{-# 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 callLayouter layout_localBinds binds >>= \case 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 f $ return bindDoc ] , -- let -- bind = expr docAddBaseY BrIndentRegular $ docPar (docLit $ Text.pack "let") (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 f $ docLines $ return <$> bindDocs ] -- let -- aaa = expra -- bbb = exprb -- ccc = exprc addAlternativeCond (not indentFourPlus) $ docAddBaseY BrIndentRegular $ docPar (docLit $ Text.pack "let") (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