-- File generated by the BNF Converter (bnfc 2.9.5).

{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE OverloadedStrings #-}

module Language.Rzk.Syntax.Layout where

import Prelude
import Data.Maybe ( fromMaybe, listToMaybe, mapMaybe )
import qualified Data.List as List

import Language.Rzk.Syntax.Lex
  ( Posn(..), Tok(..), Token(..), TokSymbol(..)
  , prToken, tokenLineCol, tokenPos, tokenPosn
  )

-- local parameters

data LayoutDelimiters
  = LayoutDelimiters
    { LayoutDelimiters -> TokSymbol
delimSep   :: TokSymbol
    , LayoutDelimiters -> Maybe TokSymbol
delimOpen  :: Maybe TokSymbol  -- ^ Nothing for toplevel layout.
    , LayoutDelimiters -> Maybe TokSymbol
delimClose :: Maybe TokSymbol  -- ^ Nothing for toplevel layout.
    }

layoutWords :: [(TokSymbol, LayoutDelimiters)]
layoutWords :: [(TokSymbol, LayoutDelimiters)]
layoutWords = []

layoutStopWords :: [TokSymbol]
layoutStopWords :: [TokSymbol]
layoutStopWords = []

-- layout separators

layoutOpen, layoutClose, layoutSep :: [TokSymbol]
layoutOpen :: [TokSymbol]
layoutOpen  = [TokSymbol] -> [TokSymbol]
forall a. Eq a => [a] -> [a]
List.nub ([TokSymbol] -> [TokSymbol]) -> [TokSymbol] -> [TokSymbol]
forall a b. (a -> b) -> a -> b
$ ((TokSymbol, LayoutDelimiters) -> Maybe TokSymbol)
-> [(TokSymbol, LayoutDelimiters)] -> [TokSymbol]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LayoutDelimiters -> Maybe TokSymbol
delimOpen  (LayoutDelimiters -> Maybe TokSymbol)
-> ((TokSymbol, LayoutDelimiters) -> LayoutDelimiters)
-> (TokSymbol, LayoutDelimiters)
-> Maybe TokSymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TokSymbol, LayoutDelimiters) -> LayoutDelimiters
forall a b. (a, b) -> b
snd) [(TokSymbol, LayoutDelimiters)]
layoutWords
layoutClose :: [TokSymbol]
layoutClose = [TokSymbol] -> [TokSymbol]
forall a. Eq a => [a] -> [a]
List.nub ([TokSymbol] -> [TokSymbol]) -> [TokSymbol] -> [TokSymbol]
forall a b. (a -> b) -> a -> b
$ ((TokSymbol, LayoutDelimiters) -> Maybe TokSymbol)
-> [(TokSymbol, LayoutDelimiters)] -> [TokSymbol]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LayoutDelimiters -> Maybe TokSymbol
delimClose (LayoutDelimiters -> Maybe TokSymbol)
-> ((TokSymbol, LayoutDelimiters) -> LayoutDelimiters)
-> (TokSymbol, LayoutDelimiters)
-> Maybe TokSymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TokSymbol, LayoutDelimiters) -> LayoutDelimiters
forall a b. (a, b) -> b
snd) [(TokSymbol, LayoutDelimiters)]
layoutWords
layoutSep :: [TokSymbol]
layoutSep   = [TokSymbol] -> [TokSymbol]
forall a. Eq a => [a] -> [a]
List.nub ([TokSymbol] -> [TokSymbol]) -> [TokSymbol] -> [TokSymbol]
forall a b. (a -> b) -> a -> b
$ String -> Line -> TokSymbol
TokSymbol String
";" Line
32 TokSymbol -> [TokSymbol] -> [TokSymbol]
forall a. a -> [a] -> [a]
: ((TokSymbol, LayoutDelimiters) -> TokSymbol)
-> [(TokSymbol, LayoutDelimiters)] -> [TokSymbol]
forall a b. (a -> b) -> [a] -> [b]
map (LayoutDelimiters -> TokSymbol
delimSep (LayoutDelimiters -> TokSymbol)
-> ((TokSymbol, LayoutDelimiters) -> LayoutDelimiters)
-> (TokSymbol, LayoutDelimiters)
-> TokSymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TokSymbol, LayoutDelimiters) -> LayoutDelimiters
forall a b. (a, b) -> b
snd) [(TokSymbol, LayoutDelimiters)]
layoutWords

parenOpen, parenClose :: [TokSymbol]
parenOpen :: [TokSymbol]
parenOpen  =
  [ String -> Line -> TokSymbol
TokSymbol String
"(" Line
16
  , String -> Line -> TokSymbol
TokSymbol String
"[" Line
46
  ]
parenClose :: [TokSymbol]
parenClose =
  [ String -> Line -> TokSymbol
TokSymbol String
")" Line
17
  , String -> Line -> TokSymbol
TokSymbol String
"]" Line
49
  ]

-- | Report an error during layout resolution.
layoutError
   :: [Token]  -- ^ Remaining tokens.
   -> String   -- ^ Error message.
   -> a
layoutError :: forall a. [Token] -> String -> a
layoutError [Token]
ts String
msg
  | [Token] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
ts   = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Layout error: ", String
msg, String
"." ]
  | Bool
otherwise = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
      [ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Layout error at ", [Token] -> String
tokenPos [Token]
ts, String
": ", String
msg, String
"." ]
      , [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
         [ [ String
"Remaining tokens:" ]
         , (Token -> String) -> [Token] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Token -> String
prToken ([Token] -> [String]) -> [Token] -> [String]
forall a b. (a -> b) -> a -> b
$ Line -> [Token] -> [Token]
forall a. Line -> [a] -> [a]
take Line
10 [Token]
ts
         , [ String
"..." | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Token] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Token] -> Bool) -> [Token] -> Bool
forall a b. (a -> b) -> a -> b
$ Line -> [Token] -> [Token]
forall a. Line -> [a] -> [a]
drop Line
10 [Token]
ts ]
         ]
      ]

-- | Replace layout syntax with explicit layout tokens.
resolveLayout
  :: Bool      -- ^ Whether to use top-level layout.
  -> [Token]   -- ^ Token stream before layout resolution.
  -> [Token]   -- ^ Token stream after layout resolution.
resolveLayout :: Bool -> [Token] -> [Token]
resolveLayout Bool
topLayout =
  Maybe Token -> [Block] -> [Token] -> [Token]
res Maybe Token
forall a. Maybe a
Nothing [if Bool
topLayout then LayoutDelimiters -> Status -> Line -> Block
Implicit LayoutDelimiters
topDelim Status
Definitive Line
1 else Block
Explicit]
  where
  topDelim :: LayoutDelimiters
  topDelim :: LayoutDelimiters
topDelim = TokSymbol -> Maybe TokSymbol -> Maybe TokSymbol -> LayoutDelimiters
LayoutDelimiters (String -> Line -> TokSymbol
TokSymbol String
";" Line
32) Maybe TokSymbol
forall a. Maybe a
Nothing Maybe TokSymbol
forall a. Maybe a
Nothing

  res :: Maybe Token -- ^ The previous token, if any.
      -> [Block]     -- ^ A stack of layout blocks.
      -> [Token] -> [Token]

  -- The stack should never be empty.
  res :: Maybe Token -> [Block] -> [Token] -> [Token]
res Maybe Token
_ [] [Token]
ts = [Token] -> String -> [Token]
forall a. [Token] -> String -> a
layoutError [Token]
ts String
"layout stack empty"

  -- Handling explicit blocks:
  res Maybe Token
_ [Block]
st (Token
t0 : [Token]
ts)
    -- We found an open brace in the input,
    -- put an explicit layout block on the stack.
    -- This is done even if there was no layout word,
    -- to keep opening and closing braces.
    | Token -> Bool
isLayoutOpen Token
t0 Bool -> Bool -> Bool
|| Token -> Bool
isParenOpen Token
t0
      = Token
t0 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Maybe Token -> [Block] -> [Token] -> [Token]
res (Token -> Maybe Token
forall a. a -> Maybe a
Just Token
t0) (Block
Explicit Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
st) [Token]
ts

    -- If we encounter a closing brace, exit the first explicit layout block.
    | Token -> Bool
isLayoutClose Token
t0 Bool -> Bool -> Bool
|| Token -> Bool
isParenClose Token
t0
      , let ([Block]
imps, [Block]
rest) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Block -> Bool
isImplicit [Block]
st
      , let st' :: [Block]
st' = Line -> [Block] -> [Block]
forall a. Line -> [a] -> [a]
drop Line
1 [Block]
rest
      = if [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
st'
        then [Token] -> String -> [Token]
forall a. [Token] -> String -> a
layoutError [Token]
ts (String -> [Token]) -> String -> [Token]
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
          [ String
"found", Token -> String
prToken Token
t0, String
"at" , [Token] -> String
tokenPos [Token
t0]
          , String
"without an explicit layout block"
          ]
        else (Block -> Token) -> [Block] -> [Token]
forall a b. (a -> b) -> [a] -> [b]
map ([Token] -> Position -> Block -> Token
closingToken [Token]
ts (Token -> Position
tokenPosn Token
t0)) [Block]
imps [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ Token
t0 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Maybe Token -> [Block] -> [Token] -> [Token]
res (Token -> Maybe Token
forall a. a -> Maybe a
Just Token
t0) [Block]
st' [Token]
ts

  -- Ending or confirming implicit layout blocks:
  res Maybe Token
pt (b :: Block
b@(Implicit LayoutDelimiters
delim Status
status Line
col) : [Block]
bs) (Token
t0 : [Token]
ts)

      -- Do not end top-level layout block by layout stop word.
    | Token -> Bool
isStop Token
t0,  Line
col Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
<= Line
1
      = Token
t0 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Maybe Token -> [Block] -> [Token] -> [Token]
res (Token -> Maybe Token
forall a. a -> Maybe a
Just Token
t0) (Block
b Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
bs) [Token]
ts

      -- End of implicit block by a layout stop word.
    | Token -> Bool
isStop Token
t0
           -- Exit the current block and all implicit blocks
           -- more indented than the current token.
      , let ([Block]
ebs, [Block]
st') = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((Token -> Line
column Token
t0 Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
<) (Line -> Bool) -> (Block -> Line) -> Block -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Line
indentation) [Block]
bs
           -- Insert block-closers after the previous token.
      = (Block -> Token) -> [Block] -> [Token]
forall a b. (a -> b) -> [a] -> [b]
map ([Token] -> Position -> Block -> Token
closingToken [Token]
ts (Maybe Token -> Position
afterPrev Maybe Token
pt)) (Block
b Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
ebs) [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ Token
t0 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Maybe Token -> [Block] -> [Token] -> [Token]
res (Token -> Maybe Token
forall a. a -> Maybe a
Just Token
t0) [Block]
st' [Token]
ts

    -- End of an implicit layout block by dedentation.
    | Maybe Token -> Token -> Bool
newLine Maybe Token
pt Token
t0
      , Token -> Line
column Token
t0 Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
< Line
col
           -- Insert a block closer after the previous token.
           -- Repeat, with the current block removed from the stack.
      , let c :: Token
c = [Token] -> Position -> Block -> Token
closingToken [Token]
ts (Maybe Token -> Position
afterPrev Maybe Token
pt) Block
b
      = Token
c Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Maybe Token -> [Block] -> [Token] -> [Token]
res (Token -> Maybe Token
forall a. a -> Maybe a
Just Token
c) [Block]
bs (Token
t0 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
ts)

    -- If we are on a newline, confirm the last tentative blocks.
    | Maybe Token -> Token -> Bool
newLine Maybe Token
pt Token
t0, Tentative{} <- Status
status
      = Maybe Token -> [Block] -> [Token] -> [Token]
res Maybe Token
pt (LayoutDelimiters -> Status -> Line -> Block
Implicit LayoutDelimiters
delim Status
Definitive Line
col Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Line -> [Block] -> [Block]
confirm Line
col [Block]
bs) (Token
t0 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
ts)

  -- Starting and processing implicit layout blocks:
  res Maybe Token
pt [Block]
st (Token
t0 : [Token]
ts)
    -- Start a new layout block if the first token is a layout word.
    | Just delim :: LayoutDelimiters
delim@(LayoutDelimiters TokSymbol
_ Maybe TokSymbol
mopen Maybe TokSymbol
_) <- Token -> Maybe LayoutDelimiters
isLayout Token
t0
      = Maybe Token -> Token -> [Block] -> [Token] -> [Token]
maybeInsertSeparator Maybe Token
pt Token
t0 [Block]
st ([Token] -> [Token]) -> [Token] -> [Token]
forall a b. (a -> b) -> a -> b
$
        case [Token]
ts of
          -- Explicit layout, just move on. The next step
          -- will push an explicit layout block.
          Token
t1 : [Token]
_ | Token -> Bool
isLayoutOpen Token
t1 ->
            Token
t0 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Maybe Token -> [Block] -> [Token] -> [Token]
res (Token -> Maybe Token
forall a. a -> Maybe a
Just Token
t0) [Block]
st [Token]
ts
          -- Otherwise, insert an open brace after the layout word
          [Token]
_ ->
            Token
t0 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Token
b Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Maybe Token -> [Block] -> [Token] -> [Token]
res (Token -> Maybe Token
forall a. a -> Maybe a
Just Token
b) (LayoutDelimiters -> Position -> Position -> [Block] -> [Block]
addImplicit LayoutDelimiters
delim (Token -> Position
tokenPosn Token
t0) Position
pos [Block]
st) [Token]
ts
            where
            b :: Token
b   = Position -> TokSymbol -> Token
sToken (Token -> Position
nextPos Token
t0) (TokSymbol -> Token) -> TokSymbol -> Token
forall a b. (a -> b) -> a -> b
$ TokSymbol -> Maybe TokSymbol -> TokSymbol
forall a. a -> Maybe a -> a
fromMaybe TokSymbol
forall a. HasCallStack => a
undefined Maybe TokSymbol
mopen
            -- At the end of the file, the start column does not matter.
            -- So if there is no token t1 after t0, just use the position of t0.
            pos :: Position
pos = Token -> Position
tokenPosn (Token -> Position) -> Token -> Position
forall a b. (a -> b) -> a -> b
$ Token -> Maybe Token -> Token
forall a. a -> Maybe a -> a
fromMaybe Token
t0 (Maybe Token -> Token) -> Maybe Token -> Token
forall a b. (a -> b) -> a -> b
$ [Token] -> Maybe Token
forall a. [a] -> Maybe a
listToMaybe [Token]
ts

    -- Insert separator if necessary.
    | Bool
otherwise
      = Maybe Token -> Token -> [Block] -> [Token] -> [Token]
maybeInsertSeparator Maybe Token
pt Token
t0 [Block]
st ([Token] -> [Token]) -> [Token] -> [Token]
forall a b. (a -> b) -> a -> b
$
        Token
t0 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Maybe Token -> [Block] -> [Token] -> [Token]
res (Token -> Maybe Token
forall a. a -> Maybe a
Just Token
t0) [Block]
st [Token]
ts

  -- At EOF: skip explicit blocks.
  res (Just Token
_) [Block
Explicit]      [] = []
  res (Just Token
t) (Block
Explicit : [Block]
bs) [] = Maybe Token -> [Block] -> [Token] -> [Token]
res (Token -> Maybe Token
forall a. a -> Maybe a
Just Token
t) [Block]
bs []

  -- If we are using top-level layout, insert a semicolon after
  -- the last token, if there isn't one already
  res (Just Token
t) [Implicit (LayoutDelimiters TokSymbol
sep Maybe TokSymbol
_ Maybe TokSymbol
_) Status
_ Line
_] []
    | Token -> Bool
isLayoutSep Token
t = []
    | Bool
otherwise     = [Position -> TokSymbol -> Token
sToken (Token -> Position
nextPos Token
t) TokSymbol
sep]

  -- At EOF in an implicit, non-top-level block: close the block
  res (Just Token
t) (Implicit (LayoutDelimiters TokSymbol
_ Maybe TokSymbol
_ (Just TokSymbol
close)) Status
_ Line
_ : [Block]
bs) []
      = Token
b Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Maybe Token -> [Block] -> [Token] -> [Token]
res (Token -> Maybe Token
forall a. a -> Maybe a
Just Token
b) [Block]
bs []
        where b :: Token
b = Position -> TokSymbol -> Token
sToken (Token -> Position
nextPos Token
t) TokSymbol
close

  -- This should only happen if the input is empty.
  res Maybe Token
Nothing [Block]
_st []
      = []

  -- | Insert a 'layoutSep' if we are on a new line on the current
  --   implicit layout column.
  maybeInsertSeparator
    :: Maybe Token  -- ^ The previous token.
    -> Token        -- ^ The current token.
    -> [Block]      -- ^ The layout stack.
    -> [Token]      -- ^ The result token stream.
    -> [Token]      -- ^ Maybe prepended with a 'layoutSep'.
  maybeInsertSeparator :: Maybe Token -> Token -> [Block] -> [Token] -> [Token]
maybeInsertSeparator Maybe Token
pt Token
t0 = \case
    Implicit (LayoutDelimiters TokSymbol
sep Maybe TokSymbol
_ Maybe TokSymbol
_) Status
_ Line
n : [Block]
_
      | Maybe Token -> Token -> Bool
newLine Maybe Token
pt Token
t0
      , Token -> Line
column Token
t0 Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
== Line
n
      , Bool -> (Token -> Bool) -> Maybe Token -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> Bool
not (Bool -> Bool) -> (Token -> Bool) -> Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TokSymbol] -> Token -> Bool
isTokenIn ([TokSymbol]
layoutSep [TokSymbol] -> [TokSymbol] -> [TokSymbol]
forall a. [a] -> [a] -> [a]
++ [TokSymbol]
layoutOpen)) Maybe Token
pt
       -- Insert a semicolon after the previous token
       -- unless we are the beginning of the file,
       -- or the previous token is a semicolon or open brace.
      -> (Position -> TokSymbol -> Token
sToken (Maybe Token -> Position
afterPrev Maybe Token
pt) TokSymbol
sep Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:)
    [Block]
_ -> [Token] -> [Token]
forall a. a -> a
id

  closingToken :: [Token] -> Position -> Block -> Token
  closingToken :: [Token] -> Position -> Block -> Token
closingToken [Token]
ts Position
pos = Position -> TokSymbol -> Token
sToken Position
pos (TokSymbol -> Token) -> (Block -> TokSymbol) -> Block -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    Implicit (LayoutDelimiters TokSymbol
_ Maybe TokSymbol
_ (Just TokSymbol
sy)) Status
_ Line
_ -> TokSymbol
sy
    Block
_ -> [Token] -> String -> TokSymbol
forall a. [Token] -> String -> a
layoutError [Token]
ts String
"trying to close a top level block"

type Position = Posn
type Line     = Int
type Column   = Int

-- | Entry of the layout stack.
data Block
   = Implicit LayoutDelimiters Status Column
       -- ^ An implicit layout block with its start column.
   | Explicit

-- | Get current indentation.  0 if we are in an explicit block.
indentation :: Block -> Column
indentation :: Block -> Line
indentation = \case
  Implicit LayoutDelimiters
_ Status
_ Line
n -> Line
n
  Block
Explicit -> Line
0

-- | Check if s block is implicit.
isImplicit :: Block -> Bool
isImplicit :: Block -> Bool
isImplicit = \case
  Implicit{} -> Bool
True
  Explicit{} -> Bool
False

data Status
  = Tentative   -- ^ A layout column that has not been confirmed by a line break
  | Definitive  -- ^ A layout column that has been confirmed by a line break.

-- | Add a new implicit layout block.
addImplicit
  :: LayoutDelimiters -- ^ Delimiters of the new block.
  -> Position         -- ^ Position of the layout keyword.
  -> Position         -- ^ Position of the token following the layout keword.
  -> [Block]
  -> [Block]
addImplicit :: LayoutDelimiters -> Position -> Position -> [Block] -> [Block]
addImplicit LayoutDelimiters
delim (Pn Line
_ Line
l0 Line
_) (Pn Line
_ Line
l1 Line
c1) [Block]
st
    -- Case: layout keyword was at the end of the line:
    -- New implicit block is definitive.
    | Line
l1 Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
> Line
l0   = LayoutDelimiters -> Status -> Line -> Block
Implicit LayoutDelimiters
delim Status
Definitive ([Block] -> Line
col [Block]
st') Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
st'
    -- Case: staying on the same line:
    -- New implicit block is tentative.
    | Bool
otherwise = LayoutDelimiters -> Status -> Line -> Block
Implicit LayoutDelimiters
delim Status
Tentative ([Block] -> Line
col [Block]
st) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
st
  where
  st' :: [Block]
st' = Line -> [Block] -> [Block]
confirm Line
c1 [Block]
st
  col :: [Block] -> Line
col [Block]
bs = Line -> Line -> Line
forall a. Ord a => a -> a -> a
max Line
c1 (Line -> Line) -> Line -> Line
forall a b. (a -> b) -> a -> b
$ Line
1 Line -> Line -> Line
forall a. Num a => a -> a -> a
+ [Block] -> Line
definiteIndentation [Block]
bs
    -- The column of the next token determines the starting column
    -- of the implicit layout block.
    -- However, the next block needs to be strictly more indented
    -- than the previous block.

  -- | Get the current confirmed indentation level.
  definiteIndentation :: [Block] -> Int
  definiteIndentation :: [Block] -> Line
definiteIndentation [Block]
bs =
    case (Block -> Bool) -> [Block] -> [Block]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Block -> Bool
isTentative [Block]
bs of
      Implicit LayoutDelimiters
_ Status
Definitive Line
n : [Block]
_ -> Line
n
      [Block]
_ -> Line
0  -- 0 enables a first unindented block, see 194_layout/good05.in

  isTentative :: Block -> Bool
  isTentative :: Block -> Bool
isTentative = \case
    Implicit LayoutDelimiters
_ Status
Tentative Line
_ -> Bool
True
    Block
_ -> Bool
False

-- | Confirm tentative blocks that are not more indented than @col@.
confirm :: Column -> [Block] -> [Block]
confirm :: Line -> [Block] -> [Block]
confirm Line
c0 = [Block] -> [Block]
loop
  where
  loop :: [Block] -> [Block]
loop = \case
    Implicit LayoutDelimiters
delim Status
Tentative Line
c : [Block]
bs
      | Line
c Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
<= Line
c0 -> LayoutDelimiters -> Status -> Line -> Block
Implicit LayoutDelimiters
delim Status
Definitive Line
c Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
loop [Block]
bs
    [Block]
bs -> [Block]
bs

-- | Get the position immediately to the right of the given token.
--   If no token is given, gets the first position in the file.
afterPrev :: Maybe Token -> Position
afterPrev :: Maybe Token -> Position
afterPrev = Position -> (Token -> Position) -> Maybe Token -> Position
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Line -> Line -> Line -> Position
Pn Line
0 Line
1 Line
1) Token -> Position
nextPos

-- | Get the position immediately to the right of the given token.
nextPos :: Token -> Position
nextPos :: Token -> Position
nextPos Token
t = Line -> Line -> Line -> Position
Pn (Line
g Line -> Line -> Line
forall a. Num a => a -> a -> a
+ Line
s) Line
l (Line
c Line -> Line -> Line
forall a. Num a => a -> a -> a
+ Line
s Line -> Line -> Line
forall a. Num a => a -> a -> a
+ Line
1)
  where
  Pn Line
g Line
l Line
c = Token -> Position
tokenPosn Token
t
  s :: Line
s        = Token -> Line
tokenLength Token
t

-- | Get the number of characters in the token.
tokenLength :: Token -> Int
tokenLength :: Token -> Line
tokenLength = String -> Line
forall a. [a] -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
length (String -> Line) -> (Token -> String) -> Token -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> String
prToken

-- | Create a position symbol token.
sToken :: Position -> TokSymbol -> Token
sToken :: Position -> TokSymbol -> Token
sToken Position
p TokSymbol
t = Position -> Tok -> Token
PT Position
p (Tok -> Token) -> Tok -> Token
forall a b. (a -> b) -> a -> b
$ TokSymbol -> Tok
TK TokSymbol
t

-- | Get the line number of a token.
line :: Token -> Line
line :: Token -> Line
line = (Line, Line) -> Line
forall a b. (a, b) -> a
fst ((Line, Line) -> Line) -> (Token -> (Line, Line)) -> Token -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> (Line, Line)
tokenLineCol

-- | Get the column number of a token.
column :: Token -> Column
column :: Token -> Line
column = (Line, Line) -> Line
forall a b. (a, b) -> b
snd ((Line, Line) -> Line) -> (Token -> (Line, Line)) -> Token -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> (Line, Line)
tokenLineCol

-- | Is the following token on a new line?
newLine :: Maybe Token -> Token -> Bool
newLine :: Maybe Token -> Token -> Bool
newLine Maybe Token
pt Token
t0 = Bool -> (Token -> Bool) -> Maybe Token -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((Token -> Line
line Token
t0 Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
>) (Line -> Bool) -> (Token -> Line) -> Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Line
line) Maybe Token
pt

-- | Check if a word is a layout start token.
isLayout :: Token -> Maybe LayoutDelimiters
isLayout :: Token -> Maybe LayoutDelimiters
isLayout = \case
  PT Position
_ (TK TokSymbol
t) -> TokSymbol
-> [(TokSymbol, LayoutDelimiters)] -> Maybe LayoutDelimiters
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup TokSymbol
t [(TokSymbol, LayoutDelimiters)]
layoutWords
  Token
_ -> Maybe LayoutDelimiters
forall a. Maybe a
Nothing

-- | Check if a token is one of the given symbols.
isTokenIn :: [TokSymbol] -> Token -> Bool
isTokenIn :: [TokSymbol] -> Token -> Bool
isTokenIn [TokSymbol]
ts = \case
  PT Position
_ (TK TokSymbol
t) -> TokSymbol
t TokSymbol -> [TokSymbol] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TokSymbol]
ts
  Token
_ -> Bool
False

-- | Check if a token is a layout stop token.
isStop :: Token -> Bool
isStop :: Token -> Bool
isStop = [TokSymbol] -> Token -> Bool
isTokenIn [TokSymbol]
layoutStopWords

-- | Check if a token is the layout open token.
isLayoutOpen :: Token -> Bool
isLayoutOpen :: Token -> Bool
isLayoutOpen = [TokSymbol] -> Token -> Bool
isTokenIn [TokSymbol]
layoutOpen

-- | Check if a token is the layout separator token.
isLayoutSep :: Token -> Bool
isLayoutSep :: Token -> Bool
isLayoutSep = [TokSymbol] -> Token -> Bool
isTokenIn [TokSymbol]
layoutSep

-- | Check if a token is the layout close token.
isLayoutClose :: Token -> Bool
isLayoutClose :: Token -> Bool
isLayoutClose = [TokSymbol] -> Token -> Bool
isTokenIn [TokSymbol]
layoutClose

-- | Check if a token is an opening parenthesis.
isParenOpen :: Token -> Bool
isParenOpen :: Token -> Bool
isParenOpen = [TokSymbol] -> Token -> Bool
isTokenIn [TokSymbol]
parenOpen

-- | Check if a token is a closing parenthesis.
isParenClose :: Token -> Bool
isParenClose :: Token -> Bool
isParenClose = [TokSymbol] -> Token -> Bool
isTokenIn [TokSymbol]
parenClose