Reintroduce BDAnnotationKW in the form of BDEntryDelta

source/library/Language/Haskell/Brittany/Internal/Components/BriDoc.hs

@@ -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

source/library/Language/Haskell/Brittany/Internal/S3_ToBriDocTools.hs

@@ -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
+  allocateNode $ BDFBaseYPushCur bd
-  n2 <- allocateNode $ BDFBaseYPop n1
-  return n2
 
 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

source/library/Language/Haskell/Brittany/Internal/S4_WriteBriDoc.hs

@@ -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

source/library/Language/Haskell/Brittany/Internal/StepOrchestrate.hs

@@ -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

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Module.hs

@@ -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

source/library/Language/Haskell/Brittany/Internal/Transformations/T1_Alt.hs

@@ -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 }
+        mSet $ acp' { _acp_indent = _acp_indent acp }
-        return $ reWrap $ BDFBaseYPop r
+        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

source/library/Language/Haskell/Brittany/Internal/Transformations/T2_Floating.hs

@@ -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
+  descendEntryDelta = transformDownMay $ \case
-    BDBaseYPop (BDCols sig cols@(_ : _)) ->
+    -- entry delta floating in
-      Just $ BDCols sig (List.init cols ++ [BDBaseYPop (List.last cols)])
+    BDEntryDelta dp (BDPar ind line indented) ->
-    BDBaseYPop (BDDebug s x) -> Just $ BDDebug s (BDBaseYPop x)
+      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

source/library/Language/Haskell/Brittany/Internal/Transformations/T4_Columns.hs

@@ -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

source/library/Language/Haskell/Brittany/Internal/WriteBriDoc/AlignmentAlgo.hs

@@ -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 []"