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

2
src-literatetests/10-tests.blt
View File

@ -227,7 +227,7 @@ func
{-# LANGUAGE ScopedTypeVariables #-}
func
:: forall m
. ColMap2
. ColMap2
-> ColInfo
-> ColInfo
-> ColInfo

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

40
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
describe (Text.unpack groupname) $ tests `forM_` \(name, pend, inp) -> do
(if pend then before_ pending else id)
$ it (Text.unpack name)
$ roundTripEqual inp
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 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
)
]

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

File diff suppressed because it is too large Load Diff

137
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,57 +27,91 @@ import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr
layoutStmt :: ToBriDoc' (StmtLR RdrName RdrName (LHsExpr RdrName))
layoutStmt lstmt@(L _ stmt) = docWrapNode lstmt $ case stmt of
LastStmt body False _ -> do
layoutExpr body
BindStmt lPat expr _ _ _ -> do
patDoc <- fmap return $ colsWrapPat =<< layoutPat lPat
expDoc <- docSharedWrapper layoutExpr expr
docAlt
[ docCols
ColBindStmt
[ appSep patDoc
, docSeq [appSep $ docLit $ Text.pack "<-", docForceParSpacing expDoc]
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
patDoc <- fmap return $ colsWrapPat =<< layoutPat lPat
expDoc <- docSharedWrapper layoutExpr expr
docAlt
[ docCols
ColBindStmt
[ appSep patDoc
, docSeq [appSep $ docLit $ Text.pack "<-", docForceParSpacing expDoc]
]
, docCols
ColBindStmt
[ appSep patDoc
, docAddBaseY BrIndentRegular
$ docPar (docLit $ Text.pack "<-") (expDoc)
]
]
, docCols
ColBindStmt
[ appSep patDoc
LetStmt binds -> layoutLocalBinds binds >>= \case
Nothing -> docLit $ Text.pack "let" -- i just tested
-- it, and it is
-- indeed allowed.
-- heh.
Just [] -> docLit $ Text.pack "let" -- this probably never happens
Just [bindDoc] -> docAlt
[ -- let bind = expr
docCols
ColDoLet
[ appSep $ docLit $ Text.pack "let"
, ( if indentPolicy == IndentPolicyLeft
then docForceSingleline
else docSetBaseAndIndent
)
$ return bindDoc
]
, -- let
-- bind = expr
docAddBaseY BrIndentRegular $ docPar
(docLit $ Text.pack "let")
(docSetBaseAndIndent $ return bindDoc)
]
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 _ _ _ _ _ _ _ _ _ -> 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 "<-") (expDoc)
]
$ docPar (docLit (Text.pack "rec")) (docLines $ layoutStmt <$> stmts)
)
]
LetStmt binds -> layoutLocalBinds binds >>= \case
Nothing -> docLit $ Text.pack "let" -- i just tested
-- it, and it is
-- indeed allowed.
-- heh.
Just [] -> docLit $ Text.pack "let" -- this probably never happens
Just [bindDoc] -> docAlt
[ docCols
ColDoLet
[ appSep $ docLit $ Text.pack "let"
, docSetBaseAndIndent $ return bindDoc
]
, docAddBaseY BrIndentRegular
$ docPar (docLit $ Text.pack "let")
(docSetBaseAndIndent $ return bindDoc)
]
Just bindDocs -> docAlt
[ docSeq
[ appSep $ docLit $ Text.pack "let"
, docSetBaseAndIndent $ docLines $ return <$> bindDocs
]
, docAddBaseY BrIndentRegular $ docPar
(docLit $ Text.pack "let")
(docSetBaseAndIndent $ docLines $ return <$> bindDocs)
]
RecStmt stmts _ _ _ _ _ _ _ _ _ -> do
docSeq
[ docLit (Text.pack "rec")
, docSeparator
, docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts
]
BodyStmt expr _ _ _ -> do
expDoc <- docSharedWrapper layoutExpr expr
docAddBaseY BrIndentRegular $ expDoc
_ -> briDocByExactInlineOnly "some unknown statement" lstmt
BodyStmt expr _ _ _ -> do
expDoc <- docSharedWrapper layoutExpr expr
docAddBaseY BrIndentRegular $ expDoc
_ -> briDocByExactInlineOnly "some unknown statement" lstmt

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

@ -174,17 +174,17 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
, docForceSingleline $ return $ typeDoc
]
-- :: forall x
-- . x
-- . x
, docPar
(docSeq $ docLit (Text.pack "forall") : tyVarDocLineList)
( docCols ColTyOpPrefix
[ docWrapNodeRest ltype $ docLit $ Text.pack ". "
[ docWrapNodeRest ltype $ docLit $ Text.pack " . "
, maybeForceML $ return typeDoc
]
)
-- :: forall
-- (x :: *)
-- . x
-- . x
, docPar
(docLit (Text.pack "forall"))
(docLines
@ -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
])
]