commit
5bba918705
|
@ -31,7 +31,7 @@ func = do
|
||||||
func = do
|
func = do
|
||||||
s <- mGet
|
s <- mGet
|
||||||
mSet $ s { _lstate_indent = _lstate_indent state
|
mSet $ s { _lstate_indent = _lstate_indent state
|
||||||
, _lstate_indent = _lstate_indent state
|
, _lstate_foo = _lstate_foo state
|
||||||
}
|
}
|
||||||
|
|
||||||
#test record update indentation 3
|
#test record update indentation 3
|
||||||
|
@ -39,7 +39,23 @@ func = do
|
||||||
s <- mGet
|
s <- mGet
|
||||||
mSet $ s
|
mSet $ s
|
||||||
{ _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
|
{ _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
|
#test post-indent comment
|
||||||
|
|
|
@ -40,14 +40,27 @@ data InputLine
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
files <- System.Directory.listDirectory "src-literatetests/"
|
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)
|
inputs <- blts `forM` \blt -> Text.IO.readFile ("src-literatetests" </> blt)
|
||||||
let groups = createChunks =<< inputs
|
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
|
describe (Text.unpack groupname) $ tests `forM_` \(name, pend, inp) -> do
|
||||||
(if pend then before_ pending else id)
|
(if pend then before_ pending else id)
|
||||||
$ it (Text.unpack name)
|
$ 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
|
where
|
||||||
-- this function might be implemented in a weirdly complex fashion; the
|
-- this function might be implemented in a weirdly complex fashion; the
|
||||||
-- reason being that it was copied from a somewhat more complex variant.
|
-- 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..)
|
-- past this line: copy-pasta from other test (meh..)
|
||||||
--------------------
|
--------------------
|
||||||
roundTripEqual :: Text -> Expectation
|
roundTripEqual :: Config -> Text -> Expectation
|
||||||
roundTripEqual t =
|
roundTripEqual c t =
|
||||||
fmap (fmap PPTextWrapper)
|
fmap (fmap PPTextWrapper)
|
||||||
(parsePrintModuleTests defaultTestConfig "TestFakeFileName.hs" t)
|
(parsePrintModuleTests c "TestFakeFileName.hs" t)
|
||||||
`shouldReturn` Right (PPTextWrapper t)
|
`shouldReturn` Right (PPTextWrapper t)
|
||||||
|
|
||||||
newtype PPTextWrapper = PPTextWrapper Text
|
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
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -191,7 +191,7 @@ data IndentPolicy = IndentPolicyLeft -- never create a new indentation at more
|
||||||
| IndentPolicyFree -- can create new indentations whereever
|
| IndentPolicyFree -- can create new indentations whereever
|
||||||
| IndentPolicyMultiple -- can create indentations only
|
| IndentPolicyMultiple -- can create indentations only
|
||||||
-- at any n * amount.
|
-- at any n * amount.
|
||||||
deriving (Show, Generic, Data)
|
deriving (Eq, Show, Generic, Data)
|
||||||
|
|
||||||
data AltChooser = AltChooserSimpleQuick -- always choose last alternative.
|
data AltChooser = AltChooserSimpleQuick -- always choose last alternative.
|
||||||
-- leads to tons of sparsely filled
|
-- leads to tons of sparsely filled
|
||||||
|
|
|
@ -265,9 +265,15 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
|
||||||
gs -> docSeq
|
gs -> docSeq
|
||||||
$ [appSep $ docLit $ Text.pack "|"]
|
$ [appSep $ docLit $ Text.pack "|"]
|
||||||
++ List.intersperse docCommaSep (return <$> gs)
|
++ List.intersperse docCommaSep (return <$> gs)
|
||||||
docAlt
|
|
||||||
|
indentPolicy <- mAsk
|
||||||
|
<&> _conf_layout
|
||||||
|
.> _lconfig_indentPolicy
|
||||||
|
.> confUnpack
|
||||||
|
docAltFilter
|
||||||
$ -- one-line solution
|
$ -- one-line solution
|
||||||
[ docCols
|
[ ( True
|
||||||
|
, docCols
|
||||||
(ColBindingLine alignmentToken)
|
(ColBindingLine alignmentToken)
|
||||||
[ docSeq (patPartInline ++ [guardPart])
|
[ docSeq (patPartInline ++ [guardPart])
|
||||||
, docSeq
|
, docSeq
|
||||||
|
@ -276,6 +282,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
|
||||||
, wherePart
|
, wherePart
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
)
|
||||||
| not hasComments
|
| not hasComments
|
||||||
, [(guards, body, _bodyRaw)] <- [clauseDocs]
|
, [(guards, body, _bodyRaw)] <- [clauseDocs]
|
||||||
, let guardPart = singleLineGuardsDoc guards
|
, let guardPart = singleLineGuardsDoc guards
|
||||||
|
@ -289,7 +296,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
|
||||||
_ -> []
|
_ -> []
|
||||||
]
|
]
|
||||||
++ -- one-line solution + where in next line(s)
|
++ -- one-line solution + where in next line(s)
|
||||||
[ docLines
|
[ ( True
|
||||||
|
, docLines
|
||||||
$ [ docCols
|
$ [ docCols
|
||||||
(ColBindingLine alignmentToken)
|
(ColBindingLine alignmentToken)
|
||||||
[ docSeq (patPartInline ++ [guardPart])
|
[ docSeq (patPartInline ++ [guardPart])
|
||||||
|
@ -298,23 +306,27 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
++ wherePartMultiLine
|
++ wherePartMultiLine
|
||||||
|
)
|
||||||
| [(guards, body, _bodyRaw)] <- [clauseDocs]
|
| [(guards, body, _bodyRaw)] <- [clauseDocs]
|
||||||
, let guardPart = singleLineGuardsDoc guards
|
, let guardPart = singleLineGuardsDoc guards
|
||||||
, Data.Maybe.isJust mWhereDocs
|
, Data.Maybe.isJust mWhereDocs
|
||||||
]
|
]
|
||||||
++ -- two-line solution + where in next line(s)
|
++ -- two-line solution + where in next line(s)
|
||||||
[ docLines
|
[ ( 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
|
||||||
|
)
|
||||||
| [(guards, body, _bodyRaw)] <- [clauseDocs]
|
| [(guards, body, _bodyRaw)] <- [clauseDocs]
|
||||||
, let guardPart = singleLineGuardsDoc guards
|
, 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
|
-- where in following lines
|
||||||
[ docLines
|
[ ( True
|
||||||
|
, docLines
|
||||||
$ [ docCols
|
$ [ docCols
|
||||||
(ColBindingLine alignmentToken)
|
(ColBindingLine alignmentToken)
|
||||||
[ docSeq (patPartInline ++ [guardPart])
|
[ docSeq (patPartInline ++ [guardPart])
|
||||||
|
@ -329,24 +341,28 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
|
||||||
-- , docAddBaseY BrIndentRegular $ return body
|
-- , docAddBaseY BrIndentRegular $ return body
|
||||||
-- ]
|
-- ]
|
||||||
++ wherePartMultiLine
|
++ wherePartMultiLine
|
||||||
|
)
|
||||||
| [(guards, body, _bodyRaw)] <- [clauseDocs]
|
| [(guards, body, _bodyRaw)] <- [clauseDocs]
|
||||||
, let guardPart = singleLineGuardsDoc guards
|
, let guardPart = singleLineGuardsDoc guards
|
||||||
]
|
]
|
||||||
++ -- pattern and exactly one clause in single line, body in new line.
|
++ -- pattern and exactly one clause in single line, body in new line.
|
||||||
[ docLines
|
[ ( 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]
|
| [(guards, body, _)] <- [clauseDocs]
|
||||||
, let guardPart = singleLineGuardsDoc guards
|
, let guardPart = singleLineGuardsDoc guards
|
||||||
]
|
]
|
||||||
++ -- multiple clauses added in-paragraph, each in a single line
|
++ -- multiple clauses added in-paragraph, each in a single line
|
||||||
-- example: foo | bar = baz
|
-- example: foo | bar = baz
|
||||||
-- | lll = asd
|
-- | lll = asd
|
||||||
[ docLines
|
[ ( indentPolicy /= IndentPolicyLeft
|
||||||
|
, docLines
|
||||||
$ [ docSeq
|
$ [ docSeq
|
||||||
[ appSep $ docForceSingleline $ return patDoc
|
[ appSep $ docForceSingleline $ return patDoc
|
||||||
, docSetBaseY
|
, docSetBaseY
|
||||||
|
@ -370,10 +386,12 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
++ wherePartMultiLine
|
++ wherePartMultiLine
|
||||||
|
)
|
||||||
| Just patDoc <- [mPatDoc]
|
| Just patDoc <- [mPatDoc]
|
||||||
]
|
]
|
||||||
++ -- multiple clauses, each in a separate, single line
|
++ -- multiple clauses, each in a separate, single line
|
||||||
[ docLines
|
[ ( True
|
||||||
|
, docLines
|
||||||
$ [ docAddBaseY BrIndentRegular
|
$ [ docAddBaseY BrIndentRegular
|
||||||
$ patPartParWrap
|
$ patPartParWrap
|
||||||
$ docLines
|
$ docLines
|
||||||
|
@ -396,10 +414,12 @@ 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
|
||||||
[ docLines
|
[ ( True
|
||||||
|
, docLines
|
||||||
$ [ docAddBaseY BrIndentRegular
|
$ [ docAddBaseY BrIndentRegular
|
||||||
$ patPartParWrap
|
$ patPartParWrap
|
||||||
$ docLines
|
$ docLines
|
||||||
|
@ -431,10 +451,12 @@ 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
|
||||||
[ docLines
|
[ ( True
|
||||||
|
, docLines
|
||||||
$ [ docAddBaseY BrIndentRegular
|
$ [ docAddBaseY BrIndentRegular
|
||||||
$ patPartParWrap
|
$ patPartParWrap
|
||||||
$ docLines
|
$ docLines
|
||||||
|
@ -464,9 +486,11 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
++ wherePartMultiLine
|
++ wherePartMultiLine
|
||||||
|
)
|
||||||
]
|
]
|
||||||
++ -- conservative approach: everything starts on the left.
|
++ -- conservative approach: everything starts on the left.
|
||||||
[ docLines
|
[ ( True
|
||||||
|
, docLines
|
||||||
$ [ docAddBaseY BrIndentRegular
|
$ [ docAddBaseY BrIndentRegular
|
||||||
$ patPartParWrap
|
$ patPartParWrap
|
||||||
$ docLines
|
$ docLines
|
||||||
|
@ -494,4 +518,5 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
++ wherePartMultiLine
|
++ wherePartMultiLine
|
||||||
|
)
|
||||||
]
|
]
|
||||||
|
|
|
@ -13,6 +13,7 @@ where
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Internal.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
import Language.Haskell.Brittany.Internal.LayouterBasics
|
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||||
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
|
|
||||||
import RdrName ( RdrName(..) )
|
import RdrName ( RdrName(..) )
|
||||||
import GHC ( runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..) )
|
import GHC ( runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..) )
|
||||||
|
@ -30,7 +31,13 @@ import Language.Haskell.Brittany.Internal.Layouters.Type
|
||||||
|
|
||||||
|
|
||||||
layoutExpr :: ToBriDoc HsExpr
|
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
|
HsVar vname -> do
|
||||||
docLit =<< lrdrNameToTextAnn vname
|
docLit =<< lrdrNameToTextAnn vname
|
||||||
HsUnboundVar var -> case var of
|
HsUnboundVar var -> case var of
|
||||||
|
@ -112,42 +119,50 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
|
||||||
let (headE, paramEs) = gather [exp2] exp1
|
let (headE, paramEs) = gather [exp2] exp1
|
||||||
headDoc <- docSharedWrapper layoutExpr headE
|
headDoc <- docSharedWrapper layoutExpr headE
|
||||||
paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs
|
paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs
|
||||||
docAlt
|
docAltFilter
|
||||||
[ -- foo x y
|
[ -- foo x y
|
||||||
docCols ColApp
|
( True
|
||||||
|
, docCols ColApp
|
||||||
$ appSep (docForceSingleline headDoc)
|
$ appSep (docForceSingleline headDoc)
|
||||||
: spacifyDocs (docForceSingleline <$> paramDocs)
|
: spacifyDocs (docForceSingleline <$> paramDocs)
|
||||||
|
)
|
||||||
, -- foo x
|
, -- foo x
|
||||||
-- y
|
-- y
|
||||||
docSeq
|
( allowFreeIndent
|
||||||
|
, 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
|
||||||
docSetParSpacing
|
( True
|
||||||
|
, 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
|
||||||
docAddBaseY BrIndentRegular
|
( True
|
||||||
|
, 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.
|
||||||
|
@ -400,6 +415,12 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
|
||||||
thenExprDoc <- docSharedWrapper layoutExpr thenExpr
|
thenExprDoc <- docSharedWrapper layoutExpr thenExpr
|
||||||
elseExprDoc <- docSharedWrapper layoutExpr elseExpr
|
elseExprDoc <- docSharedWrapper layoutExpr elseExpr
|
||||||
hasComments <- hasAnyCommentsBelow lexpr
|
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
|
docAltFilter
|
||||||
[ -- if _ then _ else _
|
[ -- if _ then _ else _
|
||||||
(,) (not hasComments)
|
(,) (not hasComments)
|
||||||
|
@ -428,8 +449,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
|
||||||
$ docSetParSpacing
|
$ docSetParSpacing
|
||||||
$ docAddBaseY BrIndentRegular
|
$ docAddBaseY BrIndentRegular
|
||||||
$ docPar
|
$ docPar
|
||||||
( docAddBaseY (BrIndentSpecial 3)
|
( docSeq
|
||||||
$ docSeq
|
|
||||||
[ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"
|
[ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"
|
||||||
, docNodeAnnKW lexpr (Just AnnIf) $ docForceSingleline ifExprDoc
|
, docNodeAnnKW lexpr (Just AnnIf) $ docForceSingleline ifExprDoc
|
||||||
])
|
])
|
||||||
|
@ -468,7 +488,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
|
||||||
(,) True
|
(,) True
|
||||||
$ docAddBaseY BrIndentRegular
|
$ docAddBaseY BrIndentRegular
|
||||||
$ docPar
|
$ docPar
|
||||||
( docAddBaseY (BrIndentSpecial 3)
|
( docAddBaseY maySpecialIndent
|
||||||
$ docSeq
|
$ docSeq
|
||||||
[ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"
|
[ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"
|
||||||
, docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc
|
, docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc
|
||||||
|
@ -491,7 +511,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
|
||||||
, (,) True
|
, (,) True
|
||||||
$ docSetBaseY
|
$ docSetBaseY
|
||||||
$ docLines
|
$ docLines
|
||||||
[ docAddBaseY (BrIndentSpecial 3)
|
[ docAddBaseY maySpecialIndent
|
||||||
$ docSeq
|
$ docSeq
|
||||||
[ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"
|
[ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"
|
||||||
, docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc
|
, 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
|
-- if "let" is moved horizontally as part of the transformation, as the
|
||||||
-- comments before the first let item are moved horizontally with it.
|
-- comments before the first let item are moved horizontally with it.
|
||||||
docSetIndentLevel $ case mBindDocs of
|
docSetIndentLevel $ case mBindDocs of
|
||||||
Just [bindDoc] -> docAlt
|
Just [bindDoc] -> docAltFilter
|
||||||
[ docSeq
|
[ ( True
|
||||||
|
, docSeq
|
||||||
[ appSep $ docLit $ Text.pack "let"
|
[ appSep $ docLit $ Text.pack "let"
|
||||||
, appSep $ docForceSingleline $ return bindDoc
|
, appSep $ docForceSingleline $ return bindDoc
|
||||||
, appSep $ docLit $ Text.pack "in"
|
, appSep $ docLit $ Text.pack "in"
|
||||||
, docForceSingleline $ expDoc1
|
, docForceSingleline $ expDoc1
|
||||||
]
|
]
|
||||||
|
)
|
||||||
|
, ( indentPolicy /= IndentPolicyLeft
|
||||||
, docLines
|
, docLines
|
||||||
[ docSeq
|
[ docSeq
|
||||||
[ appSep $ docLit $ Text.pack "let"
|
[ appSep $ docLit $ Text.pack "let"
|
||||||
|
@ -537,6 +560,8 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
|
||||||
, docSetBaseY $ expDoc1
|
, docSetBaseY $ expDoc1
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
)
|
||||||
|
, ( True
|
||||||
, docLines
|
, docLines
|
||||||
[ docAddBaseY BrIndentRegular
|
[ docAddBaseY BrIndentRegular
|
||||||
$ docPar
|
$ docPar
|
||||||
|
@ -547,9 +572,36 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
|
||||||
(appSep $ docLit $ Text.pack "in")
|
(appSep $ docLit $ Text.pack "in")
|
||||||
(docSetBaseY $ expDoc1)
|
(docSetBaseY $ expDoc1)
|
||||||
]
|
]
|
||||||
|
)
|
||||||
]
|
]
|
||||||
Just bindDocs@(_:_) -> docAlt
|
Just bindDocs@(_:_) -> docAltFilter
|
||||||
[ docLines
|
--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
|
[ docSeq
|
||||||
[ appSep $ docLit $ Text.pack "let"
|
[ appSep $ docLit $ Text.pack "let"
|
||||||
, docSetBaseAndIndent $ docLines $ return <$> bindDocs
|
, docSetBaseAndIndent $ docLines $ return <$> bindDocs
|
||||||
|
@ -559,6 +611,8 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
|
||||||
, docSetBaseY $ expDoc1
|
, docSetBaseY $ expDoc1
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
)
|
||||||
|
, ( True
|
||||||
, docLines
|
, docLines
|
||||||
[ docAddBaseY BrIndentRegular
|
[ docAddBaseY BrIndentRegular
|
||||||
$ docPar
|
$ docPar
|
||||||
|
@ -569,6 +623,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
|
||||||
(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]
|
||||||
|
@ -797,9 +852,10 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
|
||||||
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)
|
||||||
docAlt
|
docAltFilter
|
||||||
-- singleline
|
-- singleline
|
||||||
[ docSeq
|
[ ( True
|
||||||
|
, 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
|
||||||
|
@ -814,7 +870,9 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
|
||||||
docWrapNode lfield $ docLit fieldStr
|
docWrapNode lfield $ docLit fieldStr
|
||||||
, docLit $ Text.pack "}"
|
, docLit $ Text.pack "}"
|
||||||
]
|
]
|
||||||
|
)
|
||||||
-- wild-indentation block
|
-- wild-indentation block
|
||||||
|
, ( indentPolicy /= IndentPolicyLeft
|
||||||
, docSeq
|
, docSeq
|
||||||
[ docNodeAnnKW lexpr Nothing $ appSep rExprDoc
|
[ docNodeAnnKW lexpr Nothing $ appSep rExprDoc
|
||||||
, docSetBaseY $ docLines $ let
|
, docSetBaseY $ docLines $ let
|
||||||
|
@ -843,7 +901,9 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
|
||||||
]
|
]
|
||||||
in [line1] ++ lineR ++ [lineN]
|
in [line1] ++ lineR ++ [lineN]
|
||||||
]
|
]
|
||||||
|
)
|
||||||
-- strict indentation block
|
-- strict indentation block
|
||||||
|
, ( True
|
||||||
, docSetParSpacing
|
, docSetParSpacing
|
||||||
$ docAddBaseY BrIndentRegular
|
$ docAddBaseY BrIndentRegular
|
||||||
$ docPar
|
$ docPar
|
||||||
|
@ -872,6 +932,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
|
||||||
, docLit $ Text.pack "}"
|
, docLit $ Text.pack "}"
|
||||||
]
|
]
|
||||||
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
|
||||||
|
@ -903,7 +964,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
|
||||||
docSeq
|
docSeq
|
||||||
[ docLit $ Text.pack "["
|
[ docLit $ Text.pack "["
|
||||||
, docForceSingleline e1Doc
|
, docForceSingleline e1Doc
|
||||||
, docCommaSep
|
, appSep $ docLit $ Text.pack ","
|
||||||
, appSep $ docForceSingleline e2Doc
|
, appSep $ docForceSingleline e2Doc
|
||||||
, docLit $ Text.pack "..]"
|
, docLit $ Text.pack "..]"
|
||||||
]
|
]
|
||||||
|
@ -924,7 +985,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
|
||||||
docSeq
|
docSeq
|
||||||
[ docLit $ Text.pack "["
|
[ docLit $ Text.pack "["
|
||||||
, docForceSingleline e1Doc
|
, docForceSingleline e1Doc
|
||||||
, docCommaSep
|
, appSep $ docLit $ Text.pack ","
|
||||||
, appSep $ docForceSingleline e2Doc
|
, appSep $ docForceSingleline e2Doc
|
||||||
, appSep $ docLit $ Text.pack ".."
|
, appSep $ docLit $ Text.pack ".."
|
||||||
, docForceSingleline eNDoc
|
, docForceSingleline eNDoc
|
||||||
|
|
|
@ -11,6 +11,7 @@ where
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Internal.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
import Language.Haskell.Brittany.Internal.LayouterBasics
|
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||||
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
|
|
||||||
import RdrName ( RdrName(..) )
|
import RdrName ( RdrName(..) )
|
||||||
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
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 :: 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
|
LastStmt body False _ -> do
|
||||||
layoutExpr body
|
layoutExpr body
|
||||||
BindStmt lPat expr _ _ _ -> do
|
BindStmt lPat expr _ _ _ -> do
|
||||||
|
@ -52,30 +55,62 @@ layoutStmt lstmt@(L _ stmt) = docWrapNode lstmt $ case stmt of
|
||||||
-- heh.
|
-- heh.
|
||||||
Just [] -> docLit $ Text.pack "let" -- this probably never happens
|
Just [] -> docLit $ Text.pack "let" -- this probably never happens
|
||||||
Just [bindDoc] -> docAlt
|
Just [bindDoc] -> docAlt
|
||||||
[ docCols
|
[ -- let bind = expr
|
||||||
|
docCols
|
||||||
ColDoLet
|
ColDoLet
|
||||||
[ appSep $ docLit $ Text.pack "let"
|
[ appSep $ docLit $ Text.pack "let"
|
||||||
, docSetBaseAndIndent $ return bindDoc
|
, ( if indentPolicy == IndentPolicyLeft
|
||||||
|
then docForceSingleline
|
||||||
|
else docSetBaseAndIndent
|
||||||
|
)
|
||||||
|
$ return bindDoc
|
||||||
]
|
]
|
||||||
, docAddBaseY BrIndentRegular
|
, -- let
|
||||||
$ docPar (docLit $ Text.pack "let")
|
-- bind = expr
|
||||||
|
docAddBaseY BrIndentRegular $ docPar
|
||||||
|
(docLit $ Text.pack "let")
|
||||||
(docSetBaseAndIndent $ return bindDoc)
|
(docSetBaseAndIndent $ return bindDoc)
|
||||||
]
|
]
|
||||||
Just bindDocs -> docAlt
|
Just bindDocs -> docAltFilter
|
||||||
[ docSeq
|
[ -- let aaa = expra
|
||||||
|
-- bbb = exprb
|
||||||
|
-- ccc = exprc
|
||||||
|
( indentPolicy /= IndentPolicyLeft
|
||||||
|
, docSeq
|
||||||
[ appSep $ docLit $ Text.pack "let"
|
[ appSep $ docLit $ Text.pack "let"
|
||||||
, docSetBaseAndIndent $ docLines $ return <$> bindDocs
|
, docSetBaseAndIndent $ docLines $ return <$> bindDocs
|
||||||
]
|
]
|
||||||
|
)
|
||||||
|
, -- let
|
||||||
|
-- aaa = expra
|
||||||
|
-- bbb = exprb
|
||||||
|
-- ccc = exprc
|
||||||
|
( True
|
||||||
, docAddBaseY BrIndentRegular $ docPar
|
, docAddBaseY BrIndentRegular $ docPar
|
||||||
(docLit $ Text.pack "let")
|
(docLit $ Text.pack "let")
|
||||||
(docSetBaseAndIndent $ docLines $ return <$> bindDocs)
|
(docSetBaseAndIndent $ docLines $ return <$> bindDocs)
|
||||||
|
)
|
||||||
]
|
]
|
||||||
RecStmt stmts _ _ _ _ _ _ _ _ _ -> do
|
RecStmt stmts _ _ _ _ _ _ _ _ _ -> docAltFilter
|
||||||
docSeq
|
[ -- rec stmt1
|
||||||
|
-- stmt2
|
||||||
|
-- stmt3
|
||||||
|
( indentPolicy /= IndentPolicyLeft
|
||||||
|
, docSeq
|
||||||
[ docLit (Text.pack "rec")
|
[ docLit (Text.pack "rec")
|
||||||
, docSeparator
|
, docSeparator
|
||||||
, docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts
|
, docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts
|
||||||
]
|
]
|
||||||
|
)
|
||||||
|
, -- rec
|
||||||
|
-- stmt1
|
||||||
|
-- stmt2
|
||||||
|
-- stmt3
|
||||||
|
( True
|
||||||
|
, docAddBaseY BrIndentRegular
|
||||||
|
$ 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
|
||||||
|
|
Loading…
Reference in New Issue