{-|
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, formatDocument, formatFile, formatFileWrite,
  isWellFormatted, isWellFormattedFile,
  normalizeTabs,
) where

import           Data.List               (sort)

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

import           Language.Rzk.Syntax     (resolveLayout,
                                          tryExtractMarkdownCodeBlocks)
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 T.Text
  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 :: T.Text -> Tok
pattern $mSymbol :: forall {r}. Tok -> (Text -> r) -> ((# #) -> r) -> r
Symbol s <- TK (TokSymbol s _)

pattern Token :: T.Text -> Int -> Int -> Token
pattern $mToken :: forall {r}. Token -> (Text -> 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 :: T.Text -> Int -> Int -> Token
pattern $mTokenIdent :: forall {r}. Token -> (Text -> 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 -> Int
eqBraceDepth     :: Int  -- ^ Depth inside =_{ ... }; 0 = not inside, 1 = at top level after =_{
  , FormatState -> Bool
eqBraceOnOwnLine :: Bool -- ^ True if the current =_{ started at the beginning of its line (after spaces)
  , FormatState -> [Token]
allTokens        :: [Token] -- ^ The full array of tokens after resolving the layout
  }

-- | Replace every tab character with a single space.
--   Call this before 'formatTextEdits' so that the lexer and edit positions
--   are consistent (BNFC column counts are undefined when the source contains tabs).
normalizeTabs :: T.Text -> T.Text
normalizeTabs :: Text -> Text
normalizeTabs = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\t" Text
" "

formatTextEdits :: T.Text -> [FormattingEdit]
formatTextEdits :: Text -> [FormattingEdit]
formatTextEdits Text
contents =
  case Bool -> [Token] -> Either String [Token]
resolveLayout Bool
True (Text -> [Token]
tokens Text
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, eqBraceDepth :: Int
eqBraceDepth = Int
0, eqBraceOnOwnLine :: Bool
eqBraceOnOwnLine = 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 :: Text
rzkBlocks = Text -> Text -> Text
tryExtractMarkdownCodeBlocks Text
"rzk" Text
contents
    contentLines :: Int -> Text
contentLines Int
line = Text -> [Text]
T.lines Text
rzkBlocks [Text] -> Int -> Text
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 :: [(T.Text, T.Text)]
    unicodeTokens :: [(Text, Text)]
unicodeTokens =
      [ (Text
"->", Text
"→")
      , (Text
"|->", Text
"↦")
      , (Text
"===", Text
"≡")
      , (Text
"<=", Text
"≤")
      , (Text
"/\\", Text
"∧")
      , (Text
"\\/", Text
"∨")
      , (Text
"Sigma", Text
"Σ")
      , (Text
"∑", Text
"Σ")
      , (Text
"*_1", Text
"*₁")
      , (Text
"0_2", Text
"0₂")
      , (Text
"1_2", Text
"1₂")
      , (Text
"*", Text
"×")
      ]
    go :: FormatState -> [Token] -> [FormattingEdit]
    go :: FormatState -> [Token] -> [FormattingEdit]
go FormatState
_ [] = []
    go FormatState
s (Token Text
"#lang" Int
langLine Int
langCol : Token Text
"rzk-1" Int
rzkLine Int
rzkCol : [Token]
tks)
      -- Tab characters would break column counts (BNFC uses next multiple of 8); call 'format'
      -- or pass 'normalizeTabs' output to 'formatTextEdits' so input is tab-free.
      = [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 -> Text -> FormattingEdit
FormattingEdit Int
langLine Int
1 Int
langLine Int
langCol Text
"")
          -- 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 -> Text -> FormattingEdit
FormattingEdit Int
langLine (Int
langCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) Int
rzkLine Int
rzkCol Text
" ")
          ]

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

    go FormatState
s (Token Text
"#define" Int
defLine Int
defCol : TokenIdent Text
_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 -> Text -> FormattingEdit
FormattingEdit Int
defLine Int
1 Int
defLine Int
defCol Text
"")
          -- 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 -> Text -> FormattingEdit
FormattingEdit Int
defLine (Int
defCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int
nameLine Int
nameCol Text
" ")
          ]
    -- #def is an alias for #define
    go FormatState
s (Token Text
"#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 (Text -> Int -> TokSymbol
TokSymbol Text
"#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 Text
"(" 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 -> Text -> FormattingEdit
FormattingEdit Int
line Int
spaceCol Int
line (Int
spaceCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacesAfter) Text
" "
        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 -> Text -> FormattingEdit
FormattingEdit Int
line Int
spaceCol Int
line (Int
spaceCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacesAfter) Text
""
        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 :: Text
lineContent = Int -> Text
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 :: [(Text, Text)]
singleCharUnicodeTokens = ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
_, Text
unicode) -> Text -> Int
T.length Text
unicode Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) [(Text, Text)]
unicodeTokens
        punctuations :: [T.Text]
        punctuations :: [Text]
punctuations = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst [(Text, Text)]
singleCharUnicodeTokens -- ASCII sequences will be converted soon
          , ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> b
snd [(Text, Text)]
singleCharUnicodeTokens
          , [Text
"(", Text
":", Text
",", Text
"="]
          ]
        isPunctuation :: Token -> Bool
isPunctuation (Token Text
tk Int
_ Int
_) = Text
tk Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
punctuations
        isPunctuation Token
_              = Bool
False
        spacesAfter :: Int
spacesAfter = Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> Text -> Text
T.drop Int
col Text
lineContent)
        isLastNonSpaceChar :: Bool
isLastNonSpaceChar = (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> Text -> Text
T.drop Int
col Text
lineContent)

    -- Remove any space before the closing paren
    go FormatState
s (Token Text
")" 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 :: Text
lineContent = Int -> Text
contentLines Int
line
        isFirstNonSpaceChar :: Bool
isFirstNonSpaceChar = (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> Text -> Text
T.take (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
lineContent)
        spacesBefore :: Int
spacesBefore = Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Text -> Text
T.reverse (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
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 -> Text -> FormattingEdit
FormattingEdit Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spacesBefore) Int
line Int
col Text
"")
          ]

    -- Enter =_{ ... } (identity type with explicit type): track depth for newline-after-} rule (style guide)
    -- Only apply newline-after-} when the outermost =_{ is on its own line. Increment depth for nesting.
    go FormatState
s (Token Text
"=_{" Int
line Int
col : [Token]
tks)
      = FormatState -> [Token] -> [FormattingEdit]
go (FormatState
s { eqBraceDepth = eqBraceDepth s + 1, eqBraceOnOwnLine = if eqBraceDepth s == 0 then isOnOwnLine else eqBraceOnOwnLine s }) [Token]
tks
      where
        lineContent :: Text
lineContent = Int -> Text
contentLines Int
line
        isOnOwnLine :: Bool
isOnOwnLine = (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> Text -> Text
T.take (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
lineContent)

    -- Count braces inside =_{ ... } so we detect the closing }
    go FormatState
s (Token Text
"{" Int
_line Int
_col : [Token]
tks)
      = FormatState -> [Token] -> [FormattingEdit]
go (FormatState
s { eqBraceDepth = if eqBraceDepth s > 0 then eqBraceDepth s + 1 else 0 }) [Token]
tks

    -- Newline after the closing } of =_{ ... } only when =_{ was on its own line (style guide)
    go FormatState
s (Token Text
"}" Int
line Int
col : [Token]
tks)
      = [FormattingEdit]
eqBraceEdits [FormattingEdit] -> [FormattingEdit] -> [FormattingEdit]
forall a. [a] -> [a] -> [a]
++ FormatState -> [Token] -> [FormattingEdit]
go FormatState
s' [Token]
tks
      where
        closingEqBrace :: Bool
closingEqBrace = FormatState -> Int
eqBraceDepth FormatState
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
        onOwnLine :: Bool
onOwnLine = FormatState -> Bool
eqBraceOnOwnLine FormatState
s
        s' :: FormatState
s' | FormatState -> Int
eqBraceDepth FormatState
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = FormatState
s { eqBraceDepth = eqBraceDepth s - 1, eqBraceOnOwnLine = if eqBraceDepth s == 1 then False else eqBraceOnOwnLine s }
           | Bool
otherwise         = FormatState
s
        lineContent :: Text
lineContent = Int -> Text
contentLines Int
line
        braceEndCol :: Int
braceEndCol = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1  -- 1-based column right after "}"
        afterBrace :: Text
afterBrace = Int -> Text -> Text
T.drop (Int
braceEndCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
lineContent
        spacesAfter :: Int
spacesAfter = Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
afterBrace
        isLastOnLine :: Bool
isLastOnLine = (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
afterBrace
        eqBraceEdits :: [FormattingEdit]
eqBraceEdits
          | Bool
closingEqBrace Bool -> Bool -> Bool
&& Bool
onOwnLine Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isLastOnLine
          = [ Int -> Int -> Int -> Int -> Text -> FormattingEdit
FormattingEdit Int
line Int
braceEndCol Int
line (Int
braceEndCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacesAfter) Text
"\n  " ]
          | Bool
closingEqBrace Bool -> Bool -> Bool
&& Bool
onOwnLine Bool -> Bool -> Bool
&& Bool
isLastOnLine
          = let nextLine :: Text
nextLine = if Int
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Text -> [Text]
T.lines Text
rzkBlocks) then Int -> Text
contentLines (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) else Text
""
                spacesNextLine :: Int
spacesNextLine = Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
nextLine
            in if Int
spacesNextLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
2 then [ Int -> Int -> Int -> Int -> Text -> FormattingEdit
FormattingEdit (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
1 (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacesNextLine) Text
"  " ] else []
          | Bool
otherwise
          = []

    -- line break before : (only the top-level one) and one space after
    go FormatState
s (Token Text
":" 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 :: Text
lineContent = Int -> Text
contentLines Int
line
        isFirstNonSpaceChar :: Bool
isFirstNonSpaceChar = (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> Text -> Text
T.take (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
lineContent)
        isLastNonSpaceChar :: Bool
isLastNonSpaceChar = (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> Text -> Text
T.drop Int
col Text
lineContent)
        spacesBefore :: Int
spacesBefore = Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Text -> Text
T.reverse (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
lineContent)
        spaceCol :: Int
spaceCol = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        spacesAfter :: Int
spacesAfter = Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> Text -> Text
T.drop Int
col Text
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 -> Text -> FormattingEdit
FormattingEdit Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spacesBefore) Int
line Int
col Text
"\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 -> Text -> FormattingEdit
FormattingEdit Int
line Int
1 Int
line Int
col Text
"  ")
          -- 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 -> Text -> FormattingEdit
FormattingEdit Int
line Int
spaceCol Int
line (Int
spaceCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacesAfter) Text
" ")
          ]
        -- When colon is on its own line inside parentheses, align with parameter name on previous line (issue #215)
        prevLine :: Text
prevLine = if Int
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then Int -> Text
contentLines (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) else Text
""
        paramNameCol :: Int
paramNameCol =
          case (Char -> Bool) -> Text -> Maybe Int
T.findIndex (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'(') Text
prevLine of
            Just Int
parenIdx ->
              let afterParen :: Text
afterParen = Int -> Text -> Text
T.drop (Int
parenIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
prevLine
                  spacesAfterParen :: Int
spacesAfterParen = Text -> Int
T.length ((Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
afterParen)
              in Int
parenIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacesAfterParen  -- 1-based column of first char of param name
            Maybe Int
Nothing -> Int
2  -- fallback: 1 space (column 2)
        alignSpaces :: Text
alignSpaces = Int -> Text -> Text
T.replicate (Int
paramNameCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
" "
        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
          -- Inside parens with colon on its own line: align with param name; else 1 space before :
          [ (Bool
isFirstNonSpaceChar Bool -> Bool -> Bool
&& FormatState -> Int
parensDepth FormatState
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
spacesBefore Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
paramNameCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1,
              Int -> Int -> Int -> Int -> Text -> FormattingEdit
FormattingEdit Int
line Int
1 Int
line Int
col Text
alignSpaces)
          , (Bool -> Bool
not Bool
isFirstNonSpaceChar Bool -> Bool -> Bool
&& Int
spacesBefore Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1,
              Int -> Int -> Int -> Int -> Text -> FormattingEdit
FormattingEdit Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spacesBefore) Int
line Int
col Text
" ")
          -- 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 -> Text -> FormattingEdit
FormattingEdit Int
line Int
spaceCol Int
line (Int
spaceCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacesAfter) Text
" ")
          ]

    -- Line break before := and one space after
    go FormatState
s (Token Text
":=" 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 :: Text
lineContent = Int -> Text
contentLines Int
line
        isFirstNonSpaceChar :: Bool
isFirstNonSpaceChar = (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> Text -> Text
T.take (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
lineContent)
        spacesAfter :: Int
spacesAfter = Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> Text -> Text
T.drop (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
lineContent)
        spacesBefore :: Int
spacesBefore = Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Text -> Text
T.reverse (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
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 -> Text -> FormattingEdit
FormattingEdit Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spacesBefore) Int
line Int
col Text
"\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 -> Text -> FormattingEdit
FormattingEdit Int
line Int
1 Int
line Int
col Text
"  ")
            -- Ensure exactly one space after
          , (Text -> Int
T.length Text
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 -> Text -> 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) Text
" ")
          ]

    -- One space after \
    go FormatState
s (Token Text
"\\" 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 :: Text
lineContent = Int -> Text
contentLines Int
line
        spacesAfter :: Int
spacesAfter = Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> Text -> Text
T.drop Int
col Text
lineContent)
        isLastNonSpaceChar :: Bool
isLastNonSpaceChar = (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> Text -> Text
T.drop Int
col Text
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 -> Text -> FormattingEdit
FormattingEdit Int
line Int
spaceCol Int
line (Int
spaceCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacesAfter) Text
" ")
          ]

    -- Reset any state necessary after finishing a command
    go FormatState
s (Token Text
";" 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 Text
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 = Text
tk Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"->", Text
"→"]
        lineContent :: Text
lineContent = Int -> Text
contentLines Int
line
        spacesBefore :: Int
spacesBefore = Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Text -> Text
T.reverse (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
lineContent)
        spacesAfter :: Int
spacesAfter = Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> Text -> Text
T.drop (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
tk Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
lineContent)
        isFirstNonSpaceChar :: Bool
isFirstNonSpaceChar = (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> Text -> Text
T.take (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
lineContent)
        isLastNonSpaceChar :: Bool
isLastNonSpaceChar = (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Int -> Text -> Text
T.drop (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
tk Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
lineContent)
        prevLine :: Text
prevLine
          | Int
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> Text
contentLines (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          | Bool
otherwise = Text
""
        nextLine :: Text
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
< [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Text -> [Text]
T.lines Text
rzkBlocks) = Int -> Text
contentLines (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          | Bool
otherwise = Text
""
        spacesNextLine :: Int
spacesNextLine = Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
nextLine
        edits :: [FormattingEdit]
edits = [FormattingEdit]
spaceEdits [FormattingEdit] -> [FormattingEdit] -> [FormattingEdit]
forall a. [a] -> [a] -> [a]
++ [FormattingEdit]
unicodeEdits
        spaceEdits :: [FormattingEdit]
spaceEdits
          | Text
tk Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"->", Text
"→", Text
",", Text
"*", Text
"×", Text
"="] = ((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 -> Text -> FormattingEdit
FormattingEdit Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spacesBefore) Int
line Int
col Text
" "])
              -- 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 -> Text -> FormattingEdit
FormattingEdit Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
tk) Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
tk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacesAfter) Text
" "])
              -- 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 -> Text -> FormattingEdit
FormattingEdit Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spacesBefore) Int
line Int
col (Text -> FormattingEdit) -> Text -> FormattingEdit
forall a b. (a -> b) -> a -> b
$
                      Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.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))) Text
" "
                  -- 2. Replace the new line and spaces after the token with a single space
                  , Int -> Int -> Int -> Int -> Text -> FormattingEdit
FormattingEdit Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
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) Text
" "
                  ])
              -- 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 -> Text -> FormattingEdit
FormattingEdit (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Text -> Int
T.length Text
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
+ Text -> Int
T.length Text
tk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacesAfter) (Text -> FormattingEdit) -> Text -> FormattingEdit
forall a b. (a -> b) -> a -> b
$
                    Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tk Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
spacesBefore Text
" "])
              ]
          | Bool
otherwise = []
        unicodeEdits :: [FormattingEdit]
unicodeEdits
          | Just Text
unicodeToken <- Text
tk Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Text, Text)]
unicodeTokens =
              [ Int -> Int -> Int -> Int -> Text -> FormattingEdit
FormattingEdit Int
line Int
col Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
tk) Text
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 -> T.Text -> T.Text
applyTextEdit :: FormattingEdit -> Text -> Text
applyTextEdit (FormattingEdit Int
sl Int
sc Int
el Int
ec Text
newText) Text
oldText =
  let (Text
_, Text
afterEnd) = (Int, Int) -> Text -> (Text, Text)
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) Text
oldText
      (Text
beforeStart, Text
_) = (Int, Int) -> Text -> (Text, Text)
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) Text
oldText
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
beforeStart, Text
newText, Text
afterEnd]
 where
  splitAtPos :: (Int, Int) -> T.Text -> (T.Text, T.Text)
  splitAtPos :: (Int, Int) -> Text -> (Text, Text)
splitAtPos (Int
l, Int
c) Text
t = let index :: Int
index = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Text -> Int
startLineIndex Int
l Text
t in Int -> Text -> (Text, Text)
T.splitAt Int
index Text
t

  startLineIndex :: Int -> T.Text -> Int
  startLineIndex :: Int -> Text -> Int
startLineIndex Int
0 Text
_ = Int
0
  startLineIndex Int
line Text
t' =
    case (Char -> Bool) -> Text -> Maybe Int
T.findIndex (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n') Text
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 -> Text -> Int
startLineIndex (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Text -> Text
T.drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
t')
      Maybe Int
Nothing -> Text -> Int
T.length Text
t'

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

-- | Format Rzk code, returning the formatted version.
--   Tabs are normalized to single spaces before formatting.
format :: T.Text -> T.Text
format :: Text -> Text
format Text
contents =
  let normalized :: Text
normalized = Text -> Text
normalizeTabs Text
contents
  in [FormattingEdit] -> Text -> Text
applyTextEdits (Text -> [FormattingEdit]
formatTextEdits Text
normalized) Text
normalized

-- | Same as 'format'. Use this when replacing the entire document (e.g. from
--   the language server), so that tab normalization and all formatting rules
--   are applied correctly instead of applying incremental edits to tabbed source.
formatDocument :: T.Text -> T.Text
formatDocument :: Text -> Text
formatDocument = Text -> Text
format

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

-- | Format the file and write the result back to the file.
formatFileWrite :: FilePath -> IO ()
formatFileWrite :: String -> IO ()
formatFileWrite String
path = String -> IO Text
formatFile String
path IO Text -> (Text -> 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 -> Text -> IO ()
T.writeFile String
path

-- | Check if the given Rzk source code is well formatted.
--   This is useful for automation tasks.
--   Tabs are normalized to single spaces before checking.
isWellFormatted :: T.Text -> Bool
isWellFormatted :: Text -> Bool
isWellFormatted Text
src = [FormattingEdit] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Text -> [FormattingEdit]
formatTextEdits (Text -> Text
normalizeTabs Text
src))

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