-- | Parse and print CommonMark (like Github-flavored Markdown) transcripts.
module Unison.Codebase.Transcript.Parser
  ( format,
    parse,
  )
where

import CMark qualified
import Data.Aeson qualified as Aeson
import Data.Bitraversable (bitraverse)
import Data.Bool (bool)
import Data.Char qualified as Char
import Data.Frontmatter (parseYamlFrontmatter)
import Data.Frontmatter qualified as Frontmatter
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text.Enc
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)
import Unison.Server.Backend (encodeFrontmatter)

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"
  PostRequest Text
url Text
body ->
    Text
"POST " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
Text.unlines (Text
"BODY:" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (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.lines Text
body)) 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"
  APIResponse Text
txt -> [Text] -> Text
Text.unlines (Text
"RESPONSE:" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (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.lines Text
txt)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"

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 UcmContext
UcmContextEmpty = Text
""
    formatContext (UcmContextProject ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch) = forall target source. From source target => source -> target
into @Text ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch

formatSettings :: Aeson.Value -> Text
formatSettings :: Value -> Text
formatSettings Value
frontmatter =
  if Value
frontmatter Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
Aeson.Null then Text
"" else ByteString -> Text
Text.Enc.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encodeFrontmatter Value
frontmatter ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"

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)

format :: Transcript -> Text
format :: Transcript -> Text
format Transcript {Value
frontmatter :: Value
$sel:frontmatter:Transcript :: Transcript -> Value
frontmatter, [Stanza]
stanzas :: [Stanza]
$sel:stanzas:Transcript :: Transcript -> [Stanza]
stanzas} = Value -> Text
formatSettings Value
frontmatter Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Stanza] -> Text
formatStanzas [Stanza]
stanzas

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

parse :: FilePath -> ByteString -> Either (P.ParseErrorBundle Text Void) Transcript
parse :: String
-> ByteString -> Either (ParseErrorBundle Text Void) Transcript
parse String
srcName =
  ((Value, [Stanza]) -> Transcript)
-> Either (ParseErrorBundle Text Void) (Value, [Stanza])
-> Either (ParseErrorBundle Text Void) Transcript
forall a b.
(a -> b)
-> Either (ParseErrorBundle Text Void) a
-> Either (ParseErrorBundle Text Void) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Value -> [Stanza] -> Transcript)
-> (Value, [Stanza]) -> Transcript
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Value -> [Stanza] -> Transcript
Transcript)
    (Either (ParseErrorBundle Text Void) (Value, [Stanza])
 -> Either (ParseErrorBundle Text Void) Transcript)
-> (ByteString
    -> Either (ParseErrorBundle Text Void) (Value, [Stanza]))
-> ByteString
-> Either (ParseErrorBundle Text Void) Transcript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either String Value -> Either (ParseErrorBundle Text Void) Value)
-> (ByteString -> Either (ParseErrorBundle Text Void) [Stanza])
-> (Either String Value, ByteString)
-> Either (ParseErrorBundle Text Void) (Value, [Stanza])
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Value -> Either (ParseErrorBundle Text Void) Value
forall a. a -> Either (ParseErrorBundle Text Void) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either (ParseErrorBundle Text Void) Value)
-> (Either String Value -> Value)
-> Either String Value
-> Either (ParseErrorBundle Text Void) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Value)
-> (Value -> Value) -> Either String Value -> Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Value -> String -> Value
forall a b. a -> b -> a
const Value
Aeson.Null) Value -> Value
forall a. a -> a
id) (String -> Text -> Either (ParseErrorBundle Text Void) [Stanza]
parseStanzas String
srcName (Text -> Either (ParseErrorBundle Text Void) [Stanza])
-> (ByteString -> Text)
-> ByteString
-> Either (ParseErrorBundle Text Void) [Stanza]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.Enc.decodeUtf8)
    ((Either String Value, ByteString)
 -> Either (ParseErrorBundle Text Void) (Value, [Stanza]))
-> (ByteString -> (Either String Value, ByteString))
-> ByteString
-> Either (ParseErrorBundle Text Void) (Value, [Stanza])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (Either String Value, ByteString)
parseSettings

handleFrontmatterResult :: Frontmatter.Result Aeson.Value -> Either String (Aeson.Value, ByteString)
handleFrontmatterResult :: Result Value -> Either String (Value, ByteString)
handleFrontmatterResult = \case
  Frontmatter.Fail ByteString
_remainder [String]
_contexts String
message -> String -> Either String (Value, ByteString)
forall a b. a -> Either a b
Left String
message
  Frontmatter.Partial ByteString -> Result Value
fn -> Result Value -> Either String (Value, ByteString)
handleFrontmatterResult (Result Value -> Either String (Value, ByteString))
-> Result Value -> Either String (Value, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Result Value
fn ByteString
forall a. Monoid a => a
mempty
  Frontmatter.Done ByteString
remainder Value
frontmatter -> (Value, ByteString) -> Either String (Value, ByteString)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
frontmatter, ByteString
remainder)

parseSettings :: ByteString -> (Either String Aeson.Value, ByteString)
parseSettings :: ByteString -> (Either String Value, ByteString)
parseSettings ByteString
input = (String -> (Either String Value, ByteString))
-> ((Value, ByteString) -> (Either String Value, ByteString))
-> Either String (Value, ByteString)
-> (Either String Value, ByteString)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((,ByteString
input) (Either String Value -> (Either String Value, ByteString))
-> (String -> Either String Value)
-> String
-> (Either String Value, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Value
forall a b. a -> Either a b
Left) ((Value -> Either String Value)
-> (Value, ByteString) -> (Either String Value, ByteString)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Value -> Either String Value
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (Either String (Value, ByteString)
 -> (Either String Value, ByteString))
-> (Result Value -> Either String (Value, ByteString))
-> Result Value
-> (Either String Value, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result Value -> Either String (Value, ByteString)
handleFrontmatterResult (Result Value -> (Either String Value, ByteString))
-> Result Value -> (Either String Value, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Result Value
forall a. FromJSON a => ByteString -> Result a
parseYamlFrontmatter ByteString
input

parseStanzas :: FilePath -> Text -> Either (P.ParseErrorBundle Text Void) [Stanza]
parseStanzas :: String -> Text -> Either (ParseErrorBundle Text Void) [Stanza]
parseStanzas 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
<$> (Maybe (ProjectAndBranch ProjectName ProjectBranchName)
 -> UcmContext)
-> ParsecT
     Void
     Text
     Identity
     (Maybe (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
          (UcmContext
-> (ProjectAndBranch ProjectName ProjectBranchName -> UcmContext)
-> Maybe (ProjectAndBranch ProjectName ProjectBranchName)
-> UcmContext
forall b a. b -> (a -> b) -> Maybe a -> b
maybe UcmContext
UcmContextEmpty ProjectAndBranch ProjectName ProjectBranchName -> UcmContext
UcmContextProject)
          (ParsecT
  Void Text Identity (ProjectAndBranch ProjectName ProjectBranchName)
-> ParsecT
     Void
     Text
     Identity
     (Maybe (ProjectAndBranch ProjectName ProjectBranchName))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT
  Void Text Identity (ProjectAndBranch ProjectName ProjectBranchName)
fullyQualifiedProjectAndBranchNamesParser ParsecT
  Void
  Text
  Identity
  (Maybe (ProjectAndBranch ProjectName ProjectBranchName))
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT
     Void
     Text
     Identity
     (Maybe (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
  (Maybe (ProjectAndBranch ProjectName ProjectBranchName))
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     (Maybe (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 =
  ( P APIRequest
getRequest
      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
<|> P APIRequest
postRequest
      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
<|> P APIRequest
apiComment
      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
<|> P APIRequest
apiResponse
  )
    P APIRequest -> ParsecT Void Text Identity () -> P APIRequest
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 ()
spaces
  where
    getRequest :: P APIRequest
getRequest = do
      Text
_ <- Text -> ParsecT Void Text Identity Text
word Text
"GET"
      ParsecT Void Text Identity ()
spaces
      Text
url <- ParsecT Void Text Identity Text
restOfLine
      APIRequest -> P APIRequest
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (APIRequest -> P APIRequest) -> APIRequest -> P APIRequest
forall a b. (a -> b) -> a -> b
$ Text -> APIRequest
GetRequest Text
url
    postRequest :: P APIRequest
postRequest = do
      Text
_ <- Text -> ParsecT Void Text Identity Text
word Text
"POST"
      ParsecT Void Text Identity ()
spaces
      Text
url <- ParsecT Void Text Identity Text
restOfLine
      Token Text
_ <- Text -> ParsecT Void Text Identity Text
word Text
"BODY:" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Token Text]
-> ParsecT Void Text Identity [Token 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 (Token Text)
-> ParsecT Void Text Identity [Token Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many (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
' ') ParsecT Void Text Identity [Token Text]
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (Token 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
*> 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'
      Text
body <- [Text] -> Text
Text.unlines ([Text] -> Text)
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (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)
      APIRequest -> P APIRequest
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (APIRequest -> P APIRequest) -> APIRequest -> P APIRequest
forall a b. (a -> b) -> a -> b
$ Text -> Text -> APIRequest
PostRequest Text
url Text
body
    apiComment :: P APIRequest
apiComment = do
      Tokens Text
_ <- 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
"--"
      Text
comment <- ParsecT Void Text Identity Text
restOfLine
      APIRequest -> P APIRequest
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (APIRequest -> P APIRequest) -> APIRequest -> P APIRequest
forall a b. (a -> b) -> a -> b
$ Text -> APIRequest
APIComment Text
comment
    apiResponse :: P APIRequest
apiResponse = do
      Token Text
_ <- Text -> ParsecT Void Text Identity Text
word Text
"RESPONSE:" 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
<* ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [Token Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many (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
' ') ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (Token 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
*> 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'
      Text
response <- [Text] -> Text
Text.unlines ([Text] -> Text)
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (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)
      APIRequest -> P APIRequest
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (APIRequest -> P APIRequest) -> APIRequest -> P APIRequest
forall a b. (a -> b) -> a -> b
$ Text -> APIRequest
APIResponse Text
response

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 Maybe 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
      [ Maybe Hidden -> Maybe Text
formatHidden Maybe 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 =
  Maybe Hidden -> Bool -> Bool -> Bool -> a -> InfoTags a
forall a. Maybe Hidden -> Bool -> Bool -> Bool -> a -> InfoTags a
InfoTags
    (Maybe Hidden -> Bool -> Bool -> Bool -> a -> InfoTags a)
-> ParsecT Void Text Identity (Maybe 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 (Maybe Hidden)
-> ParsecT Void Text Identity (Maybe Hidden)
forall a. P a -> P a
lineToken ParsecT Void Text Identity (Maybe 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 :: Maybe Hidden -> Maybe Text
formatHidden :: Maybe Hidden -> Maybe Text
formatHidden = (Hidden -> Text) -> Maybe Hidden -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \case
  Hidden
HideAll -> Text
":hide-all"
  Hidden
HideOutput -> Text
":hide"
  Hidden
Shown -> Text
":show"

hidden :: P (Maybe Hidden)
hidden :: ParsecT Void Text Identity (Maybe Hidden)
hidden =
  (Hidden -> Maybe Hidden
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Hidden
HideAll Maybe Hidden
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe 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 (Maybe Hidden)
-> ParsecT Void Text Identity (Maybe Hidden)
-> ParsecT Void Text Identity (Maybe 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 -> Maybe Hidden
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Hidden
HideOutput Maybe Hidden
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe 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 (Maybe Hidden)
-> ParsecT Void Text Identity (Maybe Hidden)
-> ParsecT Void Text Identity (Maybe 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 -> Maybe Hidden
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Hidden
Shown Maybe Hidden
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe 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
":show")
    ParsecT Void Text Identity (Maybe Hidden)
-> ParsecT Void Text Identity (Maybe Hidden)
-> ParsecT Void Text Identity (Maybe 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
<|> Maybe Hidden -> ParsecT Void Text Identity (Maybe Hidden)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Hidden
forall a. Maybe a
Nothing

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 = []
        }