{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Language.Haskell.Brittany.Internal.LayouterBasics
  ( processDefault
  , rdrNameToText
  , lrdrNameToText
  , lrdrNameToTextAnn
  , lrdrNameToTextAnnTypeEqualityIsSpecial
  , lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick
  , askIndent
  , extractAllComments
  , extractRestComments
  , filterAnns
  , docEmpty
  , docLit
  , docLitS
  , docAlt
  , CollectAltM
  , addAlternativeCond
  , addAlternative
  , runFilteredAlternative
  , docLines
  , docCols
  , docSeq
  , docPar
  , docNodeAnnKW
  , docNodeMoveToKWDP
  , docWrapNode
  , docWrapNodePrior
  , docWrapNodeRest
  , docForceSingleline
  , docForceMultiline
  , docEnsureIndent
  , docAddBaseY
  , docSetBaseY
  , docSetIndentLevel
  , docSeparator
  , docAnnotationPrior
  , docAnnotationKW
  , docAnnotationRest
  , docMoveToKWDP
  , docNonBottomSpacing
  , docNonBottomSpacingS
  , docSetParSpacing
  , docForceParSpacing
  , docDebug
  , docSetBaseAndIndent
  , briDocByExact
  , briDocByExactNoComment
  , briDocByExactInlineOnly
  , foldedAnnKeys
  , unknownNodeError
  , appSep
  , docCommaSep
  , docParenLSep
  , docParenL
  , docParenR
  , docParenHashLSep
  , docParenHashRSep
  , docBracketL
  , docBracketR
  , docTick
  , spacifyDocs
  , briDocMToPPM
  , briDocMToPPMInner
  , allocateNode
  , docSharedWrapper
  , hasAnyCommentsBelow
  , hasCommentsBetween
  , hasAnyCommentsConnected
  , hasAnyCommentsPrior
  , hasAnyRegularCommentsConnected
  , hasAnyRegularCommentsRest
  , hasAnnKeywordComment
  , hasAnnKeyword
  )
where



#include "prelude.inc"

import qualified Control.Monad.Writer.Strict as Writer

import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
import qualified Language.Haskell.GHC.ExactPrint.Annotate as ExactPrint.Annotate
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
import qualified Language.Haskell.GHC.ExactPrint.Utils as ExactPrint.Utils

import Language.Haskell.GHC.ExactPrint.Types ( AnnKey, Annotation, KeywordId )

import qualified Data.Text.Lazy.Builder as Text.Builder

import Language.Haskell.Brittany.Internal.Config.Types
import Language.Haskell.Brittany.Internal.Types
import Language.Haskell.Brittany.Internal.Utils
import Language.Haskell.Brittany.Internal.ExactPrintUtils

import           RdrName ( RdrName(..) )
import           GHC ( Located, runGhc, GenLocated(L), moduleNameString )
import qualified SrcLoc        as GHC
import           OccName ( occNameString )
import           Name ( getOccString )
import           Module ( moduleName )
import           ApiAnnotation ( AnnKeywordId(..) )

import           Data.Data
import           Data.Generics.Schemes

import qualified Data.Char as Char

import           DataTreePrint

import           Data.HList.HList



processDefault
  :: ( ExactPrint.Annotate.Annotate ast
     , MonadMultiWriter Text.Builder.Builder m
     , MonadMultiReader ExactPrint.Types.Anns m
     )
  => Located ast
  -> m ()
processDefault :: Located ast -> m ()
processDefault Located ast
x = do
  Anns
anns <- m Anns
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk
  let str :: String
str = Located ast -> Anns -> String
forall ast. Annotate ast => Located ast -> Anns -> String
ExactPrint.exactPrint Located ast
x Anns
anns
  -- this hack is here so our print-empty-module trick does not add
  -- a newline at the start if there actually is no module header / imports
  -- / anything.
  -- TODO: instead the appropriate annotation could be removed when "cleaning"
  --       the module (header). This would remove the need for this hack!
  case String
str of
    String
"\n" -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    String
_    -> Builder -> m ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell (Builder -> m ()) -> Builder -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Builder
Text.Builder.fromString String
str

-- | Use ExactPrint's output for this node; add a newly generated inline comment
-- at insertion position (meant to point out to the user that this node is
-- not handled by brittany yet). Useful when starting implementing new
-- syntactic constructs when children are not handled yet.
briDocByExact
  :: (ExactPrint.Annotate.Annotate ast)
  => Located ast
  -> ToBriDocM BriDocNumbered
briDocByExact :: Located ast -> ToBriDocM BriDocNumbered
briDocByExact Located ast
ast = do
  Anns
anns <- MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  Anns
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk
  String
-> (DebugConfig -> Identity (Last Bool))
-> Doc
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     ()
forall (m :: * -> *) a.
(MonadMultiReader Config m, Show a) =>
String -> (DebugConfig -> Identity (Last Bool)) -> a -> m ()
traceIfDumpConf String
"ast"
                  DebugConfig -> Identity (Last Bool)
forall (f :: * -> *). CDebugConfig f -> f (Last Bool)
_dconf_dump_ast_unknown
                  (Int -> LayouterF -> Located ast -> Doc
forall a. Data a => Int -> LayouterF -> a -> Doc
printTreeWithCustom Int
100 (Anns -> LayouterF
customLayouterF Anns
anns) Located ast
ast)
  Located ast -> Anns -> Bool -> ToBriDocM BriDocNumbered
forall ast.
Annotate ast =>
Located ast -> Anns -> Bool -> ToBriDocM BriDocNumbered
docExt Located ast
ast Anns
anns Bool
True

-- | Use ExactPrint's output for this node.
-- Consider that for multi-line input, the indentation of the code produced
-- by ExactPrint might be different, and even incompatible with the indentation
-- of its surroundings as layouted by brittany. But there are safe uses of
-- this, e.g. for any top-level declarations.
briDocByExactNoComment
  :: (ExactPrint.Annotate.Annotate ast)
  => Located ast
  -> ToBriDocM BriDocNumbered
briDocByExactNoComment :: Located ast -> ToBriDocM BriDocNumbered
briDocByExactNoComment Located ast
ast = do
  Anns
anns <- MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  Anns
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk
  String
-> (DebugConfig -> Identity (Last Bool))
-> Doc
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     ()
forall (m :: * -> *) a.
(MonadMultiReader Config m, Show a) =>
String -> (DebugConfig -> Identity (Last Bool)) -> a -> m ()
traceIfDumpConf String
"ast"
                  DebugConfig -> Identity (Last Bool)
forall (f :: * -> *). CDebugConfig f -> f (Last Bool)
_dconf_dump_ast_unknown
                  (Int -> LayouterF -> Located ast -> Doc
forall a. Data a => Int -> LayouterF -> a -> Doc
printTreeWithCustom Int
100 (Anns -> LayouterF
customLayouterF Anns
anns) Located ast
ast)
  Located ast -> Anns -> Bool -> ToBriDocM BriDocNumbered
forall ast.
Annotate ast =>
Located ast -> Anns -> Bool -> ToBriDocM BriDocNumbered
docExt Located ast
ast Anns
anns Bool
False

-- | Use ExactPrint's output for this node, presuming that this output does
-- not contain any newlines. If this property is not met, the semantics
-- depend on the @econf_AllowRiskyExactPrintUse@ config flag.
briDocByExactInlineOnly
  :: (ExactPrint.Annotate.Annotate ast, Data ast)
  => String
  -> Located ast
  -> ToBriDocM BriDocNumbered
briDocByExactInlineOnly :: String -> Located ast -> ToBriDocM BriDocNumbered
briDocByExactInlineOnly String
infoStr Located ast
ast = do
  Anns
anns <- MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  Anns
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk
  String
-> (DebugConfig -> Identity (Last Bool))
-> Doc
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     ()
forall (m :: * -> *) a.
(MonadMultiReader Config m, Show a) =>
String -> (DebugConfig -> Identity (Last Bool)) -> a -> m ()
traceIfDumpConf String
"ast"
                  DebugConfig -> Identity (Last Bool)
forall (f :: * -> *). CDebugConfig f -> f (Last Bool)
_dconf_dump_ast_unknown
                  (Int -> LayouterF -> Located ast -> Doc
forall a. Data a => Int -> LayouterF -> a -> Doc
printTreeWithCustom Int
100 (Anns -> LayouterF
customLayouterF Anns
anns) Located ast
ast)
  let exactPrinted :: Text
exactPrinted = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Located ast -> Anns -> String
forall ast. Annotate ast => Located ast -> Anns -> String
ExactPrint.exactPrint Located ast
ast Anns
anns
  ExactPrintFallbackMode
fallbackMode <-
    MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  Config
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  Config
-> (Config -> ExactPrintFallbackMode)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     ExactPrintFallbackMode
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Config -> CErrorHandlingConfig Identity
forall (f :: * -> *). CConfig f -> CErrorHandlingConfig f
_conf_errorHandling (Config -> CErrorHandlingConfig Identity)
-> (CErrorHandlingConfig Identity
    -> Identity (Last ExactPrintFallbackMode))
-> Config
-> Identity (Last ExactPrintFallbackMode)
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> CErrorHandlingConfig Identity
-> Identity (Last ExactPrintFallbackMode)
forall (f :: * -> *).
CErrorHandlingConfig f -> f (Last ExactPrintFallbackMode)
_econf_ExactPrintFallback (Config -> Identity (Last ExactPrintFallbackMode))
-> (Identity (Last ExactPrintFallbackMode)
    -> ExactPrintFallbackMode)
-> Config
-> ExactPrintFallbackMode
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> Identity (Last ExactPrintFallbackMode) -> ExactPrintFallbackMode
forall a b. Coercible a b => Identity a -> b
confUnpack
  let exactPrintNode :: Text -> ToBriDocM BriDocNumbered
exactPrintNode Text
t = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> BriDocFInt -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ AnnKey -> Set AnnKey -> Bool -> Text -> BriDocFInt
forall (f :: * -> *).
AnnKey -> Set AnnKey -> Bool -> Text -> BriDocF f
BDFExternal
        (Located ast -> AnnKey
forall a. Constraints a => a -> AnnKey
ExactPrint.Types.mkAnnKey Located ast
ast)
        (Located ast -> Set AnnKey
forall ast. Data ast => ast -> Set AnnKey
foldedAnnKeys Located ast
ast)
        Bool
False
        Text
t
  let errorAction :: ToBriDocM BriDocNumbered
errorAction = do
        [BrittanyError]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell [String -> Located ast -> BrittanyError
forall ast.
Data ast =>
String -> GenLocated SrcSpan ast -> BrittanyError
ErrorUnknownNode String
infoStr Located ast
ast]
        Text -> ToBriDocM BriDocNumbered
docLit
          (Text -> ToBriDocM BriDocNumbered)
-> Text -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"
  case (ExactPrintFallbackMode
fallbackMode, Text -> [Text]
Text.lines Text
exactPrinted) of
    (ExactPrintFallbackMode
ExactPrintFallbackModeNever, [Text]
_  ) -> ToBriDocM BriDocNumbered
errorAction
    (ExactPrintFallbackMode
_                          , [Text
t]) -> Text -> ToBriDocM BriDocNumbered
exactPrintNode
      ((Char -> Bool) -> Text -> Text
Text.dropWhile Char -> Bool
Char.isSpace (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Text.dropWhileEnd Char -> Bool
Char.isSpace (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
t)
    (ExactPrintFallbackMode
ExactPrintFallbackModeRisky, [Text]
_) -> Text -> ToBriDocM BriDocNumbered
exactPrintNode Text
exactPrinted
    (ExactPrintFallbackMode, [Text])
_ -> ToBriDocM BriDocNumbered
errorAction

rdrNameToText :: RdrName -> Text
-- rdrNameToText = Text.pack . show . flip runSDoc unsafeGlobalDynFlags . ppr
rdrNameToText :: RdrName -> Text
rdrNameToText (Unqual OccName
occname) = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ OccName -> String
occNameString OccName
occname
rdrNameToText (Qual ModuleName
mname OccName
occname) =
  String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString ModuleName
mname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ OccName -> String
occNameString OccName
occname
rdrNameToText (Orig Module
modul OccName
occname) =
  String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString (Module -> ModuleName
moduleName Module
modul) String -> String -> String
forall a. [a] -> [a] -> [a]
++ OccName -> String
occNameString OccName
occname
rdrNameToText (Exact Name
name) = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. NamedThing a => a -> String
getOccString Name
name

lrdrNameToText :: GenLocated l RdrName -> Text
lrdrNameToText :: GenLocated l RdrName -> Text
lrdrNameToText (L l
_ RdrName
n) = RdrName -> Text
rdrNameToText RdrName
n

lrdrNameToTextAnnGen
  :: (MonadMultiReader Config m, MonadMultiReader (Map AnnKey Annotation) m)
  => (Text -> Text)
  -> Located RdrName
  -> m Text
lrdrNameToTextAnnGen :: (Text -> Text) -> Located RdrName -> m Text
lrdrNameToTextAnnGen Text -> Text
f ast :: Located RdrName
ast@(L SrcSpan
_ RdrName
n) = do
  Anns
anns <- m Anns
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk
  let t :: Text
t = Text -> Text
f (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ RdrName -> Text
rdrNameToText RdrName
n
  let hasUni :: AnnKeywordId -> (KeywordId, b) -> Bool
hasUni AnnKeywordId
x (ExactPrint.Types.G AnnKeywordId
y, b
_) = AnnKeywordId
x AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
y
      hasUni AnnKeywordId
_ (KeywordId, b)
_                         = Bool
False
  -- TODO: in general: we should _always_ process all annotaiton stuff here.
  --       whatever we don't probably should have had some effect on the
  --       output. in such cases, resorting to byExact is probably the safe
  --       choice.
  Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ case AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Located RdrName -> AnnKey
forall a. Constraints a => a -> AnnKey
ExactPrint.Types.mkAnnKey Located RdrName
ast) Anns
anns of
    Maybe Annotation
Nothing                                   -> Text
t
    Just (ExactPrint.Types.Ann DeltaPos
_ [(Comment, DeltaPos)]
_ [(Comment, DeltaPos)]
_ [(KeywordId, DeltaPos)]
aks Maybe [SrcSpan]
_ Maybe AnnKey
_) -> case RdrName
n of
      Exact{} | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
Text.pack String
"()"      -> Text
t
      RdrName
_ | ((KeywordId, DeltaPos) -> Bool) -> [(KeywordId, DeltaPos)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (AnnKeywordId -> (KeywordId, DeltaPos) -> Bool
forall b. AnnKeywordId -> (KeywordId, b) -> Bool
hasUni AnnKeywordId
AnnBackquote) [(KeywordId, DeltaPos)]
aks  -> String -> Text
Text.pack String
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
"`"
      RdrName
_ | ((KeywordId, DeltaPos) -> Bool) -> [(KeywordId, DeltaPos)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (AnnKeywordId -> (KeywordId, DeltaPos) -> Bool
forall b. AnnKeywordId -> (KeywordId, b) -> Bool
hasUni AnnKeywordId
AnnCommaTuple) [(KeywordId, DeltaPos)]
aks -> Text
t
      RdrName
_ | ((KeywordId, DeltaPos) -> Bool) -> [(KeywordId, DeltaPos)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (AnnKeywordId -> (KeywordId, DeltaPos) -> Bool
forall b. AnnKeywordId -> (KeywordId, b) -> Bool
hasUni AnnKeywordId
AnnOpenP) [(KeywordId, DeltaPos)]
aks      -> String -> Text
Text.pack String
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
")"
      RdrName
_ | Bool
otherwise                      -> Text
t

lrdrNameToTextAnn
  :: (MonadMultiReader Config m, MonadMultiReader (Map AnnKey Annotation) m)
  => Located RdrName
  -> m Text
lrdrNameToTextAnn :: Located RdrName -> m Text
lrdrNameToTextAnn = (Text -> Text) -> Located RdrName -> m Text
forall (m :: * -> *).
(MonadMultiReader Config m, MonadMultiReader Anns m) =>
(Text -> Text) -> Located RdrName -> m Text
lrdrNameToTextAnnGen Text -> Text
forall a. a -> a
id

lrdrNameToTextAnnTypeEqualityIsSpecial
  :: (MonadMultiReader Config m, MonadMultiReader (Map AnnKey Annotation) m)
  => Located RdrName
  -> m Text
lrdrNameToTextAnnTypeEqualityIsSpecial :: Located RdrName -> m Text
lrdrNameToTextAnnTypeEqualityIsSpecial Located RdrName
ast = do
  let f :: Text -> Text
f Text
x = if Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
Text.pack String
"Data.Type.Equality~"
        then String -> Text
Text.pack String
"~" -- rraaaahhh special casing rraaahhhhhh
        else Text
x
  (Text -> Text) -> Located RdrName -> m Text
forall (m :: * -> *).
(MonadMultiReader Config m, MonadMultiReader Anns m) =>
(Text -> Text) -> Located RdrName -> m Text
lrdrNameToTextAnnGen Text -> Text
f Located RdrName
ast

-- | Same as lrdrNameToTextAnnTypeEqualityIsSpecial, but also inspects
-- the annotations for a (parent) node for a tick to be added to the
-- literal.
-- Excessively long name to reflect on us having to work around such
-- excessively obscure special cases in the exactprint API.
lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick
  :: ( Data ast
     , MonadMultiReader Config m
     , MonadMultiReader (Map AnnKey Annotation) m
     )
  => Located ast
  -> Located RdrName
  -> m Text
lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick :: Located ast -> Located RdrName -> m Text
lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick Located ast
ast1 Located RdrName
ast2 = do
  Bool
hasQuote <- Located ast -> AnnKeywordId -> m Bool
forall a (m :: * -> *).
(Data a, MonadMultiReader Anns m) =>
Located a -> AnnKeywordId -> m Bool
hasAnnKeyword Located ast
ast1 AnnKeywordId
AnnSimpleQuote
  Text
x        <- Located RdrName -> m Text
forall (m :: * -> *).
(MonadMultiReader Config m, MonadMultiReader Anns m) =>
Located RdrName -> m Text
lrdrNameToTextAnn Located RdrName
ast2
  let lit :: Text
lit = if Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
Text.pack String
"Data.Type.Equality~"
        then String -> Text
Text.pack String
"~" -- rraaaahhh special casing rraaahhhhhh
        else Text
x
  Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ if Bool
hasQuote then Char -> Text -> Text
Text.cons Char
'\'' Text
lit else Text
lit

askIndent :: (MonadMultiReader Config m) => m Int
askIndent :: m Int
askIndent = Identity (Last Int) -> Int
forall a b. Coercible a b => Identity a -> b
confUnpack (Identity (Last Int) -> Int)
-> (Config -> Identity (Last Int)) -> Config -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLayoutConfig Identity -> Identity (Last Int)
forall (f :: * -> *). CLayoutConfig f -> f (Last Int)
_lconfig_indentAmount (CLayoutConfig Identity -> Identity (Last Int))
-> (Config -> CLayoutConfig Identity)
-> Config
-> Identity (Last Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout (Config -> Int) -> m Config -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Config
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk


extractAllComments
  :: ExactPrint.Annotation -> [(ExactPrint.Comment, ExactPrint.DeltaPos)]
extractAllComments :: Annotation -> [(Comment, DeltaPos)]
extractAllComments Annotation
ann =
  Annotation -> [(Comment, DeltaPos)]
ExactPrint.annPriorComments Annotation
ann [(Comment, DeltaPos)]
-> [(Comment, DeltaPos)] -> [(Comment, DeltaPos)]
forall a. [a] -> [a] -> [a]
++ Annotation -> [(Comment, DeltaPos)]
extractRestComments Annotation
ann

extractRestComments
  :: ExactPrint.Annotation -> [(ExactPrint.Comment, ExactPrint.DeltaPos)]
extractRestComments :: Annotation -> [(Comment, DeltaPos)]
extractRestComments Annotation
ann =
  Annotation -> [(Comment, DeltaPos)]
ExactPrint.annFollowingComments Annotation
ann
    [(Comment, DeltaPos)]
-> [(Comment, DeltaPos)] -> [(Comment, DeltaPos)]
forall a. [a] -> [a] -> [a]
++ (Annotation -> [(KeywordId, DeltaPos)]
ExactPrint.annsDP Annotation
ann [(KeywordId, DeltaPos)]
-> ((KeywordId, DeltaPos) -> [(Comment, DeltaPos)])
-> [(Comment, DeltaPos)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
         (ExactPrint.AnnComment Comment
com, DeltaPos
dp) -> [(Comment
com, DeltaPos
dp)]
         (KeywordId, DeltaPos)
_                               -> []
       )

filterAnns :: Data.Data.Data ast => ast -> ExactPrint.Anns -> ExactPrint.Anns
filterAnns :: ast -> Anns -> Anns
filterAnns ast
ast =
  (AnnKey -> Annotation -> Bool) -> Anns -> Anns
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\AnnKey
k Annotation
_ -> AnnKey
k AnnKey -> Set AnnKey -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` ast -> Set AnnKey
forall ast. Data ast => ast -> Set AnnKey
foldedAnnKeys ast
ast)

-- | True if there are any comments that are
-- a) connected to any node below (in AST sense) the given node AND
-- b) after (in source code order) the node.
hasAnyCommentsBelow :: Data ast => GHC.Located ast -> ToBriDocM Bool
hasAnyCommentsBelow :: Located ast -> ToBriDocM Bool
hasAnyCommentsBelow ast :: Located ast
ast@(L SrcSpan
l ast
_) =
  ((Comment, DeltaPos) -> Bool) -> [(Comment, DeltaPos)] -> Bool
forall a. (a -> Bool) -> [a] -> Bool
List.any (\(Comment
c, DeltaPos
_) -> Comment -> SrcSpan
ExactPrint.commentIdentifier Comment
c SrcSpan -> SrcSpan -> Bool
forall a. Ord a => a -> a -> Bool
> SrcSpan
l)
    ([(Comment, DeltaPos)] -> Bool)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [(Comment, DeltaPos)]
-> ToBriDocM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Located ast
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [(Comment, DeltaPos)]
forall ast.
Data ast =>
Located ast
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [(Comment, DeltaPos)]
astConnectedComments Located ast
ast

hasCommentsBetween
  :: Data ast
  => GHC.Located ast
  -> AnnKeywordId
  -> AnnKeywordId
  -> ToBriDocM Bool
hasCommentsBetween :: Located ast -> AnnKeywordId -> AnnKeywordId -> ToBriDocM Bool
hasCommentsBetween Located ast
ast AnnKeywordId
leftKey AnnKeywordId
rightKey = do
  Maybe Annotation
mAnn <- Located ast
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     (Maybe Annotation)
forall ast (m :: * -> *).
(Data ast, MonadMultiReader Anns m) =>
Located ast -> m (Maybe Annotation)
astAnn Located ast
ast
  let go1 :: [(KeywordId, DeltaPos)] -> Bool
go1 []         = Bool
False
      go1 ((ExactPrint.G AnnKeywordId
kw, DeltaPos
_dp) : [(KeywordId, DeltaPos)]
rest) | AnnKeywordId
kw AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
leftKey = [(KeywordId, DeltaPos)] -> Bool
go2 [(KeywordId, DeltaPos)]
rest
      go1 ((KeywordId, DeltaPos)
_ : [(KeywordId, DeltaPos)]
rest) = [(KeywordId, DeltaPos)] -> Bool
go1 [(KeywordId, DeltaPos)]
rest
      go2 :: [(KeywordId, DeltaPos)] -> Bool
go2 []         = Bool
False
      go2 ((ExactPrint.AnnComment Comment
_, DeltaPos
_dp) : [(KeywordId, DeltaPos)]
_rest) = Bool
True
      go2 ((ExactPrint.G AnnKeywordId
kw, DeltaPos
_dp) : [(KeywordId, DeltaPos)]
_rest) | AnnKeywordId
kw AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
rightKey = Bool
False
      go2 ((KeywordId, DeltaPos)
_ : [(KeywordId, DeltaPos)]
rest) = [(KeywordId, DeltaPos)] -> Bool
go2 [(KeywordId, DeltaPos)]
rest
  case Maybe Annotation
mAnn of
    Maybe Annotation
Nothing  -> Bool -> ToBriDocM Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    Just Annotation
ann -> Bool -> ToBriDocM Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> ToBriDocM Bool) -> Bool -> ToBriDocM Bool
forall a b. (a -> b) -> a -> b
$ [(KeywordId, DeltaPos)] -> Bool
go1 ([(KeywordId, DeltaPos)] -> Bool)
-> [(KeywordId, DeltaPos)] -> Bool
forall a b. (a -> b) -> a -> b
$ Annotation -> [(KeywordId, DeltaPos)]
ExactPrint.annsDP Annotation
ann

-- | True if there are any comments that are connected to any node below (in AST
--   sense) the given node
hasAnyCommentsConnected :: Data ast => GHC.Located ast -> ToBriDocM Bool
hasAnyCommentsConnected :: Located ast -> ToBriDocM Bool
hasAnyCommentsConnected Located ast
ast = Bool -> Bool
not (Bool -> Bool)
-> ([(Comment, DeltaPos)] -> Bool) -> [(Comment, DeltaPos)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Comment, DeltaPos)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Comment, DeltaPos)] -> Bool)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [(Comment, DeltaPos)]
-> ToBriDocM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Located ast
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [(Comment, DeltaPos)]
forall ast.
Data ast =>
Located ast
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [(Comment, DeltaPos)]
astConnectedComments Located ast
ast

-- | True if there are any regular comments connected to any node below (in AST
--   sense) the given node
hasAnyRegularCommentsConnected :: Data ast => GHC.Located ast -> ToBriDocM Bool
hasAnyRegularCommentsConnected :: Located ast -> ToBriDocM Bool
hasAnyRegularCommentsConnected Located ast
ast =
  ((Comment, DeltaPos) -> Bool) -> [(Comment, DeltaPos)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Comment, DeltaPos) -> Bool
isRegularComment ([(Comment, DeltaPos)] -> Bool)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [(Comment, DeltaPos)]
-> ToBriDocM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Located ast
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [(Comment, DeltaPos)]
forall ast.
Data ast =>
Located ast
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [(Comment, DeltaPos)]
astConnectedComments Located ast
ast

-- | Regular comments are comments that are actually "source code comments",
-- i.e. things that start with "--" or "{-". In contrast to comment-annotations
-- used by ghc-exactprint for capturing symbols (and their exact positioning).
--
-- Only the type instance layouter makes use of this filter currently, but
-- it might make sense to apply it more aggressively or make it the default -
-- I believe that most of the time we branch on the existence of comments, we
-- only care about "regular" comments. We simply did not need the distinction
-- because "irregular" comments are not that common outside of type/data decls.
isRegularComment :: (ExactPrint.Comment, ExactPrint.DeltaPos) -> Bool
isRegularComment :: (Comment, DeltaPos) -> Bool
isRegularComment = (Maybe AnnKeywordId -> Maybe AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe AnnKeywordId
forall a. Maybe a
Nothing) (Maybe AnnKeywordId -> Bool)
-> ((Comment, DeltaPos) -> Maybe AnnKeywordId)
-> (Comment, DeltaPos)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment -> Maybe AnnKeywordId
ExactPrint.Types.commentOrigin (Comment -> Maybe AnnKeywordId)
-> ((Comment, DeltaPos) -> Comment)
-> (Comment, DeltaPos)
-> Maybe AnnKeywordId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Comment, DeltaPos) -> Comment
forall a b. (a, b) -> a
fst

astConnectedComments
  :: Data ast
  => GHC.Located ast
  -> ToBriDocM [(ExactPrint.Types.Comment, ExactPrint.Types.DeltaPos)]
astConnectedComments :: Located ast
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [(Comment, DeltaPos)]
astConnectedComments Located ast
ast = do
  Anns
anns <- Located ast -> Anns -> Anns
forall ast. Data ast => ast -> Anns -> Anns
filterAnns Located ast
ast (Anns -> Anns)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     Anns
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     Anns
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  Anns
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk
  [(Comment, DeltaPos)]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [(Comment, DeltaPos)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Comment, DeltaPos)]
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      [(Comment, DeltaPos)])
-> [(Comment, DeltaPos)]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [(Comment, DeltaPos)]
forall a b. (a -> b) -> a -> b
$ Annotation -> [(Comment, DeltaPos)]
extractAllComments (Annotation -> [(Comment, DeltaPos)])
-> [Annotation] -> [(Comment, DeltaPos)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Anns -> [Annotation]
forall k a. Map k a -> [a]
Map.elems Anns
anns

hasAnyCommentsPrior :: Data ast => GHC.Located ast -> ToBriDocM Bool
hasAnyCommentsPrior :: Located ast -> ToBriDocM Bool
hasAnyCommentsPrior Located ast
ast = Located ast
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     (Maybe Annotation)
forall ast (m :: * -> *).
(Data ast, MonadMultiReader Anns m) =>
Located ast -> m (Maybe Annotation)
astAnn Located ast
ast MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  (Maybe Annotation)
-> (Maybe Annotation -> Bool) -> ToBriDocM Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
  Maybe Annotation
Nothing -> Bool
False
  Just (ExactPrint.Types.Ann DeltaPos
_ [(Comment, DeltaPos)]
priors [(Comment, DeltaPos)]
_ [(KeywordId, DeltaPos)]
_ Maybe [SrcSpan]
_ Maybe AnnKey
_) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Comment, DeltaPos)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Comment, DeltaPos)]
priors

hasAnyRegularCommentsRest :: Data ast => GHC.Located ast -> ToBriDocM Bool
hasAnyRegularCommentsRest :: Located ast -> ToBriDocM Bool
hasAnyRegularCommentsRest Located ast
ast = Located ast
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     (Maybe Annotation)
forall ast (m :: * -> *).
(Data ast, MonadMultiReader Anns m) =>
Located ast -> m (Maybe Annotation)
astAnn Located ast
ast MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  (Maybe Annotation)
-> (Maybe Annotation -> Bool) -> ToBriDocM Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
  Maybe Annotation
Nothing -> Bool
False
  Just Annotation
ann -> ((Comment, DeltaPos) -> Bool) -> [(Comment, DeltaPos)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Comment, DeltaPos) -> Bool
isRegularComment (Annotation -> [(Comment, DeltaPos)]
extractRestComments Annotation
ann)

hasAnnKeywordComment
  :: Data ast => GHC.Located ast -> AnnKeywordId -> ToBriDocM Bool
hasAnnKeywordComment :: Located ast -> AnnKeywordId -> ToBriDocM Bool
hasAnnKeywordComment Located ast
ast AnnKeywordId
annKeyword = Located ast
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     (Maybe Annotation)
forall ast (m :: * -> *).
(Data ast, MonadMultiReader Anns m) =>
Located ast -> m (Maybe Annotation)
astAnn Located ast
ast MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  (Maybe Annotation)
-> (Maybe Annotation -> Bool) -> ToBriDocM Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
  Maybe Annotation
Nothing  -> Bool
False
  Just Annotation
ann -> ((Comment, DeltaPos) -> Bool) -> [(Comment, DeltaPos)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Comment, DeltaPos) -> Bool
hasK (Annotation -> [(Comment, DeltaPos)]
extractAllComments Annotation
ann)
  where hasK :: (Comment, DeltaPos) -> Bool
hasK = (Maybe AnnKeywordId -> Maybe AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId -> Maybe AnnKeywordId
forall a. a -> Maybe a
Just AnnKeywordId
annKeyword) (Maybe AnnKeywordId -> Bool)
-> ((Comment, DeltaPos) -> Maybe AnnKeywordId)
-> (Comment, DeltaPos)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment -> Maybe AnnKeywordId
ExactPrint.Types.commentOrigin (Comment -> Maybe AnnKeywordId)
-> ((Comment, DeltaPos) -> Comment)
-> (Comment, DeltaPos)
-> Maybe AnnKeywordId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Comment, DeltaPos) -> Comment
forall a b. (a, b) -> a
fst

hasAnnKeyword
  :: (Data a, MonadMultiReader (Map AnnKey Annotation) m)
  => Located a
  -> AnnKeywordId
  -> m Bool
hasAnnKeyword :: Located a -> AnnKeywordId -> m Bool
hasAnnKeyword Located a
ast AnnKeywordId
annKeyword = Located a -> m (Maybe Annotation)
forall ast (m :: * -> *).
(Data ast, MonadMultiReader Anns m) =>
Located ast -> m (Maybe Annotation)
astAnn Located a
ast m (Maybe Annotation) -> (Maybe Annotation -> Bool) -> m Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
  Maybe Annotation
Nothing -> Bool
False
  Just (ExactPrint.Types.Ann DeltaPos
_ [(Comment, DeltaPos)]
_ [(Comment, DeltaPos)]
_ [(KeywordId, DeltaPos)]
aks Maybe [SrcSpan]
_ Maybe AnnKey
_) -> ((KeywordId, DeltaPos) -> Bool) -> [(KeywordId, DeltaPos)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (KeywordId, DeltaPos) -> Bool
hasK [(KeywordId, DeltaPos)]
aks
 where
  hasK :: (KeywordId, DeltaPos) -> Bool
hasK (ExactPrint.Types.G AnnKeywordId
x, DeltaPos
_) = AnnKeywordId
x AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
annKeyword
  hasK (KeywordId, DeltaPos)
_                         = Bool
False

astAnn
  :: (Data ast, MonadMultiReader (Map AnnKey Annotation) m)
  => GHC.Located ast
  -> m (Maybe Annotation)
astAnn :: Located ast -> m (Maybe Annotation)
astAnn Located ast
ast = AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Located ast -> AnnKey
forall a. Constraints a => a -> AnnKey
ExactPrint.Types.mkAnnKey Located ast
ast) (Anns -> Maybe Annotation) -> m Anns -> m (Maybe Annotation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Anns
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk

-- new BriDoc stuff

allocateNode
  :: MonadMultiState NodeAllocIndex m => BriDocFInt -> m BriDocNumbered
allocateNode :: BriDocFInt -> m BriDocNumbered
allocateNode BriDocFInt
bd = do
  Int
i <- m Int
forall (m :: * -> *). MonadMultiState NodeAllocIndex m => m Int
allocNodeIndex
  BriDocNumbered -> m BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, BriDocFInt
bd)

allocNodeIndex :: MonadMultiState NodeAllocIndex m => m Int
allocNodeIndex :: m Int
allocNodeIndex = do
  NodeAllocIndex Int
i <- m NodeAllocIndex
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
  NodeAllocIndex -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (NodeAllocIndex -> m ()) -> NodeAllocIndex -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> NodeAllocIndex
NodeAllocIndex (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i

-- docEmpty :: MonadMultiState NodeAllocIndex m => m BriDocNumbered
-- docEmpty = allocateNode BDFEmpty
--
-- docLit :: MonadMultiState NodeAllocIndex m => Text -> m BriDocNumbered
-- docLit t = allocateNode $ BDFLit t
--
-- docExt :: (ExactPrint.Annotate.Annotate ast, MonadMultiState NodeAllocIndex m)
--        => Located ast -> ExactPrint.Types.Anns -> Bool -> m BriDocNumbered
-- docExt x anns shouldAddComment = allocateNode $ BDFExternal
--                   (ExactPrint.Types.mkAnnKey x)
--                   (foldedAnnKeys x)
--                   shouldAddComment
--                   (Text.pack $ ExactPrint.exactPrint x anns)
--
-- docAlt :: MonadMultiState NodeAllocIndex m => [m BriDocNumbered] -> m BriDocNumbered
-- docAlt l = allocateNode . BDFAlt =<< sequence l
--
--
-- docSeq :: MonadMultiState NodeAllocIndex m => [m BriDocNumbered] -> m BriDocNumbered
-- docSeq l = allocateNode . BDFSeq =<< sequence l
--
-- docLines :: MonadMultiState NodeAllocIndex m => [m BriDocNumbered] -> m BriDocNumbered
-- docLines l = allocateNode . BDFLines =<< sequence l
--
-- docCols :: MonadMultiState NodeAllocIndex m => ColSig -> [m BriDocNumbered] -> m BriDocNumbered
-- docCols sig l = allocateNode . BDFCols sig =<< sequence l
--
-- docAddBaseY :: MonadMultiState NodeAllocIndex m => BrIndent -> m BriDocNumbered -> m BriDocNumbered
-- docAddBaseY ind bdm = allocateNode . BDFAddBaseY ind =<< bdm
--
-- docSetBaseY :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -> m BriDocNumbered
-- docSetBaseY bdm = allocateNode . BDFSetBaseY =<< bdm
--
-- docSetIndentLevel :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -> m BriDocNumbered
-- docSetIndentLevel bdm = allocateNode . BDFSetIndentLevel =<< bdm
--
-- docSeparator :: MonadMultiState NodeAllocIndex m => m BriDocNumbered
-- docSeparator = allocateNode BDFSeparator
--
-- docAnnotationPrior :: MonadMultiState NodeAllocIndex m => AnnKey -> m BriDocNumbered -> m BriDocNumbered
-- docAnnotationPrior annKey bdm = allocateNode . BDFAnnotationPrior annKey =<< bdm
--
-- docAnnotationPost :: MonadMultiState NodeAllocIndex m => AnnKey -> m BriDocNumbered -> m BriDocNumbered
-- docAnnotationPost  annKey bdm = allocateNode . BDFAnnotationPost annKey =<< bdm
--
-- docNonBottomSpacing :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -> m BriDocNumbered
-- docNonBottomSpacing bdm = allocateNode . BDFNonBottomSpacing =<< bdm
--
-- appSep :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -> m BriDocNumbered
-- appSep x = docSeq [x, docSeparator]
--
-- docCommaSep :: MonadMultiState NodeAllocIndex m => m BriDocNumbered
-- docCommaSep = appSep $ docLit $ Text.pack ","
--
-- docParenLSep :: MonadMultiState NodeAllocIndex m => m BriDocNumbered
-- docParenLSep = appSep $ docLit $ Text.pack "("
--
--
-- docPostComment :: (Data.Data.Data ast, MonadMultiState NodeAllocIndex m)
--                => Located ast
--                -> m BriDocNumbered
--                -> m BriDocNumbered
-- docPostComment ast bdm = do
--   bd <- bdm
--   allocateNode $ BDFAnnotationPost (ExactPrint.Types.mkAnnKey ast) bd
--
-- docWrapNode :: ( Data.Data.Data ast, MonadMultiState NodeAllocIndex m)
--             => Located ast
--             -> m BriDocNumbered
--             -> m BriDocNumbered
-- docWrapNode ast bdm = do
--   bd <- bdm
--   i1 <- allocNodeIndex
--   i2 <- allocNodeIndex
--   return
--     $ (,) i1
--     $ BDFAnnotationPrior (ExactPrint.Types.mkAnnKey ast)
--     $ (,) i2
--     $ BDFAnnotationPost (ExactPrint.Types.mkAnnKey ast)
--     $ bd
--
-- docPar :: MonadMultiState NodeAllocIndex m
--        => m BriDocNumbered
--        -> m BriDocNumbered
--        -> m BriDocNumbered
-- docPar lineM indentedM = do
--   line <- lineM
--   indented <- indentedM
--   allocateNode $ BDFPar BrIndentNone line indented
--
-- docForceSingleline :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -> m BriDocNumbered
-- docForceSingleline bdm = allocateNode . BDFForceSingleline =<< bdm
--
-- docForceMultiline :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -> m BriDocNumbered
-- docForceMultiline bdm = allocateNode . BDFForceMultiline =<< bdm
--
-- docEnsureIndent :: MonadMultiState NodeAllocIndex m => BrIndent -> m BriDocNumbered -> m BriDocNumbered
-- docEnsureIndent ind mbd = mbd >>= \bd -> allocateNode $ BDFEnsureIndent ind bd

docEmpty :: ToBriDocM BriDocNumbered
docEmpty :: ToBriDocM BriDocNumbered
docEmpty = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode BriDocFInt
forall (f :: * -> *). BriDocF f
BDFEmpty

docLit :: Text -> ToBriDocM BriDocNumbered
docLit :: Text -> ToBriDocM BriDocNumbered
docLit Text
t = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> BriDocFInt -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ Text -> BriDocFInt
forall (f :: * -> *). Text -> BriDocF f
BDFLit Text
t

docLitS :: String -> ToBriDocM BriDocNumbered
docLitS :: String -> ToBriDocM BriDocNumbered
docLitS String
s = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> BriDocFInt -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ Text -> BriDocFInt
forall (f :: * -> *). Text -> BriDocF f
BDFLit (Text -> BriDocFInt) -> Text -> BriDocFInt
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
s

docExt
  :: (ExactPrint.Annotate.Annotate ast)
  => Located ast
  -> ExactPrint.Types.Anns
  -> Bool
  -> ToBriDocM BriDocNumbered
docExt :: Located ast -> Anns -> Bool -> ToBriDocM BriDocNumbered
docExt Located ast
x Anns
anns Bool
shouldAddComment = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> BriDocFInt -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ AnnKey -> Set AnnKey -> Bool -> Text -> BriDocFInt
forall (f :: * -> *).
AnnKey -> Set AnnKey -> Bool -> Text -> BriDocF f
BDFExternal
  (Located ast -> AnnKey
forall a. Constraints a => a -> AnnKey
ExactPrint.Types.mkAnnKey Located ast
x)
  (Located ast -> Set AnnKey
forall ast. Data ast => ast -> Set AnnKey
foldedAnnKeys Located ast
x)
  Bool
shouldAddComment
  (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Located ast -> Anns -> String
forall ast. Annotate ast => Located ast -> Anns -> String
ExactPrint.exactPrint Located ast
x Anns
anns)

docAlt :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docAlt :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docAlt [ToBriDocM BriDocNumbered]
l = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> ([BriDocNumbered] -> BriDocFInt)
-> [BriDocNumbered]
-> ToBriDocM BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BriDocNumbered] -> BriDocFInt
forall (f :: * -> *). [f (BriDocF f)] -> BriDocF f
BDFAlt ([BriDocNumbered] -> ToBriDocM BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [BriDocNumbered]
-> ToBriDocM BriDocNumbered
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [ToBriDocM BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [BriDocNumbered]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ToBriDocM BriDocNumbered]
l

newtype CollectAltM a = CollectAltM (Writer.Writer [ToBriDocM BriDocNumbered] a)
  deriving (a -> CollectAltM b -> CollectAltM a
(a -> b) -> CollectAltM a -> CollectAltM b
(forall a b. (a -> b) -> CollectAltM a -> CollectAltM b)
-> (forall a b. a -> CollectAltM b -> CollectAltM a)
-> Functor CollectAltM
forall a b. a -> CollectAltM b -> CollectAltM a
forall a b. (a -> b) -> CollectAltM a -> CollectAltM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CollectAltM b -> CollectAltM a
$c<$ :: forall a b. a -> CollectAltM b -> CollectAltM a
fmap :: (a -> b) -> CollectAltM a -> CollectAltM b
$cfmap :: forall a b. (a -> b) -> CollectAltM a -> CollectAltM b
Functor, Functor CollectAltM
a -> CollectAltM a
Functor CollectAltM
-> (forall a. a -> CollectAltM a)
-> (forall a b.
    CollectAltM (a -> b) -> CollectAltM a -> CollectAltM b)
-> (forall a b c.
    (a -> b -> c) -> CollectAltM a -> CollectAltM b -> CollectAltM c)
-> (forall a b. CollectAltM a -> CollectAltM b -> CollectAltM b)
-> (forall a b. CollectAltM a -> CollectAltM b -> CollectAltM a)
-> Applicative CollectAltM
CollectAltM a -> CollectAltM b -> CollectAltM b
CollectAltM a -> CollectAltM b -> CollectAltM a
CollectAltM (a -> b) -> CollectAltM a -> CollectAltM b
(a -> b -> c) -> CollectAltM a -> CollectAltM b -> CollectAltM c
forall a. a -> CollectAltM a
forall a b. CollectAltM a -> CollectAltM b -> CollectAltM a
forall a b. CollectAltM a -> CollectAltM b -> CollectAltM b
forall a b. CollectAltM (a -> b) -> CollectAltM a -> CollectAltM b
forall a b c.
(a -> b -> c) -> CollectAltM a -> CollectAltM b -> CollectAltM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: CollectAltM a -> CollectAltM b -> CollectAltM a
$c<* :: forall a b. CollectAltM a -> CollectAltM b -> CollectAltM a
*> :: CollectAltM a -> CollectAltM b -> CollectAltM b
$c*> :: forall a b. CollectAltM a -> CollectAltM b -> CollectAltM b
liftA2 :: (a -> b -> c) -> CollectAltM a -> CollectAltM b -> CollectAltM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> CollectAltM a -> CollectAltM b -> CollectAltM c
<*> :: CollectAltM (a -> b) -> CollectAltM a -> CollectAltM b
$c<*> :: forall a b. CollectAltM (a -> b) -> CollectAltM a -> CollectAltM b
pure :: a -> CollectAltM a
$cpure :: forall a. a -> CollectAltM a
$cp1Applicative :: Functor CollectAltM
Applicative, Applicative CollectAltM
a -> CollectAltM a
Applicative CollectAltM
-> (forall a b.
    CollectAltM a -> (a -> CollectAltM b) -> CollectAltM b)
-> (forall a b. CollectAltM a -> CollectAltM b -> CollectAltM b)
-> (forall a. a -> CollectAltM a)
-> Monad CollectAltM
CollectAltM a -> (a -> CollectAltM b) -> CollectAltM b
CollectAltM a -> CollectAltM b -> CollectAltM b
forall a. a -> CollectAltM a
forall a b. CollectAltM a -> CollectAltM b -> CollectAltM b
forall a b. CollectAltM a -> (a -> CollectAltM b) -> CollectAltM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> CollectAltM a
$creturn :: forall a. a -> CollectAltM a
>> :: CollectAltM a -> CollectAltM b -> CollectAltM b
$c>> :: forall a b. CollectAltM a -> CollectAltM b -> CollectAltM b
>>= :: CollectAltM a -> (a -> CollectAltM b) -> CollectAltM b
$c>>= :: forall a b. CollectAltM a -> (a -> CollectAltM b) -> CollectAltM b
$cp1Monad :: Applicative CollectAltM
Monad)

addAlternativeCond :: Bool -> ToBriDocM BriDocNumbered -> CollectAltM ()
addAlternativeCond :: Bool -> ToBriDocM BriDocNumbered -> CollectAltM ()
addAlternativeCond Bool
cond ToBriDocM BriDocNumbered
doc =
  Bool -> CollectAltM () -> CollectAltM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cond (ToBriDocM BriDocNumbered -> CollectAltM ()
addAlternative ToBriDocM BriDocNumbered
doc)

addAlternative :: ToBriDocM BriDocNumbered -> CollectAltM ()
addAlternative :: ToBriDocM BriDocNumbered -> CollectAltM ()
addAlternative =
  Writer [ToBriDocM BriDocNumbered] () -> CollectAltM ()
forall a. Writer [ToBriDocM BriDocNumbered] a -> CollectAltM a
CollectAltM (Writer [ToBriDocM BriDocNumbered] () -> CollectAltM ())
-> (ToBriDocM BriDocNumbered
    -> Writer [ToBriDocM BriDocNumbered] ())
-> ToBriDocM BriDocNumbered
-> CollectAltM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ToBriDocM BriDocNumbered] -> Writer [ToBriDocM BriDocNumbered] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell ([ToBriDocM BriDocNumbered]
 -> Writer [ToBriDocM BriDocNumbered] ())
-> (ToBriDocM BriDocNumbered -> [ToBriDocM BriDocNumbered])
-> ToBriDocM BriDocNumbered
-> Writer [ToBriDocM BriDocNumbered] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ToBriDocM BriDocNumbered
-> [ToBriDocM BriDocNumbered] -> [ToBriDocM BriDocNumbered]
forall a. a -> [a] -> [a]
: [])

runFilteredAlternative :: CollectAltM () -> ToBriDocM BriDocNumbered
runFilteredAlternative :: CollectAltM () -> ToBriDocM BriDocNumbered
runFilteredAlternative (CollectAltM Writer [ToBriDocM BriDocNumbered] ()
action) =
  [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docAlt ([ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered)
-> [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ Writer [ToBriDocM BriDocNumbered] () -> [ToBriDocM BriDocNumbered]
forall w a. Writer w a -> w
Writer.execWriter Writer [ToBriDocM BriDocNumbered] ()
action


docSeq :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docSeq :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docSeq [] = ToBriDocM BriDocNumbered
docEmpty
docSeq [ToBriDocM BriDocNumbered]
l = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> ([BriDocNumbered] -> BriDocFInt)
-> [BriDocNumbered]
-> ToBriDocM BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BriDocNumbered] -> BriDocFInt
forall (f :: * -> *). [f (BriDocF f)] -> BriDocF f
BDFSeq ([BriDocNumbered] -> ToBriDocM BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [BriDocNumbered]
-> ToBriDocM BriDocNumbered
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [ToBriDocM BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [BriDocNumbered]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ToBriDocM BriDocNumbered]
l

docLines :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docLines :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docLines [ToBriDocM BriDocNumbered]
l = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> ([BriDocNumbered] -> BriDocFInt)
-> [BriDocNumbered]
-> ToBriDocM BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BriDocNumbered] -> BriDocFInt
forall (f :: * -> *). [f (BriDocF f)] -> BriDocF f
BDFLines ([BriDocNumbered] -> ToBriDocM BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [BriDocNumbered]
-> ToBriDocM BriDocNumbered
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [ToBriDocM BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [BriDocNumbered]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ToBriDocM BriDocNumbered]
l

docCols :: ColSig -> [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docCols :: ColSig -> [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docCols ColSig
sig [ToBriDocM BriDocNumbered]
l = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> ([BriDocNumbered] -> BriDocFInt)
-> [BriDocNumbered]
-> ToBriDocM BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColSig -> [BriDocNumbered] -> BriDocFInt
forall (f :: * -> *). ColSig -> [f (BriDocF f)] -> BriDocF f
BDFCols ColSig
sig ([BriDocNumbered] -> ToBriDocM BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [BriDocNumbered]
-> ToBriDocM BriDocNumbered
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [ToBriDocM BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [BriDocNumbered]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ToBriDocM BriDocNumbered]
l

docAddBaseY :: BrIndent -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docAddBaseY :: BrIndent -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docAddBaseY BrIndent
ind ToBriDocM BriDocNumbered
bdm = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> (BriDocNumbered -> BriDocFInt)
-> BriDocNumbered
-> ToBriDocM BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BrIndent -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *). BrIndent -> f (BriDocF f) -> BriDocF f
BDFAddBaseY BrIndent
ind (BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ToBriDocM BriDocNumbered
bdm

docSetBaseY :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docSetBaseY :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docSetBaseY ToBriDocM BriDocNumbered
bdm = do
  BriDocNumbered
bd <- ToBriDocM BriDocNumbered
bdm
  -- the order here is important so that these two nodes can be treated
  -- properly over at `transformAlts`.
  BriDocNumbered
n1 <- BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> BriDocFInt -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDocFInt
forall (f :: * -> *). f (BriDocF f) -> BriDocF f
BDFBaseYPushCur BriDocNumbered
bd
  BriDocNumbered
n2 <- BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> BriDocFInt -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDocFInt
forall (f :: * -> *). f (BriDocF f) -> BriDocF f
BDFBaseYPop BriDocNumbered
n1
  BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return BriDocNumbered
n2

docSetIndentLevel :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docSetIndentLevel :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docSetIndentLevel ToBriDocM BriDocNumbered
bdm = do
  BriDocNumbered
bd <- ToBriDocM BriDocNumbered
bdm
  BriDocNumbered
n1 <- BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> BriDocFInt -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDocFInt
forall (f :: * -> *). f (BriDocF f) -> BriDocF f
BDFIndentLevelPushCur BriDocNumbered
bd
  BriDocNumbered
n2 <- BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> BriDocFInt -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDocFInt
forall (f :: * -> *). f (BriDocF f) -> BriDocF f
BDFIndentLevelPop BriDocNumbered
n1
  BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return BriDocNumbered
n2

docSetBaseAndIndent :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docSetBaseAndIndent :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docSetBaseAndIndent = ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docSetBaseY (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
-> (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered
-> ToBriDocM BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docSetIndentLevel

docSeparator :: ToBriDocM BriDocNumbered
docSeparator :: ToBriDocM BriDocNumbered
docSeparator = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode BriDocFInt
forall (f :: * -> *). BriDocF f
BDFSeparator

docAnnotationPrior
  :: AnnKey -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docAnnotationPrior :: AnnKey -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docAnnotationPrior AnnKey
annKey ToBriDocM BriDocNumbered
bdm = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> (BriDocNumbered -> BriDocFInt)
-> BriDocNumbered
-> ToBriDocM BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnKey -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *). AnnKey -> f (BriDocF f) -> BriDocF f
BDFAnnotationPrior AnnKey
annKey (BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ToBriDocM BriDocNumbered
bdm

docAnnotationKW
  :: AnnKey
  -> Maybe AnnKeywordId
  -> ToBriDocM BriDocNumbered
  -> ToBriDocM BriDocNumbered
docAnnotationKW :: AnnKey
-> Maybe AnnKeywordId
-> ToBriDocM BriDocNumbered
-> ToBriDocM BriDocNumbered
docAnnotationKW AnnKey
annKey Maybe AnnKeywordId
kw ToBriDocM BriDocNumbered
bdm = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> (BriDocNumbered -> BriDocFInt)
-> BriDocNumbered
-> ToBriDocM BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnKey -> Maybe AnnKeywordId -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *).
AnnKey -> Maybe AnnKeywordId -> f (BriDocF f) -> BriDocF f
BDFAnnotationKW AnnKey
annKey Maybe AnnKeywordId
kw (BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ToBriDocM BriDocNumbered
bdm

docMoveToKWDP
  :: AnnKey
  -> AnnKeywordId
  -> Bool
  -> ToBriDocM BriDocNumbered
  -> ToBriDocM BriDocNumbered
docMoveToKWDP :: AnnKey
-> AnnKeywordId
-> Bool
-> ToBriDocM BriDocNumbered
-> ToBriDocM BriDocNumbered
docMoveToKWDP AnnKey
annKey AnnKeywordId
kw Bool
shouldRestoreIndent ToBriDocM BriDocNumbered
bdm =
  BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> (BriDocNumbered -> BriDocFInt)
-> BriDocNumbered
-> ToBriDocM BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnKey -> AnnKeywordId -> Bool -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *).
AnnKey -> AnnKeywordId -> Bool -> f (BriDocF f) -> BriDocF f
BDFMoveToKWDP AnnKey
annKey AnnKeywordId
kw Bool
shouldRestoreIndent (BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ToBriDocM BriDocNumbered
bdm

docAnnotationRest
  :: AnnKey -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docAnnotationRest :: AnnKey -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docAnnotationRest AnnKey
annKey ToBriDocM BriDocNumbered
bdm = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> (BriDocNumbered -> BriDocFInt)
-> BriDocNumbered
-> ToBriDocM BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnKey -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *). AnnKey -> f (BriDocF f) -> BriDocF f
BDFAnnotationRest AnnKey
annKey (BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ToBriDocM BriDocNumbered
bdm

docNonBottomSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docNonBottomSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docNonBottomSpacing ToBriDocM BriDocNumbered
bdm = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> (BriDocNumbered -> BriDocFInt)
-> BriDocNumbered
-> ToBriDocM BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *). Bool -> f (BriDocF f) -> BriDocF f
BDFNonBottomSpacing Bool
False (BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ToBriDocM BriDocNumbered
bdm

docNonBottomSpacingS :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docNonBottomSpacingS :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docNonBottomSpacingS ToBriDocM BriDocNumbered
bdm = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> (BriDocNumbered -> BriDocFInt)
-> BriDocNumbered
-> ToBriDocM BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *). Bool -> f (BriDocF f) -> BriDocF f
BDFNonBottomSpacing Bool
True (BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ToBriDocM BriDocNumbered
bdm

docSetParSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docSetParSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docSetParSpacing ToBriDocM BriDocNumbered
bdm = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> (BriDocNumbered -> BriDocFInt)
-> BriDocNumbered
-> ToBriDocM BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BriDocNumbered -> BriDocFInt
forall (f :: * -> *). f (BriDocF f) -> BriDocF f
BDFSetParSpacing (BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ToBriDocM BriDocNumbered
bdm

docForceParSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docForceParSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docForceParSpacing ToBriDocM BriDocNumbered
bdm = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> (BriDocNumbered -> BriDocFInt)
-> BriDocNumbered
-> ToBriDocM BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BriDocNumbered -> BriDocFInt
forall (f :: * -> *). f (BriDocF f) -> BriDocF f
BDFForceParSpacing (BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ToBriDocM BriDocNumbered
bdm

docDebug :: String -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docDebug :: String -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docDebug String
s ToBriDocM BriDocNumbered
bdm = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> (BriDocNumbered -> BriDocFInt)
-> BriDocNumbered
-> ToBriDocM BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *). String -> f (BriDocF f) -> BriDocF f
BDFDebug String
s (BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ToBriDocM BriDocNumbered
bdm

appSep :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
appSep :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
appSep ToBriDocM BriDocNumbered
x = [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docSeq [ToBriDocM BriDocNumbered
x, ToBriDocM BriDocNumbered
docSeparator]

docCommaSep :: ToBriDocM BriDocNumbered
docCommaSep :: ToBriDocM BriDocNumbered
docCommaSep = ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
appSep (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ Text -> ToBriDocM BriDocNumbered
docLit (Text -> ToBriDocM BriDocNumbered)
-> Text -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
","

docParenLSep :: ToBriDocM BriDocNumbered
docParenLSep :: ToBriDocM BriDocNumbered
docParenLSep = ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
appSep ToBriDocM BriDocNumbered
docParenL

-- TODO: we don't make consistent use of these (yet). However, I think the
-- most readable approach overall might be something else: define
-- `lit = docLit . Text.pack` and `prepSep = docSeq [docSeparator, x]`.
-- I think those two would make the usage most readable.
-- lit "("  and  appSep (lit "(")  are understandable and short without
-- introducing a new top-level binding for all types of parentheses.
docParenL :: ToBriDocM BriDocNumbered
docParenL :: ToBriDocM BriDocNumbered
docParenL = Text -> ToBriDocM BriDocNumbered
docLit (Text -> ToBriDocM BriDocNumbered)
-> Text -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"("

docParenR :: ToBriDocM BriDocNumbered
docParenR :: ToBriDocM BriDocNumbered
docParenR = Text -> ToBriDocM BriDocNumbered
docLit (Text -> ToBriDocM BriDocNumbered)
-> Text -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
")"

docParenHashLSep :: ToBriDocM BriDocNumbered
docParenHashLSep :: ToBriDocM BriDocNumbered
docParenHashLSep =  [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docSeq [Text -> ToBriDocM BriDocNumbered
docLit (Text -> ToBriDocM BriDocNumbered)
-> Text -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"(#", ToBriDocM BriDocNumbered
docSeparator]

docParenHashRSep :: ToBriDocM BriDocNumbered
docParenHashRSep :: ToBriDocM BriDocNumbered
docParenHashRSep = [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docSeq [ToBriDocM BriDocNumbered
docSeparator, Text -> ToBriDocM BriDocNumbered
docLit (Text -> ToBriDocM BriDocNumbered)
-> Text -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"#)"]

docBracketL :: ToBriDocM BriDocNumbered
docBracketL :: ToBriDocM BriDocNumbered
docBracketL = Text -> ToBriDocM BriDocNumbered
docLit (Text -> ToBriDocM BriDocNumbered)
-> Text -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"["

docBracketR :: ToBriDocM BriDocNumbered
docBracketR :: ToBriDocM BriDocNumbered
docBracketR = Text -> ToBriDocM BriDocNumbered
docLit (Text -> ToBriDocM BriDocNumbered)
-> Text -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"]"


docTick :: ToBriDocM BriDocNumbered
docTick :: ToBriDocM BriDocNumbered
docTick = Text -> ToBriDocM BriDocNumbered
docLit (Text -> ToBriDocM BriDocNumbered)
-> Text -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"'"

docNodeAnnKW
  :: Data.Data.Data ast
  => Located ast
  -> Maybe AnnKeywordId
  -> ToBriDocM BriDocNumbered
  -> ToBriDocM BriDocNumbered
docNodeAnnKW :: Located ast
-> Maybe AnnKeywordId
-> ToBriDocM BriDocNumbered
-> ToBriDocM BriDocNumbered
docNodeAnnKW Located ast
ast Maybe AnnKeywordId
kw ToBriDocM BriDocNumbered
bdm =
  AnnKey
-> Maybe AnnKeywordId
-> ToBriDocM BriDocNumbered
-> ToBriDocM BriDocNumbered
docAnnotationKW (Located ast -> AnnKey
forall a. Constraints a => a -> AnnKey
ExactPrint.Types.mkAnnKey Located ast
ast) Maybe AnnKeywordId
kw ToBriDocM BriDocNumbered
bdm

docNodeMoveToKWDP
  :: Data.Data.Data ast
  => Located ast
  -> AnnKeywordId
  -> Bool
  -> ToBriDocM BriDocNumbered
  -> ToBriDocM BriDocNumbered
docNodeMoveToKWDP :: Located ast
-> AnnKeywordId
-> Bool
-> ToBriDocM BriDocNumbered
-> ToBriDocM BriDocNumbered
docNodeMoveToKWDP Located ast
ast AnnKeywordId
kw Bool
shouldRestoreIndent ToBriDocM BriDocNumbered
bdm =
  AnnKey
-> AnnKeywordId
-> Bool
-> ToBriDocM BriDocNumbered
-> ToBriDocM BriDocNumbered
docMoveToKWDP (Located ast -> AnnKey
forall a. Constraints a => a -> AnnKey
ExactPrint.Types.mkAnnKey Located ast
ast) AnnKeywordId
kw Bool
shouldRestoreIndent ToBriDocM BriDocNumbered
bdm

class DocWrapable a where
  docWrapNode :: ( Data.Data.Data ast)
              => Located ast
              -> a
              -> a
  docWrapNodePrior :: ( Data.Data.Data ast)
                   => Located ast
                   -> a
                   -> a
  docWrapNodeRest  :: ( Data.Data.Data ast)
                   => Located ast
                   -> a
                   -> a

instance DocWrapable (ToBriDocM BriDocNumbered) where
  docWrapNode :: Located ast -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docWrapNode Located ast
ast ToBriDocM BriDocNumbered
bdm = do
    BriDocNumbered
bd <- ToBriDocM BriDocNumbered
bdm
    Int
i1 <- MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  Int
forall (m :: * -> *). MonadMultiState NodeAllocIndex m => m Int
allocNodeIndex
    Int
i2 <- MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  Int
forall (m :: * -> *). MonadMultiState NodeAllocIndex m => m Int
allocNodeIndex
    BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return
      (BriDocNumbered -> ToBriDocM BriDocNumbered)
-> BriDocNumbered -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ (,) Int
i1
      (BriDocFInt -> BriDocNumbered) -> BriDocFInt -> BriDocNumbered
forall a b. (a -> b) -> a -> b
$ AnnKey -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *). AnnKey -> f (BriDocF f) -> BriDocF f
BDFAnnotationPrior (Located ast -> AnnKey
forall a. Constraints a => a -> AnnKey
ExactPrint.Types.mkAnnKey Located ast
ast)
      (BriDocNumbered -> BriDocFInt) -> BriDocNumbered -> BriDocFInt
forall a b. (a -> b) -> a -> b
$ (,) Int
i2
      (BriDocFInt -> BriDocNumbered) -> BriDocFInt -> BriDocNumbered
forall a b. (a -> b) -> a -> b
$ AnnKey -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *). AnnKey -> f (BriDocF f) -> BriDocF f
BDFAnnotationRest (Located ast -> AnnKey
forall a. Constraints a => a -> AnnKey
ExactPrint.Types.mkAnnKey Located ast
ast)
      (BriDocNumbered -> BriDocFInt) -> BriDocNumbered -> BriDocFInt
forall a b. (a -> b) -> a -> b
$ BriDocNumbered
bd
  docWrapNodePrior :: Located ast -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docWrapNodePrior Located ast
ast ToBriDocM BriDocNumbered
bdm = do
    BriDocNumbered
bd <- ToBriDocM BriDocNumbered
bdm
    Int
i1 <- MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  Int
forall (m :: * -> *). MonadMultiState NodeAllocIndex m => m Int
allocNodeIndex
    BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return
      (BriDocNumbered -> ToBriDocM BriDocNumbered)
-> BriDocNumbered -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ (,) Int
i1
      (BriDocFInt -> BriDocNumbered) -> BriDocFInt -> BriDocNumbered
forall a b. (a -> b) -> a -> b
$ AnnKey -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *). AnnKey -> f (BriDocF f) -> BriDocF f
BDFAnnotationPrior (Located ast -> AnnKey
forall a. Constraints a => a -> AnnKey
ExactPrint.Types.mkAnnKey Located ast
ast)
      (BriDocNumbered -> BriDocFInt) -> BriDocNumbered -> BriDocFInt
forall a b. (a -> b) -> a -> b
$ BriDocNumbered
bd
  docWrapNodeRest :: Located ast -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docWrapNodeRest Located ast
ast ToBriDocM BriDocNumbered
bdm = do
    BriDocNumbered
bd <- ToBriDocM BriDocNumbered
bdm
    Int
i2 <- MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  Int
forall (m :: * -> *). MonadMultiState NodeAllocIndex m => m Int
allocNodeIndex
    BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return
      (BriDocNumbered -> ToBriDocM BriDocNumbered)
-> BriDocNumbered -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ (,) Int
i2
      (BriDocFInt -> BriDocNumbered) -> BriDocFInt -> BriDocNumbered
forall a b. (a -> b) -> a -> b
$ AnnKey -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *). AnnKey -> f (BriDocF f) -> BriDocF f
BDFAnnotationRest (Located ast -> AnnKey
forall a. Constraints a => a -> AnnKey
ExactPrint.Types.mkAnnKey Located ast
ast)
      (BriDocNumbered -> BriDocFInt) -> BriDocNumbered -> BriDocFInt
forall a b. (a -> b) -> a -> b
$ BriDocNumbered
bd

instance DocWrapable (ToBriDocM a) => DocWrapable [ToBriDocM a] where
  docWrapNode :: Located ast -> [ToBriDocM a] -> [ToBriDocM a]
docWrapNode Located ast
ast [ToBriDocM a]
bdms = case [ToBriDocM a]
bdms of
    [] -> []
    [ToBriDocM a
bd] -> [Located ast -> ToBriDocM a -> ToBriDocM a
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNode Located ast
ast ToBriDocM a
bd]
    (ToBriDocM a
bd1:[ToBriDocM a]
bdR) | (ToBriDocM a
bdN:[ToBriDocM a]
bdM) <- [ToBriDocM a] -> [ToBriDocM a]
forall a. [a] -> [a]
reverse [ToBriDocM a]
bdR ->
      [Located ast -> ToBriDocM a -> ToBriDocM a
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNodePrior Located ast
ast ToBriDocM a
bd1] [ToBriDocM a] -> [ToBriDocM a] -> [ToBriDocM a]
forall a. [a] -> [a] -> [a]
++ [ToBriDocM a] -> [ToBriDocM a]
forall a. [a] -> [a]
reverse [ToBriDocM a]
bdM [ToBriDocM a] -> [ToBriDocM a] -> [ToBriDocM a]
forall a. [a] -> [a] -> [a]
++ [Located ast -> ToBriDocM a -> ToBriDocM a
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNodeRest Located ast
ast ToBriDocM a
bdN]
    [ToBriDocM a]
_ -> String -> [ToBriDocM a]
forall a. HasCallStack => String -> a
error String
"cannot happen (TM)"
  docWrapNodePrior :: Located ast -> [ToBriDocM a] -> [ToBriDocM a]
docWrapNodePrior Located ast
ast [ToBriDocM a]
bdms = case [ToBriDocM a]
bdms of
    [] -> []
    [ToBriDocM a
bd] -> [Located ast -> ToBriDocM a -> ToBriDocM a
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNodePrior Located ast
ast ToBriDocM a
bd]
    (ToBriDocM a
bd1:[ToBriDocM a]
bdR) -> Located ast -> ToBriDocM a -> ToBriDocM a
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNodePrior Located ast
ast ToBriDocM a
bd1 ToBriDocM a -> [ToBriDocM a] -> [ToBriDocM a]
forall a. a -> [a] -> [a]
: [ToBriDocM a]
bdR
  docWrapNodeRest :: Located ast -> [ToBriDocM a] -> [ToBriDocM a]
docWrapNodeRest Located ast
ast [ToBriDocM a]
bdms = case [ToBriDocM a] -> [ToBriDocM a]
forall a. [a] -> [a]
reverse [ToBriDocM a]
bdms of
      [] -> []
      (ToBriDocM a
bdN:[ToBriDocM a]
bdR) -> [ToBriDocM a] -> [ToBriDocM a]
forall a. [a] -> [a]
reverse ([ToBriDocM a] -> [ToBriDocM a]) -> [ToBriDocM a] -> [ToBriDocM a]
forall a b. (a -> b) -> a -> b
$ Located ast -> ToBriDocM a -> ToBriDocM a
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNodeRest Located ast
ast ToBriDocM a
bdN ToBriDocM a -> [ToBriDocM a] -> [ToBriDocM a]
forall a. a -> [a] -> [a]
: [ToBriDocM a]
bdR

instance DocWrapable (ToBriDocM a) => DocWrapable (ToBriDocM [a]) where
  docWrapNode :: Located ast -> ToBriDocM [a] -> ToBriDocM [a]
docWrapNode Located ast
ast ToBriDocM [a]
bdsm = do
    [a]
bds <- ToBriDocM [a]
bdsm
    case [a]
bds of
      [] -> [a] -> ToBriDocM [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [] -- TODO: this might be bad. maybe. then again, not really. well.
      [a
bd] -> do
        a
bd' <- Located ast -> ToBriDocM a -> ToBriDocM a
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNode Located ast
ast (a -> ToBriDocM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
bd)
        [a] -> ToBriDocM [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a
bd']
      (a
bd1:[a]
bdR) | (a
bdN:[a]
bdM) <- [a] -> [a]
forall a. [a] -> [a]
reverse [a]
bdR -> do
        a
bd1' <- Located ast -> ToBriDocM a -> ToBriDocM a
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNodePrior Located ast
ast (a -> ToBriDocM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
bd1)
        a
bdN' <- Located ast -> ToBriDocM a -> ToBriDocM a
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNodeRest  Located ast
ast (a -> ToBriDocM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
bdN)
        [a] -> ToBriDocM [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> ToBriDocM [a]) -> [a] -> ToBriDocM [a]
forall a b. (a -> b) -> a -> b
$ [a
bd1'] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
bdM [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
bdN']
      [a]
_ -> String -> ToBriDocM [a]
forall a. HasCallStack => String -> a
error String
"cannot happen (TM)"
  docWrapNodePrior :: Located ast -> ToBriDocM [a] -> ToBriDocM [a]
docWrapNodePrior Located ast
ast ToBriDocM [a]
bdsm = do
    [a]
bds <- ToBriDocM [a]
bdsm
    case [a]
bds of
      [] -> [a] -> ToBriDocM [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      (a
bd1:[a]
bdR) -> do
        a
bd1' <- Located ast -> ToBriDocM a -> ToBriDocM a
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNodePrior Located ast
ast (a -> ToBriDocM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
bd1)
        [a] -> ToBriDocM [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
bd1'a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
bdR)
  docWrapNodeRest :: Located ast -> ToBriDocM [a] -> ToBriDocM [a]
docWrapNodeRest Located ast
ast ToBriDocM [a]
bdsm = do
    [a]
bds <- ToBriDocM [a]
bdsm
    case [a] -> [a]
forall a. [a] -> [a]
reverse [a]
bds of
      [] -> [a] -> ToBriDocM [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      (a
bdN:[a]
bdR) -> do
        a
bdN' <- Located ast -> ToBriDocM a -> ToBriDocM a
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNodeRest Located ast
ast (a -> ToBriDocM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
bdN)
        [a] -> ToBriDocM [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> ToBriDocM [a]) -> [a] -> ToBriDocM [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse (a
bdN'a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
bdR)

instance DocWrapable (ToBriDocM a) => DocWrapable (ToBriDocM (Seq a)) where
  docWrapNode :: Located ast -> ToBriDocM (Seq a) -> ToBriDocM (Seq a)
docWrapNode Located ast
ast ToBriDocM (Seq a)
bdsm = do
    Seq a
bds <- ToBriDocM (Seq a)
bdsm
    case Seq a -> ViewL a
forall a. Seq a -> ViewL a
Seq.viewl Seq a
bds of
      ViewL a
Seq.EmptyL -> Seq a -> ToBriDocM (Seq a)
forall (m :: * -> *) a. Monad m => a -> m a
return Seq a
forall a. Seq a
Seq.empty -- TODO: this might be bad. maybe. then again, not really. well.
      a
bd1 Seq.:< Seq a
rest -> case Seq a -> ViewR a
forall a. Seq a -> ViewR a
Seq.viewr Seq a
rest of
        ViewR a
Seq.EmptyR -> do
          a
bd1' <- Located ast -> ToBriDocM a -> ToBriDocM a
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNode Located ast
ast (a -> ToBriDocM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
bd1)
          Seq a -> ToBriDocM (Seq a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq a -> ToBriDocM (Seq a)) -> Seq a -> ToBriDocM (Seq a)
forall a b. (a -> b) -> a -> b
$ a -> Seq a
forall a. a -> Seq a
Seq.singleton a
bd1'
        Seq a
bdM Seq.:> a
bdN -> do
          a
bd1' <- Located ast -> ToBriDocM a -> ToBriDocM a
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNodePrior Located ast
ast (a -> ToBriDocM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
bd1)
          a
bdN' <- Located ast -> ToBriDocM a -> ToBriDocM a
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNodeRest  Located ast
ast (a -> ToBriDocM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
bdN)
          Seq a -> ToBriDocM (Seq a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq a -> ToBriDocM (Seq a)) -> Seq a -> ToBriDocM (Seq a)
forall a b. (a -> b) -> a -> b
$ (a
bd1' a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
Seq.<| Seq a
bdM) Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> a
bdN'
  docWrapNodePrior :: Located ast -> ToBriDocM (Seq a) -> ToBriDocM (Seq a)
docWrapNodePrior Located ast
ast ToBriDocM (Seq a)
bdsm = do
    Seq a
bds <- ToBriDocM (Seq a)
bdsm
    case Seq a -> ViewL a
forall a. Seq a -> ViewL a
Seq.viewl Seq a
bds of
      ViewL a
Seq.EmptyL -> Seq a -> ToBriDocM (Seq a)
forall (m :: * -> *) a. Monad m => a -> m a
return Seq a
forall a. Seq a
Seq.empty
      a
bd1 Seq.:< Seq a
bdR -> do
        a
bd1' <- Located ast -> ToBriDocM a -> ToBriDocM a
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNodePrior Located ast
ast (a -> ToBriDocM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
bd1)
        Seq a -> ToBriDocM (Seq a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq a -> ToBriDocM (Seq a)) -> Seq a -> ToBriDocM (Seq a)
forall a b. (a -> b) -> a -> b
$ a
bd1' a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
Seq.<| Seq a
bdR
  docWrapNodeRest :: Located ast -> ToBriDocM (Seq a) -> ToBriDocM (Seq a)
docWrapNodeRest Located ast
ast ToBriDocM (Seq a)
bdsm = do
    Seq a
bds <- ToBriDocM (Seq a)
bdsm
    case Seq a -> ViewR a
forall a. Seq a -> ViewR a
Seq.viewr Seq a
bds of
      ViewR a
Seq.EmptyR -> Seq a -> ToBriDocM (Seq a)
forall (m :: * -> *) a. Monad m => a -> m a
return Seq a
forall a. Seq a
Seq.empty
      Seq a
bdR Seq.:> a
bdN -> do
        a
bdN' <- Located ast -> ToBriDocM a -> ToBriDocM a
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNodeRest Located ast
ast (a -> ToBriDocM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
bdN)
        Seq a -> ToBriDocM (Seq a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq a -> ToBriDocM (Seq a)) -> Seq a -> ToBriDocM (Seq a)
forall a b. (a -> b) -> a -> b
$ Seq a
bdR Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> a
bdN'

instance DocWrapable (ToBriDocM ([BriDocNumbered], BriDocNumbered, a)) where
  docWrapNode :: Located ast
-> ToBriDocM ([BriDocNumbered], BriDocNumbered, a)
-> ToBriDocM ([BriDocNumbered], BriDocNumbered, a)
docWrapNode Located ast
ast ToBriDocM ([BriDocNumbered], BriDocNumbered, a)
stuffM = do
    ([BriDocNumbered]
bds, BriDocNumbered
bd, a
x) <- ToBriDocM ([BriDocNumbered], BriDocNumbered, a)
stuffM
    if [BriDocNumbered] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BriDocNumbered]
bds
      then do
        BriDocNumbered
bd' <- Located ast -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNode Located ast
ast (BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return BriDocNumbered
bd)
        ([BriDocNumbered], BriDocNumbered, a)
-> ToBriDocM ([BriDocNumbered], BriDocNumbered, a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([BriDocNumbered]
bds, BriDocNumbered
bd', a
x)
      else do
        [BriDocNumbered]
bds' <- Located ast
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [BriDocNumbered]
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNodePrior Located ast
ast ([BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [BriDocNumbered]
forall (m :: * -> *) a. Monad m => a -> m a
return [BriDocNumbered]
bds)
        BriDocNumbered
bd' <- Located ast -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNodeRest Located ast
ast (BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return BriDocNumbered
bd)
        ([BriDocNumbered], BriDocNumbered, a)
-> ToBriDocM ([BriDocNumbered], BriDocNumbered, a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([BriDocNumbered]
bds', BriDocNumbered
bd', a
x)
  docWrapNodePrior :: Located ast
-> ToBriDocM ([BriDocNumbered], BriDocNumbered, a)
-> ToBriDocM ([BriDocNumbered], BriDocNumbered, a)
docWrapNodePrior Located ast
ast ToBriDocM ([BriDocNumbered], BriDocNumbered, a)
stuffM = do
    ([BriDocNumbered]
bds, BriDocNumbered
bd, a
x) <- ToBriDocM ([BriDocNumbered], BriDocNumbered, a)
stuffM
    [BriDocNumbered]
bds' <- Located ast
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [BriDocNumbered]
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNodePrior Located ast
ast ([BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [BriDocNumbered]
forall (m :: * -> *) a. Monad m => a -> m a
return [BriDocNumbered]
bds)
    ([BriDocNumbered], BriDocNumbered, a)
-> ToBriDocM ([BriDocNumbered], BriDocNumbered, a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([BriDocNumbered]
bds', BriDocNumbered
bd, a
x)
  docWrapNodeRest :: Located ast
-> ToBriDocM ([BriDocNumbered], BriDocNumbered, a)
-> ToBriDocM ([BriDocNumbered], BriDocNumbered, a)
docWrapNodeRest Located ast
ast ToBriDocM ([BriDocNumbered], BriDocNumbered, a)
stuffM = do
    ([BriDocNumbered]
bds, BriDocNumbered
bd, a
x) <- ToBriDocM ([BriDocNumbered], BriDocNumbered, a)
stuffM
    BriDocNumbered
bd' <- Located ast -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNodeRest Located ast
ast (BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return BriDocNumbered
bd)
    ([BriDocNumbered], BriDocNumbered, a)
-> ToBriDocM ([BriDocNumbered], BriDocNumbered, a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([BriDocNumbered]
bds, BriDocNumbered
bd', a
x)



docPar
  :: ToBriDocM BriDocNumbered
  -> ToBriDocM BriDocNumbered
  -> ToBriDocM BriDocNumbered
docPar :: ToBriDocM BriDocNumbered
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docPar ToBriDocM BriDocNumbered
lineM ToBriDocM BriDocNumbered
indentedM = do
  BriDocNumbered
line     <- ToBriDocM BriDocNumbered
lineM
  BriDocNumbered
indented <- ToBriDocM BriDocNumbered
indentedM
  BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> BriDocFInt -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BrIndent -> BriDocNumbered -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *).
BrIndent -> f (BriDocF f) -> f (BriDocF f) -> BriDocF f
BDFPar BrIndent
BrIndentNone BriDocNumbered
line BriDocNumbered
indented

docForceSingleline :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docForceSingleline :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docForceSingleline ToBriDocM BriDocNumbered
bdm = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> (BriDocNumbered -> BriDocFInt)
-> BriDocNumbered
-> ToBriDocM BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BriDocNumbered -> BriDocFInt
forall (f :: * -> *). f (BriDocF f) -> BriDocF f
BDFForceSingleline (BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ToBriDocM BriDocNumbered
bdm

docForceMultiline :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docForceMultiline :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docForceMultiline ToBriDocM BriDocNumbered
bdm = BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> (BriDocNumbered -> BriDocFInt)
-> BriDocNumbered
-> ToBriDocM BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BriDocNumbered -> BriDocFInt
forall (f :: * -> *). f (BriDocF f) -> BriDocF f
BDFForceMultiline (BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ToBriDocM BriDocNumbered
bdm

docEnsureIndent
  :: BrIndent -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docEnsureIndent :: BrIndent -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docEnsureIndent BrIndent
ind ToBriDocM BriDocNumbered
mbd = ToBriDocM BriDocNumbered
mbd ToBriDocM BriDocNumbered
-> (BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \BriDocNumbered
bd -> BriDocFInt -> ToBriDocM BriDocNumbered
forall (m :: * -> *).
MonadMultiState NodeAllocIndex m =>
BriDocFInt -> m BriDocNumbered
allocateNode (BriDocFInt -> ToBriDocM BriDocNumbered)
-> BriDocFInt -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BrIndent -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *). BrIndent -> f (BriDocF f) -> BriDocF f
BDFEnsureIndent BrIndent
ind BriDocNumbered
bd

unknownNodeError
  :: Data.Data.Data ast
  => String
  -> GenLocated GHC.SrcSpan ast
  -> ToBriDocM BriDocNumbered
unknownNodeError :: String -> GenLocated SrcSpan ast -> ToBriDocM BriDocNumbered
unknownNodeError String
infoStr GenLocated SrcSpan ast
ast = do
  [BrittanyError]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell [String -> GenLocated SrcSpan ast -> BrittanyError
forall ast.
Data ast =>
String -> GenLocated SrcSpan ast -> BrittanyError
ErrorUnknownNode String
infoStr GenLocated SrcSpan ast
ast]
  Text -> ToBriDocM BriDocNumbered
docLit (Text -> ToBriDocM BriDocNumbered)
-> Text -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"

spacifyDocs :: [ToBriDocM BriDocNumbered] -> [ToBriDocM BriDocNumbered]
spacifyDocs :: [ToBriDocM BriDocNumbered] -> [ToBriDocM BriDocNumbered]
spacifyDocs [] = []
spacifyDocs [ToBriDocM BriDocNumbered]
ds = (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
-> [ToBriDocM BriDocNumbered] -> [ToBriDocM BriDocNumbered]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
appSep ([ToBriDocM BriDocNumbered] -> [ToBriDocM BriDocNumbered]
forall a. [a] -> [a]
List.init [ToBriDocM BriDocNumbered]
ds) [ToBriDocM BriDocNumbered]
-> [ToBriDocM BriDocNumbered] -> [ToBriDocM BriDocNumbered]
forall a. [a] -> [a] -> [a]
++ [[ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
forall a. [a] -> a
List.last [ToBriDocM BriDocNumbered]
ds]

briDocMToPPM :: ToBriDocM a -> PPMLocal a
briDocMToPPM :: ToBriDocM a -> PPMLocal a
briDocMToPPM ToBriDocM a
m = do
  (a
x, [BrittanyError]
errs, Seq String
debugs) <- ToBriDocM a -> PPMLocal (a, [BrittanyError], Seq String)
forall a. ToBriDocM a -> PPMLocal (a, [BrittanyError], Seq String)
briDocMToPPMInner ToBriDocM a
m
  Seq String
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell Seq String
debugs
  [BrittanyError]
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell [BrittanyError]
errs
  a -> PPMLocal a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

briDocMToPPMInner :: ToBriDocM a -> PPMLocal (a, [BrittanyError], Seq String)
briDocMToPPMInner :: ToBriDocM a -> PPMLocal (a, [BrittanyError], Seq String)
briDocMToPPMInner ToBriDocM a
m = do
  HList '[Config, Anns]
readers <- MultiRWST
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[]
  Identity
  (HList '[Config, Anns])
forall (m :: * -> *) (r :: [*]) (w :: [*]) (s :: [*]).
Monad m =>
MultiRWST r w s m (HList r)
MultiRWSS.mGetRawR
  let ((a
x, [BrittanyError]
errs), Seq String
debugs) =
        Identity ((a, [BrittanyError]), Seq String)
-> ((a, [BrittanyError]), Seq String)
forall a. Identity a -> a
runIdentity
          (Identity ((a, [BrittanyError]), Seq String)
 -> ((a, [BrittanyError]), Seq String))
-> Identity ((a, [BrittanyError]), Seq String)
-> ((a, [BrittanyError]), Seq String)
forall a b. (a -> b) -> a -> b
$ MultiRWST '[] '[] '[] Identity ((a, [BrittanyError]), Seq String)
-> Identity ((a, [BrittanyError]), Seq String)
forall (m :: * -> *) a. Monad m => MultiRWST '[] '[] '[] m a -> m a
MultiRWSS.runMultiRWSTNil
          (MultiRWST '[] '[] '[] Identity ((a, [BrittanyError]), Seq String)
 -> Identity ((a, [BrittanyError]), Seq String))
-> MultiRWST
     '[] '[] '[] Identity ((a, [BrittanyError]), Seq String)
-> Identity ((a, [BrittanyError]), Seq String)
forall a b. (a -> b) -> a -> b
$ NodeAllocIndex
-> MultiRWST
     '[]
     '[]
     '[NodeAllocIndex]
     Identity
     ((a, [BrittanyError]), Seq String)
-> MultiRWST
     '[] '[] '[] Identity ((a, [BrittanyError]), Seq String)
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m a
MultiRWSS.withMultiStateA (Int -> NodeAllocIndex
NodeAllocIndex Int
1)
          (MultiRWST
   '[]
   '[]
   '[NodeAllocIndex]
   Identity
   ((a, [BrittanyError]), Seq String)
 -> MultiRWST
      '[] '[] '[] Identity ((a, [BrittanyError]), Seq String))
-> MultiRWST
     '[]
     '[]
     '[NodeAllocIndex]
     Identity
     ((a, [BrittanyError]), Seq String)
-> MultiRWST
     '[] '[] '[] Identity ((a, [BrittanyError]), Seq String)
forall a b. (a -> b) -> a -> b
$ HList '[Config, Anns]
-> MultiRWST
     (Append '[Config, Anns] '[])
     '[]
     '[NodeAllocIndex]
     Identity
     ((a, [BrittanyError]), Seq String)
-> MultiRWST
     '[]
     '[]
     '[NodeAllocIndex]
     Identity
     ((a, [BrittanyError]), Seq String)
forall (m :: * -> *) (r1 :: [*]) (r2 :: [*]) (w :: [*]) (s :: [*])
       a.
Monad m =>
HList r1
-> MultiRWST (Append r1 r2) w s m a -> MultiRWST r2 w s m a
MultiRWSS.withMultiReaders HList '[Config, Anns]
readers
          (MultiRWST
   (Append '[Config, Anns] '[])
   '[]
   '[NodeAllocIndex]
   Identity
   ((a, [BrittanyError]), Seq String)
 -> MultiRWST
      '[]
      '[]
      '[NodeAllocIndex]
      Identity
      ((a, [BrittanyError]), Seq String))
-> MultiRWST
     (Append '[Config, Anns] '[])
     '[]
     '[NodeAllocIndex]
     Identity
     ((a, [BrittanyError]), Seq String)
-> MultiRWST
     '[]
     '[]
     '[NodeAllocIndex]
     Identity
     ((a, [BrittanyError]), Seq String)
forall a b. (a -> b) -> a -> b
$ MultiRWST
  '[Config, Anns]
  '[Seq String]
  '[NodeAllocIndex]
  Identity
  (a, [BrittanyError])
-> MultiRWST
     '[Config, Anns]
     '[]
     '[NodeAllocIndex]
     Identity
     ((a, [BrittanyError]), Seq String)
forall w (m :: * -> *) (r :: [*]) (ws :: [*]) (s :: [*]) a.
(Monoid w, Monad m) =>
MultiRWST r (w : ws) s m a -> MultiRWST r ws s m (a, w)
MultiRWSS.withMultiWriterAW
          (MultiRWST
   '[Config, Anns]
   '[Seq String]
   '[NodeAllocIndex]
   Identity
   (a, [BrittanyError])
 -> MultiRWST
      '[Config, Anns]
      '[]
      '[NodeAllocIndex]
      Identity
      ((a, [BrittanyError]), Seq String))
-> MultiRWST
     '[Config, Anns]
     '[Seq String]
     '[NodeAllocIndex]
     Identity
     (a, [BrittanyError])
-> MultiRWST
     '[Config, Anns]
     '[]
     '[NodeAllocIndex]
     Identity
     ((a, [BrittanyError]), Seq String)
forall a b. (a -> b) -> a -> b
$ ToBriDocM a
-> MultiRWST
     '[Config, Anns]
     '[Seq String]
     '[NodeAllocIndex]
     Identity
     (a, [BrittanyError])
forall w (m :: * -> *) (r :: [*]) (ws :: [*]) (s :: [*]) a.
(Monoid w, Monad m) =>
MultiRWST r (w : ws) s m a -> MultiRWST r ws s m (a, w)
MultiRWSS.withMultiWriterAW
          (ToBriDocM a
 -> MultiRWST
      '[Config, Anns]
      '[Seq String]
      '[NodeAllocIndex]
      Identity
      (a, [BrittanyError]))
-> ToBriDocM a
-> MultiRWST
     '[Config, Anns]
     '[Seq String]
     '[NodeAllocIndex]
     Identity
     (a, [BrittanyError])
forall a b. (a -> b) -> a -> b
$ ToBriDocM a
m
  (a, [BrittanyError], Seq String)
-> PPMLocal (a, [BrittanyError], Seq String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x, [BrittanyError]
errs, Seq String
debugs)

docSharedWrapper :: Monad m => (x -> m y) -> x -> m (m y)
docSharedWrapper :: (x -> m y) -> x -> m (m y)
docSharedWrapper x -> m y
f x
x = y -> m y
forall (m :: * -> *) a. Monad m => a -> m a
return (y -> m y) -> m y -> m (m y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x -> m y
f x
x