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
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)
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
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
((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)
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
((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)
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)
_ ->
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)
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)
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
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
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
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
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
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
_) =
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
(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
(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
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