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 , ghc-boot-th
, hspec >=2.4.1 && <2.5 , hspec >=2.4.1 && <2.5
} }
ghc-options: -Wall
main-is: TestMain.hs main-is: TestMain.hs
other-modules: TestUtils other-modules: TestUtils
AsymptoticPerfTests AsymptoticPerfTests
@ -314,7 +313,6 @@ test-suite littests
, filepath , filepath
, parsec >=3.1.11 && <3.2 , parsec >=3.1.11 && <3.2
} }
ghc-options: -Wall
main-is: Main.hs main-is: Main.hs
other-modules: other-modules:
hs-source-dirs: src-literatetests hs-source-dirs: src-literatetests
@ -355,7 +353,6 @@ test-suite libinterfacetests
, transformers , transformers
, hspec >=2.4.1 && <2.5 , hspec >=2.4.1 && <2.5
} }
ghc-options: -Wall
main-is: Main.hs main-is: Main.hs
other-modules: other-modules:
hs-source-dirs: src-libinterfacetests 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.Types as ExactPrint.Types
import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Monoid
import Text.Read (Read(..)) import Text.Read (Read(..))
import qualified Text.ParserCombinators.ReadP as ReadP import qualified Text.ParserCombinators.ReadP as ReadP
@ -148,7 +149,7 @@ mainCmdParser helpDesc = do
, PP.text "inplace: override respective input file (without backup!)" , 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") inputParams <- addParamNoFlagStrings "PATH" (paramHelpStr "paths to input/inout haskell source files")
reorderStop reorderStop

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

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

59
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,10 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
, docEmpty , docEmpty
, docLit , docLit
, docAlt , docAlt
, docAltFilter , CollectAltM
, addAlternativeCond
, addAlternative
, runFilteredAlternative
, docLines , docLines
, docCols , docCols
, docSeq , docSeq
@ -60,6 +65,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
@ -111,7 +118,7 @@ processDefault x = do
-- the module (header). This would remove the need for this hack! -- the module (header). This would remove the need for this hack!
case str of case str of
"\n" -> return () "\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 -- | 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 -- at insertion position (meant to point out to the user that this node is
@ -166,7 +173,7 @@ briDocByExactInlineOnly infoStr ast = do
False False
t t
let errorAction = do let errorAction = do
mTell $ [ErrorUnknownNode infoStr ast] mTell [ErrorUnknownNode infoStr ast]
docLit docLit
$ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}" $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"
case (fallbackMode, Text.lines exactPrinted) of case (fallbackMode, Text.lines exactPrinted) of
@ -256,8 +263,8 @@ extractAllComments ann =
) )
filterAnns :: Data.Data.Data ast => ast -> ExactPrint.Anns -> ExactPrint.Anns filterAnns :: Data.Data.Data ast => ast -> ExactPrint.Anns -> ExactPrint.Anns
filterAnns ast anns = filterAnns ast =
Map.filterWithKey (\k _ -> k `Set.member` foldedAnnKeys ast) anns Map.filterWithKey (\k _ -> k `Set.member` foldedAnnKeys ast)
hasAnyCommentsBelow :: Data ast => GHC.Located ast -> ToBriDocM Bool hasAnyCommentsBelow :: Data ast => GHC.Located ast -> ToBriDocM Bool
hasAnyCommentsBelow ast@(L l _) = do hasAnyCommentsBelow ast@(L l _) = do
@ -415,8 +422,20 @@ 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)
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
@ -565,7 +584,7 @@ instance DocWrapable a => DocWrapable [a] where
docWrapNode ast bdsm = do docWrapNode ast bdsm = do
bds <- bdsm bds <- bdsm
case bds of 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] -> do
bd' <- docWrapNode ast (return bd) bd' <- docWrapNode ast (return bd)
return [bd'] return [bd']
@ -577,23 +596,23 @@ instance DocWrapable a => DocWrapable [a] where
docWrapNodePrior ast bdsm = do docWrapNodePrior ast bdsm = do
bds <- bdsm bds <- bdsm
case bds of case bds of
[] -> return $ [] [] -> return []
(bd1:bdR) -> do (bd1:bdR) -> do
bd1' <- docWrapNodePrior ast (return bd1) bd1' <- docWrapNodePrior ast (return bd1)
return $ (bd1':bdR) return (bd1':bdR)
docWrapNodeRest ast bdsm = do docWrapNodeRest ast bdsm = do
bds <- bdsm bds <- bdsm
case reverse bds of case reverse bds of
[] -> return $ [] [] -> return []
(bdN:bdR) -> do (bdN:bdR) -> do
bdN' <- docWrapNodeRest ast (return bdN) bdN' <- docWrapNodeRest ast (return bdN)
return $ reverse $ (bdN':bdR) return $ reverse (bdN':bdR)
instance DocWrapable a => DocWrapable (Seq a) where instance DocWrapable a => DocWrapable (Seq a) where
docWrapNode ast bdsm = do docWrapNode ast bdsm = do
bds <- bdsm bds <- bdsm
case Seq.viewl bds of 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 bd1 Seq.:< rest -> case Seq.viewr rest of
Seq.EmptyR -> do Seq.EmptyR -> do
bd1' <- docWrapNode ast (return bd1) bd1' <- docWrapNode ast (return bd1)
@ -605,14 +624,14 @@ instance DocWrapable a => DocWrapable (Seq a) where
docWrapNodePrior ast bdsm = do docWrapNodePrior ast bdsm = do
bds <- bdsm bds <- bdsm
case Seq.viewl bds of case Seq.viewl bds of
Seq.EmptyL -> return $ Seq.empty Seq.EmptyL -> return Seq.empty
bd1 Seq.:< bdR -> do bd1 Seq.:< bdR -> do
bd1' <- docWrapNodePrior ast (return bd1) bd1' <- docWrapNodePrior ast (return bd1)
return $ bd1' Seq.<| bdR return $ bd1' Seq.<| bdR
docWrapNodeRest ast bdsm = do docWrapNodeRest ast bdsm = do
bds <- bdsm bds <- bdsm
case Seq.viewr bds of case Seq.viewr bds of
Seq.EmptyR -> return $ Seq.empty Seq.EmptyR -> return Seq.empty
bdR Seq.:> bdN -> do bdR Seq.:> bdN -> do
bdN' <- docWrapNodeRest ast (return bdN) bdN' <- docWrapNodeRest ast (return bdN)
return $ bdR Seq.|> bdN' return $ bdR Seq.|> bdN'
@ -623,19 +642,19 @@ instance DocWrapable ([BriDocNumbered], BriDocNumbered, a) where
if null bds if null bds
then do then do
bd' <- docWrapNode ast (return bd) bd' <- docWrapNode ast (return bd)
return $ (bds, bd', x) return (bds, bd', x)
else do else do
bds' <- docWrapNodePrior ast (return bds) bds' <- docWrapNodePrior ast (return bds)
bd' <- docWrapNodeRest ast (return bd) bd' <- docWrapNodeRest ast (return bd)
return $ (bds', bd', x) return (bds', bd', x)
docWrapNodePrior ast stuffM = do docWrapNodePrior ast stuffM = do
(bds, bd, x) <- stuffM (bds, bd, x) <- stuffM
bds' <- docWrapNodePrior ast (return bds) bds' <- docWrapNodePrior ast (return bds)
return $ (bds', bd, x) return (bds', bd, x)
docWrapNodeRest ast stuffM = do docWrapNodeRest ast stuffM = do
(bds, bd, x) <- stuffM (bds, bd, x) <- stuffM
bd' <- docWrapNodeRest ast (return bd) 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 unknownNodeError
:: Data.Data.Data ast => String -> ast -> ToBriDocM BriDocNumbered :: Data.Data.Data ast => String -> ast -> ToBriDocM BriDocNumbered
unknownNodeError infoStr ast = do unknownNodeError infoStr ast = do
mTell $ [ErrorUnknownNode infoStr ast] mTell [ErrorUnknownNode infoStr ast]
docLit $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}" docLit $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"
spacifyDocs :: [ToBriDocM BriDocNumbered] -> [ToBriDocM BriDocNumbered] 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 ++ (List.intersperse docCommaSep
(docForceSingleline . return <$> gs) (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 indentPolicy <- mAsk
<&> _conf_layout <&> _conf_layout
.> _lconfig_indentPolicy .> _lconfig_indentPolicy
.> confUnpack .> confUnpack
docAltFilter
$ -- one-line solution runFilteredAlternative $ do
[ ( True
, docCols case clauseDocs of
[(guards, body, _bodyRaw)] -> do
let guardPart = singleLineGuardsDoc guards
forM_ wherePart $ \wherePart' ->
-- one-line solution
addAlternativeCond (not hasComments) $ docCols
(ColBindingLine alignmentToken) (ColBindingLine alignmentToken)
[ docSeq (patPartInline ++ [guardPart]) [ docSeq (patPartInline ++ [guardPart])
, docSeq , docSeq
[ appSep $ return binderDoc [ appSep $ return binderDoc
, docForceSingleline $ return body , docForceSingleline $ return body
, wherePart , wherePart'
] ]
] ]
) -- one-line solution + where in next line(s)
| not hasComments addAlternativeCond (Data.Maybe.isJust mWhereDocs)
, [(guards, body, _bodyRaw)] <- [clauseDocs] $ docLines
, let guardPart = singleLineGuardsDoc guards
, wherePart <- case mWhereDocs of
Nothing -> return @[] $ docEmpty
Just [w] -> return @[] $ docSeq
[ docSeparator
, appSep $ docLit $ Text.pack "where"
, docSetIndentLevel $ docForceSingleline $ return w
]
_ -> []
]
++ -- one-line solution + where in next line(s)
[ ( True
, docLines
$ [ docCols $ [ docCols
(ColBindingLine alignmentToken) (ColBindingLine alignmentToken)
[ docSeq (patPartInline ++ [guardPart]) [ docSeq (patPartInline ++ [guardPart])
@ -349,27 +349,18 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
] ]
] ]
++ wherePartMultiLine ++ wherePartMultiLine
) -- two-line solution + where in next line(s)
| [(guards, body, _bodyRaw)] <- [clauseDocs] addAlternative
, let guardPart = singleLineGuardsDoc guards $ docLines
, Data.Maybe.isJust mWhereDocs
]
++ -- two-line solution + where in next line(s)
[ ( True
, docLines
$ [ docForceSingleline $ [ docForceSingleline
$ docSeq (patPartInline ++ [guardPart, return binderDoc]) $ docSeq (patPartInline ++ [guardPart, return binderDoc])
, docEnsureIndent BrIndentRegular $ docForceSingleline $ return body , docEnsureIndent BrIndentRegular $ docForceSingleline $ return body
] ]
++ wherePartMultiLine ++ wherePartMultiLine
) -- pattern and exactly one clause in single line, body as par;
| [(guards, body, _bodyRaw)] <- [clauseDocs]
, let guardPart = singleLineGuardsDoc guards
]
++ -- pattern and exactly one clause in single line, body as par;
-- where in following lines -- where in following lines
[ ( True addAlternative
, docLines $ docLines
$ [ docCols $ [ docCols
(ColBindingLine alignmentToken) (ColBindingLine alignmentToken)
[ docSeq (patPartInline ++ [guardPart]) [ docSeq (patPartInline ++ [guardPart])
@ -384,28 +375,27 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
-- , docAddBaseY BrIndentRegular $ return body -- , docAddBaseY BrIndentRegular $ return body
-- ] -- ]
++ wherePartMultiLine ++ wherePartMultiLine
) -- pattern and exactly one clause in single line, body in new line.
| [(guards, body, _bodyRaw)] <- [clauseDocs] addAlternative
, let guardPart = singleLineGuardsDoc guards $ docLines
]
++ -- pattern and exactly one clause in single line, body in new line.
[ ( True
, docLines
$ [ docSeq (patPartInline ++ [guardPart, return binderDoc]) $ [ docSeq (patPartInline ++ [guardPart, return binderDoc])
, docEnsureIndent BrIndentRegular , docEnsureIndent BrIndentRegular
$ docNonBottomSpacing $ docNonBottomSpacing
$ (docAddBaseY BrIndentRegular $ return body) $ docAddBaseY BrIndentRegular
$ return body
] ]
++ wherePartMultiLine ++ wherePartMultiLine
)
| [(guards, body, _)] <- [clauseDocs] _ -> return () -- no alternatives exclusively when `length clauseDocs /= 1`
, let guardPart = singleLineGuardsDoc guards
] case mPatDoc of
++ -- multiple clauses added in-paragraph, each in a single line Nothing -> return ()
Just patDoc ->
-- multiple clauses added in-paragraph, each in a single line
-- example: foo | bar = baz -- example: foo | bar = baz
-- | lll = asd -- | lll = asd
[ ( indentPolicy /= IndentPolicyLeft addAlternativeCond (indentPolicy /= IndentPolicyLeft)
, docLines $ docLines
$ [ docSeq $ [ docSeq
[ appSep $ docForceSingleline $ return patDoc [ appSep $ docForceSingleline $ return patDoc
, docSetBaseY , docSetBaseY
@ -429,12 +419,9 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
] ]
] ]
++ wherePartMultiLine ++ wherePartMultiLine
) -- multiple clauses, each in a separate, single line
| Just patDoc <- [mPatDoc] addAlternative
] $ docLines
++ -- multiple clauses, each in a separate, single line
[ ( True
, docLines
$ [ docAddBaseY BrIndentRegular $ [ docAddBaseY BrIndentRegular
$ patPartParWrap $ patPartParWrap
$ docLines $ docLines
@ -457,12 +444,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
] ]
] ]
++ wherePartMultiLine ++ wherePartMultiLine
) -- multiple clauses, each with the guard(s) in a single line, body
]
++ -- multiple clauses, each with the guard(s) in a single line, body
-- as a paragraph -- as a paragraph
[ ( True addAlternative
, docLines $ docLines
$ [ docAddBaseY BrIndentRegular $ [ docAddBaseY BrIndentRegular
$ patPartParWrap $ patPartParWrap
$ docLines $ docLines
@ -494,12 +479,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
] ]
] ]
++ wherePartMultiLine ++ wherePartMultiLine
) -- multiple clauses, each with the guard(s) in a single line, body
]
++ -- multiple clauses, each with the guard(s) in a single line, body
-- in a new line as a paragraph -- in a new line as a paragraph
[ ( True addAlternative
, docLines $ docLines
$ [ docAddBaseY BrIndentRegular $ [ docAddBaseY BrIndentRegular
$ patPartParWrap $ patPartParWrap
$ docLines $ docLines
@ -529,11 +512,9 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
] ]
] ]
++ wherePartMultiLine ++ wherePartMultiLine
) -- conservative approach: everything starts on the left.
] addAlternative
++ -- conservative approach: everything starts on the left. $ docLines
[ ( True
, docLines
$ [ docAddBaseY BrIndentRegular $ [ docAddBaseY BrIndentRegular
$ patPartParWrap $ patPartParWrap
$ docLines $ docLines
@ -561,5 +542,3 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
] ]
] ]
++ wherePartMultiLine ++ 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 bodyDoc <- docAddBaseY BrIndentRegular <$> docSharedWrapper layoutExpr body
let funcPatternPartLine = let funcPatternPartLine =
docCols ColCasePattern docCols ColCasePattern
$ (patDocs <&> (\p -> docSeq [docForceSingleline p, docSeparator])) (patDocs <&> (\p -> docSeq [docForceSingleline p, docSeparator]))
docAlt docAlt
[ -- single line [ -- single line
docSeq docSeq
@ -114,7 +114,7 @@ layoutExpr lexpr@(L _ expr) = do
HsApp exp1@(L _ HsApp{}) exp2 -> do HsApp exp1@(L _ HsApp{}) exp2 -> do
let gather :: [LHsExpr RdrName] -> LHsExpr RdrName -> (LHsExpr RdrName, [LHsExpr RdrName]) let gather :: [LHsExpr RdrName] -> LHsExpr RdrName -> (LHsExpr RdrName, [LHsExpr RdrName])
gather list = \case gather list = \case
(L _ (HsApp l r)) -> gather (r:list) l L _ (HsApp l r) -> gather (r:list) l
x -> (x, list) x -> (x, list)
let (headE, paramEs) = gather [exp2] exp1 let (headE, paramEs) = gather [exp2] exp1
let colsOrSequence = case headE of let colsOrSequence = case headE of
@ -123,51 +123,46 @@ layoutExpr lexpr@(L _ expr) = do
_ -> docSeq _ -> docSeq
headDoc <- docSharedWrapper layoutExpr headE headDoc <- docSharedWrapper layoutExpr headE
paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs
docAltFilter runFilteredAlternative $ do
[ -- foo x y -- foo x y
( True addAlternative
, colsOrSequence $ colsOrSequence
$ appSep (docForceSingleline headDoc) $ appSep (docForceSingleline headDoc)
: spacifyDocs (docForceSingleline <$> paramDocs) : spacifyDocs (docForceSingleline <$> paramDocs)
) -- foo x
, -- foo x
-- y -- y
( allowFreeIndent addAlternativeCond allowFreeIndent
, docSeq $ docSeq
[ appSep (docForceSingleline headDoc) [ appSep (docForceSingleline headDoc)
, docSetBaseY , docSetBaseY
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docLines $ docLines
$ (docForceSingleline <$> paramDocs) $ docForceSingleline <$> paramDocs
] ]
) -- foo
, -- foo
-- x -- x
-- y -- y
( True addAlternative
, docSetParSpacing $ docSetParSpacing
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar $ docPar
(docForceSingleline headDoc) (docForceSingleline headDoc)
( docNonBottomSpacing ( docNonBottomSpacing
$ docLines paramDocs $ docLines paramDocs
) )
) -- ( multi
, -- ( multi
-- line -- line
-- function -- function
-- ) -- )
-- x -- x
-- y -- y
( True addAlternative
, docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar $ docPar
headDoc headDoc
( docNonBottomSpacing ( docNonBottomSpacing
$ docLines paramDocs $ docLines paramDocs
) )
)
]
HsApp exp1 exp2 -> do HsApp exp1 exp2 -> do
-- TODO: if expDoc1 is some literal, we may want to create a docCols here. -- TODO: if expDoc1 is some literal, we may want to create a docCols here.
expDoc1 <- docSharedWrapper layoutExpr exp1 expDoc1 <- docSharedWrapper layoutExpr exp1
@ -243,39 +238,36 @@ layoutExpr lexpr@(L _ expr) = do
| occNameString occname == "$" -> True | occNameString occname == "$" -> True
(_, L _ (HsApp _ (L _ HsVar{}))) -> False (_, L _ (HsApp _ (L _ HsVar{}))) -> False
_ -> True _ -> True
docAltFilter runFilteredAlternative $ do
[ ( not hasComments addAlternativeCond (not hasComments)
, docSeq $ docSeq
[ appSep $ docForceSingleline leftOperandDoc [ appSep $ docForceSingleline leftOperandDoc
, docSeq , docSeq
$ (appListDocs <&> \(od, ed) -> docSeq $ appListDocs <&> \(od, ed) -> docSeq
[ appSep $ docForceSingleline od [ appSep $ docForceSingleline od
, appSep $ docForceSingleline ed , appSep $ docForceSingleline ed
] ]
)
, appSep $ docForceSingleline opLastDoc , appSep $ docForceSingleline opLastDoc
, (if allowPar then docForceParSpacing else docForceSingleline) , (if allowPar then docForceParSpacing else docForceSingleline)
expLastDoc expLastDoc
] ]
)
-- this case rather leads to some unfortunate layouting than to anything -- this case rather leads to some unfortunate layouting than to anything
-- useful; disabling for now. (it interfers with cols stuff.) -- useful; disabling for now. (it interfers with cols stuff.)
-- , docSetBaseY -- addAlternative
-- - $ docPar -- $ docSetBaseY
-- $ docPar
-- leftOperandDoc -- leftOperandDoc
-- ( docLines -- ( docLines
-- - $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed]) -- $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])
-- ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]] -- ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]]
-- ) -- )
, (otherwise addAlternative $
, docPar docPar
leftOperandDoc leftOperandDoc
( docLines ( docLines
$ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed]) $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])
++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]] ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]]
) )
)
]
OpApp expLeft expOp _ expRight -> do OpApp expLeft expOp _ expRight -> do
expDocLeft <- docSharedWrapper layoutExpr expLeft expDocLeft <- docSharedWrapper layoutExpr expLeft
expDocOp <- docSharedWrapper layoutExpr expOp expDocOp <- docSharedWrapper layoutExpr expOp
@ -285,45 +277,45 @@ layoutExpr lexpr@(L _ expr) = do
| occNameString occname == "$" -> True | occNameString occname == "$" -> True
(_, L _ (HsApp _ (L _ HsVar{}))) -> False (_, L _ (HsApp _ (L _ HsVar{}))) -> False
_ -> True _ -> True
docAltFilter runFilteredAlternative $ do
$ [ -- one-line -- one-line
(,) True addAlternative
$ docSeq $ docSeq
[ appSep $ docForceSingleline expDocLeft [ appSep $ docForceSingleline expDocLeft
, appSep $ docForceSingleline expDocOp , appSep $ docForceSingleline expDocOp
, docForceSingleline expDocRight , docForceSingleline expDocRight
] ]
-- , -- line + freely indented block for right expression -- -- line + freely indented block for right expression
-- docSeq -- addAlternative
-- $ docSeq
-- [ appSep $ docForceSingleline expDocLeft -- [ appSep $ docForceSingleline expDocLeft
-- , appSep $ docForceSingleline expDocOp -- , appSep $ docForceSingleline expDocOp
-- , docSetBaseY $ docAddBaseY BrIndentRegular expDocRight -- , docSetBaseY $ docAddBaseY BrIndentRegular expDocRight
-- ] -- ]
, -- two-line -- two-line
(,) True addAlternative
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar $ docPar
expDocLeft expDocLeft
( docForceSingleline ( docForceSingleline
$ docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight] $ docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight]
) )
, -- one-line + par -- one-line + par
(,) allowPar addAlternativeCond allowPar
$ docSeq $ docSeq
[ appSep $ docForceSingleline expDocLeft [ appSep $ docForceSingleline expDocLeft
, appSep $ docForceSingleline expDocOp , appSep $ docForceSingleline expDocOp
, docForceParSpacing expDocRight , docForceParSpacing expDocRight
] ]
, -- more lines -- more lines
(,) True addAlternative
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar $ docPar
expDocLeft expDocLeft
(docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight]) (docCols ColOpPrefix [appSep expDocOp, docSetBaseY expDocRight])
]
NegApp op _ -> do NegApp op _ -> do
opDoc <- docSharedWrapper layoutExpr op opDoc <- docSharedWrapper layoutExpr op
docSeq $ [ docLit $ Text.pack "-" docSeq [ docLit $ Text.pack "-"
, opDoc , opDoc
] ]
HsPar innerExp -> do HsPar innerExp -> do
@ -364,7 +356,7 @@ layoutExpr lexpr@(L _ expr) = do
case splitFirstLast argDocs of case splitFirstLast argDocs of
FirstLastEmpty -> docSeq FirstLastEmpty -> docSeq
[ openLit [ openLit
, docNodeAnnKW lexpr (Just AnnOpenP) $ closeLit , docNodeAnnKW lexpr (Just AnnOpenP) closeLit
] ]
FirstLastSingleton e -> docAlt FirstLastSingleton e -> docAlt
[ docCols ColTuple [ docCols ColTuple
@ -380,24 +372,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 $
, (,) True let
$ let
start = docCols ColTuples start = docCols ColTuples
[appSep $ openLit, e1] [appSep openLit, e1]
linesM = ems <&> \d -> linesM = ems <&> \d ->
docCols ColTuples [docCommaSep, d] docCols ColTuples [docCommaSep, d]
lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN] lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN]
end = closeLit end = closeLit
in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end] in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN, end]
]
HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do
cExpDoc <- docSharedWrapper layoutExpr cExp cExpDoc <- docSharedWrapper layoutExpr cExp
binderDoc <- docLit $ Text.pack "->" binderDoc <- docLit $ Text.pack "->"
@ -432,9 +421,9 @@ layoutExpr lexpr@(L _ expr) = do
_ -> BrIndentSpecial 3 _ -> BrIndentSpecial 3
-- TODO: some of the alternatives (especially last and last-but-one) -- TODO: some of the alternatives (especially last and last-but-one)
-- overlap. -- overlap.
docAltFilter runFilteredAlternative $ do
[ -- if _ then _ else _ -- if _ then _ else _
(,) (not hasComments) addAlternativeCond (not hasComments)
$ docSeq $ docSeq
[ appSep $ docLit $ Text.pack "if" [ appSep $ docLit $ Text.pack "if"
, appSep $ docForceSingleline ifExprDoc , appSep $ docForceSingleline ifExprDoc
@ -443,7 +432,7 @@ layoutExpr lexpr@(L _ expr) = do
, appSep $ docLit $ Text.pack "else" , appSep $ docLit $ Text.pack "else"
, docForceSingleline elseExprDoc , docForceSingleline elseExprDoc
] ]
, -- either -- either
-- if expr -- if expr
-- then foo -- then foo
-- bar -- bar
@ -456,7 +445,7 @@ layoutExpr lexpr@(L _ expr) = do
-- else -- else
-- stuff -- stuff
-- note that this has par-spacing -- note that this has par-spacing
(,) True addAlternative
$ docSetParSpacing $ docSetParSpacing
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar $ docPar
@ -479,7 +468,7 @@ layoutExpr lexpr@(L _ expr) = do
$ docPar (docLit $ Text.pack "else") elseExprDoc $ docPar (docLit $ Text.pack "else") elseExprDoc
] ]
]) ])
, -- either -- either
-- if multi -- if multi
-- line -- line
-- condition -- condition
@ -496,7 +485,7 @@ layoutExpr lexpr@(L _ expr) = do
-- else -- else
-- stuff -- stuff
-- note that this does _not_ have par-spacing -- note that this does _not_ have par-spacing
(,) True addAlternative
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar $ docPar
( docAddBaseY maySpecialIndent ( docAddBaseY maySpecialIndent
@ -519,7 +508,7 @@ layoutExpr lexpr@(L _ expr) = do
$ docPar (docLit $ Text.pack "else") elseExprDoc $ docPar (docLit $ Text.pack "else") elseExprDoc
] ]
]) ])
, (,) True addAlternative
$ docSetBaseY $ docSetBaseY
$ docLines $ docLines
[ docAddBaseY maySpecialIndent [ docAddBaseY maySpecialIndent
@ -533,7 +522,6 @@ layoutExpr lexpr@(L _ expr) = do
, docAddBaseY BrIndentRegular , docAddBaseY BrIndentRegular
$ docPar (docLit $ Text.pack "else") elseExprDoc $ docPar (docLit $ Text.pack "else") elseExprDoc
] ]
]
HsMultiIf _ cases -> do HsMultiIf _ cases -> do
clauseDocs <- cases `forM` layoutGrhs clauseDocs <- cases `forM` layoutGrhs
binderDoc <- docLit $ Text.pack "->" binderDoc <- docLit $ Text.pack "->"
@ -562,9 +550,9 @@ layoutExpr lexpr@(L _ expr) = do
Just [bindDoc] -> docAlt Just [bindDoc] -> docAlt
[ docSeq [ docSeq
[ appSep $ docLit $ Text.pack "let" [ appSep $ docLit $ Text.pack "let"
, appSep $ docForceSingleline $ bindDoc , appSep $ docForceSingleline bindDoc
, appSep $ docLit $ Text.pack "in" , appSep $ docLit $ Text.pack "in"
, docForceSingleline $ expDoc1 , docForceSingleline expDoc1
] ]
, docLines , docLines
[ docAlt [ docAlt
@ -576,7 +564,7 @@ layoutExpr lexpr@(L _ expr) = do
, docAddBaseY BrIndentRegular , docAddBaseY BrIndentRegular
$ docPar $ docPar
(docLit $ Text.pack "let") (docLit $ Text.pack "let")
(docSetBaseAndIndent $ bindDoc) (docSetBaseAndIndent bindDoc)
] ]
, docAlt , docAlt
[ docSeq [ docSeq
@ -586,11 +574,11 @@ layoutExpr lexpr@(L _ expr) = do
, docAddBaseY BrIndentRegular , docAddBaseY BrIndentRegular
$ docPar $ docPar
(docLit $ Text.pack "in") (docLit $ Text.pack "in")
(docSetBaseY $ expDoc1) (docSetBaseY expDoc1)
] ]
] ]
] ]
Just bindDocs@(_:_) -> docAltFilter Just bindDocs@(_:_) -> runFilteredAlternative $ do
--either --either
-- let -- let
-- a = b -- a = b
@ -604,32 +592,30 @@ 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
] ]
] ]
) addAlternativeCond (indentPolicy /= IndentPolicyLeft)
, ( indentPolicy /= IndentPolicyLeft $ docLines
, docLines
[ docSeq [ docSeq
[ appSep $ docLit $ Text.pack "let" [ appSep $ docLit $ Text.pack "let"
, docSetBaseAndIndent $ docLines $ bindDocs , docSetBaseAndIndent $ docLines bindDocs
] ]
, docSeq , docSeq
[ appSep $ docLit $ Text.pack "in " [ appSep $ docLit $ Text.pack "in "
, docSetBaseY $ expDoc1 , docSetBaseY expDoc1
] ]
] ]
) addAlternative
, ( True $ docLines
, docLines
[ docAddBaseY BrIndentRegular [ docAddBaseY BrIndentRegular
$ docPar $ docPar
(docLit $ Text.pack "let") (docLit $ Text.pack "let")
@ -639,8 +625,6 @@ layoutExpr lexpr@(L _ expr) = do
(docLit $ Text.pack "in") (docLit $ Text.pack "in")
(docSetBaseY $ expDoc1) (docSetBaseY $ expDoc1)
] ]
)
]
_ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1] _ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1]
-- docSeq [appSep $ docLit "let in", expDoc1] -- docSeq [appSep $ docLit "let in", expDoc1]
HsDo DoExpr (L _ stmts) _ -> do HsDo DoExpr (L _ stmts) _ -> do
@ -662,8 +646,8 @@ layoutExpr lexpr@(L _ expr) = do
; _ -> False } -> do ; _ -> False } -> do
stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
hasComments <- hasAnyCommentsBelow lexpr hasComments <- hasAnyCommentsBelow lexpr
docAltFilter runFilteredAlternative $ do
[ (,) (not hasComments) addAlternativeCond (not hasComments)
$ docSeq $ docSeq
[ docNodeAnnKW lexpr Nothing [ docNodeAnnKW lexpr Nothing
$ appSep $ appSep
@ -675,11 +659,11 @@ layoutExpr lexpr@(L _ expr) = do
$ List.last stmtDocs $ List.last stmtDocs
, appSep $ docLit $ Text.pack "|" , appSep $ docLit $ Text.pack "|"
, docSeq $ List.intersperse docCommaSep , docSeq $ List.intersperse docCommaSep
$ fmap docForceSingleline $ List.init stmtDocs $ docForceSingleline <$> List.init stmtDocs
, docLit $ Text.pack " ]" , docLit $ Text.pack " ]"
] ]
, (,) True addAlternative $
$ let let
start = docCols ColListComp start = docCols ColListComp
[ docNodeAnnKW lexpr Nothing [ docNodeAnnKW lexpr Nothing
$ appSep $ docLit $ Text.pack "[" $ appSep $ docLit $ Text.pack "["
@ -694,7 +678,6 @@ layoutExpr lexpr@(L _ expr) = do
docCols ColListComp [docCommaSep, d] docCols ColListComp [docCommaSep, d]
end = docLit $ Text.pack "]" end = docLit $ Text.pack "]"
in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end] in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end]
]
HsDo{} -> do HsDo{} -> do
-- TODO -- TODO
unknownNodeError "HsDo{} no comp" lexpr unknownNodeError "HsDo{} no comp" lexpr
@ -716,20 +699,19 @@ layoutExpr lexpr@(L _ expr) = do
[ docSeq [ docSeq
[ docLit $ Text.pack "[" [ docLit $ Text.pack "["
, docSeparator , docSeparator
, docSetBaseY $ docNodeAnnKW lexpr (Just AnnOpenS) $ e , docSetBaseY $ docNodeAnnKW lexpr (Just AnnOpenS) e
] ]
, docLit $ Text.pack "]" , docLit $ Text.pack "]"
] ]
] ]
FirstLast e1 ems eN -> FirstLast e1 ems eN -> runFilteredAlternative $ do
docAltFilter addAlternativeCond (not hasComments)
[ (,) (not hasComments)
$ docSeq $ docSeq
$ [docLit $ Text.pack "["] $ [docLit $ Text.pack "["]
++ List.intersperse docCommaSep (docForceSingleline <$> (e1:ems ++ [docNodeAnnKW lexpr (Just AnnOpenS) eN])) ++ List.intersperse docCommaSep (docForceSingleline <$> (e1:ems ++ [docNodeAnnKW lexpr (Just AnnOpenS) eN]))
++ [docLit $ Text.pack "]"] ++ [docLit $ Text.pack "]"]
, (,) True addAlternative $
$ let let
start = docCols ColList start = docCols ColList
[appSep $ docLit $ Text.pack "[", e1] [appSep $ docLit $ Text.pack "[", e1]
linesM = ems <&> \d -> linesM = ems <&> \d ->
@ -737,7 +719,6 @@ layoutExpr lexpr@(L _ expr) = do
lineN = docCols ColList [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenS) eN] lineN = docCols ColList [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenS) eN]
end = docLit $ Text.pack "]" end = docLit $ Text.pack "]"
in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end] in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]
]
ExplicitList _ _ [] -> ExplicitList _ _ [] ->
docLit $ Text.pack "[]" docLit $ Text.pack "[]"
ExplicitPArr{} -> do ExplicitPArr{} -> do
@ -757,20 +738,20 @@ layoutExpr lexpr@(L _ expr) = do
fExpDoc <- if pun fExpDoc <- if pun
then return Nothing then return Nothing
else Just <$> docSharedWrapper layoutExpr fExpr else Just <$> docSharedWrapper layoutExpr fExpr
return $ (fieldl, lrdrNameToText lnameF, fExpDoc) return (fieldl, lrdrNameToText lnameF, fExpDoc)
let line1 appender wrapper = let line1 appender wrapper =
[ appender $ docLit $ Text.pack "{" [ appender $ docLit $ Text.pack "{"
, docWrapNodePrior fd1l $ appSep $ docLit $ fd1n , docWrapNodePrior fd1l $ appSep $ docLit fd1n
, case fd1e of , case fd1e of
Just x -> docSeq Just x -> docSeq
[ appSep $ docLit $ Text.pack "=" [ appSep $ docLit $ Text.pack "="
, docWrapNodeRest fd1l $ wrapper $ x , docWrapNodeRest fd1l $ wrapper x
] ]
Nothing -> docEmpty Nothing -> docEmpty
] ]
let lineR wrapper = fdr <&> \(lfield, fText, fDoc) -> let lineR wrapper = fdr <&> \(lfield, fText, fDoc) ->
[ docCommaSep [ docCommaSep
, appSep $ docLit $ fText , appSep $ docLit fText
, case fDoc of , case fDoc of
Just x -> docWrapNode lfield $ docSeq Just x -> docWrapNode lfield $ docSeq
[ appSep $ docLit $ Text.pack "=" [ appSep $ docLit $ Text.pack "="
@ -784,14 +765,14 @@ layoutExpr lexpr@(L _ expr) = do
] ]
docAlt docAlt
[ docSeq [ docSeq
$ [docNodeAnnKW lexpr Nothing $ nameDoc, docSeparator] $ [docNodeAnnKW lexpr Nothing nameDoc, docSeparator]
++ line1 id docForceSingleline ++ line1 id docForceSingleline
++ join (lineR docForceSingleline) ++ join (lineR docForceSingleline)
++ lineN ++ lineN
, docSetParSpacing , docSetParSpacing
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar $ docPar
(docNodeAnnKW lexpr Nothing $ nameDoc) (docNodeAnnKW lexpr Nothing nameDoc)
( docNonBottomSpacing ( docNonBottomSpacing
$ docLines $ docLines
$ [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)] $ [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)]
@ -808,20 +789,20 @@ layoutExpr lexpr@(L _ expr) = do
fExpDoc <- if pun fExpDoc <- if pun
then return Nothing then return Nothing
else Just <$> docSharedWrapper layoutExpr fExpr else Just <$> docSharedWrapper layoutExpr fExpr
return $ (fieldl, lrdrNameToText lnameF, fExpDoc) return (fieldl, lrdrNameToText lnameF, fExpDoc)
let line1 appender wrapper = let line1 appender wrapper =
[ appender $ docLit $ Text.pack "{" [ appender $ docLit $ Text.pack "{"
, docWrapNodePrior fd1l $ appSep $ docLit $ fd1n , docWrapNodePrior fd1l $ appSep $ docLit fd1n
, case fd1e of , case fd1e of
Just x -> docSeq Just x -> docSeq
[ appSep $ docLit $ Text.pack "=" [ appSep $ docLit $ Text.pack "="
, docWrapNodeRest fd1l $ wrapper $ x , docWrapNodeRest fd1l $ wrapper x
] ]
Nothing -> docEmpty Nothing -> docEmpty
] ]
let lineR wrapper = fdr <&> \(lfield, fText, fDoc) -> let lineR wrapper = fdr <&> \(lfield, fText, fDoc) ->
[ docCommaSep [ docCommaSep
, appSep $ docLit $ fText , appSep $ docLit fText
, case fDoc of , case fDoc of
Just x -> docWrapNode lfield $ docSeq Just x -> docWrapNode lfield $ docSeq
[ appSep $ docLit $ Text.pack "=" [ appSep $ docLit $ Text.pack "="
@ -839,7 +820,7 @@ layoutExpr lexpr@(L _ expr) = do
] ]
docAlt docAlt
[ docSeq [ docSeq
$ [docNodeAnnKW lexpr Nothing $ nameDoc, docSeparator] $ [docNodeAnnKW lexpr Nothing nameDoc, docSeparator]
++ line1 id docForceSingleline ++ line1 id docForceSingleline
++ join (lineR docForceSingleline) ++ join (lineR docForceSingleline)
++ lineDot ++ lineDot
@ -847,7 +828,7 @@ layoutExpr lexpr@(L _ expr) = do
, docSetParSpacing , docSetParSpacing
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar $ docPar
(docNodeAnnKW lexpr Nothing $ nameDoc) (docNodeAnnKW lexpr Nothing nameDoc)
( docNonBottomSpacing ( docNonBottomSpacing
$ docLines $ docLines
$ [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)] $ [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)]
@ -870,10 +851,10 @@ layoutExpr lexpr@(L _ expr) = do
return $ case ambName of return $ case ambName of
Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)
Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)
docAltFilter runFilteredAlternative $ do
-- container { fieldA = blub, fieldB = blub } -- container { fieldA = blub, fieldB = blub }
[ ( True addAlternative
, docSeq $ docSeq
[ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc
, appSep $ docLit $ Text.pack "{" , appSep $ docLit $ Text.pack "{"
, appSep $ docSeq $ List.intersperse docCommaSep , appSep $ docSeq $ List.intersperse docCommaSep
@ -888,18 +869,17 @@ layoutExpr lexpr@(L _ expr) = do
docWrapNode lfield $ docLit fieldStr docWrapNode lfield $ docLit fieldStr
, docLit $ Text.pack "}" , docLit $ Text.pack "}"
] ]
)
-- hanging single-line fields -- hanging single-line fields
-- container { fieldA = blub -- container { fieldA = blub
-- , fieldB = blub -- , fieldB = blub
-- } -- }
, ( indentPolicy /= IndentPolicyLeft addAlternativeCond (indentPolicy /= IndentPolicyLeft)
, docSeq $ docSeq
[ docNodeAnnKW lexpr Nothing $ appSep rExprDoc [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc
, docSetBaseY $ docLines $ let , docSetBaseY $ docLines $ let
line1 = docCols ColRecUpdate line1 = docCols ColRecUpdate
[ 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 "="
@ -909,7 +889,7 @@ layoutExpr lexpr@(L _ expr) = do
] ]
lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate
[ docCommaSep [ docCommaSep
, appSep $ docLit $ fText , appSep $ docLit fText
, case fDoc of , case fDoc of
Just x -> docSeq [ appSep $ docLit $ Text.pack "=" Just x -> docSeq [ appSep $ docLit $ Text.pack "="
, docForceSingleline x , docForceSingleline x
@ -922,25 +902,24 @@ layoutExpr lexpr@(L _ expr) = do
] ]
in [line1] ++ lineR ++ [lineN] in [line1] ++ lineR ++ [lineN]
] ]
)
-- non-hanging with expressions placed to the right of the names -- non-hanging with expressions placed to the right of the names
-- container -- container
-- { fieldA = blub -- { fieldA = blub
-- , fieldB = potentially -- , fieldB = potentially
-- multiline -- multiline
-- } -- }
, ( True addAlternative
, docSetParSpacing $ docSetParSpacing
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar $ docPar
(docNodeAnnKW lexpr Nothing $ rExprDoc) (docNodeAnnKW lexpr Nothing rExprDoc)
(docNonBottomSpacing $ docLines $ let (docNonBottomSpacing $ docLines $ let
expressionWrapper = if indentPolicy == IndentPolicyLeft expressionWrapper = if indentPolicy == IndentPolicyLeft
then docForceParSpacing then docForceParSpacing
else docSetBaseY else docSetBaseY
line1 = docCols ColRecUpdate line1 = docCols ColRecUpdate
[ appSep $ docLit $ Text.pack "{" [ appSep $ docLit $ Text.pack "{"
, docWrapNodePrior rF1f $ appSep $ docLit $ rF1n , docWrapNodePrior rF1f $ appSep $ docLit rF1n
, docWrapNodeRest rF1f $ case rF1e of , docWrapNodeRest rF1f $ case rF1e of
Just x -> docAlt Just x -> docAlt
[ docSeq [ appSep $ docLit $ Text.pack "=" [ docSeq [ appSep $ docLit $ Text.pack "="
@ -954,7 +933,7 @@ layoutExpr lexpr@(L _ expr) = do
lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield
$ docCols ColRecUpdate $ docCols ColRecUpdate
[ docCommaSep [ docCommaSep
, appSep $ docLit $ fText , appSep $ docLit fText
, case fDoc of , case fDoc of
Just x -> docAlt Just x -> docAlt
[ docSeq [ appSep $ docLit $ Text.pack "=" [ docSeq [ appSep $ docLit $ Text.pack "="
@ -971,8 +950,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 */
@ -1078,7 +1055,7 @@ layoutExpr lexpr@(L _ expr) = do
docLit $ Text.pack "_" docLit $ Text.pack "_"
EAsPat asName asExpr -> do EAsPat asName asExpr -> do
docSeq docSeq
[ docLit $ (lrdrNameToText asName) <> Text.pack "@" [ docLit $ lrdrNameToText asName <> Text.pack "@"
, layoutExpr asExpr , layoutExpr asExpr
] ]
EViewPat{} -> do 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 _ (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]
@ -121,25 +118,22 @@ layoutLLIEs :: Bool -> Located [LIE RdrName] -> ToBriDocM BriDocNumbered
layoutLLIEs enableSingleline llies = do layoutLLIEs enableSingleline llies = do
ieDs <- layoutAnnAndSepLLIEs llies ieDs <- layoutAnnAndSepLLIEs llies
hasComments <- hasAnyCommentsBelow llies hasComments <- hasAnyCommentsBelow llies
runFilteredAlternative $
case ieDs of case ieDs of
[] -> docAltFilter [] -> do
[ (not hasComments, docLit $ Text.pack "()") addAlternativeCond (not hasComments) $
, ( hasComments docLit $ Text.pack "()"
, docPar (docSeq [docParenLSep, docWrapNodeRest llies docEmpty]) addAlternativeCond hasComments $
docPar (docSeq [docParenLSep, docWrapNodeRest llies docEmpty])
docParenR docParenR
) (ieDsH:ieDsT) -> do
] addAlternativeCond (not hasComments && enableSingleline)
(ieDsH:ieDsT) -> docAltFilter $ docSeq
[ ( not hasComments && enableSingleline
, docSeq
$ [docLit (Text.pack "(")] $ [docLit (Text.pack "(")]
++ (docForceSingleline <$> ieDs) ++ (docForceSingleline <$> ieDs)
++ [docParenR] ++ [docParenR]
) addAlternative
, ( otherwise $ docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH])
, docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH])
$ docLines $ docLines
$ ieDsT $ ieDsT
++ [docParenR] ++ [docParenR]
)
]

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

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

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

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

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 fExpDoc <- if pun
then return Nothing then return Nothing
else Just <$> docSharedWrapper layoutPat fPat else Just <$> docSharedWrapper layoutPat fPat
return $ (lrdrNameToText lnameF, fExpDoc) return (lrdrNameToText lnameF, fExpDoc)
fmap Seq.singleton $ docSeq Seq.singleton <$> docSeq
[ appSep $ docLit t [ appSep $ docLit t
, appSep $ docLit $ Text.pack "{" , appSep $ docLit $ Text.pack "{"
, docSeq $ List.intersperse docCommaSep , docSeq $ List.intersperse docCommaSep
$ fds <&> \case $ fds <&> \case
(fieldName, Just fieldDoc) -> docSeq (fieldName, Just fieldDoc) -> docSeq
[ appSep $ docLit $ fieldName [ appSep $ docLit fieldName
, appSep $ docLit $ Text.pack "=" , appSep $ docLit $ Text.pack "="
, fieldDoc >>= colsWrapPat , fieldDoc >>= colsWrapPat
] ]
@ -112,7 +112,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
ConPatIn lname (RecCon (HsRecFields [] (Just 0))) -> do ConPatIn lname (RecCon (HsRecFields [] (Just 0))) -> do
-- Abc { .. } -> expr -- Abc { .. } -> expr
let t = lrdrNameToText lname let t = lrdrNameToText lname
fmap Seq.singleton $ docSeq Seq.singleton <$> docSeq
[ appSep $ docLit t [ appSep $ docLit t
, docLit $ Text.pack "{..}" , docLit $ Text.pack "{..}"
] ]
@ -123,13 +123,13 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
fExpDoc <- if pun fExpDoc <- if pun
then return Nothing then return Nothing
else Just <$> docSharedWrapper layoutPat fPat else Just <$> docSharedWrapper layoutPat fPat
return $ (lrdrNameToText lnameF, fExpDoc) return (lrdrNameToText lnameF, fExpDoc)
fmap Seq.singleton $ docSeq Seq.singleton <$> docSeq
[ appSep $ docLit t [ appSep $ docLit t
, appSep $ docLit $ Text.pack "{" , appSep $ docLit $ Text.pack "{"
, docSeq $ fds >>= \case , docSeq $ fds >>= \case
(fieldName, Just fieldDoc) -> (fieldName, Just fieldDoc) ->
[ appSep $ docLit $ fieldName [ appSep $ docLit fieldName
, appSep $ docLit $ Text.pack "=" , appSep $ docLit $ Text.pack "="
, fieldDoc >>= colsWrapPat , fieldDoc >>= colsWrapPat
, docCommaSep , docCommaSep
@ -167,7 +167,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
docAddBaseY BrIndentRegular $ docSeq docAddBaseY BrIndentRegular $ docSeq
[ appSep $ return xN [ appSep $ return xN
, appSep $ docLit $ Text.pack "::" , appSep $ docLit $ Text.pack "::"
, docForceSingleline $ tyDoc , docForceSingleline tyDoc
] ]
return $ xR Seq.|> xN' return $ xR Seq.|> xN'
ListPat elems _ _ -> ListPat elems _ _ ->
@ -193,7 +193,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
-- else -- else
-- VarPat n -> return $ stringLayouter lpat $ rdrNameToText n -- VarPat n -> return $ stringLayouter lpat $ rdrNameToText n
-- endif -- endif
_ -> fmap return $ briDocByExactInlineOnly "some unknown pattern" lpat _ -> return <$> briDocByExactInlineOnly "some unknown pattern" lpat
colsWrapPat :: Seq BriDocNumbered -> ToBriDocM BriDocNumbered colsWrapPat :: Seq BriDocNumbered -> ToBriDocM BriDocNumbered
colsWrapPat = docCols ColPatterns . fmap return . Foldable.toList colsWrapPat = docCols ColPatterns . fmap return . Foldable.toList
@ -205,7 +205,7 @@ wrapPatPrepend
wrapPatPrepend pat prepElem = do wrapPatPrepend pat prepElem = do
patDocs <- layoutPat pat patDocs <- layoutPat pat
case Seq.viewl patDocs of case Seq.viewl patDocs of
Seq.EmptyL -> return $ Seq.empty Seq.EmptyL -> return Seq.empty
x1 Seq.:< xR -> do x1 Seq.:< xR -> do
x1' <- docSeq [prepElem, return x1] x1' <- docSeq [prepElem, return x1]
return $ x1' Seq.<| xR return $ x1' Seq.<| xR
@ -216,7 +216,7 @@ wrapPatListy
-> String -> String
-> ToBriDocM (Seq BriDocNumbered) -> ToBriDocM (Seq BriDocNumbered)
wrapPatListy elems start end = do 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 sDoc <- docLit $ Text.pack start
eDoc <- docLit $ Text.pack end eDoc <- docLit $ Text.pack end
case Seq.viewl elemDocs of 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") (docLit $ Text.pack "let")
(docSetBaseAndIndent $ return bindDoc) (docSetBaseAndIndent $ return bindDoc)
] ]
Just bindDocs -> docAltFilter Just bindDocs -> runFilteredAlternative $ do
[ -- let aaa = expra -- let aaa = expra
-- bbb = exprb -- bbb = exprb
-- ccc = exprc -- ccc = exprc
( indentPolicy /= IndentPolicyLeft addAlternativeCond (indentPolicy /= IndentPolicyLeft)
, docSeq $ docSeq
[ appSep $ docLit $ Text.pack "let" [ appSep $ docLit $ Text.pack "let"
, docSetBaseAndIndent $ docLines $ return <$> bindDocs , docSetBaseAndIndent $ docLines $ return <$> bindDocs
] ]
) -- let
, -- let
-- aaa = expra -- aaa = expra
-- bbb = exprb -- bbb = exprb
-- ccc = exprc -- ccc = exprc
( True addAlternative $
, docAddBaseY BrIndentRegular $ docPar docAddBaseY BrIndentRegular $ docPar
(docLit $ Text.pack "let") (docLit $ Text.pack "let")
(docSetBaseAndIndent $ docLines $ return <$> bindDocs) (docSetBaseAndIndent $ docLines $ return <$> bindDocs)
) RecStmt stmts _ _ _ _ _ _ _ _ _ -> runFilteredAlternative $ do
] -- rec stmt1
RecStmt stmts _ _ _ _ _ _ _ _ _ -> docAltFilter
[ -- rec stmt1
-- stmt2 -- stmt2
-- stmt3 -- stmt3
( indentPolicy /= IndentPolicyLeft addAlternativeCond (indentPolicy /= IndentPolicyLeft)
, docSeq $ docSeq
[ docLit (Text.pack "rec") [ docLit (Text.pack "rec")
, docSeparator , docSeparator
, docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts , docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts
] ]
) -- rec
, -- rec
-- stmt1 -- stmt1
-- stmt2 -- stmt2
-- stmt3 -- stmt3
( True addAlternative
, docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar (docLit (Text.pack "rec")) (docLines $ layoutStmt <$> stmts) $ docPar (docLit (Text.pack "rec")) (docLines $ layoutStmt <$> stmts)
)
]
BodyStmt expr _ _ _ -> do BodyStmt expr _ _ _ -> do
expDoc <- docSharedWrapper layoutExpr expr expDoc <- docSharedWrapper layoutExpr expr
docAddBaseY BrIndentRegular $ expDoc docAddBaseY BrIndentRegular $ expDoc

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 Foreign.ForeignPtr as E ( ForeignPtr
) )
import Data.Monoid as E ( (<>) import Data.Monoid as E ( mconcat
, mconcat
, Monoid (..) , Monoid (..)
) )
import Data.Bifunctor as E ( bimap ) import Data.Bifunctor as E ( bimap )
import Data.Functor as E ( (<$), ($>) ) import Data.Functor as E ( (<$), ($>) )
import Data.Function as E ( (&) ) import Data.Function as E ( (&) )
import Data.Semigroup as E ( (<>)
, Semigroup(..)
)
import System.IO as E ( hFlush import System.IO as E ( hFlush
, stdout , stdout
) )

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

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

2
stack.yaml
View File

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