-- | Parse and print CommonMark (like Github-flavored Markdown) transcripts.
module Unison.Codebase.Transcript.Parser
  ( -- * printing
    formatAPIRequest,
    formatUcmLine,
    formatInfoString,
    formatStanzas,

    -- * parsing
    stanzas,
    ucmLine,
    apiRequest,
    fenced,
    hidden,
    expectingError,
    language,
  )
where

import CMark qualified
import Data.Bool (bool)
import Data.Char qualified as Char
import Data.Text qualified as Text
import Text.Megaparsec qualified as P
import Text.Megaparsec.Char qualified as P
import Unison.Codebase.Transcript hiding (expectingError, generated, hasBug, hidden)
import Unison.Prelude
import Unison.Project (fullyQualifiedProjectAndBranchNamesParser)

padIfNonEmpty :: Text -> Text
padIfNonEmpty :: Text -> Text
padIfNonEmpty Text
line = if Text -> Bool
Text.null Text
line then Text
line else Text
"  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
line

formatAPIRequest :: APIRequest -> Text
formatAPIRequest :: APIRequest -> Text
formatAPIRequest = \case
  GetRequest Text
txt -> Text
"GET " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
  APIComment Text
txt -> Text
"--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
  APIResponseLine Text
txt -> [Text] -> Text
Text.unlines ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
padIfNonEmpty ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
Text.lines Text
txt

formatUcmLine :: UcmLine -> Text
formatUcmLine :: UcmLine -> Text
formatUcmLine = \case
  UcmCommand UcmContext
context Text
txt -> UcmContext -> Text
formatContext UcmContext
context Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
  UcmComment Text
txt -> Text
"--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
  UcmOutputLine Text
txt -> [Text] -> Text
Text.unlines ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
padIfNonEmpty ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
Text.lines Text
txt
  where
    formatContext :: UcmContext -> Text
formatContext (UcmContextProject ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch) = forall target source. From source target => source -> target
into @Text ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch

formatStanzas :: [Stanza] -> Text
formatStanzas :: [Stanza] -> Text
formatStanzas =
  [CMarkOption] -> Maybe Int -> Node -> Text
CMark.nodeToCommonmark [] Maybe Int
forall a. Maybe a
Nothing (Node -> Text) -> ([Stanza] -> Node) -> [Stanza] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PosInfo -> NodeType -> [Node] -> Node
CMark.Node Maybe PosInfo
forall a. Maybe a
Nothing NodeType
CMark.DOCUMENT ([Node] -> Node) -> ([Stanza] -> [Node]) -> [Stanza] -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stanza -> Node) -> [Stanza] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Node -> Node) -> (ProcessedBlock -> Node) -> Stanza -> Node
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Node -> Node
forall a. a -> a
id ProcessedBlock -> Node
processedBlockToNode)

processedBlockToNode :: ProcessedBlock -> CMark.Node
processedBlockToNode :: ProcessedBlock -> Node
processedBlockToNode = \case
  Ucm InfoTags ()
tags [UcmLine]
cmds -> (() -> Maybe Text) -> Text -> InfoTags () -> Text -> Node
forall {a}. (a -> Maybe Text) -> Text -> InfoTags a -> Text -> Node
mkNode (\() -> Maybe Text
forall a. Maybe a
Nothing) Text
"ucm" InfoTags ()
tags (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ (UcmLine -> Text -> Text) -> Text -> [UcmLine] -> Text
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) (Text -> Text -> Text)
-> (UcmLine -> Text) -> UcmLine -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UcmLine -> Text
formatUcmLine) Text
"" [UcmLine]
cmds
  Unison InfoTags (Maybe Text)
tags Text
txt -> (Maybe Text -> Maybe Text)
-> Text -> InfoTags (Maybe Text) -> Text -> Node
forall {a}. (a -> Maybe Text) -> Text -> InfoTags a -> Text -> Node
mkNode Maybe Text -> Maybe Text
forall a. a -> a
id Text
"unison" InfoTags (Maybe Text)
tags Text
txt
  API InfoTags ()
tags [APIRequest]
apiRequests -> (() -> Maybe Text) -> Text -> InfoTags () -> Text -> Node
forall {a}. (a -> Maybe Text) -> Text -> InfoTags a -> Text -> Node
mkNode (\() -> Maybe Text
forall a. Maybe a
Nothing) Text
"api" InfoTags ()
tags (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ (APIRequest -> Text -> Text) -> Text -> [APIRequest] -> Text
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) (Text -> Text -> Text)
-> (APIRequest -> Text) -> APIRequest -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APIRequest -> Text
formatAPIRequest) Text
"" [APIRequest]
apiRequests
  where
    mkNode :: (a -> Maybe Text) -> Text -> InfoTags a -> Text -> Node
mkNode a -> Maybe Text
formatA Text
lang = Maybe PosInfo -> Text -> Text -> Node
CMarkCodeBlock Maybe PosInfo
forall a. Maybe a
Nothing (Text -> Text -> Node)
-> (InfoTags a -> Text) -> InfoTags a -> Text -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe Text) -> Text -> InfoTags a -> Text
forall a. (a -> Maybe Text) -> Text -> InfoTags a -> Text
formatInfoString a -> Maybe Text
formatA Text
lang

type P = P.Parsec Void Text

stanzas :: FilePath -> Text -> Either (P.ParseErrorBundle Text Void) [Stanza]
stanzas :: String -> Text -> Either (ParseErrorBundle Text Void) [Stanza]
stanzas String
srcName =
  -- TODO: Internal warning if `_DOCUMENT` isn’t `CMark.DOCUMENT`.
  (\(CMark.Node Maybe PosInfo
_ NodeType
_DOCUMENT [Node]
blocks) -> (Node -> Either (ParseErrorBundle Text Void) Stanza)
-> [Node] -> Either (ParseErrorBundle Text Void) [Stanza]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Node -> Either (ParseErrorBundle Text Void) Stanza
stanzaFromNode [Node]
blocks)
    (Node -> Either (ParseErrorBundle Text Void) [Stanza])
-> (Text -> Node)
-> Text
-> Either (ParseErrorBundle Text Void) [Stanza]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CMarkOption] -> Text -> Node
CMark.commonmarkToNode [CMarkOption
CMark.optSourcePos]
  where
    stanzaFromNode :: CMark.Node -> Either (P.ParseErrorBundle Text Void) Stanza
    stanzaFromNode :: Node -> Either (ParseErrorBundle Text Void) Stanza
stanzaFromNode Node
node = case Node
node of
      CMarkCodeBlock (Just CMark.PosInfo {Int
startLine :: Int
startLine :: PosInfo -> Int
startLine, Int
startColumn :: Int
startColumn :: PosInfo -> Int
startColumn}) Text
info Text
body ->
        Stanza
-> (ProcessedBlock -> Stanza) -> Maybe ProcessedBlock -> Stanza
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Node -> Stanza
forall a b. a -> Either a b
Left Node
node) ProcessedBlock -> Stanza
forall a. a -> Either Node a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ProcessedBlock -> Stanza)
-> Either (ParseErrorBundle Text Void) (Maybe ProcessedBlock)
-> Either (ParseErrorBundle Text Void) Stanza
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (State Text Void,
 Either (ParseErrorBundle Text Void) (Maybe ProcessedBlock))
-> Either (ParseErrorBundle Text Void) (Maybe ProcessedBlock)
forall a b. (a, b) -> b
snd (Parsec Void Text (Maybe ProcessedBlock)
-> State Text Void
-> (State Text Void,
    Either (ParseErrorBundle Text Void) (Maybe ProcessedBlock))
forall e s a.
Parsec e s a
-> State s e -> (State s e, Either (ParseErrorBundle s e) a)
P.runParser' Parsec Void Text (Maybe ProcessedBlock)
fenced (State Text Void
 -> (State Text Void,
     Either (ParseErrorBundle Text Void) (Maybe ProcessedBlock)))
-> State Text Void
-> (State Text Void,
    Either (ParseErrorBundle Text Void) (Maybe ProcessedBlock))
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> Text -> Text -> State Text Void
forall e. String -> Int -> Int -> Text -> Text -> State Text e
fencedState String
srcName Int
startLine Int
startColumn Text
info Text
body)
      Node
_ -> Stanza -> Either (ParseErrorBundle Text Void) Stanza
forall a. a -> Either (ParseErrorBundle Text Void) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stanza -> Either (ParseErrorBundle Text Void) Stanza)
-> Stanza -> Either (ParseErrorBundle Text Void) Stanza
forall a b. (a -> b) -> a -> b
$ Node -> Stanza
forall a b. a -> Either a b
Left Node
node

ucmLine :: P UcmLine
ucmLine :: P UcmLine
ucmLine = P UcmLine
ucmOutputLine P UcmLine -> P UcmLine -> P UcmLine
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P UcmLine
ucmComment P UcmLine -> P UcmLine -> P UcmLine
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P UcmLine
ucmCommand
  where
    ucmCommand :: P UcmLine
    ucmCommand :: P UcmLine
ucmCommand =
      UcmContext -> Text -> UcmLine
UcmCommand
        (UcmContext -> Text -> UcmLine)
-> ParsecT Void Text Identity UcmContext
-> ParsecT Void Text Identity (Text -> UcmLine)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProjectAndBranch ProjectName ProjectBranchName -> UcmContext)
-> ParsecT
     Void Text Identity (ProjectAndBranch ProjectName ProjectBranchName)
-> ParsecT Void Text Identity UcmContext
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          ProjectAndBranch ProjectName ProjectBranchName -> UcmContext
UcmContextProject
          (ParsecT
  Void Text Identity (ProjectAndBranch ProjectName ProjectBranchName)
fullyQualifiedProjectAndBranchNamesParser ParsecT
  Void Text Identity (ProjectAndBranch ProjectName ProjectBranchName)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT
     Void Text Identity (ProjectAndBranch ProjectName ProjectBranchName)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a. P a -> P a
lineToken (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.chunk Tokens Text
">") ParsecT
  Void Text Identity (ProjectAndBranch ProjectName ProjectBranchName)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void Text Identity (ProjectAndBranch ProjectName ProjectBranchName)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
nonNewlineSpaces)
        ParsecT Void Text Identity (Text -> UcmLine)
-> ParsecT Void Text Identity Text -> P UcmLine
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
restOfLine

    ucmComment :: P UcmLine
    ucmComment :: P UcmLine
ucmComment =
      String -> P UcmLine -> P UcmLine
forall a.
String
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
P.label String
"comment (delimited with “--”)" (P UcmLine -> P UcmLine) -> P UcmLine -> P UcmLine
forall a b. (a -> b) -> a -> b
$
        Text -> UcmLine
UcmComment (Text -> UcmLine) -> ParsecT Void Text Identity Text -> P UcmLine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.chunk Tokens Text
"--" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
restOfLine)

    ucmOutputLine :: P UcmLine
    ucmOutputLine :: P UcmLine
ucmOutputLine = Text -> UcmLine
UcmOutputLine (Text -> UcmLine) -> ParsecT Void Text Identity Text -> P UcmLine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.chunk Tokens Text
"  " ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
restOfLine ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text
"" Text
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity Text
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
P.single Char
Token Text
'\n' ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text
"" Text
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity Text
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.chunk Tokens Text
" \n")

restOfLine :: P Text
restOfLine :: ParsecT Void Text Identity Text
restOfLine = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP Maybe String
forall a. Maybe a
Nothing (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token Text
'\n') ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
P.single Char
Token Text
'\n'

apiRequest :: P APIRequest
apiRequest :: P APIRequest
apiRequest =
  Text -> APIRequest
GetRequest (Text -> APIRequest)
-> ParsecT Void Text Identity Text -> P APIRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ParsecT Void Text Identity Text
word Text
"GET" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
spaces ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
restOfLine)
    P APIRequest -> P APIRequest -> P APIRequest
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> APIRequest
APIComment (Text -> APIRequest)
-> ParsecT Void Text Identity Text -> P APIRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.chunk Tokens Text
"--" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
restOfLine)
    P APIRequest -> P APIRequest -> P APIRequest
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> APIRequest
APIResponseLine (Text -> APIRequest)
-> ParsecT Void Text Identity Text -> P APIRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.chunk Tokens Text
"  " ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
restOfLine ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text
"" Text
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity Text
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
P.single Char
Token Text
'\n' ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text
"" Text
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity Text
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.chunk Tokens Text
" \n")

formatInfoString :: (a -> Maybe Text) -> Text -> InfoTags a -> Text
formatInfoString :: forall a. (a -> Maybe Text) -> Text -> InfoTags a -> Text
formatInfoString a -> Maybe Text
formatA Text
language InfoTags a
infoTags =
  let infoTagText :: Text
infoTagText = (a -> Maybe Text) -> InfoTags a -> Text
forall a. (a -> Maybe Text) -> InfoTags a -> Text
formatInfoTags a -> Maybe Text
formatA InfoTags a
infoTags
   in if Text -> Bool
Text.null Text
infoTagText then Text
language else Text
language Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
infoTagText

formatInfoTags :: (a -> Maybe Text) -> InfoTags a -> Text
formatInfoTags :: forall a. (a -> Maybe Text) -> InfoTags a -> Text
formatInfoTags a -> Maybe Text
formatA (InfoTags Hidden
hidden Bool
expectingError Bool
hasBug Bool
generated a
additionalTags) =
  Text -> [Text] -> Text
Text.intercalate Text
" " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes
      [ Hidden -> Maybe Text
formatHidden Hidden
hidden,
        Bool -> Maybe Text
formatExpectingError Bool
expectingError,
        Bool -> Maybe Text
formatHasBug Bool
hasBug,
        Bool -> Maybe Text
formatGenerated Bool
generated,
        a -> Maybe Text
formatA a
additionalTags
      ]

infoTags :: P a -> P (InfoTags a)
infoTags :: forall a. P a -> P (InfoTags a)
infoTags P a
p =
  Hidden -> Bool -> Bool -> Bool -> a -> InfoTags a
forall a. Hidden -> Bool -> Bool -> Bool -> a -> InfoTags a
InfoTags
    (Hidden -> Bool -> Bool -> Bool -> a -> InfoTags a)
-> ParsecT Void Text Identity Hidden
-> ParsecT
     Void Text Identity (Bool -> Bool -> Bool -> a -> InfoTags a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Hidden
-> ParsecT Void Text Identity Hidden
forall a. P a -> P a
lineToken ParsecT Void Text Identity Hidden
hidden
    ParsecT
  Void Text Identity (Bool -> Bool -> Bool -> a -> InfoTags a)
-> ParsecT Void Text Identity Bool
-> ParsecT Void Text Identity (Bool -> Bool -> a -> InfoTags a)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Bool -> ParsecT Void Text Identity Bool
forall a. P a -> P a
lineToken ParsecT Void Text Identity Bool
expectingError
    ParsecT Void Text Identity (Bool -> Bool -> a -> InfoTags a)
-> ParsecT Void Text Identity Bool
-> ParsecT Void Text Identity (Bool -> a -> InfoTags a)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Bool -> ParsecT Void Text Identity Bool
forall a. P a -> P a
lineToken ParsecT Void Text Identity Bool
hasBug
    ParsecT Void Text Identity (Bool -> a -> InfoTags a)
-> ParsecT Void Text Identity Bool
-> ParsecT Void Text Identity (a -> InfoTags a)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Bool -> ParsecT Void Text Identity Bool
forall a. P a -> P a
lineToken ParsecT Void Text Identity Bool
generated
    ParsecT Void Text Identity (a -> InfoTags a)
-> P a -> ParsecT Void Text Identity (InfoTags a)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P a
p
    ParsecT Void Text Identity (InfoTags a)
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (InfoTags a)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
P.single Char
Token Text
'\n'

-- | Parses the info string and contents of a fenced code block.
fenced :: P (Maybe ProcessedBlock)
fenced :: Parsec Void Text (Maybe ProcessedBlock)
fenced = do
  Text
fenceType <- ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. P a -> P a
lineToken ParsecT Void Text Identity Text
language
  case Text
fenceType of
    Text
"ucm" -> (ProcessedBlock -> Maybe ProcessedBlock)
-> ParsecT Void Text Identity ProcessedBlock
-> Parsec Void Text (Maybe ProcessedBlock)
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ProcessedBlock -> Maybe ProcessedBlock
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParsecT Void Text Identity ProcessedBlock
 -> Parsec Void Text (Maybe ProcessedBlock))
-> ParsecT Void Text Identity ProcessedBlock
-> Parsec Void Text (Maybe ProcessedBlock)
forall a b. (a -> b) -> a -> b
$ InfoTags () -> [UcmLine] -> ProcessedBlock
Ucm (InfoTags () -> [UcmLine] -> ProcessedBlock)
-> ParsecT Void Text Identity (InfoTags ())
-> ParsecT Void Text Identity ([UcmLine] -> ProcessedBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (InfoTags ())
forall a. P a -> P (InfoTags a)
infoTags (() -> ParsecT Void Text Identity ()
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ParsecT Void Text Identity ([UcmLine] -> ProcessedBlock)
-> ParsecT Void Text Identity [UcmLine]
-> ParsecT Void Text Identity ProcessedBlock
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P UcmLine
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [UcmLine]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill P UcmLine
ucmLine ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof
    Text
"unison" -> (ProcessedBlock -> Maybe ProcessedBlock)
-> ParsecT Void Text Identity ProcessedBlock
-> Parsec Void Text (Maybe ProcessedBlock)
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ProcessedBlock -> Maybe ProcessedBlock
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParsecT Void Text Identity ProcessedBlock
 -> Parsec Void Text (Maybe ProcessedBlock))
-> ParsecT Void Text Identity ProcessedBlock
-> Parsec Void Text (Maybe ProcessedBlock)
forall a b. (a -> b) -> a -> b
$ InfoTags (Maybe Text) -> Text -> ProcessedBlock
Unison (InfoTags (Maybe Text) -> Text -> ProcessedBlock)
-> ParsecT Void Text Identity (InfoTags (Maybe Text))
-> ParsecT Void Text Identity (Text -> ProcessedBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Maybe Text)
-> ParsecT Void Text Identity (InfoTags (Maybe Text))
forall a. P a -> P (InfoTags a)
infoTags (ParsecT Void Text Identity Text -> P (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
untilSpace1) ParsecT Void Text Identity (Text -> ProcessedBlock)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ProcessedBlock
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
forall e s (m :: * -> *). MonadParsec e s m => m s
P.getInput
    Text
"api" -> (ProcessedBlock -> Maybe ProcessedBlock)
-> ParsecT Void Text Identity ProcessedBlock
-> Parsec Void Text (Maybe ProcessedBlock)
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ProcessedBlock -> Maybe ProcessedBlock
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParsecT Void Text Identity ProcessedBlock
 -> Parsec Void Text (Maybe ProcessedBlock))
-> ParsecT Void Text Identity ProcessedBlock
-> Parsec Void Text (Maybe ProcessedBlock)
forall a b. (a -> b) -> a -> b
$ InfoTags () -> [APIRequest] -> ProcessedBlock
API (InfoTags () -> [APIRequest] -> ProcessedBlock)
-> ParsecT Void Text Identity (InfoTags ())
-> ParsecT Void Text Identity ([APIRequest] -> ProcessedBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (InfoTags ())
forall a. P a -> P (InfoTags a)
infoTags (() -> ParsecT Void Text Identity ()
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ParsecT Void Text Identity ([APIRequest] -> ProcessedBlock)
-> ParsecT Void Text Identity [APIRequest]
-> ParsecT Void Text Identity ProcessedBlock
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P APIRequest
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [APIRequest]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill P APIRequest
apiRequest ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof
    Text
_ -> Maybe ProcessedBlock -> Parsec Void Text (Maybe ProcessedBlock)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ProcessedBlock
forall a. Maybe a
Nothing

word :: Text -> P Text
word :: Text -> ParsecT Void Text Identity Text
word Text
text = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.chunk Text
Tokens Text
text ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
P.notFollowedBy ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
P.alphaNumChar

lineToken :: P a -> P a
lineToken :: forall a. P a -> P a
lineToken P a
p = P a
p P a -> ParsecT Void Text Identity () -> P a
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
nonNewlineSpaces

nonNewlineSpaces :: P ()
nonNewlineSpaces :: ParsecT Void Text Identity ()
nonNewlineSpaces = ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity (Tokens Text)
 -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP Maybe String
forall a. Maybe a
Nothing (\Token Text
ch -> Char
Token Text
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
Token Text
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t')

formatHidden :: Hidden -> Maybe Text
formatHidden :: Hidden -> Maybe Text
formatHidden = \case
  Hidden
HideAll -> Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
":hide-all"
  Hidden
HideOutput -> Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
":hide"
  Hidden
Shown -> Maybe Text
forall a. Maybe a
Nothing

hidden :: P Hidden
hidden :: ParsecT Void Text Identity Hidden
hidden =
  (Hidden
HideAll Hidden
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Hidden
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
word Text
":hide-all")
    ParsecT Void Text Identity Hidden
-> ParsecT Void Text Identity Hidden
-> ParsecT Void Text Identity Hidden
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Hidden
HideOutput Hidden
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Hidden
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
word Text
":hide")
    ParsecT Void Text Identity Hidden
-> ParsecT Void Text Identity Hidden
-> ParsecT Void Text Identity Hidden
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Hidden -> ParsecT Void Text Identity Hidden
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Hidden
Shown

formatExpectingError :: ExpectingError -> Maybe Text
formatExpectingError :: Bool -> Maybe Text
formatExpectingError = Maybe Text -> Maybe Text -> Bool -> Maybe Text
forall a. a -> a -> Bool -> a
bool Maybe Text
forall a. Maybe a
Nothing (Maybe Text -> Bool -> Maybe Text)
-> Maybe Text -> Bool -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
":error"

expectingError :: P ExpectingError
expectingError :: ParsecT Void Text Identity Bool
expectingError = Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool)
-> P (Maybe Text) -> ParsecT Void Text Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> P (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> ParsecT Void Text Identity Text
word Text
":error")

formatHasBug :: HasBug -> Maybe Text
formatHasBug :: Bool -> Maybe Text
formatHasBug = Maybe Text -> Maybe Text -> Bool -> Maybe Text
forall a. a -> a -> Bool -> a
bool Maybe Text
forall a. Maybe a
Nothing (Maybe Text -> Bool -> Maybe Text)
-> Maybe Text -> Bool -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
":bug"

hasBug :: P HasBug
hasBug :: ParsecT Void Text Identity Bool
hasBug = Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool)
-> P (Maybe Text) -> ParsecT Void Text Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> P (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> ParsecT Void Text Identity Text
word Text
":bug")

formatGenerated :: ExpectingError -> Maybe Text
formatGenerated :: Bool -> Maybe Text
formatGenerated = Maybe Text -> Maybe Text -> Bool -> Maybe Text
forall a. a -> a -> Bool -> a
bool Maybe Text
forall a. Maybe a
Nothing (Maybe Text -> Bool -> Maybe Text)
-> Maybe Text -> Bool -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
":added-by-ucm"

generated :: P Bool
generated :: ParsecT Void Text Identity Bool
generated = Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool)
-> P (Maybe Text) -> ParsecT Void Text Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> P (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> ParsecT Void Text Identity Text
word Text
":added-by-ucm")

untilSpace1 :: P Text
untilSpace1 :: ParsecT Void Text Identity Text
untilSpace1 = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
P.takeWhile1P Maybe String
forall a. Maybe a
Nothing (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Char.isSpace)

language :: P Text
language :: ParsecT Void Text Identity Text
language = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP Maybe String
forall a. Maybe a
Nothing (\Token Text
ch -> Char -> Bool
Char.isDigit Char
Token Text
ch Bool -> Bool -> Bool
|| Char -> Bool
Char.isLower Char
Token Text
ch Bool -> Bool -> Bool
|| Char
Token Text
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')

spaces :: P ()
spaces :: ParsecT Void Text Identity ()
spaces = ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity (Tokens Text)
 -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"spaces") Char -> Bool
Token Text -> Bool
Char.isSpace

-- | Create a parser state that has source locations that match the file (as opposed to being relative to the start of
--   the individual fenced code block).
--
--  __NB__: If a code block has a fence longer than the minimum (three backticks), the columns for parse errors in the
--          info string will be slightly off (but the printed code excerpt will match the reported positions).
--
--  __NB__: Creating custom states is likely simpler starting with Megaparsec 9.6.0.
fencedState ::
  -- | file containing the fenced code block
  FilePath ->
  -- | `CMark.startLine` for the block
  Int ->
  -- | `CMark.startColumn` for the block`
  Int ->
  -- | info string from the block
  Text ->
  -- | contents of the code block
  Text ->
  P.State Text e
fencedState :: forall e. String -> Int -> Int -> Text -> Text -> State Text e
fencedState String
name Int
startLine Int
startColumn Text
info Text
body =
  let -- This is the most common opening fence, so we assume it’s the right one. I don’t think there’s any way to get
      -- the actual size of the fence from "CMark", so this can be wrong sometimes, but it’s probably the approach
      -- that’s least likely to confuse users.
      openingFence :: String
openingFence = String
"``` "
      -- Glue the info string and body back together, as if they hadn’t been split by "CMark". This keeps the position
      -- info in sync.
      s :: Text
s = Text
info Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
body
   in P.State
        { stateInput :: Text
stateInput = Text
s,
          stateOffset :: Int
stateOffset = Int
0,
          statePosState :: PosState Text
statePosState =
            P.PosState
              { pstateInput :: Text
pstateInput = Text
s,
                pstateOffset :: Int
pstateOffset = Int
0,
                -- `CMark.startColumn` marks the beginning of the fence, not the beginning of the info string, so we
                -- adjust it for the fence that precedes it.
                pstateSourcePos :: SourcePos
pstateSourcePos = String -> Pos -> Pos -> SourcePos
P.SourcePos String
name (Int -> Pos
P.mkPos Int
startLine) (Pos -> SourcePos) -> (Int -> Pos) -> Int -> SourcePos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Pos
P.mkPos (Int -> SourcePos) -> Int -> SourcePos
forall a b. (a -> b) -> a -> b
$ Int
startColumn Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
openingFence,
                pstateTabWidth :: Pos
pstateTabWidth = Pos
P.defaultTabWidth,
                -- Ensure we print the fence as part of the line if there’s a parse error in the info string.
                pstateLinePrefix :: String
pstateLinePrefix = String
openingFence
              },
          stateParseErrors :: [ParseError Text e]
stateParseErrors = []
        }