{- |
Module      : Prosidy.Parse
Description : Parse raw text into Prosidy documents
Copyright   : (c) James Alexander Feldman-Crough, 2019
License     : MPL-2.0
Maintainer  : alex@fldcr.com
-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ApplicativeDo     #-}
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Prosidy.Parse
    ( -- * Parsing Prosidy types from 'Data.Text.Text'
      parseDocument
    , parseDocumentMetadata
      -- * Reading & parsing Prosidy files
    , readDocument
    , readDocumentMetadata
      -- * Errors
    , Failure(..)
    , prettyFailure
    )
where

import           Control.Monad.Fail.Compat      ( MonadFail(..) )
import           Prelude                 hiding ( fail )

import           Prosidy.Types
import           Prosidy.Source
import           Prosidy.Types.Key              ( isValidKeyHead
                                                , isValidKeyTail
                                                , unsafeMakeKey
                                                )
import           Prosidy.Types.Series           ( fromSeqNE
                                                , toSeqNE
                                                , fromSeq
                                                )

import           Text.Megaparsec         hiding ( token
                                                , sourceName
                                                )
import           Text.Megaparsec.Char           ( char
                                                , string
                                                )

import qualified Data.Char                     as Char
import qualified Data.Text.Lazy                as Text.Lazy
import qualified Data.HashMap.Strict           as HashMap
import qualified Data.Sequence                 as Seq
import qualified Data.List                     as List
import qualified Data.HashSet                  as HashSet
import qualified Data.Text.Encoding            as Text.Encoding
import qualified Text.Megaparsec.Char          as Megaparsec
import qualified Data.ByteString               as ByteString

import           Control.Applicative            ( Alternative )
import           Data.Bifunctor                 ( first )
import           Text.Megaparsec.Char.Lexer     ( hexadecimal )
import           Data.Functor                   ( ($>) )
import           Data.Foldable                  ( fold
                                                , traverse_
                                                )
import           Control.Monad                  ( MonadPlus
                                                , void
                                                )
import           Data.Text                      ( Text )
import           Data.Void                      ( Void )
import           Control.Exception              ( Exception
                                                , throwIO
                                                )
import           Control.Monad.Trans.Reader     ( ReaderT(..) )

{-
    If you run into errors, use the following combinator to get Megaparsec to 
    print out its state.

    > import qualified Text.Megaparsec.Debug
    > 
    > dbg :: Show a => String -> P a -> P a
    > dbg txt (P (ReaderT r)) = P . ReaderT $ \src ->
    >     Text.Megaparsec.Debug.dbg txt $ r src
-}

-------------------------------------------------------------------------------
-- | Parses a Prosidy 'Document' from its source.
--
-- The 'FilePath' parameter is only used for error reporting.
parseDocument :: FilePath -> Text -> Either Failure Document
parseDocument :: FilePath -> Text -> Either Failure Document
parseDocument path :: FilePath
path = P Document -> Source -> Either Failure Document
forall a. P a -> Source -> Either Failure a
runP P Document
doc (Source -> Either Failure Document)
-> (Text -> Source) -> Text -> Either Failure Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text -> Source
makeSource FilePath
path

-- | Reads a Prosidy 'Document' from the given 'FilePath'.
--
-- Errors will be thrown as exceptions. Use 'parseDocument' for a pure
-- implementation.
readDocument :: FilePath -> IO Document
readDocument :: FilePath -> IO Document
readDocument filepath :: FilePath
filepath = do
    ByteString
bytes <- FilePath -> IO ByteString
ByteString.readFile FilePath
filepath
    (Failure -> IO Document)
-> (Document -> IO Document)
-> Either Failure Document
-> IO Document
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Failure -> IO Document
forall e a. Exception e => e -> IO a
throwIO Document -> IO Document
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Failure Document -> IO Document)
-> (Text -> Either Failure Document) -> Text -> IO Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text -> Either Failure Document
parseDocument FilePath
filepath (Text -> IO Document) -> Text -> IO Document
forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
Text.Encoding.decodeUtf8With
        (\_ _ -> Char -> Maybe Char
forall a. a -> Maybe a
Just '\65533')
        ByteString
bytes

-------------------------------------------------------------------------------
-- | Parses a Prosidy document's header 'Metadata' from source, stopping when the
-- header ends.
--
-- The 'FilePath' parameter is only used for error reporting.
parseDocumentMetadata :: FilePath -> Text -> Either Failure Metadata
parseDocumentMetadata :: FilePath -> Text -> Either Failure Metadata
parseDocumentMetadata path :: FilePath
path = P Metadata -> Source -> Either Failure Metadata
forall a. P a -> Source -> Either Failure a
runP P Metadata
docMetadata (Source -> Either Failure Metadata)
-> (Text -> Source) -> Text -> Either Failure Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text -> Source
makeSource FilePath
path

-- | Reads a Prosidy document's 'Metadata' header from the given 'FilePath'.
--
-- Errors will be thrown as exceptions. Use 'parseDocumentMetadata' for a pure
-- implementation.
readDocumentMetadata :: FilePath -> IO Metadata
readDocumentMetadata :: FilePath -> IO Metadata
readDocumentMetadata filepath :: FilePath
filepath = do
    ByteString
bytes <- FilePath -> IO ByteString
ByteString.readFile FilePath
filepath
    (Failure -> IO Metadata)
-> (Metadata -> IO Metadata)
-> Either Failure Metadata
-> IO Metadata
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Failure -> IO Metadata
forall e a. Exception e => e -> IO a
throwIO Metadata -> IO Metadata
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Either Failure Metadata -> IO Metadata)
-> (Text -> Either Failure Metadata) -> Text -> IO Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text -> Either Failure Metadata
parseDocumentMetadata FilePath
filepath
        (Text -> IO Metadata) -> Text -> IO Metadata
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Text.Encoding.decodeUtf8 ByteString
bytes

-------------------------------------------------------------------------------
-- | A parsing error.
--
newtype Failure = Failure (ParseErrorBundle Text Void)
  deriving newtype (Show Failure
Typeable Failure
(Typeable Failure, Show Failure) =>
(Failure -> SomeException)
-> (SomeException -> Maybe Failure)
-> (Failure -> FilePath)
-> Exception Failure
SomeException -> Maybe Failure
Failure -> FilePath
Failure -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> FilePath) -> Exception e
displayException :: Failure -> FilePath
$cdisplayException :: Failure -> FilePath
fromException :: SomeException -> Maybe Failure
$cfromException :: SomeException -> Maybe Failure
toException :: Failure -> SomeException
$ctoException :: Failure -> SomeException
$cp2Exception :: Show Failure
$cp1Exception :: Typeable Failure
Exception, Int -> Failure -> ShowS
[Failure] -> ShowS
Failure -> FilePath
(Int -> Failure -> ShowS)
-> (Failure -> FilePath) -> ([Failure] -> ShowS) -> Show Failure
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Failure] -> ShowS
$cshowList :: [Failure] -> ShowS
show :: Failure -> FilePath
$cshow :: Failure -> FilePath
showsPrec :: Int -> Failure -> ShowS
$cshowsPrec :: Int -> Failure -> ShowS
Show)

-- | Pretty-print a 'Failure' into a message acceptable for displaying to
-- users.
prettyFailure :: Failure -> String
prettyFailure :: Failure -> FilePath
prettyFailure (Failure e :: ParseErrorBundle Text Void
e) = ParseErrorBundle Text Void -> FilePath
forall s e.
(Stream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty ParseErrorBundle Text Void
e

-------------------------------------------------------------------------------
newtype P a = P (ReaderT Source (Parsec Void Text) a)
  deriving newtype (a -> P b -> P a
(a -> b) -> P a -> P b
(forall a b. (a -> b) -> P a -> P b)
-> (forall a b. a -> P b -> P a) -> Functor P
forall a b. a -> P b -> P a
forall a b. (a -> b) -> P a -> P b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> P b -> P a
$c<$ :: forall a b. a -> P b -> P a
fmap :: (a -> b) -> P a -> P b
$cfmap :: forall a b. (a -> b) -> P a -> P b
Functor, Functor P
a -> P a
Functor P =>
(forall a. a -> P a)
-> (forall a b. P (a -> b) -> P a -> P b)
-> (forall a b c. (a -> b -> c) -> P a -> P b -> P c)
-> (forall a b. P a -> P b -> P b)
-> (forall a b. P a -> P b -> P a)
-> Applicative P
P a -> P b -> P b
P a -> P b -> P a
P (a -> b) -> P a -> P b
(a -> b -> c) -> P a -> P b -> P c
forall a. a -> P a
forall a b. P a -> P b -> P a
forall a b. P a -> P b -> P b
forall a b. P (a -> b) -> P a -> P b
forall a b c. (a -> b -> c) -> P a -> P b -> P c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: P a -> P b -> P a
$c<* :: forall a b. P a -> P b -> P a
*> :: P a -> P b -> P b
$c*> :: forall a b. P a -> P b -> P b
liftA2 :: (a -> b -> c) -> P a -> P b -> P c
$cliftA2 :: forall a b c. (a -> b -> c) -> P a -> P b -> P c
<*> :: P (a -> b) -> P a -> P b
$c<*> :: forall a b. P (a -> b) -> P a -> P b
pure :: a -> P a
$cpure :: forall a. a -> P a
$cp1Applicative :: Functor P
Applicative, Applicative P
P a
Applicative P =>
(forall a. P a)
-> (forall a. P a -> P a -> P a)
-> (forall a. P a -> P [a])
-> (forall a. P a -> P [a])
-> Alternative P
P a -> P a -> P a
P a -> P [a]
P a -> P [a]
forall a. P a
forall a. P a -> P [a]
forall a. P a -> P a -> P a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: P a -> P [a]
$cmany :: forall a. P a -> P [a]
some :: P a -> P [a]
$csome :: forall a. P a -> P [a]
<|> :: P a -> P a -> P a
$c<|> :: forall a. P a -> P a -> P a
empty :: P a
$cempty :: forall a. P a
$cp1Alternative :: Applicative P
Alternative, Applicative P
a -> P a
Applicative P =>
(forall a b. P a -> (a -> P b) -> P b)
-> (forall a b. P a -> P b -> P b)
-> (forall a. a -> P a)
-> Monad P
P a -> (a -> P b) -> P b
P a -> P b -> P b
forall a. a -> P a
forall a b. P a -> P b -> P b
forall a b. P a -> (a -> P b) -> P b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> P a
$creturn :: forall a. a -> P a
>> :: P a -> P b -> P b
$c>> :: forall a b. P a -> P b -> P b
>>= :: P a -> (a -> P b) -> P b
$c>>= :: forall a b. P a -> (a -> P b) -> P b
$cp1Monad :: Applicative P
Monad, Monad P
Monad P => (forall a. FilePath -> P a) -> MonadFail P
FilePath -> P a
forall a. FilePath -> P a
forall (m :: * -> *).
Monad m =>
(forall a. FilePath -> m a) -> MonadFail m
fail :: FilePath -> P a
$cfail :: forall a. FilePath -> P a
$cp1MonadFail :: Monad P
MonadFail, Monad P
Alternative P
P a
(Alternative P, Monad P) =>
(forall a. P a) -> (forall a. P a -> P a -> P a) -> MonadPlus P
P a -> P a -> P a
forall a. P a
forall a. P a -> P a -> P a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
mplus :: P a -> P a -> P a
$cmplus :: forall a. P a -> P a -> P a
mzero :: P a
$cmzero :: forall a. P a
$cp2MonadPlus :: Monad P
$cp1MonadPlus :: Alternative P
MonadPlus, MonadParsec Void Text)

type MetadataItem = (Key, Maybe Text)

runP :: P a -> Source -> Either Failure a
runP :: P a -> Source -> Either Failure a
runP (P (ReaderT r :: Source -> Parsec Void Text a
r)) src :: Source
src =
    (ParseErrorBundle Text Void -> Failure)
-> Either (ParseErrorBundle Text Void) a -> Either Failure a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle Text Void -> Failure
Failure (Either (ParseErrorBundle Text Void) a -> Either Failure a)
-> Either (ParseErrorBundle Text Void) a -> Either Failure a
forall a b. (a -> b) -> a -> b
$ Parsec Void Text a
-> FilePath -> Text -> Either (ParseErrorBundle Text Void) a
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
parse (Source -> Parsec Void Text a
r Source
src) (Source -> FilePath
sourceName Source
src) (Source -> Text
sourceText Source
src)

-------------------------------------------------------------------------------
doc :: P Document
doc :: P Document
doc = do
    Metadata
header <- P Metadata
docMetadata
    Series Block
body   <- Seq Block -> Series Block
forall a. Seq a -> Series a
Series (Seq Block -> Series Block)
-> ([Block] -> Seq Block) -> [Block] -> Series Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Seq Block
forall a. [a] -> Seq a
Seq.fromList ([Block] -> Series Block) -> P [Block] -> P (Series Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Block -> P [Block]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many P Block
block
    P ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
    pure $ Metadata -> Series Block -> Document
Document Metadata
header Series Block
body

-------------------------------------------------------------------------------
docMetadata :: P Metadata
docMetadata :: P Metadata
docMetadata = do
    -- try to read a shebang as the _very_ first line of a document.
    P () -> P ()
forall a. P a -> P ()
optional_ (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> P (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string "#!" P Text -> P () -> P ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Char -> P () -> P ()
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m end
skipManyTill P Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (P () -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void P ()
newlineOrEOF)
    -- skip past any blank lines at the start of the document
    P ()
skipSpaces P () -> P () -> P ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P () -> P ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany P ()
endOfLine
    -- read each metadata item as a line-wide token
    [MetadataItem]
items <- P MetadataItem -> P [MetadataItem]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many P MetadataItem
docMetadataItem
    -- stop when we hit three dashes, alone, on a line
    P ()
docMetadataEnd
    pure $ (MetadataItem -> Metadata) -> [MetadataItem] -> Metadata
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap MetadataItem -> Metadata
itemToMetadata [MetadataItem]
items

docMetadataEnd :: P ()
docMetadataEnd :: P ()
docMetadataEnd = do
    P Text -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P Text -> P ()) -> P Text -> P ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> P (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string "---"
    P () -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ do
        P ()
skipSpaces
        P ()
newlineOrEOF
        P ()
skipSpaces
    P () -> P ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany P ()
endOfLine

docMetadataItem :: P MetadataItem
docMetadataItem :: P MetadataItem
docMetadataItem = do
    Key
itemKey <- P Key
key
    Maybe Text
itemVal <- P Text -> P (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (P Text -> P (Maybe Text)) -> P Text -> P (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
        P ()
metaItemSep
        Text -> P Text -> P Text
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option "" P Text
text P Text -> P () -> P Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
skipSpaces
    P ()
endOfLines
    pure (Key
itemKey, Maybe Text
itemVal)

-------------------------------------------------------------------------------
block :: P Block
block :: P Block
block = [P Block] -> P Block
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ BlockTag -> Block
BlockTag (BlockTag -> Block) -> P BlockTag -> P Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P BlockTag
blockTag
    , LiteralTag -> Block
BlockLiteral (LiteralTag -> Block) -> P LiteralTag -> P Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P LiteralTag
literalTag
    , Paragraph -> Block
BlockParagraph (Paragraph -> Block) -> P Paragraph -> P Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Paragraph
paragraph
    ]

blockTag :: P BlockTag
blockTag :: P BlockTag
blockTag = do
    BlockTag
t <- P () -> P (Series Block) -> P BlockTag
forall a. P () -> P a -> P (Tag a)
genericTag (P Text -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P Text -> P ()) -> P Text -> P ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> P (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string "#-") P (Series Block)
blockTagContents
    P ()
emptyLines
    pure BlockTag
t

blockTagContents :: P (Series Block)
blockTagContents :: P (Series Block)
blockTagContents = [P (Series Block)] -> P (Series Block)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [P (Series Block)
ifBraces, P (Series Block)
ifBlock, P (Series Block)
ifNothing]
  where
    ifBraces :: P (Series Block)
ifBraces = P (Maybe Location -> Series Block) -> P (Series Block)
forall a. P (Maybe Location -> a) -> P a
annotateSource (P (Maybe Location -> Series Block) -> P (Series Block))
-> P (Maybe Location -> Series Block) -> P (Series Block)
forall a b. (a -> b) -> a -> b
$ (Maybe (SeriesNE Inline) -> Maybe Location -> Series Block)
-> P (Maybe (SeriesNE Inline))
-> P (Maybe Location -> Series Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ((SeriesNE Inline -> Maybe Location -> Series Block)
-> Maybe (SeriesNE Inline) -> Maybe Location -> Series Block
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((SeriesNE Inline -> Maybe Location -> Series Block)
 -> Maybe (SeriesNE Inline) -> Maybe Location -> Series Block)
-> (SeriesNE Inline -> Maybe Location -> Series Block)
-> Maybe (SeriesNE Inline)
-> Maybe Location
-> Series Block
forall a b. (a -> b) -> a -> b
$ \x :: SeriesNE Inline
x src :: Maybe Location
src ->
            Seq Block -> Series Block
forall a. Seq a -> Series a
Series (Seq Block -> Series Block)
-> (Paragraph -> Seq Block) -> Paragraph -> Series Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Seq Block
forall a. a -> Seq a
Seq.singleton (Block -> Seq Block)
-> (Paragraph -> Block) -> Paragraph -> Seq Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Paragraph -> Block
BlockParagraph (Paragraph -> Series Block) -> Paragraph -> Series Block
forall a b. (a -> b) -> a -> b
$ SeriesNE Inline -> Maybe Location -> Paragraph
Paragraph SeriesNE Inline
x Maybe Location
src
        )
        (P (Maybe (SeriesNE Inline)) -> P (Maybe (SeriesNE Inline))
forall a. P a -> P a
token P (Maybe (SeriesNE Inline))
tagParagraph)
    ifBlock :: P (Series Block)
ifBlock = Seq Block -> Series Block
forall a. Seq a -> Series a
Series (Seq Block -> Series Block)
-> ([Block] -> Seq Block) -> [Block] -> Series Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Seq Block
forall a. [a] -> Seq a
Seq.fromList ([Block] -> Series Block) -> P [Block] -> P (Series Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P [Block] -> P [Block]
forall a. P a -> P a
withBlockDelimiters
        (P ()
emptyLines P () -> P [Block] -> P [Block]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Block -> P [Block]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many P Block
block)
    ifNothing :: P (Series Block)
ifNothing = P ()
skipSpaces P () -> P () -> P ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
endOfLine P () -> Series Block -> P (Series Block)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Series Block
forall a. Monoid a => a
mempty

literalTag :: P LiteralTag
literalTag :: P LiteralTag
literalTag = P () -> P Text -> P LiteralTag
forall a. P () -> P a -> P (Tag a)
genericTag (P Text -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P Text -> P ()) -> P Text -> P ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> P (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string "#=") (P Text -> P LiteralTag) -> P Text -> P LiteralTag
forall a b. (a -> b) -> a -> b
$ do
    P ()
close <- P () -> P (P ())
blockTagDelim (P () -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ P () -> P ()
forall a. P a -> P ()
optional_ P ()
comment P () -> P () -> P ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
newlineOrEOF)
    P () -> P Text
literalBody P ()
close

literalBody :: P () -> P Text
literalBody :: P () -> P Text
literalBody end :: P ()
end = do
    [Text]
literalLines <- P Text -> P () -> P [Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill P Text
literalLine (P () -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ P ()
skipSpaces P () -> P () -> P ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
end)
    P ()
emptyLines
    pure $ Text -> Text
Text.Lazy.toStrict (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.Lazy.intercalate "\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
literalLines

literalLine :: P Text.Lazy.Text
literalLine :: P Text
literalLine = do
    Text
line <- Maybe FilePath -> (Token Text -> Bool) -> P (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe FilePath -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "literal text") ((Token Text -> Bool) -> P Text) -> (Token Text -> Bool) -> P Text
forall a b. (a -> b) -> a -> b
$ \ch :: Token Text
ch -> Char
Token Text
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\r' Bool -> Bool -> Bool
&& Char
Token Text
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n'
    P ()
newlineOrEOF
    pure $ Text -> Text
Text.Lazy.fromStrict Text
line

blockTagDelim :: P () -> P (P ())
blockTagDelim :: P () -> P (P ())
blockTagDelim slurp :: P ()
slurp = do
    Token Text -> P (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
':'
    Maybe Text
maybeLabel <- P Text -> P (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional P Text
keyLike
    P ()
skipSpaces P () -> P () -> P ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
slurp
    pure $ do
        Tokens Text -> P (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string "#:"
        (Text -> P Text) -> Maybe Text -> P ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Text -> P Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Maybe Text
maybeLabel
        P ()
skipSpaces

withBlockDelimiters :: P a -> P a
withBlockDelimiters :: P a -> P a
withBlockDelimiters parser :: P a
parser = do
    P ()
close <- P () -> P (P ())
blockTagDelim P ()
endOfLine
    P a
parser P a -> P () -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
close

-------------------------------------------------------------------------------
inline :: P Inline
inline :: P Inline
inline = [P Inline] -> P Inline
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [InlineTag -> Inline
InlineTag (InlineTag -> Inline) -> P InlineTag -> P Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P InlineTag
inlineTag, Fragment -> Inline
InlineText (Fragment -> Inline) -> P Fragment -> P Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Fragment
fragment]

inlineTag :: P InlineTag
inlineTag :: P InlineTag
inlineTag = P () -> P (Series Inline) -> P InlineTag
forall a. P () -> P a -> P (Tag a)
genericTag P ()
sigil (P (Series Inline) -> P InlineTag)
-> (P (Series Inline) -> P (Series Inline))
-> P (Series Inline)
-> P InlineTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Series Inline -> P (Series Inline) -> P (Series Inline)
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Series Inline
forall a. Monoid a => a
mempty (P (Series Inline) -> P InlineTag)
-> P (Series Inline) -> P InlineTag
forall a b. (a -> b) -> a -> b
$ P (Maybe (SeriesNE Inline)) -> P (Series Inline)
forall a. P (Maybe (SeriesNE a)) -> P (Series a)
orEmpty P (Maybe (SeriesNE Inline))
tagParagraph
  where
    orEmpty :: P (Maybe (SeriesNE a)) -> P (Series a)
orEmpty = (Maybe (SeriesNE a) -> Series a)
-> P (Maybe (SeriesNE a)) -> P (Series a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe (SeriesNE a) -> Series a)
 -> P (Maybe (SeriesNE a)) -> P (Series a))
-> (Maybe (SeriesNE a) -> Series a)
-> P (Maybe (SeriesNE a))
-> P (Series a)
forall a b. (a -> b) -> a -> b
$ Series a
-> (SeriesNE a -> Series a) -> Maybe (SeriesNE a) -> Series a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Series a
forall a. Monoid a => a
mempty (Seq a -> Series a
forall a. Seq a -> Series a
fromSeq (Seq a -> Series a)
-> (SeriesNE a -> Seq a) -> SeriesNE a -> Series a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeriesNE a -> Seq a
forall a. SeriesNE a -> Seq a
toSeqNE)
    sigil :: P ()
sigil   = P () -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ do
        P Char -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P Char -> P ()) -> P Char -> P ()
forall a b. (a -> b) -> a -> b
$ Token Text -> P (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'#'
        P Char -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P Char -> P ()) -> (P Char -> P Char) -> P Char -> P ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P Char -> P Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (P Char -> P ()) -> P Char -> P ()
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool) -> P (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isValidKeyHead

-------------------------------------------------------------------------------
paragraph :: P Paragraph
paragraph :: P Paragraph
paragraph = P (Maybe Location -> Paragraph) -> P Paragraph
forall a. P (Maybe Location -> a) -> P a
annotateSource (P (Maybe Location -> Paragraph) -> P Paragraph)
-> P (Maybe Location -> Paragraph) -> P Paragraph
forall a b. (a -> b) -> a -> b
$ P (Maybe (SeriesNE Inline))
paragraphLike P (Maybe (SeriesNE Inline))
-> (Maybe (SeriesNE Inline) -> P (Maybe Location -> Paragraph))
-> P (Maybe Location -> Paragraph)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= P (Maybe Location -> Paragraph)
-> (SeriesNE Inline -> P (Maybe Location -> Paragraph))
-> Maybe (SeriesNE Inline)
-> P (Maybe Location -> Paragraph)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (FilePath -> P (Maybe Location -> Paragraph)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail "empty paragraph encountered")
    ((Maybe Location -> Paragraph) -> P (Maybe Location -> Paragraph)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe Location -> Paragraph) -> P (Maybe Location -> Paragraph))
-> (SeriesNE Inline -> Maybe Location -> Paragraph)
-> SeriesNE Inline
-> P (Maybe Location -> Paragraph)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeriesNE Inline -> Maybe Location -> Paragraph
Paragraph)

paragraphLike :: P (Maybe (SeriesNE Inline))
paragraphLike :: P (Maybe (SeriesNE Inline))
paragraphLike = do
    [[Inline]]
ppLines <- P [Inline]
paragraphLine P [Inline] -> P () -> P [[Inline]]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepEndBy1` P ()
endOfLine
    P ()
emptyLines
    Maybe (SeriesNE Inline) -> P (Maybe (SeriesNE Inline))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (SeriesNE Inline) -> P (Maybe (SeriesNE Inline)))
-> ([Inline] -> Maybe (SeriesNE Inline))
-> [Inline]
-> P (Maybe (SeriesNE Inline))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Inline -> Maybe (SeriesNE Inline)
forall a. Seq a -> Maybe (SeriesNE a)
fromSeqNE (Seq Inline -> Maybe (SeriesNE Inline))
-> ([Inline] -> Seq Inline) -> [Inline] -> Maybe (SeriesNE Inline)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Seq Inline
forall a. [a] -> Seq a
Seq.fromList ([Inline] -> P (Maybe (SeriesNE Inline)))
-> [Inline] -> P (Maybe (SeriesNE Inline))
forall a b. (a -> b) -> a -> b
$ [Inline] -> [[Inline]] -> [Inline]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Inline
Break] [[Inline]]
ppLines

paragraphLine :: P [Inline]
paragraphLine :: P [Inline]
paragraphLine = do
    Inline
headItem <- P Inline
inline
    [Inline]
tailItem <- P Inline -> P [Inline]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many P Inline
paragraphInline
    P ()
skipSpaces
    pure $ Inline
headItem Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
tailItem

paragraphInline :: P Inline
paragraphInline :: P Inline
paragraphInline = (P ()
paragraphSpacer P () -> Inline -> P Inline
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Inline
Break) P Inline -> P Inline -> P Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P Inline
inline

paragraphSpacer :: P ()
paragraphSpacer :: P ()
paragraphSpacer = P () -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ do
    P ()
skipSpaces1
    P () -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ P Text -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens Text -> P (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string "##") P () -> P () -> P ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P ()
newlineOrEOF

tagParagraph :: P (Maybe (SeriesNE Inline))
tagParagraph :: P (Maybe (SeriesNE Inline))
tagParagraph = P ()
-> P Char
-> P (Maybe (SeriesNE Inline))
-> P (Maybe (SeriesNE Inline))
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between P ()
start P Char
end (P (Maybe (SeriesNE Inline)) -> P (Maybe (SeriesNE Inline)))
-> P (Maybe (SeriesNE Inline)) -> P (Maybe (SeriesNE Inline))
forall a b. (a -> b) -> a -> b
$ Maybe (SeriesNE Inline)
-> P (Maybe (SeriesNE Inline)) -> P (Maybe (SeriesNE Inline))
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Maybe (SeriesNE Inline)
forall a. Maybe a
Nothing P (Maybe (SeriesNE Inline))
paragraphLike
  where
    start :: P ()
start = Token Text -> P (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'{' P Char -> P () -> P ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
skipSpaces P () -> P () -> P ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
emptyLines
    end :: P Char
end   = P ()
skipSpaces P () -> P () -> P ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
emptyLines P () -> P Char -> P Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Token Text -> P (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'}'

-------------------------------------------------------------------------------
genericTag :: P () -> P a -> P (Tag a)
genericTag :: P () -> P a -> P (Tag a)
genericTag sigilParser :: P ()
sigilParser bodyParser :: P a
bodyParser = P (Maybe Location -> Tag a) -> P (Tag a)
forall a. P (Maybe Location -> a) -> P a
annotateSource (P (Maybe Location -> Tag a) -> P (Tag a))
-> P (Maybe Location -> Tag a) -> P (Tag a)
forall a b. (a -> b) -> a -> b
$ do
    P ()
sigilParser
    Key
thisName     <- Text -> Key
unsafeMakeKey (Text -> Key) -> P Text -> P Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Text
keyLike
    Metadata
thisMetadata <- P Metadata
meta
    a
thisContent  <- P a
bodyParser
    pure $ Key -> Metadata -> a -> Maybe Location -> Tag a
forall a. Key -> Metadata -> a -> Maybe Location -> Tag a
Tag Key
thisName Metadata
thisMetadata a
thisContent

meta :: P Metadata
meta :: P Metadata
meta =
    Metadata -> P Metadata -> P Metadata
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Metadata
forall a. Monoid a => a
mempty
        (P Metadata -> P Metadata) -> P Metadata -> P Metadata
forall a b. (a -> b) -> a -> b
$          P () -> P (Token Text) -> P Metadata -> P Metadata
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between P ()
start P (Token Text)
end
        (P Metadata -> P Metadata) -> P Metadata -> P Metadata
forall a b. (a -> b) -> a -> b
$          (MetadataItem -> Metadata) -> [MetadataItem] -> Metadata
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap MetadataItem -> Metadata
itemToMetadata
        ([MetadataItem] -> Metadata) -> P [MetadataItem] -> P Metadata
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>        P MetadataItem
metaItem
        P MetadataItem -> P () -> P [MetadataItem]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepEndBy` P ()
metaSep
  where
    start :: P ()
start = do
        Token Text -> P (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'['
        P ()
skipSpaces
        P () -> P ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany P ()
endOfLine
    end :: P (Token Text)
end = Token Text -> P (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
']'

metaItem :: P MetadataItem
metaItem :: P MetadataItem
metaItem = do
    Key
itemKey <- P Key
key P Key -> P () -> P Key
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
emptyLines
    Maybe Text
itemVal <- P Text -> P (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (P Text -> P (Maybe Text)) -> P Text -> P (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
        P ()
metaItemSep P () -> P () -> P ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
emptyLines
        Text -> P Text -> P Text
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option "" P Text
quotedText
    P ()
skipSpaces P () -> P () -> P ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
emptyLines
    pure (Key
itemKey, Maybe Text
itemVal)

metaSep :: P ()
metaSep :: P ()
metaSep = do
    P Char -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P Char -> P ()) -> P Char -> P ()
forall a b. (a -> b) -> a -> b
$ Token Text -> P (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
','
    P ()
skipSpaces
    P ()
emptyLines

-------------------------------------------------------------------------------
escape :: P Char
escape :: P Char
escape = FilePath -> P Char -> P Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
FilePath -> m a -> m a
label "escape sequence" (P Char -> P Char) -> P Char -> P Char
forall a b. (a -> b) -> a -> b
$ do
    P Char -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P Char -> P ()) -> P Char -> P ()
forall a b. (a -> b) -> a -> b
$ Token Text -> P (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'\\'
    [P Char] -> P Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ [Token Text] -> P (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf @[] "#{}[]:='\"\\"
        , Token Text -> P (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'n' P Char -> Char -> P Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> '\n'
        , Token Text -> P (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
't' P Char -> Char -> P Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> '\t'
        , Token Text -> P (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'r' P Char -> Char -> P Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> '\r'
        , Token Text -> P (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'u' P Char -> P Char -> P Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Char
unicodeEscape
        ]

unicodeEscape :: P Char
unicodeEscape :: P Char
unicodeEscape = Int -> Char
Char.chr (Int -> Char) -> P Int -> P Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
hexadecimal

keyLike :: P Text
keyLike :: P Text
keyLike = do
    P Char -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P Char -> P ()) -> (P Char -> P Char) -> P Char -> P ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P Char -> P Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (P Char -> P ()) -> P Char -> P ()
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool) -> P (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isValidKeyHead
    Maybe FilePath -> (Token Text -> Bool) -> P (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe FilePath -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "key") Char -> Bool
Token Text -> Bool
isValidKeyTail

key :: P Key
key :: P Key
key = P Key -> P Key
forall a. P a -> P a
token (P Key -> P Key) -> P Key -> P Key
forall a b. (a -> b) -> a -> b
$ Text -> Key
unsafeMakeKey (Text -> Key) -> P Text -> P Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Text
keyLike

metaItemSep :: P ()
metaItemSep :: P ()
metaItemSep = P () -> P ()
forall a. P a -> P a
token (P () -> P ()) -> (P Char -> P ()) -> P Char -> P ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P Char -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P Char -> P ()) -> P Char -> P ()
forall a b. (a -> b) -> a -> b
$ Token Text -> P (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
':' P Char -> P Char -> P Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> P (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'='

quotedText :: P Text
quotedText :: P Text
quotedText = do
    Char
delim <- Token Text -> P (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'\'' P Char -> P Char -> P Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> P (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'"'
    [Text]
parts <- P Text -> P [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (P Text -> P [Text]) -> P Text -> P [Text]
forall a b. (a -> b) -> a -> b
$ [P Text] -> P Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Char -> Text
Text.Lazy.singleton (Char -> Text) -> P Char -> P Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Char
escape
        , Text -> Text
Text.Lazy.fromStrict (Text -> Text) -> P Text -> P Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath -> (Token Text -> Bool) -> P (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe FilePath -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P
            (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "quoted text")
            (\ch :: Token Text
ch -> Char
Token Text
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
delim Bool -> Bool -> Bool
&& Char
Token Text
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\\')
        ]
    P Char -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P Char -> P ()) -> P Char -> P ()
forall a b. (a -> b) -> a -> b
$ Token Text -> P (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
delim
    P ()
skipSpaces
    Text -> P Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> P Text) -> ([Text] -> Text) -> [Text] -> P Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.Lazy.toStrict (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Text] -> P Text) -> [Text] -> P Text
forall a b. (a -> b) -> a -> b
$ [Text]
parts

fragment :: P Fragment
fragment :: P Fragment
fragment = P (Maybe Location -> Fragment) -> P Fragment
forall a. P (Maybe Location -> a) -> P a
annotateSource (P (Maybe Location -> Fragment) -> P Fragment)
-> P (Maybe Location -> Fragment) -> P Fragment
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Location -> Fragment
Fragment (Text -> Maybe Location -> Fragment)
-> P Text -> P (Maybe Location -> Fragment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Text
text

text :: P Text
text :: P Text
text = do
    [Text]
parts <- P Text
word P Text -> P () -> P [Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy1` P ()
textSpace
    Text -> P Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> P Text) -> ([Text] -> Text) -> [Text] -> P Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.Lazy.toStrict (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.Lazy.intercalate " " ([Text] -> P Text) -> [Text] -> P Text
forall a b. (a -> b) -> a -> b
$ [Text]
parts

textSpace :: P ()
textSpace :: P ()
textSpace = P () -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ do
    P ()
skipSpaces1
    P () -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ P Char -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text -> P (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'#') P () -> P () -> P ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P ()
newlineOrEOF

word :: P Text.Lazy.Text
word :: P Text
word = ([Text] -> Text) -> P [Text] -> P Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (P [Text] -> P Text) -> (P Text -> P [Text]) -> P Text -> P Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P Text -> P [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (P Text -> P Text) -> P Text -> P Text
forall a b. (a -> b) -> a -> b
$ [P Text] -> P Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Char -> Text
Text.Lazy.singleton (Char -> Text) -> P Char -> P Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Char
escape
    , Text -> Text
Text.Lazy.fromStrict (Text -> Text) -> P Text -> P Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath -> (Token Text -> Bool) -> P (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe FilePath -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P
        (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "plain text")
        (\ch :: Token Text
ch -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> HashSet Char -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Char
Token Text
ch HashSet Char
reserved Bool -> Bool -> Bool
|| Char -> Bool
Char.isSpace Char
Token Text
ch)
    ]
    where reserved :: HashSet Char
reserved = FilePath -> HashSet Char
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList "#{}\\"

-------------------------------------------------------------------------------
comment :: P ()
comment :: P ()
comment = FilePath -> P () -> P ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
FilePath -> m a -> m a
label "comment" (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ do
    P Text -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P Text -> P ()) -> P Text -> P ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> P (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string "##"
    P () -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ P Char -> P () -> P ()
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m end
skipManyTill P Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (P () -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead P ()
newlineOrEOF)

endOfLine :: P ()
endOfLine :: P ()
endOfLine =
    -- This rule is a bit hairy! Specifically, there was a bug at the end of 
    -- a file that ended with a comment and no trailing newline.
    --
    -- Because we use `endOfLine` in repeat productions (many, some),
    -- endOfLine _has_ to consume input to prevent looping forever.
    -- In order to satisfy this:
    -- 
    -- 1. If its the end of a file, then we _must_ consume a comment.
    -- 2. If it's not the end of a file, then we _must_ consume at least 
    --    one newline.
            P ()
commentThenNewline P () -> P () -> P ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P ()
commentThenEOF
  where
    commentThenEOF :: P ()
commentThenEOF     = P ()
comment P () -> P () -> P ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
    commentThenNewline :: P ()
commentThenNewline = P () -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ do
        P () -> P ()
forall a. P a -> P ()
optional_ P ()
comment
        P Char -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void P Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
Megaparsec.newline
        P ()
skipSpaces

endOfLines :: P ()
endOfLines :: P ()
endOfLines = P () -> P ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome P ()
endOfLine

emptyLines :: P ()
emptyLines :: P ()
emptyLines = P () -> P ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany P ()
endOfLine

spaceChar :: P ()
spaceChar :: P ()
spaceChar = do
    P () -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy P ()
newlineOrEOF
    P Char -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void P Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
Megaparsec.spaceChar

skipSpaces :: P ()
skipSpaces :: P ()
skipSpaces = P () -> P ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany P ()
spaceChar

skipSpaces1 :: P ()
skipSpaces1 :: P ()
skipSpaces1 = P () -> P ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome P ()
spaceChar

token :: P a -> P a
token :: P a -> P a
token = (P a -> P () -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
skipSpaces)

newlineOrEOF :: P ()
newlineOrEOF :: P ()
newlineOrEOF = P Char -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void P Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
Megaparsec.newline P () -> P () -> P ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

-------------------------------------------------------------------------------
optional_ :: P a -> P ()
optional_ :: P a -> P ()
optional_ = () -> P () -> P ()
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option () (P () -> P ()) -> (P a -> P ()) -> P a -> P ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P a -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void

-------------------------------------------------------------------------------
itemToMetadata :: MetadataItem -> Metadata
itemToMetadata :: MetadataItem -> Metadata
itemToMetadata (k :: Key
k, Just v :: Text
v ) = Set Key -> Assoc Key Text -> Metadata
Metadata Set Key
forall a. Monoid a => a
mempty (HashMap Key Text -> Assoc Key Text
forall k v. HashMap k v -> Assoc k v
Assoc (HashMap Key Text -> Assoc Key Text)
-> HashMap Key Text -> Assoc Key Text
forall a b. (a -> b) -> a -> b
$ Key -> Text -> HashMap Key Text
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Key
k Text
v)
itemToMetadata (k :: Key
k, Nothing) = Set Key -> Assoc Key Text -> Metadata
Metadata (HashSet Key -> Set Key
forall a. HashSet a -> Set a
Set (HashSet Key -> Set Key) -> HashSet Key -> Set Key
forall a b. (a -> b) -> a -> b
$ Key -> HashSet Key
forall a. Hashable a => a -> HashSet a
HashSet.singleton Key
k) Assoc Key Text
forall a. Monoid a => a
mempty

annotateSource :: P (Maybe Location -> a) -> P a
annotateSource :: P (Maybe Location -> a) -> P a
annotateSource (P (ReaderT r :: Source -> Parsec Void Text (Maybe Location -> a)
r)) = ReaderT Source (Parsec Void Text) a -> P a
forall a. ReaderT Source (Parsec Void Text) a -> P a
P (ReaderT Source (Parsec Void Text) a -> P a)
-> ((Source -> Parsec Void Text a)
    -> ReaderT Source (Parsec Void Text) a)
-> (Source -> Parsec Void Text a)
-> P a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Source -> Parsec Void Text a)
-> ReaderT Source (Parsec Void Text) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Source -> Parsec Void Text a) -> P a)
-> (Source -> Parsec Void Text a) -> P a
forall a b. (a -> b) -> a -> b
$ \src :: Source
src -> do
    Offset
offset    <- Word -> Offset
Offset (Word -> Offset) -> (Int -> Word) -> Int -> Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Offset)
-> ParsecT Void Text Identity Int
-> ParsecT Void Text Identity Offset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    Maybe Location -> a
result    <- Source -> Parsec Void Text (Maybe Location -> a)
r Source
src
    Location
sourceLoc <- ParsecT Void Text Identity Location
-> (Location -> ParsecT Void Text Identity Location)
-> Maybe Location
-> ParsecT Void Text Identity Location
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> ParsecT Void Text Identity Location
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
sourceLocationError) Location -> ParsecT Void Text Identity Location
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Location -> ParsecT Void Text Identity Location)
-> Maybe Location -> ParsecT Void Text Identity Location
forall a b. (a -> b) -> a -> b
$ Offset -> Source -> Maybe Location
getLocation Offset
offset Source
src
    a -> Parsec Void Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Parsec Void Text a)
-> (Maybe Location -> a) -> Maybe Location -> Parsec Void Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Location -> a
result (Maybe Location -> Parsec Void Text a)
-> Maybe Location -> Parsec Void Text a
forall a b. (a -> b) -> a -> b
$ Location -> Maybe Location
forall a. a -> Maybe a
Just Location
sourceLoc

sourceLocationError :: String
sourceLocationError :: FilePath
sourceLocationError = "UNEXPECTED: Failed to create a source location."