{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeApplications #-}
{- |
   Module      : Text.Pandoc.Readers.Pod
   Copyright   : © 2024 Evan Silberman
   License     : GNU GPL, version 2 or above

   Maintainer  : Evan Silberman <evan@jklol.net>
   Stability   : WIP
   Portability : portable

Conversion of Pod to 'Pandoc' documents
-}
module Text.Pandoc.Readers.Pod (readPod) where

import Control.Monad (void)
import Control.Monad.Except (throwError)
import Data.Char (isAsciiUpper, digitToInt)
import Data.Default (Default)
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Parsing
import Text.Pandoc.Parsing.General (isSpaceChar)
import Text.Pandoc.XML (lookupEntity)
import Text.Pandoc.Class.PandocMonad (PandocMonad(..))
import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.Error
import Text.Pandoc.Builder (Blocks, Inlines)
import qualified Text.Pandoc.Builder as B
import qualified Data.Text as T
import qualified Data.Text.Read as TR
import Text.Pandoc.Shared (stringify, textToIdentifier, tshow)
import Data.Set (Set)
import Data.Functor (($>))
import Data.Maybe (listToMaybe, fromMaybe)
import Numeric (readOct)

data PodState = PodState
  { PodState -> [LogMessage]
logMessages :: [LogMessage]
  , PodState -> Set Text
headerIds :: Set T.Text
  , PodState -> ReaderOptions
options :: ReaderOptions
} deriving (Int -> PodState -> ShowS
[PodState] -> ShowS
PodState -> String
(Int -> PodState -> ShowS)
-> (PodState -> String) -> ([PodState] -> ShowS) -> Show PodState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PodState -> ShowS
showsPrec :: Int -> PodState -> ShowS
$cshow :: PodState -> String
show :: PodState -> String
$cshowList :: [PodState] -> ShowS
showList :: [PodState] -> ShowS
Show)

instance HasLogMessages PodState where
  addLogMessage :: LogMessage -> PodState -> PodState
addLogMessage LogMessage
msg PodState
st = PodState
st{ logMessages = msg : logMessages st }
  getLogMessages :: PodState -> [LogMessage]
getLogMessages PodState
st = [LogMessage] -> [LogMessage]
forall a. [a] -> [a]
reverse ([LogMessage] -> [LogMessage]) -> [LogMessage] -> [LogMessage]
forall a b. (a -> b) -> a -> b
$ PodState -> [LogMessage]
logMessages PodState
st

instance HasIdentifierList PodState where
  extractIdentifierList :: PodState -> Set Text
extractIdentifierList = PodState -> Set Text
headerIds
  updateIdentifierList :: (Set Text -> Set Text) -> PodState -> PodState
updateIdentifierList Set Text -> Set Text
f PodState
st = PodState
st{headerIds = f (headerIds st)}

instance HasReaderOptions PodState where
  extractReaderOptions :: PodState -> ReaderOptions
extractReaderOptions = PodState -> ReaderOptions
options

instance Default PodState where
  def :: PodState
def = PodState
    { logMessages :: [LogMessage]
logMessages = []
    , headerIds :: Set Text
headerIds = Set Text
forall a. Monoid a => a
mempty
    , options :: ReaderOptions
options = ReaderOptions
forall a. Default a => a
def
    }

data PodLinkDestination = LinkUrl Inlines T.Text
                        | LinkMan Inlines (Maybe Inlines)
                        | LinkInternal Inlines
                        deriving (Int -> PodLinkDestination -> ShowS
[PodLinkDestination] -> ShowS
PodLinkDestination -> String
(Int -> PodLinkDestination -> ShowS)
-> (PodLinkDestination -> String)
-> ([PodLinkDestination] -> ShowS)
-> Show PodLinkDestination
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PodLinkDestination -> ShowS
showsPrec :: Int -> PodLinkDestination -> ShowS
$cshow :: PodLinkDestination -> String
show :: PodLinkDestination -> String
$cshowList :: [PodLinkDestination] -> ShowS
showList :: [PodLinkDestination] -> ShowS
Show)

defaultLinkName :: PodLinkDestination -> Inlines
defaultLinkName :: PodLinkDestination -> Inlines
defaultLinkName (LinkUrl Inlines
inl Text
_) = Inlines
inl
defaultLinkName (LinkMan Inlines
nm (Just Inlines
sec)) = Inlines -> Inlines
B.doubleQuoted Inlines
sec Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" in " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
nm
defaultLinkName (LinkMan Inlines
nm Maybe Inlines
Nothing) = Inlines
nm
defaultLinkName (LinkInternal Inlines
sec) = Inlines -> Inlines
B.doubleQuoted Inlines
sec

type PodParser m = ParsecT Sources PodState m

readPod :: (PandocMonad m, ToSources a)
        => ReaderOptions
        -> a
        -> m Pandoc
readPod :: forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readPod ReaderOptions
_ a
s = do
  let sources :: Sources
sources = a -> Sources
forall a. ToSources a => a -> Sources
toSources a
s
  Either PandocError Pandoc
p <- ParsecT Sources PodState m Pandoc
-> PodState -> Sources -> m (Either PandocError Pandoc)
forall (m :: * -> *) t st a.
(Monad m, ToSources t) =>
ParsecT Sources st m a -> st -> t -> m (Either PandocError a)
readWithM ParsecT Sources PodState m Pandoc
forall (m :: * -> *). PandocMonad m => PodParser m Pandoc
parsePod PodState
forall a. Default a => a
def Sources
sources
  case Either PandocError Pandoc
p of
    Right Pandoc
result -> Pandoc -> m Pandoc
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
result
    Left PandocError
e       -> PandocError -> m Pandoc
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e

parsePod :: PandocMonad m => PodParser m Pandoc
parsePod :: forall (m :: * -> *). PandocMonad m => PodParser m Pandoc
parsePod = do
  -- We don't actually start processing Pod until we encounter a Pod command.
  -- If we never encounter a Pod command, the document is still valid Pod, it
  -- just contains no content.
  PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
notPod
  [Blocks]
bs <- PodParser m Blocks
-> ParsecT Sources PodState m ()
-> ParsecT Sources PodState m [Blocks]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
block ParsecT Sources PodState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  ParsecT Sources PodState m ()
forall (m :: * -> *) st s.
(PandocMonad m, HasLogMessages st) =>
ParsecT s st m ()
reportLogMessages
  Pandoc -> PodParser m Pandoc
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> PodParser m Pandoc) -> Pandoc -> PodParser m Pandoc
forall a b. (a -> b) -> a -> b
$ Blocks -> Pandoc
B.doc (Blocks -> Pandoc) -> Blocks -> Pandoc
forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat [Blocks]
bs

block :: PandocMonad m => PodParser m Blocks
block :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
block = PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
verbatim  PodParser m Blocks -> PodParser m Blocks -> PodParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
paragraph PodParser m Blocks -> PodParser m Blocks -> PodParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
command PodParser m Blocks -> String -> PodParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"Pod paragraph"

command :: PandocMonad m => PodParser m Blocks
command :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
command = do
    ParsecT Sources PodState m () -> ParsecT Sources PodState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'=' ParsecT Sources PodState m Char
-> ParsecT Sources PodState m () -> ParsecT Sources PodState m ()
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources PodState m String -> ParsecT Sources PodState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (String -> ParsecT Sources PodState m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"item" ParsecT Sources PodState m String
-> ParsecT Sources PodState m String
-> ParsecT Sources PodState m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Sources PodState m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"back" ParsecT Sources PodState m String
-> ParsecT Sources PodState m String
-> ParsecT Sources PodState m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Sources PodState m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"end"))
    PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
header PodParser m Blocks -> PodParser m Blocks -> PodParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
pod PodParser m Blocks -> PodParser m Blocks -> PodParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
cut PodParser m Blocks -> PodParser m Blocks -> PodParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
over PodParser m Blocks -> PodParser m Blocks -> PodParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
for PodParser m Blocks -> PodParser m Blocks -> PodParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
begin PodParser m Blocks -> PodParser m Blocks -> PodParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
encoding PodParser m Blocks -> String -> PodParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"Pod command"

cmd :: PandocMonad m => T.Text -> PodParser m ()
cmd :: forall (m :: * -> *). PandocMonad m => Text -> PodParser m ()
cmd Text
nm = do
  Text -> ParsecT Sources PodState m Text
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> ParsecT s u m Text
textStr Text
nm
  ParsecT Sources PodState m Char -> PodParser m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Sources PodState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
nonspaceChar
  ParsecT Sources PodState m String -> PodParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Sources PodState m String -> PodParser m ())
-> ParsecT Sources PodState m String -> PodParser m ()
forall a b. (a -> b) -> a -> b
$ ParsecT Sources PodState m Char
-> ParsecT Sources PodState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources PodState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar

encoding :: PandocMonad m => PodParser m Blocks
encoding :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
encoding = do
  Text -> PodParser m ()
forall (m :: * -> *). PandocMonad m => Text -> PodParser m ()
cmd Text
"encoding"
  ParsecT Sources PodState m Text
forall (m :: * -> *) st. Monad m => ParsecT Sources st m Text
anyLine
  ParsecT Sources PodState m Text -> PodParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Sources PodState m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
  LogMessage -> PodParser m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParsecT s st m ()
logMessage (LogMessage -> PodParser m ()) -> LogMessage -> PodParser m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
"=encoding; Pandoc requires UTF-8 input"
  Blocks -> PodParser m Blocks
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty

header :: PandocMonad m => PodParser m Blocks
header :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
header = do
  String -> ParsecT Sources PodState m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"head"
  Char
dig <- String -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m Char
oneOf String
"123456"
  ParsecT Sources PodState m Char -> ParsecT Sources PodState m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Sources PodState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
blankline ParsecT Sources PodState m ()
-> ParsecT Sources PodState m () -> ParsecT Sources PodState m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Char -> ParsecT Sources PodState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT Sources PodState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar
  Inlines
ins <- PodParser m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
inlines
  Attr
attrs <- Attr -> Inlines -> ParsecT Sources PodState m Attr
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st, HasLogMessages st,
 HasIdentifierList st) =>
Attr -> Inlines -> ParsecT s st m Attr
registerHeader Attr
B.nullAttr Inlines
ins
  ParsecT Sources PodState m Text -> ParsecT Sources PodState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Sources PodState m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
  Blocks -> PodParser m Blocks
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> PodParser m Blocks) -> Blocks -> PodParser m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Int -> Inlines -> Blocks
B.headerWith Attr
attrs (Char -> Int
digitToInt Char
dig) Inlines
ins

pod :: PandocMonad m => PodParser m Blocks
pod :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
pod = do
  Text -> PodParser m ()
forall (m :: * -> *). PandocMonad m => Text -> PodParser m ()
cmd Text
"pod"
  ParsecT Sources PodState m Inlines -> PodParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Sources PodState m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
inlines)
  ParsecT Sources PodState m Text -> PodParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Sources PodState m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
  Blocks -> PodParser m Blocks
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty

cut :: PandocMonad m => PodParser m Blocks
cut :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
cut = Text -> PodParser m ()
forall (m :: * -> *). PandocMonad m => Text -> PodParser m ()
cmd Text
"cut" PodParser m ()
-> ParsecT Sources PodState m Blocks
-> ParsecT Sources PodState m Blocks
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources PodState m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
notPod

notPod :: PandocMonad m => PodParser m Blocks
notPod :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
notPod = do
  ParsecT Sources PodState m Text
-> ParsecT Sources PodState m ()
-> ParsecT Sources PodState m [Text]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Sources PodState m Text
forall (m :: * -> *) st. Monad m => ParsecT Sources st m Text
anyLine (ParsecT Sources PodState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof ParsecT Sources PodState m ()
-> ParsecT Sources PodState m () -> ParsecT Sources PodState m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Char -> ParsecT Sources PodState m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Sources PodState m Char -> ParsecT Sources PodState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources PodState m Char -> ParsecT Sources PodState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'=' ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Char
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
letter))))
  Blocks -> PodParser m Blocks
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty

over :: PandocMonad m => PodParser m Blocks
over :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
over = do
  Text -> PodParser m ()
forall (m :: * -> *). PandocMonad m => Text -> PodParser m ()
cmd Text
"over"
  ParsecT Sources PodState m Text
forall (m :: * -> *) st. Monad m => ParsecT Sources st m Text
anyLine
  ParsecT Sources PodState m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
  PodParser m Blocks -> PodParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (PodParser m Blocks -> PodParser m ())
-> PodParser m Blocks -> PodParser m ()
forall a b. (a -> b) -> a -> b
$ PodParser m Blocks -> PodParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'=' ParsecT Sources PodState m Char
-> PodParser m Blocks -> PodParser m Blocks
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
cut)
  Blocks
bs <- PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
list PodParser m Blocks -> PodParser m Blocks -> PodParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
blockquote
  String -> ParsecT Sources PodState m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"=back" ParsecT Sources PodState m String
-> ParsecT Sources PodState m Text
-> ParsecT Sources PodState m String
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources PodState m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
  Blocks -> PodParser m Blocks
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
bs

list :: PandocMonad m => PodParser m Blocks
list :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
list = ParsecT Sources PodState m Blocks
-> ParsecT Sources PodState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Sources PodState m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
bulletList ParsecT Sources PodState m Blocks
-> ParsecT Sources PodState m Blocks
-> ParsecT Sources PodState m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Blocks
-> ParsecT Sources PodState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Sources PodState m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
orderedList ParsecT Sources PodState m Blocks
-> ParsecT Sources PodState m Blocks
-> ParsecT Sources PodState m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
definitionList

bulletList :: PandocMonad m => PodParser m Blocks
bulletList :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
bulletList = [Blocks] -> Blocks
B.bulletList ([Blocks] -> Blocks)
-> ParsecT Sources PodState m [Blocks]
-> ParsecT Sources PodState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Blocks
-> ParsecT Sources PodState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (PodParser m () -> ParsecT Sources PodState m Blocks
forall (m :: * -> *).
PandocMonad m =>
PodParser m () -> PodParser m Blocks
item (ParsecT Sources PodState m Char
-> ParsecT Sources PodState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources PodState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources PodState m String
-> PodParser m () -> PodParser m ()
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources PodState m Char -> PodParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'*')))

orderedList :: PandocMonad m => PodParser m Blocks
orderedList :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
orderedList = do
  Blocks
start <- PodParser m Blocks
item1
  [Blocks]
more <- PodParser m Blocks -> ParsecT Sources PodState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many PodParser m Blocks
orderedItem
  Blocks -> PodParser m Blocks
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> PodParser m Blocks) -> Blocks -> PodParser m Blocks
forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
B.orderedList (Blocks
start Blocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
: [Blocks]
more)
  where
    item1 :: PodParser m Blocks
item1 = PodParser m () -> PodParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
PodParser m () -> PodParser m Blocks
item (PodParser m () -> PodParser m Blocks)
-> PodParser m () -> PodParser m Blocks
forall a b. (a -> b) -> a -> b
$ PodParser m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces PodParser m ()
-> ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Char
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'1' ParsecT Sources PodState m Char -> PodParser m () -> PodParser m ()
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources PodState m Char -> PodParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'.')
    orderedItem :: PodParser m Blocks
orderedItem = PodParser m () -> PodParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
PodParser m () -> PodParser m Blocks
item (PodParser m () -> PodParser m Blocks)
-> PodParser m () -> PodParser m Blocks
forall a b. (a -> b) -> a -> b
$ PodParser m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces PodParser m ()
-> ParsecT Sources PodState m String
-> ParsecT Sources PodState m String
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources PodState m Char
-> ParsecT Sources PodState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
digit ParsecT Sources PodState m String
-> PodParser m () -> PodParser m ()
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources PodState m Char -> PodParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'.')

item :: PandocMonad m => PodParser m () -> PodParser m Blocks
item :: forall (m :: * -> *).
PandocMonad m =>
PodParser m () -> PodParser m Blocks
item PodParser m ()
p = do
  PodParser m () -> PodParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Text -> PodParser m ()
forall (m :: * -> *). PandocMonad m => Text -> PodParser m ()
cmd Text
"=item")
  PodParser m ()
p
  ParsecT Sources PodState m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
  [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT Sources PodState m [Blocks] -> PodParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PodParser m Blocks -> ParsecT Sources PodState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
block PodParser m Blocks -> String -> PodParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"runaway item"

definitionList :: PandocMonad m => PodParser m Blocks
definitionList :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
definitionList = [(Inlines, [Blocks])] -> Blocks
B.definitionList ([(Inlines, [Blocks])] -> Blocks)
-> ParsecT Sources PodState m [(Inlines, [Blocks])]
-> ParsecT Sources PodState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m (Inlines, [Blocks])
-> ParsecT Sources PodState m [(Inlines, [Blocks])]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Sources PodState m (Inlines, [Blocks])
dlItem
  where
    dlItem :: ParsecT Sources PodState m (Inlines, [Blocks])
dlItem = do
      ParsecT Sources PodState m () -> ParsecT Sources PodState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Text -> ParsecT Sources PodState m ()
forall (m :: * -> *). PandocMonad m => Text -> PodParser m ()
cmd Text
"=item")
      ParsecT Sources PodState m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
      Inlines
term <- PodParser m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
inlines
      ParsecT Sources PodState m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
      -- perlpodspec sez the /section part of a link can refer to either
      -- a header or a dl item, hence treating it as a "header" here
      Attr
attrs <- Attr -> Inlines -> ParsecT Sources PodState m Attr
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st, HasLogMessages st,
 HasIdentifierList st) =>
Attr -> Inlines -> ParsecT s st m Attr
registerHeader Attr
B.nullAttr Inlines
term
      Blocks
defn <- [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT Sources PodState m [Blocks]
-> ParsecT Sources PodState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Blocks
-> ParsecT Sources PodState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources PodState m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
block ParsecT Sources PodState m Blocks
-> String -> ParsecT Sources PodState m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"runaway dlitem"
      (Inlines, [Blocks])
-> ParsecT Sources PodState m (Inlines, [Blocks])
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Attr -> Inlines -> Inlines
B.spanWith Attr
attrs Inlines
term, [Blocks
defn])

blockquote :: PandocMonad m => PodParser m Blocks
blockquote :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
blockquote = Blocks -> Blocks
B.blockQuote (Blocks -> Blocks) -> ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT Sources PodState m [Blocks]
-> ParsecT Sources PodState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Blocks
-> ParsecT Sources PodState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources PodState m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
block ParsecT Sources PodState m Blocks
-> String -> ParsecT Sources PodState m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"runaway blockquote"

paragraph :: PandocMonad m => PodParser m Blocks
paragraph :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
paragraph = do
  ParsecT Sources PodState m () -> ParsecT Sources PodState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources PodState m Char -> ParsecT Sources PodState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'=' ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Char
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
letter))
  Inlines
inl <- PodParser m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
inlines
  ParsecT Sources PodState m Text -> ParsecT Sources PodState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Sources PodState m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
  Blocks -> PodParser m Blocks
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> PodParser m Blocks) -> Blocks -> PodParser m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
B.trimInlines Inlines
inl

inlines :: PandocMonad m => PodParser m Inlines
inlines :: forall (m :: * -> *). PandocMonad m => PodParser m Inlines
inlines = [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources PodState m [Inlines]
-> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Sources PodState m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
format ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
whitespace ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
str)

-- perlpodspec sez:
--   If a Pod processor sees any formatting code other than the ones listed,
--   that processor must by default treat this as an error.
format :: PandocMonad m => PodParser m Inlines
format :: forall (m :: * -> *). PandocMonad m => PodParser m Inlines
format = ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources PodState m Inlines
 -> ParsecT Sources PodState m Inlines)
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall a b. (a -> b) -> a -> b
$ do
  Char
ctrl <- (Char -> Bool) -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isAsciiUpper
  SourcePos
p <- ParsecT Sources PodState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  ParsecT Sources PodState m Char -> ParsecT Sources PodState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'<')
  case Char
ctrl of
    Char
'B' -> Inlines -> Inlines
B.strong (Inlines -> Inlines)
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Inlines
argument
    Char
'C' -> Text -> Inlines
B.code (Text -> Inlines) -> (Inlines -> Text) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inlines -> Inlines)
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Inlines
argument
    Char
'F' -> Attr -> Inlines -> Inlines
B.spanWith (Text
forall a. Monoid a => a
mempty, [Text
"filename"], [(Text, Text)]
forall a. Monoid a => a
mempty) (Inlines -> Inlines)
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Inlines
argument
    Char
'I' -> Inlines -> Inlines
B.emph (Inlines -> Inlines)
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Inlines
argument
    Char
'S' -> ParsecT Sources PodState m Inlines
argument  -- TODO map nbsps
    Char
'X' -> ParsecT Sources PodState m Inlines
argument ParsecT Sources PodState m Inlines
-> Inlines -> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Inlines
forall a. Monoid a => a
mempty
    Char
'Z' -> ParsecT Sources PodState m Inlines
argument ParsecT Sources PodState m Inlines
-> Inlines -> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Inlines
forall a. Monoid a => a
mempty

    Char
'E' -> do
      Text
a <- Inlines -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inlines -> Text)
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Inlines
argument
      case Text -> Maybe Text
entity Text
a of
             -- per spec:
             --   Pod parsers, when faced with some unknown "E<identifier>" code,
             --   shouldn't simply replace it with nullstring (by default, at
             --   least), but may pass it through as a string consisting of the
             --   literal characters E, less-than, identifier, greater-than.
             Maybe Text
Nothing -> do
               LogMessage -> ParsecT Sources PodState m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParsecT s st m ()
logMessage (LogMessage -> ParsecT Sources PodState m ())
-> LogMessage -> ParsecT Sources PodState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent (Text
"unknown entity " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a) SourcePos
p
               Inlines -> ParsecT Sources PodState m Inlines
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT Sources PodState m Inlines)
-> Inlines -> ParsecT Sources PodState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text
"E<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
             Just Text
e -> Inlines -> ParsecT Sources PodState m Inlines
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT Sources PodState m Inlines)
-> Inlines -> ParsecT Sources PodState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str Text
e

    Char
'L' -> ParsecT Sources PodState m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
link

    Char
x -> PandocError -> ParsecT Sources PodState m Inlines
forall a. PandocError -> ParsecT Sources PodState m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> ParsecT Sources PodState m Inlines)
-> PandocError -> ParsecT Sources PodState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ Text -> Char -> Text
T.snoc Text
"unknown Pod formatting code " Char
x
  where
    argument :: ParsecT Sources PodState m Inlines
argument = ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Sources PodState m Inlines
expandedArg ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Inlines
compactArg ParsecT Sources PodState m Inlines
-> String -> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"argument"
    innerStr :: ParsecT Sources PodState m Inlines
innerStr =  Text -> Inlines
B.str (Text -> Inlines)
-> ParsecT Sources PodState m Text
-> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Char -> ParsecT Sources PodState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m Text
many1Char (String -> ParsecT Sources PodState m Char
forall (m :: * -> *). PandocMonad m => String -> PodParser m Char
podCharLess String
">")
    compactArg :: ParsecT Sources PodState m Inlines
compactArg = do
      Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'<'
      [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources PodState m [Inlines]
-> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Char
-> ParsecT Sources PodState m [Inlines]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (ParsecT Sources PodState m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
format ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
whitespace ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Inlines
innerStr) (Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'>')
    expandedArg :: ParsecT Sources PodState m Inlines
expandedArg = do
      Int
openLen <- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int)
-> ParsecT Sources PodState m String
-> ParsecT Sources PodState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Char
-> ParsecT Sources PodState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'<')
      let close :: Text
close = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
openLen Char
'>'
      ParsecT Sources PodState m Char -> ParsecT Sources PodState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT Sources PodState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources PodState m ()
-> ParsecT Sources PodState m () -> ParsecT Sources PodState m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Char -> ParsecT Sources PodState m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Sources PodState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
blankline
      Inlines
arg <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources PodState m [Inlines]
-> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Sources PodState m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
format ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources PodState m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
whitespace ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m ()
-> ParsecT Sources PodState m Inlines
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources PodState m Text -> ParsecT Sources PodState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Text -> ParsecT Sources PodState m Text
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> ParsecT s u m Text
textStr Text
close)) ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
str)
      ParsecT Sources PodState m Char
-> ParsecT Sources PodState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Sources PodState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar
      Text -> ParsecT Sources PodState m Text
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> ParsecT s u m Text
textStr Text
close
      Inlines -> ParsecT Sources PodState m Inlines
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
arg
    -- Some legacy entity names are required to be parsed by Pod formatters
    oct :: String -> Maybe (Integer, String)
oct = [(Integer, String)] -> Maybe (Integer, String)
forall a. [a] -> Maybe a
listToMaybe ([(Integer, String)] -> Maybe (Integer, String))
-> (String -> [(Integer, String)])
-> String
-> Maybe (Integer, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Num a) => ReadS a
readOct @Integer
    entity :: Text -> Maybe Text
entity Text
"apos" = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"'"
    entity Text
"sol" = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"/"
    entity Text
"verbar" = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"|"
    entity Text
"lchevron" = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"«"
    entity Text
"rchevron" = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"»"
    entity (Text -> Text -> Maybe Text
T.stripPrefix Text
"0x" -> Just Text
suf) = Text -> Maybe Text
lookupEntity (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"#x" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suf
    entity (Text -> Text -> Maybe Text
T.stripPrefix Text
"0" -> Just Text
suf)
        | Just (Integer
n, String
"") <- String -> Maybe (Integer, String)
oct (Text -> String
T.unpack Text
suf) = Text -> Maybe Text
lookupEntity (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
tshow Integer
n
    entity (forall a. Integral a => Reader a
TR.decimal @Integer -> Right (Integer
x, Text
"")) = Text -> Maybe Text
lookupEntity (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
tshow Integer
x
    entity Text
x = Text -> Maybe Text
lookupEntity Text
x

-- god knows there must be a higher order way of writing this thing, where we
-- have multiple different possible parser states within the link argument
-- varying depending on whether the link is expanded or not, but at least I
-- understand what I've done. This would be less wacky with a lexing step.
link :: PandocMonad m => PodParser m Inlines
link :: forall (m :: * -> *). PandocMonad m => PodParser m Inlines
link = do
  Text -> Text
identifier <- Extensions -> Text -> Text
textToIdentifier (Extensions -> Text -> Text)
-> ParsecT Sources PodState m Extensions
-> ParsecT Sources PodState m (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReaderOptions -> Extensions)
-> ParsecT Sources PodState m Extensions
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
forall s (m :: * -> *) t b.
Stream s m t =>
(ReaderOptions -> b) -> ParsecT s PodState m b
getOption ReaderOptions -> Extensions
readerExtensions
  (Maybe Inlines
name, PodLinkDestination
dest) <- ParsecT Sources PodState m (Maybe Inlines, PodLinkDestination)
-> ParsecT Sources PodState m (Maybe Inlines, PodLinkDestination)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Sources PodState m (Maybe Inlines, PodLinkDestination)
expandedLinkArg ParsecT Sources PodState m (Maybe Inlines, PodLinkDestination)
-> ParsecT Sources PodState m (Maybe Inlines, PodLinkDestination)
-> ParsecT Sources PodState m (Maybe Inlines, PodLinkDestination)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m (Maybe Inlines, PodLinkDestination)
compactLinkArg
  Inlines -> PodParser m Inlines
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> PodParser m Inlines) -> Inlines -> PodParser m Inlines
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> Maybe Inlines -> PodLinkDestination -> Inlines
mkLink Text -> Text
identifier Maybe Inlines
name PodLinkDestination
dest
  where
    compactLinkArg :: ParsecT Sources PodState m (Maybe Inlines, PodLinkDestination)
compactLinkArg = do
      Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'<'
      Maybe [Inlines]
name <- PodParser m Inlines
-> String -> ParsecT Sources PodState m (Maybe [Inlines])
forall {m :: * -> *}.
PandocMonad m =>
ParsecT Sources PodState m Inlines
-> String -> ParsecT Sources PodState m (Maybe [Inlines])
linkName PodParser m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
whitespace String
">"
      PodLinkDestination
dest <- PodParser m Inlines
-> ParsecT Sources PodState m Char
-> String
-> ParsecT Sources PodState m PodLinkDestination
forall {m :: * -> *} {a}.
(PandocMonad m, Show a) =>
ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m a
-> String
-> ParsecT Sources PodState m PodLinkDestination
linkDest PodParser m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
whitespace (Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'>') String
">"
      Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'>'
      (Maybe Inlines, PodLinkDestination)
-> ParsecT Sources PodState m (Maybe Inlines, PodLinkDestination)
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> Maybe [Inlines] -> Maybe Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Inlines]
name, PodLinkDestination
dest)
    expandedLinkArg :: ParsecT Sources PodState m (Maybe Inlines, PodLinkDestination)
expandedLinkArg = do
      Int
openLen <- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int)
-> ParsecT Sources PodState m String
-> ParsecT Sources PodState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Char
-> ParsecT Sources PodState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'<')
      let closeStr :: ParsecT Sources u m Text
closeStr = Text -> ParsecT Sources u m Text
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> ParsecT s u m Text
textStr (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
openLen Char
'>')
      let close :: ParsecT Sources u m Text
close = ParsecT Sources u m Char -> ParsecT Sources u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT Sources u m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources u m ()
-> ParsecT Sources u m Text -> ParsecT Sources u m Text
forall a b.
ParsecT Sources u m a
-> ParsecT Sources u m b -> ParsecT Sources u m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources u m Text
forall {u}. ParsecT Sources u m Text
closeStr
      let sp :: ParsecT Sources u m Inlines
sp = ParsecT Sources u m Inlines -> ParsecT Sources u m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources u m Inlines -> ParsecT Sources u m Inlines)
-> ParsecT Sources u m Inlines -> ParsecT Sources u m Inlines
forall a b. (a -> b) -> a -> b
$ ParsecT Sources u m Char -> ParsecT Sources u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Sources u m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources u m String
-> ParsecT Sources u m () -> ParsecT Sources u m ()
forall a b.
ParsecT Sources u m a
-> ParsecT Sources u m b -> ParsecT Sources u m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources u m Text -> ParsecT Sources u m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Sources u m Text
forall {u}. ParsecT Sources u m Text
closeStr ParsecT Sources u m () -> Inlines -> ParsecT Sources u m Inlines
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Inlines
B.space
      ParsecT Sources PodState m Char
-> ParsecT Sources PodState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Sources PodState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar
      Maybe [Inlines]
name <- PodParser m Inlines
-> String -> ParsecT Sources PodState m (Maybe [Inlines])
forall {m :: * -> *}.
PandocMonad m =>
ParsecT Sources PodState m Inlines
-> String -> ParsecT Sources PodState m (Maybe [Inlines])
linkName PodParser m Inlines
forall {u}. ParsecT Sources u m Inlines
sp String
""
      PodLinkDestination
dest <- PodParser m Inlines
-> ParsecT Sources PodState m Text
-> String
-> ParsecT Sources PodState m PodLinkDestination
forall {m :: * -> *} {a}.
(PandocMonad m, Show a) =>
ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m a
-> String
-> ParsecT Sources PodState m PodLinkDestination
linkDest PodParser m Inlines
forall {u}. ParsecT Sources u m Inlines
sp ParsecT Sources PodState m Text
forall {u}. ParsecT Sources u m Text
close String
""
      ParsecT Sources PodState m Text
forall {u}. ParsecT Sources u m Text
close
      (Maybe Inlines, PodLinkDestination)
-> ParsecT Sources PodState m (Maybe Inlines, PodLinkDestination)
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> Maybe [Inlines] -> Maybe Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Inlines]
name, PodLinkDestination
dest)
    mkLink :: (Text -> Text) -> Maybe Inlines -> PodLinkDestination -> Inlines
mkLink Text -> Text
identifier Maybe Inlines
name PodLinkDestination
dest =
      let name' :: Inlines
name' = Inlines -> Maybe Inlines -> Inlines
forall a. a -> Maybe a -> a
fromMaybe (PodLinkDestination -> Inlines
defaultLinkName PodLinkDestination
dest) Maybe Inlines
name in
          case PodLinkDestination
dest of
            LinkUrl Inlines
_ Text
href -> Text -> Text -> Inlines -> Inlines
B.link Text
href Text
"" Inlines
name'
            LinkMan Inlines
nm Maybe Inlines
Nothing ->  Attr -> Text -> Text -> Inlines -> Inlines
B.linkWith (Text
forall a. Monoid a => a
mempty, [Text]
forall a. Monoid a => a
mempty, [(Text
"manual", Inlines -> Text
forall a. Walkable Inline a => a -> Text
stringify Inlines
nm)]) Text
"" Text
"" Inlines
name'
            LinkMan Inlines
nm (Just Inlines
sc) -> Attr -> Text -> Text -> Inlines -> Inlines
B.linkWith (Text
forall a. Monoid a => a
mempty, [Text]
forall a. Monoid a => a
mempty, [(Text
"manual", Inlines -> Text
forall a. Walkable Inline a => a -> Text
stringify Inlines
nm), (Text
"section", Inlines -> Text
forall a. Walkable Inline a => a -> Text
stringify Inlines
sc)]) Text
"" Text
"" Inlines
name'
            LinkInternal Inlines
sc -> Text -> Text -> Inlines -> Inlines
B.link (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
identifier (Inlines -> Text
forall a. Walkable Inline a => a -> Text
stringify Inlines
sc)) Text
"" Inlines
name'

    linkName :: ParsecT Sources PodState m Inlines
-> String -> ParsecT Sources PodState m (Maybe [Inlines])
linkName ParsecT Sources PodState m Inlines
sp String
ex = ParsecT Sources PodState m [Inlines]
-> ParsecT Sources PodState m (Maybe [Inlines])
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT Sources PodState m [Inlines]
 -> ParsecT Sources PodState m (Maybe [Inlines]))
-> ParsecT Sources PodState m [Inlines]
-> ParsecT Sources PodState m (Maybe [Inlines])
forall a b. (a -> b) -> a -> b
$ ParsecT Sources PodState m [Inlines]
-> ParsecT Sources PodState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources PodState m [Inlines]
 -> ParsecT Sources PodState m [Inlines])
-> ParsecT Sources PodState m [Inlines]
-> ParsecT Sources PodState m [Inlines]
forall a b. (a -> b) -> a -> b
$ ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many
        (ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Sources PodState m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
format
         ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Inlines
sp
         ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text -> Inlines
B.str (Text -> Inlines)
-> ParsecT Sources PodState m Text
-> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Char -> ParsecT Sources PodState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m Text
many1Char (String -> ParsecT Sources PodState m Char
forall (m :: * -> *). PandocMonad m => String -> PodParser m Char
podCharLess (Char
'|'Char -> ShowS
forall a. a -> [a] -> [a]
:String
ex))) ParsecT Sources PodState m [Inlines]
-> ParsecT Sources PodState m Char
-> ParsecT Sources PodState m [Inlines]
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|'
    linkDest :: ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m a
-> String
-> ParsecT Sources PodState m PodLinkDestination
linkDest ParsecT Sources PodState m Inlines
sp ParsecT Sources PodState m a
close String
ex = ParsecT Sources PodState m PodLinkDestination
-> ParsecT Sources PodState m PodLinkDestination
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Sources PodState m PodLinkDestination
forall {m :: * -> *}.
PandocMonad m =>
String -> ParsecT Sources PodState m PodLinkDestination
url String
ex) ParsecT Sources PodState m PodLinkDestination
-> ParsecT Sources PodState m PodLinkDestination
-> ParsecT Sources PodState m PodLinkDestination
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m a
-> String
-> ParsecT Sources PodState m PodLinkDestination
forall {m :: * -> *} {a}.
(Show a, PandocMonad m) =>
ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m a
-> String
-> ParsecT Sources PodState m PodLinkDestination
internal ParsecT Sources PodState m Inlines
sp ParsecT Sources PodState m a
close String
ex ParsecT Sources PodState m PodLinkDestination
-> ParsecT Sources PodState m PodLinkDestination
-> ParsecT Sources PodState m PodLinkDestination
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m a
-> String
-> ParsecT Sources PodState m PodLinkDestination
forall {m :: * -> *} {a}.
(PandocMonad m, Show a) =>
ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m a
-> String
-> ParsecT Sources PodState m PodLinkDestination
man ParsecT Sources PodState m Inlines
sp ParsecT Sources PodState m a
close String
ex
    -- perlpodspec sez:
    --    Note that you can distinguish URL-links from anything else by the
    --    fact that they match m/\A\w+:[^:\s]\S*\z/.
    -- This is obviously not an RFC-compliant matcher for a URI scheme, but
    -- this is what the specification and the canonical implementation (Pod::Simple)
    -- do for deciding that a link target "looks like" a URL, as opposed to a
    -- manual page reference, so what we are doing here is roughly equivalent
    -- even though it is nonsense
    url :: String -> ParsecT Sources PodState m PodLinkDestination
url String
ex = do
      Text
scheme <- ParsecT Sources PodState m Char -> ParsecT Sources PodState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m Text
many1Char (ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
letter ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
digit ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'_')
      Text
colon <- Char -> Text
T.singleton (Char -> Text)
-> ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':' ParsecT Sources PodState m Text
-> ParsecT Sources PodState m () -> ParsecT Sources PodState m Text
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources PodState m Char -> ParsecT Sources PodState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':')
      [Inlines]
rst <- ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Sources PodState m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
format ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text -> Inlines
B.str (Text -> Inlines)
-> ParsecT Sources PodState m Text
-> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Char -> ParsecT Sources PodState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m Text
many1Char (String -> ParsecT Sources PodState m Char
forall (m :: * -> *). PandocMonad m => String -> PodParser m Char
podCharLess String
ex))
      PodLinkDestination -> ParsecT Sources PodState m PodLinkDestination
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PodLinkDestination
 -> ParsecT Sources PodState m PodLinkDestination)
-> PodLinkDestination
-> ParsecT Sources PodState m PodLinkDestination
forall a b. (a -> b) -> a -> b
$ Inlines -> Text -> PodLinkDestination
LinkUrl
                 (Text -> Inlines
B.str Text
scheme Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
B.str Text
colon Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat [Inlines]
rst)
                 (Text
scheme Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
colon Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inlines] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inlines]
rst)
    quotedSection :: ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m a
-> String
-> ParsecT Sources PodState m Inlines
quotedSection ParsecT Sources PodState m Inlines
sp ParsecT Sources PodState m a
close String
ex = do
      let mystr :: ParsecT Sources PodState m Inlines
mystr = Text -> Inlines
B.str (Text -> Inlines)
-> ParsecT Sources PodState m Text
-> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Char -> ParsecT Sources PodState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m Text
many1Char (String -> ParsecT Sources PodState m Char
forall (m :: * -> *). PandocMonad m => String -> PodParser m Char
podCharLess (Char
'\"'Char -> ShowS
forall a. a -> [a] -> [a]
:String
ex) ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Char -> ParsecT Sources PodState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'"' ParsecT Sources PodState m Char
-> ParsecT Sources PodState m () -> ParsecT Sources PodState m Char
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources PodState m a -> ParsecT Sources PodState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Sources PodState m a
close))
      Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'"'
      Inlines
ins <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources PodState m [Inlines]
-> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Sources PodState m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
format ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Inlines
sp ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Inlines
mystr)
      Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'"'
      Inlines -> ParsecT Sources PodState m Inlines
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
ins
    section :: ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m a
-> String
-> ParsecT Sources PodState m Inlines
section ParsecT Sources PodState m Inlines
sp ParsecT Sources PodState m a
close String
ex = ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m a
-> String
-> ParsecT Sources PodState m Inlines
forall {m :: * -> *} {a}.
(PandocMonad m, Show a) =>
ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m a
-> String
-> ParsecT Sources PodState m Inlines
quotedSection ParsecT Sources PodState m Inlines
sp ParsecT Sources PodState m a
close String
ex) ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources PodState m [Inlines]
-> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Sources PodState m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
format ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Inlines
sp ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text -> Inlines
B.str (Text -> Inlines)
-> ParsecT Sources PodState m Text
-> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Char -> ParsecT Sources PodState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m Text
many1Char (String -> ParsecT Sources PodState m Char
forall (m :: * -> *). PandocMonad m => String -> PodParser m Char
podCharLess String
ex))
    internal :: ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m a
-> String
-> ParsecT Sources PodState m PodLinkDestination
internal ParsecT Sources PodState m Inlines
sp ParsecT Sources PodState m a
close String
ex = do
      Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'/'
      Inlines -> PodLinkDestination
LinkInternal (Inlines -> PodLinkDestination)
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m PodLinkDestination
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m a
-> String
-> ParsecT Sources PodState m Inlines
forall {a} {m :: * -> *}.
(Show a, PandocMonad m) =>
ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m a
-> String
-> ParsecT Sources PodState m Inlines
section ParsecT Sources PodState m Inlines
sp ParsecT Sources PodState m a
close String
ex
    notSlash :: ParsecT Sources PodState m Inlines
-> String -> ParsecT Sources PodState m Inlines
notSlash ParsecT Sources PodState m Inlines
sp String
ex = ParsecT Sources PodState m Inlines
forall (m :: * -> *). PandocMonad m => PodParser m Inlines
format ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Inlines
sp ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text -> Inlines
B.str (Text -> Inlines)
-> ParsecT Sources PodState m Text
-> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Char -> ParsecT Sources PodState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m Text
many1Char (String -> ParsecT Sources PodState m Char
forall (m :: * -> *). PandocMonad m => String -> PodParser m Char
podCharLess (Char
'/'Char -> ShowS
forall a. a -> [a] -> [a]
:String
ex))
    man :: ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m a
-> String
-> ParsecT Sources PodState m PodLinkDestination
man ParsecT Sources PodState m Inlines
sp ParsecT Sources PodState m a
close String
ex = do
      Inlines
page <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Sources PodState m [Inlines]
-> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Sources PodState m Inlines
-> String -> ParsecT Sources PodState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
ParsecT Sources PodState m Inlines
-> String -> ParsecT Sources PodState m Inlines
notSlash ParsecT Sources PodState m Inlines
sp String
ex)
      Maybe Inlines
sec <- ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m (Maybe Inlines)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT Sources PodState m Inlines
 -> ParsecT Sources PodState m (Maybe Inlines))
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m (Maybe Inlines)
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'/' ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m a
-> String
-> ParsecT Sources PodState m Inlines
forall {a} {m :: * -> *}.
(Show a, PandocMonad m) =>
ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m a
-> String
-> ParsecT Sources PodState m Inlines
section ParsecT Sources PodState m Inlines
sp ParsecT Sources PodState m a
close String
ex
      PodLinkDestination -> ParsecT Sources PodState m PodLinkDestination
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PodLinkDestination
 -> ParsecT Sources PodState m PodLinkDestination)
-> PodLinkDestination
-> ParsecT Sources PodState m PodLinkDestination
forall a b. (a -> b) -> a -> b
$ Inlines -> Maybe Inlines -> PodLinkDestination
LinkMan Inlines
page Maybe Inlines
sec

whitespace :: PandocMonad m => PodParser m Inlines
whitespace :: forall (m :: * -> *). PandocMonad m => PodParser m Inlines
whitespace = ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources PodState m Inlines
 -> ParsecT Sources PodState m Inlines)
-> ParsecT Sources PodState m Inlines
-> ParsecT Sources PodState m Inlines
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Sources PodState m Char
-> ParsecT Sources PodState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Sources PodState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources PodState m String
-> ParsecT Sources PodState m () -> ParsecT Sources PodState m ()
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources PodState m Char -> ParsecT Sources PodState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline ParsecT Sources PodState m ()
-> ParsecT Sources PodState m () -> ParsecT Sources PodState m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources PodState m Char
-> ParsecT Sources PodState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources PodState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources PodState m String
-> ParsecT Sources PodState m () -> ParsecT Sources PodState m ()
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources PodState m Char -> ParsecT Sources PodState m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline
  ParsecT Sources PodState m Char -> ParsecT Sources PodState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Sources PodState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
blankline
  Inlines -> ParsecT Sources PodState m Inlines
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
B.space

podCharLess :: PandocMonad m => String -> PodParser m Char
podCharLess :: forall (m :: * -> *). PandocMonad m => String -> PodParser m Char
podCharLess String
exclude = ParsecT Sources PodState m Char -> ParsecT Sources PodState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((Char -> Bool) -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isAsciiUpper ParsecT Sources PodState m Char
-> ParsecT Sources PodState m () -> ParsecT Sources PodState m Char
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources PodState m Char -> ParsecT Sources PodState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'<'))
                ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> Bool) -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Bool -> Bool
not (Char -> Bool
isSpaceChar Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
c Bool -> Bool -> Bool
|| Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c String
exclude))

podChar :: PandocMonad m => PodParser m Char
podChar :: forall (m :: * -> *). PandocMonad m => PodParser m Char
podChar = ParsecT Sources PodState m Char -> ParsecT Sources PodState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((Char -> Bool) -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isAsciiUpper ParsecT Sources PodState m Char
-> ParsecT Sources PodState m () -> ParsecT Sources PodState m Char
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources PodState m Char -> ParsecT Sources PodState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'<'))
                ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> Bool) -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Bool -> Bool
not (Char -> Bool
isSpaceChar Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
c))

str :: PandocMonad m => PodParser m Inlines
str :: forall (m :: * -> *). PandocMonad m => PodParser m Inlines
str = Text -> Inlines
B.str (Text -> Inlines)
-> ParsecT Sources PodState m Text
-> ParsecT Sources PodState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Char -> ParsecT Sources PodState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m Text
many1Char ParsecT Sources PodState m Char
forall (m :: * -> *). PandocMonad m => PodParser m Char
podChar

nonEmptyLine :: PandocMonad m => PodParser m T.Text
nonEmptyLine :: forall (m :: * -> *). PandocMonad m => PodParser m Text
nonEmptyLine = ParsecT Sources PodState m Text -> ParsecT Sources PodState m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources PodState m Text
 -> ParsecT Sources PodState m Text)
-> ParsecT Sources PodState m Text
-> ParsecT Sources PodState m Text
forall a b. (a -> b) -> a -> b
$ do
  Text
pre <- ParsecT Sources PodState m Char -> ParsecT Sources PodState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m Text
manyChar ParsecT Sources PodState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar
  Text
something <- Char -> Text
T.singleton (Char -> Text)
-> ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources PodState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
nonspaceChar
  Text
post <- ParsecT Sources PodState m Text
forall (m :: * -> *) st. Monad m => ParsecT Sources st m Text
anyLineNewline
  Text -> ParsecT Sources PodState m Text
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT Sources PodState m Text)
-> Text -> ParsecT Sources PodState m Text
forall a b. (a -> b) -> a -> b
$ Text
pre Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
something Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
post

verbatim :: PandocMonad m => PodParser m Blocks
verbatim :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
verbatim = do
  Text
start <- ParsecT Sources PodState m Text
startVerbatimLine
  [Text]
lns <- ParsecT Sources PodState m Text
-> ParsecT Sources PodState m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Sources PodState m Text
forall (m :: * -> *). PandocMonad m => PodParser m Text
nonEmptyLine ParsecT Sources PodState m Text
-> ParsecT Sources PodState m Text
-> ParsecT Sources PodState m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                     ParsecT Sources PodState m Text -> ParsecT Sources PodState m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do Text
b <- ParsecT Sources PodState m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
                             Text
l <- ParsecT Sources PodState m Text
startVerbatimLine
                             Text -> ParsecT Sources PodState m Text
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT Sources PodState m Text)
-> Text -> ParsecT Sources PodState m Text
forall a b. (a -> b) -> a -> b
$ Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l))
  ParsecT Sources PodState m Text -> ParsecT Sources PodState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Sources PodState m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
  Blocks -> PodParser m Blocks
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> PodParser m Blocks) -> Blocks -> PodParser m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Blocks
B.codeBlock (Text -> Blocks) -> Text -> Blocks
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
startText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
lns
  where
    startVerbatimLine :: ParsecT Sources PodState m Text
startVerbatimLine = ParsecT Sources PodState m Char -> ParsecT Sources PodState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m Text
many1Char ParsecT Sources PodState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar ParsecT Sources PodState m Text
-> ParsecT Sources PodState m Text
-> ParsecT Sources PodState m Text
forall a. Semigroup a => a -> a -> a
<> ParsecT Sources PodState m Text
forall (m :: * -> *). PandocMonad m => PodParser m Text
nonEmptyLine

-- =begin/=end/=for and data paragraphs
-- The =begin/=end (and single-paragraph =for variant) markers in Pod are
-- designed as an extension point for specific formatters
--
-- this doesn't strictly match the intent of "=begin :ident" pod blocks, which
-- are still meant to be processed specially by the formatter, and only land in
-- the output upon request, i.e. pod2html will process "=begin :html" blocks as
-- Pod and include them in the regular output. Since the regions contain Pod
-- markup it seems to me that the best thing to do is parse the markup and put
-- a classname on it, allowing users to respond as desired with filters.
-- Pandoc doesn't have a built-in concept of parsed Divs that are only rendered
-- to certain formats, just raw blocks.
--
-- perlpodspec allows nesting of =begin/=end regions but we currently don't
-- because it would be annoying and we have something somewhat useful we
-- can do with these blocks which is treat them as RawBlocks, which matches
-- the intent reasonably well, and that gets weirder if we parse a nested
-- structure. It seems unlikely this would be encountered in the wild.

regionIdentifier :: PandocMonad m => PodParser m T.Text
regionIdentifier :: forall (m :: * -> *). PandocMonad m => PodParser m Text
regionIdentifier = ParsecT Sources PodState m Char -> ParsecT Sources PodState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m Text
many1Char (ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
alphaNum ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Char
-> ParsecT Sources PodState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m Char
oneOf String
"-_")

for :: PandocMonad m => PodParser m Blocks
for :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
for = do
  String -> ParsecT Sources PodState m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"for"
  ParsecT Sources PodState m Char
-> ParsecT Sources PodState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Sources PodState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar
  PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
forDiv PodParser m Blocks -> PodParser m Blocks -> PodParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
forData

forDiv :: PandocMonad m => PodParser m Blocks
forDiv :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
forDiv = do
  Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':'
  Text
cls <- PodParser m Text
forall (m :: * -> *). PandocMonad m => PodParser m Text
regionIdentifier
  ParsecT Sources PodState m Char
-> ParsecT Sources PodState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Sources PodState m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar
  Attr -> Blocks -> Blocks
B.divWith (Text
forall a. Monoid a => a
mempty, [Text
cls], [(Text, Text)]
forall a. Monoid a => a
mempty) (Blocks -> Blocks) -> PodParser m Blocks -> PodParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
paragraph

forData :: PandocMonad m => PodParser m Blocks
forData :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
forData = do
  Text
fmt <- PodParser m Text
forall (m :: * -> *). PandocMonad m => PodParser m Text
regionIdentifier
  Text
ln1 <- PodParser m Text
forall (m :: * -> *) st. Monad m => ParsecT Sources st m Text
anyLineNewline
  [Text]
lns <- PodParser m Text -> ParsecT Sources PodState m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many PodParser m Text
forall (m :: * -> *). PandocMonad m => PodParser m Text
nonEmptyLine
  PodParser m Text -> ParsecT Sources PodState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional PodParser m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
  Blocks -> PodParser m Blocks
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> PodParser m Blocks) -> Blocks -> PodParser m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Blocks
B.rawBlock Text
fmt ([Text] -> Text
T.concat (Text
ln1 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
lns))

begin :: PandocMonad m => PodParser m Blocks
begin :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
begin = do
  Text -> PodParser m ()
forall (m :: * -> *). PandocMonad m => Text -> PodParser m ()
cmd Text
"begin"
  PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
beginDiv PodParser m Blocks -> PodParser m Blocks -> PodParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
beginData

beginDiv :: PandocMonad m => PodParser m Blocks
beginDiv :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
beginDiv = do
  Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':'
  Text
cls <- PodParser m Text
forall (m :: * -> *). PandocMonad m => PodParser m Text
regionIdentifier
  PodParser m Text
forall (m :: * -> *) st. Monad m => ParsecT Sources st m Text
anyLine  -- "parameters" may appear in this position
  PodParser m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
  Blocks
bs <- [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT Sources PodState m [Blocks] -> PodParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PodParser m Blocks -> ParsecT Sources PodState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
block
  Text -> PodParser m Text
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> ParsecT s u m Text
textStr (Text
"=end :" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cls) PodParser m Text -> PodParser m Text -> PodParser m Text
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* PodParser m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
  Blocks -> PodParser m Blocks
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> PodParser m Blocks) -> Blocks -> PodParser m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
forall a. Monoid a => a
mempty, [Text
cls], [(Text, Text)]
forall a. Monoid a => a
mempty) Blocks
bs

beginData :: PandocMonad m => PodParser m Blocks
beginData :: forall (m :: * -> *). PandocMonad m => PodParser m Blocks
beginData = do
  Text
fmt <- PodParser m Text
forall (m :: * -> *). PandocMonad m => PodParser m Text
regionIdentifier
  PodParser m Text
forall (m :: * -> *) st. Monad m => ParsecT Sources st m Text
anyLine
  PodParser m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
  Text
lns <- [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text)
-> ParsecT Sources PodState m [Text] -> PodParser m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PodParser m Text -> ParsecT Sources PodState m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (PodParser m Text -> PodParser m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try PodParser m Text
rawCut PodParser m Text -> PodParser m Text -> PodParser m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> PodParser m Text
forall {u}. ParsecT Sources u m Text
rawLine)
  Text -> PodParser m Text
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> ParsecT s u m Text
textStr (Text
"=end " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fmt) PodParser m Text -> PodParser m Text -> PodParser m Text
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* PodParser m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
  Blocks -> PodParser m Blocks
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> PodParser m Blocks) -> Blocks -> PodParser m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Blocks
B.rawBlock Text
fmt Text
lns
  where
    rawCut :: PodParser m Text
rawCut = do
      Char -> ParsecT Sources PodState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'=' ParsecT Sources PodState m Char
-> PodParser m Blocks -> PodParser m Blocks
forall a b.
ParsecT Sources PodState m a
-> ParsecT Sources PodState m b -> ParsecT Sources PodState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
cut
      PodParser m Blocks
forall (m :: * -> *). PandocMonad m => PodParser m Blocks
pod PodParser m Blocks -> String -> PodParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"=pod to close =cut within =begin/=end"
      Text -> PodParser m Text
forall a. a -> ParsecT Sources PodState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
forall a. Monoid a => a
mempty
    rawLine :: ParsecT Sources u m Text
rawLine = do
      ParsecT Sources u m () -> ParsecT Sources u m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources u m Char -> ParsecT Sources u m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'=' ParsecT Sources u m Char
-> ParsecT Sources u m Char -> ParsecT Sources u m Char
forall a b.
ParsecT Sources u m a
-> ParsecT Sources u m b -> ParsecT Sources u m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
letter))
      ParsecT Sources u m Text
forall (m :: * -> *) st. Monad m => ParsecT Sources st m Text
anyLineNewline