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

Reintroduce BDAnnotationKW in the form of BDEntryDelta

ghc92
Lennart Spitzner 2023-03-17 15:02:48 +00:00
parent 7d3490b80a
commit ee2814e3a8
9 changed files with 86 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
source/library/Language/Haskell/Brittany/Internal/Components/BriDoc.hs
View File

@ -11,7 +11,7 @@ import Language.Haskell.Brittany.Internal.Prelude
import Data.Generics.Uniplate.Direct as Uniplate
import qualified Data.Data
import GHC (RealSrcLoc, LEpaComment)
import GHC (RealSrcLoc, LEpaComment, DeltaPos)
@ -29,7 +29,6 @@ data BriDoc
| BDSeparator -- semantically, space-unless-at-end-of-line.
| BDAddBaseY BrIndent BriDoc
| BDBaseYPushCur BriDoc
| BDBaseYPop BriDoc
| BDIndentLevelPushCur BriDoc
| BDIndentLevelPop BriDoc
| BDPar
@ -55,6 +54,14 @@ data BriDoc
| BDFlushCommentsPost RealSrcLoc BriDoc
-- process comments before loc from the queue, but flow to end of
-- child-nodes
| BDEntryDelta DeltaPos BriDoc
-- Move to the specified delta position before rendering the inner
-- element. Currently this only ever respects newlines, i.e. Sameline
-- is ignored and only the `n` of DifferentLine n _ is used.
-- Purpose is to retain some spacing in the formatted code, inside
-- a particular declaration - on the top-level spacing is retained by
-- other means.
-- The deltas should in general derived via `obtainAnnDeltaPos`.
| BDLines [BriDoc]
| BDEnsureIndent BrIndent BriDoc
-- the following constructors are only relevant for the alt transformation
@ -80,7 +87,6 @@ data BriDocF f
| BDFSeparator -- semantically, space-unless-at-end-of-line.
| BDFAddBaseY BrIndent (f (BriDocF f))
| BDFBaseYPushCur (f (BriDocF f))
| BDFBaseYPop (f (BriDocF f))
| BDFIndentLevelPushCur (f (BriDocF f))
| BDFIndentLevelPop (f (BriDocF f))
| BDFPar
@ -106,6 +112,7 @@ data BriDocF f
| BDFFlushCommentsPost RealSrcLoc (f (BriDocF f))
-- process comments before loc from the queue, but flow to end of
-- child-nodes
| BDFEntryDelta DeltaPos (f (BriDocF f))
| BDFLines [(f (BriDocF f))]
| BDFEnsureIndent BrIndent (f (BriDocF f))
| BDFForceMultiline (f (BriDocF f))
@ -134,7 +141,6 @@ instance Uniplate.Uniplate BriDoc where
uniplate x@BDSeparator = plate x
uniplate (BDAddBaseY ind bd ) = plate BDAddBaseY |- ind |* bd
uniplate (BDBaseYPushCur bd) = plate BDBaseYPushCur |* bd
uniplate (BDBaseYPop bd) = plate BDBaseYPop |* bd
uniplate (BDIndentLevelPushCur bd) = plate BDIndentLevelPushCur |* bd
uniplate (BDIndentLevelPop bd) = plate BDIndentLevelPop |* bd
uniplate (BDPar ind line indented) = plate BDPar |- ind |* line |* indented
@ -148,6 +154,7 @@ instance Uniplate.Uniplate BriDoc where
plate BDFlushCommentsPrior |- loc |* bd
uniplate (BDFlushCommentsPost loc bd) =
plate BDFlushCommentsPost |- loc |* bd
uniplate (BDEntryDelta dp bd ) = plate BDEntryDelta |- dp |* bd
uniplate (BDLines lines ) = plate BDLines ||* lines
uniplate (BDEnsureIndent ind bd ) = plate BDEnsureIndent |- ind |* bd
uniplate (BDForceMultiline bd ) = plate BDForceMultiline |* bd
@ -167,7 +174,6 @@ briDocSeqSpine = \case
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
@ -178,6 +184,7 @@ briDocSeqSpine = \case
BDQueueComments _comms bd -> briDocSeqSpine bd
BDFlushCommentsPrior _loc bd -> briDocSeqSpine bd
BDFlushCommentsPost _loc bd -> briDocSeqSpine bd
BDEntryDelta _dp bd -> briDocSeqSpine bd
BDLines lines -> foldl' (\() -> briDocSeqSpine) () lines
BDEnsureIndent _ind bd -> briDocSeqSpine bd
BDForceMultiline bd -> briDocSeqSpine bd
@ -204,7 +211,6 @@ unwrapBriDocNumbered tpl = case snd tpl of
BDFSeparator -> BDSeparator
BDFAddBaseY ind bd -> BDAddBaseY ind $ rec bd
BDFBaseYPushCur bd -> BDBaseYPushCur $ rec bd
BDFBaseYPop bd -> BDBaseYPop $ rec bd
BDFIndentLevelPushCur bd -> BDIndentLevelPushCur $ rec bd
BDFIndentLevelPop bd -> BDIndentLevelPop $ rec bd
BDFPar ind line indented -> BDPar ind (rec line) (rec indented)
@ -215,6 +221,7 @@ unwrapBriDocNumbered tpl = case snd tpl of
BDFQueueComments comms bd -> BDQueueComments comms $ rec bd
BDFFlushCommentsPrior loc bd -> BDFlushCommentsPrior loc $ rec bd
BDFFlushCommentsPost loc bd -> BDFlushCommentsPost loc $ rec bd
BDFEntryDelta dp bd -> BDEntryDelta dp $ rec bd
BDFLines lines -> BDLines $ rec <$> lines
BDFEnsureIndent ind bd -> BDEnsureIndent ind $ rec bd
BDFForceMultiline bd -> BDForceMultiline $ rec bd

8
source/library/Language/Haskell/Brittany/Internal/S3_ToBriDocTools.hs
View File

@ -381,9 +381,7 @@ docSetBaseY bdm = do
bd <- bdm
-- the order here is important so that these two nodes can be treated
-- properly over at `transformAlts`.
n1 <- allocateNode $ BDFBaseYPushCur bd
n2 <- allocateNode $ BDFBaseYPop n1
return n2
allocateNode $ BDFBaseYPushCur bd
docSetIndentLevel :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docSetIndentLevel bdm = do
@ -470,6 +468,10 @@ docEnsureIndent
:: BrIndent -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docEnsureIndent ind mbd = mbd >>= \bd -> allocateNode $ BDFEnsureIndent ind bd
docAddEntryDelta :: GHC.DeltaPos -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docAddEntryDelta dp bdm = do
bd <- bdm
allocateNode (BDFEntryDelta dp bd)
docFlushRemaining :: FastString -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docFlushRemaining fileThing = docFlushCommsPost

10
source/library/Language/Haskell/Brittany/Internal/S4_WriteBriDoc.hs
View File

@ -30,6 +30,7 @@ import GHC ( Anchor(Anchor)
, GenLocated(L)
, LEpaComment
, RealSrcLoc
, DeltaPos(SameLine, DifferentLine)
)
import GHC.Types.SrcLoc ( realSrcSpanEnd )
import qualified GHC.OldList as List
@ -143,8 +144,6 @@ layoutBriDocM = \case
BDBaseYPushCur bd -> do
layoutBaseYPushCur
layoutBriDocM bd
BDBaseYPop bd -> do
layoutBriDocM bd
layoutBaseYPop
BDIndentLevelPushCur bd -> do
layoutIndentLevelPushCur
@ -169,6 +168,13 @@ layoutBriDocM = \case
indentF $ do
layoutWriteNewline
layoutBriDocM indented
BDEntryDelta dp bd -> do
case dp of
GHC.SameLine _ -> pure ()
GHC.DifferentLine l _i -> mModify $ \s -> s {
_lstate_plannedSpace = PlannedNewline l
}
layoutBriDocM bd
BDLines lines -> alignColsLines layoutBriDocM lines
BDAlt [] -> error "empty BDAlt"
BDAlt (alt : _) -> layoutBriDocM alt

7
source/library/Language/Haskell/Brittany/Internal/StepOrchestrate.hs
View File

@ -96,13 +96,6 @@ processModule traceFunc conf inlineConf parsedModule = do
HsModule _ _layoutInfo Nothing Just{} _ _ _ _ -> error
"brittany internal error: exports without module name"
HsModule epAnn _layoutInfo (Just n) les _ _ _ _ -> do
let startDelta = obtainAnnDeltaPos epAnn GHC.AnnModule
tellDebugMess (show startDelta)
case startDelta of
Nothing -> pure ()
Just GHC.SameLine{} -> pure ()
Just (GHC.DifferentLine r _) ->
mTell $ TextL.Builder.fromString $ replicate (r - 1) '\n'
(bd, _) <-
briDocMToPPM
$ maybe id

12
source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Module.hs
View File

@ -33,9 +33,17 @@ moduleNameExportBridoc epAnn modName les = do
-- the config should not prevent single-line layout when there is no
-- export list
let tn = Text.pack $ moduleNameString $ unLoc modName
let startDelta = obtainAnnDeltaPos epAnn AnnModule
-- tellDebugMess (show startDelta)
let wrapModule = case startDelta of
Nothing -> id
Just SameLine{} -> id
Just (DifferentLine 0 _) -> id
Just (DifferentLine 1 _) -> id
Just dp -> docAddEntryDelta dp
docHandleComms epAnn $ docHandleComms posModule $ runFilteredAlternative $ do
addAlternativeCond allowSingleLine $ docSeq
[ appSep $ docLit $ Text.pack "module"
[ appSep $ wrapModule $ docLit $ Text.pack "module"
, appSep $ docLit tn
, docForceSingleline $ appSep $ case les of
Nothing -> docEmpty
@ -46,7 +54,7 @@ moduleNameExportBridoc epAnn modName les = do
addAlternative $ docLines
[ docAddBaseY BrIndentRegular $ docPar
(docSeq
[appSep $ docLit $ Text.pack "module", docLit tn]
[appSep $ wrapModule $ docLit $ Text.pack "module", docLit tn]
)
(docSeq
[ case les of

14
source/library/Language/Haskell/Brittany/Internal/Transformations/T1_Alt.hs
View File

@ -176,13 +176,11 @@ transformAlts =
acp <- mGet
mSet $ acp { _acp_indent = _acp_line acp }
r <- rec bd
return $ reWrap $ BDFBaseYPushCur r
BDFBaseYPop bd -> do
acp <- mGet
r <- rec bd
acp' <- mGet
mSet $ acp' { _acp_indent = _acp_indentPrep acp }
return $ reWrap $ BDFBaseYPop r
mSet $ acp' { _acp_indent = _acp_indent acp }
return $ reWrap $ BDFBaseYPushCur r
BDFEntryDelta dp bd -> do
return $ reWrap $ BDFEntryDelta dp bd
BDFIndentLevelPushCur bd -> do
reWrap . BDFIndentLevelPushCur <$> rec bd
BDFIndentLevelPop bd -> do
@ -442,7 +440,6 @@ getSpacing !bridoc = rec bridoc
)
, _vs_paragraph = VerticalSpacingParSome 0
}
BDFBaseYPop bd -> rec bd
BDFIndentLevelPushCur bd -> rec bd
BDFIndentLevelPop bd -> rec bd
BDFPar BrIndentNone sameLine indented -> do
@ -491,6 +488,7 @@ getSpacing !bridoc = rec bridoc
BDFQueueComments _comms bd -> rec bd
BDFFlushCommentsPrior _loc bd -> rec bd
BDFFlushCommentsPost _loc bd -> rec bd
BDFEntryDelta _dp bd -> rec bd
BDFLines [] ->
return $ LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False
BDFLines (l1 : lR) -> do
@ -740,7 +738,6 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
VerticalSpacingParSome i -> VerticalSpacingParSome i
VerticalSpacingParAlways i -> VerticalSpacingParAlways i
}
BDFBaseYPop bd -> rec bd
BDFIndentLevelPushCur bd -> rec bd
BDFIndentLevelPop bd -> rec bd
BDFPar BrIndentNone sameLine indented -> do
@ -793,6 +790,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
BDFQueueComments _comms bd -> rec bd
BDFFlushCommentsPrior _loc bd -> rec bd
BDFFlushCommentsPost _loc bd -> rec bd
BDFEntryDelta _dp bd -> rec bd
BDFLines [] -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]
BDFLines ls@(_ : _) -> do
-- we simply assume that lines is only used "properly", i.e. in

49
source/library/Language/Haskell/Brittany/Internal/Transformations/T2_Floating.hs
View File

@ -75,10 +75,20 @@ transformSimplifyFloating = stepBO .> stepFull
Just $ BDCols sig (BDBaseYPushCur (List.head cols) : List.tail cols)
BDBaseYPushCur (BDDebug s x) -> Just $ BDDebug s (BDBaseYPushCur x)
_ -> Nothing
descendBYPop = transformDownMay $ \case
BDBaseYPop (BDCols sig cols@(_ : _)) ->
Just $ BDCols sig (List.init cols ++ [BDBaseYPop (List.last cols)])
BDBaseYPop (BDDebug s x) -> Just $ BDDebug s (BDBaseYPop x)
descendEntryDelta = transformDownMay $ \case
-- entry delta floating in
BDEntryDelta dp (BDPar ind line indented) ->
Just $ BDPar ind (BDEntryDelta dp line) indented
BDEntryDelta dp (BDSeq (l : lr)) ->
Just $ BDSeq (BDEntryDelta dp l : lr)
BDEntryDelta dp (BDLines (l : lr)) ->
Just $ BDLines (BDEntryDelta dp l : lr)
BDEntryDelta dp (BDCols sig (l : lr)) ->
Just $ BDCols sig (BDEntryDelta dp l : lr)
BDEntryDelta dp (BDAddBaseY indent x) ->
Just $ BDAddBaseY indent $ BDEntryDelta dp x
BDEntryDelta dp (BDDebug s x) ->
Just $ BDDebug s $ BDEntryDelta dp x
_ -> Nothing
descendILPush = transformDownMay $ \case
BDIndentLevelPushCur (BDCols sig cols@(_ : _)) ->
@ -113,7 +123,18 @@ transformSimplifyFloating = stepBO .> stepFull
BDAddBaseY _ lit@BDLit{} -> Just $ lit
BDAddBaseY ind (BDBaseYPushCur x) ->
Just $ BDBaseYPushCur (BDAddBaseY ind x)
BDAddBaseY ind (BDBaseYPop x) -> Just $ BDBaseYPop (BDAddBaseY ind x)
-- TODO92 We have several rules here in conflict with each other.
-- Unless I forget some detail related to some elements being able
-- to float in further, we probably should define some
-- intended "floating" order that all rules should adhere.
-- According to that order, we should either have
-- A (B x) -> B (A x)
-- or
-- B (A x) -> A (B x)
-- but not both.
-- I have disable the following conflict for
-- BDAddBaseY vs BDEntryDelta for now.
-- BDAddBaseY ind (BDEntryDelta dp) -> Just $ BDEntryDelta dp (BDAddBaseY ind x)
BDAddBaseY ind (BDDebug s x) -> Just $ BDDebug s (BDAddBaseY ind x)
BDAddBaseY ind (BDIndentLevelPop x) ->
Just $ BDIndentLevelPop (BDAddBaseY ind x)
@ -132,7 +153,7 @@ transformSimplifyFloating = stepBO .> stepFull
x@BDFlushCommentsPost{} -> descendCommsPost x
x@BDAddBaseY{} -> descendAddB x
x@BDBaseYPushCur{} -> descendBYPush x
x@BDBaseYPop{} -> descendBYPop x
x@BDEntryDelta{} -> descendEntryDelta x
x@BDIndentLevelPushCur{} -> descendILPush x
x@BDIndentLevelPop{} -> descendILPop x
x -> x
@ -157,7 +178,6 @@ transformSimplifyFloating = stepBO .> stepFull
BDAddBaseY _ lit@BDLit{} -> Just $ lit
BDAddBaseY ind (BDBaseYPushCur x) ->
Just $ BDBaseYPushCur (BDAddBaseY ind x)
BDAddBaseY ind (BDBaseYPop x) -> Just $ BDBaseYPop (BDAddBaseY ind x)
-- EnsureIndent float-in
-- BDEnsureIndent indent (BDCols sig (col:colr)) ->
-- Just $ BDCols sig (BDEnsureIndent indent col : (BDAddBaseY indent <$> colr))
@ -183,5 +203,18 @@ transformSimplifyFloating = stepBO .> stepFull
$ BDLines $ List.init list ++ [BDFlushCommentsPost loc $ List.last list]
BDFlushCommentsPost loc (BDCols sig list) -> Just
$ BDCols sig $ List.init list ++ [BDFlushCommentsPost loc $ List.last list]
-- entry-delta floating in
BDEntryDelta dp (BDPar ind line indented) ->
Just $ BDPar ind (BDEntryDelta dp line) indented
BDEntryDelta dp (BDSeq (l : lr)) ->
Just $ BDSeq (BDEntryDelta dp l : lr)
BDEntryDelta dp (BDLines (l : lr)) ->
Just $ BDLines (BDEntryDelta dp l : lr)
BDEntryDelta dp (BDCols sig (l : lr)) ->
Just $ BDCols sig (BDEntryDelta dp l : lr)
BDEntryDelta dp (BDAddBaseY indent x) ->
Just $ BDAddBaseY indent $ BDEntryDelta dp x
BDEntryDelta dp (BDDebug s x) ->
Just $ BDDebug s $ BDEntryDelta dp x
_ -> Nothing

2
source/library/Language/Haskell/Brittany/Internal/Transformations/T4_Columns.hs
View File

@ -121,7 +121,6 @@ transformSimplifyColumns = Uniplate.rewrite $ \case
BDSeparator -> Nothing
BDAddBaseY{} -> Nothing
BDBaseYPushCur{} -> Nothing
BDBaseYPop{} -> Nothing
BDIndentLevelPushCur{} -> Nothing
BDIndentLevelPop{} -> Nothing
BDPar{} -> Nothing
@ -135,6 +134,7 @@ transformSimplifyColumns = Uniplate.rewrite $ \case
BDQueueComments{} -> Nothing
BDFlushCommentsPrior{} -> Nothing
BDFlushCommentsPost{} -> Nothing
BDEntryDelta{} -> Nothing
BDEnsureIndent{} -> Nothing
BDSetParSpacing{} -> Nothing
BDForceParSpacing{} -> Nothing

4
source/library/Language/Haskell/Brittany/Internal/WriteBriDoc/AlignmentAlgo.hs
View File

@ -398,7 +398,6 @@ briDocLineLength briDoc = flip StateS.evalState False $ rec briDoc
BDSeparator -> StateS.get >>= \b -> StateS.put True $> if b then 0 else 1
BDAddBaseY _ bd -> rec bd
BDBaseYPushCur bd -> rec bd
BDBaseYPop bd -> rec bd
BDIndentLevelPushCur bd -> rec bd
BDIndentLevelPop bd -> rec bd
BDPar _ line _ -> rec line
@ -414,6 +413,7 @@ briDocLineLength briDoc = flip StateS.evalState False $ rec briDoc
BDLines ls@(_ : _) -> do
x <- StateS.get
return $ maximum $ ls <&> \l -> StateS.evalState (rec l) x
BDEntryDelta _dp bd -> rec bd
BDLines [] -> error "briDocLineLength BDLines []"
BDEnsureIndent _ bd -> rec bd
BDSetParSpacing bd -> rec bd
@ -433,7 +433,6 @@ briDocIsMultiLine briDoc = rec briDoc
BDSeparator -> False
BDAddBaseY _ bd -> rec bd
BDBaseYPushCur bd -> rec bd
BDBaseYPop bd -> rec bd
BDIndentLevelPushCur bd -> rec bd
BDIndentLevelPop bd -> rec bd
BDPar{} -> True
@ -448,6 +447,7 @@ briDocIsMultiLine briDoc = rec briDoc
BDQueueComments _ bd -> rec bd
BDFlushCommentsPrior _ bd -> rec bd
BDFlushCommentsPost _ bd -> rec bd
BDEntryDelta _dp bd -> rec bd
BDLines (_ : _ : _) -> True
BDLines [_] -> False
BDLines [] -> error "briDocIsMultiLine BDLines []"