{-|
Module      : Formatter
Description : This module defines the formatter for rzk files.

The formatter is designed in a way that can be consumed both by the CLI and the
LSP server.
-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PatternSynonyms     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Rzk.Format (
  FormattingEdit (FormattingEdit),
  formatTextEdits,
  format, formatFile, formatFileWrite,
  isWellFormatted, isWellFormattedFile,
) where

import           Data.List                  (elemIndex, sort)

import qualified Data.Text                  as T
import qualified Data.Text.IO               as T

import           Language.Rzk.Syntax        (tryExtractMarkdownCodeBlocks,
                                             resolveLayout)
import           Language.Rzk.Syntax.Lex    (Posn (Pn), Tok (..),
                                             TokSymbol (TokSymbol),
                                             Token (PT), tokens)

-- | All indices are 1-based (as received from the lexer)
-- Note: LSP uses 0-based indices
data FormattingEdit = FormattingEdit Int Int Int Int String
  deriving (FormattingEdit -> FormattingEdit -> Bool
(FormattingEdit -> FormattingEdit -> Bool)
-> (FormattingEdit -> FormattingEdit -> Bool) -> Eq FormattingEdit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FormattingEdit -> FormattingEdit -> Bool
== :: FormattingEdit -> FormattingEdit -> Bool
$c/= :: FormattingEdit -> FormattingEdit -> Bool
/= :: FormattingEdit -> FormattingEdit -> Bool
Eq, Eq FormattingEdit
Eq FormattingEdit =>
(FormattingEdit -> FormattingEdit -> Ordering)
-> (FormattingEdit -> FormattingEdit -> Bool)
-> (FormattingEdit -> FormattingEdit -> Bool)
-> (FormattingEdit -> FormattingEdit -> Bool)
-> (FormattingEdit -> FormattingEdit -> Bool)
-> (FormattingEdit -> FormattingEdit -> FormattingEdit)
-> (FormattingEdit -> FormattingEdit -> FormattingEdit)
-> Ord FormattingEdit
FormattingEdit -> FormattingEdit -> Bool
FormattingEdit -> FormattingEdit -> Ordering
FormattingEdit -> FormattingEdit -> FormattingEdit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FormattingEdit -> FormattingEdit -> Ordering
compare :: FormattingEdit -> FormattingEdit -> Ordering
$c< :: FormattingEdit -> FormattingEdit -> Bool
< :: FormattingEdit -> FormattingEdit -> Bool
$c<= :: FormattingEdit -> FormattingEdit -> Bool
<= :: FormattingEdit -> FormattingEdit -> Bool
$c> :: FormattingEdit -> FormattingEdit -> Bool
> :: FormattingEdit -> FormattingEdit -> Bool
$c>= :: FormattingEdit -> FormattingEdit -> Bool
>= :: FormattingEdit -> FormattingEdit -> Bool
$cmax :: FormattingEdit -> FormattingEdit -> FormattingEdit
max :: FormattingEdit -> FormattingEdit -> FormattingEdit
$cmin :: FormattingEdit -> FormattingEdit -> FormattingEdit
min :: FormattingEdit -> FormattingEdit -> FormattingEdit
Ord, Int -> FormattingEdit -> ShowS
[FormattingEdit] -> ShowS
FormattingEdit -> String
(Int -> FormattingEdit -> ShowS)
-> (FormattingEdit -> String)
-> ([FormattingEdit] -> ShowS)
-> Show FormattingEdit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FormattingEdit -> ShowS
showsPrec :: Int -> FormattingEdit -> ShowS
$cshow :: FormattingEdit -> String
show :: FormattingEdit -> String
$cshowList :: [FormattingEdit] -> ShowS
showList :: [FormattingEdit] -> ShowS
Show)

-- TODO: more patterns, e.g. for identifiers and literals
pattern Symbol :: String -> Tok
pattern $mSymbol :: forall {r}. Tok -> (String -> r) -> ((# #) -> r) -> r
Symbol s <- TK (TokSymbol s _)

pattern Token :: String -> Int -> Int -> Token
pattern $mToken :: forall {r}.
Token -> (String -> Int -> Int -> r) -> ((# #) -> r) -> r
Token s line col <- PT (Pn _ line col) (Symbol s)

-- pattern TokenSym :: String -> Int -> Int -> Token
-- pattern TokenSym s line col <- PT (Pn _ line col) (Symbol s)

pattern TokenIdent :: String -> Int -> Int -> Token
pattern $mTokenIdent :: forall {r}.
Token -> (String -> Int -> Int -> r) -> ((# #) -> r) -> r
TokenIdent s line col <- PT (Pn _ line col) (T_VarIdentToken s)

data FormatState = FormatState
  { FormatState -> Int
parensDepth  :: Int  -- ^ The level of parentheses nesting
  , FormatState -> Bool
definingName :: Bool -- ^ After #define, in name or assumptions (to detect the : for the type)
  , FormatState -> Bool
lambdaArrow  :: Bool -- ^ After a lambda '\', in the parameters (to leave its -> on the same line)
  , FormatState -> [Token]
allTokens    :: [Token] -- ^ The full array of tokens after resolving the layout
  }

-- TODO: replace all tabs with 1 space before processing
formatTextEdits :: String -> [FormattingEdit]
formatTextEdits :: String -> [FormattingEdit]
formatTextEdits String
contents =
  case Bool -> [Token] -> Either String [Token]
resolveLayout Bool
True (String -> [Token]
tokens String
rzkBlocks) of
    Left String
_err -> [] -- TODO: log error (in a CLI and LSP friendly way)
    Right [Token]
allToks -> FormatState -> [Token] -> [FormattingEdit]
go (FormatState
initialState {allTokens = allToks}) [Token]
allToks
  where
    initialState :: FormatState
initialState = FormatState { parensDepth :: Int
parensDepth = Int
0, definingName :: Bool
definingName = Bool
False, lambdaArrow :: Bool
lambdaArrow = Bool
False, allTokens :: [Token]
allTokens = [] }
    incParensDepth :: FormatState -> FormatState
incParensDepth FormatState
s = FormatState
s { parensDepth = parensDepth s + 1 }
    decParensDepth :: FormatState -> FormatState
decParensDepth FormatState
s = FormatState
s { parensDepth = 0 `max` (parensDepth s - 1) }
    rzkBlocks :: String
rzkBlocks = String -> ShowS
tryExtractMarkdownCodeBlocks String
"rzk" String
contents -- TODO: replace tabs with spaces
    contentLines :: Int -> String
contentLines Int
line = String -> [String]
lines String
rzkBlocks [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) -- Sorry
    lineTokensBefore :: [Token] -> Int -> Int -> [Token]
lineTokensBefore [Token]
toks Int
line Int
col = (Token -> Bool) -> [Token] -> [Token]
forall a. (a -> Bool) -> [a] -> [a]
filter Token -> Bool
isBefore [Token]
toks
      where
        isBefore :: Token -> Bool
isBefore (PT (Pn Int
_ Int
l Int
c) Tok
_) = Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
col
        isBefore Token
_                 = Bool
False
    unicodeTokens :: [(String, String)]
unicodeTokens =
      [ (String
"->", String
"→")
      , (String
"|->", String
"↦")
      , (String
"===", String
"≡")
      , (String
"<=", String
"≤")
      , (String
"/\\", String
"∧")
      , (String
"\\/", String
"∨")
      , (String
"Sigma", String
"Σ")
      , (String
"∑", String
"Σ")
      , (String
"*_1", String
"*₁")
      , (String
"0_2", String
"0₂")
      , (String
"1_2", String
"1₂")
      , (String
"*", String
"×")
      ]
    go :: FormatState -> [Token] -> [FormattingEdit]
    go :: FormatState -> [Token] -> [FormattingEdit]
go FormatState
_ [] = []
    go FormatState
s (Token String
"#lang" Int
langLine Int
langCol : Token String
"rzk-1" Int
rzkLine Int
rzkCol : [Token]
tks)
      -- FIXME: Tab characters break this because BNFC increases the column number to the next multiple of 8
      -- Should probably check the first field of Pn (always incremented by 1)
      -- Or `tabSize` param sent along the formatting request
      -- But we should probably convert tabs to spaces first before any other formatting
      = [FormattingEdit]
edits [FormattingEdit] -> [FormattingEdit] -> [FormattingEdit]
forall a. [a] -> [a] -> [a]
++ FormatState -> [Token] -> [FormattingEdit]
go FormatState
s [Token]
tks
      where
        edits :: [FormattingEdit]
edits = ((Bool, FormattingEdit) -> FormattingEdit)
-> [(Bool, FormattingEdit)] -> [FormattingEdit]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, FormattingEdit) -> FormattingEdit
forall a b. (a, b) -> b
snd ([(Bool, FormattingEdit)] -> [FormattingEdit])
-> [(Bool, FormattingEdit)] -> [FormattingEdit]
forall a b. (a -> b) -> a -> b
$ ((Bool, FormattingEdit) -> Bool)
-> [(Bool, FormattingEdit)] -> [(Bool, FormattingEdit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, FormattingEdit) -> Bool
forall a b. (a, b) -> a
fst
          -- Remove extra spaces before #lang
          [ (Int
langCol Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1, Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
langLine Int
1 Int
langLine Int
langCol String
"")
          -- Remove extra spaces between #lang and rzk-1
          , (Int
rzkLine Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
langLine Bool -> Bool -> Bool
|| Int
rzkCol Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
langCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1,
              Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
langLine (Int
langCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) Int
rzkLine Int
rzkCol String
" ")
          ]

    go FormatState
s (Token String
"#postulate" Int
_ Int
_ : [Token]
tks) = FormatState -> [Token] -> [FormattingEdit]
go (FormatState
s {definingName = True}) [Token]
tks

    go FormatState
s (Token String
"#define" Int
defLine Int
defCol : TokenIdent String
_name Int
nameLine Int
nameCol : [Token]
tks)
      = [FormattingEdit]
edits [FormattingEdit] -> [FormattingEdit] -> [FormattingEdit]
forall a. [a] -> [a] -> [a]
++ FormatState -> [Token] -> [FormattingEdit]
go (FormatState
s {definingName = True}) [Token]
tks
      where
        edits :: [FormattingEdit]
edits = ((Bool, FormattingEdit) -> FormattingEdit)
-> [(Bool, FormattingEdit)] -> [FormattingEdit]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, FormattingEdit) -> FormattingEdit
forall a b. (a, b) -> b
snd ([(Bool, FormattingEdit)] -> [FormattingEdit])
-> [(Bool, FormattingEdit)] -> [FormattingEdit]
forall a b. (a -> b) -> a -> b
$ ((Bool, FormattingEdit) -> Bool)
-> [(Bool, FormattingEdit)] -> [(Bool, FormattingEdit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, FormattingEdit) -> Bool
forall a b. (a, b) -> a
fst
          -- Remove any space before #define
          [ (Int
defCol Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1, Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
defLine Int
1 Int
defLine Int
defCol String
"")
          -- Ensure exactly one space after #define
          , (Int
nameLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
defLine Bool -> Bool -> Bool
|| Int
nameCol Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
defCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1,
              Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
defLine (Int
defCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int
nameLine Int
nameCol String
" ")
          ]
    -- #def is an alias for #define
    go FormatState
s (Token String
"#def" Int
line Int
col : [Token]
tks) = FormatState -> [Token] -> [FormattingEdit]
go FormatState
s (Posn -> Tok -> Token
PT (Int -> Int -> Int -> Posn
Pn Int
0 Int
line Int
col) (TokSymbol -> Tok
TK (String -> Int -> TokSymbol
TokSymbol String
"#define" Int
0))Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
tks)
    -- TODO: similarly for other commands

    -- Ensure exactly one space after the first open paren of a line
    go FormatState
s (Token String
"(" Int
line Int
col : [Token]
tks)
      | Bool
precededBySingleCharOnly Bool -> Bool -> Bool
&& Int
spacesAfter Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isLastNonSpaceChar
        = Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
line Int
spaceCol Int
line (Int
spaceCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacesAfter) String
" "
        FormattingEdit -> [FormattingEdit] -> [FormattingEdit]
forall a. a -> [a] -> [a]
: FormatState -> [Token] -> [FormattingEdit]
go (FormatState -> FormatState
incParensDepth FormatState
s) [Token]
tks
      -- Remove extra spaces if it's not the first open paren on a new line
      | Bool -> Bool
not Bool
precededBySingleCharOnly Bool -> Bool -> Bool
&& Int
spacesAfter Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
        = Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
line Int
spaceCol Int
line (Int
spaceCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacesAfter) String
""
        FormattingEdit -> [FormattingEdit] -> [FormattingEdit]
forall a. a -> [a] -> [a]
: FormatState -> [Token] -> [FormattingEdit]
go (FormatState -> FormatState
incParensDepth FormatState
s) [Token]
tks
      | Bool
otherwise = FormatState -> [Token] -> [FormattingEdit]
go (FormatState -> FormatState
incParensDepth FormatState
s) [Token]
tks
      -- TODO: Split after 80 chars
      where
        spaceCol :: Int
spaceCol = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        lineContent :: String
lineContent = Int -> String
contentLines Int
line
        precededBySingleCharOnly :: Bool
precededBySingleCharOnly = (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Token -> Bool
isPunctuation ([Token] -> Int -> Int -> [Token]
lineTokensBefore (FormatState -> [Token]
allTokens FormatState
s) Int
line Int
col)
        singleCharUnicodeTokens :: [(String, String)]
singleCharUnicodeTokens = ((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(String
_, String
unicode) -> String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
unicode Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) [(String, String)]
unicodeTokens
        punctuations :: [String]
punctuations = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst [(String, String)]
singleCharUnicodeTokens -- ASCII sequences will be converted soon
          , ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd [(String, String)]
singleCharUnicodeTokens
          , [String
"(", String
":", String
",", String
"="]
          ]
        isPunctuation :: Token -> Bool
isPunctuation (Token String
tk Int
_ Int
_) = String
tk String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
punctuations
        isPunctuation Token
_              = Bool
False
        spacesAfter :: Int
spacesAfter = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
col String
lineContent)
        isLastNonSpaceChar :: Bool
isLastNonSpaceChar = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
col String
lineContent)

    -- Remove any space before the closing paren
    go FormatState
s (Token String
")" Int
line Int
col : [Token]
tks)
      = [FormattingEdit]
edits [FormattingEdit] -> [FormattingEdit] -> [FormattingEdit]
forall a. [a] -> [a] -> [a]
++ FormatState -> [Token] -> [FormattingEdit]
go (FormatState -> FormatState
decParensDepth FormatState
s) [Token]
tks
      where
        lineContent :: String
lineContent = Int -> String
contentLines Int
line
        isFirstNonSpaceChar :: Bool
isFirstNonSpaceChar = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> ShowS
forall a. Int -> [a] -> [a]
take (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
lineContent)
        spacesBefore :: Int
spacesBefore = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
take (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
lineContent)
        edits :: [FormattingEdit]
edits = ((Bool, FormattingEdit) -> FormattingEdit)
-> [(Bool, FormattingEdit)] -> [FormattingEdit]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, FormattingEdit) -> FormattingEdit
forall a b. (a, b) -> b
snd ([(Bool, FormattingEdit)] -> [FormattingEdit])
-> [(Bool, FormattingEdit)] -> [FormattingEdit]
forall a b. (a -> b) -> a -> b
$ ((Bool, FormattingEdit) -> Bool)
-> [(Bool, FormattingEdit)] -> [(Bool, FormattingEdit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, FormattingEdit) -> Bool
forall a b. (a, b) -> a
fst
          [ (Bool -> Bool
not Bool
isFirstNonSpaceChar Bool -> Bool -> Bool
&& Int
spacesBefore Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0,
              Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spacesBefore) Int
line Int
col String
"")
          ]

    -- line break before : (only the top-level one) and one space after
    go FormatState
s (Token String
":" Int
line Int
col : [Token]
tks)
      | Bool
isDefinitionTypeSeparator = [FormattingEdit]
typeSepEdits [FormattingEdit] -> [FormattingEdit] -> [FormattingEdit]
forall a. [a] -> [a] -> [a]
++ FormatState -> [Token] -> [FormattingEdit]
go (FormatState
s {definingName = False}) [Token]
tks
      | Bool
otherwise                 = [FormattingEdit]
normalEdits [FormattingEdit] -> [FormattingEdit] -> [FormattingEdit]
forall a. [a] -> [a] -> [a]
++ FormatState -> [Token] -> [FormattingEdit]
go FormatState
s [Token]
tks
      where
        isDefinitionTypeSeparator :: Bool
isDefinitionTypeSeparator = FormatState -> Int
parensDepth FormatState
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& FormatState -> Bool
definingName FormatState
s
        lineContent :: String
lineContent = Int -> String
contentLines Int
line
        isFirstNonSpaceChar :: Bool
isFirstNonSpaceChar = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> ShowS
forall a. Int -> [a] -> [a]
take (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
lineContent)
        isLastNonSpaceChar :: Bool
isLastNonSpaceChar = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
col String
lineContent)
        spacesBefore :: Int
spacesBefore = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
take (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
lineContent)
        spaceCol :: Int
spaceCol = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        spacesAfter :: Int
spacesAfter = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
col String
lineContent)
        typeSepEdits :: [FormattingEdit]
typeSepEdits = ((Bool, FormattingEdit) -> FormattingEdit)
-> [(Bool, FormattingEdit)] -> [FormattingEdit]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, FormattingEdit) -> FormattingEdit
forall a b. (a, b) -> b
snd ([(Bool, FormattingEdit)] -> [FormattingEdit])
-> [(Bool, FormattingEdit)] -> [FormattingEdit]
forall a b. (a -> b) -> a -> b
$ ((Bool, FormattingEdit) -> Bool)
-> [(Bool, FormattingEdit)] -> [(Bool, FormattingEdit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, FormattingEdit) -> Bool
forall a b. (a, b) -> a
fst
          -- Ensure line break before : (and remove any spaces before)
          [ (Bool -> Bool
not Bool
isFirstNonSpaceChar, Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spacesBefore) Int
line Int
col String
"\n  ")
          -- Ensure 2 spaces before : (if already on a new line)
          , (Bool
isFirstNonSpaceChar Bool -> Bool -> Bool
&& Int
spacesBefore Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
2, Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
line Int
1 Int
line Int
col String
"  ")
          -- Ensure 1 space after
          , (Bool -> Bool
not Bool
isLastNonSpaceChar Bool -> Bool -> Bool
&& Int
spacesAfter Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1,
              Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
line Int
spaceCol Int
line (Int
spaceCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacesAfter) String
" ")
          ]
        normalEdits :: [FormattingEdit]
normalEdits = ((Bool, FormattingEdit) -> FormattingEdit)
-> [(Bool, FormattingEdit)] -> [FormattingEdit]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, FormattingEdit) -> FormattingEdit
forall a b. (a, b) -> b
snd ([(Bool, FormattingEdit)] -> [FormattingEdit])
-> [(Bool, FormattingEdit)] -> [FormattingEdit]
forall a b. (a -> b) -> a -> b
$ ((Bool, FormattingEdit) -> Bool)
-> [(Bool, FormattingEdit)] -> [(Bool, FormattingEdit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, FormattingEdit) -> Bool
forall a b. (a, b) -> a
fst
          -- 1 space before :
          [ (Int
spacesBefore Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1, Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spacesBefore) Int
line Int
col String
" ")
          -- 1 space after
          , (Bool -> Bool
not Bool
isLastNonSpaceChar Bool -> Bool -> Bool
&& Int
spacesAfter Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1,
              Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
line Int
spaceCol Int
line (Int
spaceCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacesAfter) String
" ")
          ]

    -- Line break before := and one space after
    go FormatState
s (Token String
":=" Int
line Int
col : [Token]
tks)
      = [FormattingEdit]
edits [FormattingEdit] -> [FormattingEdit] -> [FormattingEdit]
forall a. [a] -> [a] -> [a]
++ FormatState -> [Token] -> [FormattingEdit]
go FormatState
s [Token]
tks
      where
        lineContent :: String
lineContent = Int -> String
contentLines Int
line
        isFirstNonSpaceChar :: Bool
isFirstNonSpaceChar = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> ShowS
forall a. Int -> [a] -> [a]
take (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
lineContent)
        spacesAfter :: Int
spacesAfter = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> ShowS
forall a. Int -> [a] -> [a]
drop (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
lineContent)
        spacesBefore :: Int
spacesBefore = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
take (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
lineContent)
        edits :: [FormattingEdit]
edits = ((Bool, FormattingEdit) -> FormattingEdit)
-> [(Bool, FormattingEdit)] -> [FormattingEdit]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, FormattingEdit) -> FormattingEdit
forall a b. (a, b) -> b
snd ([(Bool, FormattingEdit)] -> [FormattingEdit])
-> [(Bool, FormattingEdit)] -> [FormattingEdit]
forall a b. (a -> b) -> a -> b
$ ((Bool, FormattingEdit) -> Bool)
-> [(Bool, FormattingEdit)] -> [(Bool, FormattingEdit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, FormattingEdit) -> Bool
forall a b. (a, b) -> a
fst
            -- Ensure line break before `:=`
          [ (Bool -> Bool
not Bool
isFirstNonSpaceChar, Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spacesBefore) Int
line Int
col String
"\n  ")
            -- Ensure 2 spaces before `:=` (if already on a new line)
          , (Bool
isFirstNonSpaceChar Bool -> Bool -> Bool
&& Int
spacesBefore Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
2,
              Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
line Int
1 Int
line Int
col String
"  ")
            -- Ensure exactly one space after
          , (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
lineContent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Bool -> Bool -> Bool
&& Int
spacesAfter Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1,
              Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacesAfter) String
" ")
          ]

    -- One space after \
    go FormatState
s (Token String
"\\" Int
line Int
col : [Token]
tks)
      = [FormattingEdit]
edits [FormattingEdit] -> [FormattingEdit] -> [FormattingEdit]
forall a. [a] -> [a] -> [a]
++ FormatState -> [Token] -> [FormattingEdit]
go (FormatState
s { lambdaArrow = True }) [Token]
tks
      where
        lineContent :: String
lineContent = Int -> String
contentLines Int
line
        spacesAfter :: Int
spacesAfter = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
col String
lineContent)
        isLastNonSpaceChar :: Bool
isLastNonSpaceChar = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
col String
lineContent)
        spaceCol :: Int
spaceCol = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        edits :: [FormattingEdit]
edits = ((Bool, FormattingEdit) -> FormattingEdit)
-> [(Bool, FormattingEdit)] -> [FormattingEdit]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, FormattingEdit) -> FormattingEdit
forall a b. (a, b) -> b
snd ([(Bool, FormattingEdit)] -> [FormattingEdit])
-> [(Bool, FormattingEdit)] -> [FormattingEdit]
forall a b. (a -> b) -> a -> b
$ ((Bool, FormattingEdit) -> Bool)
-> [(Bool, FormattingEdit)] -> [(Bool, FormattingEdit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, FormattingEdit) -> Bool
forall a b. (a, b) -> a
fst
          [ (Bool -> Bool
not Bool
isLastNonSpaceChar Bool -> Bool -> Bool
&& Int
spacesAfter Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1,
              Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
line Int
spaceCol Int
line (Int
spaceCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacesAfter) String
" ")
          ]

    -- Reset any state necessary after finishing a command
    go FormatState
s (Token String
";" Int
_ Int
_ : [Token]
tks) = FormatState -> [Token] -> [FormattingEdit]
go FormatState
s [Token]
tks

    -- One space (or new line) around binary operators and replace ASCII w/ unicode
    go FormatState
s (Token String
tk Int
line Int
col : [Token]
tks) = [FormattingEdit]
edits [FormattingEdit] -> [FormattingEdit] -> [FormattingEdit]
forall a. [a] -> [a] -> [a]
++ FormatState -> [Token] -> [FormattingEdit]
go FormatState
s' [Token]
tks
      where
        s' :: FormatState
s' | Bool
isArrow = FormatState
s { lambdaArrow = False } -- reset flag after reaching the arrow
           | Bool
otherwise = FormatState
s
        isArrow :: Bool
isArrow = String
tk String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"->", String
"→"]
        lineContent :: String
lineContent = Int -> String
contentLines Int
line
        spacesBefore :: Int
spacesBefore = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
take (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
lineContent)
        spacesAfter :: Int
spacesAfter = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> ShowS
forall a. Int -> [a] -> [a]
drop (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
tk Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
lineContent)
        isFirstNonSpaceChar :: Bool
isFirstNonSpaceChar = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> ShowS
forall a. Int -> [a] -> [a]
take (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
lineContent)
        isLastNonSpaceChar :: Bool
isLastNonSpaceChar = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> ShowS
forall a. Int -> [a] -> [a]
drop (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
tk Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
lineContent)
        prevLine :: String
prevLine
          | Int
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> String
contentLines (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          | Bool
otherwise = String
""
        nextLine :: String
nextLine
          | Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
lines String
rzkBlocks) = Int -> String
contentLines (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          | Bool
otherwise = String
""
        spacesNextLine :: Int
spacesNextLine = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') String
nextLine
        edits :: [FormattingEdit]
edits = [FormattingEdit]
spaceEdits [FormattingEdit] -> [FormattingEdit] -> [FormattingEdit]
forall a. [a] -> [a] -> [a]
++ [FormattingEdit]
unicodeEdits
        spaceEdits :: [FormattingEdit]
spaceEdits
          | String
tk String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"->", String
"→", String
",", String
"*", String
"×", String
"="] = ((Bool, [FormattingEdit]) -> [FormattingEdit])
-> [(Bool, [FormattingEdit])] -> [FormattingEdit]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool, [FormattingEdit]) -> [FormattingEdit]
forall a b. (a, b) -> b
snd ([(Bool, [FormattingEdit])] -> [FormattingEdit])
-> [(Bool, [FormattingEdit])] -> [FormattingEdit]
forall a b. (a -> b) -> a -> b
$ ((Bool, [FormattingEdit]) -> Bool)
-> [(Bool, [FormattingEdit])] -> [(Bool, [FormattingEdit])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, [FormattingEdit]) -> Bool
forall a b. (a, b) -> a
fst
              -- Ensure exactly one space before (unless first char in line, or about to move to next line)
              [ (Bool -> Bool
not Bool
isFirstNonSpaceChar Bool -> Bool -> Bool
&& Int
spacesBefore Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isLastNonSpaceChar,
                  [Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spacesBefore) Int
line Int
col String
" "])
              -- Ensure exactly one space after (unless last char in line)
              , (Bool -> Bool
not Bool
isLastNonSpaceChar Bool -> Bool -> Bool
&& Int
spacesAfter Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1,
                  [Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
tk) Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
tk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacesAfter) String
" "])
              -- If last char in line, move it to next line (except for lambda arrow)
              , (Bool
isLastNonSpaceChar Bool -> Bool -> Bool
&& Bool -> Bool
not (FormatState -> Bool
lambdaArrow FormatState
s),
                  -- This is split into 2 edits to avoid possible overlap with unicode replacement
                  -- 1. Add a new line (with relevant spaces) before the token
                  [ Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spacesBefore) Int
line Int
col (String -> FormattingEdit) -> String -> FormattingEdit
forall a b. (a -> b) -> a -> b
$
                      String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
2 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` (Int
spacesNextLine Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
spacesNextLine Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
2))) Char
' '
                  -- 2. Replace the new line and spaces after the token with a single space
                  , Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
tk) (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
spacesNextLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
" "
                  ])
              -- If lambda -> is first char in line, move it to the previous line
              , (Bool
isFirstNonSpaceChar Bool -> Bool -> Bool
&& Bool
isArrow Bool -> Bool -> Bool
&& FormatState -> Bool
lambdaArrow FormatState
s,
                  [Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
prevLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
tk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacesAfter) (String -> FormattingEdit) -> String -> FormattingEdit
forall a b. (a -> b) -> a -> b
$
                    String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tk String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
spacesBefore Char
' '])
              ]
          | Bool
otherwise = []
        unicodeEdits :: [FormattingEdit]
unicodeEdits
          | Just String
unicodeToken <- String
tk String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(String, String)]
unicodeTokens =
              [ Int -> Int -> Int -> Int -> String -> FormattingEdit
FormattingEdit Int
line Int
col Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
tk) String
unicodeToken
              ]
          | Bool
otherwise = []

    go FormatState
s (Token
_:[Token]
tks) = FormatState -> [Token] -> [FormattingEdit]
go FormatState
s [Token]
tks

-- Adapted from https://hackage.haskell.org/package/lsp-types-2.1.0.0/docs/Language-LSP-Protocol-Types.html#g:7
applyTextEdit :: FormattingEdit -> String -> String
applyTextEdit :: FormattingEdit -> ShowS
applyTextEdit (FormattingEdit Int
sl Int
sc Int
el Int
ec String
newText) String
oldText =
  let (String
_, String
afterEnd) = (Int, Int) -> String -> (String, String)
splitAtPos (Int
elInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Int
ec Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String
oldText
      (String
beforeStart, String
_) = (Int, Int) -> String -> (String, String)
splitAtPos (Int
slInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Int
scInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String
oldText
   in [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
beforeStart, String
newText, String
afterEnd]
 where
  splitAtPos :: (Int, Int) -> String -> (String, String)
  splitAtPos :: (Int, Int) -> String -> (String, String)
splitAtPos (Int
l, Int
c) String
t = let index :: Int
index = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> String -> Int
startLineIndex Int
l String
t in Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
index String
t

  startLineIndex :: Int -> String -> Int
  startLineIndex :: Int -> String -> Int
startLineIndex Int
0 String
_ = Int
0
  startLineIndex Int
line String
t' =
    case Char -> String -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Char
'\n' String
t' of
      Just Int
i  -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> String -> Int
startLineIndex (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> ShowS
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
t')
      Maybe Int
Nothing -> String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
t'

applyTextEdits :: [FormattingEdit] -> String -> String
applyTextEdits :: [FormattingEdit] -> ShowS
applyTextEdits [FormattingEdit]
edits String
contents = (FormattingEdit -> ShowS) -> String -> [FormattingEdit] -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FormattingEdit -> ShowS
applyTextEdit String
contents ([FormattingEdit] -> [FormattingEdit]
forall a. Ord a => [a] -> [a]
sort [FormattingEdit]
edits)

-- | Format Rzk code, returning the formatted version.
format :: String -> String
format :: ShowS
format = [FormattingEdit] -> ShowS
applyTextEdits ([FormattingEdit] -> ShowS)
-> (String -> [FormattingEdit]) -> ShowS
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> [FormattingEdit]
formatTextEdits

-- | Format Rzk code from a file
formatFile :: FilePath -> IO String
formatFile :: String -> IO String
formatFile String
path = do
  Text
contents <- String -> IO Text
T.readFile String
path
  String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
format (Text -> String
T.unpack Text
contents))

-- | Format the file and write the result back to the file.
formatFileWrite :: FilePath -> IO ()
formatFileWrite :: String -> IO ()
formatFileWrite String
path = String -> IO String
formatFile String
path IO String -> (String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> String -> IO ()
writeFile String
path

-- | Check if the given Rzk source code is well formatted.
--   This is useful for automation tasks.
isWellFormatted :: String -> Bool
isWellFormatted :: String -> Bool
isWellFormatted String
src = [FormattingEdit] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> [FormattingEdit]
formatTextEdits String
src)

-- | Same as 'isWellFormatted', but reads the source code from a file.
isWellFormattedFile :: FilePath -> IO Bool
isWellFormattedFile :: String -> IO Bool
isWellFormattedFile String
path = do
  Text
contents <- String -> IO Text
T.readFile String
path
  Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Bool
isWellFormatted (Text -> String
T.unpack Text
contents))