-- |
-- ## High-Level Summary
--
-- This section provides a high-level summary of this file. For those who
-- know more about compiler-development, the below explanation is likely enough.
-- For everyone else, see the next section.
--
-- The parser itself is unaware of indentation, and instead only parses explicit
-- delimiters which are inserted by this layout algorithm (much like Haskell).
-- This is convenient because the actual grammar can be specified apart from the
-- indentation rules. Haskell has a few problematic productions which make it
-- impossible to implement a purely lexical layout algorithm, so it also has an
-- additional (and somewhat contentious) parser error side condition. PureScript
-- does not have these problematic productions (particularly foo, bar ::
-- SomeType syntax in declarations), but it does have a few gotchas of it's own.
-- The algorithm is "non-trivial" to say the least, but it is implemented as a
-- purely lexical delimiter parser on a token-by-token basis, which is highly
-- convenient, since it can be replicated in any language or toolchain. There is
-- likely room to simplify it, but there are some seemingly innocuous things
-- that complicate it.
--
-- "Naked" commas (case, patterns, guards, fundeps) are a constant source of
-- complexity, and indeed too much of this is what prevents Haskell from having
-- such an algorithm. Unquoted properties for layout keywords introduce a domino
-- effect of complexity since we have to mask and unmask any usage of . (also in
-- foralls!) or labels in record literals.
--
-- ## Detailed Summary
--
-- ### The Problem
--
-- The parser itself is unaware of indentation or other such layout concerns.
-- Rather than dealing with it explicitly, the parser and its
-- grammar rules are only aware of normal tokens (e.g. @TokLowerName@) and
-- three special zero-width tokens, @TokLayoutStart@, @TokLayoutSep@,
-- and @TokLayoutEnd@. This is convenient because the actual grammar
-- can be specified apart from the indentation rules and other such
-- layout concerns.
--
-- For a simple example, the parser parses all three examples of the code below
-- using the exact same grammar rules for the @let@ keyword despite
-- each example using different indentations levels:
--
-- @
-- -- Example 1
-- let foo = 5
--     x = 2 in foo
--
-- -- Example 2
-- let
--   bar = 5
--   y = 2
-- in bar
--
-- -- Example 3
-- let        baz
--                  =
--              5
--            z= 2 in baz
-- @
--
-- Each block of code might appear to the parser as a stream of the
-- following source tokens where the @\{@ sequence represents
-- @TokLayoutStart@, the @\;@ sequence represents @TokLayoutSep@,
-- and the @\}@ sequence represents @TokLayoutEnd@:
-- - @let \{foo = 5\;x = 2\} in foo@
-- - @let \{bar = 5\;y = 2\} in bar@
-- - @let \{baz = 5\;z = 2\} in baz@
--
--
-- For a more complex example, consider commas:
--
-- @
-- case one, { twoA, twoB }, [ three1
--    , three2
--    ,   do
--      { three3, three4 } <- case arg1, arg2 of
--         Nothing, _ -> { three3: 1, three4: 2 }
--         Just _, Nothing -> { three3: 2, three4: 3 }
--         _, _ -> { three3: 3, three4: 4 }
--      pure $ three3 + three4
--    ] of
-- @
--
-- Which of the above 13 commas function as the separators between the
-- case binders (e.g. @one@) in the outermost @case ... of@ context?
--
-- ### The Solution
--
-- The parser doesn't have to care about layout concerns (e.g. indentation
-- or what starts and ends a context, such as a case binder) because the
-- lexer solves that problem instead.
--
-- So, how does the lexer solve this problem? It follows this general algorithm:
-- 1. Lex the source code text into an initial stream of `SourceToken`s
--    that do not have any of the three special tokens mentioned previously.
-- 2. On a token-by-token basis, determine whether the lexer should
--        1. insert one of the three special tokens,
--        2. modify the current context (e.g. are we within a case binder?
--           Are we in a record expression?)
--
-- Step 2 is handled via 'insertLayout' and is essentially a state machine.
-- The layout delimiters, (e.g. 'LytCase', 'LytBrace', 'LytProperty',
-- and 'LytOf' in the next section's example) either stop certain "rules"
-- from applying or ensure that certain "rules" now apply. By "rules",
-- we mean whether and where one of the three special tokens are added.
-- The comments in the source code for the 'insertLayout' algorithm call
-- pushing these delimiters onto the stack "masking" and popping them off
-- as "unmasking". Seeing when a layout delimiter is pushed and popped
-- are the keys to understanding this algorithm.
--
-- ### Walking Through an Example
--
-- Before showing an example, let's remember a few things.
--   1. The @TokLowerName "case"@ token (i.e. a "case" keyword) indicates the start
--      of a @case ... of@ context. That context includes case binders (like the
--      example shown previously) that can get quite complex. When encountered,
--      we may need to insert one or more of the three special tokens here
--      until we encounter the terminating @TokLowerName "of"@ token that
--      signifies its end.
--   2. "case" and "of" can also appear as a record field's name. In such a context,
--      they would not start or end a @case ... of@ block.
--
-- Given the below source code...
--
-- @
-- case { case: "foo", of: "bar" } of
-- @
--
-- the lexer would go through something like the following states:
-- 1. Encountered @TokLowerName "case"@. Update current context to
--    "within a case of expression" by pushing the 'LytCase' delimiter
--    onto the layout delimiter stack. Insert the @case@ token
--    into the stream of source tokens.
-- 2. Encountered @TokLeftBrace@. Update current context to
--    "within a record expression" by pushing the 'LytBrace' delimiter.
--    Since we expect a field name to be the next token we see,
--    which may include a reserved keyword, update the current context again to
--    "expecting a field name" by pushing the `LytProperty`.
--    delimiter. Insert the @{@ token into the stream of source tokens.
-- 3. Encountered @TokLowerName "case"@. Check the current context.
--    Since it's a `LytProperty`, this is a field name and we shouldn't
--    assume that the next few tokens will be case binders. However,
--    since this might be a record with no more fields, update the
--    current context back to "within a record expression" by popping
--    the `LytProperty` off the layout delimiter stack. Insert the @case@ token
-- 4. Encountered @TokColon@. Insert the @:@ token
-- 5. Encountered @TokLowerName "foo"@. Insert the @foo@ token.
-- 6. Encountered @TokComma@. Check the current context. Since it's a `LytBrace`,
--    we're in a record expression and there is another field. Update the
--    current context by pushing `LytProperty` as we expect a field name again.
-- 7. Encountered @TokLowerName "of"@. Check the current context.
--    Since it's a `LytProperty`, this is a field name rather
--    than the end of a case binder. Thus, we don't expect the next tokens
--    to be the @body@ in a @case ... of body@ expression. However, since
--    this might be a record with no more fields, update the current context
--    back to "within a record expression" by popping the `LytProperty`
--    off the stack. Insert the @of@ token.
-- 8. Encountered @TokRightBrace@. Check the current context.
--    Since it's a `LytBrace`, this is the end of a record expression.
--    Update the current context to "within a case of expression"
--    by popping the `LytBrace` off the stack. Insert the @}@ token.
-- 9. Encountered @TokLowername "of"@. Check the current context.
--    Since it's a 'LytCase', this is the end of a @case ... of@ expression
--    and the body will follow. Update the current context to
--    "body of a case of expression" by pushing 'LytOf' onto the layout stack.
--    Insert the @of@ token into the stream of tokens.
--
module Language.PureScript.CST.Layout where

import Prelude

import Data.DList (snoc)
import Data.DList qualified as DList
import Data.Foldable (find)
import Data.Function ((&))
import Language.PureScript.CST.Types (Comment, LineFeed, SourcePos(..), SourceRange(..), SourceToken(..), Token(..), TokenAnn(..))

type LayoutStack = [(SourcePos, LayoutDelim)]

data LayoutDelim
  = LytRoot
  | LytTopDecl
  | LytTopDeclHead
  | LytDeclGuard
  | LytCase
  | LytCaseBinders
  | LytCaseGuard
  | LytLambdaBinders
  | LytParen
  | LytBrace
  | LytSquare
  | LytIf
  | LytThen
  | LytProperty
  | LytForall
  | LytTick
  | LytLet
  | LytLetStmt
  | LytWhere
  | LytOf
  | LytDo
  | LytAdo
  deriving (Int -> LayoutDelim -> ShowS
[LayoutDelim] -> ShowS
LayoutDelim -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayoutDelim] -> ShowS
$cshowList :: [LayoutDelim] -> ShowS
show :: LayoutDelim -> String
$cshow :: LayoutDelim -> String
showsPrec :: Int -> LayoutDelim -> ShowS
$cshowsPrec :: Int -> LayoutDelim -> ShowS
Show, LayoutDelim -> LayoutDelim -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayoutDelim -> LayoutDelim -> Bool
$c/= :: LayoutDelim -> LayoutDelim -> Bool
== :: LayoutDelim -> LayoutDelim -> Bool
$c== :: LayoutDelim -> LayoutDelim -> Bool
Eq, Eq LayoutDelim
LayoutDelim -> LayoutDelim -> Bool
LayoutDelim -> LayoutDelim -> Ordering
LayoutDelim -> LayoutDelim -> LayoutDelim
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
min :: LayoutDelim -> LayoutDelim -> LayoutDelim
$cmin :: LayoutDelim -> LayoutDelim -> LayoutDelim
max :: LayoutDelim -> LayoutDelim -> LayoutDelim
$cmax :: LayoutDelim -> LayoutDelim -> LayoutDelim
>= :: LayoutDelim -> LayoutDelim -> Bool
$c>= :: LayoutDelim -> LayoutDelim -> Bool
> :: LayoutDelim -> LayoutDelim -> Bool
$c> :: LayoutDelim -> LayoutDelim -> Bool
<= :: LayoutDelim -> LayoutDelim -> Bool
$c<= :: LayoutDelim -> LayoutDelim -> Bool
< :: LayoutDelim -> LayoutDelim -> Bool
$c< :: LayoutDelim -> LayoutDelim -> Bool
compare :: LayoutDelim -> LayoutDelim -> Ordering
$ccompare :: LayoutDelim -> LayoutDelim -> Ordering
Ord)

isIndented :: LayoutDelim -> Bool
isIndented :: LayoutDelim -> Bool
isIndented = \case
  LayoutDelim
LytLet     -> Bool
True
  LayoutDelim
LytLetStmt -> Bool
True
  LayoutDelim
LytWhere   -> Bool
True
  LayoutDelim
LytOf      -> Bool
True
  LayoutDelim
LytDo      -> Bool
True
  LayoutDelim
LytAdo     -> Bool
True
  LayoutDelim
_          -> Bool
False

isTopDecl :: SourcePos -> LayoutStack -> Bool
isTopDecl :: SourcePos -> LayoutStack -> Bool
isTopDecl SourcePos
tokPos = \case
  [(SourcePos
lytPos, LayoutDelim
LytWhere), (SourcePos
_, LayoutDelim
LytRoot)]
    | SourcePos -> Int
srcColumn SourcePos
tokPos forall a. Eq a => a -> a -> Bool
== SourcePos -> Int
srcColumn SourcePos
lytPos -> Bool
True
  LayoutStack
_ -> Bool
False

lytToken :: SourcePos -> Token -> SourceToken
lytToken :: SourcePos -> Token -> SourceToken
lytToken SourcePos
pos = TokenAnn -> Token -> SourceToken
SourceToken TokenAnn
ann
  where
  ann :: TokenAnn
ann = TokenAnn
    { tokRange :: SourceRange
tokRange = SourcePos -> SourcePos -> SourceRange
SourceRange SourcePos
pos SourcePos
pos
    , tokLeadingComments :: [Comment LineFeed]
tokLeadingComments = []
    , tokTrailingComments :: [Comment Void]
tokTrailingComments = []
    }

insertLayout :: SourceToken -> SourcePos -> LayoutStack -> (LayoutStack, [SourceToken])
insertLayout :: SourceToken
-> SourcePos -> LayoutStack -> (LayoutStack, [SourceToken])
insertLayout src :: SourceToken
src@(SourceToken TokenAnn
tokAnn Token
tok) SourcePos
nextPos LayoutStack
stack =
  forall a. DList a -> [a]
DList.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insert (LayoutStack
stack, forall a. Monoid a => a
mempty)
  where
  tokPos :: SourcePos
tokPos =
    SourceRange -> SourcePos
srcStart forall a b. (a -> b) -> a -> b
$ TokenAnn -> SourceRange
tokRange TokenAnn
tokAnn

  insert :: (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insert state :: (LayoutStack, DList SourceToken)
state@(LayoutStack
stk, DList SourceToken
acc) = case Token
tok of
    -- `data` declarations need masking (LytTopDecl) because the usage of `|`
    -- should not introduce a LytDeclGard context.
    TokLowerName [] Text
"data" ->
      case (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertDefault of
        state' :: (LayoutStack, DList SourceToken)
state'@(LayoutStack
stk', DList SourceToken
_) | SourcePos -> LayoutStack -> Bool
isTopDecl SourcePos
tokPos LayoutStack
stk' ->
          (LayoutStack, DList SourceToken)
state' forall a b. a -> (a -> b) -> b
& forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytTopDecl
        (LayoutStack, DList SourceToken)
state' ->
          (LayoutStack, DList SourceToken)
state' forall a b. a -> (a -> b) -> b
& forall {t} {a} {b}. (t -> Bool) -> ([(a, t)], b) -> ([(a, t)], b)
popStack (forall a. Eq a => a -> a -> Bool
== LayoutDelim
LytProperty)

    -- `class` declaration heads need masking (LytTopDeclHead) because the
    -- usage of commas in functional dependencies.
    TokLowerName [] Text
"class" ->
      case (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertDefault of
        state' :: (LayoutStack, DList SourceToken)
state'@(LayoutStack
stk', DList SourceToken
_) | SourcePos -> LayoutStack -> Bool
isTopDecl SourcePos
tokPos LayoutStack
stk' ->
          (LayoutStack, DList SourceToken)
state' forall a b. a -> (a -> b) -> b
& forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytTopDeclHead
        (LayoutStack, DList SourceToken)
state' ->
          (LayoutStack, DList SourceToken)
state' forall a b. a -> (a -> b) -> b
& forall {t} {a} {b}. (t -> Bool) -> ([(a, t)], b) -> ([(a, t)], b)
popStack (forall a. Eq a => a -> a -> Bool
== LayoutDelim
LytProperty)

    TokLowerName [] Text
"where" ->
      case LayoutStack
stk of
        (SourcePos
_, LayoutDelim
LytTopDeclHead) : LayoutStack
stk' ->
          (LayoutStack
stk', DList SourceToken
acc) forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src forall a b. a -> (a -> b) -> b
& LayoutDelim
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertStart LayoutDelim
LytWhere
        (SourcePos
_, LayoutDelim
LytProperty) : LayoutStack
stk' ->
          (LayoutStack
stk', DList SourceToken
acc) forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src
        LayoutStack
_ ->
          (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (SourcePos -> LayoutDelim -> Bool)
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
collapse SourcePos -> LayoutDelim -> Bool
whereP forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src forall a b. a -> (a -> b) -> b
& LayoutDelim
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertStart LayoutDelim
LytWhere
      where
      -- `where` always closes do blocks:
      --     example = do do do do foo where foo = ...
      --
      -- `where` closes layout contexts even when indented at the same level:
      --     example = case
      --       Foo -> ...
      --       Bar -> ...
      --       where foo = ...
      whereP :: SourcePos -> LayoutDelim -> Bool
whereP SourcePos
_      LayoutDelim
LytDo = Bool
True
      whereP SourcePos
lytPos LayoutDelim
lyt   = SourcePos -> LayoutDelim -> Bool
offsideEndP SourcePos
lytPos LayoutDelim
lyt

    TokLowerName [] Text
"in" ->
      case (SourcePos -> LayoutDelim -> Bool)
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
collapse forall {p}. p -> LayoutDelim -> Bool
inP (LayoutStack, DList SourceToken)
state of
        -- `let/in` is not allowed in `ado` syntax. `in` is treated as a
        -- delimiter and must always close the `ado`.
        --    example = ado
        --      foo <- ...
        --      let bar = ...
        --      in ...
        ((SourcePos
_, LayoutDelim
LytLetStmt) : (SourcePos
_, LayoutDelim
LytAdo) : LayoutStack
stk', DList SourceToken
acc') ->
          (LayoutStack
stk', DList SourceToken
acc') forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertEnd forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertEnd forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src
        ((SourcePos
_, LayoutDelim
lyt) : LayoutStack
stk', DList SourceToken
acc') | LayoutDelim -> Bool
isIndented LayoutDelim
lyt ->
          (LayoutStack
stk', DList SourceToken
acc') forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertEnd forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src
        (LayoutStack, DList SourceToken)
_ ->
          (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertDefault forall a b. a -> (a -> b) -> b
& forall {t} {a} {b}. (t -> Bool) -> ([(a, t)], b) -> ([(a, t)], b)
popStack (forall a. Eq a => a -> a -> Bool
== LayoutDelim
LytProperty)
      where
      inP :: p -> LayoutDelim -> Bool
inP p
_ LayoutDelim
LytLet = Bool
False
      inP p
_ LayoutDelim
LytAdo = Bool
False
      inP p
_ LayoutDelim
lyt    = LayoutDelim -> Bool
isIndented LayoutDelim
lyt

    TokLowerName [] Text
"let" ->
      (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& ((LayoutStack, DList SourceToken)
 -> (LayoutStack, DList SourceToken))
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertKwProperty (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
next
      where
      next :: (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
next state' :: (LayoutStack, DList SourceToken)
state'@(LayoutStack
stk', DList SourceToken
_) = case LayoutStack
stk' of
        (SourcePos
p, LayoutDelim
LytDo) : LayoutStack
_ | SourcePos -> Int
srcColumn SourcePos
p forall a. Eq a => a -> a -> Bool
== SourcePos -> Int
srcColumn SourcePos
tokPos ->
          (LayoutStack, DList SourceToken)
state' forall a b. a -> (a -> b) -> b
& LayoutDelim
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertStart LayoutDelim
LytLetStmt
        (SourcePos
p, LayoutDelim
LytAdo) : LayoutStack
_ | SourcePos -> Int
srcColumn SourcePos
p forall a. Eq a => a -> a -> Bool
== SourcePos -> Int
srcColumn SourcePos
tokPos ->
          (LayoutStack, DList SourceToken)
state' forall a b. a -> (a -> b) -> b
& LayoutDelim
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertStart LayoutDelim
LytLetStmt
        LayoutStack
_ ->
          (LayoutStack, DList SourceToken)
state' forall a b. a -> (a -> b) -> b
& LayoutDelim
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertStart LayoutDelim
LytLet

    TokLowerName [Text]
_ Text
"do" ->
      (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& ((LayoutStack, DList SourceToken)
 -> (LayoutStack, DList SourceToken))
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertKwProperty (LayoutDelim
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertStart LayoutDelim
LytDo)

    TokLowerName [Text]
_ Text
"ado" ->
      (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& ((LayoutStack, DList SourceToken)
 -> (LayoutStack, DList SourceToken))
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertKwProperty (LayoutDelim
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertStart LayoutDelim
LytAdo)

    -- `case` heads need masking due to commas.
    TokLowerName [] Text
"case" ->
      (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& ((LayoutStack, DList SourceToken)
 -> (LayoutStack, DList SourceToken))
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertKwProperty (forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytCase)

    TokLowerName [] Text
"of" ->
      case (SourcePos -> LayoutDelim -> Bool)
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
collapse forall {p}. p -> LayoutDelim -> Bool
indentedP (LayoutStack, DList SourceToken)
state of
        -- When `of` is matched with a `case`, we are in a case block, and we
        -- need to mask additional contexts (LytCaseBinders, LytCaseGuards)
        -- due to commas.
        ((SourcePos
_, LayoutDelim
LytCase) : LayoutStack
stk', DList SourceToken
acc') ->
          (LayoutStack
stk', DList SourceToken
acc') forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src forall a b. a -> (a -> b) -> b
& LayoutDelim
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertStart LayoutDelim
LytOf forall a b. a -> (a -> b) -> b
& forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
nextPos LayoutDelim
LytCaseBinders
        (LayoutStack, DList SourceToken)
state' ->
          (LayoutStack, DList SourceToken)
state' forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertDefault forall a b. a -> (a -> b) -> b
& forall {t} {a} {b}. (t -> Bool) -> ([(a, t)], b) -> ([(a, t)], b)
popStack (forall a. Eq a => a -> a -> Bool
== LayoutDelim
LytProperty)

    -- `if/then/else` is considered a delimiter context. This allows us to
    -- write chained expressions in `do` blocks without stair-stepping:
    --     example = do
    --       foo
    --       if ... then
    --         ...
    --       else if ... then
    --         ...
    --       else
    --         ...
    TokLowerName [] Text
"if" ->
      (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& ((LayoutStack, DList SourceToken)
 -> (LayoutStack, DList SourceToken))
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertKwProperty (forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytIf)

    TokLowerName [] Text
"then" ->
      case (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (SourcePos -> LayoutDelim -> Bool)
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
collapse forall {p}. p -> LayoutDelim -> Bool
indentedP of
        ((SourcePos
_, LayoutDelim
LytIf) : LayoutStack
stk', DList SourceToken
acc') ->
          (LayoutStack
stk', DList SourceToken
acc') forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src forall a b. a -> (a -> b) -> b
& forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytThen
        (LayoutStack, DList SourceToken)
_ ->
          (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertDefault forall a b. a -> (a -> b) -> b
& forall {t} {a} {b}. (t -> Bool) -> ([(a, t)], b) -> ([(a, t)], b)
popStack (forall a. Eq a => a -> a -> Bool
== LayoutDelim
LytProperty)

    TokLowerName [] Text
"else" ->
      case (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (SourcePos -> LayoutDelim -> Bool)
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
collapse forall {p}. p -> LayoutDelim -> Bool
indentedP of
        ((SourcePos
_, LayoutDelim
LytThen) : LayoutStack
stk', DList SourceToken
acc') ->
          (LayoutStack
stk', DList SourceToken
acc') forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src
        (LayoutStack, DList SourceToken)
_ ->
          -- We don't want to insert a layout separator for top-level `else` in
          -- instance chains.
          case (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (SourcePos -> LayoutDelim -> Bool)
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
collapse SourcePos -> LayoutDelim -> Bool
offsideP of
            state' :: (LayoutStack, DList SourceToken)
state'@(LayoutStack
stk', DList SourceToken
_) | SourcePos -> LayoutStack -> Bool
isTopDecl SourcePos
tokPos LayoutStack
stk' ->
              (LayoutStack, DList SourceToken)
state' forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src
            (LayoutStack, DList SourceToken)
state' ->
              (LayoutStack, DList SourceToken)
state' forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertSep forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src forall a b. a -> (a -> b) -> b
& forall {t} {a} {b}. (t -> Bool) -> ([(a, t)], b) -> ([(a, t)], b)
popStack (forall a. Eq a => a -> a -> Bool
== LayoutDelim
LytProperty)

    -- `forall` binders need masking because the usage of `.` should not
    -- introduce a LytProperty context.
    TokForall SourceStyle
_ ->
      (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& ((LayoutStack, DList SourceToken)
 -> (LayoutStack, DList SourceToken))
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertKwProperty (forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytForall)

    -- Lambdas need masking because the usage of `->` should not close a
    -- LytDeclGuard or LytCaseGuard context.
    Token
TokBackslash ->
      (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertDefault forall a b. a -> (a -> b) -> b
& forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytLambdaBinders

    TokRightArrow SourceStyle
_ ->
      (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (SourcePos -> LayoutDelim -> Bool)
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
collapse SourcePos -> LayoutDelim -> Bool
arrowP forall a b. a -> (a -> b) -> b
& forall {t} {a} {b}. (t -> Bool) -> ([(a, t)], b) -> ([(a, t)], b)
popStack LayoutDelim -> Bool
guardP forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src
      where
      arrowP :: SourcePos -> LayoutDelim -> Bool
arrowP SourcePos
_      LayoutDelim
LytDo     = Bool
True
      arrowP SourcePos
_      LayoutDelim
LytOf     = Bool
False
      arrowP SourcePos
lytPos LayoutDelim
lyt       = SourcePos -> LayoutDelim -> Bool
offsideEndP SourcePos
lytPos LayoutDelim
lyt

      guardP :: LayoutDelim -> Bool
guardP LayoutDelim
LytCaseBinders   = Bool
True
      guardP LayoutDelim
LytCaseGuard     = Bool
True
      guardP LayoutDelim
LytLambdaBinders = Bool
True
      guardP LayoutDelim
_                = Bool
False

    Token
TokEquals ->
      case (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (SourcePos -> LayoutDelim -> Bool)
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
collapse forall {p}. p -> LayoutDelim -> Bool
equalsP of
        ((SourcePos
_, LayoutDelim
LytDeclGuard) : LayoutStack
stk', DList SourceToken
acc') ->
          (LayoutStack
stk', DList SourceToken
acc') forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src
        (LayoutStack, DList SourceToken)
_ ->
          (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertDefault
      where
      equalsP :: p -> LayoutDelim -> Bool
equalsP p
_ LayoutDelim
LytWhere   = Bool
True
      equalsP p
_ LayoutDelim
LytLet     = Bool
True
      equalsP p
_ LayoutDelim
LytLetStmt = Bool
True
      equalsP p
_ LayoutDelim
_          = Bool
False

    -- Guards need masking because of commas.
    Token
TokPipe ->
      case (SourcePos -> LayoutDelim -> Bool)
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
collapse SourcePos -> LayoutDelim -> Bool
offsideEndP (LayoutStack, DList SourceToken)
state of
        state' :: (LayoutStack, DList SourceToken)
state'@((SourcePos
_, LayoutDelim
LytOf) : LayoutStack
_, DList SourceToken
_) ->
          (LayoutStack, DList SourceToken)
state' forall a b. a -> (a -> b) -> b
& forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytCaseGuard forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src
        state' :: (LayoutStack, DList SourceToken)
state'@((SourcePos
_, LayoutDelim
LytLet) : LayoutStack
_, DList SourceToken
_) ->
          (LayoutStack, DList SourceToken)
state' forall a b. a -> (a -> b) -> b
& forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytDeclGuard forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src
        state' :: (LayoutStack, DList SourceToken)
state'@((SourcePos
_, LayoutDelim
LytLetStmt) : LayoutStack
_, DList SourceToken
_) ->
          (LayoutStack, DList SourceToken)
state' forall a b. a -> (a -> b) -> b
& forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytDeclGuard forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src
        state' :: (LayoutStack, DList SourceToken)
state'@((SourcePos
_, LayoutDelim
LytWhere) : LayoutStack
_, DList SourceToken
_) ->
          (LayoutStack, DList SourceToken)
state' forall a b. a -> (a -> b) -> b
& forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytDeclGuard forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src
        (LayoutStack, DList SourceToken)
_ ->
          (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertDefault

    -- Ticks can either start or end an infix expression. We preemptively
    -- collapse all indentation contexts in search of a starting delimiter,
    -- and backtrack if we don't find one.
    Token
TokTick ->
      case (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (SourcePos -> LayoutDelim -> Bool)
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
collapse forall {p}. p -> LayoutDelim -> Bool
indentedP of
        ((SourcePos
_, LayoutDelim
LytTick) : LayoutStack
stk', DList SourceToken
acc') ->
          (LayoutStack
stk', DList SourceToken
acc') forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src
        (LayoutStack, DList SourceToken)
_ ->
          (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (SourcePos -> LayoutDelim -> Bool)
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
collapse SourcePos -> LayoutDelim -> Bool
offsideEndP forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertSep forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src forall a b. a -> (a -> b) -> b
& forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytTick

    -- In general, commas should close all indented contexts.
    --     example = [ do foo
    --                    bar, baz ]
    Token
TokComma ->
      case (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (SourcePos -> LayoutDelim -> Bool)
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
collapse forall {p}. p -> LayoutDelim -> Bool
indentedP of
        -- If we see a LytBrace, then we are in a record type or literal.
        -- Record labels need masking so we can use unquoted keywords as labels
        -- without accidentally littering layout delimiters.
        state' :: (LayoutStack, DList SourceToken)
state'@((SourcePos
_, LayoutDelim
LytBrace) : LayoutStack
_, DList SourceToken
_) ->
          (LayoutStack, DList SourceToken)
state' forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src forall a b. a -> (a -> b) -> b
& forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytProperty
        (LayoutStack, DList SourceToken)
state' ->
          (LayoutStack, DList SourceToken)
state' forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src

    -- TokDot tokens usually entail property access, which need masking so we
    -- can use unquoted keywords as labels.
    Token
TokDot ->
      case (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertDefault of
        ((SourcePos
_, LayoutDelim
LytForall) : LayoutStack
stk', DList SourceToken
acc') ->
          (LayoutStack
stk', DList SourceToken
acc')
        (LayoutStack, DList SourceToken)
state' ->
          (LayoutStack, DList SourceToken)
state' forall a b. a -> (a -> b) -> b
& forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytProperty

    Token
TokLeftParen ->
      (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertDefault forall a b. a -> (a -> b) -> b
& forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytParen

    Token
TokLeftBrace ->
      (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertDefault forall a b. a -> (a -> b) -> b
& forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytBrace forall a b. a -> (a -> b) -> b
& forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytProperty

    Token
TokLeftSquare ->
      (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertDefault forall a b. a -> (a -> b) -> b
& forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytSquare

    Token
TokRightParen ->
      (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (SourcePos -> LayoutDelim -> Bool)
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
collapse forall {p}. p -> LayoutDelim -> Bool
indentedP forall a b. a -> (a -> b) -> b
& forall {t} {a} {b}. (t -> Bool) -> ([(a, t)], b) -> ([(a, t)], b)
popStack (forall a. Eq a => a -> a -> Bool
== LayoutDelim
LytParen) forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src

    Token
TokRightBrace ->
      (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (SourcePos -> LayoutDelim -> Bool)
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
collapse forall {p}. p -> LayoutDelim -> Bool
indentedP forall a b. a -> (a -> b) -> b
& forall {t} {a} {b}. (t -> Bool) -> ([(a, t)], b) -> ([(a, t)], b)
popStack (forall a. Eq a => a -> a -> Bool
== LayoutDelim
LytProperty) forall a b. a -> (a -> b) -> b
& forall {t} {a} {b}. (t -> Bool) -> ([(a, t)], b) -> ([(a, t)], b)
popStack (forall a. Eq a => a -> a -> Bool
== LayoutDelim
LytBrace) forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src

    Token
TokRightSquare ->
      (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (SourcePos -> LayoutDelim -> Bool)
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
collapse forall {p}. p -> LayoutDelim -> Bool
indentedP forall a b. a -> (a -> b) -> b
& forall {t} {a} {b}. (t -> Bool) -> ([(a, t)], b) -> ([(a, t)], b)
popStack (forall a. Eq a => a -> a -> Bool
== LayoutDelim
LytSquare) forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src

    TokString Text
_ PSString
_ ->
      (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertDefault forall a b. a -> (a -> b) -> b
& forall {t} {a} {b}. (t -> Bool) -> ([(a, t)], b) -> ([(a, t)], b)
popStack (forall a. Eq a => a -> a -> Bool
== LayoutDelim
LytProperty)

    TokLowerName [] Text
_ ->
      (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertDefault forall a b. a -> (a -> b) -> b
& forall {t} {a} {b}. (t -> Bool) -> ([(a, t)], b) -> ([(a, t)], b)
popStack (forall a. Eq a => a -> a -> Bool
== LayoutDelim
LytProperty)

    TokOperator [Text]
_ Text
_ ->
      (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (SourcePos -> LayoutDelim -> Bool)
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
collapse SourcePos -> LayoutDelim -> Bool
offsideEndP forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertSep forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src

    Token
_ ->
      (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertDefault

  insertDefault :: (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertDefault (LayoutStack, DList SourceToken)
state =
    (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (SourcePos -> LayoutDelim -> Bool)
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
collapse SourcePos -> LayoutDelim -> Bool
offsideP forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertSep forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
src

  insertStart :: LayoutDelim
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertStart LayoutDelim
lyt state :: (LayoutStack, DList SourceToken)
state@(LayoutStack
stk, DList SourceToken
_) =
    -- We only insert a new layout start when it's going to increase indentation.
    -- This prevents things like the following from parsing:
    --     instance foo :: Foo where
    --     foo = 42
    case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (LayoutDelim -> Bool
isIndented forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) LayoutStack
stk of
      Just (SourcePos
pos, LayoutDelim
_) | SourcePos -> Int
srcColumn SourcePos
nextPos forall a. Ord a => a -> a -> Bool
<= SourcePos -> Int
srcColumn SourcePos
pos -> (LayoutStack, DList SourceToken)
state
      Maybe (SourcePos, LayoutDelim)
_ -> (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
nextPos LayoutDelim
lyt forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken (SourcePos -> Token -> SourceToken
lytToken SourcePos
nextPos Token
TokLayoutStart)

  insertSep :: (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertSep state :: (LayoutStack, DList SourceToken)
state@(LayoutStack
stk, DList SourceToken
acc) = case LayoutStack
stk of
    -- LytTopDecl is closed by a separator.
    (SourcePos
lytPos, LayoutDelim
LytTopDecl) : LayoutStack
stk' | SourcePos -> Bool
sepP SourcePos
lytPos ->
      (LayoutStack
stk', DList SourceToken
acc) forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
sepTok
    -- LytTopDeclHead can be closed by a separator if there is no `where`.
    (SourcePos
lytPos, LayoutDelim
LytTopDeclHead) : LayoutStack
stk' | SourcePos -> Bool
sepP SourcePos
lytPos ->
      (LayoutStack
stk', DList SourceToken
acc) forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
sepTok
    (SourcePos
lytPos, LayoutDelim
lyt) : LayoutStack
_ | SourcePos -> LayoutDelim -> Bool
indentSepP SourcePos
lytPos LayoutDelim
lyt ->
      case LayoutDelim
lyt of
        -- If a separator is inserted in a case block, we need to push an
        -- additional LytCaseBinders context for comma masking.
        LayoutDelim
LytOf -> (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
sepTok forall a b. a -> (a -> b) -> b
& forall {a} {b} {b}. a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack SourcePos
tokPos LayoutDelim
LytCaseBinders
        LayoutDelim
_     -> (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken SourceToken
sepTok
    LayoutStack
_ -> (LayoutStack, DList SourceToken)
state
    where
    sepTok :: SourceToken
sepTok = SourcePos -> Token -> SourceToken
lytToken SourcePos
tokPos Token
TokLayoutSep

  insertKwProperty :: ((LayoutStack, DList SourceToken)
 -> (LayoutStack, DList SourceToken))
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertKwProperty (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
k (LayoutStack, DList SourceToken)
state =
    case (LayoutStack, DList SourceToken)
state forall a b. a -> (a -> b) -> b
& (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertDefault of
      ((SourcePos
_, LayoutDelim
LytProperty) : LayoutStack
stk', DList SourceToken
acc') ->
        (LayoutStack
stk', DList SourceToken
acc')
      (LayoutStack, DList SourceToken)
state' ->
        (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
k (LayoutStack, DList SourceToken)
state'

  insertEnd :: (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
insertEnd =
    forall {a} {a}. a -> (a, DList a) -> (a, DList a)
insertToken (SourcePos -> Token -> SourceToken
lytToken SourcePos
tokPos Token
TokLayoutEnd)

  insertToken :: a -> (a, DList a) -> (a, DList a)
insertToken a
token (a
stk, DList a
acc) =
    (a
stk, DList a
acc forall a. DList a -> a -> DList a
`snoc` a
token)

  pushStack :: a -> b -> ([(a, b)], b) -> ([(a, b)], b)
pushStack a
lytPos b
lyt ([(a, b)]
stk, b
acc) =
    ((a
lytPos, b
lyt) forall a. a -> [a] -> [a]
: [(a, b)]
stk, b
acc)

  popStack :: (t -> Bool) -> ([(a, t)], b) -> ([(a, t)], b)
popStack t -> Bool
p ((a
_, t
lyt) : [(a, t)]
stk', b
acc)
    | t -> Bool
p t
lyt = ([(a, t)]
stk', b
acc)
  popStack t -> Bool
_ ([(a, t)], b)
state = ([(a, t)], b)
state

  collapse :: (SourcePos -> LayoutDelim -> Bool)
-> (LayoutStack, DList SourceToken)
-> (LayoutStack, DList SourceToken)
collapse SourcePos -> LayoutDelim -> Bool
p = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LayoutStack
-> DList SourceToken -> (LayoutStack, DList SourceToken)
go
    where
    go :: LayoutStack
-> DList SourceToken -> (LayoutStack, DList SourceToken)
go ((SourcePos
lytPos, LayoutDelim
lyt) : LayoutStack
stk) DList SourceToken
acc
      | SourcePos -> LayoutDelim -> Bool
p SourcePos
lytPos LayoutDelim
lyt =
          LayoutStack
-> DList SourceToken -> (LayoutStack, DList SourceToken)
go LayoutStack
stk forall a b. (a -> b) -> a -> b
$ if LayoutDelim -> Bool
isIndented LayoutDelim
lyt
                   then DList SourceToken
acc forall a. DList a -> a -> DList a
`snoc` SourcePos -> Token -> SourceToken
lytToken SourcePos
tokPos Token
TokLayoutEnd
                   else DList SourceToken
acc
    go LayoutStack
stk DList SourceToken
acc = (LayoutStack
stk, DList SourceToken
acc)

  indentedP :: b -> LayoutDelim -> Bool
indentedP =
    forall a b. a -> b -> a
const LayoutDelim -> Bool
isIndented

  offsideP :: SourcePos -> LayoutDelim -> Bool
offsideP SourcePos
lytPos LayoutDelim
lyt =
    LayoutDelim -> Bool
isIndented LayoutDelim
lyt Bool -> Bool -> Bool
&& SourcePos -> Int
srcColumn SourcePos
tokPos forall a. Ord a => a -> a -> Bool
< SourcePos -> Int
srcColumn SourcePos
lytPos

  offsideEndP :: SourcePos -> LayoutDelim -> Bool
offsideEndP SourcePos
lytPos LayoutDelim
lyt =
    LayoutDelim -> Bool
isIndented LayoutDelim
lyt Bool -> Bool -> Bool
&& SourcePos -> Int
srcColumn SourcePos
tokPos forall a. Ord a => a -> a -> Bool
<= SourcePos -> Int
srcColumn SourcePos
lytPos

  indentSepP :: SourcePos -> LayoutDelim -> Bool
indentSepP SourcePos
lytPos LayoutDelim
lyt =
    LayoutDelim -> Bool
isIndented LayoutDelim
lyt Bool -> Bool -> Bool
&& SourcePos -> Bool
sepP SourcePos
lytPos

  sepP :: SourcePos -> Bool
sepP SourcePos
lytPos =
    SourcePos -> Int
srcColumn SourcePos
tokPos forall a. Eq a => a -> a -> Bool
== SourcePos -> Int
srcColumn SourcePos
lytPos Bool -> Bool -> Bool
&& SourcePos -> Int
srcLine SourcePos
tokPos forall a. Eq a => a -> a -> Bool
/= SourcePos -> Int
srcLine SourcePos
lytPos

unwindLayout :: SourcePos -> [Comment LineFeed] -> LayoutStack -> [SourceToken]
unwindLayout :: SourcePos -> [Comment LineFeed] -> LayoutStack -> [SourceToken]
unwindLayout SourcePos
pos [Comment LineFeed]
leading = LayoutStack -> [SourceToken]
go
  where
  go :: LayoutStack -> [SourceToken]
go [] = []
  go ((SourcePos
_, LayoutDelim
LytRoot) : LayoutStack
_) = [TokenAnn -> Token -> SourceToken
SourceToken (SourceRange -> [Comment LineFeed] -> [Comment Void] -> TokenAnn
TokenAnn (SourcePos -> SourcePos -> SourceRange
SourceRange SourcePos
pos SourcePos
pos) [Comment LineFeed]
leading []) Token
TokEof]
  go ((SourcePos
_, LayoutDelim
lyt) : LayoutStack
stk) | LayoutDelim -> Bool
isIndented LayoutDelim
lyt = SourcePos -> Token -> SourceToken
lytToken SourcePos
pos Token
TokLayoutEnd forall a. a -> [a] -> [a]
: LayoutStack -> [SourceToken]
go LayoutStack
stk
  go ((SourcePos, LayoutDelim)
_ : LayoutStack
stk) = LayoutStack -> [SourceToken]
go LayoutStack
stk