Replace BriDoc+BriDocF with single BriDocW + type family
parent
ee2814e3a8
commit
b116529005
|
|
@ -5,6 +5,7 @@
|
|||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
module Language.Haskell.Brittany.Internal.Components.BriDoc where
|
||||
|
||||
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
|
||||
-- of transformations on `BriDocF Identity`s and it is really annoying to
|
||||
-- `Identity`/`runIdentity` everywhere.
|
||||
data BriDoc
|
||||
-- historical design note
|
||||
--
|
||||
-- We previously had
|
||||
-- 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
|
||||
BDEmpty
|
||||
| BDLit !Text
|
||||
| BDSeq [BriDoc] -- elements other than the last should
|
||||
| BDSeq [BriDocRec w] -- elements other than the last should
|
||||
-- not contains BDPars.
|
||||
| BDCols ColSig [BriDoc] -- elements other than the last
|
||||
| BDCols ColSig [BriDocRec w] -- elements other than the last
|
||||
-- should not contains BDPars
|
||||
| BDSeparator -- semantically, space-unless-at-end-of-line.
|
||||
| BDAddBaseY BrIndent BriDoc
|
||||
| BDBaseYPushCur BriDoc
|
||||
| BDIndentLevelPushCur BriDoc
|
||||
| BDIndentLevelPop BriDoc
|
||||
| BDAddBaseY BrIndent (BriDocRec w)
|
||||
| BDBaseYPushCur (BriDocRec w)
|
||||
| BDIndentLevelPushCur (BriDocRec w)
|
||||
| BDIndentLevelPop (BriDocRec w)
|
||||
| BDPar
|
||||
{ _bdpar_indent :: BrIndent
|
||||
, _bdpar_restOfLine :: BriDoc -- should not contain other BDPars
|
||||
, _bdpar_indented :: BriDoc
|
||||
, _bdpar_restOfLine :: BriDocRec w -- should not contain other BDPars
|
||||
, _bdpar_indented :: BriDocRec w
|
||||
}
|
||||
-- | BDAddIndent BrIndent (BriDocF f)
|
||||
-- | BDAddIndent BrIndent (BriDocRec w)
|
||||
-- | BDNewline
|
||||
| BDAlt [BriDoc]
|
||||
| BDForwardLineMode BriDoc
|
||||
| BDAlt [BriDocRec w]
|
||||
| BDForwardLineMode (BriDocRec w)
|
||||
| BDExternal -- AnnKey
|
||||
-- (Set AnnKey) -- set of annkeys contained within the node
|
||||
-- -- to be printed via exactprint
|
||||
|
|
@ -47,14 +65,14 @@ data BriDoc
|
|||
Text
|
||||
| BDPlain !Text -- used for QuasiQuotes, content can be multi-line
|
||||
-- (contrast to BDLit)
|
||||
| BDQueueComments [LEpaComment] BriDoc
|
||||
| BDQueueComments [LEpaComment] (BriDocRec w)
|
||||
-- queue to be later flushed when the markers are reached
|
||||
| BDFlushCommentsPrior RealSrcLoc BriDoc
|
||||
| BDFlushCommentsPrior RealSrcLoc (BriDocRec w)
|
||||
-- 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
|
||||
-- child-nodes
|
||||
| BDEntryDelta DeltaPos BriDoc
|
||||
| BDEntryDelta DeltaPos (BriDocRec w)
|
||||
-- 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.
|
||||
|
|
@ -62,77 +80,31 @@ data BriDoc
|
|||
-- 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
|
||||
| BDLines [(BriDocRec w)]
|
||||
| BDEnsureIndent BrIndent (BriDocRec w)
|
||||
-- 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.
|
||||
| BDForceMultiline BriDoc
|
||||
| BDForceSingleline BriDoc
|
||||
| BDNonBottomSpacing Bool BriDoc
|
||||
| BDSetParSpacing BriDoc
|
||||
| BDForceParSpacing BriDoc
|
||||
| BDForceMultiline (BriDocRec w)
|
||||
| BDForceSingleline (BriDocRec w)
|
||||
| BDNonBottomSpacing Bool (BriDocRec w)
|
||||
| BDSetParSpacing (BriDocRec w)
|
||||
| BDForceParSpacing (BriDocRec w)
|
||||
-- pseudo-deprecated
|
||||
| BDDebug String BriDoc
|
||||
deriving (Data.Data.Data, Eq, Ord)
|
||||
| BDDebug String (BriDocRec w)
|
||||
|
||||
data BriDocF f
|
||||
= -- BDWrapAnnKey AnnKey BriDoc
|
||||
BDFEmpty
|
||||
| BDFLit !Text
|
||||
| BDFSeq [f (BriDocF f)] -- elements other than the last should
|
||||
-- not contains BDPars.
|
||||
| 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))
|
||||
deriving instance Data.Data.Data (BriDocW 'Unwrapped)
|
||||
deriving instance Data.Data.Data (BriDocW 'Wrapped)
|
||||
|
||||
type BriDoc = BriDocW 'Unwrapped
|
||||
type BriDocWrapped = BriDocW 'Wrapped
|
||||
type BriDocNumbered = (Int, BriDocWrapped)
|
||||
|
||||
data BrIndent = BrIndentNone
|
||||
| BrIndentRegular
|
||||
| BrIndentSpecial Int
|
||||
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
|
||||
uniplate x@BDEmpty{} = plate x
|
||||
uniplate x@BDLit{} = plate x
|
||||
|
|
@ -204,32 +176,32 @@ isNotEmpty _ = True
|
|||
-- TODO: rename to "dropLabels" ?
|
||||
unwrapBriDocNumbered :: BriDocNumbered -> BriDoc
|
||||
unwrapBriDocNumbered tpl = case snd tpl of
|
||||
BDFEmpty -> BDEmpty
|
||||
BDFLit t -> BDLit t
|
||||
BDFSeq list -> BDSeq $ rec <$> list
|
||||
BDFCols sig list -> BDCols sig $ rec <$> list
|
||||
BDFSeparator -> BDSeparator
|
||||
BDFAddBaseY ind bd -> BDAddBaseY ind $ rec bd
|
||||
BDFBaseYPushCur bd -> BDBaseYPushCur $ rec bd
|
||||
BDFIndentLevelPushCur bd -> BDIndentLevelPushCur $ rec bd
|
||||
BDFIndentLevelPop bd -> BDIndentLevelPop $ rec bd
|
||||
BDFPar ind line indented -> BDPar ind (rec line) (rec indented)
|
||||
BDFAlt alts -> BDAlt $ rec <$> alts -- not that this will happen
|
||||
BDFForwardLineMode bd -> BDForwardLineMode $ rec bd
|
||||
BDFExternal c t -> BDExternal c t
|
||||
BDFPlain t -> BDPlain t
|
||||
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
|
||||
BDFForceSingleline bd -> BDForceSingleline $ rec bd
|
||||
BDFNonBottomSpacing b bd -> BDNonBottomSpacing b $ rec bd
|
||||
BDFSetParSpacing bd -> BDSetParSpacing $ rec bd
|
||||
BDFForceParSpacing bd -> BDForceParSpacing $ rec bd
|
||||
BDFDebug s bd -> BDDebug (s ++ "@" ++ show (fst tpl)) $ rec bd
|
||||
BDEmpty -> BDEmpty
|
||||
BDLit t -> BDLit t
|
||||
BDSeq list -> BDSeq $ rec <$> list
|
||||
BDCols sig list -> BDCols sig $ rec <$> list
|
||||
BDSeparator -> BDSeparator
|
||||
BDAddBaseY ind bd -> BDAddBaseY ind $ rec bd
|
||||
BDBaseYPushCur bd -> BDBaseYPushCur $ rec bd
|
||||
BDIndentLevelPushCur bd -> BDIndentLevelPushCur $ rec bd
|
||||
BDIndentLevelPop bd -> BDIndentLevelPop $ rec bd
|
||||
BDPar ind line indented -> BDPar ind (rec line) (rec indented)
|
||||
BDAlt alts -> BDAlt $ rec <$> alts -- not that this will happen
|
||||
BDForwardLineMode bd -> BDForwardLineMode $ rec bd
|
||||
BDExternal c t -> BDExternal c t
|
||||
BDPlain t -> BDPlain t
|
||||
BDQueueComments comms bd -> BDQueueComments comms $ rec bd
|
||||
BDFlushCommentsPrior loc bd -> BDFlushCommentsPrior loc $ rec bd
|
||||
BDFlushCommentsPost loc bd -> BDFlushCommentsPost loc $ rec bd
|
||||
BDEntryDelta dp bd -> BDEntryDelta dp $ rec bd
|
||||
BDLines lines -> BDLines $ rec <$> lines
|
||||
BDEnsureIndent ind bd -> BDEnsureIndent ind $ rec bd
|
||||
BDForceMultiline bd -> BDForceMultiline $ rec bd
|
||||
BDForceSingleline bd -> BDForceSingleline $ rec bd
|
||||
BDNonBottomSpacing b bd -> BDNonBottomSpacing b $ rec bd
|
||||
BDSetParSpacing bd -> BDSetParSpacing $ rec bd
|
||||
BDForceParSpacing bd -> BDForceParSpacing $ rec bd
|
||||
BDDebug s bd -> BDDebug (s ++ "@" ++ show (fst tpl)) $ rec bd
|
||||
where rec = unwrapBriDocNumbered
|
||||
|
||||
data ColSig
|
||||
|
|
|
|||
|
|
@ -99,7 +99,7 @@ briDocByExactInlineOnly infoStr ast = do
|
|||
mAsk <&> _conf_errorHandling .> _econf_ExactPrintFallback .> confUnpack
|
||||
let
|
||||
exactPrintNode t =
|
||||
allocateNode $ BDFExternal
|
||||
allocateNode $ BDExternal
|
||||
-- (ExactPrint.Types.mkAnnKey ast)
|
||||
-- (foldedAnnKeys ast)
|
||||
False t
|
||||
|
|
@ -312,7 +312,7 @@ astConnectedComments =
|
|||
-- new BriDoc stuff
|
||||
|
||||
allocateNode
|
||||
:: MonadMultiState NodeAllocIndex m => BriDocFInt -> m BriDocNumbered
|
||||
:: MonadMultiState NodeAllocIndex m => BriDocWrapped -> m BriDocNumbered
|
||||
allocateNode bd = do
|
||||
i <- allocNodeIndex
|
||||
return (i, bd)
|
||||
|
|
@ -324,20 +324,20 @@ allocNodeIndex = do
|
|||
return i
|
||||
|
||||
docEmpty :: ToBriDocM BriDocNumbered
|
||||
docEmpty = allocateNode BDFEmpty
|
||||
docEmpty = allocateNode BDEmpty
|
||||
|
||||
docLit :: Text -> ToBriDocM BriDocNumbered
|
||||
docLit t = allocateNode $ BDFLit t
|
||||
docLit t = allocateNode $ BDLit t
|
||||
|
||||
docLitS :: String -> ToBriDocM BriDocNumbered
|
||||
docLitS s = allocateNode $ BDFLit $ Text.pack s
|
||||
docLitS s = allocateNode $ BDLit $ Text.pack s
|
||||
|
||||
docExt
|
||||
:: (ExactPrint.ExactPrint (GenLocated l ast))
|
||||
=> GenLocated l ast
|
||||
-> Bool
|
||||
-> ToBriDocM BriDocNumbered
|
||||
docExt x shouldAddComment = allocateNode $ BDFExternal
|
||||
docExt x shouldAddComment = allocateNode $ BDExternal
|
||||
-- (ExactPrint.Types.mkAnnKey x)
|
||||
-- (foldedAnnKeys x)
|
||||
shouldAddComment
|
||||
|
|
@ -348,7 +348,7 @@ docExt x shouldAddComment = allocateNode $ BDFExternal
|
|||
)
|
||||
|
||||
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)
|
||||
deriving (Functor, Applicative, Monad)
|
||||
|
|
@ -365,51 +365,51 @@ runFilteredAlternative (CollectAltM action) = docAlt $ Writer.execWriter action
|
|||
|
||||
docSeq :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
|
||||
docSeq [] = docEmpty
|
||||
docSeq l = allocateNode . BDFSeq =<< sequence l
|
||||
docSeq l = allocateNode . BDSeq =<< sequence l
|
||||
|
||||
docLines :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
|
||||
docLines l = allocateNode . BDFLines =<< sequence l
|
||||
docLines l = allocateNode . BDLines =<< sequence l
|
||||
|
||||
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 ind bdm = allocateNode . BDFAddBaseY ind =<< bdm
|
||||
docAddBaseY ind bdm = allocateNode . BDAddBaseY ind =<< bdm
|
||||
|
||||
docSetBaseY :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docSetBaseY bdm = do
|
||||
bd <- bdm
|
||||
-- the order here is important so that these two nodes can be treated
|
||||
-- properly over at `transformAlts`.
|
||||
allocateNode $ BDFBaseYPushCur bd
|
||||
allocateNode $ BDBaseYPushCur bd
|
||||
|
||||
docSetIndentLevel :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docSetIndentLevel bdm = do
|
||||
bd <- bdm
|
||||
n1 <- allocateNode $ BDFIndentLevelPushCur bd
|
||||
n2 <- allocateNode $ BDFIndentLevelPop n1
|
||||
n1 <- allocateNode $ BDIndentLevelPushCur bd
|
||||
n2 <- allocateNode $ BDIndentLevelPop n1
|
||||
return n2
|
||||
|
||||
docSetBaseAndIndent :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docSetBaseAndIndent = docSetBaseY . docSetIndentLevel
|
||||
|
||||
docSeparator :: ToBriDocM BriDocNumbered
|
||||
docSeparator = allocateNode BDFSeparator
|
||||
docSeparator = allocateNode BDSeparator
|
||||
|
||||
docNonBottomSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docNonBottomSpacing bdm = allocateNode . BDFNonBottomSpacing False =<< bdm
|
||||
docNonBottomSpacing bdm = allocateNode . BDNonBottomSpacing False =<< bdm
|
||||
|
||||
docNonBottomSpacingS :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docNonBottomSpacingS bdm = allocateNode . BDFNonBottomSpacing True =<< bdm
|
||||
docNonBottomSpacingS bdm = allocateNode . BDNonBottomSpacing True =<< bdm
|
||||
|
||||
docSetParSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docSetParSpacing bdm = allocateNode . BDFSetParSpacing =<< bdm
|
||||
docSetParSpacing bdm = allocateNode . BDSetParSpacing =<< bdm
|
||||
|
||||
docForceParSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docForceParSpacing bdm = allocateNode . BDFForceParSpacing =<< bdm
|
||||
docForceParSpacing bdm = allocateNode . BDForceParSpacing =<< bdm
|
||||
|
||||
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 x = docSeq [x, docSeparator]
|
||||
|
|
@ -456,22 +456,22 @@ docPar
|
|||
docPar lineM indentedM = do
|
||||
line <- lineM
|
||||
indented <- indentedM
|
||||
allocateNode $ BDFPar BrIndentNone line indented
|
||||
allocateNode $ BDPar BrIndentNone line indented
|
||||
|
||||
docForceSingleline :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docForceSingleline bdm = allocateNode . BDFForceSingleline =<< bdm
|
||||
docForceSingleline bdm = allocateNode . BDForceSingleline =<< bdm
|
||||
|
||||
docForceMultiline :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docForceMultiline bdm = allocateNode . BDFForceMultiline =<< bdm
|
||||
docForceMultiline bdm = allocateNode . BDForceMultiline =<< bdm
|
||||
|
||||
docEnsureIndent
|
||||
:: 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 dp bdm = do
|
||||
bd <- bdm
|
||||
allocateNode (BDFEntryDelta dp bd)
|
||||
allocateNode (BDEntryDelta dp bd)
|
||||
|
||||
docFlushRemaining :: FastString -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docFlushRemaining fileThing = docFlushCommsPost
|
||||
|
|
@ -486,7 +486,7 @@ instance DocHandleComms [LEpaComment] (ToBriDocM BriDocNumbered) where
|
|||
docHandleComms comms bdm = do
|
||||
bd <- bdm
|
||||
i1 <- allocNodeIndex
|
||||
pure (i1, BDFQueueComments comms bd)
|
||||
pure (i1, BDQueueComments comms bd)
|
||||
|
||||
instance DocHandleComms (EpAnn a) (ToBriDocM BriDocNumbered) where
|
||||
docHandleComms epAnn bdm = case epAnn of
|
||||
|
|
@ -494,15 +494,15 @@ instance DocHandleComms (EpAnn a) (ToBriDocM BriDocNumbered) where
|
|||
bd <- bdm
|
||||
i1 <- allocNodeIndex
|
||||
pure
|
||||
(i1, BDFFlushCommentsPrior (GHC.realSrcSpanStart $ GHC.anchor anch) bd)
|
||||
(i1, BDFlushCommentsPrior (GHC.realSrcSpanStart $ GHC.anchor anch) bd)
|
||||
EpAnn anch _ (EpaComments comms) -> do
|
||||
bd <- bdm
|
||||
i1 <- allocNodeIndex
|
||||
i2 <- allocNodeIndex
|
||||
pure
|
||||
( i1
|
||||
, BDFFlushCommentsPrior (GHC.realSrcSpanStart $ GHC.anchor anch)
|
||||
(i2, BDFQueueComments (reverse comms) bd)
|
||||
, BDFlushCommentsPrior (GHC.realSrcSpanStart $ GHC.anchor anch)
|
||||
(i2, BDQueueComments (reverse comms) bd)
|
||||
)
|
||||
EpAnn anch _ (EpaCommentsBalanced commsB commsA) -> do
|
||||
bd <- bdm
|
||||
|
|
@ -510,10 +510,10 @@ instance DocHandleComms (EpAnn a) (ToBriDocM BriDocNumbered) where
|
|||
i2 <- allocNodeIndex
|
||||
pure
|
||||
( i1
|
||||
, BDFQueueComments
|
||||
, BDQueueComments
|
||||
(reverse commsB ++ reverse commsA)
|
||||
( i2
|
||||
, BDFFlushCommentsPrior (GHC.realSrcSpanStart $ GHC.anchor anch) bd
|
||||
, BDFlushCommentsPrior (GHC.realSrcSpanStart $ GHC.anchor anch) bd
|
||||
)
|
||||
)
|
||||
EpAnnNotUsed -> bdm
|
||||
|
|
@ -525,7 +525,7 @@ instance DocHandleComms (GHC.RealSrcLoc) (ToBriDocM BriDocNumbered) where
|
|||
docHandleComms loc bdm = do
|
||||
bd <- bdm
|
||||
i1 <- allocNodeIndex
|
||||
pure (i1, BDFFlushCommentsPrior loc bd)
|
||||
pure (i1, BDFlushCommentsPrior loc bd)
|
||||
|
||||
instance DocHandleComms (Maybe GHC.RealSrcSpan) (ToBriDocM BriDocNumbered) where
|
||||
docHandleComms Nothing bdm = bdm
|
||||
|
|
@ -680,7 +680,7 @@ instance DocFlushCommsPost (ToBriDocM BriDocNumbered) where
|
|||
Just span -> \bdm -> do
|
||||
i1 <- allocNodeIndex
|
||||
bd <- bdm
|
||||
pure (i1, BDFFlushCommentsPost span bd)
|
||||
pure (i1, BDFlushCommentsPost span bd)
|
||||
|
||||
instance DocFlushCommsPost (ToBriDocM [BriDocNumbered]) where
|
||||
docFlushCommsPost loc bdm = do
|
||||
|
|
|
|||
|
|
@ -906,7 +906,7 @@ layoutClsInst (L declLoc _) cid = do
|
|||
:: [ToBriDocM (Located BriDocNumbered)] -> ToBriDocM BriDocNumbered
|
||||
docSortedLines l =
|
||||
allocateNode
|
||||
. BDFLines
|
||||
. BDLines
|
||||
. fmap unLoc
|
||||
. List.sortOn (ExactPrint.rs . getLoc)
|
||||
=<< sequence l
|
||||
|
|
|
|||
|
|
@ -991,7 +991,7 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
-- TODO
|
||||
briDocByExactInlineOnly "HsTcBracketOut{}" lexpr
|
||||
HsSpliceE _ (HsQuasiQuote _ _ quoter _loc content) -> do
|
||||
allocateNode $ BDFPlain
|
||||
allocateNode $ BDPlain
|
||||
(Text.pack
|
||||
$ "["
|
||||
++ showOutputable quoter
|
||||
|
|
@ -1197,26 +1197,26 @@ recordExpression dotdot wrapO wrapDD wrapC indentPolicy _lexpr nameDoc nameLayou
|
|||
in fieldLines ++ [dotdotLine, lineN]
|
||||
)
|
||||
|
||||
litBriDoc :: HsLit GhcPs -> BriDocFInt
|
||||
litBriDoc :: HsLit GhcPs -> BriDocWrapped
|
||||
litBriDoc = \case
|
||||
HsChar (SourceText t) _c -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\'']
|
||||
HsCharPrim (SourceText t) _c -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\'']
|
||||
HsString (SourceText t) _fastString -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ FastString.unpackFS fastString
|
||||
HsStringPrim (SourceText t) _byteString -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ Data.ByteString.Char8.unpack byteString
|
||||
HsInt _ (IL (SourceText t) _ _) -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
|
||||
HsIntPrim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
|
||||
HsWordPrim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
|
||||
HsInt64Prim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
|
||||
HsWord64Prim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
|
||||
HsInteger (SourceText t) _i _type -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
|
||||
HsRat _ (FL (SourceText t) _ _ _ _) _type -> BDFLit $ Text.pack t
|
||||
HsFloatPrim _ (FL (SourceText t) _ _ _ _) -> BDFLit $ Text.pack t
|
||||
HsDoublePrim _ (FL (SourceText t) _ _ _ _) -> BDFLit $ Text.pack t
|
||||
HsChar (SourceText t) _c -> BDLit $ Text.pack t -- BDLit $ Text.pack $ ['\'', c, '\'']
|
||||
HsCharPrim (SourceText t) _c -> BDLit $ Text.pack t -- BDLit $ Text.pack $ ['\'', c, '\'']
|
||||
HsString (SourceText t) _fastString -> BDLit $ Text.pack t -- BDLit $ Text.pack $ FastString.unpackFS fastString
|
||||
HsStringPrim (SourceText t) _byteString -> BDLit $ Text.pack t -- BDLit $ Text.pack $ Data.ByteString.Char8.unpack byteString
|
||||
HsInt _ (IL (SourceText t) _ _) -> BDLit $ Text.pack t -- BDLit $ Text.pack $ show i
|
||||
HsIntPrim (SourceText t) _i -> BDLit $ Text.pack t -- BDLit $ Text.pack $ show i
|
||||
HsWordPrim (SourceText t) _i -> BDLit $ Text.pack t -- BDLit $ Text.pack $ show i
|
||||
HsInt64Prim (SourceText t) _i -> BDLit $ Text.pack t -- BDLit $ Text.pack $ show i
|
||||
HsWord64Prim (SourceText t) _i -> BDLit $ Text.pack t -- BDLit $ Text.pack $ show i
|
||||
HsInteger (SourceText t) _i _type -> BDLit $ Text.pack t -- BDLit $ Text.pack $ show i
|
||||
HsRat _ (FL (SourceText t) _ _ _ _) _type -> BDLit $ Text.pack t
|
||||
HsFloatPrim _ (FL (SourceText t) _ _ _ _) -> BDLit $ Text.pack t
|
||||
HsDoublePrim _ (FL (SourceText t) _ _ _ _) -> BDLit $ Text.pack t
|
||||
_ -> error "litBriDoc: literal with no SourceText"
|
||||
|
||||
overLitValBriDoc :: OverLitVal -> BriDocFInt
|
||||
overLitValBriDoc :: OverLitVal -> BriDocWrapped
|
||||
overLitValBriDoc = \case
|
||||
HsIntegral (IL (SourceText t) _ _) -> BDFLit $ Text.pack t
|
||||
HsFractional (FL (SourceText t) _ _ _ _) -> BDFLit $ Text.pack t
|
||||
HsIsString (SourceText t) _ -> BDFLit $ Text.pack t
|
||||
HsIntegral (IL (SourceText t) _ _) -> BDLit $ Text.pack t
|
||||
HsFractional (FL (SourceText t) _ _ _ _) -> BDLit $ Text.pack t
|
||||
HsIsString (SourceText t) _ -> BDLit $ Text.pack t
|
||||
_ -> error "overLitValBriDoc: literal with no SourceText"
|
||||
|
|
|
|||
|
|
@ -10,6 +10,6 @@ import Language.Haskell.Brittany.Internal.Components.BriDoc
|
|||
|
||||
layoutExpr :: ToBriDoc HsExpr
|
||||
|
||||
litBriDoc :: HsLit GhcPs -> BriDocFInt
|
||||
litBriDoc :: HsLit GhcPs -> BriDocWrapped
|
||||
|
||||
overLitValBriDoc :: OverLitVal -> BriDocFInt
|
||||
overLitValBriDoc :: OverLitVal -> BriDocWrapped
|
||||
|
|
|
|||
|
|
@ -116,28 +116,28 @@ transformAlts =
|
|||
-- go = Memo.memo $ \bdX -> do
|
||||
-- i <- lift $ incGet
|
||||
-- fmap (\bd' -> (i,bd')) $ case bdX of
|
||||
-- BDEmpty -> return $ BDFEmpty
|
||||
-- BDLit t -> return $ BDFLit t
|
||||
-- BDSeq list -> BDFSeq <$> go `mapM` list
|
||||
-- BDCols sig list -> BDFCols sig <$> go `mapM` list
|
||||
-- BDSeparator -> return $ BDFSeparator
|
||||
-- BDAddBaseY ind bd -> BDFAddBaseY ind <$> go bd
|
||||
-- BDSetBaseY bd -> BDFSetBaseY <$> go bd
|
||||
-- BDSetIndentLevel bd -> BDFSetIndentLevel <$> go bd
|
||||
-- BDPar ind line indented -> [ BDFPar ind line' indented'
|
||||
-- BDEmpty -> return $ BDEmpty
|
||||
-- BDLit t -> return $ BDLit t
|
||||
-- BDSeq list -> BDSeq <$> go `mapM` list
|
||||
-- BDCols sig list -> BDCols sig <$> go `mapM` list
|
||||
-- BDSeparator -> return $ BDSeparator
|
||||
-- BDAddBaseY ind bd -> BDAddBaseY ind <$> go bd
|
||||
-- BDSetBaseY bd -> BDSetBaseY <$> go bd
|
||||
-- BDSetIndentLevel bd -> BDSetIndentLevel <$> go bd
|
||||
-- BDPar ind line indented -> [ BDPar ind line' indented'
|
||||
-- | line' <- go line
|
||||
-- , indented' <- go indented
|
||||
-- ]
|
||||
-- BDAlt alts -> BDFAlt <$> go `mapM` alts -- not that this will happen
|
||||
-- BDForceMultiline bd -> BDFForceMultiline <$> go bd
|
||||
-- BDForceSingleline bd -> BDFForceSingleline <$> go bd
|
||||
-- BDForwardLineMode bd -> BDFForwardLineMode <$> go bd
|
||||
-- BDExternal k ks c t -> return $ BDFExternal k ks c t
|
||||
-- BDAnnotationPrior annKey bd -> BDFAnnotationPrior annKey <$> go bd
|
||||
-- BDAnnotationPost annKey bd -> BDFAnnotationPost annKey <$> go bd
|
||||
-- BDLines lines -> BDFLines <$> go `mapM` lines
|
||||
-- BDEnsureIndent ind bd -> BDFEnsureIndent ind <$> go bd
|
||||
-- BDProhibitMTEL bd -> BDFProhibitMTEL <$> go bd
|
||||
-- BDAlt alts -> BDAlt <$> go `mapM` alts -- not that this will happen
|
||||
-- BDForceMultiline bd -> BDForceMultiline <$> go bd
|
||||
-- BDForceSingleline bd -> BDForceSingleline <$> go bd
|
||||
-- BDForwardLineMode bd -> BDForwardLineMode <$> go bd
|
||||
-- BDExternal k ks c t -> return $ BDExternal k ks c t
|
||||
-- BDAnnotationPrior annKey bd -> BDAnnotationPrior annKey <$> go bd
|
||||
-- BDAnnotationPost annKey bd -> BDAnnotationPost annKey <$> go bd
|
||||
-- BDLines lines -> BDLines <$> go `mapM` lines
|
||||
-- BDEnsureIndent ind bd -> BDEnsureIndent ind <$> go bd
|
||||
-- BDProhibitMTEL bd -> BDProhibitMTEL <$> go bd
|
||||
|
||||
|
||||
|
||||
|
|
@ -156,12 +156,12 @@ transformAlts =
|
|||
-- acp <- mGet
|
||||
-- mSet $ acp { _acp_forceMLFlag = altLineModeDecay $ _acp_forceMLFlag acp }
|
||||
-- BDWrapAnnKey annKey <$> rec bd
|
||||
BDFEmpty{} -> processSpacingSimple bdX $> bdX
|
||||
BDFLit{} -> processSpacingSimple bdX $> bdX
|
||||
BDFSeq list -> reWrap . BDFSeq <$> list `forM` rec
|
||||
BDFCols sig list -> reWrap . BDFCols sig <$> list `forM` rec
|
||||
BDFSeparator -> processSpacingSimple bdX $> bdX
|
||||
BDFAddBaseY indent bd -> do
|
||||
BDEmpty{} -> processSpacingSimple bdX $> bdX
|
||||
BDLit{} -> processSpacingSimple bdX $> bdX
|
||||
BDSeq list -> reWrap . BDSeq <$> list `forM` rec
|
||||
BDCols sig list -> reWrap . BDCols sig <$> list `forM` rec
|
||||
BDSeparator -> processSpacingSimple bdX $> bdX
|
||||
BDAddBaseY indent bd -> do
|
||||
acp <- mGet
|
||||
indAdd <- fixIndentationForMultiple acp indent
|
||||
mSet $ acp { _acp_indentPrep = max (_acp_indentPrep acp) indAdd }
|
||||
|
|
@ -170,22 +170,22 @@ transformAlts =
|
|||
mSet $ acp' { _acp_indent = _acp_indent acp }
|
||||
return $ case indent of
|
||||
BrIndentNone -> r
|
||||
BrIndentRegular -> reWrap $ BDFAddBaseY (BrIndentSpecial indAdd) r
|
||||
BrIndentSpecial i -> reWrap $ BDFAddBaseY (BrIndentSpecial i) r
|
||||
BDFBaseYPushCur bd -> do
|
||||
BrIndentRegular -> reWrap $ BDAddBaseY (BrIndentSpecial indAdd) r
|
||||
BrIndentSpecial i -> reWrap $ BDAddBaseY (BrIndentSpecial i) r
|
||||
BDBaseYPushCur bd -> do
|
||||
acp <- mGet
|
||||
mSet $ acp { _acp_indent = _acp_line acp }
|
||||
r <- rec bd
|
||||
acp' <- mGet
|
||||
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
|
||||
reWrap . BDFIndentLevelPop <$> rec bd
|
||||
BDFPar indent sameLine indented -> do
|
||||
return $ reWrap $ BDBaseYPushCur r
|
||||
BDEntryDelta dp bd -> do
|
||||
return $ reWrap $ BDEntryDelta dp bd
|
||||
BDIndentLevelPushCur bd -> do
|
||||
reWrap . BDIndentLevelPushCur <$> rec bd
|
||||
BDIndentLevelPop bd -> do
|
||||
reWrap . BDIndentLevelPop <$> rec bd
|
||||
BDPar indent sameLine indented -> do
|
||||
indAmount <-
|
||||
mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
|
||||
let
|
||||
|
|
@ -199,12 +199,12 @@ transformAlts =
|
|||
sameLine' <- rec sameLine
|
||||
mModify $ \acp' -> acp' { _acp_line = ind, _acp_indent = ind }
|
||||
indented' <- rec indented
|
||||
return $ reWrap $ BDFPar indent sameLine' indented'
|
||||
BDFAlt [] -> error "empty BDAlt" -- returning BDEmpty instead is a
|
||||
return $ reWrap $ BDPar indent sameLine' indented'
|
||||
BDAlt [] -> error "empty BDAlt" -- returning BDEmpty instead is a
|
||||
-- possibility, but i will prefer a
|
||||
-- fail-early approach; BDEmpty does not
|
||||
-- make sense semantically for Alt[].
|
||||
BDFAlt alts -> do
|
||||
BDAlt alts -> do
|
||||
altChooser <- mAsk <&> _conf_layout .> _lconfig_altChooser .> confUnpack
|
||||
case altChooser of
|
||||
AltChooserSimpleQuick -> do
|
||||
|
|
@ -263,7 +263,7 @@ transformAlts =
|
|||
$ fromMaybe (-- trace ("choosing last") $
|
||||
List.last alts)
|
||||
$ Data.List.Extra.firstJust (fmap snd) checkedOptions
|
||||
BDFForceMultiline bd -> do
|
||||
BDForceMultiline bd -> do
|
||||
acp <- mGet
|
||||
x <- do
|
||||
mSet $ mergeLineMode acp (AltLineModeStateForceML False)
|
||||
|
|
@ -271,7 +271,7 @@ transformAlts =
|
|||
acp' <- mGet
|
||||
mSet $ acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }
|
||||
return $ x
|
||||
BDFForceSingleline bd -> do
|
||||
BDForceSingleline bd -> do
|
||||
acp <- mGet
|
||||
x <- do
|
||||
mSet $ mergeLineMode acp AltLineModeStateForceSL
|
||||
|
|
@ -279,7 +279,7 @@ transformAlts =
|
|||
acp' <- mGet
|
||||
mSet $ acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }
|
||||
return $ x
|
||||
BDFForwardLineMode bd -> do
|
||||
BDForwardLineMode bd -> do
|
||||
acp <- mGet
|
||||
x <- do
|
||||
mSet $ acp
|
||||
|
|
@ -289,29 +289,29 @@ transformAlts =
|
|||
acp' <- mGet
|
||||
mSet $ acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }
|
||||
return $ x
|
||||
BDFExternal{} -> processSpacingSimple bdX $> bdX
|
||||
BDFPlain{} -> processSpacingSimple bdX $> bdX
|
||||
BDFQueueComments comms bd ->
|
||||
reWrap . BDFQueueComments comms <$> rec bd
|
||||
BDFFlushCommentsPrior loc bd ->
|
||||
BDExternal{} -> processSpacingSimple bdX $> bdX
|
||||
BDPlain{} -> processSpacingSimple bdX $> bdX
|
||||
BDQueueComments comms bd ->
|
||||
reWrap . BDQueueComments comms <$> rec bd
|
||||
BDFlushCommentsPrior loc bd ->
|
||||
-- TODO92 for AnnotationPrior we had this here:
|
||||
-- > acp <- mGet
|
||||
-- > mSet
|
||||
-- > $ acp { _acp_forceMLFlag = altLineModeDecay $ _acp_forceMLFlag acp }
|
||||
-- > bd' <- rec bd
|
||||
-- not sure if the lineModeDecay is relevant any longer though..
|
||||
reWrap . BDFFlushCommentsPrior loc <$> rec bd
|
||||
BDFFlushCommentsPost loc bd ->
|
||||
reWrap . BDFFlushCommentsPost loc <$> rec bd
|
||||
BDFLines [] -> return $ reWrap BDFEmpty -- evil transformation. or harmless.
|
||||
BDFLines (l : lr) -> do
|
||||
reWrap . BDFlushCommentsPrior loc <$> rec bd
|
||||
BDFlushCommentsPost loc bd ->
|
||||
reWrap . BDFlushCommentsPost loc <$> rec bd
|
||||
BDLines [] -> return $ reWrap BDEmpty -- evil transformation. or harmless.
|
||||
BDLines (l : lr) -> do
|
||||
ind <- _acp_indent <$> mGet
|
||||
l' <- rec l
|
||||
lr' <- lr `forM` \x -> do
|
||||
mModify $ \acp -> acp { _acp_line = ind, _acp_indent = ind }
|
||||
rec x
|
||||
return $ reWrap $ BDFLines (l' : lr')
|
||||
BDFEnsureIndent indent bd -> do
|
||||
return $ reWrap $ BDLines (l' : lr')
|
||||
BDEnsureIndent indent bd -> do
|
||||
acp <- mGet
|
||||
indAdd <- fixIndentationForMultiple acp indent
|
||||
mSet $ acp
|
||||
|
|
@ -320,7 +320,7 @@ transformAlts =
|
|||
, _acp_indent = _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
|
||||
-- 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
|
||||
-- indentation, not the current cursor position.
|
||||
}
|
||||
|
|
@ -330,21 +330,21 @@ transformAlts =
|
|||
return $ case indent of
|
||||
BrIndentNone -> r
|
||||
BrIndentRegular ->
|
||||
reWrap $ BDFEnsureIndent (BrIndentSpecial indAdd) r
|
||||
BrIndentSpecial i -> reWrap $ BDFEnsureIndent (BrIndentSpecial i) r
|
||||
BDFNonBottomSpacing _ bd -> rec bd
|
||||
BDFSetParSpacing bd -> rec bd
|
||||
BDFForceParSpacing bd -> rec bd
|
||||
BDFDebug s bd -> do
|
||||
reWrap $ BDEnsureIndent (BrIndentSpecial indAdd) r
|
||||
BrIndentSpecial i -> reWrap $ BDEnsureIndent (BrIndentSpecial i) r
|
||||
BDNonBottomSpacing _ bd -> rec bd
|
||||
BDSetParSpacing bd -> rec bd
|
||||
BDForceParSpacing bd -> rec bd
|
||||
BDDebug s bd -> do
|
||||
acp :: AltCurPos <- mGet
|
||||
tellDebugMess
|
||||
$ "transformAlts: BDFDEBUG "
|
||||
$ "transformAlts: BDDEBUG "
|
||||
++ s
|
||||
++ " (node-id="
|
||||
++ show brDcId
|
||||
++ "): acp="
|
||||
++ show acp
|
||||
reWrap . BDFDebug s <$> rec bd
|
||||
reWrap . BDDebug s <$> rec bd
|
||||
processSpacingSimple
|
||||
:: ( MonadMultiReader Config m
|
||||
, MonadMultiState AltCurPos m
|
||||
|
|
@ -391,17 +391,17 @@ getSpacing !bridoc = rec bridoc
|
|||
let colMax = config & _conf_layout & _lconfig_cols & confUnpack
|
||||
result <- case brDc of
|
||||
-- BDWrapAnnKey _annKey bd -> rec bd
|
||||
BDFEmpty ->
|
||||
BDEmpty ->
|
||||
return $ LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False
|
||||
BDFLit t -> return $ LineModeValid $ VerticalSpacing
|
||||
BDLit t -> return $ LineModeValid $ VerticalSpacing
|
||||
(Text.length t)
|
||||
VerticalSpacingParNone
|
||||
False
|
||||
BDFSeq list -> sumVs <$> rec `mapM` list
|
||||
BDFCols _sig list -> sumVs <$> rec `mapM` list
|
||||
BDFSeparator ->
|
||||
BDSeq list -> sumVs <$> rec `mapM` list
|
||||
BDCols _sig list -> sumVs <$> rec `mapM` list
|
||||
BDSeparator ->
|
||||
return $ LineModeValid $ VerticalSpacing 1 VerticalSpacingParNone False
|
||||
BDFAddBaseY indent bd -> do
|
||||
BDAddBaseY indent bd -> do
|
||||
mVs <- rec bd
|
||||
return $ mVs <&> \vs -> vs
|
||||
{ _vs_paragraph = case _vs_paragraph vs of
|
||||
|
|
@ -423,7 +423,7 @@ getSpacing !bridoc = rec bridoc
|
|||
i + (confUnpack $ _lconfig_indentAmount $ _conf_layout $ config)
|
||||
BrIndentSpecial j -> i + j
|
||||
}
|
||||
BDFBaseYPushCur bd -> do
|
||||
BDBaseYPushCur bd -> do
|
||||
mVs <- rec bd
|
||||
return $ mVs <&> \vs -> vs
|
||||
-- We leave par as-is, even though it technically is not
|
||||
|
|
@ -440,9 +440,9 @@ getSpacing !bridoc = rec bridoc
|
|||
)
|
||||
, _vs_paragraph = VerticalSpacingParSome 0
|
||||
}
|
||||
BDFIndentLevelPushCur bd -> rec bd
|
||||
BDFIndentLevelPop bd -> rec bd
|
||||
BDFPar BrIndentNone sameLine indented -> do
|
||||
BDIndentLevelPushCur bd -> rec bd
|
||||
BDIndentLevelPop bd -> rec bd
|
||||
BDPar BrIndentNone sameLine indented -> do
|
||||
mVs <- rec sameLine
|
||||
mIndSp <- rec indented
|
||||
return
|
||||
|
|
@ -465,33 +465,33 @@ getSpacing !bridoc = rec bridoc
|
|||
== VerticalSpacingParNone
|
||||
&& _vs_parFlag indSp
|
||||
]
|
||||
BDFPar{} -> error "BDPar with indent in getSpacing"
|
||||
BDFAlt [] -> error "empty BDAlt"
|
||||
BDFAlt (alt : _) -> rec alt
|
||||
BDFForceMultiline bd -> do
|
||||
BDPar{} -> error "BDPar with indent in getSpacing"
|
||||
BDAlt [] -> error "empty BDAlt"
|
||||
BDAlt (alt : _) -> rec alt
|
||||
BDForceMultiline bd -> do
|
||||
mVs <- rec bd
|
||||
return $ mVs >>= _vs_paragraph .> \case
|
||||
VerticalSpacingParNone -> LineModeInvalid
|
||||
_ -> mVs
|
||||
BDFForceSingleline bd -> do
|
||||
BDForceSingleline bd -> do
|
||||
mVs <- rec bd
|
||||
return $ mVs >>= _vs_paragraph .> \case
|
||||
VerticalSpacingParNone -> mVs
|
||||
_ -> LineModeInvalid
|
||||
BDFForwardLineMode bd -> rec bd
|
||||
BDFExternal _ txt -> return $ LineModeValid $ case Text.lines txt of
|
||||
BDForwardLineMode bd -> rec bd
|
||||
BDExternal _ txt -> return $ LineModeValid $ case Text.lines txt of
|
||||
[t] -> VerticalSpacing (Text.length t) 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
|
||||
_ -> VerticalSpacing 999 VerticalSpacingParNone False
|
||||
BDFQueueComments _comms bd -> rec bd
|
||||
BDFFlushCommentsPrior _loc bd -> rec bd
|
||||
BDFFlushCommentsPost _loc bd -> rec bd
|
||||
BDFEntryDelta _dp bd -> rec bd
|
||||
BDFLines [] ->
|
||||
BDQueueComments _comms bd -> rec bd
|
||||
BDFlushCommentsPrior _loc bd -> rec bd
|
||||
BDFlushCommentsPost _loc bd -> rec bd
|
||||
BDEntryDelta _dp bd -> rec bd
|
||||
BDLines [] ->
|
||||
return $ LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False
|
||||
BDFLines (l1 : lR) -> do
|
||||
BDLines (l1 : lR) -> do
|
||||
mVs <- rec l1
|
||||
mVRs <- rec `mapM` lR
|
||||
let lSps = mVs : mVRs
|
||||
|
|
@ -500,7 +500,7 @@ getSpacing !bridoc = rec bridoc
|
|||
| VerticalSpacing lsp _ _ <- mVs
|
||||
, lineMax <- getMaxVS $ maxVs $ lSps
|
||||
]
|
||||
BDFEnsureIndent indent bd -> do
|
||||
BDEnsureIndent indent bd -> do
|
||||
mVs <- rec bd
|
||||
let
|
||||
addInd = case indent of
|
||||
|
|
@ -510,7 +510,7 @@ getSpacing !bridoc = rec bridoc
|
|||
BrIndentSpecial i -> i
|
||||
return $ mVs <&> \(VerticalSpacing lsp psp pf) ->
|
||||
VerticalSpacing (lsp + addInd) psp pf
|
||||
BDFNonBottomSpacing b bd -> do
|
||||
BDNonBottomSpacing b bd -> do
|
||||
mVs <- rec bd
|
||||
return $ mVs <|> LineModeValid
|
||||
(VerticalSpacing
|
||||
|
|
@ -521,20 +521,20 @@ getSpacing !bridoc = rec bridoc
|
|||
)
|
||||
False
|
||||
)
|
||||
BDFSetParSpacing bd -> do
|
||||
BDSetParSpacing bd -> do
|
||||
mVs <- rec bd
|
||||
return $ mVs <&> \vs -> vs { _vs_parFlag = True }
|
||||
BDFForceParSpacing bd -> do
|
||||
BDForceParSpacing bd -> do
|
||||
mVs <- rec bd
|
||||
return
|
||||
$ [ vs
|
||||
| vs <- mVs
|
||||
, _vs_parFlag vs || _vs_paragraph vs == VerticalSpacingParNone
|
||||
]
|
||||
BDFDebug s bd -> do
|
||||
BDDebug s bd -> do
|
||||
r <- rec bd
|
||||
tellDebugMess
|
||||
$ "getSpacing: BDFDebug "
|
||||
$ "getSpacing: BDDebug "
|
||||
++ show s
|
||||
++ " (node-id="
|
||||
++ show brDcId
|
||||
|
|
@ -690,13 +690,13 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
. preFilterLimit
|
||||
result <- case brdc of
|
||||
-- BDWrapAnnKey _annKey bd -> rec bd
|
||||
BDFEmpty -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]
|
||||
BDFLit t ->
|
||||
BDEmpty -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]
|
||||
BDLit t ->
|
||||
return $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False]
|
||||
BDFSeq list -> fmap sumVs . mapM filterAndLimit <$> rec `mapM` list
|
||||
BDFCols _sig list -> fmap sumVs . mapM filterAndLimit <$> rec `mapM` list
|
||||
BDFSeparator -> return $ [VerticalSpacing 1 VerticalSpacingParNone False]
|
||||
BDFAddBaseY indent bd -> do
|
||||
BDSeq list -> fmap sumVs . mapM filterAndLimit <$> rec `mapM` list
|
||||
BDCols _sig list -> fmap sumVs . mapM filterAndLimit <$> rec `mapM` list
|
||||
BDSeparator -> return $ [VerticalSpacing 1 VerticalSpacingParNone False]
|
||||
BDAddBaseY indent bd -> do
|
||||
mVs <- rec bd
|
||||
return $ mVs <&> \vs -> vs
|
||||
{ _vs_paragraph = case _vs_paragraph vs of
|
||||
|
|
@ -718,7 +718,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
i + (confUnpack $ _lconfig_indentAmount $ _conf_layout $ config)
|
||||
BrIndentSpecial j -> i + j
|
||||
}
|
||||
BDFBaseYPushCur bd -> do
|
||||
BDBaseYPushCur bd -> do
|
||||
mVs <- rec bd
|
||||
return $ mVs <&> \vs -> vs
|
||||
-- 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
|
||||
VerticalSpacingParAlways i -> VerticalSpacingParAlways i
|
||||
}
|
||||
BDFIndentLevelPushCur bd -> rec bd
|
||||
BDFIndentLevelPop bd -> rec bd
|
||||
BDFPar BrIndentNone sameLine indented -> do
|
||||
BDIndentLevelPushCur bd -> rec bd
|
||||
BDIndentLevelPop bd -> rec bd
|
||||
BDPar BrIndentNone sameLine indented -> do
|
||||
mVss <- filterAndLimit <$> rec sameLine
|
||||
indSps <- filterAndLimit <$> rec indented
|
||||
let mVsIndSp = take limit $ [ (x, y) | x <- mVss, y <- indSps ]
|
||||
|
|
@ -761,24 +761,24 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
&& _vs_parFlag indSp
|
||||
)
|
||||
|
||||
BDFPar{} -> error "BDPar with indent in getSpacing"
|
||||
BDFAlt [] -> error "empty BDAlt"
|
||||
BDPar{} -> error "BDPar with indent in getSpacing"
|
||||
BDAlt [] -> error "empty BDAlt"
|
||||
-- BDAlt (alt:_) -> rec alt
|
||||
BDFAlt alts -> do
|
||||
BDAlt alts -> do
|
||||
r <- rec `mapM` alts
|
||||
return $ filterAndLimit =<< r
|
||||
BDFForceMultiline bd -> do
|
||||
BDForceMultiline bd -> do
|
||||
mVs <- filterAndLimit <$> rec bd
|
||||
return $ filter ((/= VerticalSpacingParNone) . _vs_paragraph) mVs
|
||||
BDFForceSingleline bd -> do
|
||||
BDForceSingleline bd -> do
|
||||
mVs <- filterAndLimit <$> rec bd
|
||||
return $ filter ((== VerticalSpacingParNone) . _vs_paragraph) mVs
|
||||
BDFForwardLineMode bd -> rec bd
|
||||
BDFExternal _ txt | [t] <- Text.lines txt ->
|
||||
BDForwardLineMode bd -> rec bd
|
||||
BDExternal _ txt | [t] <- Text.lines txt ->
|
||||
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.
|
||||
BDFPlain t -> return
|
||||
BDPlain t -> return
|
||||
[ case Text.lines t of
|
||||
[] -> VerticalSpacing 0 VerticalSpacingParNone False
|
||||
[t1] ->
|
||||
|
|
@ -787,12 +787,12 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
VerticalSpacing (Text.length t1) (VerticalSpacingParAlways 0) True
|
||||
| allowHangingQuasiQuotes
|
||||
]
|
||||
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
|
||||
BDQueueComments _comms bd -> rec bd
|
||||
BDFlushCommentsPrior _loc bd -> rec bd
|
||||
BDFlushCommentsPost _loc bd -> rec bd
|
||||
BDEntryDelta _dp bd -> rec bd
|
||||
BDLines [] -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]
|
||||
BDLines ls@(_ : _) -> do
|
||||
-- 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
|
||||
-- paragraph". That most importantly means that Lines should never
|
||||
|
|
@ -819,7 +819,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
-- [] -> []
|
||||
-- (lSps:_) -> mVs <&> \(VerticalSpacing lsp _) ->
|
||||
-- VerticalSpacing lsp $ VerticalSpacingParSome $ getMaxVS $ maxVs lSps
|
||||
BDFEnsureIndent indent bd -> do
|
||||
BDEnsureIndent indent bd -> do
|
||||
mVs <- rec bd
|
||||
let
|
||||
addInd = case indent of
|
||||
|
|
@ -829,7 +829,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
BrIndentSpecial i -> i
|
||||
return $ mVs <&> \(VerticalSpacing lsp 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
|
||||
-- all tests work without it. It should be possible to have
|
||||
-- `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
|
||||
-- solution would require conditionally folding the search-space
|
||||
-- only in appropriate locations (i.e. a new BriDoc node type
|
||||
-- for this purpose, perhaps "BDFNonBottomSpacing1").
|
||||
-- for this purpose, perhaps "BDNonBottomSpacing1").
|
||||
-- else
|
||||
-- [ Foldable.foldl1
|
||||
-- (\(VerticalSpacing x1 x2 _) (VerticalSpacing y1 y2 _) ->
|
||||
|
|
@ -884,20 +884,20 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
-- False)
|
||||
-- mVs
|
||||
-- ]
|
||||
BDFSetParSpacing bd -> do
|
||||
BDSetParSpacing bd -> do
|
||||
mVs <- rec bd
|
||||
return $ mVs <&> \vs -> vs { _vs_parFlag = True }
|
||||
BDFForceParSpacing bd -> do
|
||||
BDForceParSpacing bd -> do
|
||||
mVs <- preFilterLimit <$> rec bd
|
||||
return
|
||||
$ [ vs
|
||||
| vs <- mVs
|
||||
, _vs_parFlag vs || _vs_paragraph vs == VerticalSpacingParNone
|
||||
]
|
||||
BDFDebug s bd -> do
|
||||
BDDebug s bd -> do
|
||||
r <- rec bd
|
||||
tellDebugMess
|
||||
$ "getSpacings: BDFDebug "
|
||||
$ "getSpacings: BDDebug "
|
||||
++ show s
|
||||
++ " (node-id="
|
||||
++ show brDcId
|
||||
|
|
|
|||
Loading…
Reference in New Issue