Replace 'docAltFilter' with 'runFilteredAlternative'
Sergey Vinokurov
parent
8410fbff8e
commit
2ed9a13fdb
|
|
@ -1,3 +1,5 @@
|
|||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
|
||||
module Language.Haskell.Brittany.Internal.LayouterBasics
|
||||
( processDefault
|
||||
, rdrNameToText
|
||||
|
|
@ -11,7 +13,11 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
|
|||
, docEmpty
|
||||
, docLit
|
||||
, docAlt
|
||||
, docAltFilter
|
||||
, CollectAltM
|
||||
, addAlternativeCondM
|
||||
, addAlternativeCond
|
||||
, addAlternative
|
||||
, runFilteredAlternative
|
||||
, docLines
|
||||
, docCols
|
||||
, docSeq
|
||||
|
|
@ -60,6 +66,8 @@ where
|
|||
|
||||
#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.Annotate as ExactPrint.Annotate
|
||||
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 l = allocateNode . BDFAlt =<< sequence l
|
||||
|
||||
docAltFilter :: [(Bool, ToBriDocM BriDocNumbered)] -> ToBriDocM BriDocNumbered
|
||||
docAltFilter = docAlt . map snd . filter fst
|
||||
newtype CollectAltM a = CollectAltM (Writer.Writer [ToBriDocM BriDocNumbered] a)
|
||||
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
|
||||
|
|
|
|||
|
|
@ -313,34 +313,33 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
|
|||
<&> _conf_layout
|
||||
.> _lconfig_indentPolicy
|
||||
.> confUnpack
|
||||
docAltFilter
|
||||
$ -- one-line solution
|
||||
[ ( True
|
||||
, docCols
|
||||
runFilteredAlternative $ do
|
||||
|
||||
let wherePart = case mWhereDocs of
|
||||
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)
|
||||
[ docSeq (patPartInline ++ [guardPart])
|
||||
, docSeq
|
||||
[ appSep $ return binderDoc
|
||||
, docForceSingleline $ return body
|
||||
, wherePart
|
||||
, wherePart'
|
||||
]
|
||||
]
|
||||
)
|
||||
| not hasComments
|
||||
, [(guards, body, _bodyRaw)] <- [clauseDocs]
|
||||
, 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
|
||||
-- one-line solution + where in next line(s)
|
||||
addAlternativeCond (Data.Maybe.isJust mWhereDocs)
|
||||
$ docLines
|
||||
$ [ docCols
|
||||
(ColBindingLine alignmentToken)
|
||||
[ docSeq (patPartInline ++ [guardPart])
|
||||
|
|
@ -349,27 +348,18 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
|
|||
]
|
||||
]
|
||||
++ wherePartMultiLine
|
||||
)
|
||||
| [(guards, body, _bodyRaw)] <- [clauseDocs]
|
||||
, let guardPart = singleLineGuardsDoc guards
|
||||
, Data.Maybe.isJust mWhereDocs
|
||||
]
|
||||
++ -- two-line solution + where in next line(s)
|
||||
[ ( True
|
||||
, docLines
|
||||
-- two-line solution + where in next line(s)
|
||||
addAlternative
|
||||
$ docLines
|
||||
$ [ docForceSingleline
|
||||
$ docSeq (patPartInline ++ [guardPart, return binderDoc])
|
||||
, docEnsureIndent BrIndentRegular $ docForceSingleline $ return body
|
||||
]
|
||||
++ wherePartMultiLine
|
||||
)
|
||||
| [(guards, body, _bodyRaw)] <- [clauseDocs]
|
||||
, let guardPart = singleLineGuardsDoc guards
|
||||
]
|
||||
++ -- pattern and exactly one clause in single line, body as par;
|
||||
-- pattern and exactly one clause in single line, body as par;
|
||||
-- where in following lines
|
||||
[ ( True
|
||||
, docLines
|
||||
addAlternative
|
||||
$ docLines
|
||||
$ [ docCols
|
||||
(ColBindingLine alignmentToken)
|
||||
[ docSeq (patPartInline ++ [guardPart])
|
||||
|
|
@ -384,28 +374,27 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
|
|||
-- , docAddBaseY BrIndentRegular $ return body
|
||||
-- ]
|
||||
++ wherePartMultiLine
|
||||
)
|
||||
| [(guards, body, _bodyRaw)] <- [clauseDocs]
|
||||
, let guardPart = singleLineGuardsDoc guards
|
||||
]
|
||||
++ -- pattern and exactly one clause in single line, body in new line.
|
||||
[ ( True
|
||||
, docLines
|
||||
-- pattern and exactly one clause in single line, body in new line.
|
||||
addAlternative
|
||||
$ docLines
|
||||
$ [ docSeq (patPartInline ++ [guardPart, return binderDoc])
|
||||
, docEnsureIndent BrIndentRegular
|
||||
$ docNonBottomSpacing
|
||||
$ (docAddBaseY BrIndentRegular $ return body)
|
||||
$ docAddBaseY BrIndentRegular
|
||||
$ return body
|
||||
]
|
||||
++ wherePartMultiLine
|
||||
)
|
||||
| [(guards, body, _)] <- [clauseDocs]
|
||||
, let guardPart = singleLineGuardsDoc guards
|
||||
]
|
||||
++ -- multiple clauses added in-paragraph, each in a single line
|
||||
|
||||
_ -> return ()
|
||||
|
||||
case mPatDoc of
|
||||
Nothing -> return ()
|
||||
Just patDoc ->
|
||||
-- multiple clauses added in-paragraph, each in a single line
|
||||
-- example: foo | bar = baz
|
||||
-- | lll = asd
|
||||
[ ( indentPolicy /= IndentPolicyLeft
|
||||
, docLines
|
||||
addAlternativeCond (indentPolicy /= IndentPolicyLeft)
|
||||
$ docLines
|
||||
$ [ docSeq
|
||||
[ appSep $ docForceSingleline $ return patDoc
|
||||
, docSetBaseY
|
||||
|
|
@ -429,12 +418,9 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
|
|||
]
|
||||
]
|
||||
++ wherePartMultiLine
|
||||
)
|
||||
| Just patDoc <- [mPatDoc]
|
||||
]
|
||||
++ -- multiple clauses, each in a separate, single line
|
||||
[ ( True
|
||||
, docLines
|
||||
-- multiple clauses, each in a separate, single line
|
||||
addAlternative
|
||||
$ docLines
|
||||
$ [ docAddBaseY BrIndentRegular
|
||||
$ patPartParWrap
|
||||
$ docLines
|
||||
|
|
@ -457,12 +443,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
|
|||
]
|
||||
]
|
||||
++ 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
|
||||
[ ( True
|
||||
, docLines
|
||||
addAlternative
|
||||
$ docLines
|
||||
$ [ docAddBaseY BrIndentRegular
|
||||
$ patPartParWrap
|
||||
$ docLines
|
||||
|
|
@ -494,12 +478,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
|
|||
]
|
||||
]
|
||||
++ 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
|
||||
[ ( True
|
||||
, docLines
|
||||
addAlternative
|
||||
$ docLines
|
||||
$ [ docAddBaseY BrIndentRegular
|
||||
$ patPartParWrap
|
||||
$ docLines
|
||||
|
|
@ -529,11 +511,9 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
|
|||
]
|
||||
]
|
||||
++ wherePartMultiLine
|
||||
)
|
||||
]
|
||||
++ -- conservative approach: everything starts on the left.
|
||||
[ ( True
|
||||
, docLines
|
||||
-- conservative approach: everything starts on the left.
|
||||
addAlternative
|
||||
$ docLines
|
||||
$ [ docAddBaseY BrIndentRegular
|
||||
$ patPartParWrap
|
||||
$ docLines
|
||||
|
|
@ -561,5 +541,3 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
|
|||
]
|
||||
]
|
||||
++ wherePartMultiLine
|
||||
)
|
||||
]
|
||||
|
|
|
|||
|
|
@ -123,51 +123,46 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
_ -> docSeq
|
||||
headDoc <- docSharedWrapper layoutExpr headE
|
||||
paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs
|
||||
docAltFilter
|
||||
[ -- foo x y
|
||||
( True
|
||||
, colsOrSequence
|
||||
runFilteredAlternative $ do
|
||||
-- foo x y
|
||||
addAlternative
|
||||
$ colsOrSequence
|
||||
$ appSep (docForceSingleline headDoc)
|
||||
: spacifyDocs (docForceSingleline <$> paramDocs)
|
||||
)
|
||||
, -- foo x
|
||||
-- foo x
|
||||
-- y
|
||||
( allowFreeIndent
|
||||
, docSeq
|
||||
addAlternativeCond allowFreeIndent
|
||||
$ docSeq
|
||||
[ appSep (docForceSingleline headDoc)
|
||||
, docSetBaseY
|
||||
$ docAddBaseY BrIndentRegular
|
||||
$ docLines
|
||||
$ (docForceSingleline <$> paramDocs)
|
||||
]
|
||||
)
|
||||
, -- foo
|
||||
-- foo
|
||||
-- x
|
||||
-- y
|
||||
( True
|
||||
, docSetParSpacing
|
||||
addAlternative
|
||||
$ docSetParSpacing
|
||||
$ docAddBaseY BrIndentRegular
|
||||
$ docPar
|
||||
(docForceSingleline headDoc)
|
||||
( docNonBottomSpacing
|
||||
$ docLines paramDocs
|
||||
)
|
||||
)
|
||||
, -- ( multi
|
||||
-- ( multi
|
||||
-- line
|
||||
-- function
|
||||
-- )
|
||||
-- x
|
||||
-- y
|
||||
( True
|
||||
, docAddBaseY BrIndentRegular
|
||||
addAlternative
|
||||
$ docAddBaseY BrIndentRegular
|
||||
$ docPar
|
||||
headDoc
|
||||
( docNonBottomSpacing
|
||||
$ docLines paramDocs
|
||||
)
|
||||
)
|
||||
]
|
||||
HsApp exp1 exp2 -> do
|
||||
-- TODO: if expDoc1 is some literal, we may want to create a docCols here.
|
||||
expDoc1 <- docSharedWrapper layoutExpr exp1
|
||||
|
|
@ -243,9 +238,9 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
| occNameString occname == "$" -> True
|
||||
(_, L _ (HsApp _ (L _ HsVar{}))) -> False
|
||||
_ -> True
|
||||
docAltFilter
|
||||
[ ( not hasComments
|
||||
, docSeq
|
||||
runFilteredAlternative $ do
|
||||
addAlternativeCond (not hasComments)
|
||||
$ docSeq
|
||||
[ appSep $ docForceSingleline leftOperandDoc
|
||||
, docSeq
|
||||
$ (appListDocs <&> \(od, ed) -> docSeq
|
||||
|
|
@ -257,25 +252,23 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
, (if allowPar then docForceParSpacing else docForceSingleline)
|
||||
expLastDoc
|
||||
]
|
||||
)
|
||||
-- this case rather leads to some unfortunate layouting than to anything
|
||||
-- useful; disabling for now. (it interfers with cols stuff.)
|
||||
-- , docSetBaseY
|
||||
-- - $ docPar
|
||||
-- addAlternative
|
||||
-- $ docSetBaseY
|
||||
-- $ docPar
|
||||
-- leftOperandDoc
|
||||
-- ( 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]]
|
||||
-- )
|
||||
, (otherwise
|
||||
, docPar
|
||||
addAlternative $
|
||||
docPar
|
||||
leftOperandDoc
|
||||
( docLines
|
||||
$ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])
|
||||
++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]]
|
||||
)
|
||||
)
|
||||
]
|
||||
OpApp expLeft expOp _ expRight -> do
|
||||
expDocLeft <- docSharedWrapper layoutExpr expLeft
|
||||
expDocOp <- docSharedWrapper layoutExpr expOp
|
||||
|
|
@ -285,42 +278,42 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
| occNameString occname == "$" -> True
|
||||
(_, L _ (HsApp _ (L _ HsVar{}))) -> False
|
||||
_ -> True
|
||||
docAltFilter
|
||||
$ [ -- one-line
|
||||
(,) True
|
||||
runFilteredAlternative $ do
|
||||
-- one-line
|
||||
addAlternative
|
||||
$ docSeq
|
||||
[ appSep $ docForceSingleline expDocLeft
|
||||
, appSep $ docForceSingleline expDocOp
|
||||
, docForceSingleline expDocRight
|
||||
]
|
||||
-- , -- line + freely indented block for right expression
|
||||
-- docSeq
|
||||
-- -- line + freely indented block for right expression
|
||||
-- addAlternative
|
||||
-- $ docSeq
|
||||
-- [ appSep $ docForceSingleline expDocLeft
|
||||
-- , appSep $ docForceSingleline expDocOp
|
||||
-- , docSetBaseY $ docAddBaseY BrIndentRegular expDocRight
|
||||
-- ]
|
||||
, -- two-line
|
||||
(,) True
|
||||
-- two-line
|
||||
addAlternative
|
||||
$ docAddBaseY BrIndentRegular
|
||||
$ docPar
|
||||
expDocLeft
|
||||
( docForceSingleline
|
||||
$ docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight]
|
||||
)
|
||||
, -- one-line + par
|
||||
(,) allowPar
|
||||
-- one-line + par
|
||||
addAlternativeCond allowPar
|
||||
$ docSeq
|
||||
[ appSep $ docForceSingleline expDocLeft
|
||||
, appSep $ docForceSingleline expDocOp
|
||||
, docForceParSpacing expDocRight
|
||||
]
|
||||
, -- more lines
|
||||
(,) True
|
||||
-- more lines
|
||||
addAlternative
|
||||
$ docAddBaseY BrIndentRegular
|
||||
$ docPar
|
||||
expDocLeft
|
||||
(docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight])
|
||||
]
|
||||
NegApp op _ -> do
|
||||
opDoc <- docSharedWrapper layoutExpr op
|
||||
docSeq $ [ docLit $ Text.pack "-"
|
||||
|
|
@ -380,16 +373,14 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
, closeLit
|
||||
]
|
||||
]
|
||||
FirstLast e1 ems eN ->
|
||||
docAltFilter
|
||||
[ (,) (not hasComments)
|
||||
FirstLast e1 ems eN -> runFilteredAlternative $ do
|
||||
addAlternativeCond (not hasComments)
|
||||
$ docCols ColTuple
|
||||
( [docSeq [openLit, docForceSingleline e1]]
|
||||
$ [docSeq [openLit, docForceSingleline e1]]
|
||||
++ (ems <&> \e -> docSeq [docCommaSep, docForceSingleline e])
|
||||
++ [docSeq [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) (docForceSingleline eN), closeLit]]
|
||||
)
|
||||
, (,) True
|
||||
$ let
|
||||
addAlternative $
|
||||
let
|
||||
start = docCols ColTuples
|
||||
[appSep $ openLit, e1]
|
||||
linesM = ems <&> \d ->
|
||||
|
|
@ -397,7 +388,6 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN]
|
||||
end = closeLit
|
||||
in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]
|
||||
]
|
||||
HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do
|
||||
cExpDoc <- docSharedWrapper layoutExpr cExp
|
||||
binderDoc <- docLit $ Text.pack "->"
|
||||
|
|
@ -432,9 +422,9 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
_ -> BrIndentSpecial 3
|
||||
-- TODO: some of the alternatives (especially last and last-but-one)
|
||||
-- overlap.
|
||||
docAltFilter
|
||||
[ -- if _ then _ else _
|
||||
(,) (not hasComments)
|
||||
runFilteredAlternative $ do
|
||||
-- if _ then _ else _
|
||||
addAlternativeCond (not hasComments)
|
||||
$ docSeq
|
||||
[ appSep $ docLit $ Text.pack "if"
|
||||
, appSep $ docForceSingleline ifExprDoc
|
||||
|
|
@ -443,7 +433,7 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
, appSep $ docLit $ Text.pack "else"
|
||||
, docForceSingleline elseExprDoc
|
||||
]
|
||||
, -- either
|
||||
-- either
|
||||
-- if expr
|
||||
-- then foo
|
||||
-- bar
|
||||
|
|
@ -456,7 +446,7 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
-- else
|
||||
-- stuff
|
||||
-- note that this has par-spacing
|
||||
(,) True
|
||||
addAlternative
|
||||
$ docSetParSpacing
|
||||
$ docAddBaseY BrIndentRegular
|
||||
$ docPar
|
||||
|
|
@ -479,7 +469,7 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
$ docPar (docLit $ Text.pack "else") elseExprDoc
|
||||
]
|
||||
])
|
||||
, -- either
|
||||
-- either
|
||||
-- if multi
|
||||
-- line
|
||||
-- condition
|
||||
|
|
@ -496,7 +486,7 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
-- else
|
||||
-- stuff
|
||||
-- note that this does _not_ have par-spacing
|
||||
(,) True
|
||||
addAlternative
|
||||
$ docAddBaseY BrIndentRegular
|
||||
$ docPar
|
||||
( docAddBaseY maySpecialIndent
|
||||
|
|
@ -519,7 +509,7 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
$ docPar (docLit $ Text.pack "else") elseExprDoc
|
||||
]
|
||||
])
|
||||
, (,) True
|
||||
addAlternative
|
||||
$ docSetBaseY
|
||||
$ docLines
|
||||
[ docAddBaseY maySpecialIndent
|
||||
|
|
@ -533,7 +523,6 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
, docAddBaseY BrIndentRegular
|
||||
$ docPar (docLit $ Text.pack "else") elseExprDoc
|
||||
]
|
||||
]
|
||||
HsMultiIf _ cases -> do
|
||||
clauseDocs <- cases `forM` layoutGrhs
|
||||
binderDoc <- docLit $ Text.pack "->"
|
||||
|
|
@ -590,7 +579,7 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
]
|
||||
]
|
||||
]
|
||||
Just bindDocs@(_:_) -> docAltFilter
|
||||
Just bindDocs@(_:_) -> runFilteredAlternative $ do
|
||||
--either
|
||||
-- let
|
||||
-- a = b
|
||||
|
|
@ -604,8 +593,8 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
-- c = d
|
||||
-- in
|
||||
-- fooooooooooooooooooo
|
||||
[ ( indentPolicy == IndentPolicyLeft
|
||||
, docLines
|
||||
addAlternativeCond (indentPolicy == IndentPolicyLeft)
|
||||
$ docLines
|
||||
[ docAddBaseY BrIndentRegular
|
||||
$ docPar
|
||||
(docLit $ Text.pack "let")
|
||||
|
|
@ -615,9 +604,8 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
, docAddBaseY BrIndentRegular $ expDoc1
|
||||
]
|
||||
]
|
||||
)
|
||||
, ( indentPolicy /= IndentPolicyLeft
|
||||
, docLines
|
||||
addAlternativeCond (indentPolicy /= IndentPolicyLeft)
|
||||
$ docLines
|
||||
[ docSeq
|
||||
[ appSep $ docLit $ Text.pack "let"
|
||||
, docSetBaseAndIndent $ docLines $ bindDocs
|
||||
|
|
@ -627,9 +615,8 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
, docSetBaseY $ expDoc1
|
||||
]
|
||||
]
|
||||
)
|
||||
, ( True
|
||||
, docLines
|
||||
addAlternative
|
||||
$ docLines
|
||||
[ docAddBaseY BrIndentRegular
|
||||
$ docPar
|
||||
(docLit $ Text.pack "let")
|
||||
|
|
@ -639,8 +626,6 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
(docLit $ Text.pack "in")
|
||||
(docSetBaseY $ expDoc1)
|
||||
]
|
||||
)
|
||||
]
|
||||
_ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1]
|
||||
-- docSeq [appSep $ docLit "let in", expDoc1]
|
||||
HsDo DoExpr (L _ stmts) _ -> do
|
||||
|
|
@ -662,8 +647,8 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
; _ -> False } -> do
|
||||
stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
|
||||
hasComments <- hasAnyCommentsBelow lexpr
|
||||
docAltFilter
|
||||
[ (,) (not hasComments)
|
||||
runFilteredAlternative $ do
|
||||
addAlternativeCond (not hasComments)
|
||||
$ docSeq
|
||||
[ docNodeAnnKW lexpr Nothing
|
||||
$ appSep
|
||||
|
|
@ -678,8 +663,8 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
$ fmap docForceSingleline $ List.init stmtDocs
|
||||
, docLit $ Text.pack " ]"
|
||||
]
|
||||
, (,) True
|
||||
$ let
|
||||
addAlternative $
|
||||
let
|
||||
start = docCols ColListComp
|
||||
[ docNodeAnnKW lexpr Nothing
|
||||
$ appSep $ docLit $ Text.pack "["
|
||||
|
|
@ -694,7 +679,6 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
docCols ColListComp [docCommaSep, d]
|
||||
end = docLit $ Text.pack "]"
|
||||
in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end]
|
||||
]
|
||||
HsDo{} -> do
|
||||
-- TODO
|
||||
unknownNodeError "HsDo{} no comp" lexpr
|
||||
|
|
@ -721,15 +705,14 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
, docLit $ Text.pack "]"
|
||||
]
|
||||
]
|
||||
FirstLast e1 ems eN ->
|
||||
docAltFilter
|
||||
[ (,) (not hasComments)
|
||||
FirstLast e1 ems eN -> runFilteredAlternative $ do
|
||||
addAlternativeCond (not hasComments)
|
||||
$ docSeq
|
||||
$ [docLit $ Text.pack "["]
|
||||
++ List.intersperse docCommaSep (docForceSingleline <$> (e1:ems ++ [docNodeAnnKW lexpr (Just AnnOpenS) eN]))
|
||||
++ [docLit $ Text.pack "]"]
|
||||
, (,) True
|
||||
$ let
|
||||
addAlternative $
|
||||
let
|
||||
start = docCols ColList
|
||||
[appSep $ docLit $ Text.pack "[", e1]
|
||||
linesM = ems <&> \d ->
|
||||
|
|
@ -737,7 +720,6 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
lineN = docCols ColList [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenS) eN]
|
||||
end = docLit $ Text.pack "]"
|
||||
in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]
|
||||
]
|
||||
ExplicitList _ _ [] ->
|
||||
docLit $ Text.pack "[]"
|
||||
ExplicitPArr{} -> do
|
||||
|
|
@ -870,10 +852,10 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
return $ case ambName of
|
||||
Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)
|
||||
Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)
|
||||
docAltFilter
|
||||
runFilteredAlternative $ do
|
||||
-- container { fieldA = blub, fieldB = blub }
|
||||
[ ( True
|
||||
, docSeq
|
||||
addAlternative
|
||||
$ docSeq
|
||||
[ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc
|
||||
, appSep $ docLit $ Text.pack "{"
|
||||
, appSep $ docSeq $ List.intersperse docCommaSep
|
||||
|
|
@ -888,13 +870,12 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
docWrapNode lfield $ docLit fieldStr
|
||||
, docLit $ Text.pack "}"
|
||||
]
|
||||
)
|
||||
-- hanging single-line fields
|
||||
-- container { fieldA = blub
|
||||
-- , fieldB = blub
|
||||
-- }
|
||||
, ( indentPolicy /= IndentPolicyLeft
|
||||
, docSeq
|
||||
addAlternativeCond (indentPolicy /= IndentPolicyLeft)
|
||||
$ docSeq
|
||||
[ docNodeAnnKW lexpr Nothing $ appSep rExprDoc
|
||||
, docSetBaseY $ docLines $ let
|
||||
line1 = docCols ColRecUpdate
|
||||
|
|
@ -922,15 +903,14 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
]
|
||||
in [line1] ++ lineR ++ [lineN]
|
||||
]
|
||||
)
|
||||
-- non-hanging with expressions placed to the right of the names
|
||||
-- container
|
||||
-- { fieldA = blub
|
||||
-- , fieldB = potentially
|
||||
-- multiline
|
||||
-- }
|
||||
, ( True
|
||||
, docSetParSpacing
|
||||
addAlternative
|
||||
$ docSetParSpacing
|
||||
$ docAddBaseY BrIndentRegular
|
||||
$ docPar
|
||||
(docNodeAnnKW lexpr Nothing $ rExprDoc)
|
||||
|
|
@ -971,8 +951,6 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
]
|
||||
in [line1] ++ lineR ++ [lineN]
|
||||
)
|
||||
)
|
||||
]
|
||||
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
|
||||
ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do
|
||||
#else /* ghc-8.0 */
|
||||
|
|
|
|||
|
|
@ -46,18 +46,15 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
|
|||
IEThingWith _ (IEWildcard _) _ _ -> docSeq [ien, docLit $ Text.pack "(..)"]
|
||||
IEThingWith _ _ ns _ -> do
|
||||
hasComments <- hasAnyCommentsBelow lie
|
||||
docAltFilter
|
||||
[ ( not hasComments
|
||||
, docSeq
|
||||
runFilteredAlternative $ do
|
||||
addAlternativeCond (not hasComments)
|
||||
$ docSeq
|
||||
$ [ien, docLit $ Text.pack "("]
|
||||
++ intersperse docCommaSep (map nameDoc ns)
|
||||
++ [docParenR]
|
||||
)
|
||||
, (otherwise
|
||||
, docAddBaseY BrIndentRegular
|
||||
addAlternative
|
||||
$ docAddBaseY BrIndentRegular
|
||||
$ docPar ien (layoutItems (splitFirstLast ns))
|
||||
)
|
||||
]
|
||||
where
|
||||
nameDoc = (docLit =<<) . lrdrNameToTextAnn . prepareName
|
||||
layoutItem n = docSeq [docCommaSep, docWrapNode n $ nameDoc n]
|
||||
|
|
@ -122,24 +119,20 @@ layoutLLIEs enableSingleline llies = do
|
|||
ieDs <- layoutAnnAndSepLLIEs llies
|
||||
hasComments <- hasAnyCommentsBelow llies
|
||||
case ieDs of
|
||||
[] -> docAltFilter
|
||||
[ (not hasComments, docLit $ Text.pack "()")
|
||||
, ( hasComments
|
||||
, docPar (docSeq [docParenLSep, docWrapNodeRest llies docEmpty])
|
||||
[] -> runFilteredAlternative $ do
|
||||
addAlternativeCond (not hasComments) $
|
||||
docLit $ Text.pack "()"
|
||||
addAlternativeCond hasComments $
|
||||
docPar (docSeq [docParenLSep, docWrapNodeRest llies docEmpty])
|
||||
docParenR
|
||||
)
|
||||
]
|
||||
(ieDsH:ieDsT) -> docAltFilter
|
||||
[ ( not hasComments && enableSingleline
|
||||
, docSeq
|
||||
(ieDsH:ieDsT) -> runFilteredAlternative $ do
|
||||
addAlternativeCond (not hasComments && enableSingleline)
|
||||
$ docSeq
|
||||
$ [docLit (Text.pack "(")]
|
||||
++ (docForceSingleline <$> ieDs)
|
||||
++ [docParenR]
|
||||
)
|
||||
, ( otherwise
|
||||
, docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH])
|
||||
addAlternative
|
||||
$ docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH])
|
||||
$ docLines
|
||||
$ ieDsT
|
||||
++ [docParenR]
|
||||
)
|
||||
]
|
||||
|
|
|
|||
|
|
@ -98,25 +98,21 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of
|
|||
[] -> if hasComments
|
||||
then docPar
|
||||
(docSeq [hidDoc, docParenLSep, docWrapNode llies docEmpty])
|
||||
(docEnsureIndent (BrIndentSpecial hidDocColDiff) $ docParenR)
|
||||
(docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)
|
||||
else docSeq [hidDoc, docParenLSep, docSeparator, docParenR]
|
||||
-- ..[hiding].( b )
|
||||
[ieD] -> docAltFilter
|
||||
[ ( not hasComments
|
||||
, docSeq
|
||||
[ieD] -> runFilteredAlternative $ do
|
||||
addAlternativeCond (not hasComments)
|
||||
$ docSeq
|
||||
[ hidDoc
|
||||
, docParenLSep
|
||||
, docForceSingleline $ ieD
|
||||
, docForceSingleline ieD
|
||||
, docSeparator
|
||||
, docParenR
|
||||
]
|
||||
)
|
||||
, ( otherwise
|
||||
, docPar
|
||||
addAlternative $ docPar
|
||||
(docSeq [hidDoc, docParenLSep, docNonBottomSpacing ieD])
|
||||
(docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)
|
||||
)
|
||||
]
|
||||
-- ..[hiding].( b
|
||||
-- , b'
|
||||
-- )
|
||||
|
|
|
|||
|
|
@ -38,8 +38,10 @@ layoutModule lmod@(L _ mod') = case mod' of
|
|||
[ docNodeAnnKW lmod Nothing docEmpty
|
||||
-- A pseudo node that serves merely to force documentation
|
||||
-- before the node
|
||||
, docNodeMoveToKWDP lmod AnnModule $ docAltFilter
|
||||
[ (,) allowSingleLineExportList $ docForceSingleline $ docSeq
|
||||
, docNodeMoveToKWDP lmod AnnModule $ runFilteredAlternative $ do
|
||||
addAlternativeCond allowSingleLineExportList $
|
||||
docForceSingleline
|
||||
$ docSeq
|
||||
[ appSep $ docLit $ Text.pack "module"
|
||||
, appSep $ docLit tn
|
||||
, docWrapNode lmod $ appSep $ case les of
|
||||
|
|
@ -47,7 +49,8 @@ layoutModule lmod@(L _ mod') = case mod' of
|
|||
Just x -> layoutLLIEs True x
|
||||
, docLit $ Text.pack "where"
|
||||
]
|
||||
, (,) otherwise $ docLines
|
||||
addAlternative
|
||||
$ docLines
|
||||
[ docAddBaseY BrIndentRegular $ docPar
|
||||
(docSeq [appSep $ docLit $ Text.pack "module", docLit tn]
|
||||
)
|
||||
|
|
@ -58,5 +61,4 @@ layoutModule lmod@(L _ mod') = case mod' of
|
|||
, docLit $ Text.pack "where"
|
||||
]
|
||||
]
|
||||
]
|
||||
: map layoutImport imports
|
||||
|
|
|
|||
|
|
@ -71,46 +71,40 @@ layoutStmt lstmt@(L _ stmt) = do
|
|||
(docLit $ Text.pack "let")
|
||||
(docSetBaseAndIndent $ return bindDoc)
|
||||
]
|
||||
Just bindDocs -> docAltFilter
|
||||
[ -- let aaa = expra
|
||||
Just bindDocs -> runFilteredAlternative $ do
|
||||
-- let aaa = expra
|
||||
-- bbb = exprb
|
||||
-- ccc = exprc
|
||||
( indentPolicy /= IndentPolicyLeft
|
||||
, docSeq
|
||||
addAlternativeCond (indentPolicy /= IndentPolicyLeft)
|
||||
$ docSeq
|
||||
[ appSep $ docLit $ Text.pack "let"
|
||||
, docSetBaseAndIndent $ docLines $ return <$> bindDocs
|
||||
]
|
||||
)
|
||||
, -- let
|
||||
-- let
|
||||
-- aaa = expra
|
||||
-- bbb = exprb
|
||||
-- ccc = exprc
|
||||
( True
|
||||
, docAddBaseY BrIndentRegular $ docPar
|
||||
addAlternative $
|
||||
docAddBaseY BrIndentRegular $ docPar
|
||||
(docLit $ Text.pack "let")
|
||||
(docSetBaseAndIndent $ docLines $ return <$> bindDocs)
|
||||
)
|
||||
]
|
||||
RecStmt stmts _ _ _ _ _ _ _ _ _ -> docAltFilter
|
||||
[ -- rec stmt1
|
||||
RecStmt stmts _ _ _ _ _ _ _ _ _ -> runFilteredAlternative $ do
|
||||
-- rec stmt1
|
||||
-- stmt2
|
||||
-- stmt3
|
||||
( indentPolicy /= IndentPolicyLeft
|
||||
, docSeq
|
||||
addAlternativeCond (indentPolicy /= IndentPolicyLeft)
|
||||
$ docSeq
|
||||
[ docLit (Text.pack "rec")
|
||||
, docSeparator
|
||||
, docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts
|
||||
]
|
||||
)
|
||||
, -- rec
|
||||
-- rec
|
||||
-- stmt1
|
||||
-- stmt2
|
||||
-- stmt3
|
||||
( True
|
||||
, docAddBaseY BrIndentRegular
|
||||
addAlternative
|
||||
$ docAddBaseY BrIndentRegular
|
||||
$ docPar (docLit (Text.pack "rec")) (docLines $ layoutStmt <$> stmts)
|
||||
)
|
||||
]
|
||||
BodyStmt expr _ _ _ -> do
|
||||
expDoc <- docSharedWrapper layoutExpr expr
|
||||
docAddBaseY BrIndentRegular $ expDoc
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
resolver: lts-11.0
|
||||
resolver: lts-11.1
|
||||
|
||||
packages:
|
||||
- .
|
||||
|
|
|
|||
Loading…
Reference in New Issue