Partially restore retaining-empty-lines behaviour
Currently works for do blocks, multi-line list literals, and lambda-case cases (apart from top-level blank lines that never got ignored).ghc92
parent
05270ecb45
commit
f13a82964a
|
@ -116,7 +116,8 @@ func = do
|
||||||
let (primaryPkg, otherPkgs) = selectPrimaryLocalPackage pwd pkgs'
|
let (primaryPkg, otherPkgs) = selectPrimaryLocalPackage pwd pkgs'
|
||||||
(bproblems, x) = resolveBuildTargets primaryPkg otherPkgs utargets''
|
(bproblems, x) = resolveBuildTargets primaryPkg otherPkgs utargets''
|
||||||
-- default local dir target if there's no given target
|
-- default local dir target if there's no given target
|
||||||
utargets'' = "foo"
|
utargets'' = "foo"
|
||||||
|
asd = True
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
#test list comprehension comment placement
|
#test list comprehension comment placement
|
||||||
|
|
|
@ -69,9 +69,11 @@ data BriDocW (w :: IsWrapped)
|
||||||
-- queue to be later flushed when the markers are reached
|
-- queue to be later flushed when the markers are reached
|
||||||
| BDFlushCommentsPrior RealSrcLoc (BriDocRec w)
|
| BDFlushCommentsPrior RealSrcLoc (BriDocRec w)
|
||||||
-- process comments before loc from the queue
|
-- process comments before loc from the queue
|
||||||
| BDFlushCommentsPost RealSrcLoc (BriDocRec w)
|
| BDFlushCommentsPost RealSrcLoc Bool (BriDocRec w)
|
||||||
-- process comments before loc from the queue, but flow to end of
|
-- process comments before loc from the queue, but flow to end of
|
||||||
-- child-nodes
|
-- child-nodes. The boolean determines whether we set this location for
|
||||||
|
-- purposes of multiple-line DP calculations. This determines whether
|
||||||
|
-- empty lines after this element will be retained in the output.
|
||||||
| BDEntryDelta DeltaPos (BriDocRec w)
|
| BDEntryDelta DeltaPos (BriDocRec w)
|
||||||
-- Move to the specified delta position before rendering the inner
|
-- Move to the specified delta position before rendering the inner
|
||||||
-- element. Currently this only ever respects newlines, i.e. Sameline
|
-- element. Currently this only ever respects newlines, i.e. Sameline
|
||||||
|
@ -124,8 +126,8 @@ instance Uniplate.Uniplate BriDoc where
|
||||||
plate BDQueueComments |- comms |* bd
|
plate BDQueueComments |- comms |* bd
|
||||||
uniplate (BDFlushCommentsPrior loc bd) =
|
uniplate (BDFlushCommentsPrior loc bd) =
|
||||||
plate BDFlushCommentsPrior |- loc |* bd
|
plate BDFlushCommentsPrior |- loc |* bd
|
||||||
uniplate (BDFlushCommentsPost loc bd) =
|
uniplate (BDFlushCommentsPost loc shouldMark bd) =
|
||||||
plate BDFlushCommentsPost |- loc |* bd
|
plate BDFlushCommentsPost |- loc |- shouldMark |* bd
|
||||||
uniplate (BDEntryDelta dp bd ) = plate BDEntryDelta |- dp |* bd
|
uniplate (BDEntryDelta dp bd ) = plate BDEntryDelta |- dp |* bd
|
||||||
uniplate (BDLines lines ) = plate BDLines ||* lines
|
uniplate (BDLines lines ) = plate BDLines ||* lines
|
||||||
uniplate (BDEnsureIndent ind bd ) = plate BDEnsureIndent |- ind |* bd
|
uniplate (BDEnsureIndent ind bd ) = plate BDEnsureIndent |- ind |* bd
|
||||||
|
@ -155,7 +157,7 @@ briDocSeqSpine = \case
|
||||||
BDPlain{} -> ()
|
BDPlain{} -> ()
|
||||||
BDQueueComments _comms bd -> briDocSeqSpine bd
|
BDQueueComments _comms bd -> briDocSeqSpine bd
|
||||||
BDFlushCommentsPrior _loc bd -> briDocSeqSpine bd
|
BDFlushCommentsPrior _loc bd -> briDocSeqSpine bd
|
||||||
BDFlushCommentsPost _loc bd -> briDocSeqSpine bd
|
BDFlushCommentsPost _loc _m bd -> briDocSeqSpine bd
|
||||||
BDEntryDelta _dp bd -> briDocSeqSpine bd
|
BDEntryDelta _dp bd -> briDocSeqSpine bd
|
||||||
BDLines lines -> foldl' (\() -> briDocSeqSpine) () lines
|
BDLines lines -> foldl' (\() -> briDocSeqSpine) () lines
|
||||||
BDEnsureIndent _ind bd -> briDocSeqSpine bd
|
BDEnsureIndent _ind bd -> briDocSeqSpine bd
|
||||||
|
@ -176,31 +178,31 @@ isNotEmpty _ = True
|
||||||
-- TODO: rename to "dropLabels" ?
|
-- TODO: rename to "dropLabels" ?
|
||||||
unwrapBriDocNumbered :: BriDocNumbered -> BriDoc
|
unwrapBriDocNumbered :: BriDocNumbered -> BriDoc
|
||||||
unwrapBriDocNumbered tpl = case snd tpl of
|
unwrapBriDocNumbered tpl = case snd tpl of
|
||||||
BDEmpty -> BDEmpty
|
BDEmpty -> BDEmpty
|
||||||
BDLit t -> BDLit t
|
BDLit t -> BDLit t
|
||||||
BDSeq list -> BDSeq $ rec <$> list
|
BDSeq list -> BDSeq $ rec <$> list
|
||||||
BDCols sig list -> BDCols sig $ rec <$> list
|
BDCols sig list -> BDCols sig $ rec <$> list
|
||||||
BDSeparator -> BDSeparator
|
BDSeparator -> BDSeparator
|
||||||
BDAddBaseY ind bd -> BDAddBaseY ind $ rec bd
|
BDAddBaseY ind bd -> BDAddBaseY ind $ rec bd
|
||||||
BDBaseYPushCur bd -> BDBaseYPushCur $ rec bd
|
BDBaseYPushCur bd -> BDBaseYPushCur $ rec bd
|
||||||
BDIndentLevelPushCur bd -> BDIndentLevelPushCur $ rec bd
|
BDIndentLevelPushCur bd -> BDIndentLevelPushCur $ rec bd
|
||||||
BDIndentLevelPop bd -> BDIndentLevelPop $ rec bd
|
BDIndentLevelPop bd -> BDIndentLevelPop $ rec bd
|
||||||
BDPar ind line indented -> BDPar ind (rec line) (rec indented)
|
BDPar ind line indented -> BDPar ind (rec line) (rec indented)
|
||||||
BDAlt alts -> BDAlt $ rec <$> alts -- not that this will happen
|
BDAlt alts -> BDAlt $ rec <$> alts -- not that this will happen
|
||||||
BDForwardLineMode bd -> BDForwardLineMode $ rec bd
|
BDForwardLineMode bd -> BDForwardLineMode $ rec bd
|
||||||
BDExternal c t -> BDExternal c t
|
BDExternal c t -> BDExternal c t
|
||||||
BDPlain t -> BDPlain t
|
BDPlain t -> BDPlain t
|
||||||
BDQueueComments comms bd -> BDQueueComments comms $ rec bd
|
BDQueueComments comms bd -> BDQueueComments comms $ rec bd
|
||||||
BDFlushCommentsPrior loc bd -> BDFlushCommentsPrior loc $ rec bd
|
BDFlushCommentsPrior loc bd -> BDFlushCommentsPrior loc $ rec bd
|
||||||
BDFlushCommentsPost loc bd -> BDFlushCommentsPost loc $ rec bd
|
BDFlushCommentsPost loc mrk bd -> BDFlushCommentsPost loc mrk $ rec bd
|
||||||
BDEntryDelta dp bd -> BDEntryDelta dp $ rec bd
|
BDEntryDelta dp bd -> BDEntryDelta dp $ rec bd
|
||||||
BDLines lines -> BDLines $ rec <$> lines
|
BDLines lines -> BDLines $ rec <$> lines
|
||||||
BDEnsureIndent ind bd -> BDEnsureIndent ind $ rec bd
|
BDEnsureIndent ind bd -> BDEnsureIndent ind $ rec bd
|
||||||
BDForceMultiline bd -> BDForceMultiline $ rec bd
|
BDForceMultiline bd -> BDForceMultiline $ rec bd
|
||||||
BDForceSingleline bd -> BDForceSingleline $ rec bd
|
BDForceSingleline bd -> BDForceSingleline $ rec bd
|
||||||
BDNonBottomSpacing b bd -> BDNonBottomSpacing b $ rec bd
|
BDNonBottomSpacing b bd -> BDNonBottomSpacing b $ rec bd
|
||||||
BDSetParSpacing bd -> BDSetParSpacing $ rec bd
|
BDSetParSpacing bd -> BDSetParSpacing $ rec bd
|
||||||
BDForceParSpacing bd -> BDForceParSpacing $ rec bd
|
BDForceParSpacing bd -> BDForceParSpacing $ rec bd
|
||||||
BDDebug s bd -> BDDebug (s ++ "@" ++ show (fst tpl)) $ rec bd
|
BDDebug s bd -> BDDebug (s ++ "@" ++ show (fst tpl)) $ rec bd
|
||||||
where rec = unwrapBriDocNumbered
|
where rec = unwrapBriDocNumbered
|
||||||
|
|
||||||
|
|
|
@ -474,7 +474,7 @@ docAddEntryDelta dp bdm = do
|
||||||
allocateNode (BDEntryDelta dp bd)
|
allocateNode (BDEntryDelta dp bd)
|
||||||
|
|
||||||
docFlushRemaining :: FastString -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
docFlushRemaining :: FastString -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||||
docFlushRemaining fileThing = docFlushCommsPost
|
docFlushRemaining fileThing = docFlushCommsPost False
|
||||||
(Just $ GHC.mkRealSrcLoc fileThing 999999 999999)
|
(Just $ GHC.mkRealSrcLoc fileThing 999999 999999)
|
||||||
|
|
||||||
-- CLASS DocHandleComms --------------------------------------------------------
|
-- CLASS DocHandleComms --------------------------------------------------------
|
||||||
|
@ -671,28 +671,36 @@ instance ObtainAnnDeltaPos (EpAnn GHC.AnnsModule) where
|
||||||
)
|
)
|
||||||
pos
|
pos
|
||||||
|
|
||||||
class DocFlushCommsPost a where
|
class DocFlushCommsPost ann a where
|
||||||
docFlushCommsPost :: Maybe GHC.RealSrcLoc -> a -> a
|
docFlushCommsPost :: Bool -> ann -> a -> a
|
||||||
|
|
||||||
instance DocFlushCommsPost (ToBriDocM BriDocNumbered) where
|
instance DocFlushCommsPost (Maybe GHC.RealSrcLoc) (ToBriDocM BriDocNumbered) where
|
||||||
docFlushCommsPost = \case
|
docFlushCommsPost shouldMark = \case
|
||||||
Nothing -> id
|
Nothing -> id
|
||||||
Just span -> \bdm -> do
|
Just loc -> \bdm -> do
|
||||||
i1 <- allocNodeIndex
|
i1 <- allocNodeIndex
|
||||||
bd <- bdm
|
bd <- bdm
|
||||||
pure (i1, BDFlushCommentsPost span bd)
|
pure (i1, BDFlushCommentsPost loc shouldMark bd)
|
||||||
|
|
||||||
instance DocFlushCommsPost (ToBriDocM [BriDocNumbered]) where
|
instance DocFlushCommsPost ann (ToBriDocM BriDocNumbered)
|
||||||
docFlushCommsPost loc bdm = do
|
=> DocFlushCommsPost ann (ToBriDocM [BriDocNumbered]) where
|
||||||
|
docFlushCommsPost shouldMark loc bdm = do
|
||||||
bds <- bdm
|
bds <- bdm
|
||||||
case bds of
|
case bds of
|
||||||
[] -> do
|
[] -> do
|
||||||
e <- docFlushCommsPost loc docEmpty
|
e <- docFlushCommsPost shouldMark loc docEmpty
|
||||||
pure [e]
|
pure [e]
|
||||||
_ -> do
|
_ -> do
|
||||||
e <- docFlushCommsPost loc (pure $ List.last bds)
|
e <- docFlushCommsPost shouldMark loc (pure $ List.last bds)
|
||||||
pure (List.init bds ++ [e])
|
pure (List.init bds ++ [e])
|
||||||
|
|
||||||
|
instance DocFlushCommsPost (Maybe GHC.RealSrcLoc) a
|
||||||
|
=> DocFlushCommsPost (LocatedA ast) a where
|
||||||
|
docFlushCommsPost shouldMark (L ann _) =
|
||||||
|
docFlushCommsPost shouldMark $ case GHC.locA ann of
|
||||||
|
GHC.RealSrcSpan s _ -> Just $ GHC.realSrcSpanEnd s
|
||||||
|
GHC.UnhelpfulSpan{} -> Nothing
|
||||||
|
|
||||||
unknownNodeError
|
unknownNodeError
|
||||||
:: (Data a, Data (GHC.Anno a), Outputable (GHC.Anno a))
|
:: (Data a, Data (GHC.Anno a), Outputable (GHC.Anno a))
|
||||||
=> String
|
=> String
|
||||||
|
@ -737,7 +745,32 @@ docHandleListElemComms
|
||||||
-> ToBriDocM BriDocNumbered
|
-> ToBriDocM BriDocNumbered
|
||||||
docHandleListElemComms layouter e = case obtainListElemStartCommaLocs e of
|
docHandleListElemComms layouter e = case obtainListElemStartCommaLocs e of
|
||||||
(posStart, posComma) ->
|
(posStart, posComma) ->
|
||||||
docHandleComms posStart $ docFlushCommsPost posComma $ layouter e
|
docHandleComms posStart $ docFlushCommsPost True posComma $ layouter e
|
||||||
|
|
||||||
|
docHandleListElemCommsProperPost
|
||||||
|
:: (LocatedA ast -> ToBriDocM BriDocNumbered)
|
||||||
|
-> [LocatedA ast]
|
||||||
|
-> ToBriDocM [(Maybe GHC.RealSrcLoc, ToBriDocM BriDocNumbered)]
|
||||||
|
docHandleListElemCommsProperPost layouter es = case es of
|
||||||
|
[] -> pure []
|
||||||
|
(e1 : rest) -> case obtainListElemStartCommaLocs e1 of
|
||||||
|
(posStart, posComma) -> do
|
||||||
|
res <- go posComma rest
|
||||||
|
pure
|
||||||
|
$ ( Nothing
|
||||||
|
, docFlushCommsPost True e1 $ docHandleComms posStart $ layouter e1
|
||||||
|
)
|
||||||
|
: res
|
||||||
|
where
|
||||||
|
go _intoComma [] = pure []
|
||||||
|
go intoComma (e1 : rest) = case obtainListElemStartCommaLocs e1 of
|
||||||
|
(posStart, posComma) -> do
|
||||||
|
res <- go posComma rest
|
||||||
|
pure
|
||||||
|
$ ( intoComma
|
||||||
|
, docFlushCommsPost True e1 $ docHandleComms posStart $ layouter e1
|
||||||
|
)
|
||||||
|
: res
|
||||||
|
|
||||||
epaLocationRealSrcSpanStart :: GHC.EpaLocation -> GHC.RealSrcLoc
|
epaLocationRealSrcSpanStart :: GHC.EpaLocation -> GHC.RealSrcLoc
|
||||||
epaLocationRealSrcSpanStart = GHC.realSrcSpanStart . GHC.epaLocationRealSrcSpan
|
epaLocationRealSrcSpanStart = GHC.realSrcSpanStart . GHC.epaLocationRealSrcSpan
|
||||||
|
|
|
@ -31,6 +31,8 @@ import GHC ( Anchor(Anchor)
|
||||||
, LEpaComment
|
, LEpaComment
|
||||||
, RealSrcLoc
|
, RealSrcLoc
|
||||||
, DeltaPos(SameLine, DifferentLine)
|
, DeltaPos(SameLine, DifferentLine)
|
||||||
|
, srcLocLine
|
||||||
|
, srcLocCol
|
||||||
)
|
)
|
||||||
import GHC.Types.SrcLoc ( realSrcSpanEnd )
|
import GHC.Types.SrcLoc ( realSrcSpanEnd )
|
||||||
import qualified GHC.OldList as List
|
import qualified GHC.OldList as List
|
||||||
|
@ -101,6 +103,7 @@ ppBriDoc briDoc flush = do
|
||||||
, _lstate_indLevelLinger = 0
|
, _lstate_indLevelLinger = 0
|
||||||
, _lstate_plannedSpace = PlannedNone
|
, _lstate_plannedSpace = PlannedNone
|
||||||
, _lstate_commentNewlines = 0
|
, _lstate_commentNewlines = 0
|
||||||
|
, _lstate_markerForDelta = Nothing
|
||||||
}
|
}
|
||||||
state' <-
|
state' <-
|
||||||
MultiRWSS.withMultiStateS state
|
MultiRWSS.withMultiStateS state
|
||||||
|
@ -124,6 +127,7 @@ layoutBriDocM = \case
|
||||||
BDEmpty -> do
|
BDEmpty -> do
|
||||||
return () -- can it be that simple
|
return () -- can it be that simple
|
||||||
BDLit t -> do
|
BDLit t -> do
|
||||||
|
layoutSetMarker Nothing
|
||||||
layoutRemoveIndentLevelLinger
|
layoutRemoveIndentLevelLinger
|
||||||
layoutWriteAppend t
|
layoutWriteAppend t
|
||||||
BDSeq list -> do
|
BDSeq list -> do
|
||||||
|
@ -271,9 +275,25 @@ layoutBriDocM = \case
|
||||||
comms <- takeBefore loc
|
comms <- takeBefore loc
|
||||||
printComments comms
|
printComments comms
|
||||||
mModify (\s -> s + CommentCounter (length comms))
|
mModify (\s -> s + CommentCounter (length comms))
|
||||||
|
do
|
||||||
|
marker <- mGet <&> _lstate_markerForDelta
|
||||||
|
mModify $ \s -> s { _lstate_markerForDelta = Nothing }
|
||||||
|
case marker of
|
||||||
|
Nothing -> pure ()
|
||||||
|
Just m -> do
|
||||||
|
let p1 = (srcLocLine m, srcLocCol m)
|
||||||
|
let p2 = (srcLocLine loc, srcLocCol loc)
|
||||||
|
-- traceShow (ExactPrint.pos2delta p1 p2) $ pure ()
|
||||||
|
case ExactPrint.pos2delta p1 p2 of
|
||||||
|
SameLine{} -> pure ()
|
||||||
|
DifferentLine n _ -> layoutWriteNewlines n
|
||||||
layoutBriDocM bd
|
layoutBriDocM bd
|
||||||
BDFlushCommentsPost loc bd -> do
|
BDFlushCommentsPost loc shouldMark bd -> do
|
||||||
layoutBriDocM bd
|
layoutBriDocM bd
|
||||||
|
if shouldMark then
|
||||||
|
layoutSetMarker $ Just loc
|
||||||
|
else
|
||||||
|
layoutSetMarker Nothing
|
||||||
comms <- takeBefore loc
|
comms <- takeBefore loc
|
||||||
mModify (\s -> s + CommentCounter (length comms))
|
mModify (\s -> s + CommentCounter (length comms))
|
||||||
printComments comms
|
printComments comms
|
||||||
|
@ -305,20 +325,19 @@ printComments :: LayoutConstraints m => [GHC.LEpaComment] -> m ()
|
||||||
printComments comms = do
|
printComments comms = do
|
||||||
let addComment isBlock s anchor prior = do
|
let addComment isBlock s anchor prior = do
|
||||||
case anchor of
|
case anchor of
|
||||||
Anchor span UnchangedAnchor -> layoutWriteComment
|
Anchor span UnchangedAnchor -> do
|
||||||
True
|
let dp = ExactPrint.ss2deltaEnd prior span
|
||||||
isBlock
|
layoutWriteComment True isBlock dp 1 (Text.pack s)
|
||||||
(ExactPrint.ss2deltaEnd prior span)
|
layoutUpdateMarker $ realSrcSpanEnd span
|
||||||
1
|
Anchor span (MovedAnchor dp) -> do
|
||||||
(Text.pack s)
|
|
||||||
Anchor _span (MovedAnchor dp) ->
|
|
||||||
layoutWriteComment False isBlock dp 1 (Text.pack s)
|
layoutWriteComment False isBlock dp 1 (Text.pack s)
|
||||||
comms `forM_` \(L anch (EpaComment tok prior) ) -> case tok of
|
layoutUpdateMarker $ realSrcSpanEnd span
|
||||||
EpaDocCommentNext s -> addComment False s anch prior
|
comms `forM_` \(L anch (EpaComment tok prior)) -> case tok of
|
||||||
EpaDocCommentPrev s -> addComment False s anch prior
|
EpaDocCommentNext s -> addComment False s anch prior
|
||||||
|
EpaDocCommentPrev s -> addComment False s anch prior
|
||||||
EpaDocCommentNamed s -> addComment False s anch prior
|
EpaDocCommentNamed s -> addComment False s anch prior
|
||||||
EpaDocSection _ s -> addComment False s anch prior
|
EpaDocSection _ s -> addComment False s anch prior
|
||||||
EpaDocOptions s -> addComment False s anch prior
|
EpaDocOptions s -> addComment False s anch prior
|
||||||
EpaLineComment s -> addComment False s anch prior
|
EpaLineComment s -> addComment False s anch prior
|
||||||
EpaBlockComment s -> addComment True s anch prior
|
EpaBlockComment s -> addComment True s anch prior
|
||||||
EpaEofComment -> pure ()
|
EpaEofComment -> pure ()
|
||||||
|
|
|
@ -471,7 +471,7 @@ createNamesAndTypeDoc
|
||||||
:: LConDeclField GhcPs
|
:: LConDeclField GhcPs
|
||||||
-> (ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)
|
-> (ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)
|
||||||
createNamesAndTypeDoc lField@(L _ (ConDeclField epAnn names t _)) =
|
createNamesAndTypeDoc lField@(L _ (ConDeclField epAnn names t _)) =
|
||||||
( docFlushCommsPost posColon
|
( docFlushCommsPost False posColon
|
||||||
$ docHandleComms posStart
|
$ docHandleComms posStart
|
||||||
$ docHandleComms epAnn
|
$ docHandleComms epAnn
|
||||||
$ docSeq
|
$ docSeq
|
||||||
|
@ -479,7 +479,7 @@ createNamesAndTypeDoc lField@(L _ (ConDeclField epAnn names t _)) =
|
||||||
L _ (FieldOcc _ fieldName) ->
|
L _ (FieldOcc _ fieldName) ->
|
||||||
docLit =<< lrdrNameToTextAnn fieldName
|
docLit =<< lrdrNameToTextAnn fieldName
|
||||||
]
|
]
|
||||||
, docFlushCommsPost posComma (layoutType t)
|
, docFlushCommsPost True posComma (layoutType t)
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
(posStart, posComma) = obtainListElemStartCommaLocs lField
|
(posStart, posComma) = obtainListElemStartCommaLocs lField
|
||||||
|
|
|
@ -18,6 +18,7 @@ import qualified GHC.OldList as List
|
||||||
import GHC.Types.Basic
|
import GHC.Types.Basic
|
||||||
(Activation(..), InlinePragma(..), InlineSpec(..), RuleMatchInfo(..))
|
(Activation(..), InlinePragma(..), InlineSpec(..), RuleMatchInfo(..))
|
||||||
import GHC.Types.SrcLoc (Located, getLoc, unLoc)
|
import GHC.Types.SrcLoc (Located, getLoc, unLoc)
|
||||||
|
import qualified GHC
|
||||||
import qualified GHC.Types.SrcLoc as GHC
|
import qualified GHC.Types.SrcLoc as GHC
|
||||||
import Language.Haskell.Brittany.Internal.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
import Language.Haskell.Brittany.Internal.S3_ToBriDocTools
|
import Language.Haskell.Brittany.Internal.S3_ToBriDocTools
|
||||||
|
@ -240,7 +241,7 @@ layoutGrhs (L _ (GRHS epAnn guards body)) = do
|
||||||
let posArrow = obtainAnnPos epAnn AnnRarrow
|
let posArrow = obtainAnnPos epAnn AnnRarrow
|
||||||
guardDocs <- case guards of
|
guardDocs <- case guards of
|
||||||
[] -> pure []
|
[] -> pure []
|
||||||
_ -> docFlushCommsPost posArrow $ layoutStmt `mapM` guards
|
_ -> docFlushCommsPost False posArrow $ layoutStmt `mapM` guards
|
||||||
bodyDoc <- layoutExpr body
|
bodyDoc <- layoutExpr body
|
||||||
return (docHandleComms epAnn, guardDocs, bodyDoc)
|
return (docHandleComms epAnn, guardDocs, bodyDoc)
|
||||||
|
|
||||||
|
@ -255,12 +256,16 @@ layoutPatternBind funId binderDoc lmatch@(L _ match) =
|
||||||
let (GRHSs _ grhss whereBinds) = m_grhss match
|
let (GRHSs _ grhss whereBinds) = m_grhss match
|
||||||
patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p
|
patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p
|
||||||
let isInfix = isInfixMatch match
|
let isInfix = isInfixMatch match
|
||||||
|
let matchEndLoc = case GHC.locA $ GHC.getLoc lmatch of
|
||||||
|
GHC.RealSrcSpan s _ -> Just $ GHC.realSrcSpanEnd s
|
||||||
|
GHC.UnhelpfulSpan{} -> Nothing
|
||||||
mIdDoc <- case match of
|
mIdDoc <- case match of
|
||||||
Match epAnn (FunRhs matchId _ _) _ _ ->
|
Match epAnn (FunRhs matchId _ _) _ _ ->
|
||||||
fmap Just $ docHandleComms epAnn $ do
|
fmap Just
|
||||||
t <- lrdrNameToTextAnn matchId
|
$ docHandleComms epAnn $ do
|
||||||
let t' = fixPatternBindIdentifier match t
|
t <- lrdrNameToTextAnn matchId
|
||||||
docLit t'
|
let t' = fixPatternBindIdentifier match t
|
||||||
|
docLit t'
|
||||||
_ -> pure Nothing
|
_ -> pure Nothing
|
||||||
patDoc <- docHandleComms lmatch $ case (mIdDoc, patDocs) of
|
patDoc <- docHandleComms lmatch $ case (mIdDoc, patDocs) of
|
||||||
(Just idDoc, p1 : p2 : pr) | isInfix -> if null pr
|
(Just idDoc, p1 : p2 : pr) | isInfix -> if null pr
|
||||||
|
@ -295,13 +300,14 @@ layoutPatternBind funId binderDoc lmatch@(L _ match) =
|
||||||
-- let mWhereArg = mWhereDocs <&> (,) (mkAnnKey lmatch)
|
-- let mWhereArg = mWhereDocs <&> (,) (mkAnnKey lmatch)
|
||||||
let alignmentToken = if null pats then Nothing else funId
|
let alignmentToken = if null pats then Nothing else funId
|
||||||
let hasComments = hasAnyCommentsBelow lmatch
|
let hasComments = hasAnyCommentsBelow lmatch
|
||||||
layoutPatternBindFinal
|
docFlushCommsPost True matchEndLoc
|
||||||
alignmentToken
|
$ layoutPatternBindFinal
|
||||||
binderDoc
|
alignmentToken
|
||||||
(Just patDoc)
|
binderDoc
|
||||||
(Right grhss)
|
(Just patDoc)
|
||||||
mWhereDocs
|
(Right grhss)
|
||||||
hasComments
|
mWhereDocs
|
||||||
|
hasComments
|
||||||
|
|
||||||
fixPatternBindIdentifier :: Match GhcPs (LHsExpr GhcPs) -> Text -> Text
|
fixPatternBindIdentifier :: Match GhcPs (LHsExpr GhcPs) -> Text -> Text
|
||||||
fixPatternBindIdentifier match idStr = go $ m_ctxt match
|
fixPatternBindIdentifier match idStr = go $ m_ctxt match
|
||||||
|
|
|
@ -1106,7 +1106,8 @@ recordExpression dotdot wrapO wrapDD wrapC indentPolicy _lexpr nameDoc nameLayou
|
||||||
if pun
|
if pun
|
||||||
then pure $ Left (posStart, fnameDoc)
|
then pure $ Left (posStart, fnameDoc)
|
||||||
else do
|
else do
|
||||||
expDoc <- shareDoc $ docFlushCommsPost posComma $ layoutExpr rFExpr
|
expDoc <-
|
||||||
|
shareDoc $ docFlushCommsPost True posComma $ layoutExpr rFExpr
|
||||||
pure $ Right (posStart, fnameDoc, expDoc)
|
pure $ Right (posStart, fnameDoc, expDoc)
|
||||||
fieldTuple1 <- mkFieldTuple rF1
|
fieldTuple1 <- mkFieldTuple rF1
|
||||||
fieldTupleR <- rFr `forM` mkFieldTuple
|
fieldTupleR <- rFr `forM` mkFieldTuple
|
||||||
|
|
|
@ -77,7 +77,7 @@ splitArrowType ltype@(L _ typ) = case typ of
|
||||||
EpAnn _ AddVbarAnn{} _ ->
|
EpAnn _ AddVbarAnn{} _ ->
|
||||||
error "brittany internal error: HsFunTy EpAnn"
|
error "brittany internal error: HsFunTy EpAnn"
|
||||||
EpAnn _ (AddRarrowAnn loc) _ ->
|
EpAnn _ (AddRarrowAnn loc) _ ->
|
||||||
docFlushCommsPost (Just $ epaLocationRealSrcSpanStart loc)
|
docFlushCommsPost True (Just $ epaLocationRealSrcSpanStart loc)
|
||||||
EpAnn _ AddRarrowAnnU{} _ ->
|
EpAnn _ AddRarrowAnnU{} _ ->
|
||||||
error "brittany internal error: HsFunTy EpAnn"
|
error "brittany internal error: HsFunTy EpAnn"
|
||||||
EpAnn _ AddLollyAnnU{} _ ->
|
EpAnn _ AddLollyAnnU{} _ ->
|
||||||
|
|
|
@ -301,8 +301,8 @@ transformAlts =
|
||||||
-- > bd' <- rec bd
|
-- > bd' <- rec bd
|
||||||
-- not sure if the lineModeDecay is relevant any longer though..
|
-- not sure if the lineModeDecay is relevant any longer though..
|
||||||
reWrap . BDFlushCommentsPrior loc <$> rec bd
|
reWrap . BDFlushCommentsPrior loc <$> rec bd
|
||||||
BDFlushCommentsPost loc bd ->
|
BDFlushCommentsPost loc shouldMark bd ->
|
||||||
reWrap . BDFlushCommentsPost loc <$> rec bd
|
reWrap . BDFlushCommentsPost loc shouldMark <$> rec bd
|
||||||
BDLines [] -> return $ reWrap BDEmpty -- evil transformation. or harmless.
|
BDLines [] -> return $ reWrap BDEmpty -- evil transformation. or harmless.
|
||||||
BDLines (l : lr) -> do
|
BDLines (l : lr) -> do
|
||||||
ind <- _acp_indent <$> mGet
|
ind <- _acp_indent <$> mGet
|
||||||
|
@ -487,7 +487,7 @@ getSpacing !bridoc = rec bridoc
|
||||||
_ -> VerticalSpacing 999 VerticalSpacingParNone False
|
_ -> VerticalSpacing 999 VerticalSpacingParNone False
|
||||||
BDQueueComments _comms bd -> rec bd
|
BDQueueComments _comms bd -> rec bd
|
||||||
BDFlushCommentsPrior _loc bd -> rec bd
|
BDFlushCommentsPrior _loc bd -> rec bd
|
||||||
BDFlushCommentsPost _loc bd -> rec bd
|
BDFlushCommentsPost _loc _shouldMark bd -> rec bd
|
||||||
BDEntryDelta _dp bd -> rec bd
|
BDEntryDelta _dp bd -> rec bd
|
||||||
BDLines [] ->
|
BDLines [] ->
|
||||||
return $ LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False
|
return $ LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False
|
||||||
|
@ -789,7 +789,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
||||||
]
|
]
|
||||||
BDQueueComments _comms bd -> rec bd
|
BDQueueComments _comms bd -> rec bd
|
||||||
BDFlushCommentsPrior _loc bd -> rec bd
|
BDFlushCommentsPrior _loc bd -> rec bd
|
||||||
BDFlushCommentsPost _loc bd -> rec bd
|
BDFlushCommentsPost _loc _shouldMark bd -> rec bd
|
||||||
BDEntryDelta _dp bd -> rec bd
|
BDEntryDelta _dp bd -> rec bd
|
||||||
BDLines [] -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]
|
BDLines [] -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]
|
||||||
BDLines ls@(_ : _) -> do
|
BDLines ls@(_ : _) -> do
|
||||||
|
|
|
@ -31,6 +31,8 @@ transformSimplifyFloating = stepBO .> stepFull
|
||||||
-- prior floating in
|
-- prior floating in
|
||||||
BDFlushCommentsPrior loc1 (BDFlushCommentsPrior loc2 x) ->
|
BDFlushCommentsPrior loc1 (BDFlushCommentsPrior loc2 x) ->
|
||||||
Just $ BDFlushCommentsPrior (max loc1 loc2) x
|
Just $ BDFlushCommentsPrior (max loc1 loc2) x
|
||||||
|
BDFlushCommentsPrior loc1 (BDFlushCommentsPost loc2 shouldMark2 x) ->
|
||||||
|
Just $ BDFlushCommentsPost loc2 shouldMark2 (BDFlushCommentsPrior loc1 x)
|
||||||
BDFlushCommentsPrior loc1 (BDPar ind line indented) ->
|
BDFlushCommentsPrior loc1 (BDPar ind line indented) ->
|
||||||
Just $ BDPar ind (BDFlushCommentsPrior loc1 line) indented
|
Just $ BDPar ind (BDFlushCommentsPrior loc1 line) indented
|
||||||
BDFlushCommentsPrior loc1 (BDSeq (l : lr)) ->
|
BDFlushCommentsPrior loc1 (BDSeq (l : lr)) ->
|
||||||
|
@ -43,32 +45,57 @@ transformSimplifyFloating = stepBO .> stepFull
|
||||||
Just $ BDAddBaseY indent $ BDFlushCommentsPrior loc1 x
|
Just $ BDAddBaseY indent $ BDFlushCommentsPrior loc1 x
|
||||||
BDFlushCommentsPrior loc1 (BDDebug s x) ->
|
BDFlushCommentsPrior loc1 (BDDebug s x) ->
|
||||||
Just $ BDDebug s $ BDFlushCommentsPrior loc1 x
|
Just $ BDDebug s $ BDFlushCommentsPrior loc1 x
|
||||||
|
BDFlushCommentsPrior loc1 (BDQueueComments comms1 x) ->
|
||||||
|
Just $ BDQueueComments comms1 $ BDFlushCommentsPrior loc1 x
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
descendCommsPost = transformDownMay $ \case
|
descendCommsPost = transformDownMay $ \case
|
||||||
-- post floating in
|
-- post floating in
|
||||||
BDFlushCommentsPost loc1 (BDFlushCommentsPost loc2 x) ->
|
BDFlushCommentsPost loc1 mark1 (BDFlushCommentsPost loc2 mark2 x) ->
|
||||||
Just $ BDFlushCommentsPost (max loc1 loc2) x
|
Just $ BDFlushCommentsPost (max loc1 loc2) (mark1 || mark2) x
|
||||||
BDFlushCommentsPost loc1 (BDPar ind line indented) ->
|
BDFlushCommentsPost loc1 shouldMark1 (BDPar ind line indented) ->
|
||||||
Just $ BDPar ind line $ BDFlushCommentsPost loc1 indented
|
Just $ BDPar ind line $ BDFlushCommentsPost loc1 shouldMark1 indented
|
||||||
BDFlushCommentsPost loc1 (BDSeq list) ->
|
BDFlushCommentsPost loc1 shouldMark1 (BDSeq list) ->
|
||||||
Just
|
Just
|
||||||
$ BDSeq
|
$ BDSeq
|
||||||
$ List.init list
|
$ List.init list
|
||||||
++ [BDFlushCommentsPost loc1 $ List.last list]
|
++ [BDFlushCommentsPost loc1 shouldMark1 $ List.last list]
|
||||||
BDFlushCommentsPost loc1 (BDLines list) ->
|
BDFlushCommentsPost loc1 shouldMark1 (BDLines list) ->
|
||||||
Just
|
Just
|
||||||
$ BDLines
|
$ BDLines
|
||||||
$ List.init list
|
$ List.init list
|
||||||
++ [BDFlushCommentsPost loc1 $ List.last list]
|
++ [BDFlushCommentsPost loc1 shouldMark1 $ List.last list]
|
||||||
BDFlushCommentsPost loc1 (BDCols sig cols) ->
|
BDFlushCommentsPost loc1 shouldMark1 (BDCols sig cols) ->
|
||||||
Just
|
Just
|
||||||
$ BDCols sig
|
$ BDCols sig
|
||||||
$ List.init cols
|
$ List.init cols
|
||||||
++ [BDFlushCommentsPost loc1 $ List.last cols]
|
++ [BDFlushCommentsPost loc1 shouldMark1 $ List.last cols]
|
||||||
BDFlushCommentsPost loc1 (BDAddBaseY indent x) ->
|
BDFlushCommentsPost loc1 shouldMark1 (BDIndentLevelPop x) ->
|
||||||
Just $ BDAddBaseY indent $ BDFlushCommentsPost loc1 x
|
Just $ BDIndentLevelPop (BDFlushCommentsPost loc1 shouldMark1 x)
|
||||||
BDFlushCommentsPost loc1 (BDDebug s x) ->
|
BDFlushCommentsPost loc1 shouldMark1 (BDIndentLevelPushCur x) ->
|
||||||
Just $ BDDebug s $ BDFlushCommentsPost loc1 x
|
Just $ BDIndentLevelPushCur (BDFlushCommentsPost loc1 shouldMark1 x)
|
||||||
|
BDFlushCommentsPost loc1 shouldMark1 (BDBaseYPushCur x) ->
|
||||||
|
Just $ BDBaseYPushCur (BDFlushCommentsPost loc1 shouldMark1 x)
|
||||||
|
BDFlushCommentsPost loc1 shouldMark1 (BDAddBaseY indent x) ->
|
||||||
|
Just $ BDAddBaseY indent $ BDFlushCommentsPost loc1 shouldMark1 x
|
||||||
|
BDFlushCommentsPost loc1 shouldMark1 (BDDebug s x) ->
|
||||||
|
Just $ BDDebug s $ BDFlushCommentsPost loc1 shouldMark1 x
|
||||||
|
_ -> Nothing
|
||||||
|
descendQueueComments = transformDownMay $ \case
|
||||||
|
-- queue comments floating in
|
||||||
|
BDQueueComments comms1 (BDQueueComments comms2 x) ->
|
||||||
|
Just $ BDQueueComments (comms1 ++ comms2) x
|
||||||
|
BDQueueComments comms1 (BDPar ind line indented) ->
|
||||||
|
Just $ BDPar ind (BDQueueComments comms1 line) indented
|
||||||
|
BDQueueComments comms1 (BDSeq (l : lr)) ->
|
||||||
|
Just $ BDSeq (BDQueueComments comms1 l : lr)
|
||||||
|
BDQueueComments comms1 (BDLines (l : lr)) ->
|
||||||
|
Just $ BDLines (BDQueueComments comms1 l : lr)
|
||||||
|
BDQueueComments comms1 (BDCols sig (l : lr)) ->
|
||||||
|
Just $ BDCols sig (BDQueueComments comms1 l : lr)
|
||||||
|
BDQueueComments comms1 (BDAddBaseY indent x) ->
|
||||||
|
Just $ BDAddBaseY indent $ BDQueueComments comms1 x
|
||||||
|
BDQueueComments comms1 (BDDebug s x) ->
|
||||||
|
Just $ BDDebug s $ BDQueueComments comms1 x
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
descendBYPush = transformDownMay $ \case
|
descendBYPush = transformDownMay $ \case
|
||||||
BDBaseYPushCur (BDCols sig cols@(_ : _)) ->
|
BDBaseYPushCur (BDCols sig cols@(_ : _)) ->
|
||||||
|
@ -114,8 +141,8 @@ transformSimplifyFloating = stepBO .> stepFull
|
||||||
Just $ BDPar (mergeIndents ind1 ind2) line indented
|
Just $ BDPar (mergeIndents ind1 ind2) line indented
|
||||||
BDAddBaseY ind (BDFlushCommentsPrior loc x) ->
|
BDAddBaseY ind (BDFlushCommentsPrior loc x) ->
|
||||||
Just $ BDFlushCommentsPrior loc (BDAddBaseY ind x)
|
Just $ BDFlushCommentsPrior loc (BDAddBaseY ind x)
|
||||||
BDAddBaseY ind (BDFlushCommentsPost loc x) ->
|
BDAddBaseY ind (BDFlushCommentsPost loc shouldMark x) ->
|
||||||
Just $ BDFlushCommentsPost loc (BDAddBaseY ind x)
|
Just $ BDFlushCommentsPost loc shouldMark (BDAddBaseY ind x)
|
||||||
BDAddBaseY ind (BDQueueComments comms x) ->
|
BDAddBaseY ind (BDQueueComments comms x) ->
|
||||||
Just $ BDQueueComments comms (BDAddBaseY ind x)
|
Just $ BDQueueComments comms (BDAddBaseY ind x)
|
||||||
BDAddBaseY ind (BDSeq list) ->
|
BDAddBaseY ind (BDSeq list) ->
|
||||||
|
@ -151,6 +178,7 @@ transformSimplifyFloating = stepBO .> stepFull
|
||||||
BDSeq xs -> BDSeq (dropWhile (\case BDEmpty -> True; _ -> False) xs)
|
BDSeq xs -> BDSeq (dropWhile (\case BDEmpty -> True; _ -> False) xs)
|
||||||
x@BDFlushCommentsPrior{} -> descendCommsPrior x
|
x@BDFlushCommentsPrior{} -> descendCommsPrior x
|
||||||
x@BDFlushCommentsPost{} -> descendCommsPost x
|
x@BDFlushCommentsPost{} -> descendCommsPost x
|
||||||
|
x@BDQueueComments{} -> descendQueueComments x
|
||||||
x@BDAddBaseY{} -> descendAddB x
|
x@BDAddBaseY{} -> descendAddB x
|
||||||
x@BDBaseYPushCur{} -> descendBYPush x
|
x@BDBaseYPushCur{} -> descendBYPush x
|
||||||
x@BDEntryDelta{} -> descendEntryDelta x
|
x@BDEntryDelta{} -> descendEntryDelta x
|
||||||
|
@ -186,8 +214,10 @@ transformSimplifyFloating = stepBO .> stepFull
|
||||||
-- BDEnsureIndent indent (BDLines lines) ->
|
-- BDEnsureIndent indent (BDLines lines) ->
|
||||||
-- Just $ BDLines $ BDEnsureIndent indent <$> lines
|
-- Just $ BDLines $ BDEnsureIndent indent <$> lines
|
||||||
-- flush-prior floating in
|
-- flush-prior floating in
|
||||||
BDFlushCommentsPrior loc (BDPar ind line indented) ->
|
BDFlushCommentsPrior loc1 (BDFlushCommentsPrior loc2 x) ->
|
||||||
Just $ BDPar ind (BDFlushCommentsPrior loc line) indented
|
Just $ BDFlushCommentsPrior (max loc1 loc2) x
|
||||||
|
BDFlushCommentsPrior loc1 (BDFlushCommentsPost loc2 shouldMark2 x) ->
|
||||||
|
Just $ BDFlushCommentsPost loc2 shouldMark2 (BDFlushCommentsPrior loc1 x)
|
||||||
BDFlushCommentsPrior loc (BDSeq (l : lr)) ->
|
BDFlushCommentsPrior loc (BDSeq (l : lr)) ->
|
||||||
Just $ BDSeq (BDFlushCommentsPrior loc l : lr)
|
Just $ BDSeq (BDFlushCommentsPrior loc l : lr)
|
||||||
BDFlushCommentsPrior loc (BDLines (l : lr)) ->
|
BDFlushCommentsPrior loc (BDLines (l : lr)) ->
|
||||||
|
@ -195,14 +225,24 @@ transformSimplifyFloating = stepBO .> stepFull
|
||||||
BDFlushCommentsPrior loc (BDCols sig (l : lr)) ->
|
BDFlushCommentsPrior loc (BDCols sig (l : lr)) ->
|
||||||
Just $ BDCols sig (BDFlushCommentsPrior loc l : lr)
|
Just $ BDCols sig (BDFlushCommentsPrior loc l : lr)
|
||||||
-- flush-post floating in
|
-- flush-post floating in
|
||||||
BDFlushCommentsPost comms1 (BDPar ind line indented) ->
|
BDFlushCommentsPost loc1 mark1 (BDPar ind line indented) ->
|
||||||
Just $ BDPar ind line $ BDFlushCommentsPost comms1 indented
|
Just $ BDPar ind line $ BDFlushCommentsPost loc1 mark1 indented
|
||||||
BDFlushCommentsPost loc (BDSeq list) ->
|
BDFlushCommentsPost loc1 mark1 (BDSeq list) ->
|
||||||
Just $ BDSeq $ List.init list ++ [BDFlushCommentsPost loc $ List.last list]
|
Just $ BDSeq $ List.init list ++ [BDFlushCommentsPost loc1 mark1 $ List.last list]
|
||||||
BDFlushCommentsPost loc (BDLines list) -> Just
|
BDFlushCommentsPost loc1 mark1 (BDLines list) ->
|
||||||
$ BDLines $ List.init list ++ [BDFlushCommentsPost loc $ List.last list]
|
Just $ BDLines $ List.init list ++ [BDFlushCommentsPost loc1 mark1 $ List.last list]
|
||||||
BDFlushCommentsPost loc (BDCols sig list) -> Just
|
BDFlushCommentsPost loc1 mark1 (BDCols sig list) ->
|
||||||
$ BDCols sig $ List.init list ++ [BDFlushCommentsPost loc $ List.last list]
|
Just $ BDCols sig $ List.init list ++ [BDFlushCommentsPost loc1 mark1 $ List.last list]
|
||||||
|
BDFlushCommentsPost loc1 mark1 (BDIndentLevelPop x) ->
|
||||||
|
Just $ BDIndentLevelPop (BDFlushCommentsPost loc1 mark1 x)
|
||||||
|
BDFlushCommentsPost loc1 mark1 (BDIndentLevelPushCur x) ->
|
||||||
|
Just $ BDIndentLevelPushCur (BDFlushCommentsPost loc1 mark1 x)
|
||||||
|
BDFlushCommentsPost loc1 mark1 (BDBaseYPushCur x) ->
|
||||||
|
Just $ BDBaseYPushCur (BDFlushCommentsPost loc1 mark1 x)
|
||||||
|
BDFlushCommentsPost loc1 mark1 (BDAddBaseY indent x) ->
|
||||||
|
Just $ BDAddBaseY indent $ BDFlushCommentsPost loc1 mark1 x
|
||||||
|
BDFlushCommentsPost loc1 mark1 (BDDebug s x) ->
|
||||||
|
Just $ BDDebug s $ BDFlushCommentsPost loc1 mark1 x
|
||||||
-- entry-delta floating in
|
-- entry-delta floating in
|
||||||
BDEntryDelta dp (BDPar ind line indented) ->
|
BDEntryDelta dp (BDPar ind line indented) ->
|
||||||
Just $ BDPar ind (BDEntryDelta dp line) indented
|
Just $ BDPar ind (BDEntryDelta dp line) indented
|
||||||
|
|
|
@ -33,7 +33,7 @@ transformSimplifyColumns = Uniplate.rewrite $ \case
|
||||||
(\case
|
(\case
|
||||||
BDSeparator -> True
|
BDSeparator -> True
|
||||||
BDFlushCommentsPrior _ BDSeparator -> True
|
BDFlushCommentsPrior _ BDSeparator -> True
|
||||||
BDFlushCommentsPost _ BDSeparator -> True
|
BDFlushCommentsPost _ _ BDSeparator -> True
|
||||||
_ -> False
|
_ -> False
|
||||||
)
|
)
|
||||||
rest
|
rest
|
||||||
|
@ -57,12 +57,16 @@ transformSimplifyColumns = Uniplate.rewrite $ \case
|
||||||
BDFlushCommentsPrior loc (BDCols sig (l : lr)) ->
|
BDFlushCommentsPrior loc (BDCols sig (l : lr)) ->
|
||||||
Just $ BDCols sig (BDFlushCommentsPrior loc l : lr)
|
Just $ BDCols sig (BDFlushCommentsPrior loc l : lr)
|
||||||
-- flush-post floating in
|
-- flush-post floating in
|
||||||
BDFlushCommentsPost loc (BDSeq list) ->
|
BDFlushCommentsPost loc shouldMark (BDSeq list) ->
|
||||||
Just $ BDSeq $ List.init list ++ [BDFlushCommentsPost loc $ List.last list]
|
Just
|
||||||
BDFlushCommentsPost loc (BDLines list) -> Just
|
$ BDSeq
|
||||||
$ BDLines $ List.init list ++ [BDFlushCommentsPost loc $ List.last list]
|
$ List.init list ++ [BDFlushCommentsPost loc shouldMark $ List.last list]
|
||||||
BDFlushCommentsPost loc (BDCols sig list) -> Just
|
BDFlushCommentsPost loc shouldMark (BDLines list) -> Just
|
||||||
$ BDCols sig $ List.init list ++ [BDFlushCommentsPost loc $ List.last list]
|
$ BDLines
|
||||||
|
$ List.init list ++ [BDFlushCommentsPost loc shouldMark $ List.last list]
|
||||||
|
BDFlushCommentsPost loc shouldMark (BDCols sig list) -> Just
|
||||||
|
$ BDCols sig
|
||||||
|
$ List.init list ++ [BDFlushCommentsPost loc shouldMark $ List.last list]
|
||||||
-- ensureIndent float-in
|
-- ensureIndent float-in
|
||||||
-- not sure if the following rule is necessary; tests currently are
|
-- not sure if the following rule is necessary; tests currently are
|
||||||
-- unaffected.
|
-- unaffected.
|
||||||
|
|
|
@ -42,8 +42,8 @@ transformSimplifyIndent = Uniplate.rewrite $ \case
|
||||||
BDLines [l] -> Just l
|
BDLines [l] -> Just l
|
||||||
BDAddBaseY i (BDFlushCommentsPrior c x) ->
|
BDAddBaseY i (BDFlushCommentsPrior c x) ->
|
||||||
Just $ BDFlushCommentsPrior c (BDAddBaseY i x)
|
Just $ BDFlushCommentsPrior c (BDAddBaseY i x)
|
||||||
BDAddBaseY i (BDFlushCommentsPost c x) ->
|
BDAddBaseY i (BDFlushCommentsPost c sm x) ->
|
||||||
Just $ BDFlushCommentsPost c (BDAddBaseY i x)
|
Just $ BDFlushCommentsPost c sm (BDAddBaseY i x)
|
||||||
BDAddBaseY i (BDSeq l) ->
|
BDAddBaseY i (BDSeq l) ->
|
||||||
Just $ BDSeq $ List.init l ++ [BDAddBaseY i $ List.last l]
|
Just $ BDSeq $ List.init l ++ [BDAddBaseY i $ List.last l]
|
||||||
BDAddBaseY i (BDCols sig l) ->
|
BDAddBaseY i (BDCols sig l) ->
|
||||||
|
|
|
@ -249,7 +249,7 @@ briDocToDoc = astToDoc . removeAnnotations
|
||||||
where
|
where
|
||||||
removeAnnotations = Uniplate.transform $ \case
|
removeAnnotations = Uniplate.transform $ \case
|
||||||
BDFlushCommentsPrior _ x -> x
|
BDFlushCommentsPrior _ x -> x
|
||||||
BDFlushCommentsPost _ x -> x
|
BDFlushCommentsPost _ _ x -> x
|
||||||
BDQueueComments _ x -> x
|
BDQueueComments _ x -> x
|
||||||
x -> x
|
x -> x
|
||||||
|
|
||||||
|
|
|
@ -409,7 +409,7 @@ briDocLineLength briDoc = flip StateS.evalState False $ rec briDoc
|
||||||
BDPlain t -> return $ Text.length t
|
BDPlain t -> return $ Text.length t
|
||||||
BDQueueComments _ bd -> rec bd
|
BDQueueComments _ bd -> rec bd
|
||||||
BDFlushCommentsPrior _ bd -> rec bd
|
BDFlushCommentsPrior _ bd -> rec bd
|
||||||
BDFlushCommentsPost _ bd -> rec bd
|
BDFlushCommentsPost _ _ bd -> rec bd
|
||||||
BDLines ls@(_ : _) -> do
|
BDLines ls@(_ : _) -> do
|
||||||
x <- StateS.get
|
x <- StateS.get
|
||||||
return $ maximum $ ls <&> \l -> StateS.evalState (rec l) x
|
return $ maximum $ ls <&> \l -> StateS.evalState (rec l) x
|
||||||
|
@ -446,7 +446,7 @@ briDocIsMultiLine briDoc = rec briDoc
|
||||||
BDPlain _ -> True
|
BDPlain _ -> True
|
||||||
BDQueueComments _ bd -> rec bd
|
BDQueueComments _ bd -> rec bd
|
||||||
BDFlushCommentsPrior _ bd -> rec bd
|
BDFlushCommentsPrior _ bd -> rec bd
|
||||||
BDFlushCommentsPost _ bd -> rec bd
|
BDFlushCommentsPost _ _ bd -> rec bd
|
||||||
BDEntryDelta _dp bd -> rec bd
|
BDEntryDelta _dp bd -> rec bd
|
||||||
BDLines (_ : _ : _) -> True
|
BDLines (_ : _ : _) -> True
|
||||||
BDLines [_] -> False
|
BDLines [_] -> False
|
||||||
|
|
|
@ -15,8 +15,11 @@ module Language.Haskell.Brittany.Internal.WriteBriDoc.Operators
|
||||||
, layoutIndentLevelPushCur
|
, layoutIndentLevelPushCur
|
||||||
, layoutIndentLevelPop
|
, layoutIndentLevelPop
|
||||||
, layoutWriteNewline
|
, layoutWriteNewline
|
||||||
|
, layoutWriteNewlines
|
||||||
, layoutWriteComment
|
, layoutWriteComment
|
||||||
, layoutFlushLine
|
, layoutFlushLine
|
||||||
|
, layoutSetMarker
|
||||||
|
, layoutUpdateMarker
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -26,6 +29,7 @@ import qualified Data.Text as Text
|
||||||
import qualified Data.Text.Lazy.Builder as Text.Builder
|
import qualified Data.Text.Lazy.Builder as Text.Builder
|
||||||
import qualified GHC.OldList as List
|
import qualified GHC.OldList as List
|
||||||
import qualified GHC.Parser.Annotation as GHC
|
import qualified GHC.Parser.Annotation as GHC
|
||||||
|
import GHC ( RealSrcLoc )
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Internal.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
import Language.Haskell.Brittany.Internal.WriteBriDoc.Types
|
import Language.Haskell.Brittany.Internal.WriteBriDoc.Types
|
||||||
|
@ -93,6 +97,17 @@ layoutWriteNewline = do
|
||||||
{ _lstate_plannedSpace = PlannedNewline 1
|
{ _lstate_plannedSpace = PlannedNewline 1
|
||||||
}
|
}
|
||||||
|
|
||||||
|
layoutWriteNewlines
|
||||||
|
:: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
|
||||||
|
=> Int
|
||||||
|
-> m ()
|
||||||
|
layoutWriteNewlines n = do
|
||||||
|
traceLocal ("layoutWriteNewlines")
|
||||||
|
state <- mGet
|
||||||
|
mSet $ state
|
||||||
|
{ _lstate_plannedSpace = PlannedNewline n
|
||||||
|
}
|
||||||
|
|
||||||
-- layoutMoveToIndentCol :: ( MonadMultiState LayoutState m
|
-- layoutMoveToIndentCol :: ( MonadMultiState LayoutState m
|
||||||
-- , MonadMultiWriter (Seq String) m) => Int -> m ()
|
-- , MonadMultiWriter (Seq String) m) => Int -> m ()
|
||||||
-- layoutMoveToIndentCol i = do
|
-- layoutMoveToIndentCol i = do
|
||||||
|
@ -322,6 +337,17 @@ layoutFlushLine = do
|
||||||
state <- mGet
|
state <- mGet
|
||||||
when (_lstate_curY state > 0) layoutWriteEnsureNewlineBlock
|
when (_lstate_curY state > 0) layoutWriteEnsureNewlineBlock
|
||||||
|
|
||||||
|
layoutSetMarker :: (MonadMultiState LayoutState m) => Maybe RealSrcLoc -> m ()
|
||||||
|
layoutSetMarker markerMay =
|
||||||
|
mModify $ \s -> s { _lstate_markerForDelta = markerMay }
|
||||||
|
|
||||||
|
layoutUpdateMarker :: (MonadMultiState LayoutState m) => RealSrcLoc -> m ()
|
||||||
|
layoutUpdateMarker marker = mModify $ \s -> s
|
||||||
|
{ _lstate_markerForDelta = case _lstate_markerForDelta s of
|
||||||
|
Nothing -> Nothing
|
||||||
|
Just _ -> Just marker
|
||||||
|
}
|
||||||
|
|
||||||
-- moveToY :: MonadMultiState LayoutState m => Int -> m ()
|
-- moveToY :: MonadMultiState LayoutState m => Int -> m ()
|
||||||
-- moveToY y = mModify $ \state ->
|
-- moveToY y = mModify $ \state ->
|
||||||
-- let
|
-- let
|
||||||
|
|
|
@ -7,6 +7,7 @@ import Language.Haskell.Brittany.Internal.Prelude
|
||||||
|
|
||||||
import qualified Safe
|
import qualified Safe
|
||||||
import GHC ( LEpaComment
|
import GHC ( LEpaComment
|
||||||
|
, RealSrcLoc
|
||||||
)
|
)
|
||||||
import qualified Data.Text.Lazy.Builder as TextL.Builder
|
import qualified Data.Text.Lazy.Builder as TextL.Builder
|
||||||
|
|
||||||
|
@ -60,6 +61,7 @@ data LayoutState = LayoutState
|
||||||
-- But the worst effect at the moment would
|
-- But the worst effect at the moment would
|
||||||
-- be that we introduce less newlines on
|
-- be that we introduce less newlines on
|
||||||
-- moveToKWDP, which seems harmless enough.
|
-- moveToKWDP, which seems harmless enough.
|
||||||
|
, _lstate_markerForDelta :: Maybe RealSrcLoc
|
||||||
}
|
}
|
||||||
|
|
||||||
lstate_baseY :: LayoutState -> Int
|
lstate_baseY :: LayoutState -> Int
|
||||||
|
|
Loading…
Reference in New Issue