119 lines
4.4 KiB
Haskell
119 lines
4.4 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
module Language.Haskell.Brittany.Internal.ToBriDoc.Stmt where
|
|
|
|
import qualified Data.Text as Text
|
|
import GHC (GenLocated(L))
|
|
import GHC.Hs
|
|
import Language.Haskell.Brittany.Internal.Config.Types
|
|
import Language.Haskell.Brittany.Internal.S3_ToBriDocTools
|
|
import Language.Haskell.Brittany.Internal.Prelude
|
|
import Language.Haskell.Brittany.Internal.Types
|
|
import Language.Haskell.Brittany.Internal.Components.BriDoc
|
|
|
|
|
|
|
|
layoutStmt :: GuardLStmt GhcPs -> ToBriDocM BriDocNumbered
|
|
layoutStmt lstmt@(L _ stmt) = do
|
|
indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack
|
|
indentAmount :: Int <-
|
|
mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
|
|
case stmt of
|
|
LastStmt NoExtField body Nothing _ -> do
|
|
-- at least the "|" of a monadcomprehension for _some_ reason
|
|
-- is connected to the _body_ of the "result" stmt. So we need
|
|
-- to docHandleListElemComms here..
|
|
docHandleListElemComms (callLayouter layout_expr) body
|
|
BindStmt epAnn lPat expr -> docHandleComms epAnn $ do
|
|
patDoc <- fmap return
|
|
$ callLayouter layout_colsWrapPat =<< callLayouter layout_pat lPat
|
|
expDoc <- shareDoc $ callLayouter layout_expr expr
|
|
docAlt
|
|
[ docCols
|
|
ColBindStmt
|
|
[ appSep patDoc
|
|
, docSeq
|
|
[ appSep $ docLit $ Text.pack "<-"
|
|
, docAddBaseY BrIndentRegular $ docForceParSpacing expDoc
|
|
]
|
|
]
|
|
, docCols
|
|
ColBindStmt
|
|
[ appSep patDoc
|
|
, docAddBaseY BrIndentRegular
|
|
$ docPar (docLit $ Text.pack "<-") (expDoc)
|
|
]
|
|
]
|
|
LetStmt epAnn binds -> docHandleComms epAnn $ do
|
|
let isFree = indentPolicy == IndentPolicyFree
|
|
let indentFourPlus = indentAmount >= 4
|
|
(wrapBinds, bindrDocsMay) <- callLayouter layout_localBinds binds
|
|
case bindrDocsMay of
|
|
Nothing -> docLit $ Text.pack "let"
|
|
-- i just tested the above, and it is indeed allowed. heh.
|
|
Just (_, []) -> docLit $ Text.pack "let" -- this probably never happens
|
|
Just (_, [bindDoc]) -> docAlt
|
|
[ -- let bind = expr
|
|
docCols
|
|
ColDoLet
|
|
[ appSep $ docLit $ Text.pack "let"
|
|
, let
|
|
f = case indentPolicy of
|
|
IndentPolicyFree -> docSetBaseAndIndent
|
|
IndentPolicyLeft -> docForceSingleline
|
|
IndentPolicyMultiple
|
|
| indentFourPlus -> docSetBaseAndIndent
|
|
| otherwise -> docForceSingleline
|
|
in wrapBinds $ f $ return bindDoc
|
|
]
|
|
, -- let
|
|
-- bind = expr
|
|
docAddBaseY BrIndentRegular $ docPar
|
|
(docLit $ Text.pack "let")
|
|
(wrapBinds $ docSetBaseAndIndent $ return bindDoc)
|
|
]
|
|
Just (_, bindDocs) -> runFilteredAlternative $ do
|
|
-- let aaa = expra
|
|
-- bbb = exprb
|
|
-- ccc = exprc
|
|
addAlternativeCond (isFree || indentFourPlus) $ docSeq
|
|
[ appSep $ docLit $ Text.pack "let"
|
|
, let
|
|
f = if indentFourPlus
|
|
then docEnsureIndent BrIndentRegular
|
|
else docSetBaseAndIndent
|
|
in wrapBinds $ f $ docLines $ return <$> bindDocs
|
|
]
|
|
-- let
|
|
-- aaa = expra
|
|
-- bbb = exprb
|
|
-- ccc = exprc
|
|
addAlternativeCond (not indentFourPlus)
|
|
$ docAddBaseY BrIndentRegular
|
|
$ docPar
|
|
(docLit $ Text.pack "let")
|
|
(wrapBinds $ docSetBaseAndIndent $ docLines $ return <$> bindDocs)
|
|
RecStmt epAnn (L _ stmts) _ _ _ _ _ ->
|
|
docHandleComms epAnn $ runFilteredAlternative $ do
|
|
-- rec stmt1
|
|
-- stmt2
|
|
-- stmt3
|
|
addAlternativeCond (indentPolicy == IndentPolicyFree) $ docSeq
|
|
[ docLit (Text.pack "rec")
|
|
, docSeparator
|
|
, docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts
|
|
]
|
|
-- rec
|
|
-- stmt1
|
|
-- stmt2
|
|
-- stmt3
|
|
addAlternative $ docAddBaseY BrIndentRegular $ docPar
|
|
(docLit (Text.pack "rec"))
|
|
(docLines $ layoutStmt <$> stmts)
|
|
BodyStmt NoExtField expr _ _ -> do
|
|
expDoc <- shareDoc $ callLayouter layout_expr expr
|
|
docAddBaseY BrIndentRegular $ expDoc
|
|
_ -> briDocByExactInlineOnly "some unknown statement" lstmt
|