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

Replace BriDoc+BriDocF with single BriDocW + type family

ghc92
Lennart Spitzner 2023-03-18 09:25:04 +00:00
parent ee2814e3a8
commit b116529005
6 changed files with 258 additions and 286 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5,6 +5,7 @@
{-# LANGUAGE KindSignatures #-} {-# LANGUAGE KindSignatures #-}
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE TypeFamilies #-}
module Language.Haskell.Brittany.Internal.Components.BriDoc where module Language.Haskell.Brittany.Internal.Components.BriDoc where
import Language.Haskell.Brittany.Internal.Prelude import Language.Haskell.Brittany.Internal.Prelude
@ -15,31 +16,48 @@ import GHC (RealSrcLoc, LEpaComment, DeltaPos)
-- isomorphic to BriDocF Identity. Provided for ease of use, as we do a lot -- historical design note
-- of transformations on `BriDocF Identity`s and it is really annoying to --
-- `Identity`/`runIdentity` everywhere. -- We previously had
data BriDoc -- data BriDocF (f :: Type -> Type) = …
-- where instead of BriDocRec we used `f (BriDocF f)`.
-- This was very close to what we have now, because:
-- BriDocW Wrapped ~ BriDocF ((,) Int)
-- BriDocW Unwrapped ~ BriDocF Identity
-- but the crucial (and annoying) difference is the existence of `Identity`
-- constructors that are required inside the `BriDocF Identity` values.
--
-- This new type-family based approach is much neater, yay!
data IsWrapped = Wrapped | Unwrapped
type family BriDocRec (w :: IsWrapped) where
BriDocRec 'Wrapped = (Int, BriDocW 'Wrapped)
BriDocRec 'Unwrapped = BriDocW 'Unwrapped
data BriDocW (w :: IsWrapped)
= -- BDWrapAnnKey AnnKey BriDoc = -- BDWrapAnnKey AnnKey BriDoc
BDEmpty BDEmpty
| BDLit !Text | BDLit !Text
| BDSeq [BriDoc] -- elements other than the last should | BDSeq [BriDocRec w] -- elements other than the last should
-- not contains BDPars. -- not contains BDPars.
| BDCols ColSig [BriDoc] -- elements other than the last | BDCols ColSig [BriDocRec w] -- elements other than the last
-- should not contains BDPars -- should not contains BDPars
| BDSeparator -- semantically, space-unless-at-end-of-line. | BDSeparator -- semantically, space-unless-at-end-of-line.
| BDAddBaseY BrIndent BriDoc | BDAddBaseY BrIndent (BriDocRec w)
| BDBaseYPushCur BriDoc | BDBaseYPushCur (BriDocRec w)
| BDIndentLevelPushCur BriDoc | BDIndentLevelPushCur (BriDocRec w)
| BDIndentLevelPop BriDoc | BDIndentLevelPop (BriDocRec w)
| BDPar | BDPar
{ _bdpar_indent :: BrIndent { _bdpar_indent :: BrIndent
, _bdpar_restOfLine :: BriDoc -- should not contain other BDPars , _bdpar_restOfLine :: BriDocRec w -- should not contain other BDPars
, _bdpar_indented :: BriDoc , _bdpar_indented :: BriDocRec w
} }
-- | BDAddIndent BrIndent (BriDocF f) -- | BDAddIndent BrIndent (BriDocRec w)
-- | BDNewline -- | BDNewline
| BDAlt [BriDoc] | BDAlt [BriDocRec w]
| BDForwardLineMode BriDoc | BDForwardLineMode (BriDocRec w)
| BDExternal -- AnnKey | BDExternal -- AnnKey
-- (Set AnnKey) -- set of annkeys contained within the node -- (Set AnnKey) -- set of annkeys contained within the node
-- -- to be printed via exactprint -- -- to be printed via exactprint
@ -47,14 +65,14 @@ data BriDoc
Text Text
| BDPlain !Text -- used for QuasiQuotes, content can be multi-line | BDPlain !Text -- used for QuasiQuotes, content can be multi-line
-- (contrast to BDLit) -- (contrast to BDLit)
| BDQueueComments [LEpaComment] BriDoc | BDQueueComments [LEpaComment] (BriDocRec w)
-- queue to be later flushed when the markers are reached -- queue to be later flushed when the markers are reached
| BDFlushCommentsPrior RealSrcLoc BriDoc | BDFlushCommentsPrior RealSrcLoc (BriDocRec w)
-- process comments before loc from the queue -- process comments before loc from the queue
| BDFlushCommentsPost RealSrcLoc BriDoc | BDFlushCommentsPost RealSrcLoc (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
| BDEntryDelta DeltaPos BriDoc | 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
-- is ignored and only the `n` of DifferentLine n _ is used. -- is ignored and only the `n` of DifferentLine n _ is used.
@ -62,77 +80,31 @@ data BriDoc
-- a particular declaration - on the top-level spacing is retained by -- a particular declaration - on the top-level spacing is retained by
-- other means. -- other means.
-- The deltas should in general derived via `obtainAnnDeltaPos`. -- The deltas should in general derived via `obtainAnnDeltaPos`.
| BDLines [BriDoc] | BDLines [(BriDocRec w)]
| BDEnsureIndent BrIndent BriDoc | BDEnsureIndent BrIndent (BriDocRec w)
-- the following constructors are only relevant for the alt transformation -- the following constructors are only relevant for the alt transformation
-- and are removed afterwards. They should never occur in any BriDoc -- and are removed afterwards. They should never occur in any (BriDocRec w)
-- after the alt transformation. -- after the alt transformation.
| BDForceMultiline BriDoc | BDForceMultiline (BriDocRec w)
| BDForceSingleline BriDoc | BDForceSingleline (BriDocRec w)
| BDNonBottomSpacing Bool BriDoc | BDNonBottomSpacing Bool (BriDocRec w)
| BDSetParSpacing BriDoc | BDSetParSpacing (BriDocRec w)
| BDForceParSpacing BriDoc | BDForceParSpacing (BriDocRec w)
-- pseudo-deprecated -- pseudo-deprecated
| BDDebug String BriDoc | BDDebug String (BriDocRec w)
deriving (Data.Data.Data, Eq, Ord)
data BriDocF f deriving instance Data.Data.Data (BriDocW 'Unwrapped)
= -- BDWrapAnnKey AnnKey BriDoc deriving instance Data.Data.Data (BriDocW 'Wrapped)
BDFEmpty
| BDFLit !Text type BriDoc = BriDocW 'Unwrapped
| BDFSeq [f (BriDocF f)] -- elements other than the last should type BriDocWrapped = BriDocW 'Wrapped
-- not contains BDPars. type BriDocNumbered = (Int, BriDocWrapped)
| BDFCols ColSig [f (BriDocF f)] -- elements other than the last
-- should not contains BDPars
| BDFSeparator -- semantically, space-unless-at-end-of-line.
| BDFAddBaseY BrIndent (f (BriDocF f))
| BDFBaseYPushCur (f (BriDocF f))
| BDFIndentLevelPushCur (f (BriDocF f))
| BDFIndentLevelPop (f (BriDocF f))
| BDFPar
{ _bdfpar_indent :: BrIndent
, _bdfpar_restOfLine :: f (BriDocF f) -- should not contain other BDPars
, _bdfpar_indented :: f (BriDocF f)
}
-- | BDAddIndent BrIndent (BriDocF f)
-- | BDNewline
| BDFAlt [f (BriDocF f)]
| BDFForwardLineMode (f (BriDocF f))
| BDFExternal -- AnnKey
-- (Set AnnKey) -- set of annkeys contained within the node
-- -- to be printed via exactprint
Bool -- should print extra comment ?
Text
| BDFPlain !Text -- used for QuasiQuotes, content can be multi-line
-- (contrast to BDLit)
| BDFQueueComments [LEpaComment] (f (BriDocF f))
-- ^ true = comments will be left in the queue when the node is left
| BDFFlushCommentsPrior RealSrcLoc (f (BriDocF f))
-- process comments before loc from the queue
| 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))
| BDFForceSingleline (f (BriDocF f))
| BDFNonBottomSpacing Bool (f (BriDocF f))
| BDFSetParSpacing (f (BriDocF f))
| BDFForceParSpacing (f (BriDocF f))
| BDFDebug String (f (BriDocF f))
data BrIndent = BrIndentNone data BrIndent = BrIndentNone
| BrIndentRegular | BrIndentRegular
| BrIndentSpecial Int | BrIndentSpecial Int
deriving (Eq, Ord, Data.Data.Data, Show) deriving (Eq, Ord, Data.Data.Data, Show)
-- deriving instance Data.Data.Data (BriDocF Identity)
deriving instance Data.Data.Data (BriDocF ((,) Int))
type BriDocFInt = BriDocF ((,) Int)
type BriDocNumbered = (Int, BriDocFInt)
instance Uniplate.Uniplate BriDoc where instance Uniplate.Uniplate BriDoc where
uniplate x@BDEmpty{} = plate x uniplate x@BDEmpty{} = plate x
uniplate x@BDLit{} = plate x uniplate x@BDLit{} = plate x
@ -204,32 +176,32 @@ 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
BDFEmpty -> BDEmpty BDEmpty -> BDEmpty
BDFLit t -> BDLit t BDLit t -> BDLit t
BDFSeq list -> BDSeq $ rec <$> list BDSeq list -> BDSeq $ rec <$> list
BDFCols sig list -> BDCols sig $ rec <$> list BDCols sig list -> BDCols sig $ rec <$> list
BDFSeparator -> BDSeparator BDSeparator -> BDSeparator
BDFAddBaseY ind bd -> BDAddBaseY ind $ rec bd BDAddBaseY ind bd -> BDAddBaseY ind $ rec bd
BDFBaseYPushCur bd -> BDBaseYPushCur $ rec bd BDBaseYPushCur bd -> BDBaseYPushCur $ rec bd
BDFIndentLevelPushCur bd -> BDIndentLevelPushCur $ rec bd BDIndentLevelPushCur bd -> BDIndentLevelPushCur $ rec bd
BDFIndentLevelPop bd -> BDIndentLevelPop $ rec bd BDIndentLevelPop bd -> BDIndentLevelPop $ rec bd
BDFPar ind line indented -> BDPar ind (rec line) (rec indented) BDPar ind line indented -> BDPar ind (rec line) (rec indented)
BDFAlt alts -> BDAlt $ rec <$> alts -- not that this will happen BDAlt alts -> BDAlt $ rec <$> alts -- not that this will happen
BDFForwardLineMode bd -> BDForwardLineMode $ rec bd BDForwardLineMode bd -> BDForwardLineMode $ rec bd
BDFExternal c t -> BDExternal c t BDExternal c t -> BDExternal c t
BDFPlain t -> BDPlain t BDPlain t -> BDPlain t
BDFQueueComments comms bd -> BDQueueComments comms $ rec bd BDQueueComments comms bd -> BDQueueComments comms $ rec bd
BDFFlushCommentsPrior loc bd -> BDFlushCommentsPrior loc $ rec bd BDFlushCommentsPrior loc bd -> BDFlushCommentsPrior loc $ rec bd
BDFFlushCommentsPost loc bd -> BDFlushCommentsPost loc $ rec bd BDFlushCommentsPost loc bd -> BDFlushCommentsPost loc $ rec bd
BDFEntryDelta dp bd -> BDEntryDelta dp $ rec bd BDEntryDelta dp bd -> BDEntryDelta dp $ rec bd
BDFLines lines -> BDLines $ rec <$> lines BDLines lines -> BDLines $ rec <$> lines
BDFEnsureIndent ind bd -> BDEnsureIndent ind $ rec bd BDEnsureIndent ind bd -> BDEnsureIndent ind $ rec bd
BDFForceMultiline bd -> BDForceMultiline $ rec bd BDForceMultiline bd -> BDForceMultiline $ rec bd
BDFForceSingleline bd -> BDForceSingleline $ rec bd BDForceSingleline bd -> BDForceSingleline $ rec bd
BDFNonBottomSpacing b bd -> BDNonBottomSpacing b $ rec bd BDNonBottomSpacing b bd -> BDNonBottomSpacing b $ rec bd
BDFSetParSpacing bd -> BDSetParSpacing $ rec bd BDSetParSpacing bd -> BDSetParSpacing $ rec bd
BDFForceParSpacing bd -> BDForceParSpacing $ rec bd BDForceParSpacing bd -> BDForceParSpacing $ rec bd
BDFDebug 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
data ColSig data ColSig

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

@ -99,7 +99,7 @@ briDocByExactInlineOnly infoStr ast = do
mAsk <&> _conf_errorHandling .> _econf_ExactPrintFallback .> confUnpack mAsk <&> _conf_errorHandling .> _econf_ExactPrintFallback .> confUnpack
let let
exactPrintNode t = exactPrintNode t =
allocateNode $ BDFExternal allocateNode $ BDExternal
-- (ExactPrint.Types.mkAnnKey ast) -- (ExactPrint.Types.mkAnnKey ast)
-- (foldedAnnKeys ast) -- (foldedAnnKeys ast)
False t False t
@ -312,7 +312,7 @@ astConnectedComments =
-- new BriDoc stuff -- new BriDoc stuff
allocateNode allocateNode
:: MonadMultiState NodeAllocIndex m => BriDocFInt -> m BriDocNumbered :: MonadMultiState NodeAllocIndex m => BriDocWrapped -> m BriDocNumbered
allocateNode bd = do allocateNode bd = do
i <- allocNodeIndex i <- allocNodeIndex
return (i, bd) return (i, bd)
@ -324,20 +324,20 @@ allocNodeIndex = do
return i return i
docEmpty :: ToBriDocM BriDocNumbered docEmpty :: ToBriDocM BriDocNumbered
docEmpty = allocateNode BDFEmpty docEmpty = allocateNode BDEmpty
docLit :: Text -> ToBriDocM BriDocNumbered docLit :: Text -> ToBriDocM BriDocNumbered
docLit t = allocateNode $ BDFLit t docLit t = allocateNode $ BDLit t
docLitS :: String -> ToBriDocM BriDocNumbered docLitS :: String -> ToBriDocM BriDocNumbered
docLitS s = allocateNode $ BDFLit $ Text.pack s docLitS s = allocateNode $ BDLit $ Text.pack s
docExt docExt
:: (ExactPrint.ExactPrint (GenLocated l ast)) :: (ExactPrint.ExactPrint (GenLocated l ast))
=> GenLocated l ast => GenLocated l ast
-> Bool -> Bool
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docExt x shouldAddComment = allocateNode $ BDFExternal docExt x shouldAddComment = allocateNode $ BDExternal
-- (ExactPrint.Types.mkAnnKey x) -- (ExactPrint.Types.mkAnnKey x)
-- (foldedAnnKeys x) -- (foldedAnnKeys x)
shouldAddComment shouldAddComment
@ -348,7 +348,7 @@ docExt x shouldAddComment = allocateNode $ BDFExternal
) )
docAlt :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered docAlt :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docAlt l = allocateNode . BDFAlt =<< sequence l docAlt l = allocateNode . BDAlt =<< sequence l
newtype CollectAltM a = CollectAltM (Writer.Writer [ToBriDocM BriDocNumbered] a) newtype CollectAltM a = CollectAltM (Writer.Writer [ToBriDocM BriDocNumbered] a)
deriving (Functor, Applicative, Monad) deriving (Functor, Applicative, Monad)
@ -365,51 +365,51 @@ runFilteredAlternative (CollectAltM action) = docAlt $ Writer.execWriter action
docSeq :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered docSeq :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docSeq [] = docEmpty docSeq [] = docEmpty
docSeq l = allocateNode . BDFSeq =<< sequence l docSeq l = allocateNode . BDSeq =<< sequence l
docLines :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered docLines :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docLines l = allocateNode . BDFLines =<< sequence l docLines l = allocateNode . BDLines =<< sequence l
docCols :: ColSig -> [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered docCols :: ColSig -> [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docCols sig l = allocateNode . BDFCols sig =<< sequence l docCols sig l = allocateNode . BDCols sig =<< sequence l
docAddBaseY :: BrIndent -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered docAddBaseY :: BrIndent -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docAddBaseY ind bdm = allocateNode . BDFAddBaseY ind =<< bdm docAddBaseY ind bdm = allocateNode . BDAddBaseY ind =<< bdm
docSetBaseY :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered docSetBaseY :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docSetBaseY bdm = do docSetBaseY bdm = do
bd <- bdm bd <- bdm
-- the order here is important so that these two nodes can be treated -- the order here is important so that these two nodes can be treated
-- properly over at `transformAlts`. -- properly over at `transformAlts`.
allocateNode $ BDFBaseYPushCur bd allocateNode $ BDBaseYPushCur bd
docSetIndentLevel :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered docSetIndentLevel :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docSetIndentLevel bdm = do docSetIndentLevel bdm = do
bd <- bdm bd <- bdm
n1 <- allocateNode $ BDFIndentLevelPushCur bd n1 <- allocateNode $ BDIndentLevelPushCur bd
n2 <- allocateNode $ BDFIndentLevelPop n1 n2 <- allocateNode $ BDIndentLevelPop n1
return n2 return n2
docSetBaseAndIndent :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered docSetBaseAndIndent :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docSetBaseAndIndent = docSetBaseY . docSetIndentLevel docSetBaseAndIndent = docSetBaseY . docSetIndentLevel
docSeparator :: ToBriDocM BriDocNumbered docSeparator :: ToBriDocM BriDocNumbered
docSeparator = allocateNode BDFSeparator docSeparator = allocateNode BDSeparator
docNonBottomSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered docNonBottomSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docNonBottomSpacing bdm = allocateNode . BDFNonBottomSpacing False =<< bdm docNonBottomSpacing bdm = allocateNode . BDNonBottomSpacing False =<< bdm
docNonBottomSpacingS :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered docNonBottomSpacingS :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docNonBottomSpacingS bdm = allocateNode . BDFNonBottomSpacing True =<< bdm docNonBottomSpacingS bdm = allocateNode . BDNonBottomSpacing True =<< bdm
docSetParSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered docSetParSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docSetParSpacing bdm = allocateNode . BDFSetParSpacing =<< bdm docSetParSpacing bdm = allocateNode . BDSetParSpacing =<< bdm
docForceParSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered docForceParSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docForceParSpacing bdm = allocateNode . BDFForceParSpacing =<< bdm docForceParSpacing bdm = allocateNode . BDForceParSpacing =<< bdm
docDebug :: String -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered docDebug :: String -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docDebug s bdm = allocateNode . BDFDebug s =<< bdm docDebug s bdm = allocateNode . BDDebug s =<< bdm
appSep :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered appSep :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
appSep x = docSeq [x, docSeparator] appSep x = docSeq [x, docSeparator]
@ -456,22 +456,22 @@ docPar
docPar lineM indentedM = do docPar lineM indentedM = do
line <- lineM line <- lineM
indented <- indentedM indented <- indentedM
allocateNode $ BDFPar BrIndentNone line indented allocateNode $ BDPar BrIndentNone line indented
docForceSingleline :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered docForceSingleline :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docForceSingleline bdm = allocateNode . BDFForceSingleline =<< bdm docForceSingleline bdm = allocateNode . BDForceSingleline =<< bdm
docForceMultiline :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered docForceMultiline :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docForceMultiline bdm = allocateNode . BDFForceMultiline =<< bdm docForceMultiline bdm = allocateNode . BDForceMultiline =<< bdm
docEnsureIndent docEnsureIndent
:: BrIndent -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered :: BrIndent -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docEnsureIndent ind mbd = mbd >>= \bd -> allocateNode $ BDFEnsureIndent ind bd docEnsureIndent ind mbd = mbd >>= \bd -> allocateNode $ BDEnsureIndent ind bd
docAddEntryDelta :: GHC.DeltaPos -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered docAddEntryDelta :: GHC.DeltaPos -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docAddEntryDelta dp bdm = do docAddEntryDelta dp bdm = do
bd <- bdm bd <- bdm
allocateNode (BDFEntryDelta dp bd) allocateNode (BDEntryDelta dp bd)
docFlushRemaining :: FastString -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered docFlushRemaining :: FastString -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docFlushRemaining fileThing = docFlushCommsPost docFlushRemaining fileThing = docFlushCommsPost
@ -486,7 +486,7 @@ instance DocHandleComms [LEpaComment] (ToBriDocM BriDocNumbered) where
docHandleComms comms bdm = do docHandleComms comms bdm = do
bd <- bdm bd <- bdm
i1 <- allocNodeIndex i1 <- allocNodeIndex
pure (i1, BDFQueueComments comms bd) pure (i1, BDQueueComments comms bd)
instance DocHandleComms (EpAnn a) (ToBriDocM BriDocNumbered) where instance DocHandleComms (EpAnn a) (ToBriDocM BriDocNumbered) where
docHandleComms epAnn bdm = case epAnn of docHandleComms epAnn bdm = case epAnn of
@ -494,15 +494,15 @@ instance DocHandleComms (EpAnn a) (ToBriDocM BriDocNumbered) where
bd <- bdm bd <- bdm
i1 <- allocNodeIndex i1 <- allocNodeIndex
pure pure
(i1, BDFFlushCommentsPrior (GHC.realSrcSpanStart $ GHC.anchor anch) bd) (i1, BDFlushCommentsPrior (GHC.realSrcSpanStart $ GHC.anchor anch) bd)
EpAnn anch _ (EpaComments comms) -> do EpAnn anch _ (EpaComments comms) -> do
bd <- bdm bd <- bdm
i1 <- allocNodeIndex i1 <- allocNodeIndex
i2 <- allocNodeIndex i2 <- allocNodeIndex
pure pure
( i1 ( i1
, BDFFlushCommentsPrior (GHC.realSrcSpanStart $ GHC.anchor anch) , BDFlushCommentsPrior (GHC.realSrcSpanStart $ GHC.anchor anch)
(i2, BDFQueueComments (reverse comms) bd) (i2, BDQueueComments (reverse comms) bd)
) )
EpAnn anch _ (EpaCommentsBalanced commsB commsA) -> do EpAnn anch _ (EpaCommentsBalanced commsB commsA) -> do
bd <- bdm bd <- bdm
@ -510,10 +510,10 @@ instance DocHandleComms (EpAnn a) (ToBriDocM BriDocNumbered) where
i2 <- allocNodeIndex i2 <- allocNodeIndex
pure pure
( i1 ( i1
, BDFQueueComments , BDQueueComments
(reverse commsB ++ reverse commsA) (reverse commsB ++ reverse commsA)
( i2 ( i2
, BDFFlushCommentsPrior (GHC.realSrcSpanStart $ GHC.anchor anch) bd , BDFlushCommentsPrior (GHC.realSrcSpanStart $ GHC.anchor anch) bd
) )
) )
EpAnnNotUsed -> bdm EpAnnNotUsed -> bdm
@ -525,7 +525,7 @@ instance DocHandleComms (GHC.RealSrcLoc) (ToBriDocM BriDocNumbered) where
docHandleComms loc bdm = do docHandleComms loc bdm = do
bd <- bdm bd <- bdm
i1 <- allocNodeIndex i1 <- allocNodeIndex
pure (i1, BDFFlushCommentsPrior loc bd) pure (i1, BDFlushCommentsPrior loc bd)
instance DocHandleComms (Maybe GHC.RealSrcSpan) (ToBriDocM BriDocNumbered) where instance DocHandleComms (Maybe GHC.RealSrcSpan) (ToBriDocM BriDocNumbered) where
docHandleComms Nothing bdm = bdm docHandleComms Nothing bdm = bdm
@ -680,7 +680,7 @@ instance DocFlushCommsPost (ToBriDocM BriDocNumbered) where
Just span -> \bdm -> do Just span -> \bdm -> do
i1 <- allocNodeIndex i1 <- allocNodeIndex
bd <- bdm bd <- bdm
pure (i1, BDFFlushCommentsPost span bd) pure (i1, BDFlushCommentsPost span bd)
instance DocFlushCommsPost (ToBriDocM [BriDocNumbered]) where instance DocFlushCommsPost (ToBriDocM [BriDocNumbered]) where
docFlushCommsPost loc bdm = do docFlushCommsPost loc bdm = do

2
source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs
View File

@ -906,7 +906,7 @@ layoutClsInst (L declLoc _) cid = do
:: [ToBriDocM (Located BriDocNumbered)] -> ToBriDocM BriDocNumbered :: [ToBriDocM (Located BriDocNumbered)] -> ToBriDocM BriDocNumbered
docSortedLines l = docSortedLines l =
allocateNode allocateNode
. BDFLines . BDLines
. fmap unLoc . fmap unLoc
. List.sortOn (ExactPrint.rs . getLoc) . List.sortOn (ExactPrint.rs . getLoc)
=<< sequence l =<< sequence l

38
source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs
View File

@ -991,7 +991,7 @@ layoutExpr lexpr@(L _ expr) = do
-- TODO -- TODO
briDocByExactInlineOnly "HsTcBracketOut{}" lexpr briDocByExactInlineOnly "HsTcBracketOut{}" lexpr
HsSpliceE _ (HsQuasiQuote _ _ quoter _loc content) -> do HsSpliceE _ (HsQuasiQuote _ _ quoter _loc content) -> do
allocateNode $ BDFPlain allocateNode $ BDPlain
(Text.pack (Text.pack
$ "[" $ "["
++ showOutputable quoter ++ showOutputable quoter
@ -1197,26 +1197,26 @@ recordExpression dotdot wrapO wrapDD wrapC indentPolicy _lexpr nameDoc nameLayou
in fieldLines ++ [dotdotLine, lineN] in fieldLines ++ [dotdotLine, lineN]
) )
litBriDoc :: HsLit GhcPs -> BriDocFInt litBriDoc :: HsLit GhcPs -> BriDocWrapped
litBriDoc = \case litBriDoc = \case
HsChar (SourceText t) _c -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\''] HsChar (SourceText t) _c -> BDLit $ Text.pack t -- BDLit $ Text.pack $ ['\'', c, '\'']
HsCharPrim (SourceText t) _c -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\''] HsCharPrim (SourceText t) _c -> BDLit $ Text.pack t -- BDLit $ Text.pack $ ['\'', c, '\'']
HsString (SourceText t) _fastString -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ FastString.unpackFS fastString HsString (SourceText t) _fastString -> BDLit $ Text.pack t -- BDLit $ Text.pack $ FastString.unpackFS fastString
HsStringPrim (SourceText t) _byteString -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ Data.ByteString.Char8.unpack byteString HsStringPrim (SourceText t) _byteString -> BDLit $ Text.pack t -- BDLit $ Text.pack $ Data.ByteString.Char8.unpack byteString
HsInt _ (IL (SourceText t) _ _) -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i HsInt _ (IL (SourceText t) _ _) -> BDLit $ Text.pack t -- BDLit $ Text.pack $ show i
HsIntPrim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i HsIntPrim (SourceText t) _i -> BDLit $ Text.pack t -- BDLit $ Text.pack $ show i
HsWordPrim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i HsWordPrim (SourceText t) _i -> BDLit $ Text.pack t -- BDLit $ Text.pack $ show i
HsInt64Prim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i HsInt64Prim (SourceText t) _i -> BDLit $ Text.pack t -- BDLit $ Text.pack $ show i
HsWord64Prim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i HsWord64Prim (SourceText t) _i -> BDLit $ Text.pack t -- BDLit $ Text.pack $ show i
HsInteger (SourceText t) _i _type -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i HsInteger (SourceText t) _i _type -> BDLit $ Text.pack t -- BDLit $ Text.pack $ show i
HsRat _ (FL (SourceText t) _ _ _ _) _type -> BDFLit $ Text.pack t HsRat _ (FL (SourceText t) _ _ _ _) _type -> BDLit $ Text.pack t
HsFloatPrim _ (FL (SourceText t) _ _ _ _) -> BDFLit $ Text.pack t HsFloatPrim _ (FL (SourceText t) _ _ _ _) -> BDLit $ Text.pack t
HsDoublePrim _ (FL (SourceText t) _ _ _ _) -> BDFLit $ Text.pack t HsDoublePrim _ (FL (SourceText t) _ _ _ _) -> BDLit $ Text.pack t
_ -> error "litBriDoc: literal with no SourceText" _ -> error "litBriDoc: literal with no SourceText"
overLitValBriDoc :: OverLitVal -> BriDocFInt overLitValBriDoc :: OverLitVal -> BriDocWrapped
overLitValBriDoc = \case overLitValBriDoc = \case
HsIntegral (IL (SourceText t) _ _) -> BDFLit $ Text.pack t HsIntegral (IL (SourceText t) _ _) -> BDLit $ Text.pack t
HsFractional (FL (SourceText t) _ _ _ _) -> BDFLit $ Text.pack t HsFractional (FL (SourceText t) _ _ _ _) -> BDLit $ Text.pack t
HsIsString (SourceText t) _ -> BDFLit $ Text.pack t HsIsString (SourceText t) _ -> BDLit $ Text.pack t
_ -> error "overLitValBriDoc: literal with no SourceText" _ -> error "overLitValBriDoc: literal with no SourceText"

4
source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs-boot
View File

@ -10,6 +10,6 @@ import Language.Haskell.Brittany.Internal.Components.BriDoc
layoutExpr :: ToBriDoc HsExpr layoutExpr :: ToBriDoc HsExpr
litBriDoc :: HsLit GhcPs -> BriDocFInt litBriDoc :: HsLit GhcPs -> BriDocWrapped
overLitValBriDoc :: OverLitVal -> BriDocFInt overLitValBriDoc :: OverLitVal -> BriDocWrapped

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

@ -116,28 +116,28 @@ transformAlts =
-- go = Memo.memo $ \bdX -> do -- go = Memo.memo $ \bdX -> do
-- i <- lift $ incGet -- i <- lift $ incGet
-- fmap (\bd' -> (i,bd')) $ case bdX of -- fmap (\bd' -> (i,bd')) $ case bdX of
-- BDEmpty -> return $ BDFEmpty -- BDEmpty -> return $ BDEmpty
-- BDLit t -> return $ BDFLit t -- BDLit t -> return $ BDLit t
-- BDSeq list -> BDFSeq <$> go `mapM` list -- BDSeq list -> BDSeq <$> go `mapM` list
-- BDCols sig list -> BDFCols sig <$> go `mapM` list -- BDCols sig list -> BDCols sig <$> go `mapM` list
-- BDSeparator -> return $ BDFSeparator -- BDSeparator -> return $ BDSeparator
-- BDAddBaseY ind bd -> BDFAddBaseY ind <$> go bd -- BDAddBaseY ind bd -> BDAddBaseY ind <$> go bd
-- BDSetBaseY bd -> BDFSetBaseY <$> go bd -- BDSetBaseY bd -> BDSetBaseY <$> go bd
-- BDSetIndentLevel bd -> BDFSetIndentLevel <$> go bd -- BDSetIndentLevel bd -> BDSetIndentLevel <$> go bd
-- BDPar ind line indented -> [ BDFPar ind line' indented' -- BDPar ind line indented -> [ BDPar ind line' indented'
-- | line' <- go line -- | line' <- go line
-- , indented' <- go indented -- , indented' <- go indented
-- ] -- ]
-- BDAlt alts -> BDFAlt <$> go `mapM` alts -- not that this will happen -- BDAlt alts -> BDAlt <$> go `mapM` alts -- not that this will happen
-- BDForceMultiline bd -> BDFForceMultiline <$> go bd -- BDForceMultiline bd -> BDForceMultiline <$> go bd
-- BDForceSingleline bd -> BDFForceSingleline <$> go bd -- BDForceSingleline bd -> BDForceSingleline <$> go bd
-- BDForwardLineMode bd -> BDFForwardLineMode <$> go bd -- BDForwardLineMode bd -> BDForwardLineMode <$> go bd
-- BDExternal k ks c t -> return $ BDFExternal k ks c t -- BDExternal k ks c t -> return $ BDExternal k ks c t
-- BDAnnotationPrior annKey bd -> BDFAnnotationPrior annKey <$> go bd -- BDAnnotationPrior annKey bd -> BDAnnotationPrior annKey <$> go bd
-- BDAnnotationPost annKey bd -> BDFAnnotationPost annKey <$> go bd -- BDAnnotationPost annKey bd -> BDAnnotationPost annKey <$> go bd
-- BDLines lines -> BDFLines <$> go `mapM` lines -- BDLines lines -> BDLines <$> go `mapM` lines
-- BDEnsureIndent ind bd -> BDFEnsureIndent ind <$> go bd -- BDEnsureIndent ind bd -> BDEnsureIndent ind <$> go bd
-- BDProhibitMTEL bd -> BDFProhibitMTEL <$> go bd -- BDProhibitMTEL bd -> BDProhibitMTEL <$> go bd
@ -156,12 +156,12 @@ transformAlts =
-- acp <- mGet -- acp <- mGet
-- mSet $ acp { _acp_forceMLFlag = altLineModeDecay $ _acp_forceMLFlag acp } -- mSet $ acp { _acp_forceMLFlag = altLineModeDecay $ _acp_forceMLFlag acp }
-- BDWrapAnnKey annKey <$> rec bd -- BDWrapAnnKey annKey <$> rec bd
BDFEmpty{} -> processSpacingSimple bdX $> bdX BDEmpty{} -> processSpacingSimple bdX $> bdX
BDFLit{} -> processSpacingSimple bdX $> bdX BDLit{} -> processSpacingSimple bdX $> bdX
BDFSeq list -> reWrap . BDFSeq <$> list `forM` rec BDSeq list -> reWrap . BDSeq <$> list `forM` rec
BDFCols sig list -> reWrap . BDFCols sig <$> list `forM` rec BDCols sig list -> reWrap . BDCols sig <$> list `forM` rec
BDFSeparator -> processSpacingSimple bdX $> bdX BDSeparator -> processSpacingSimple bdX $> bdX
BDFAddBaseY indent bd -> do BDAddBaseY indent bd -> do
acp <- mGet acp <- mGet
indAdd <- fixIndentationForMultiple acp indent indAdd <- fixIndentationForMultiple acp indent
mSet $ acp { _acp_indentPrep = max (_acp_indentPrep acp) indAdd } mSet $ acp { _acp_indentPrep = max (_acp_indentPrep acp) indAdd }
@ -170,22 +170,22 @@ transformAlts =
mSet $ acp' { _acp_indent = _acp_indent acp } mSet $ acp' { _acp_indent = _acp_indent acp }
return $ case indent of return $ case indent of
BrIndentNone -> r BrIndentNone -> r
BrIndentRegular -> reWrap $ BDFAddBaseY (BrIndentSpecial indAdd) r BrIndentRegular -> reWrap $ BDAddBaseY (BrIndentSpecial indAdd) r
BrIndentSpecial i -> reWrap $ BDFAddBaseY (BrIndentSpecial i) r BrIndentSpecial i -> reWrap $ BDAddBaseY (BrIndentSpecial i) r
BDFBaseYPushCur bd -> do BDBaseYPushCur bd -> do
acp <- mGet acp <- mGet
mSet $ acp { _acp_indent = _acp_line acp } mSet $ acp { _acp_indent = _acp_line acp }
r <- rec bd r <- rec bd
acp' <- mGet acp' <- mGet
mSet $ acp' { _acp_indent = _acp_indent acp } mSet $ acp' { _acp_indent = _acp_indent acp }
return $ reWrap $ BDFBaseYPushCur r return $ reWrap $ BDBaseYPushCur r
BDFEntryDelta dp bd -> do BDEntryDelta dp bd -> do
return $ reWrap $ BDFEntryDelta dp bd return $ reWrap $ BDEntryDelta dp bd
BDFIndentLevelPushCur bd -> do BDIndentLevelPushCur bd -> do
reWrap . BDFIndentLevelPushCur <$> rec bd reWrap . BDIndentLevelPushCur <$> rec bd
BDFIndentLevelPop bd -> do BDIndentLevelPop bd -> do
reWrap . BDFIndentLevelPop <$> rec bd reWrap . BDIndentLevelPop <$> rec bd
BDFPar indent sameLine indented -> do BDPar indent sameLine indented -> do
indAmount <- indAmount <-
mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
let let
@ -199,12 +199,12 @@ transformAlts =
sameLine' <- rec sameLine sameLine' <- rec sameLine
mModify $ \acp' -> acp' { _acp_line = ind, _acp_indent = ind } mModify $ \acp' -> acp' { _acp_line = ind, _acp_indent = ind }
indented' <- rec indented indented' <- rec indented
return $ reWrap $ BDFPar indent sameLine' indented' return $ reWrap $ BDPar indent sameLine' indented'
BDFAlt [] -> error "empty BDAlt" -- returning BDEmpty instead is a BDAlt [] -> error "empty BDAlt" -- returning BDEmpty instead is a
-- possibility, but i will prefer a -- possibility, but i will prefer a
-- fail-early approach; BDEmpty does not -- fail-early approach; BDEmpty does not
-- make sense semantically for Alt[]. -- make sense semantically for Alt[].
BDFAlt alts -> do BDAlt alts -> do
altChooser <- mAsk <&> _conf_layout .> _lconfig_altChooser .> confUnpack altChooser <- mAsk <&> _conf_layout .> _lconfig_altChooser .> confUnpack
case altChooser of case altChooser of
AltChooserSimpleQuick -> do AltChooserSimpleQuick -> do
@ -263,7 +263,7 @@ transformAlts =
$ fromMaybe (-- trace ("choosing last") $ $ fromMaybe (-- trace ("choosing last") $
List.last alts) List.last alts)
$ Data.List.Extra.firstJust (fmap snd) checkedOptions $ Data.List.Extra.firstJust (fmap snd) checkedOptions
BDFForceMultiline bd -> do BDForceMultiline bd -> do
acp <- mGet acp <- mGet
x <- do x <- do
mSet $ mergeLineMode acp (AltLineModeStateForceML False) mSet $ mergeLineMode acp (AltLineModeStateForceML False)
@ -271,7 +271,7 @@ transformAlts =
acp' <- mGet acp' <- mGet
mSet $ acp' { _acp_forceMLFlag = _acp_forceMLFlag acp } mSet $ acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }
return $ x return $ x
BDFForceSingleline bd -> do BDForceSingleline bd -> do
acp <- mGet acp <- mGet
x <- do x <- do
mSet $ mergeLineMode acp AltLineModeStateForceSL mSet $ mergeLineMode acp AltLineModeStateForceSL
@ -279,7 +279,7 @@ transformAlts =
acp' <- mGet acp' <- mGet
mSet $ acp' { _acp_forceMLFlag = _acp_forceMLFlag acp } mSet $ acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }
return $ x return $ x
BDFForwardLineMode bd -> do BDForwardLineMode bd -> do
acp <- mGet acp <- mGet
x <- do x <- do
mSet $ acp mSet $ acp
@ -289,29 +289,29 @@ transformAlts =
acp' <- mGet acp' <- mGet
mSet $ acp' { _acp_forceMLFlag = _acp_forceMLFlag acp } mSet $ acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }
return $ x return $ x
BDFExternal{} -> processSpacingSimple bdX $> bdX BDExternal{} -> processSpacingSimple bdX $> bdX
BDFPlain{} -> processSpacingSimple bdX $> bdX BDPlain{} -> processSpacingSimple bdX $> bdX
BDFQueueComments comms bd -> BDQueueComments comms bd ->
reWrap . BDFQueueComments comms <$> rec bd reWrap . BDQueueComments comms <$> rec bd
BDFFlushCommentsPrior loc bd -> BDFlushCommentsPrior loc bd ->
-- TODO92 for AnnotationPrior we had this here: -- TODO92 for AnnotationPrior we had this here:
-- > acp <- mGet -- > acp <- mGet
-- > mSet -- > mSet
-- > $ acp { _acp_forceMLFlag = altLineModeDecay $ _acp_forceMLFlag acp } -- > $ acp { _acp_forceMLFlag = altLineModeDecay $ _acp_forceMLFlag acp }
-- > 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 . BDFFlushCommentsPrior loc <$> rec bd reWrap . BDFlushCommentsPrior loc <$> rec bd
BDFFlushCommentsPost loc bd -> BDFlushCommentsPost loc bd ->
reWrap . BDFFlushCommentsPost loc <$> rec bd reWrap . BDFlushCommentsPost loc <$> rec bd
BDFLines [] -> return $ reWrap BDFEmpty -- evil transformation. or harmless. BDLines [] -> return $ reWrap BDEmpty -- evil transformation. or harmless.
BDFLines (l : lr) -> do BDLines (l : lr) -> do
ind <- _acp_indent <$> mGet ind <- _acp_indent <$> mGet
l' <- rec l l' <- rec l
lr' <- lr `forM` \x -> do lr' <- lr `forM` \x -> do
mModify $ \acp -> acp { _acp_line = ind, _acp_indent = ind } mModify $ \acp -> acp { _acp_line = ind, _acp_indent = ind }
rec x rec x
return $ reWrap $ BDFLines (l' : lr') return $ reWrap $ BDLines (l' : lr')
BDFEnsureIndent indent bd -> do BDEnsureIndent indent bd -> do
acp <- mGet acp <- mGet
indAdd <- fixIndentationForMultiple acp indent indAdd <- fixIndentationForMultiple acp indent
mSet $ acp mSet $ acp
@ -320,7 +320,7 @@ transformAlts =
, _acp_indent = _acp_indent acp + indAdd , _acp_indent = _acp_indent acp + indAdd
, _acp_line = max (_acp_line acp) (_acp_indent acp + indAdd) , _acp_line = max (_acp_line acp) (_acp_indent acp + indAdd)
-- we cannot use just _acp_line acp + indAdd because of the case -- we cannot use just _acp_line acp + indAdd because of the case
-- where there are multiple BDFEnsureIndents in the same line. -- where there are multiple BDEnsureIndents in the same line.
-- Then, the actual indentation is relative to the current -- Then, the actual indentation is relative to the current
-- indentation, not the current cursor position. -- indentation, not the current cursor position.
} }
@ -330,21 +330,21 @@ transformAlts =
return $ case indent of return $ case indent of
BrIndentNone -> r BrIndentNone -> r
BrIndentRegular -> BrIndentRegular ->
reWrap $ BDFEnsureIndent (BrIndentSpecial indAdd) r reWrap $ BDEnsureIndent (BrIndentSpecial indAdd) r
BrIndentSpecial i -> reWrap $ BDFEnsureIndent (BrIndentSpecial i) r BrIndentSpecial i -> reWrap $ BDEnsureIndent (BrIndentSpecial i) r
BDFNonBottomSpacing _ bd -> rec bd BDNonBottomSpacing _ bd -> rec bd
BDFSetParSpacing bd -> rec bd BDSetParSpacing bd -> rec bd
BDFForceParSpacing bd -> rec bd BDForceParSpacing bd -> rec bd
BDFDebug s bd -> do BDDebug s bd -> do
acp :: AltCurPos <- mGet acp :: AltCurPos <- mGet
tellDebugMess tellDebugMess
$ "transformAlts: BDFDEBUG " $ "transformAlts: BDDEBUG "
++ s ++ s
++ " (node-id=" ++ " (node-id="
++ show brDcId ++ show brDcId
++ "): acp=" ++ "): acp="
++ show acp ++ show acp
reWrap . BDFDebug s <$> rec bd reWrap . BDDebug s <$> rec bd
processSpacingSimple processSpacingSimple
:: ( MonadMultiReader Config m :: ( MonadMultiReader Config m
, MonadMultiState AltCurPos m , MonadMultiState AltCurPos m
@ -391,17 +391,17 @@ getSpacing !bridoc = rec bridoc
let colMax = config & _conf_layout & _lconfig_cols & confUnpack let colMax = config & _conf_layout & _lconfig_cols & confUnpack
result <- case brDc of result <- case brDc of
-- BDWrapAnnKey _annKey bd -> rec bd -- BDWrapAnnKey _annKey bd -> rec bd
BDFEmpty -> BDEmpty ->
return $ LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False return $ LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False
BDFLit t -> return $ LineModeValid $ VerticalSpacing BDLit t -> return $ LineModeValid $ VerticalSpacing
(Text.length t) (Text.length t)
VerticalSpacingParNone VerticalSpacingParNone
False False
BDFSeq list -> sumVs <$> rec `mapM` list BDSeq list -> sumVs <$> rec `mapM` list
BDFCols _sig list -> sumVs <$> rec `mapM` list BDCols _sig list -> sumVs <$> rec `mapM` list
BDFSeparator -> BDSeparator ->
return $ LineModeValid $ VerticalSpacing 1 VerticalSpacingParNone False return $ LineModeValid $ VerticalSpacing 1 VerticalSpacingParNone False
BDFAddBaseY indent bd -> do BDAddBaseY indent bd -> do
mVs <- rec bd mVs <- rec bd
return $ mVs <&> \vs -> vs return $ mVs <&> \vs -> vs
{ _vs_paragraph = case _vs_paragraph vs of { _vs_paragraph = case _vs_paragraph vs of
@ -423,7 +423,7 @@ getSpacing !bridoc = rec bridoc
i + (confUnpack $ _lconfig_indentAmount $ _conf_layout $ config) i + (confUnpack $ _lconfig_indentAmount $ _conf_layout $ config)
BrIndentSpecial j -> i + j BrIndentSpecial j -> i + j
} }
BDFBaseYPushCur bd -> do BDBaseYPushCur bd -> do
mVs <- rec bd mVs <- rec bd
return $ mVs <&> \vs -> vs return $ mVs <&> \vs -> vs
-- We leave par as-is, even though it technically is not -- We leave par as-is, even though it technically is not
@ -440,9 +440,9 @@ getSpacing !bridoc = rec bridoc
) )
, _vs_paragraph = VerticalSpacingParSome 0 , _vs_paragraph = VerticalSpacingParSome 0
} }
BDFIndentLevelPushCur bd -> rec bd BDIndentLevelPushCur bd -> rec bd
BDFIndentLevelPop bd -> rec bd BDIndentLevelPop bd -> rec bd
BDFPar BrIndentNone sameLine indented -> do BDPar BrIndentNone sameLine indented -> do
mVs <- rec sameLine mVs <- rec sameLine
mIndSp <- rec indented mIndSp <- rec indented
return return
@ -465,33 +465,33 @@ getSpacing !bridoc = rec bridoc
== VerticalSpacingParNone == VerticalSpacingParNone
&& _vs_parFlag indSp && _vs_parFlag indSp
] ]
BDFPar{} -> error "BDPar with indent in getSpacing" BDPar{} -> error "BDPar with indent in getSpacing"
BDFAlt [] -> error "empty BDAlt" BDAlt [] -> error "empty BDAlt"
BDFAlt (alt : _) -> rec alt BDAlt (alt : _) -> rec alt
BDFForceMultiline bd -> do BDForceMultiline bd -> do
mVs <- rec bd mVs <- rec bd
return $ mVs >>= _vs_paragraph .> \case return $ mVs >>= _vs_paragraph .> \case
VerticalSpacingParNone -> LineModeInvalid VerticalSpacingParNone -> LineModeInvalid
_ -> mVs _ -> mVs
BDFForceSingleline bd -> do BDForceSingleline bd -> do
mVs <- rec bd mVs <- rec bd
return $ mVs >>= _vs_paragraph .> \case return $ mVs >>= _vs_paragraph .> \case
VerticalSpacingParNone -> mVs VerticalSpacingParNone -> mVs
_ -> LineModeInvalid _ -> LineModeInvalid
BDFForwardLineMode bd -> rec bd BDForwardLineMode bd -> rec bd
BDFExternal _ txt -> return $ LineModeValid $ case Text.lines txt of BDExternal _ txt -> return $ LineModeValid $ case Text.lines txt of
[t] -> VerticalSpacing (Text.length t) VerticalSpacingParNone False [t] -> VerticalSpacing (Text.length t) VerticalSpacingParNone False
_ -> VerticalSpacing 999 VerticalSpacingParNone False _ -> VerticalSpacing 999 VerticalSpacingParNone False
BDFPlain txt -> return $ LineModeValid $ case Text.lines txt of BDPlain txt -> return $ LineModeValid $ case Text.lines txt of
[t] -> VerticalSpacing (Text.length t) VerticalSpacingParNone False [t] -> VerticalSpacing (Text.length t) VerticalSpacingParNone False
_ -> VerticalSpacing 999 VerticalSpacingParNone False _ -> VerticalSpacing 999 VerticalSpacingParNone False
BDFQueueComments _comms bd -> rec bd BDQueueComments _comms bd -> rec bd
BDFFlushCommentsPrior _loc bd -> rec bd BDFlushCommentsPrior _loc bd -> rec bd
BDFFlushCommentsPost _loc bd -> rec bd BDFlushCommentsPost _loc bd -> rec bd
BDFEntryDelta _dp bd -> rec bd BDEntryDelta _dp bd -> rec bd
BDFLines [] -> BDLines [] ->
return $ LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False return $ LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False
BDFLines (l1 : lR) -> do BDLines (l1 : lR) -> do
mVs <- rec l1 mVs <- rec l1
mVRs <- rec `mapM` lR mVRs <- rec `mapM` lR
let lSps = mVs : mVRs let lSps = mVs : mVRs
@ -500,7 +500,7 @@ getSpacing !bridoc = rec bridoc
| VerticalSpacing lsp _ _ <- mVs | VerticalSpacing lsp _ _ <- mVs
, lineMax <- getMaxVS $ maxVs $ lSps , lineMax <- getMaxVS $ maxVs $ lSps
] ]
BDFEnsureIndent indent bd -> do BDEnsureIndent indent bd -> do
mVs <- rec bd mVs <- rec bd
let let
addInd = case indent of addInd = case indent of
@ -510,7 +510,7 @@ getSpacing !bridoc = rec bridoc
BrIndentSpecial i -> i BrIndentSpecial i -> i
return $ mVs <&> \(VerticalSpacing lsp psp pf) -> return $ mVs <&> \(VerticalSpacing lsp psp pf) ->
VerticalSpacing (lsp + addInd) psp pf VerticalSpacing (lsp + addInd) psp pf
BDFNonBottomSpacing b bd -> do BDNonBottomSpacing b bd -> do
mVs <- rec bd mVs <- rec bd
return $ mVs <|> LineModeValid return $ mVs <|> LineModeValid
(VerticalSpacing (VerticalSpacing
@ -521,20 +521,20 @@ getSpacing !bridoc = rec bridoc
) )
False False
) )
BDFSetParSpacing bd -> do BDSetParSpacing bd -> do
mVs <- rec bd mVs <- rec bd
return $ mVs <&> \vs -> vs { _vs_parFlag = True } return $ mVs <&> \vs -> vs { _vs_parFlag = True }
BDFForceParSpacing bd -> do BDForceParSpacing bd -> do
mVs <- rec bd mVs <- rec bd
return return
$ [ vs $ [ vs
| vs <- mVs | vs <- mVs
, _vs_parFlag vs || _vs_paragraph vs == VerticalSpacingParNone , _vs_parFlag vs || _vs_paragraph vs == VerticalSpacingParNone
] ]
BDFDebug s bd -> do BDDebug s bd -> do
r <- rec bd r <- rec bd
tellDebugMess tellDebugMess
$ "getSpacing: BDFDebug " $ "getSpacing: BDDebug "
++ show s ++ show s
++ " (node-id=" ++ " (node-id="
++ show brDcId ++ show brDcId
@ -690,13 +690,13 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
. preFilterLimit . preFilterLimit
result <- case brdc of result <- case brdc of
-- BDWrapAnnKey _annKey bd -> rec bd -- BDWrapAnnKey _annKey bd -> rec bd
BDFEmpty -> return $ [VerticalSpacing 0 VerticalSpacingParNone False] BDEmpty -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]
BDFLit t -> BDLit t ->
return $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False] return $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False]
BDFSeq list -> fmap sumVs . mapM filterAndLimit <$> rec `mapM` list BDSeq list -> fmap sumVs . mapM filterAndLimit <$> rec `mapM` list
BDFCols _sig list -> fmap sumVs . mapM filterAndLimit <$> rec `mapM` list BDCols _sig list -> fmap sumVs . mapM filterAndLimit <$> rec `mapM` list
BDFSeparator -> return $ [VerticalSpacing 1 VerticalSpacingParNone False] BDSeparator -> return $ [VerticalSpacing 1 VerticalSpacingParNone False]
BDFAddBaseY indent bd -> do BDAddBaseY indent bd -> do
mVs <- rec bd mVs <- rec bd
return $ mVs <&> \vs -> vs return $ mVs <&> \vs -> vs
{ _vs_paragraph = case _vs_paragraph vs of { _vs_paragraph = case _vs_paragraph vs of
@ -718,7 +718,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
i + (confUnpack $ _lconfig_indentAmount $ _conf_layout $ config) i + (confUnpack $ _lconfig_indentAmount $ _conf_layout $ config)
BrIndentSpecial j -> i + j BrIndentSpecial j -> i + j
} }
BDFBaseYPushCur bd -> do BDBaseYPushCur bd -> do
mVs <- rec bd mVs <- rec bd
return $ mVs <&> \vs -> vs return $ mVs <&> \vs -> vs
-- We leave par as-is, even though it technically is not -- We leave par as-is, even though it technically is not
@ -738,9 +738,9 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
VerticalSpacingParSome i -> VerticalSpacingParSome i VerticalSpacingParSome i -> VerticalSpacingParSome i
VerticalSpacingParAlways i -> VerticalSpacingParAlways i VerticalSpacingParAlways i -> VerticalSpacingParAlways i
} }
BDFIndentLevelPushCur bd -> rec bd BDIndentLevelPushCur bd -> rec bd
BDFIndentLevelPop bd -> rec bd BDIndentLevelPop bd -> rec bd
BDFPar BrIndentNone sameLine indented -> do BDPar BrIndentNone sameLine indented -> do
mVss <- filterAndLimit <$> rec sameLine mVss <- filterAndLimit <$> rec sameLine
indSps <- filterAndLimit <$> rec indented indSps <- filterAndLimit <$> rec indented
let mVsIndSp = take limit $ [ (x, y) | x <- mVss, y <- indSps ] let mVsIndSp = take limit $ [ (x, y) | x <- mVss, y <- indSps ]
@ -761,24 +761,24 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
&& _vs_parFlag indSp && _vs_parFlag indSp
) )
BDFPar{} -> error "BDPar with indent in getSpacing" BDPar{} -> error "BDPar with indent in getSpacing"
BDFAlt [] -> error "empty BDAlt" BDAlt [] -> error "empty BDAlt"
-- BDAlt (alt:_) -> rec alt -- BDAlt (alt:_) -> rec alt
BDFAlt alts -> do BDAlt alts -> do
r <- rec `mapM` alts r <- rec `mapM` alts
return $ filterAndLimit =<< r return $ filterAndLimit =<< r
BDFForceMultiline bd -> do BDForceMultiline bd -> do
mVs <- filterAndLimit <$> rec bd mVs <- filterAndLimit <$> rec bd
return $ filter ((/= VerticalSpacingParNone) . _vs_paragraph) mVs return $ filter ((/= VerticalSpacingParNone) . _vs_paragraph) mVs
BDFForceSingleline bd -> do BDForceSingleline bd -> do
mVs <- filterAndLimit <$> rec bd mVs <- filterAndLimit <$> rec bd
return $ filter ((== VerticalSpacingParNone) . _vs_paragraph) mVs return $ filter ((== VerticalSpacingParNone) . _vs_paragraph) mVs
BDFForwardLineMode bd -> rec bd BDForwardLineMode bd -> rec bd
BDFExternal _ txt | [t] <- Text.lines txt -> BDExternal _ txt | [t] <- Text.lines txt ->
return $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False] return $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False]
BDFExternal{} -> return $ [] -- yes, we just assume that we cannot properly layout BDExternal{} -> return $ [] -- yes, we just assume that we cannot properly layout
-- this. -- this.
BDFPlain t -> return BDPlain t -> return
[ case Text.lines t of [ case Text.lines t of
[] -> VerticalSpacing 0 VerticalSpacingParNone False [] -> VerticalSpacing 0 VerticalSpacingParNone False
[t1] -> [t1] ->
@ -787,12 +787,12 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
VerticalSpacing (Text.length t1) (VerticalSpacingParAlways 0) True VerticalSpacing (Text.length t1) (VerticalSpacingParAlways 0) True
| allowHangingQuasiQuotes | allowHangingQuasiQuotes
] ]
BDFQueueComments _comms bd -> rec bd BDQueueComments _comms bd -> rec bd
BDFFlushCommentsPrior _loc bd -> rec bd BDFlushCommentsPrior _loc bd -> rec bd
BDFFlushCommentsPost _loc bd -> rec bd BDFlushCommentsPost _loc bd -> rec bd
BDFEntryDelta _dp bd -> rec bd BDEntryDelta _dp bd -> rec bd
BDFLines [] -> return $ [VerticalSpacing 0 VerticalSpacingParNone False] BDLines [] -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]
BDFLines ls@(_ : _) -> do BDLines ls@(_ : _) -> do
-- we simply assume that lines is only used "properly", i.e. in -- we simply assume that lines is only used "properly", i.e. in
-- such a way that the first line can be treated "as a part of the -- such a way that the first line can be treated "as a part of the
-- paragraph". That most importantly means that Lines should never -- paragraph". That most importantly means that Lines should never
@ -819,7 +819,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
-- [] -> [] -- [] -> []
-- (lSps:_) -> mVs <&> \(VerticalSpacing lsp _) -> -- (lSps:_) -> mVs <&> \(VerticalSpacing lsp _) ->
-- VerticalSpacing lsp $ VerticalSpacingParSome $ getMaxVS $ maxVs lSps -- VerticalSpacing lsp $ VerticalSpacingParSome $ getMaxVS $ maxVs lSps
BDFEnsureIndent indent bd -> do BDEnsureIndent indent bd -> do
mVs <- rec bd mVs <- rec bd
let let
addInd = case indent of addInd = case indent of
@ -829,7 +829,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
BrIndentSpecial i -> i BrIndentSpecial i -> i
return $ mVs <&> \(VerticalSpacing lsp psp parFlag) -> return $ mVs <&> \(VerticalSpacing lsp psp parFlag) ->
VerticalSpacing (lsp + addInd) psp parFlag VerticalSpacing (lsp + addInd) psp parFlag
BDFNonBottomSpacing b bd -> do BDNonBottomSpacing b bd -> do
-- TODO: the `b` flag is an ugly hack, but I was not able to make -- TODO: the `b` flag is an ugly hack, but I was not able to make
-- all tests work without it. It should be possible to have -- all tests work without it. It should be possible to have
-- `spMakePar` map VSPAlways{} to VSPSome x1, which fixes this -- `spMakePar` map VSPAlways{} to VSPSome x1, which fixes this
@ -864,7 +864,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
-- leading to unnecessary new-lines. Disabled for now. A better -- leading to unnecessary new-lines. Disabled for now. A better
-- solution would require conditionally folding the search-space -- solution would require conditionally folding the search-space
-- only in appropriate locations (i.e. a new BriDoc node type -- only in appropriate locations (i.e. a new BriDoc node type
-- for this purpose, perhaps "BDFNonBottomSpacing1"). -- for this purpose, perhaps "BDNonBottomSpacing1").
-- else -- else
-- [ Foldable.foldl1 -- [ Foldable.foldl1
-- (\(VerticalSpacing x1 x2 _) (VerticalSpacing y1 y2 _) -> -- (\(VerticalSpacing x1 x2 _) (VerticalSpacing y1 y2 _) ->
@ -884,20 +884,20 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
-- False) -- False)
-- mVs -- mVs
-- ] -- ]
BDFSetParSpacing bd -> do BDSetParSpacing bd -> do
mVs <- rec bd mVs <- rec bd
return $ mVs <&> \vs -> vs { _vs_parFlag = True } return $ mVs <&> \vs -> vs { _vs_parFlag = True }
BDFForceParSpacing bd -> do BDForceParSpacing bd -> do
mVs <- preFilterLimit <$> rec bd mVs <- preFilterLimit <$> rec bd
return return
$ [ vs $ [ vs
| vs <- mVs | vs <- mVs
, _vs_parFlag vs || _vs_paragraph vs == VerticalSpacingParNone , _vs_parFlag vs || _vs_paragraph vs == VerticalSpacingParNone
] ]
BDFDebug s bd -> do BDDebug s bd -> do
r <- rec bd r <- rec bd
tellDebugMess tellDebugMess
$ "getSpacings: BDFDebug " $ "getSpacings: BDDebug "
++ show s ++ show s
++ " (node-id=" ++ " (node-id="
++ show brDcId ++ show brDcId