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

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

@ -313,253 +313,231 @@ 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
(ColBindingLine alignmentToken) Just [w] -> Just $ docSeq
[ docSeq (patPartInline ++ [guardPart]) [ docSeparator
, docSeq , appSep $ docLit $ Text.pack "where"
[ appSep $ return binderDoc , docSetIndentLevel $ docForceSingleline $ return w
, docForceSingleline $ return body ]
, wherePart _ -> Nothing
] case clauseDocs of
] [(guards, body, _bodyRaw)] -> do
) let guardPart = singleLineGuardsDoc guards
| not hasComments forM_ wherePart $ \wherePart' ->
, [(guards, body, _bodyRaw)] <- [clauseDocs] -- one-line solution
, let guardPart = singleLineGuardsDoc guards addAlternativeCond (not hasComments) $ docCols
, wherePart <- case mWhereDocs of (ColBindingLine alignmentToken)
Nothing -> return @[] $ docEmpty [ docSeq (patPartInline ++ [guardPart])
Just [w] -> return @[] $ docSeq , docSeq
[ docSeparator [ appSep $ return binderDoc
, appSep $ docLit $ Text.pack "where" , docForceSingleline $ return body
, docSetIndentLevel $ docForceSingleline $ return w , wherePart'
]
_ -> []
]
++ -- one-line solution + where in next line(s)
[ ( True
, docLines
$ [ docCols
(ColBindingLine alignmentToken)
[ docSeq (patPartInline ++ [guardPart])
, docSeq
[appSep $ return binderDoc, docForceParSpacing $ return body]
] ]
] ]
++ wherePartMultiLine -- one-line solution + where in next line(s)
) addAlternativeCond (Data.Maybe.isJust mWhereDocs)
| [(guards, body, _bodyRaw)] <- [clauseDocs] $ docLines
, let guardPart = singleLineGuardsDoc guards $ [ docCols
, Data.Maybe.isJust mWhereDocs (ColBindingLine alignmentToken)
] [ docSeq (patPartInline ++ [guardPart])
++ -- two-line solution + where in next line(s) , docSeq
[ ( True [appSep $ return binderDoc, docForceParSpacing $ return body]
, docLines ]
$ [ docForceSingleline ]
$ docSeq (patPartInline ++ [guardPart, return binderDoc]) ++ wherePartMultiLine
, docEnsureIndent BrIndentRegular $ docForceSingleline $ return body -- two-line solution + where in next line(s)
] addAlternative
++ wherePartMultiLine $ docLines
) $ [ docForceSingleline
| [(guards, body, _bodyRaw)] <- [clauseDocs] $ docSeq (patPartInline ++ [guardPart, return binderDoc])
, let guardPart = singleLineGuardsDoc guards , docEnsureIndent BrIndentRegular $ docForceSingleline $ return body
] ]
++ -- pattern and exactly one clause in single line, body as par; ++ wherePartMultiLine
-- where in following lines -- pattern and exactly one clause in single line, body as par;
[ ( True -- where in following lines
, docLines addAlternative
$ [ docCols $ docLines
(ColBindingLine alignmentToken) $ [ docCols
[ docSeq (patPartInline ++ [guardPart]) (ColBindingLine alignmentToken)
, docSeq [ docSeq (patPartInline ++ [guardPart])
[ appSep $ return binderDoc , docSeq
, docForceParSpacing $ docAddBaseY BrIndentRegular $ return body [ appSep $ return binderDoc
] , docForceParSpacing $ docAddBaseY BrIndentRegular $ return body
] ]
] ]
-- , lineMod $ docAlt ]
-- [ docSetBaseY $ return body -- , lineMod $ docAlt
-- , docAddBaseY BrIndentRegular $ return body -- [ docSetBaseY $ return body
-- ] -- , docAddBaseY BrIndentRegular $ return body
++ wherePartMultiLine -- ]
) ++ wherePartMultiLine
| [(guards, body, _bodyRaw)] <- [clauseDocs] -- pattern and exactly one clause in single line, body in new line.
, let guardPart = singleLineGuardsDoc guards addAlternative
] $ docLines
++ -- pattern and exactly one clause in single line, body in new line. $ [ docSeq (patPartInline ++ [guardPart, return binderDoc])
[ ( True , docEnsureIndent BrIndentRegular
, docLines $ docNonBottomSpacing
$ [ docSeq (patPartInline ++ [guardPart, return binderDoc]) $ docAddBaseY BrIndentRegular
, docEnsureIndent BrIndentRegular $ return body
$ docNonBottomSpacing ]
$ (docAddBaseY BrIndentRegular $ return body) ++ wherePartMultiLine
]
++ wherePartMultiLine _ -> return ()
)
| [(guards, body, _)] <- [clauseDocs] case mPatDoc of
, let guardPart = singleLineGuardsDoc guards Nothing -> return ()
] Just patDoc ->
++ -- multiple clauses added in-paragraph, each in a single line -- 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
$ docLines $ docLines
$ clauseDocs $ clauseDocs
<&> \(guardDocs, bodyDoc, _) -> do <&> \(guardDocs, bodyDoc, _) -> do
let guardPart = singleLineGuardsDoc guardDocs let guardPart = singleLineGuardsDoc guardDocs
-- the docForceSingleline might seems superflous, but it -- the docForceSingleline might seems superflous, but it
-- helps the alternative resolving impl. -- helps the alternative resolving impl.
docForceSingleline $ docCols docForceSingleline $ docCols
ColGuardedBody ColGuardedBody
[ guardPart [ guardPart
, docSeq , docSeq
[ appSep $ return binderDoc
, docForceSingleline $ return bodyDoc
-- i am not sure if there is a benefit to using
-- docForceParSpacing additionally here:
-- , docAddBaseY BrIndentRegular $ return bodyDoc
]
]
]
]
++ wherePartMultiLine
)
| Just patDoc <- [mPatDoc]
]
++ -- multiple clauses, each in a separate, single line
[ ( True
, docLines
$ [ docAddBaseY BrIndentRegular
$ patPartParWrap
$ docLines
$ map docSetBaseY
$ clauseDocs
<&> \(guardDocs, bodyDoc, _) -> do
let guardPart = singleLineGuardsDoc guardDocs
-- the docForceSingleline might seems superflous, but it
-- helps the alternative resolving impl.
docForceSingleline $ docCols
ColGuardedBody
[ guardPart
, docSeq
[ appSep $ return binderDoc
, docForceSingleline $ return bodyDoc
-- i am not sure if there is a benefit to using
-- docForceParSpacing additionally here:
-- , docAddBaseY BrIndentRegular $ return bodyDoc
]
]
]
++ wherePartMultiLine
)
]
++ -- multiple clauses, each with the guard(s) in a single line, body
-- as a paragraph
[ ( True
, docLines
$ [ docAddBaseY BrIndentRegular
$ patPartParWrap
$ docLines
$ map docSetBaseY
$ clauseDocs
<&> \(guardDocs, bodyDoc, _) ->
docSeq
$ ( case guardDocs of
[] -> []
[g] ->
[ docForceSingleline
$ docSeq [appSep $ docLit $ Text.pack "|", return g]
]
gs ->
[ docForceSingleline
$ docSeq
$ [appSep $ docLit $ Text.pack "|"]
++ List.intersperse docCommaSep (return <$> gs)
]
)
++ [ docSeparator
, docCols
ColOpPrefix
[ appSep $ return binderDoc
, docAddBaseY BrIndentRegular
$ docForceParSpacing
$ return bodyDoc
]
]
]
++ wherePartMultiLine
)
]
++ -- multiple clauses, each with the guard(s) in a single line, body
-- in a new line as a paragraph
[ ( True
, docLines
$ [ docAddBaseY BrIndentRegular
$ patPartParWrap
$ docLines
$ map docSetBaseY
$ clauseDocs
>>= \(guardDocs, bodyDoc, _) ->
( case guardDocs of
[] -> []
[g] ->
[ docForceSingleline
$ docSeq [appSep $ docLit $ Text.pack "|", return g]
]
gs ->
[ docForceSingleline
$ docSeq
$ [appSep $ docLit $ Text.pack "|"]
++ List.intersperse docCommaSep (return <$> gs)
]
)
++ [ docCols
ColOpPrefix
[ appSep $ return binderDoc [ appSep $ return binderDoc
, docAddBaseY BrIndentRegular , docForceSingleline $ return bodyDoc
$ docForceParSpacing -- i am not sure if there is a benefit to using
$ return bodyDoc -- docForceParSpacing additionally here:
-- , docAddBaseY BrIndentRegular $ return bodyDoc
] ]
] ]
] ]
++ wherePartMultiLine ]
) ++ wherePartMultiLine
] -- multiple clauses, each in a separate, single line
++ -- conservative approach: everything starts on the left. addAlternative
[ ( True $ docLines
, docLines $ [ docAddBaseY BrIndentRegular
$ [ docAddBaseY BrIndentRegular $ patPartParWrap
$ patPartParWrap $ docLines
$ docLines $ map docSetBaseY
$ map docSetBaseY $ clauseDocs
$ clauseDocs <&> \(guardDocs, bodyDoc, _) -> do
>>= \(guardDocs, bodyDoc, _) -> let guardPart = singleLineGuardsDoc guardDocs
( case guardDocs of -- the docForceSingleline might seems superflous, but it
[] -> [] -- helps the alternative resolving impl.
[g] -> docForceSingleline $ docCols
[docSeq [appSep $ docLit $ Text.pack "|", return g]] ColGuardedBody
(g1:gr) -> [ guardPart
( docSeq [appSep $ docLit $ Text.pack "|", return g1] , docSeq
: ( gr [ appSep $ return binderDoc
<&> \g -> , docForceSingleline $ return bodyDoc
docSeq -- i am not sure if there is a benefit to using
[appSep $ docLit $ Text.pack ",", return g] -- docForceParSpacing additionally here:
) -- , docAddBaseY BrIndentRegular $ return bodyDoc
) ]
) ]
++ [ docCols ]
ColOpPrefix ++ wherePartMultiLine
[ appSep $ return binderDoc -- multiple clauses, each with the guard(s) in a single line, body
, docAddBaseY BrIndentRegular $ return bodyDoc -- as a paragraph
] addAlternative
] $ docLines
] $ [ docAddBaseY BrIndentRegular
++ wherePartMultiLine $ patPartParWrap
) $ docLines
] $ map docSetBaseY
$ clauseDocs
<&> \(guardDocs, bodyDoc, _) ->
docSeq
$ ( case guardDocs of
[] -> []
[g] ->
[ docForceSingleline
$ docSeq [appSep $ docLit $ Text.pack "|", return g]
]
gs ->
[ docForceSingleline
$ docSeq
$ [appSep $ docLit $ Text.pack "|"]
++ List.intersperse docCommaSep (return <$> gs)
]
)
++ [ docSeparator
, docCols
ColOpPrefix
[ appSep $ return binderDoc
, docAddBaseY BrIndentRegular
$ docForceParSpacing
$ return bodyDoc
]
]
]
++ wherePartMultiLine
-- multiple clauses, each with the guard(s) in a single line, body
-- in a new line as a paragraph
addAlternative
$ docLines
$ [ docAddBaseY BrIndentRegular
$ patPartParWrap
$ docLines
$ map docSetBaseY
$ clauseDocs
>>= \(guardDocs, bodyDoc, _) ->
( case guardDocs of
[] -> []
[g] ->
[ docForceSingleline
$ docSeq [appSep $ docLit $ Text.pack "|", return g]
]
gs ->
[ docForceSingleline
$ docSeq
$ [appSep $ docLit $ Text.pack "|"]
++ List.intersperse docCommaSep (return <$> gs)
]
)
++ [ docCols
ColOpPrefix
[ appSep $ return binderDoc
, docAddBaseY BrIndentRegular
$ docForceParSpacing
$ return bodyDoc
]
]
]
++ wherePartMultiLine
-- conservative approach: everything starts on the left.
addAlternative
$ docLines
$ [ docAddBaseY BrIndentRegular
$ patPartParWrap
$ docLines
$ map docSetBaseY
$ clauseDocs
>>= \(guardDocs, bodyDoc, _) ->
( case guardDocs of
[] -> []
[g] ->
[docSeq [appSep $ docLit $ Text.pack "|", return g]]
(g1:gr) ->
( docSeq [appSep $ docLit $ Text.pack "|", return g1]
: ( gr
<&> \g ->
docSeq
[appSep $ docLit $ Text.pack ",", return g]
)
)
)
++ [ docCols
ColOpPrefix
[ appSep $ return binderDoc
, docAddBaseY BrIndentRegular $ return bodyDoc
]
]
]
++ wherePartMultiLine

600
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 addAlternativeCond allowFreeIndent
( allowFreeIndent $ docSeq
, docSeq [ appSep (docForceSingleline headDoc)
[ appSep (docForceSingleline headDoc) , docSetBaseY
, docSetBaseY $ docAddBaseY BrIndentRegular
$ docAddBaseY BrIndentRegular $ docLines
$ docLines $ (docForceSingleline <$> paramDocs)
$ (docForceSingleline <$> paramDocs) ]
] -- foo
) -- x
, -- foo -- y
-- x addAlternative
-- y $ docSetParSpacing
( True
, 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 addAlternative
( True $ 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,39 +238,37 @@ 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
[ appSep $ docForceSingleline leftOperandDoc
, docSeq , docSeq
[ appSep $ docForceSingleline leftOperandDoc $ (appListDocs <&> \(od, ed) -> docSeq
, docSeq [ appSep $ docForceSingleline od
$ (appListDocs <&> \(od, ed) -> docSeq , appSep $ docForceSingleline ed
[ appSep $ docForceSingleline od ]
, appSep $ docForceSingleline ed )
] , appSep $ docForceSingleline opLastDoc
) , (if allowPar then docForceParSpacing else docForceSingleline)
, appSep $ docForceSingleline opLastDoc expLastDoc
, (if allowPar then docForceParSpacing else docForceSingleline) ]
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
-- [ appSep $ docForceSingleline expDocLeft -- $ docSeq
-- , appSep $ docForceSingleline expDocOp -- [ appSep $ docForceSingleline expDocLeft
-- , docSetBaseY $ docAddBaseY BrIndentRegular expDocRight -- , appSep $ docForceSingleline expDocOp
-- ] -- , docSetBaseY $ docAddBaseY BrIndentRegular expDocRight
, -- two-line -- ]
(,) True -- two-line
$ docAddBaseY BrIndentRegular addAlternative
$ docPar $ docAddBaseY BrIndentRegular
expDocLeft $ docPar
( docForceSingleline expDocLeft
$ docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight] ( docForceSingleline
) $ docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight]
, -- one-line + par )
(,) allowPar -- one-line + par
$ docSeq addAlternativeCond allowPar
[ appSep $ docForceSingleline expDocLeft $ docSeq
, appSep $ docForceSingleline expDocOp [ appSep $ docForceSingleline expDocLeft
, docForceParSpacing expDocRight , appSep $ docForceSingleline expDocOp
] , docForceParSpacing expDocRight
, -- more lines ]
(,) True -- more lines
$ docAddBaseY BrIndentRegular addAlternative
$ docPar $ docAddBaseY BrIndentRegular
expDocLeft $ docPar
(docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight]) expDocLeft
] (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,24 +373,21 @@ 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 $
) let
, (,) True start = docCols ColTuples
$ let [appSep $ openLit, e1]
start = docCols ColTuples linesM = ems <&> \d ->
[appSep $ openLit, e1] docCols ColTuples [docCommaSep, d]
linesM = ems <&> \d -> lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN]
docCols ColTuples [docCommaSep, d] end = closeLit
lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN] in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]
end = closeLit
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,10 +422,10 @@ 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
, appSep $ docLit $ Text.pack "then" , appSep $ docLit $ Text.pack "then"
@ -443,106 +433,105 @@ 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
-- else foo -- else foo
-- bar -- bar
-- or -- or
-- if expr -- if expr
-- then -- then
-- stuff -- stuff
-- 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
( docSeq ( docSeq
[ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if" [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"
, docNodeAnnKW lexpr (Just AnnIf) $ docForceSingleline ifExprDoc , docNodeAnnKW lexpr (Just AnnIf) $ docForceSingleline ifExprDoc
]) ])
(docLines (docLines
[ docAddBaseY BrIndentRegular [ docAddBaseY BrIndentRegular
$ docNodeAnnKW lexpr (Just AnnThen) $ docNodeAnnKW lexpr (Just AnnThen)
$ docAlt $ docAlt
[ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc] [ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc]
, docAddBaseY BrIndentRegular
$ docPar (docLit $ Text.pack "then") thenExprDoc
]
, docAddBaseY BrIndentRegular , docAddBaseY BrIndentRegular
$ docPar (docLit $ Text.pack "then") thenExprDoc $ docAlt
] [ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc]
, docAddBaseY BrIndentRegular , docAddBaseY BrIndentRegular
$ docAlt $ docPar (docLit $ Text.pack "else") elseExprDoc
[ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc] ]
])
-- either
-- if multi
-- line
-- condition
-- then foo
-- bar
-- else foo
-- bar
-- or
-- if multi
-- line
-- condition
-- then
-- stuff
-- else
-- stuff
-- note that this does _not_ have par-spacing
addAlternative
$ docAddBaseY BrIndentRegular
$ docPar
( docAddBaseY maySpecialIndent
$ docSeq
[ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"
, docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc
])
(docLines
[ docAddBaseY BrIndentRegular
$ docNodeAnnKW lexpr (Just AnnThen)
$ docAlt
[ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc]
, docAddBaseY BrIndentRegular
$ docPar (docLit $ Text.pack "then") thenExprDoc
]
, docAddBaseY BrIndentRegular , docAddBaseY BrIndentRegular
$ docPar (docLit $ Text.pack "else") elseExprDoc $ docAlt
] [ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc]
]) , docAddBaseY BrIndentRegular
, -- either $ docPar (docLit $ Text.pack "else") elseExprDoc
-- if multi ]
-- line ])
-- condition addAlternative
-- then foo $ docSetBaseY
-- bar $ docLines
-- else foo [ docAddBaseY maySpecialIndent
-- bar
-- or
-- if multi
-- line
-- condition
-- then
-- stuff
-- else
-- stuff
-- note that this does _not_ have par-spacing
(,) True
$ docAddBaseY BrIndentRegular
$ docPar
( docAddBaseY maySpecialIndent
$ docSeq $ docSeq
[ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if" [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"
, docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc , docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc
]) ]
(docLines , docNodeAnnKW lexpr (Just AnnThen)
[ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docNodeAnnKW lexpr (Just AnnThen) $ docPar (docLit $ Text.pack "then") thenExprDoc
$ docAlt , docAddBaseY BrIndentRegular
[ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc] $ docPar (docLit $ Text.pack "else") elseExprDoc
, docAddBaseY BrIndentRegular
$ docPar (docLit $ Text.pack "then") thenExprDoc
]
, docAddBaseY BrIndentRegular
$ docAlt
[ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc]
, docAddBaseY BrIndentRegular
$ docPar (docLit $ Text.pack "else") elseExprDoc
]
])
, (,) True
$ docSetBaseY
$ docLines
[ docAddBaseY maySpecialIndent
$ docSeq
[ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"
, docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc
] ]
, docNodeAnnKW lexpr (Just AnnThen)
$ docAddBaseY BrIndentRegular
$ docPar (docLit $ Text.pack "then") thenExprDoc
, docAddBaseY BrIndentRegular
$ 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 "->"
hasComments <- hasAnyCommentsBelow lexpr hasComments <- hasAnyCommentsBelow lexpr
docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
(docLit $ Text.pack "if") (docLit $ Text.pack "if")
(layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing hasComments) (layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing hasComments)
HsLet binds exp1 -> do HsLet binds exp1 -> do
expDoc1 <- docSharedWrapper layoutExpr exp1 expDoc1 <- docSharedWrapper layoutExpr exp1
-- We jump through some ugly hoops here to ensure proper sharing. -- We jump through some ugly hoops here to ensure proper sharing.
mBindDocs <- mapM (fmap (fmap return) . docWrapNodeRest lexpr . return) mBindDocs <- mapM (fmap (fmap return) . docWrapNodeRest lexpr . return)
=<< layoutLocalBinds binds =<< layoutLocalBinds binds
@ -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,43 +593,39 @@ 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")
(docSetBaseAndIndent $ docLines $ bindDocs) (docSetBaseAndIndent $ docLines $ bindDocs)
, docSeq , docSeq
[ docLit $ Text.pack "in " [ docLit $ Text.pack "in "
, docAddBaseY BrIndentRegular $ expDoc1 , docAddBaseY BrIndentRegular $ expDoc1
]
] ]
) ]
, ( indentPolicy /= IndentPolicyLeft addAlternativeCond (indentPolicy /= IndentPolicyLeft)
, docLines $ docLines
[ docSeq [ docSeq
[ appSep $ docLit $ Text.pack "let" [ appSep $ docLit $ Text.pack "let"
, docSetBaseAndIndent $ docLines $ bindDocs , docSetBaseAndIndent $ docLines $ bindDocs
]
, docSeq
[ appSep $ docLit $ Text.pack "in "
, docSetBaseY $ expDoc1
]
] ]
) , docSeq
, ( True [ appSep $ docLit $ Text.pack "in "
, docLines , docSetBaseY $ expDoc1
[ docAddBaseY BrIndentRegular
$ docPar
(docLit $ Text.pack "let")
(docSetBaseAndIndent $ docLines $ bindDocs)
, docAddBaseY BrIndentRegular
$ docPar
(docLit $ Text.pack "in")
(docSetBaseY $ expDoc1)
] ]
) ]
] addAlternative
$ docLines
[ docAddBaseY BrIndentRegular
$ docPar
(docLit $ Text.pack "let")
(docSetBaseAndIndent $ docLines $ bindDocs)
, docAddBaseY BrIndentRegular
$ docPar
(docLit $ Text.pack "in")
(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
@ -660,11 +645,11 @@ layoutExpr lexpr@(L _ expr) = do
HsDo x (L _ stmts) _ | case x of { ListComp -> True HsDo x (L _ stmts) _ | case x of { ListComp -> True
; MonadComp -> True ; MonadComp -> True
; _ -> 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
$ docLit $ docLit
@ -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,12 +679,11 @@ 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
ExplicitList _ _ elems@(_:_) -> do ExplicitList _ _ elems@(_:_) -> do
elemDocs <- elems `forM` docSharedWrapper layoutExpr elemDocs <- elems `forM` docSharedWrapper layoutExpr
hasComments <- hasAnyCommentsBelow lexpr hasComments <- hasAnyCommentsBelow lexpr
case splitFirstLast elemDocs of case splitFirstLast elemDocs of
FirstLastEmpty -> docSeq FirstLastEmpty -> docSeq
@ -721,23 +705,21 @@ 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 ->
docCols ColList [docCommaSep, d] docCols ColList [docCommaSep, d]
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,67 +852,65 @@ 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
$ rFs <&> \case $ rFs <&> \case
(lfield, fieldStr, Just fieldDoc) -> (lfield, fieldStr, Just fieldDoc) ->
docWrapNode lfield $ docSeq docWrapNode lfield $ docSeq
[ appSep $ docLit fieldStr [ appSep $ docLit fieldStr
, appSep $ docLit $ Text.pack "=" , appSep $ docLit $ Text.pack "="
, docForceSingleline fieldDoc , docForceSingleline fieldDoc
] ]
(lfield, fieldStr, Nothing) -> (lfield, fieldStr, Nothing) ->
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
[ appSep $ docLit $ Text.pack "{" [ appSep $ docLit $ Text.pack "{"
, docWrapNodePrior rF1f $ appSep $ docLit $ rF1n , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n
, case rF1e of , case rF1e of
Just x -> docWrapNodeRest rF1f $ docSeq Just x -> docWrapNodeRest rF1f $ docSeq
[ appSep $ docLit $ Text.pack "=" [ appSep $ docLit $ Text.pack "="
, docForceSingleline x
]
Nothing -> docEmpty
]
lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate
[ docCommaSep
, appSep $ docLit $ fText
, case fDoc of
Just x -> docSeq [ appSep $ docLit $ Text.pack "="
, docForceSingleline x , docForceSingleline x
] ]
Nothing -> docEmpty Nothing -> docEmpty
] ]
lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate lineN = docSeq
[ docCommaSep [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty
, appSep $ docLit $ fText , docLit $ Text.pack "}"
, case fDoc of ]
Just x -> docSeq [ appSep $ docLit $ Text.pack "=" in [line1] ++ lineR ++ [lineN]
, docForceSingleline x ]
] -- non-hanging with expressions placed to the right of the names
Nothing -> docEmpty -- container
] -- { fieldA = blub
lineN = docSeq -- , fieldB = potentially
[ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty -- multiline
, docLit $ Text.pack "}" -- }
] addAlternative
in [line1] ++ lineR ++ [lineN] $ docSetParSpacing
]
)
-- non-hanging with expressions placed to the right of the names
-- container
-- { fieldA = blub
-- , fieldB = potentially
-- multiline
-- }
, ( True
, 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 */

39
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 $
docParenR docPar (docSeq [docParenLSep, docWrapNodeRest llies docEmpty])
) docParenR
] (ieDsH:ieDsT) -> runFilteredAlternative $ do
(ieDsH:ieDsT) -> docAltFilter addAlternativeCond (not hasComments && enableSingleline)
[ ( not hasComments && enableSingleline $ docSeq
, 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]
)
]

30
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 (docSeq [hidDoc, docParenLSep, docNonBottomSpacing ieD])
, docPar (docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)
(docSeq [hidDoc, docParenLSep, docNonBottomSpacing ieD])
(docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)
)
]
-- ..[hiding].( b -- ..[hiding].( b
-- , b' -- , b'
-- ) -- )

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

@ -38,25 +38,27 @@ 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 $
[ appSep $ docLit $ Text.pack "module" docForceSingleline
, appSep $ docLit tn $ docSeq
, docWrapNode lmod $ appSep $ case les of [ appSep $ docLit $ Text.pack "module"
Nothing -> docEmpty , appSep $ docLit tn
Just x -> layoutLLIEs True x , docWrapNode lmod $ appSep $ case les of
, docLit $ Text.pack "where" Nothing -> docEmpty
] Just x -> layoutLLIEs True x
, (,) otherwise $ docLines , docLit $ Text.pack "where"
[ docAddBaseY BrIndentRegular $ docPar ]
(docSeq [appSep $ docLit $ Text.pack "module", docLit tn] addAlternative
) $ docLines
(docWrapNode lmod $ case les of [ docAddBaseY BrIndentRegular $ docPar
Nothing -> docEmpty (docSeq [appSep $ docLit $ Text.pack "module", docLit tn]
Just x -> layoutLLIEs False x )
) (docWrapNode lmod $ case les of
, docLit $ Text.pack "where" Nothing -> docEmpty
] Just x -> layoutLLIEs False x
] )
, docLit $ Text.pack "where"
]
] ]
: map layoutImport imports : map layoutImport imports

68
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 addAlternative $
( True 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
-- stmt2
-- stmt3
addAlternativeCond (indentPolicy /= IndentPolicyLeft)
$ docSeq
[ docLit (Text.pack "rec")
, docSeparator
, docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts
] ]
RecStmt stmts _ _ _ _ _ _ _ _ _ -> docAltFilter -- rec
[ -- rec stmt1 -- stmt1
-- stmt2 -- stmt2
-- stmt3 -- stmt3
( indentPolicy /= IndentPolicyLeft addAlternative
, docSeq $ docAddBaseY BrIndentRegular
[ docLit (Text.pack "rec") $ docPar (docLit (Text.pack "rec")) (docLines $ layoutStmt <$> stmts)
, docSeparator
, docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts
]
)
, -- rec
-- stmt1
-- stmt2
-- stmt3
( True
, docAddBaseY BrIndentRegular
$ 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:
- . - .