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

Merge pull request #66 from eborden/indentpolicyleft 

Support IndentPolicyLeft
pull/75/head
Lennart Spitzner 2017-12-01 00:30:27 +01:00 committed by GitHub
parent 072b1cf091 127299b442
commit 5bba918705
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
9 changed files with 2294 additions and 1004 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src-literatetests/15-regressions.blt
View File

@ -31,7 +31,7 @@ func = do
func = do
s <- mGet
mSet $ s { _lstate_indent = _lstate_indent state
, _lstate_indent = _lstate_indent state
, _lstate_foo = _lstate_foo state
}
#test record update indentation 3
@ -39,7 +39,23 @@ func = do
s <- mGet
mSet $ s
{ _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
, _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
, _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
}
#test record construction 1
func = Foo {_lstate_indent = _lstate_indent state}
#test record construction 2
func = Foo
{ _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
, _lstate_fooo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
}
#test record construction 3
func = do
Foo
{ _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
, _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
}
#test post-indent comment

34
src-literatetests/Main.hs
View File

@ -40,14 +40,27 @@ data InputLine
main :: IO ()
main = do
files <- System.Directory.listDirectory "src-literatetests/"
let blts = List.sort $ filter (".blt" `isSuffixOf`) files
let blts =
List.sort
$ filter (\x -> not ("tests-context-free.blt" `isSuffixOf` x))
$ filter (".blt"`isSuffixOf`) files
inputs <- blts `forM` \blt -> Text.IO.readFile ("src-literatetests" </> blt)
let groups = createChunks =<< inputs
hspec $ groups `forM_` \(groupname, tests) -> do
inputCtxFree <- Text.IO.readFile "src-literatetests/tests-context-free.blt"
let groupsCtxFree = createChunks inputCtxFree
hspec $ do
groups `forM_` \(groupname, tests) -> do
describe (Text.unpack groupname) $ tests `forM_` \(name, pend, inp) -> do
(if pend then before_ pending else id)
$ it (Text.unpack name)
$ roundTripEqual inp
$ roundTripEqual defaultTestConfig inp
groupsCtxFree `forM_` \(groupname, tests) -> do
describe ("context free: " ++ Text.unpack groupname)
$ tests
`forM_` \(name, pend, inp) -> do
(if pend then before_ pending else id)
$ it (Text.unpack name)
$ roundTripEqual contextFreeTestConfig inp
where
-- this function might be implemented in a weirdly complex fashion; the
-- reason being that it was copied from a somewhat more complex variant.
@ -132,10 +145,10 @@ main = do
--------------------
-- past this line: copy-pasta from other test (meh..)
--------------------
roundTripEqual :: Text -> Expectation
roundTripEqual t =
roundTripEqual :: Config -> Text -> Expectation
roundTripEqual c t =
fmap (fmap PPTextWrapper)
(parsePrintModuleTests defaultTestConfig "TestFakeFileName.hs" t)
(parsePrintModuleTests c "TestFakeFileName.hs" t)
`shouldReturn` Right (PPTextWrapper t)
newtype PPTextWrapper = PPTextWrapper Text
@ -170,3 +183,12 @@ defaultTestConfig = Config
}
}
contextFreeTestConfig :: Config
contextFreeTestConfig =
defaultTestConfig
{ _conf_layout = (_conf_layout defaultTestConfig)
{_lconfig_indentPolicy = coerce IndentPolicyLeft
,_lconfig_alignmentLimit = coerce (1 :: Int)
,_lconfig_columnAlignMode = coerce ColumnAlignModeDisabled
}
}

1131
src-literatetests/tests-context-free.blt Normal file
View File

File diff suppressed because it is too large Load Diff

2
src/Language/Haskell/Brittany/Internal/Config/Types.hs
View File

@ -191,7 +191,7 @@ data IndentPolicy = IndentPolicyLeft -- never create a new indentation at more
| IndentPolicyFree -- can create new indentations whereever
| IndentPolicyMultiple -- can create indentations only
-- at any n * amount.
deriving (Show, Generic, Data)
deriving (Eq, Show, Generic, Data)
data AltChooser = AltChooserSimpleQuick -- always choose last alternative.
-- leads to tons of sparsely filled

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

@ -265,9 +265,15 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
gs -> docSeq
$ [appSep $ docLit $ Text.pack "|"]
++ List.intersperse docCommaSep (return <$> gs)
docAlt
indentPolicy <- mAsk
<&> _conf_layout
.> _lconfig_indentPolicy
.> confUnpack
docAltFilter
$ -- one-line solution
[ docCols
[ ( True
, docCols
(ColBindingLine alignmentToken)
[ docSeq (patPartInline ++ [guardPart])
, docSeq
@ -276,6 +282,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
, wherePart
]
]
)
| not hasComments
, [(guards, body, _bodyRaw)] <- [clauseDocs]
, let guardPart = singleLineGuardsDoc guards
@ -289,7 +296,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
_ -> []
]
++ -- one-line solution + where in next line(s)
[ docLines
[ ( True
, docLines
$ [ docCols
(ColBindingLine alignmentToken)
[ docSeq (patPartInline ++ [guardPart])
@ -298,23 +306,27 @@ 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)
[ docLines
[ ( True
, 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;
-- where in following lines
[ docLines
[ ( True
, docLines
$ [ docCols
(ColBindingLine alignmentToken)
[ docSeq (patPartInline ++ [guardPart])
@ -329,24 +341,28 @@ 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.
[ docLines
[ ( True
, docLines
$ [ docSeq (patPartInline ++ [guardPart, return binderDoc])
, docEnsureIndent BrIndentRegular
$ docNonBottomSpacing
$ (docAddBaseY BrIndentRegular $ return body)
]
++ wherePartMultiLine
)
| [(guards, body, _)] <- [clauseDocs]
, let guardPart = singleLineGuardsDoc guards
]
++ -- multiple clauses added in-paragraph, each in a single line
-- example: foo | bar = baz
-- | lll = asd
[ docLines
[ ( indentPolicy /= IndentPolicyLeft
, docLines
$ [ docSeq
[ appSep $ docForceSingleline $ return patDoc
, docSetBaseY
@ -370,10 +386,12 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
]
]
++ wherePartMultiLine
)
| Just patDoc <- [mPatDoc]
]
++ -- multiple clauses, each in a separate, single line
[ docLines
[ ( True
, docLines
$ [ docAddBaseY BrIndentRegular
$ patPartParWrap
$ docLines
@ -396,10 +414,12 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
]
]
++ wherePartMultiLine
)
]
++ -- multiple clauses, each with the guard(s) in a single line, body
-- as a paragraph
[ docLines
[ ( True
, docLines
$ [ docAddBaseY BrIndentRegular
$ patPartParWrap
$ docLines
@ -431,10 +451,12 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
]
]
++ wherePartMultiLine
)
]
++ -- multiple clauses, each with the guard(s) in a single line, body
-- in a new line as a paragraph
[ docLines
[ ( True
, docLines
$ [ docAddBaseY BrIndentRegular
$ patPartParWrap
$ docLines
@ -464,9 +486,11 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
]
]
++ wherePartMultiLine
)
]
++ -- conservative approach: everything starts on the left.
[ docLines
[ ( True
, docLines
$ [ docAddBaseY BrIndentRegular
$ patPartParWrap
$ docLines
@ -494,4 +518,5 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
]
]
++ wherePartMultiLine
)
]

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

@ -13,6 +13,7 @@ where
import Language.Haskell.Brittany.Internal.Types
import Language.Haskell.Brittany.Internal.LayouterBasics
import Language.Haskell.Brittany.Internal.Config.Types
import RdrName ( RdrName(..) )
import GHC ( runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..) )
@ -30,7 +31,13 @@ import Language.Haskell.Brittany.Internal.Layouters.Type
layoutExpr :: ToBriDoc HsExpr
layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
layoutExpr lexpr@(L _ expr) = do
indentPolicy <- mAsk
<&> _conf_layout
.> _lconfig_indentPolicy
.> confUnpack
let allowFreeIndent = indentPolicy == IndentPolicyFree
docWrapNode lexpr $ case expr of
HsVar vname -> do
docLit =<< lrdrNameToTextAnn vname
HsUnboundVar var -> case var of
@ -112,42 +119,50 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
let (headE, paramEs) = gather [exp2] exp1
headDoc <- docSharedWrapper layoutExpr headE
paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs
docAlt
docAltFilter
[ -- foo x y
docCols ColApp
( True
, docCols ColApp
$ appSep (docForceSingleline headDoc)
: spacifyDocs (docForceSingleline <$> paramDocs)
)
, -- foo x
-- y
docSeq
( allowFreeIndent
, docSeq
[ appSep (docForceSingleline headDoc)
, docSetBaseY
$ docAddBaseY BrIndentRegular
$ docLines
$ (docForceSingleline <$> paramDocs)
]
)
, -- foo
-- x
-- y
docSetParSpacing
( True
, docSetParSpacing
$ docAddBaseY BrIndentRegular
$ docPar
(docForceSingleline headDoc)
( docNonBottomSpacing
$ docLines paramDocs
)
)
, -- ( multi
-- line
-- function
-- )
-- x
-- y
docAddBaseY BrIndentRegular
( True
, 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.
@ -400,6 +415,12 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
thenExprDoc <- docSharedWrapper layoutExpr thenExpr
elseExprDoc <- docSharedWrapper layoutExpr elseExpr
hasComments <- hasAnyCommentsBelow lexpr
let maySpecialIndent =
case indentPolicy of
IndentPolicyLeft -> BrIndentRegular
_ -> BrIndentSpecial 3
-- TODO: some of the alternatives (especially last and last-but-one)
-- overlap.
docAltFilter
[ -- if _ then _ else _
(,) (not hasComments)
@ -428,8 +449,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
$ docSetParSpacing
$ docAddBaseY BrIndentRegular
$ docPar
( docAddBaseY (BrIndentSpecial 3)
$ docSeq
( docSeq
[ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"
, docNodeAnnKW lexpr (Just AnnIf) $ docForceSingleline ifExprDoc
])
@ -468,7 +488,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
(,) True
$ docAddBaseY BrIndentRegular
$ docPar
( docAddBaseY (BrIndentSpecial 3)
( docAddBaseY maySpecialIndent
$ docSeq
[ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"
, docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc
@ -491,7 +511,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
, (,) True
$ docSetBaseY
$ docLines
[ docAddBaseY (BrIndentSpecial 3)
[ docAddBaseY maySpecialIndent
$ docSeq
[ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"
, docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc
@ -520,13 +540,16 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
-- if "let" is moved horizontally as part of the transformation, as the
-- comments before the first let item are moved horizontally with it.
docSetIndentLevel $ case mBindDocs of
Just [bindDoc] -> docAlt
[ docSeq
Just [bindDoc] -> docAltFilter
[ ( True
, docSeq
[ appSep $ docLit $ Text.pack "let"
, appSep $ docForceSingleline $ return bindDoc
, appSep $ docLit $ Text.pack "in"
, docForceSingleline $ expDoc1
]
)
, ( indentPolicy /= IndentPolicyLeft
, docLines
[ docSeq
[ appSep $ docLit $ Text.pack "let"
@ -537,6 +560,8 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
, docSetBaseY $ expDoc1
]
]
)
, ( True
, docLines
[ docAddBaseY BrIndentRegular
$ docPar
@ -547,9 +572,36 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
(appSep $ docLit $ Text.pack "in")
(docSetBaseY $ expDoc1)
]
)
]
Just bindDocs@(_:_) -> docAlt
[ docLines
Just bindDocs@(_:_) -> docAltFilter
--either
-- let
-- a = b
-- c = d
-- in foo
-- bar
-- baz
--or
-- let
-- a = b
-- c = d
-- in
-- fooooooooooooooooooo
[ ( indentPolicy == IndentPolicyLeft
, docLines
[ docAddBaseY BrIndentRegular
$ docPar
(docLit $ Text.pack "let")
(docSetBaseAndIndent $ docLines $ return <$> bindDocs)
, docSeq
[ docLit $ Text.pack "in "
, docAddBaseY BrIndentRegular $ expDoc1
]
]
)
, ( indentPolicy /= IndentPolicyLeft
, docLines
[ docSeq
[ appSep $ docLit $ Text.pack "let"
, docSetBaseAndIndent $ docLines $ return <$> bindDocs
@ -559,6 +611,8 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
, docSetBaseY $ expDoc1
]
]
)
, ( True
, docLines
[ docAddBaseY BrIndentRegular
$ docPar
@ -569,6 +623,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
(docLit $ Text.pack "in")
(docSetBaseY $ expDoc1)
]
)
]
_ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1]
-- docSeq [appSep $ docLit "let in", expDoc1]
@ -797,9 +852,10 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
return $ case ambName of
Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)
Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)
docAlt
docAltFilter
-- singleline
[ docSeq
[ ( True
, docSeq
[ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc
, appSep $ docLit $ Text.pack "{"
, appSep $ docSeq $ List.intersperse docCommaSep
@ -814,7 +870,9 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
docWrapNode lfield $ docLit fieldStr
, docLit $ Text.pack "}"
]
)
-- wild-indentation block
, ( indentPolicy /= IndentPolicyLeft
, docSeq
[ docNodeAnnKW lexpr Nothing $ appSep rExprDoc
, docSetBaseY $ docLines $ let
@ -843,7 +901,9 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
]
in [line1] ++ lineR ++ [lineN]
]
)
-- strict indentation block
, ( True
, docSetParSpacing
$ docAddBaseY BrIndentRegular
$ docPar
@ -872,6 +932,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
, docLit $ Text.pack "}"
]
in [line1] ++ lineR ++ [lineN])
)
]
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do
@ -903,7 +964,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
docSeq
[ docLit $ Text.pack "["
, docForceSingleline e1Doc
, docCommaSep
, appSep $ docLit $ Text.pack ","
, appSep $ docForceSingleline e2Doc
, docLit $ Text.pack "..]"
]
@ -924,7 +985,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
docSeq
[ docLit $ Text.pack "["
, docForceSingleline e1Doc
, docCommaSep
, appSep $ docLit $ Text.pack ","
, appSep $ docForceSingleline e2Doc
, appSep $ docLit $ Text.pack ".."
, docForceSingleline eNDoc

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

@ -11,6 +11,7 @@ where
import Language.Haskell.Brittany.Internal.Types
import Language.Haskell.Brittany.Internal.LayouterBasics
import Language.Haskell.Brittany.Internal.Config.Types
import RdrName ( RdrName(..) )
import GHC ( runGhc, GenLocated(L), moduleNameString )
@ -26,7 +27,9 @@ import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr
layoutStmt :: ToBriDoc' (StmtLR RdrName RdrName (LHsExpr RdrName))
layoutStmt lstmt@(L _ stmt) = docWrapNode lstmt $ case stmt of
layoutStmt lstmt@(L _ stmt) = do
indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack
docWrapNode lstmt $ case stmt of
LastStmt body False _ -> do
layoutExpr body
BindStmt lPat expr _ _ _ -> do
@ -52,30 +55,62 @@ layoutStmt lstmt@(L _ stmt) = docWrapNode lstmt $ case stmt of
-- heh.
Just [] -> docLit $ Text.pack "let" -- this probably never happens
Just [bindDoc] -> docAlt
[ docCols
[ -- let bind = expr
docCols
ColDoLet
[ appSep $ docLit $ Text.pack "let"
, docSetBaseAndIndent $ return bindDoc
, ( if indentPolicy == IndentPolicyLeft
then docForceSingleline
else docSetBaseAndIndent
)
$ return bindDoc
]
, docAddBaseY BrIndentRegular
$ docPar (docLit $ Text.pack "let")
, -- let
-- bind = expr
docAddBaseY BrIndentRegular $ docPar
(docLit $ Text.pack "let")
(docSetBaseAndIndent $ return bindDoc)
]
Just bindDocs -> docAlt
[ docSeq
Just bindDocs -> docAltFilter
[ -- let aaa = expra
-- bbb = exprb
-- ccc = exprc
( indentPolicy /= IndentPolicyLeft
, docSeq
[ appSep $ docLit $ Text.pack "let"
, docSetBaseAndIndent $ docLines $ return <$> bindDocs
]
)
, -- let
-- aaa = expra
-- bbb = exprb
-- ccc = exprc
( True
, docAddBaseY BrIndentRegular $ docPar
(docLit $ Text.pack "let")
(docSetBaseAndIndent $ docLines $ return <$> bindDocs)
)
]
RecStmt stmts _ _ _ _ _ _ _ _ _ -> do
docSeq
RecStmt stmts _ _ _ _ _ _ _ _ _ -> docAltFilter
[ -- rec stmt1
-- stmt2
-- stmt3
( indentPolicy /= IndentPolicyLeft
, docSeq
[ docLit (Text.pack "rec")
, docSeparator
, docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts
]
)
, -- rec
-- stmt1
-- stmt2
-- stmt3
( True
, 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/Layouters/Type.hs
View File

@ -178,7 +178,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
, docPar
(docSeq $ docLit (Text.pack "forall") : tyVarDocLineList)
( docCols ColTyOpPrefix
[ docWrapNodeRest ltype $ docLit $ Text.pack ". "
[ docWrapNodeRest ltype $ docLit $ Text.pack " . "
, maybeForceML $ return typeDoc
]
)
@ -204,7 +204,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
]
)
++[ docCols ColTyOpPrefix
[ docWrapNodeRest ltype $ docLit $ Text.pack ". "
[ docWrapNodeRest ltype $ docLit $ Text.pack " . "
, maybeForceML $ return typeDoc
]
]
@ -499,7 +499,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
)
(docCols ColTyOpPrefix
[ docWrapNodeRest ltype
$ docLit $ Text.pack "::"
$ docLit $ Text.pack ":: "
, docAddBaseY (BrIndentSpecial 2) typeDoc1
])
]