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

Merge pull request #132 from sergv/master 

Fix some hlint suggestions and Replace docAltFilter
pull/136/head
Lennart Spitzner 2018-04-04 06:50:48 +02:00 committed by GitHub
parent b43ee43220 7ffa58976f
commit 24886e818a
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
15 changed files with 750 additions and 762 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
.hlint.yaml Normal file
View File

@ -0,0 +1,24 @@
# HLint configuration file
# https://github.com/ndmitchell/hlint
##########################
# This file contains a template configuration file, which is typically
# placed as .hlint.yaml in the root of your project
# Specify additional command line arguments
- arguments:
[ "--cpp-include=srcinc"
, "--language=GADTs"
, "--language=LambdaCase"
, "--language=MultiWayIf"
, "--language=KindSignatures"
, "--cross"
, "--threads=0"
]
- ignore: {name: "Use camelCase"}
- ignore: {name: "Redundant as"}
- ignore: {name: "Redundant do"}
- ignore: {name: "Redundant return"}
- ignore: {name: "Redundant guard", whithin: "lrdrNameToTextAnn"}

3
brittany.cabal
View File

@ -244,7 +244,6 @@ test-suite unittests
, ghc-boot-th
, hspec >=2.4.1 && <2.5
}
ghc-options: -Wall
main-is: TestMain.hs
other-modules: TestUtils
AsymptoticPerfTests
@ -314,7 +313,6 @@ test-suite littests
, filepath
, parsec >=3.1.11 && <3.2
}
ghc-options: -Wall
main-is: Main.hs
other-modules:
hs-source-dirs: src-literatetests
@ -355,7 +353,6 @@ test-suite libinterfacetests
, transformers
, hspec >=2.4.1 && <2.5
}
ghc-options: -Wall
main-is: Main.hs
other-modules:
hs-source-dirs: src-libinterfacetests

3
src-brittany/Main.hs
View File

@ -11,6 +11,7 @@ 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.Parsers as ExactPrint.Parsers
import qualified Data.Map as Map
import qualified Data.Monoid
import Text.Read (Read(..))
import qualified Text.ParserCombinators.ReadP as ReadP
@ -148,7 +149,7 @@ mainCmdParser helpDesc = do
, PP.text "inplace: override respective input file (without backup!)"
]
)
<> flagDefault Display
Data.Monoid.<> flagDefault Display
)
inputParams <- addParamNoFlagStrings "PATH" (paramHelpStr "paths to input/inout haskell source files")
reorderStop

4
src/Language/Haskell/Brittany/Internal.hs
View File

@ -93,8 +93,8 @@ parsePrintModule configRaw inputText = runExceptT $ do
cppCheckFunc
(hackTransform $ Text.unpack inputText)
case parseResult of
Left err -> throwE $ [ErrorInput err]
Right x -> pure $ x
Left err -> throwE [ErrorInput err]
Right x -> pure x
(errsWarns, outputTextL) <- do
let omitCheck =
config

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

@ -1,3 +1,5 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Language.Haskell.Brittany.Internal.LayouterBasics
( processDefault
, rdrNameToText
@ -11,7 +13,10 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
, docEmpty
, docLit
, docAlt
, docAltFilter
, CollectAltM
, addAlternativeCond
, addAlternative
, runFilteredAlternative
, docLines
, docCols
, docSeq
@ -60,6 +65,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
@ -111,7 +118,7 @@ processDefault x = do
-- the module (header). This would remove the need for this hack!
case str of
"\n" -> return ()
_ -> mTell $ Text.Builder.fromString $ str
_ -> mTell $ Text.Builder.fromString str
-- | Use ExactPrint's output for this node; add a newly generated inline comment
-- at insertion position (meant to point out to the user that this node is
@ -166,7 +173,7 @@ briDocByExactInlineOnly infoStr ast = do
False
t
let errorAction = do
mTell $ [ErrorUnknownNode infoStr ast]
mTell [ErrorUnknownNode infoStr ast]
docLit
$ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"
case (fallbackMode, Text.lines exactPrinted) of
@ -256,8 +263,8 @@ extractAllComments ann =
)
filterAnns :: Data.Data.Data ast => ast -> ExactPrint.Anns -> ExactPrint.Anns
filterAnns ast anns =
Map.filterWithKey (\k _ -> k `Set.member` foldedAnnKeys ast) anns
filterAnns ast =
Map.filterWithKey (\k _ -> k `Set.member` foldedAnnKeys ast)
hasAnyCommentsBelow :: Data ast => GHC.Located ast -> ToBriDocM Bool
hasAnyCommentsBelow ast@(L l _) = do
@ -415,8 +422,20 @@ 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)
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
@ -565,7 +584,7 @@ instance DocWrapable a => DocWrapable [a] where
docWrapNode ast bdsm = do
bds <- bdsm
case bds of
[] -> return $ [] -- TODO: this might be bad. maybe. then again, not really. well.
[] -> return [] -- TODO: this might be bad. maybe. then again, not really. well.
[bd] -> do
bd' <- docWrapNode ast (return bd)
return [bd']
@ -577,23 +596,23 @@ instance DocWrapable a => DocWrapable [a] where
docWrapNodePrior ast bdsm = do
bds <- bdsm
case bds of
[] -> return $ []
[] -> return []
(bd1:bdR) -> do
bd1' <- docWrapNodePrior ast (return bd1)
return $ (bd1':bdR)
return (bd1':bdR)
docWrapNodeRest ast bdsm = do
bds <- bdsm
case reverse bds of
[] -> return $ []
[] -> return []
(bdN:bdR) -> do
bdN' <- docWrapNodeRest ast (return bdN)
return $ reverse $ (bdN':bdR)
return $ reverse (bdN':bdR)
instance DocWrapable a => DocWrapable (Seq a) where
docWrapNode ast bdsm = do
bds <- bdsm
case Seq.viewl bds of
Seq.EmptyL -> return $ Seq.empty -- TODO: this might be bad. maybe. then again, not really. well.
Seq.EmptyL -> return Seq.empty -- TODO: this might be bad. maybe. then again, not really. well.
bd1 Seq.:< rest -> case Seq.viewr rest of
Seq.EmptyR -> do
bd1' <- docWrapNode ast (return bd1)
@ -605,14 +624,14 @@ instance DocWrapable a => DocWrapable (Seq a) where
docWrapNodePrior ast bdsm = do
bds <- bdsm
case Seq.viewl bds of
Seq.EmptyL -> return $ Seq.empty
Seq.EmptyL -> return Seq.empty
bd1 Seq.:< bdR -> do
bd1' <- docWrapNodePrior ast (return bd1)
return $ bd1' Seq.<| bdR
docWrapNodeRest ast bdsm = do
bds <- bdsm
case Seq.viewr bds of
Seq.EmptyR -> return $ Seq.empty
Seq.EmptyR -> return Seq.empty
bdR Seq.:> bdN -> do
bdN' <- docWrapNodeRest ast (return bdN)
return $ bdR Seq.|> bdN'
@ -623,19 +642,19 @@ instance DocWrapable ([BriDocNumbered], BriDocNumbered, a) where
if null bds
then do
bd' <- docWrapNode ast (return bd)
return $ (bds, bd', x)
return (bds, bd', x)
else do
bds' <- docWrapNodePrior ast (return bds)
bd' <- docWrapNodeRest ast (return bd)
return $ (bds', bd', x)
return (bds', bd', x)
docWrapNodePrior ast stuffM = do
(bds, bd, x) <- stuffM
bds' <- docWrapNodePrior ast (return bds)
return $ (bds', bd, x)
return (bds', bd, x)
docWrapNodeRest ast stuffM = do
(bds, bd, x) <- stuffM
bd' <- docWrapNodeRest ast (return bd)
return $ (bds, bd', x)
return (bds, bd', x)
@ -661,7 +680,7 @@ docEnsureIndent ind mbd = mbd >>= \bd -> allocateNode $ BDFEnsureIndent ind bd
unknownNodeError
:: Data.Data.Data ast => String -> ast -> ToBriDocM BriDocNumbered
unknownNodeError infoStr ast = do
mTell $ [ErrorUnknownNode infoStr ast]
mTell [ErrorUnknownNode infoStr ast]
docLit $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"
spacifyDocs :: [ToBriDocM BriDocNumbered] -> [ToBriDocM BriDocNumbered]

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

@ -308,39 +308,39 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
++ (List.intersperse docCommaSep
(docForceSingleline . return <$> gs)
)
wherePart = case mWhereDocs of
Nothing -> Just docEmpty
Just [w] -> Just $ docSeq
[ docSeparator
, appSep $ docLit $ Text.pack "where"
, docSetIndentLevel $ docForceSingleline $ return w
]
_ -> Nothing
indentPolicy <- mAsk
<&> _conf_layout
.> _lconfig_indentPolicy
.> confUnpack
docAltFilter
$ -- one-line solution
[ ( True
, docCols
runFilteredAlternative $ do
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 +349,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 +375,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 () -- no alternatives exclusively when `length clauseDocs /= 1`
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 +419,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 +444,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 +479,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 +512,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 +542,3 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
]
]
++ wherePartMultiLine
)
]

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

@ -61,7 +61,7 @@ layoutExpr lexpr@(L _ expr) = do
bodyDoc <- docAddBaseY BrIndentRegular <$> docSharedWrapper layoutExpr body
let funcPatternPartLine =
docCols ColCasePattern
$ (patDocs <&> (\p -> docSeq [docForceSingleline p, docSeparator]))
(patDocs <&> (\p -> docSeq [docForceSingleline p, docSeparator]))
docAlt
[ -- single line
docSeq
@ -114,7 +114,7 @@ layoutExpr lexpr@(L _ expr) = do
HsApp exp1@(L _ HsApp{}) exp2 -> do
let gather :: [LHsExpr RdrName] -> LHsExpr RdrName -> (LHsExpr RdrName, [LHsExpr RdrName])
gather list = \case
(L _ (HsApp l r)) -> gather (r:list) l
L _ (HsApp l r) -> gather (r:list) l
x -> (x, list)
let (headE, paramEs) = gather [exp2] exp1
let colsOrSequence = case headE of
@ -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)
$ 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,39 +238,36 @@ 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
$ appListDocs <&> \(od, ed) -> docSeq
[ appSep $ docForceSingleline od
, appSep $ docForceSingleline ed
]
)
, appSep $ docForceSingleline opLastDoc
, (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,45 +277,45 @@ 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])
]
(docCols ColOpPrefix [appSep expDocOp, docSetBaseY expDocRight])
NegApp op _ -> do
opDoc <- docSharedWrapper layoutExpr op
docSeq $ [ docLit $ Text.pack "-"
docSeq [ docLit $ Text.pack "-"
, opDoc
]
HsPar innerExp -> do
@ -364,7 +356,7 @@ layoutExpr lexpr@(L _ expr) = do
case splitFirstLast argDocs of
FirstLastEmpty -> docSeq
[ openLit
, docNodeAnnKW lexpr (Just AnnOpenP) $ closeLit
, docNodeAnnKW lexpr (Just AnnOpenP) closeLit
]
FirstLastSingleton e -> docAlt
[ docCols ColTuple
@ -380,24 +372,21 @@ 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]
[appSep openLit, e1]
linesM = ems <&> \d ->
docCols ColTuples [docCommaSep, d]
lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN]
end = closeLit
in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]
]
in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN, end]
HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do
cExpDoc <- docSharedWrapper layoutExpr cExp
binderDoc <- docLit $ Text.pack "->"
@ -432,9 +421,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 +432,7 @@ layoutExpr lexpr@(L _ expr) = do
, appSep $ docLit $ Text.pack "else"
, docForceSingleline elseExprDoc
]
, -- either
-- either
-- if expr
-- then foo
-- bar
@ -456,7 +445,7 @@ layoutExpr lexpr@(L _ expr) = do
-- else
-- stuff
-- note that this has par-spacing
(,) True
addAlternative
$ docSetParSpacing
$ docAddBaseY BrIndentRegular
$ docPar
@ -479,7 +468,7 @@ layoutExpr lexpr@(L _ expr) = do
$ docPar (docLit $ Text.pack "else") elseExprDoc
]
])
, -- either
-- either
-- if multi
-- line
-- condition
@ -496,7 +485,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 +508,7 @@ layoutExpr lexpr@(L _ expr) = do
$ docPar (docLit $ Text.pack "else") elseExprDoc
]
])
, (,) True
addAlternative
$ docSetBaseY
$ docLines
[ docAddBaseY maySpecialIndent
@ -533,7 +522,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 "->"
@ -562,9 +550,9 @@ layoutExpr lexpr@(L _ expr) = do
Just [bindDoc] -> docAlt
[ docSeq
[ appSep $ docLit $ Text.pack "let"
, appSep $ docForceSingleline $ bindDoc
, appSep $ docForceSingleline bindDoc
, appSep $ docLit $ Text.pack "in"
, docForceSingleline $ expDoc1
, docForceSingleline expDoc1
]
, docLines
[ docAlt
@ -576,7 +564,7 @@ layoutExpr lexpr@(L _ expr) = do
, docAddBaseY BrIndentRegular
$ docPar
(docLit $ Text.pack "let")
(docSetBaseAndIndent $ bindDoc)
(docSetBaseAndIndent bindDoc)
]
, docAlt
[ docSeq
@ -586,11 +574,11 @@ layoutExpr lexpr@(L _ expr) = do
, docAddBaseY BrIndentRegular
$ docPar
(docLit $ Text.pack "in")
(docSetBaseY $ expDoc1)
(docSetBaseY expDoc1)
]
]
]
Just bindDocs@(_:_) -> docAltFilter
Just bindDocs@(_:_) -> runFilteredAlternative $ do
--either
-- let
-- a = b
@ -604,32 +592,30 @@ layoutExpr lexpr@(L _ expr) = do
-- c = d
-- in
-- fooooooooooooooooooo
[ ( indentPolicy == IndentPolicyLeft
, docLines
addAlternativeCond (indentPolicy == IndentPolicyLeft)
$ docLines
[ docAddBaseY BrIndentRegular
$ docPar
(docLit $ Text.pack "let")
(docSetBaseAndIndent $ docLines $ bindDocs)
(docSetBaseAndIndent $ docLines bindDocs)
, docSeq
[ docLit $ Text.pack "in "
, docAddBaseY BrIndentRegular $ expDoc1
, docAddBaseY BrIndentRegular expDoc1
]
]
)
, ( indentPolicy /= IndentPolicyLeft
, docLines
addAlternativeCond (indentPolicy /= IndentPolicyLeft)
$ docLines
[ docSeq
[ appSep $ docLit $ Text.pack "let"
, docSetBaseAndIndent $ docLines $ bindDocs
, docSetBaseAndIndent $ docLines bindDocs
]
, docSeq
[ appSep $ docLit $ Text.pack "in "
, docSetBaseY $ expDoc1
, docSetBaseY expDoc1
]
]
)
, ( True
, docLines
addAlternative
$ docLines
[ docAddBaseY BrIndentRegular
$ docPar
(docLit $ Text.pack "let")
@ -639,8 +625,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 +646,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
@ -675,11 +659,11 @@ layoutExpr lexpr@(L _ expr) = do
$ List.last stmtDocs
, appSep $ docLit $ Text.pack "|"
, docSeq $ List.intersperse docCommaSep
$ fmap docForceSingleline $ List.init stmtDocs
$ docForceSingleline <$> List.init stmtDocs
, docLit $ Text.pack " ]"
]
, (,) True
$ let
addAlternative $
let
start = docCols ColListComp
[ docNodeAnnKW lexpr Nothing
$ appSep $ docLit $ Text.pack "["
@ -694,7 +678,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
@ -716,20 +699,19 @@ layoutExpr lexpr@(L _ expr) = do
[ docSeq
[ docLit $ Text.pack "["
, docSeparator
, docSetBaseY $ docNodeAnnKW lexpr (Just AnnOpenS) $ e
, docSetBaseY $ docNodeAnnKW lexpr (Just AnnOpenS) e
]
, 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 +719,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
@ -757,20 +738,20 @@ layoutExpr lexpr@(L _ expr) = do
fExpDoc <- if pun
then return Nothing
else Just <$> docSharedWrapper layoutExpr fExpr
return $ (fieldl, lrdrNameToText lnameF, fExpDoc)
return (fieldl, lrdrNameToText lnameF, fExpDoc)
let line1 appender wrapper =
[ appender $ docLit $ Text.pack "{"
, docWrapNodePrior fd1l $ appSep $ docLit $ fd1n
, docWrapNodePrior fd1l $ appSep $ docLit fd1n
, case fd1e of
Just x -> docSeq
[ appSep $ docLit $ Text.pack "="
, docWrapNodeRest fd1l $ wrapper $ x
, docWrapNodeRest fd1l $ wrapper x
]
Nothing -> docEmpty
]
let lineR wrapper = fdr <&> \(lfield, fText, fDoc) ->
[ docCommaSep
, appSep $ docLit $ fText
, appSep $ docLit fText
, case fDoc of
Just x -> docWrapNode lfield $ docSeq
[ appSep $ docLit $ Text.pack "="
@ -784,14 +765,14 @@ layoutExpr lexpr@(L _ expr) = do
]
docAlt
[ docSeq
$ [docNodeAnnKW lexpr Nothing $ nameDoc, docSeparator]
$ [docNodeAnnKW lexpr Nothing nameDoc, docSeparator]
++ line1 id docForceSingleline
++ join (lineR docForceSingleline)
++ lineN
, docSetParSpacing
$ docAddBaseY BrIndentRegular
$ docPar
(docNodeAnnKW lexpr Nothing $ nameDoc)
(docNodeAnnKW lexpr Nothing nameDoc)
( docNonBottomSpacing
$ docLines
$ [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)]
@ -808,20 +789,20 @@ layoutExpr lexpr@(L _ expr) = do
fExpDoc <- if pun
then return Nothing
else Just <$> docSharedWrapper layoutExpr fExpr
return $ (fieldl, lrdrNameToText lnameF, fExpDoc)
return (fieldl, lrdrNameToText lnameF, fExpDoc)
let line1 appender wrapper =
[ appender $ docLit $ Text.pack "{"
, docWrapNodePrior fd1l $ appSep $ docLit $ fd1n
, docWrapNodePrior fd1l $ appSep $ docLit fd1n
, case fd1e of
Just x -> docSeq
[ appSep $ docLit $ Text.pack "="
, docWrapNodeRest fd1l $ wrapper $ x
, docWrapNodeRest fd1l $ wrapper x
]
Nothing -> docEmpty
]
let lineR wrapper = fdr <&> \(lfield, fText, fDoc) ->
[ docCommaSep
, appSep $ docLit $ fText
, appSep $ docLit fText
, case fDoc of
Just x -> docWrapNode lfield $ docSeq
[ appSep $ docLit $ Text.pack "="
@ -839,7 +820,7 @@ layoutExpr lexpr@(L _ expr) = do
]
docAlt
[ docSeq
$ [docNodeAnnKW lexpr Nothing $ nameDoc, docSeparator]
$ [docNodeAnnKW lexpr Nothing nameDoc, docSeparator]
++ line1 id docForceSingleline
++ join (lineR docForceSingleline)
++ lineDot
@ -847,7 +828,7 @@ layoutExpr lexpr@(L _ expr) = do
, docSetParSpacing
$ docAddBaseY BrIndentRegular
$ docPar
(docNodeAnnKW lexpr Nothing $ nameDoc)
(docNodeAnnKW lexpr Nothing nameDoc)
( docNonBottomSpacing
$ docLines
$ [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)]
@ -870,10 +851,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,18 +869,17 @@ 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
[ appSep $ docLit $ Text.pack "{"
, docWrapNodePrior rF1f $ appSep $ docLit $ rF1n
, docWrapNodePrior rF1f $ appSep $ docLit rF1n
, case rF1e of
Just x -> docWrapNodeRest rF1f $ docSeq
[ appSep $ docLit $ Text.pack "="
@ -909,7 +889,7 @@ layoutExpr lexpr@(L _ expr) = do
]
lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate
[ docCommaSep
, appSep $ docLit $ fText
, appSep $ docLit fText
, case fDoc of
Just x -> docSeq [ appSep $ docLit $ Text.pack "="
, docForceSingleline x
@ -922,25 +902,24 @@ 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)
(docNodeAnnKW lexpr Nothing rExprDoc)
(docNonBottomSpacing $ docLines $ let
expressionWrapper = if indentPolicy == IndentPolicyLeft
then docForceParSpacing
else docSetBaseY
line1 = docCols ColRecUpdate
[ appSep $ docLit $ Text.pack "{"
, docWrapNodePrior rF1f $ appSep $ docLit $ rF1n
, docWrapNodePrior rF1f $ appSep $ docLit rF1n
, docWrapNodeRest rF1f $ case rF1e of
Just x -> docAlt
[ docSeq [ appSep $ docLit $ Text.pack "="
@ -954,7 +933,7 @@ layoutExpr lexpr@(L _ expr) = do
lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield
$ docCols ColRecUpdate
[ docCommaSep
, appSep $ docLit $ fText
, appSep $ docLit fText
, case fDoc of
Just x -> docAlt
[ docSeq [ appSep $ docLit $ Text.pack "="
@ -971,8 +950,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 */
@ -1078,7 +1055,7 @@ layoutExpr lexpr@(L _ expr) = do
docLit $ Text.pack "_"
EAsPat asName asExpr -> do
docSeq
[ docLit $ (lrdrNameToText asName) <> Text.pack "@"
[ docLit $ lrdrNameToText asName <> Text.pack "@"
, layoutExpr asExpr
]
EViewPat{} -> do

38
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 _ _ 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]
@ -121,25 +118,22 @@ layoutLLIEs :: Bool -> Located [LIE RdrName] -> ToBriDocM BriDocNumbered
layoutLLIEs enableSingleline llies = do
ieDs <- layoutAnnAndSepLLIEs llies
hasComments <- hasAnyCommentsBelow llies
runFilteredAlternative $
case ieDs of
[] -> docAltFilter
[ (not hasComments, docLit $ Text.pack "()")
, ( hasComments
, docPar (docSeq [docParenLSep, docWrapNodeRest llies docEmpty])
[] -> 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) -> 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]
)
]

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
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'
-- )

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
-- 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

22
src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs
View File

@ -94,14 +94,14 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
fExpDoc <- if pun
then return Nothing
else Just <$> docSharedWrapper layoutPat fPat
return $ (lrdrNameToText lnameF, fExpDoc)
fmap Seq.singleton $ docSeq
return (lrdrNameToText lnameF, fExpDoc)
Seq.singleton <$> docSeq
[ appSep $ docLit t
, appSep $ docLit $ Text.pack "{"
, docSeq $ List.intersperse docCommaSep
$ fds <&> \case
(fieldName, Just fieldDoc) -> docSeq
[ appSep $ docLit $ fieldName
[ appSep $ docLit fieldName
, appSep $ docLit $ Text.pack "="
, fieldDoc >>= colsWrapPat
]
@ -112,7 +112,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
ConPatIn lname (RecCon (HsRecFields [] (Just 0))) -> do
-- Abc { .. } -> expr
let t = lrdrNameToText lname
fmap Seq.singleton $ docSeq
Seq.singleton <$> docSeq
[ appSep $ docLit t
, docLit $ Text.pack "{..}"
]
@ -123,13 +123,13 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
fExpDoc <- if pun
then return Nothing
else Just <$> docSharedWrapper layoutPat fPat
return $ (lrdrNameToText lnameF, fExpDoc)
fmap Seq.singleton $ docSeq
return (lrdrNameToText lnameF, fExpDoc)
Seq.singleton <$> docSeq
[ appSep $ docLit t
, appSep $ docLit $ Text.pack "{"
, docSeq $ fds >>= \case
(fieldName, Just fieldDoc) ->
[ appSep $ docLit $ fieldName
[ appSep $ docLit fieldName
, appSep $ docLit $ Text.pack "="
, fieldDoc >>= colsWrapPat
, docCommaSep
@ -167,7 +167,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
docAddBaseY BrIndentRegular $ docSeq
[ appSep $ return xN
, appSep $ docLit $ Text.pack "::"
, docForceSingleline $ tyDoc
, docForceSingleline tyDoc
]
return $ xR Seq.|> xN'
ListPat elems _ _ ->
@ -193,7 +193,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
-- else
-- VarPat n -> return $ stringLayouter lpat $ rdrNameToText n
-- endif
_ -> fmap return $ briDocByExactInlineOnly "some unknown pattern" lpat
_ -> return <$> briDocByExactInlineOnly "some unknown pattern" lpat
colsWrapPat :: Seq BriDocNumbered -> ToBriDocM BriDocNumbered
colsWrapPat = docCols ColPatterns . fmap return . Foldable.toList
@ -205,7 +205,7 @@ wrapPatPrepend
wrapPatPrepend pat prepElem = do
patDocs <- layoutPat pat
case Seq.viewl patDocs of
Seq.EmptyL -> return $ Seq.empty
Seq.EmptyL -> return Seq.empty
x1 Seq.:< xR -> do
x1' <- docSeq [prepElem, return x1]
return $ x1' Seq.<| xR
@ -216,7 +216,7 @@ wrapPatListy
-> String
-> ToBriDocM (Seq BriDocNumbered)
wrapPatListy elems start end = do
elemDocs <- Seq.fromList elems `forM` \e -> layoutPat e >>= colsWrapPat
elemDocs <- Seq.fromList elems `forM` (layoutPat >=> colsWrapPat)
sDoc <- docLit $ Text.pack start
eDoc <- docLit $ Text.pack end
case Seq.viewl elemDocs of

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

@ -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

6
src/Language/Haskell/Brittany/Internal/Prelude.hs
View File

@ -255,14 +255,16 @@ import Debug.Trace as E ( trace
import Foreign.ForeignPtr as E ( ForeignPtr
)
import Data.Monoid as E ( (<>)
, mconcat
import Data.Monoid as E ( mconcat
, Monoid (..)
)
import Data.Bifunctor as E ( bimap )
import Data.Functor as E ( (<$), ($>) )
import Data.Function as E ( (&) )
import Data.Semigroup as E ( (<>)
, Semigroup(..)
)
import System.IO as E ( hFlush
, stdout
)

5
src/Language/Haskell/Brittany/Internal/Utils.hs
View File

@ -84,9 +84,12 @@ fromOptionIdentity x y =
newtype Max a = Max { getMax :: a }
deriving (Eq, Ord, Show, Bounded, Num)
instance (Num a, Ord a) => Semigroup (Max a) where
(<>) = Data.Coerce.coerce (max :: a -> a -> a)
instance (Num a, Ord a) => Monoid (Max a) where
mempty = Max 0
mappend = Data.Coerce.coerce (max :: a -> a -> a)
mappend = (<>)
newtype ShowIsId = ShowIsId String deriving Data

2
stack.yaml
View File

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