hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

Replace 'docAltFilter' with 'runFilteredAlternative'

pull/132/head
Sergey Vinokurov 2018-04-02 21:18:37 +01:00
parent 8410fbff8e
commit 2ed9a13fdb
No known key found for this signature in database
GPG Key ID: D6CD29530F98D6B8
8 changed files with 622 additions and 657 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Language.Haskell.Brittany.Internal.LayouterBasics module Language.Haskell.Brittany.Internal.LayouterBasics
( processDefault ( processDefault
, rdrNameToText , rdrNameToText
@ -11,7 +13,11 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
, docEmpty , docEmpty
, docLit , docLit
, docAlt , docAlt
, docAltFilter , CollectAltM
, addAlternativeCondM
, addAlternativeCond
, addAlternative
, runFilteredAlternative
, docLines , docLines
, docCols , docCols
, docSeq , docSeq
@ -60,6 +66,8 @@ where
#include "prelude.inc" #include "prelude.inc"
import qualified Control.Monad.Writer.Strict as Writer
import qualified Language.Haskell.GHC.ExactPrint as ExactPrint import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
import qualified Language.Haskell.GHC.ExactPrint.Annotate as ExactPrint.Annotate import qualified Language.Haskell.GHC.ExactPrint.Annotate as ExactPrint.Annotate
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
@ -415,8 +423,24 @@ docExt x anns shouldAddComment = allocateNode $ BDFExternal
docAlt :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered docAlt :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docAlt l = allocateNode . BDFAlt =<< sequence l docAlt l = allocateNode . BDFAlt =<< sequence l
docAltFilter :: [(Bool, ToBriDocM BriDocNumbered)] -> ToBriDocM BriDocNumbered newtype CollectAltM a = CollectAltM (Writer.Writer [ToBriDocM BriDocNumbered] a)
docAltFilter = docAlt . map snd . filter fst deriving (Functor, Applicative, Monad)
addAlternativeCondM :: Bool -> CollectAltM (ToBriDocM BriDocNumbered) -> CollectAltM ()
addAlternativeCondM cond doc =
addAlternativeCond cond =<< doc
addAlternativeCond :: Bool -> ToBriDocM BriDocNumbered -> CollectAltM ()
addAlternativeCond cond doc =
when cond (addAlternative doc)
addAlternative :: ToBriDocM BriDocNumbered -> CollectAltM ()
addAlternative =
CollectAltM . Writer.tell . (: [])
runFilteredAlternative :: CollectAltM () -> ToBriDocM BriDocNumbered
runFilteredAlternative (CollectAltM action) =
docAlt $ Writer.execWriter action
docSeq :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered docSeq :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered

126
src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs
View File

@ -313,34 +313,33 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
<&> _conf_layout <&> _conf_layout
.> _lconfig_indentPolicy .> _lconfig_indentPolicy
.> confUnpack .> confUnpack
docAltFilter runFilteredAlternative $ do
$ -- one-line solution
[ ( True let wherePart = case mWhereDocs of
, docCols Nothing -> Just docEmpty
Just [w] -> Just $ docSeq
[ docSeparator
, appSep $ docLit $ Text.pack "where"
, docSetIndentLevel $ docForceSingleline $ return w
]
_ -> Nothing
case clauseDocs of
[(guards, body, _bodyRaw)] -> do
let guardPart = singleLineGuardsDoc guards
forM_ wherePart $ \wherePart' ->
-- one-line solution
addAlternativeCond (not hasComments) $ docCols
(ColBindingLine alignmentToken) (ColBindingLine alignmentToken)
[ docSeq (patPartInline ++ [guardPart]) [ docSeq (patPartInline ++ [guardPart])
, docSeq , docSeq
[ appSep $ return binderDoc [ appSep $ return binderDoc
, docForceSingleline $ return body , docForceSingleline $ return body
, wherePart , wherePart'
] ]
] ]
) -- one-line solution + where in next line(s)
| not hasComments addAlternativeCond (Data.Maybe.isJust mWhereDocs)
, [(guards, body, _bodyRaw)] <- [clauseDocs] $ docLines
, let guardPart = singleLineGuardsDoc guards
, wherePart <- case mWhereDocs of
Nothing -> return @[] $ docEmpty
Just [w] -> return @[] $ docSeq
[ docSeparator
, appSep $ docLit $ Text.pack "where"
, docSetIndentLevel $ docForceSingleline $ return w
]
_ -> []
]
++ -- one-line solution + where in next line(s)
[ ( True
, docLines
$ [ docCols $ [ docCols
(ColBindingLine alignmentToken) (ColBindingLine alignmentToken)
[ docSeq (patPartInline ++ [guardPart]) [ docSeq (patPartInline ++ [guardPart])
@ -349,27 +348,18 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
] ]
] ]
++ wherePartMultiLine ++ wherePartMultiLine
) -- two-line solution + where in next line(s)
| [(guards, body, _bodyRaw)] <- [clauseDocs] addAlternative
, let guardPart = singleLineGuardsDoc guards $ docLines
, Data.Maybe.isJust mWhereDocs
]
++ -- two-line solution + where in next line(s)
[ ( True
, docLines
$ [ docForceSingleline $ [ docForceSingleline
$ docSeq (patPartInline ++ [guardPart, return binderDoc]) $ docSeq (patPartInline ++ [guardPart, return binderDoc])
, docEnsureIndent BrIndentRegular $ docForceSingleline $ return body , docEnsureIndent BrIndentRegular $ docForceSingleline $ return body
] ]
++ wherePartMultiLine ++ wherePartMultiLine
) -- pattern and exactly one clause in single line, body as par;
| [(guards, body, _bodyRaw)] <- [clauseDocs]
, let guardPart = singleLineGuardsDoc guards
]
++ -- pattern and exactly one clause in single line, body as par;
-- where in following lines -- where in following lines
[ ( True addAlternative
, docLines $ docLines
$ [ docCols $ [ docCols
(ColBindingLine alignmentToken) (ColBindingLine alignmentToken)
[ docSeq (patPartInline ++ [guardPart]) [ docSeq (patPartInline ++ [guardPart])
@ -384,28 +374,27 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
-- , docAddBaseY BrIndentRegular $ return body -- , docAddBaseY BrIndentRegular $ return body
-- ] -- ]
++ wherePartMultiLine ++ wherePartMultiLine
) -- pattern and exactly one clause in single line, body in new line.
| [(guards, body, _bodyRaw)] <- [clauseDocs] addAlternative
, let guardPart = singleLineGuardsDoc guards $ docLines
]
++ -- pattern and exactly one clause in single line, body in new line.
[ ( True
, docLines
$ [ docSeq (patPartInline ++ [guardPart, return binderDoc]) $ [ docSeq (patPartInline ++ [guardPart, return binderDoc])
, docEnsureIndent BrIndentRegular , docEnsureIndent BrIndentRegular
$ docNonBottomSpacing $ docNonBottomSpacing
$ (docAddBaseY BrIndentRegular $ return body) $ docAddBaseY BrIndentRegular
$ return body
] ]
++ wherePartMultiLine ++ wherePartMultiLine
)
| [(guards, body, _)] <- [clauseDocs] _ -> return ()
, let guardPart = singleLineGuardsDoc guards
] case mPatDoc of
++ -- multiple clauses added in-paragraph, each in a single line Nothing -> return ()
Just patDoc ->
-- multiple clauses added in-paragraph, each in a single line
-- example: foo | bar = baz -- example: foo | bar = baz
-- | lll = asd -- | lll = asd
[ ( indentPolicy /= IndentPolicyLeft addAlternativeCond (indentPolicy /= IndentPolicyLeft)
, docLines $ docLines
$ [ docSeq $ [ docSeq
[ appSep $ docForceSingleline $ return patDoc [ appSep $ docForceSingleline $ return patDoc
, docSetBaseY , docSetBaseY
@ -429,12 +418,9 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
] ]
] ]
++ wherePartMultiLine ++ wherePartMultiLine
) -- multiple clauses, each in a separate, single line
| Just patDoc <- [mPatDoc] addAlternative
] $ docLines
++ -- multiple clauses, each in a separate, single line
[ ( True
, docLines
$ [ docAddBaseY BrIndentRegular $ [ docAddBaseY BrIndentRegular
$ patPartParWrap $ patPartParWrap
$ docLines $ docLines
@ -457,12 +443,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
] ]
] ]
++ wherePartMultiLine ++ wherePartMultiLine
) -- multiple clauses, each with the guard(s) in a single line, body
]
++ -- multiple clauses, each with the guard(s) in a single line, body
-- as a paragraph -- as a paragraph
[ ( True addAlternative
, docLines $ docLines
$ [ docAddBaseY BrIndentRegular $ [ docAddBaseY BrIndentRegular
$ patPartParWrap $ patPartParWrap
$ docLines $ docLines
@ -494,12 +478,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
] ]
] ]
++ wherePartMultiLine ++ wherePartMultiLine
) -- multiple clauses, each with the guard(s) in a single line, body
]
++ -- multiple clauses, each with the guard(s) in a single line, body
-- in a new line as a paragraph -- in a new line as a paragraph
[ ( True addAlternative
, docLines $ docLines
$ [ docAddBaseY BrIndentRegular $ [ docAddBaseY BrIndentRegular
$ patPartParWrap $ patPartParWrap
$ docLines $ docLines
@ -529,11 +511,9 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
] ]
] ]
++ wherePartMultiLine ++ wherePartMultiLine
) -- conservative approach: everything starts on the left.
] addAlternative
++ -- conservative approach: everything starts on the left. $ docLines
[ ( True
, docLines
$ [ docAddBaseY BrIndentRegular $ [ docAddBaseY BrIndentRegular
$ patPartParWrap $ patPartParWrap
$ docLines $ docLines
@ -561,5 +541,3 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
] ]
] ]
++ wherePartMultiLine ++ wherePartMultiLine
)
]

160
src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
View File

@ -123,51 +123,46 @@ layoutExpr lexpr@(L _ expr) = do
_ -> docSeq _ -> docSeq
headDoc <- docSharedWrapper layoutExpr headE headDoc <- docSharedWrapper layoutExpr headE
paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs
docAltFilter runFilteredAlternative $ do
[ -- foo x y -- foo x y
( True addAlternative
, colsOrSequence $ colsOrSequence
$ appSep (docForceSingleline headDoc) $ appSep (docForceSingleline headDoc)
: spacifyDocs (docForceSingleline <$> paramDocs) : spacifyDocs (docForceSingleline <$> paramDocs)
) -- foo x
, -- foo x
-- y -- y
( allowFreeIndent addAlternativeCond allowFreeIndent
, docSeq $ docSeq
[ appSep (docForceSingleline headDoc) [ appSep (docForceSingleline headDoc)
, docSetBaseY , docSetBaseY
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docLines $ docLines
$ (docForceSingleline <$> paramDocs) $ (docForceSingleline <$> paramDocs)
] ]
) -- foo
, -- foo
-- x -- x
-- y -- y
( True addAlternative
, docSetParSpacing $ docSetParSpacing
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar $ docPar
(docForceSingleline headDoc) (docForceSingleline headDoc)
( docNonBottomSpacing ( docNonBottomSpacing
$ docLines paramDocs $ docLines paramDocs
) )
) -- ( multi
, -- ( multi
-- line -- line
-- function -- function
-- ) -- )
-- x -- x
-- y -- y
( True addAlternative
, docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar $ docPar
headDoc headDoc
( docNonBottomSpacing ( docNonBottomSpacing
$ docLines paramDocs $ docLines paramDocs
) )
)
]
HsApp exp1 exp2 -> do HsApp exp1 exp2 -> do
-- TODO: if expDoc1 is some literal, we may want to create a docCols here. -- TODO: if expDoc1 is some literal, we may want to create a docCols here.
expDoc1 <- docSharedWrapper layoutExpr exp1 expDoc1 <- docSharedWrapper layoutExpr exp1
@ -243,9 +238,9 @@ layoutExpr lexpr@(L _ expr) = do
| occNameString occname == "$" -> True | occNameString occname == "$" -> True
(_, L _ (HsApp _ (L _ HsVar{}))) -> False (_, L _ (HsApp _ (L _ HsVar{}))) -> False
_ -> True _ -> True
docAltFilter runFilteredAlternative $ do
[ ( not hasComments addAlternativeCond (not hasComments)
, docSeq $ docSeq
[ appSep $ docForceSingleline leftOperandDoc [ appSep $ docForceSingleline leftOperandDoc
, docSeq , docSeq
$ (appListDocs <&> \(od, ed) -> docSeq $ (appListDocs <&> \(od, ed) -> docSeq
@ -257,25 +252,23 @@ layoutExpr lexpr@(L _ expr) = do
, (if allowPar then docForceParSpacing else docForceSingleline) , (if allowPar then docForceParSpacing else docForceSingleline)
expLastDoc expLastDoc
] ]
)
-- this case rather leads to some unfortunate layouting than to anything -- this case rather leads to some unfortunate layouting than to anything
-- useful; disabling for now. (it interfers with cols stuff.) -- useful; disabling for now. (it interfers with cols stuff.)
-- , docSetBaseY -- addAlternative
-- - $ docPar -- $ docSetBaseY
-- $ docPar
-- leftOperandDoc -- leftOperandDoc
-- ( docLines -- ( docLines
-- - $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed]) -- $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])
-- ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]] -- ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]]
-- ) -- )
, (otherwise addAlternative $
, docPar docPar
leftOperandDoc leftOperandDoc
( docLines ( docLines
$ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed]) $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])
++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]] ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]]
) )
)
]
OpApp expLeft expOp _ expRight -> do OpApp expLeft expOp _ expRight -> do
expDocLeft <- docSharedWrapper layoutExpr expLeft expDocLeft <- docSharedWrapper layoutExpr expLeft
expDocOp <- docSharedWrapper layoutExpr expOp expDocOp <- docSharedWrapper layoutExpr expOp
@ -285,42 +278,42 @@ layoutExpr lexpr@(L _ expr) = do
| occNameString occname == "$" -> True | occNameString occname == "$" -> True
(_, L _ (HsApp _ (L _ HsVar{}))) -> False (_, L _ (HsApp _ (L _ HsVar{}))) -> False
_ -> True _ -> True
docAltFilter runFilteredAlternative $ do
$ [ -- one-line -- one-line
(,) True addAlternative
$ docSeq $ docSeq
[ appSep $ docForceSingleline expDocLeft [ appSep $ docForceSingleline expDocLeft
, appSep $ docForceSingleline expDocOp , appSep $ docForceSingleline expDocOp
, docForceSingleline expDocRight , docForceSingleline expDocRight
] ]
-- , -- line + freely indented block for right expression -- -- line + freely indented block for right expression
-- docSeq -- addAlternative
-- $ docSeq
-- [ appSep $ docForceSingleline expDocLeft -- [ appSep $ docForceSingleline expDocLeft
-- , appSep $ docForceSingleline expDocOp -- , appSep $ docForceSingleline expDocOp
-- , docSetBaseY $ docAddBaseY BrIndentRegular expDocRight -- , docSetBaseY $ docAddBaseY BrIndentRegular expDocRight
-- ] -- ]
, -- two-line -- two-line
(,) True addAlternative
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar $ docPar
expDocLeft expDocLeft
( docForceSingleline ( docForceSingleline
$ docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight] $ docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight]
) )
, -- one-line + par -- one-line + par
(,) allowPar addAlternativeCond allowPar
$ docSeq $ docSeq
[ appSep $ docForceSingleline expDocLeft [ appSep $ docForceSingleline expDocLeft
, appSep $ docForceSingleline expDocOp , appSep $ docForceSingleline expDocOp
, docForceParSpacing expDocRight , docForceParSpacing expDocRight
] ]
, -- more lines -- more lines
(,) True addAlternative
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar $ docPar
expDocLeft expDocLeft
(docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight]) (docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight])
]
NegApp op _ -> do NegApp op _ -> do
opDoc <- docSharedWrapper layoutExpr op opDoc <- docSharedWrapper layoutExpr op
docSeq $ [ docLit $ Text.pack "-" docSeq $ [ docLit $ Text.pack "-"
@ -380,16 +373,14 @@ layoutExpr lexpr@(L _ expr) = do
, closeLit , closeLit
] ]
] ]
FirstLast e1 ems eN -> FirstLast e1 ems eN -> runFilteredAlternative $ do
docAltFilter addAlternativeCond (not hasComments)
[ (,) (not hasComments)
$ docCols ColTuple $ docCols ColTuple
( [docSeq [openLit, docForceSingleline e1]] $ [docSeq [openLit, docForceSingleline e1]]
++ (ems <&> \e -> docSeq [docCommaSep, docForceSingleline e]) ++ (ems <&> \e -> docSeq [docCommaSep, docForceSingleline e])
++ [docSeq [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) (docForceSingleline eN), closeLit]] ++ [docSeq [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) (docForceSingleline eN), closeLit]]
) addAlternative $
, (,) True let
$ let
start = docCols ColTuples start = docCols ColTuples
[appSep $ openLit, e1] [appSep $ openLit, e1]
linesM = ems <&> \d -> linesM = ems <&> \d ->
@ -397,7 +388,6 @@ layoutExpr lexpr@(L _ expr) = do
lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN] lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN]
end = closeLit end = closeLit
in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end] in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]
]
HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do
cExpDoc <- docSharedWrapper layoutExpr cExp cExpDoc <- docSharedWrapper layoutExpr cExp
binderDoc <- docLit $ Text.pack "->" binderDoc <- docLit $ Text.pack "->"
@ -432,9 +422,9 @@ layoutExpr lexpr@(L _ expr) = do
_ -> BrIndentSpecial 3 _ -> BrIndentSpecial 3
-- TODO: some of the alternatives (especially last and last-but-one) -- TODO: some of the alternatives (especially last and last-but-one)
-- overlap. -- overlap.
docAltFilter runFilteredAlternative $ do
[ -- if _ then _ else _ -- if _ then _ else _
(,) (not hasComments) addAlternativeCond (not hasComments)
$ docSeq $ docSeq
[ appSep $ docLit $ Text.pack "if" [ appSep $ docLit $ Text.pack "if"
, appSep $ docForceSingleline ifExprDoc , appSep $ docForceSingleline ifExprDoc
@ -443,7 +433,7 @@ layoutExpr lexpr@(L _ expr) = do
, appSep $ docLit $ Text.pack "else" , appSep $ docLit $ Text.pack "else"
, docForceSingleline elseExprDoc , docForceSingleline elseExprDoc
] ]
, -- either -- either
-- if expr -- if expr
-- then foo -- then foo
-- bar -- bar
@ -456,7 +446,7 @@ layoutExpr lexpr@(L _ expr) = do
-- else -- else
-- stuff -- stuff
-- note that this has par-spacing -- note that this has par-spacing
(,) True addAlternative
$ docSetParSpacing $ docSetParSpacing
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar $ docPar
@ -479,7 +469,7 @@ layoutExpr lexpr@(L _ expr) = do
$ docPar (docLit $ Text.pack "else") elseExprDoc $ docPar (docLit $ Text.pack "else") elseExprDoc
] ]
]) ])
, -- either -- either
-- if multi -- if multi
-- line -- line
-- condition -- condition
@ -496,7 +486,7 @@ layoutExpr lexpr@(L _ expr) = do
-- else -- else
-- stuff -- stuff
-- note that this does _not_ have par-spacing -- note that this does _not_ have par-spacing
(,) True addAlternative
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar $ docPar
( docAddBaseY maySpecialIndent ( docAddBaseY maySpecialIndent
@ -519,7 +509,7 @@ layoutExpr lexpr@(L _ expr) = do
$ docPar (docLit $ Text.pack "else") elseExprDoc $ docPar (docLit $ Text.pack "else") elseExprDoc
] ]
]) ])
, (,) True addAlternative
$ docSetBaseY $ docSetBaseY
$ docLines $ docLines
[ docAddBaseY maySpecialIndent [ docAddBaseY maySpecialIndent
@ -533,7 +523,6 @@ layoutExpr lexpr@(L _ expr) = do
, docAddBaseY BrIndentRegular , docAddBaseY BrIndentRegular
$ docPar (docLit $ Text.pack "else") elseExprDoc $ docPar (docLit $ Text.pack "else") elseExprDoc
] ]
]
HsMultiIf _ cases -> do HsMultiIf _ cases -> do
clauseDocs <- cases `forM` layoutGrhs clauseDocs <- cases `forM` layoutGrhs
binderDoc <- docLit $ Text.pack "->" binderDoc <- docLit $ Text.pack "->"
@ -590,7 +579,7 @@ layoutExpr lexpr@(L _ expr) = do
] ]
] ]
] ]
Just bindDocs@(_:_) -> docAltFilter Just bindDocs@(_:_) -> runFilteredAlternative $ do
--either --either
-- let -- let
-- a = b -- a = b
@ -604,8 +593,8 @@ layoutExpr lexpr@(L _ expr) = do
-- c = d -- c = d
-- in -- in
-- fooooooooooooooooooo -- fooooooooooooooooooo
[ ( indentPolicy == IndentPolicyLeft addAlternativeCond (indentPolicy == IndentPolicyLeft)
, docLines $ docLines
[ docAddBaseY BrIndentRegular [ docAddBaseY BrIndentRegular
$ docPar $ docPar
(docLit $ Text.pack "let") (docLit $ Text.pack "let")
@ -615,9 +604,8 @@ layoutExpr lexpr@(L _ expr) = do
, docAddBaseY BrIndentRegular $ expDoc1 , docAddBaseY BrIndentRegular $ expDoc1
] ]
] ]
) addAlternativeCond (indentPolicy /= IndentPolicyLeft)
, ( indentPolicy /= IndentPolicyLeft $ docLines
, docLines
[ docSeq [ docSeq
[ appSep $ docLit $ Text.pack "let" [ appSep $ docLit $ Text.pack "let"
, docSetBaseAndIndent $ docLines $ bindDocs , docSetBaseAndIndent $ docLines $ bindDocs
@ -627,9 +615,8 @@ layoutExpr lexpr@(L _ expr) = do
, docSetBaseY $ expDoc1 , docSetBaseY $ expDoc1
] ]
] ]
) addAlternative
, ( True $ docLines
, docLines
[ docAddBaseY BrIndentRegular [ docAddBaseY BrIndentRegular
$ docPar $ docPar
(docLit $ Text.pack "let") (docLit $ Text.pack "let")
@ -639,8 +626,6 @@ layoutExpr lexpr@(L _ expr) = do
(docLit $ Text.pack "in") (docLit $ Text.pack "in")
(docSetBaseY $ expDoc1) (docSetBaseY $ expDoc1)
] ]
)
]
_ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1] _ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1]
-- docSeq [appSep $ docLit "let in", expDoc1] -- docSeq [appSep $ docLit "let in", expDoc1]
HsDo DoExpr (L _ stmts) _ -> do HsDo DoExpr (L _ stmts) _ -> do
@ -662,8 +647,8 @@ layoutExpr lexpr@(L _ expr) = do
; _ -> False } -> do ; _ -> False } -> do
stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
hasComments <- hasAnyCommentsBelow lexpr hasComments <- hasAnyCommentsBelow lexpr
docAltFilter runFilteredAlternative $ do
[ (,) (not hasComments) addAlternativeCond (not hasComments)
$ docSeq $ docSeq
[ docNodeAnnKW lexpr Nothing [ docNodeAnnKW lexpr Nothing
$ appSep $ appSep
@ -678,8 +663,8 @@ layoutExpr lexpr@(L _ expr) = do
$ fmap docForceSingleline $ List.init stmtDocs $ fmap docForceSingleline $ List.init stmtDocs
, docLit $ Text.pack " ]" , docLit $ Text.pack " ]"
] ]
, (,) True addAlternative $
$ let let
start = docCols ColListComp start = docCols ColListComp
[ docNodeAnnKW lexpr Nothing [ docNodeAnnKW lexpr Nothing
$ appSep $ docLit $ Text.pack "[" $ appSep $ docLit $ Text.pack "["
@ -694,7 +679,6 @@ layoutExpr lexpr@(L _ expr) = do
docCols ColListComp [docCommaSep, d] docCols ColListComp [docCommaSep, d]
end = docLit $ Text.pack "]" end = docLit $ Text.pack "]"
in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end] in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end]
]
HsDo{} -> do HsDo{} -> do
-- TODO -- TODO
unknownNodeError "HsDo{} no comp" lexpr unknownNodeError "HsDo{} no comp" lexpr
@ -721,15 +705,14 @@ layoutExpr lexpr@(L _ expr) = do
, docLit $ Text.pack "]" , docLit $ Text.pack "]"
] ]
] ]
FirstLast e1 ems eN -> FirstLast e1 ems eN -> runFilteredAlternative $ do
docAltFilter addAlternativeCond (not hasComments)
[ (,) (not hasComments)
$ docSeq $ docSeq
$ [docLit $ Text.pack "["] $ [docLit $ Text.pack "["]
++ List.intersperse docCommaSep (docForceSingleline <$> (e1:ems ++ [docNodeAnnKW lexpr (Just AnnOpenS) eN])) ++ List.intersperse docCommaSep (docForceSingleline <$> (e1:ems ++ [docNodeAnnKW lexpr (Just AnnOpenS) eN]))
++ [docLit $ Text.pack "]"] ++ [docLit $ Text.pack "]"]
, (,) True addAlternative $
$ let let
start = docCols ColList start = docCols ColList
[appSep $ docLit $ Text.pack "[", e1] [appSep $ docLit $ Text.pack "[", e1]
linesM = ems <&> \d -> linesM = ems <&> \d ->
@ -737,7 +720,6 @@ layoutExpr lexpr@(L _ expr) = do
lineN = docCols ColList [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenS) eN] lineN = docCols ColList [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenS) eN]
end = docLit $ Text.pack "]" end = docLit $ Text.pack "]"
in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end] in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]
]
ExplicitList _ _ [] -> ExplicitList _ _ [] ->
docLit $ Text.pack "[]" docLit $ Text.pack "[]"
ExplicitPArr{} -> do ExplicitPArr{} -> do
@ -870,10 +852,10 @@ layoutExpr lexpr@(L _ expr) = do
return $ case ambName of return $ case ambName of
Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)
Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)
docAltFilter runFilteredAlternative $ do
-- container { fieldA = blub, fieldB = blub } -- container { fieldA = blub, fieldB = blub }
[ ( True addAlternative
, docSeq $ docSeq
[ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc
, appSep $ docLit $ Text.pack "{" , appSep $ docLit $ Text.pack "{"
, appSep $ docSeq $ List.intersperse docCommaSep , appSep $ docSeq $ List.intersperse docCommaSep
@ -888,13 +870,12 @@ layoutExpr lexpr@(L _ expr) = do
docWrapNode lfield $ docLit fieldStr docWrapNode lfield $ docLit fieldStr
, docLit $ Text.pack "}" , docLit $ Text.pack "}"
] ]
)
-- hanging single-line fields -- hanging single-line fields
-- container { fieldA = blub -- container { fieldA = blub
-- , fieldB = blub -- , fieldB = blub
-- } -- }
, ( indentPolicy /= IndentPolicyLeft addAlternativeCond (indentPolicy /= IndentPolicyLeft)
, docSeq $ docSeq
[ docNodeAnnKW lexpr Nothing $ appSep rExprDoc [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc
, docSetBaseY $ docLines $ let , docSetBaseY $ docLines $ let
line1 = docCols ColRecUpdate line1 = docCols ColRecUpdate
@ -922,15 +903,14 @@ layoutExpr lexpr@(L _ expr) = do
] ]
in [line1] ++ lineR ++ [lineN] in [line1] ++ lineR ++ [lineN]
] ]
)
-- non-hanging with expressions placed to the right of the names -- non-hanging with expressions placed to the right of the names
-- container -- container
-- { fieldA = blub -- { fieldA = blub
-- , fieldB = potentially -- , fieldB = potentially
-- multiline -- multiline
-- } -- }
, ( True addAlternative
, docSetParSpacing $ docSetParSpacing
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar $ docPar
(docNodeAnnKW lexpr Nothing $ rExprDoc) (docNodeAnnKW lexpr Nothing $ rExprDoc)
@ -971,8 +951,6 @@ layoutExpr lexpr@(L _ expr) = do
] ]
in [line1] ++ lineR ++ [lineN] in [line1] ++ lineR ++ [lineN]
) )
)
]
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do
#else /* ghc-8.0 */ #else /* ghc-8.0 */

37
src/Language/Haskell/Brittany/Internal/Layouters/IE.hs
View File

@ -46,18 +46,15 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
IEThingWith _ (IEWildcard _) _ _ -> docSeq [ien, docLit $ Text.pack "(..)"] IEThingWith _ (IEWildcard _) _ _ -> docSeq [ien, docLit $ Text.pack "(..)"]
IEThingWith _ _ ns _ -> do IEThingWith _ _ ns _ -> do
hasComments <- hasAnyCommentsBelow lie hasComments <- hasAnyCommentsBelow lie
docAltFilter runFilteredAlternative $ do
[ ( not hasComments addAlternativeCond (not hasComments)
, docSeq $ docSeq
$ [ien, docLit $ Text.pack "("] $ [ien, docLit $ Text.pack "("]
++ intersperse docCommaSep (map nameDoc ns) ++ intersperse docCommaSep (map nameDoc ns)
++ [docParenR] ++ [docParenR]
) addAlternative
, (otherwise $ docAddBaseY BrIndentRegular
, docAddBaseY BrIndentRegular
$ docPar ien (layoutItems (splitFirstLast ns)) $ docPar ien (layoutItems (splitFirstLast ns))
)
]
where where
nameDoc = (docLit =<<) . lrdrNameToTextAnn . prepareName nameDoc = (docLit =<<) . lrdrNameToTextAnn . prepareName
layoutItem n = docSeq [docCommaSep, docWrapNode n $ nameDoc n] layoutItem n = docSeq [docCommaSep, docWrapNode n $ nameDoc n]
@ -122,24 +119,20 @@ layoutLLIEs enableSingleline llies = do
ieDs <- layoutAnnAndSepLLIEs llies ieDs <- layoutAnnAndSepLLIEs llies
hasComments <- hasAnyCommentsBelow llies hasComments <- hasAnyCommentsBelow llies
case ieDs of case ieDs of
[] -> docAltFilter [] -> runFilteredAlternative $ do
[ (not hasComments, docLit $ Text.pack "()") addAlternativeCond (not hasComments) $
, ( hasComments docLit $ Text.pack "()"
, docPar (docSeq [docParenLSep, docWrapNodeRest llies docEmpty]) addAlternativeCond hasComments $
docPar (docSeq [docParenLSep, docWrapNodeRest llies docEmpty])
docParenR docParenR
) (ieDsH:ieDsT) -> runFilteredAlternative $ do
] addAlternativeCond (not hasComments && enableSingleline)
(ieDsH:ieDsT) -> docAltFilter $ docSeq
[ ( not hasComments && enableSingleline
, docSeq
$ [docLit (Text.pack "(")] $ [docLit (Text.pack "(")]
++ (docForceSingleline <$> ieDs) ++ (docForceSingleline <$> ieDs)
++ [docParenR] ++ [docParenR]
) addAlternative
, ( otherwise $ docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH])
, docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH])
$ docLines $ docLines
$ ieDsT $ ieDsT
++ [docParenR] ++ [docParenR]
)
]

16
src/Language/Haskell/Brittany/Internal/Layouters/Import.hs
View File

@ -98,25 +98,21 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of
[] -> if hasComments [] -> if hasComments
then docPar then docPar
(docSeq [hidDoc, docParenLSep, docWrapNode llies docEmpty]) (docSeq [hidDoc, docParenLSep, docWrapNode llies docEmpty])
(docEnsureIndent (BrIndentSpecial hidDocColDiff) $ docParenR) (docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)
else docSeq [hidDoc, docParenLSep, docSeparator, docParenR] else docSeq [hidDoc, docParenLSep, docSeparator, docParenR]
-- ..[hiding].( b ) -- ..[hiding].( b )
[ieD] -> docAltFilter [ieD] -> runFilteredAlternative $ do
[ ( not hasComments addAlternativeCond (not hasComments)
, docSeq $ docSeq
[ hidDoc [ hidDoc
, docParenLSep , docParenLSep
, docForceSingleline $ ieD , docForceSingleline ieD
, docSeparator , docSeparator
, docParenR , docParenR
] ]
) addAlternative $ docPar
, ( otherwise
, docPar
(docSeq [hidDoc, docParenLSep, docNonBottomSpacing ieD]) (docSeq [hidDoc, docParenLSep, docNonBottomSpacing ieD])
(docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR) (docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)
)
]
-- ..[hiding].( b -- ..[hiding].( b
-- , b' -- , b'
-- ) -- )

10
src/Language/Haskell/Brittany/Internal/Layouters/Module.hs
View File

@ -38,8 +38,10 @@ layoutModule lmod@(L _ mod') = case mod' of
[ docNodeAnnKW lmod Nothing docEmpty [ docNodeAnnKW lmod Nothing docEmpty
-- A pseudo node that serves merely to force documentation -- A pseudo node that serves merely to force documentation
-- before the node -- before the node
, docNodeMoveToKWDP lmod AnnModule $ docAltFilter , docNodeMoveToKWDP lmod AnnModule $ runFilteredAlternative $ do
[ (,) allowSingleLineExportList $ docForceSingleline $ docSeq addAlternativeCond allowSingleLineExportList $
docForceSingleline
$ docSeq
[ appSep $ docLit $ Text.pack "module" [ appSep $ docLit $ Text.pack "module"
, appSep $ docLit tn , appSep $ docLit tn
, docWrapNode lmod $ appSep $ case les of , docWrapNode lmod $ appSep $ case les of
@ -47,7 +49,8 @@ layoutModule lmod@(L _ mod') = case mod' of
Just x -> layoutLLIEs True x Just x -> layoutLLIEs True x
, docLit $ Text.pack "where" , docLit $ Text.pack "where"
] ]
, (,) otherwise $ docLines addAlternative
$ docLines
[ docAddBaseY BrIndentRegular $ docPar [ docAddBaseY BrIndentRegular $ docPar
(docSeq [appSep $ docLit $ Text.pack "module", docLit tn] (docSeq [appSep $ docLit $ Text.pack "module", docLit tn]
) )
@ -58,5 +61,4 @@ layoutModule lmod@(L _ mod') = case mod' of
, docLit $ Text.pack "where" , docLit $ Text.pack "where"
] ]
] ]
]
: map layoutImport imports : map layoutImport imports

34
src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs
View File

@ -71,46 +71,40 @@ layoutStmt lstmt@(L _ stmt) = do
(docLit $ Text.pack "let") (docLit $ Text.pack "let")
(docSetBaseAndIndent $ return bindDoc) (docSetBaseAndIndent $ return bindDoc)
] ]
Just bindDocs -> docAltFilter Just bindDocs -> runFilteredAlternative $ do
[ -- let aaa = expra -- let aaa = expra
-- bbb = exprb -- bbb = exprb
-- ccc = exprc -- ccc = exprc
( indentPolicy /= IndentPolicyLeft addAlternativeCond (indentPolicy /= IndentPolicyLeft)
, docSeq $ docSeq
[ appSep $ docLit $ Text.pack "let" [ appSep $ docLit $ Text.pack "let"
, docSetBaseAndIndent $ docLines $ return <$> bindDocs , docSetBaseAndIndent $ docLines $ return <$> bindDocs
] ]
) -- let
, -- let
-- aaa = expra -- aaa = expra
-- bbb = exprb -- bbb = exprb
-- ccc = exprc -- ccc = exprc
( True addAlternative $
, docAddBaseY BrIndentRegular $ docPar docAddBaseY BrIndentRegular $ docPar
(docLit $ Text.pack "let") (docLit $ Text.pack "let")
(docSetBaseAndIndent $ docLines $ return <$> bindDocs) (docSetBaseAndIndent $ docLines $ return <$> bindDocs)
) RecStmt stmts _ _ _ _ _ _ _ _ _ -> runFilteredAlternative $ do
] -- rec stmt1
RecStmt stmts _ _ _ _ _ _ _ _ _ -> docAltFilter
[ -- rec stmt1
-- stmt2 -- stmt2
-- stmt3 -- stmt3
( indentPolicy /= IndentPolicyLeft addAlternativeCond (indentPolicy /= IndentPolicyLeft)
, docSeq $ docSeq
[ docLit (Text.pack "rec") [ docLit (Text.pack "rec")
, docSeparator , docSeparator
, docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts , docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts
] ]
) -- rec
, -- rec
-- stmt1 -- stmt1
-- stmt2 -- stmt2
-- stmt3 -- stmt3
( True addAlternative
, docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar (docLit (Text.pack "rec")) (docLines $ layoutStmt <$> stmts) $ docPar (docLit (Text.pack "rec")) (docLines $ layoutStmt <$> stmts)
)
]
BodyStmt expr _ _ _ -> do BodyStmt expr _ _ _ -> do
expDoc <- docSharedWrapper layoutExpr expr expDoc <- docSharedWrapper layoutExpr expr
docAddBaseY BrIndentRegular $ expDoc docAddBaseY BrIndentRegular $ expDoc

2
stack.yaml
View File

@ -1,4 +1,4 @@
resolver: lts-11.0 resolver: lts-11.1
packages: packages:
- . - .