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

    -- * conversion
    processedBlockToNode,

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

import CMark qualified
import Data.Char qualified as Char
import Data.Text qualified as Text
import Text.Megaparsec qualified as P
import Unison.Codebase.Transcript
import Unison.Prelude
import Unison.Project (fullyQualifiedProjectAndBranchNamesParser)

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
  APIComment Text
txt -> Text
"-- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 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
  UcmComment Text
txt -> Text
"--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 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

formatStanza :: Stanza -> Text
formatStanza :: Stanza -> Text
formatStanza = (Node -> Text) -> (ProcessedBlock -> Text) -> Stanza -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Node -> Text
formatNode ProcessedBlock -> Text
formatProcessedBlock

formatNode :: CMark.Node -> Text
formatNode :: Node -> Text
formatNode = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n") (Text -> Text) -> (Node -> Text) -> Node -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CMarkOption] -> Maybe Int -> Node -> Text
CMark.nodeToCommonmark [] Maybe Int
forall a. Maybe a
Nothing

formatProcessedBlock :: ProcessedBlock -> Text
formatProcessedBlock :: ProcessedBlock -> Text
formatProcessedBlock = Node -> Text
formatNode (Node -> Text)
-> (ProcessedBlock -> Node) -> ProcessedBlock -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessedBlock -> Node
processedBlockToNode

processedBlockToNode :: ProcessedBlock -> CMark.Node
processedBlockToNode :: ProcessedBlock -> Node
processedBlockToNode = \case
  Ucm Hidden
_ ExpectingError
_ [UcmLine]
cmds -> Maybe PosInfo -> Text -> Text -> Node
CMarkCodeBlock Maybe PosInfo
forall a. Maybe a
Nothing Text
"ucm" (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 Hidden
_hide ExpectingError
_ Maybe Text
fname Text
txt ->
    Maybe PosInfo -> Text -> Text -> Node
CMarkCodeBlock Maybe PosInfo
forall a. Maybe a
Nothing Text
"unison" (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
txt (\Text
fname -> [Text] -> Text
Text.unlines [Text
"---", Text
"title: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname, Text
"---", Text
txt]) Maybe Text
fname
  API [APIRequest]
apiRequests -> Maybe PosInfo -> Text -> Text -> Node
CMarkCodeBlock Maybe PosInfo
forall a. Maybe a
Nothing Text
"api" (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ APIRequest -> Text
formatAPIRequest (APIRequest -> Text) -> [APIRequest] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [APIRequest]
apiRequests

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 = (\(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 []
  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 Maybe PosInfo
_ 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
<$> Parsec Void Text (Maybe ProcessedBlock)
-> String
-> Text
-> Either (ParseErrorBundle Text Void) (Maybe ProcessedBlock)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.parse (Text -> Parsec Void Text (Maybe ProcessedBlock)
fenced Text
info) String
srcName 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
ucmCommand 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
  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)
-> ParsecT
     Void Text Identity (ProjectAndBranch ProjectName ProjectBranchName)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (ParsecT
   Void Text Identity (ProjectAndBranch ProjectName ProjectBranchName)
 -> ParsecT
      Void
      Text
      Identity
      (ProjectAndBranch ProjectName ProjectBranchName))
-> ParsecT
     Void Text Identity (ProjectAndBranch ProjectName ProjectBranchName)
-> ParsecT
     Void Text Identity (ProjectAndBranch ProjectName ProjectBranchName)
forall a b. (a -> b) -> a -> b
$ ParsecT
  Void Text Identity (ProjectAndBranch ProjectName ProjectBranchName)
fullyQualifiedProjectAndBranchNamesParser ParsecT
  Void Text Identity (ProjectAndBranch ProjectName ProjectBranchName)
-> ParsecT Void Text Identity 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 Text -> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lineToken (Text -> ParsecT Void Text Identity Text
word Text
">"))
        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
<*> Maybe String
-> (Token Text -> ExpectingError)
-> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> ExpectingError) -> m (Tokens s)
P.takeWhileP Maybe String
forall a. Maybe a
Nothing (Token Text -> Token Text -> ExpectingError
forall a. Eq a => a -> a -> ExpectingError
/= Char
Token Text
'\n')
        P UcmLine -> ParsecT Void Text Identity () -> P UcmLine
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

    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
<$> (Text -> ParsecT Void Text Identity Text
word Text
"--" ParsecT Void Text Identity 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
*> Maybe String
-> (Token Text -> ExpectingError)
-> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> ExpectingError) -> m (Tokens s)
P.takeWhileP Maybe String
forall a. Maybe a
Nothing (Token Text -> Token Text -> ExpectingError
forall a. Eq a => a -> a -> ExpectingError
/= Char
Token Text
'\n')) P UcmLine -> ParsecT Void Text Identity () -> P UcmLine
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

apiRequest :: P APIRequest
apiRequest :: P APIRequest
apiRequest = do
  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
getRequest
  where
    getRequest :: P APIRequest
getRequest = do
      Text -> ParsecT Void Text Identity Text
word Text
"GET"
      ParsecT Void Text Identity ()
spaces
      Text
path <- Maybe String
-> (Token Text -> ExpectingError)
-> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> ExpectingError) -> m (Tokens s)
P.takeWhile1P Maybe String
forall a. Maybe a
Nothing (Token Text -> Token Text -> ExpectingError
forall a. Eq a => a -> a -> ExpectingError
/= Char
Token Text
'\n')
      ParsecT Void Text Identity ()
spaces
      pure (Text -> APIRequest
GetRequest Text
path)
    apiComment :: P APIRequest
apiComment = do
      Text -> ParsecT Void Text Identity Text
word Text
"--"
      Text
comment <- Maybe String
-> (Token Text -> ExpectingError)
-> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> ExpectingError) -> m (Tokens s)
P.takeWhileP Maybe String
forall a. Maybe a
Nothing (Token Text -> Token Text -> ExpectingError
forall a. Eq a => a -> a -> ExpectingError
/= Char
Token Text
'\n')
      ParsecT Void Text Identity ()
spaces
      pure (Text -> APIRequest
APIComment Text
comment)

-- | Produce the correct parser for the code block based on the provided info string.
fenced :: Text -> P (Maybe ProcessedBlock)
fenced :: Text -> Parsec Void Text (Maybe ProcessedBlock)
fenced Text
info = do
  Text
body <- ParsecT Void Text Identity Text
forall e s (m :: * -> *). MonadParsec e s m => m s
P.getInput
  Text -> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => s -> m ()
P.setInput Text
info
  Text
fenceType <- ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lineToken (Text -> ParsecT Void Text Identity Text
word Text
"ucm" 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 -> ParsecT Void Text Identity Text
word Text
"unison" 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 -> ParsecT Void Text Identity Text
word Text
"api" 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
<|> ParsecT Void Text Identity Text
language)
  case Text
fenceType of
    Text
"ucm" -> do
      Hidden
hide <- P Hidden
hidden
      ExpectingError
err <- P ExpectingError
expectingError
      Text -> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => s -> m ()
P.setInput Text
body
      ProcessedBlock -> Maybe ProcessedBlock
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProcessedBlock -> Maybe ProcessedBlock)
-> ([UcmLine] -> ProcessedBlock)
-> [UcmLine]
-> Maybe ProcessedBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hidden -> ExpectingError -> [UcmLine] -> ProcessedBlock
Ucm Hidden
hide ExpectingError
err ([UcmLine] -> Maybe ProcessedBlock)
-> ParsecT Void Text Identity [UcmLine]
-> Parsec Void Text (Maybe ProcessedBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity ()
spaces ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [UcmLine]
-> ParsecT Void Text Identity [UcmLine]
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
*> 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" ->
      do
        -- todo: this has to be more interesting
        -- ```unison:hide
        -- ```unison
        -- ```unison:hide:all scratch.u
        Hidden
hide <- P Hidden -> P Hidden
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lineToken P Hidden
hidden
        ExpectingError
err <- P ExpectingError -> P ExpectingError
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lineToken P ExpectingError
expectingError
        Maybe Text
fileName <- ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
untilSpace1
        Text -> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => s -> m ()
P.setInput Text
body
        ProcessedBlock -> Maybe ProcessedBlock
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProcessedBlock -> Maybe ProcessedBlock)
-> (Text -> ProcessedBlock) -> Text -> Maybe ProcessedBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hidden -> ExpectingError -> Maybe Text -> Text -> ProcessedBlock
Unison Hidden
hide ExpectingError
err Maybe Text
fileName (Text -> Maybe ProcessedBlock)
-> ParsecT Void Text Identity Text
-> Parsec Void Text (Maybe ProcessedBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> 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
forall e s (m :: * -> *). MonadParsec e s m => m s
P.getInput)
    Text
"api" -> do
      Text -> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => s -> m ()
P.setInput Text
body
      ProcessedBlock -> Maybe ProcessedBlock
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProcessedBlock -> Maybe ProcessedBlock)
-> ([APIRequest] -> ProcessedBlock)
-> [APIRequest]
-> Maybe ProcessedBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [APIRequest] -> ProcessedBlock
API ([APIRequest] -> Maybe ProcessedBlock)
-> ParsecT Void Text Identity [APIRequest]
-> Parsec Void Text (Maybe ProcessedBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity ()
spaces ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [APIRequest]
-> ParsecT Void Text Identity [APIRequest]
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
*> 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
txt = ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ do
  Text
chs <- Maybe String -> Int -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> Int -> m (Tokens s)
P.takeP (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. Show a => a -> String
show Text
txt) (Text -> Int
Text.length Text
txt)
  ExpectingError -> ParsecT Void Text Identity ()
forall (f :: * -> *). Alternative f => ExpectingError -> f ()
guard (Text
chs Text -> Text -> ExpectingError
forall a. Eq a => a -> a -> ExpectingError
== Text
txt)
  pure Text
txt

lineToken :: P a -> P a
lineToken :: forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity 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 -> ExpectingError)
-> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> ExpectingError) -> m (Tokens s)
P.takeWhileP Maybe String
forall a. Maybe a
Nothing (\Token Text
ch -> Char
Token Text
ch Char -> Char -> ExpectingError
forall a. Eq a => a -> a -> ExpectingError
== Char
' ' ExpectingError -> ExpectingError -> ExpectingError
|| Char
Token Text
ch Char -> Char -> ExpectingError
forall a. Eq a => a -> a -> ExpectingError
== Char
'\t')

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

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

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

language :: P Text
language :: ParsecT Void Text Identity Text
language = Maybe String
-> (Token Text -> ExpectingError)
-> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> ExpectingError) -> m (Tokens s)
P.takeWhileP Maybe String
forall a. Maybe a
Nothing (\Token Text
ch -> Char -> ExpectingError
Char.isDigit Char
Token Text
ch ExpectingError -> ExpectingError -> ExpectingError
|| Char -> ExpectingError
Char.isLower Char
Token Text
ch ExpectingError -> ExpectingError -> ExpectingError
|| Char
Token Text
ch Char -> Char -> ExpectingError
forall a. Eq a => a -> a -> ExpectingError
== 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 -> ExpectingError)
-> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> ExpectingError) -> m (Tokens s)
P.takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"spaces") Char -> ExpectingError
Token Text -> ExpectingError
Char.isSpace