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

Merge branch 'where-newlines'

remotes/felixonmars/ghc-8.6
Lennart Spitzner 2018-11-04 19:23:50 +01:00
parent 268cd333f3 2eb22e730f
commit 9d915232c0
8 changed files with 125 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1106,3 +1106,38 @@ instance MyClass Int where
-- ^ Interesting field
, intData2 :: Int
}
###############################################################################
###############################################################################
###############################################################################
#group whitespace-newlines
###############################################################################
###############################################################################
###############################################################################
#test module-import-newlines
module Main where
import Prelude
firstDecl = True
#test function-where-newlines
func = do
-- complex first step
aaa
-- complex second step
bbb
where
helper :: Helper
helper = helpful
other :: Other
other = True

17
src/Language/Haskell/Brittany/Internal/Backend.hs
View File

@ -235,7 +235,10 @@ layoutBriDocM = \case
{ _lstate_comments = Map.adjust
( \ann -> ann { ExactPrint.annFollowingComments = []
, ExactPrint.annPriorComments = []
, ExactPrint.annsDP = []
, ExactPrint.annsDP =
flip filter (ExactPrint.annsDP ann) $ \case
(ExactPrint.Types.AnnComment{}, _) -> False
_ -> True
}
)
annKey
@ -259,7 +262,7 @@ layoutBriDocM = \case
-- layoutMoveToIndentCol y
layoutWriteAppendMultiline $ Text.pack $ comment
-- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 }
BDMoveToKWDP annKey keyword bd -> do
BDMoveToKWDP annKey keyword shouldRestoreIndent bd -> do
mDP <- do
state <- mGet
let m = _lstate_comments state
@ -269,12 +272,14 @@ layoutBriDocM = \case
, (ExactPrint.Types.G kw1, dp) <- ann
, keyword == kw1
]
-- mTell $ Seq.fromList ["KWDP: " ++ show annKey ++ " " ++ show mAnn]
pure $ case relevant of
[] -> Nothing
(dp:_) -> Just dp
case mDP of
Nothing -> pure ()
Just (ExactPrint.Types.DP (y, x)) -> layoutMoveToCommentPos y x
Nothing -> pure ()
Just (ExactPrint.Types.DP (y, x)) ->
layoutMoveToCommentPos y (if shouldRestoreIndent then x else 0)
layoutBriDocM bd
BDNonBottomSpacing bd -> layoutBriDocM bd
BDSetParSpacing bd -> layoutBriDocM bd
@ -308,7 +313,7 @@ briDocLineLength briDoc = flip StateS.evalState False $ rec briDoc
BDAnnotationPrior _ bd -> rec bd
BDAnnotationKW _ _ bd -> rec bd
BDAnnotationRest _ bd -> rec bd
BDMoveToKWDP _ _ bd -> rec bd
BDMoveToKWDP _ _ _ bd -> rec bd
BDLines ls@(_:_) -> do
x <- StateS.get
return $ maximum $ ls <&> \l -> StateS.evalState (rec l) x
@ -344,7 +349,7 @@ briDocIsMultiLine briDoc = rec briDoc
BDAnnotationPrior _ bd -> rec bd
BDAnnotationKW _ _ bd -> rec bd
BDAnnotationRest _ bd -> rec bd
BDMoveToKWDP _ _ bd -> rec bd
BDMoveToKWDP _ _ _ bd -> rec bd
BDLines (_:_:_) -> True
BDLines [_ ] -> False
BDLines [] -> error "briDocIsMultiLine BDLines []"

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

@ -527,9 +527,11 @@ docAnnotationKW annKey kw bdm = allocateNode . BDFAnnotationKW annKey kw =<< bdm
docMoveToKWDP
:: AnnKey
-> AnnKeywordId
-> Bool
-> ToBriDocM BriDocNumbered
-> ToBriDocM BriDocNumbered
docMoveToKWDP annKey kw bdm = allocateNode . BDFMoveToKWDP annKey kw =<< bdm
docMoveToKWDP annKey kw shouldRestoreIndent bdm =
allocateNode . BDFMoveToKWDP annKey kw shouldRestoreIndent =<< bdm
docAnnotationRest
:: AnnKey -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
@ -597,10 +599,11 @@ docNodeMoveToKWDP
:: Data.Data.Data ast
=> Located ast
-> AnnKeywordId
-> Bool
-> ToBriDocM BriDocNumbered
-> ToBriDocM BriDocNumbered
docNodeMoveToKWDP ast kw bdm =
docMoveToKWDP (ExactPrint.Types.mkAnnKey ast) kw bdm
docNodeMoveToKWDP ast kw shouldRestoreIndent bdm =
docMoveToKWDP (ExactPrint.Types.mkAnnKey ast) kw shouldRestoreIndent bdm
class DocWrapable a where
docWrapNode :: ( Data.Data.Data ast)

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

@ -26,11 +26,11 @@ import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
import Language.Haskell.Brittany.Internal.ExactPrintUtils
import Language.Haskell.Brittany.Internal.Utils
import GHC ( runGhc
, GenLocated(L)
, moduleNameString
, AnnKeywordId (..)
)
import GHC ( runGhc
, GenLocated(L)
, moduleNameString
, AnnKeywordId(..)
)
import SrcLoc ( SrcSpan, noSrcSpan, Located , getLoc, unLoc )
import HsSyn
import Name
@ -204,13 +204,14 @@ layoutBind lbind@(L _ bind) = case bind of
patDocs <- colsWrapPat =<< layoutPat pat
clauseDocs <- layoutGrhs `mapM` grhss
mWhereDocs <- layoutLocalBinds whereBinds
let mWhereArg = mWhereDocs <&> \d -> (mkAnnKey lbind, d) -- TODO: is this the right AnnKey?
binderDoc <- docLit $ Text.pack "="
hasComments <- hasAnyCommentsBelow lbind
fmap Right $ docWrapNode lbind $ layoutPatternBindFinal Nothing
binderDoc
(Just patDocs)
clauseDocs
mWhereDocs
mWhereArg
hasComments
_ -> Right <$> unknownNodeError "" lbind
@ -282,13 +283,14 @@ layoutPatternBind mIdStr binderDoc lmatch@(L _ match) = do
$ (List.intersperse docSeparator $ docForceSingleline <$> ps)
clauseDocs <- docWrapNodeRest lmatch $ layoutGrhs `mapM` grhss
mWhereDocs <- layoutLocalBinds whereBinds
let mWhereArg = mWhereDocs <&> \d -> (mkAnnKey lmatch, d)
let alignmentToken = if null pats then Nothing else mIdStr
hasComments <- hasAnyCommentsBelow lmatch
layoutPatternBindFinal alignmentToken
binderDoc
(Just patDoc)
clauseDocs
mWhereDocs
mWhereArg
hasComments
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 && ghc-8.4 */
@ -319,7 +321,8 @@ layoutPatternBindFinal
-> BriDocNumbered
-> Maybe BriDocNumbered
-> [([BriDocNumbered], BriDocNumbered, LHsExpr GhcPs)]
-> Maybe [BriDocNumbered]
-> Maybe (ExactPrint.AnnKey, [BriDocNumbered])
-- ^ AnnKey for the node that contains the AnnWhere position annotation
-> Bool
-> ToBriDocM BriDocNumbered
layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs hasComments = do
@ -345,30 +348,36 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
-- be shared between alternatives.
wherePartMultiLine :: [ToBriDocM BriDocNumbered] <- case mWhereDocs of
Nothing -> return $ []
Just [w] -> fmap (pure . pure) $ docAlt
Just (annKeyWhere, [w]) -> fmap (pure . pure) $ docAlt
[ docEnsureIndent BrIndentRegular
$ docSeq
[ docLit $ Text.pack "where"
, docSeparator
, docForceSingleline $ return w
]
, docEnsureIndent whereIndent $ docLines
[ docLit $ Text.pack "where"
, docEnsureIndent whereIndent
$ docSetIndentLevel
$ docNonBottomSpacing
$ return w
]
]
Just ws -> fmap (pure . pure) $ docEnsureIndent whereIndent $ docLines
[ docLit $ Text.pack "where"
, docEnsureIndent whereIndent
$ docSetIndentLevel
$ docNonBottomSpacing
$ docLines
$ return
<$> ws
, docMoveToKWDP annKeyWhere AnnWhere False
$ docEnsureIndent whereIndent
$ docLines
[ docLit $ Text.pack "where"
, docEnsureIndent whereIndent
$ docSetIndentLevel
$ docNonBottomSpacing
$ return w
]
]
Just (annKeyWhere, ws) ->
fmap (pure . pure)
$ docMoveToKWDP annKeyWhere AnnWhere False
$ docEnsureIndent whereIndent
$ docLines
[ docLit $ Text.pack "where"
, docEnsureIndent whereIndent
$ docSetIndentLevel
$ docNonBottomSpacing
$ docLines
$ return
<$> ws
]
let singleLineGuardsDoc guards = appSep $ case guards of
[] -> docEmpty
[g] -> docSeq
@ -380,7 +389,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
)
wherePart = case mWhereDocs of
Nothing -> Just docEmpty
Just [w] -> Just $ docSeq
Just (_, [w]) -> Just $ docSeq
[ docSeparator
, appSep $ docLit $ Text.pack "where"
, docSetIndentLevel $ docForceSingleline $ return w

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

@ -111,7 +111,8 @@ layoutExpr lexpr@(L _ expr) = do
HsLamCase _ (MG lmatches@(L _ matches) _ _ _) -> do
#endif
binderDoc <- docLit $ Text.pack "->"
funcPatDocs <- docWrapNode lmatches $ layoutPatternBind Nothing binderDoc `mapM` matches
funcPatDocs <- docWrapNode lmatches
$ layoutPatternBind Nothing binderDoc `mapM` matches
docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
(docLit $ Text.pack "\\case")
(docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs)
@ -410,7 +411,8 @@ layoutExpr lexpr@(L _ expr) = do
HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do
cExpDoc <- docSharedWrapper layoutExpr cExp
binderDoc <- docLit $ Text.pack "->"
funcPatDocs <- docWrapNode lmatches $ layoutPatternBind Nothing binderDoc `mapM` matches
funcPatDocs <- docWrapNode lmatches
$ layoutPatternBind Nothing binderDoc `mapM` matches
docAlt
[ docSetParSpacing
$ docAddBaseY BrIndentRegular

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

@ -40,7 +40,7 @@ layoutModule lmod@(L _ mod') = case mod' of
[ docNodeAnnKW lmod Nothing docEmpty
-- A pseudo node that serves merely to force documentation
-- before the node
, docNodeMoveToKWDP lmod AnnModule $ runFilteredAlternative $ do
, docNodeMoveToKWDP lmod AnnModule True $ runFilteredAlternative $ do
addAlternativeCond allowSingleLine $
docForceSingleline
$ docSeq

8
src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs
View File

@ -296,8 +296,8 @@ transformAlts =
reWrap . BDFAnnotationRest annKey <$> rec bd
BDFAnnotationKW annKey kw bd ->
reWrap . BDFAnnotationKW annKey kw <$> rec bd
BDFMoveToKWDP annKey kw bd ->
reWrap . BDFMoveToKWDP annKey kw <$> rec bd
BDFMoveToKWDP annKey kw b bd ->
reWrap . BDFMoveToKWDP annKey kw b <$> rec bd
BDFLines [] -> return $ reWrap BDFEmpty -- evil transformation. or harmless.
BDFLines (l:lr) -> do
ind <- _acp_indent <$> mGet
@ -457,7 +457,7 @@ getSpacing !bridoc = rec bridoc
BDFAnnotationPrior _annKey bd -> rec bd
BDFAnnotationKW _annKey _kw bd -> rec bd
BDFAnnotationRest _annKey bd -> rec bd
BDFMoveToKWDP _annKey _kw bd -> rec bd
BDFMoveToKWDP _annKey _kw _b bd -> rec bd
BDFLines [] -> return
$ LineModeValid
$ VerticalSpacing 0 VerticalSpacingParNone False
@ -730,7 +730,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
BDFAnnotationPrior _annKey bd -> rec bd
BDFAnnotationKW _annKey _kw bd -> rec bd
BDFAnnotationRest _annKey bd -> rec bd
BDFMoveToKWDP _annKey _kw bd -> rec bd
BDFMoveToKWDP _annKey _kw _b bd -> rec bd
BDFLines [] -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]
BDFLines ls@(_:_) -> do
-- we simply assume that lines is only used "properly", i.e. in

58
src/Language/Haskell/Brittany/Internal/Types.hs
View File

@ -246,7 +246,7 @@ data BriDoc
| BDAnnotationPrior AnnKey BriDoc
| BDAnnotationKW AnnKey (Maybe AnnKeywordId) BriDoc
| BDAnnotationRest AnnKey BriDoc
| BDMoveToKWDP AnnKey AnnKeywordId BriDoc
| BDMoveToKWDP AnnKey AnnKeywordId Bool BriDoc -- True if should respect x offset
| BDLines [BriDoc]
| BDEnsureIndent BrIndent BriDoc
-- the following constructors are only relevant for the alt transformation
@ -292,7 +292,7 @@ data BriDocF f
| BDFAnnotationPrior AnnKey (f (BriDocF f))
| BDFAnnotationKW AnnKey (Maybe AnnKeywordId) (f (BriDocF f))
| BDFAnnotationRest AnnKey (f (BriDocF f))
| BDFMoveToKWDP AnnKey AnnKeywordId (f (BriDocF f))
| BDFMoveToKWDP AnnKey AnnKeywordId Bool (f (BriDocF f)) -- True if should respect x offset
| BDFLines [(f (BriDocF f))]
| BDFEnsureIndent BrIndent (f (BriDocF f))
| BDFForceMultiline (f (BriDocF f))
@ -326,7 +326,7 @@ instance Uniplate.Uniplate BriDoc where
uniplate (BDAnnotationPrior annKey bd) = plate BDAnnotationPrior |- annKey |* bd
uniplate (BDAnnotationKW annKey kw bd) = plate BDAnnotationKW |- annKey |- kw |* bd
uniplate (BDAnnotationRest annKey bd) = plate BDAnnotationRest |- annKey |* bd
uniplate (BDMoveToKWDP annKey kw bd) = plate BDMoveToKWDP |- annKey |- kw |* bd
uniplate (BDMoveToKWDP annKey kw b bd) = plate BDMoveToKWDP |- annKey |- kw |- b |* bd
uniplate (BDLines lines) = plate BDLines ||* lines
uniplate (BDEnsureIndent ind bd) = plate BDEnsureIndent |- ind |* bd
uniplate (BDForceMultiline bd) = plate BDForceMultiline |* bd
@ -358,7 +358,7 @@ unwrapBriDocNumbered tpl = case snd tpl of
BDFAnnotationPrior annKey bd -> BDAnnotationPrior annKey $ rec bd
BDFAnnotationKW annKey kw bd -> BDAnnotationKW annKey kw $ rec bd
BDFAnnotationRest annKey bd -> BDAnnotationRest annKey $ rec bd
BDFMoveToKWDP annKey kw bd -> BDMoveToKWDP annKey kw $ rec bd
BDFMoveToKWDP annKey kw b bd -> BDMoveToKWDP annKey kw b $ rec bd
BDFLines lines -> BDLines $ rec <$> lines
BDFEnsureIndent ind bd -> BDEnsureIndent ind $ rec bd
BDFForceMultiline bd -> BDForceMultiline $ rec bd
@ -377,32 +377,32 @@ isNotEmpty _ = True
-- this might not work. is not used anywhere either.
briDocSeqSpine :: BriDoc -> ()
briDocSeqSpine = \case
BDEmpty -> ()
BDLit _t -> ()
BDSeq list -> foldl' ((briDocSeqSpine.) . seq) () list
BDCols _sig list -> foldl' ((briDocSeqSpine.) . seq) () list
BDSeparator -> ()
BDAddBaseY _ind bd -> briDocSeqSpine bd
BDBaseYPushCur bd -> briDocSeqSpine bd
BDBaseYPop bd -> briDocSeqSpine bd
BDIndentLevelPushCur bd -> briDocSeqSpine bd
BDIndentLevelPop bd -> briDocSeqSpine bd
BDEmpty -> ()
BDLit _t -> ()
BDSeq list -> foldl' ((briDocSeqSpine .) . seq) () list
BDCols _sig list -> foldl' ((briDocSeqSpine .) . seq) () list
BDSeparator -> ()
BDAddBaseY _ind bd -> briDocSeqSpine bd
BDBaseYPushCur bd -> briDocSeqSpine bd
BDBaseYPop bd -> briDocSeqSpine bd
BDIndentLevelPushCur bd -> briDocSeqSpine bd
BDIndentLevelPop bd -> briDocSeqSpine bd
BDPar _ind line indented -> briDocSeqSpine line `seq` briDocSeqSpine indented
BDAlt alts -> foldl' (\(!()) -> briDocSeqSpine) () alts
BDForwardLineMode bd -> briDocSeqSpine bd
BDExternal{} -> ()
BDAnnotationPrior _annKey bd -> briDocSeqSpine bd
BDAnnotationKW _annKey _kw bd -> briDocSeqSpine bd
BDAnnotationRest _annKey bd -> briDocSeqSpine bd
BDMoveToKWDP _annKey _kw bd -> briDocSeqSpine bd
BDLines lines -> foldl' (\(!()) -> briDocSeqSpine) () lines
BDEnsureIndent _ind bd -> briDocSeqSpine bd
BDForceMultiline bd -> briDocSeqSpine bd
BDForceSingleline bd -> briDocSeqSpine bd
BDNonBottomSpacing bd -> briDocSeqSpine bd
BDSetParSpacing bd -> briDocSeqSpine bd
BDForceParSpacing bd -> briDocSeqSpine bd
BDDebug _s bd -> briDocSeqSpine bd
BDAlt alts -> foldl' (\(!()) -> briDocSeqSpine) () alts
BDForwardLineMode bd -> briDocSeqSpine bd
BDExternal{} -> ()
BDAnnotationPrior _annKey bd -> briDocSeqSpine bd
BDAnnotationKW _annKey _kw bd -> briDocSeqSpine bd
BDAnnotationRest _annKey bd -> briDocSeqSpine bd
BDMoveToKWDP _annKey _kw _b bd -> briDocSeqSpine bd
BDLines lines -> foldl' (\(!()) -> briDocSeqSpine) () lines
BDEnsureIndent _ind bd -> briDocSeqSpine bd
BDForceMultiline bd -> briDocSeqSpine bd
BDForceSingleline bd -> briDocSeqSpine bd
BDNonBottomSpacing bd -> briDocSeqSpine bd
BDSetParSpacing bd -> briDocSeqSpine bd
BDForceParSpacing bd -> briDocSeqSpine bd
BDDebug _s bd -> briDocSeqSpine bd
briDocForceSpine :: BriDoc -> BriDoc
briDocForceSpine bd = briDocSeqSpine bd `seq` bd