{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Text.MMark.Parser
( MMarkErr (..),
parse,
)
where
import Control.Applicative (Alternative, liftA2)
import Control.Monad
import qualified Control.Monad.Combinators.NonEmpty as NE
import qualified Data.Aeson as Aeson
import Data.Bifunctor (Bifunctor (..))
import Data.Bool (bool)
import qualified Data.Char as Char
import qualified Data.DList as DList
import Data.HTML.Entities (htmlEntityMap)
import qualified Data.HashMap.Strict as HM
import Data.List.NonEmpty (NonEmpty (..), (<|))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (catMaybes, fromJust, isJust, isNothing)
import Data.Monoid (Any (..))
import Data.Ratio ((%))
import qualified Data.Set as E
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Lens.Micro ((^.))
import qualified Text.Email.Validate as Email
import Text.MMark.Parser.Internal
import Text.MMark.Type
import Text.MMark.Util
import Text.Megaparsec hiding (State (..), parse)
import Text.Megaparsec.Char hiding (eol)
import qualified Text.Megaparsec.Char.Lexer as L
import Text.URI (URI)
import qualified Text.URI as URI
import Text.URI.Lens (uriPath)
#if !defined(ghcjs_HOST_OS)
import qualified Data.Yaml as Yaml
#endif
data InlineFrame
=
EmphasisFrame
|
EmphasisFrame_
|
StrongFrame
|
StrongFrame_
|
StrikeoutFrame
|
SubscriptFrame
|
SuperscriptFrame
deriving (InlineFrame -> InlineFrame -> Bool
(InlineFrame -> InlineFrame -> Bool)
-> (InlineFrame -> InlineFrame -> Bool) -> Eq InlineFrame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InlineFrame -> InlineFrame -> Bool
$c/= :: InlineFrame -> InlineFrame -> Bool
== :: InlineFrame -> InlineFrame -> Bool
$c== :: InlineFrame -> InlineFrame -> Bool
Eq, Eq InlineFrame
Eq InlineFrame
-> (InlineFrame -> InlineFrame -> Ordering)
-> (InlineFrame -> InlineFrame -> Bool)
-> (InlineFrame -> InlineFrame -> Bool)
-> (InlineFrame -> InlineFrame -> Bool)
-> (InlineFrame -> InlineFrame -> Bool)
-> (InlineFrame -> InlineFrame -> InlineFrame)
-> (InlineFrame -> InlineFrame -> InlineFrame)
-> Ord InlineFrame
InlineFrame -> InlineFrame -> Bool
InlineFrame -> InlineFrame -> Ordering
InlineFrame -> InlineFrame -> InlineFrame
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InlineFrame -> InlineFrame -> InlineFrame
$cmin :: InlineFrame -> InlineFrame -> InlineFrame
max :: InlineFrame -> InlineFrame -> InlineFrame
$cmax :: InlineFrame -> InlineFrame -> InlineFrame
>= :: InlineFrame -> InlineFrame -> Bool
$c>= :: InlineFrame -> InlineFrame -> Bool
> :: InlineFrame -> InlineFrame -> Bool
$c> :: InlineFrame -> InlineFrame -> Bool
<= :: InlineFrame -> InlineFrame -> Bool
$c<= :: InlineFrame -> InlineFrame -> Bool
< :: InlineFrame -> InlineFrame -> Bool
$c< :: InlineFrame -> InlineFrame -> Bool
compare :: InlineFrame -> InlineFrame -> Ordering
$ccompare :: InlineFrame -> InlineFrame -> Ordering
$cp1Ord :: Eq InlineFrame
Ord, Int -> InlineFrame -> ShowS
[InlineFrame] -> ShowS
InlineFrame -> String
(Int -> InlineFrame -> ShowS)
-> (InlineFrame -> String)
-> ([InlineFrame] -> ShowS)
-> Show InlineFrame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InlineFrame] -> ShowS
$cshowList :: [InlineFrame] -> ShowS
show :: InlineFrame -> String
$cshow :: InlineFrame -> String
showsPrec :: Int -> InlineFrame -> ShowS
$cshowsPrec :: Int -> InlineFrame -> ShowS
Show)
data InlineState
=
SingleFrame InlineFrame
|
DoubleFrame InlineFrame InlineFrame
deriving (InlineState -> InlineState -> Bool
(InlineState -> InlineState -> Bool)
-> (InlineState -> InlineState -> Bool) -> Eq InlineState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InlineState -> InlineState -> Bool
$c/= :: InlineState -> InlineState -> Bool
== :: InlineState -> InlineState -> Bool
$c== :: InlineState -> InlineState -> Bool
Eq, Eq InlineState
Eq InlineState
-> (InlineState -> InlineState -> Ordering)
-> (InlineState -> InlineState -> Bool)
-> (InlineState -> InlineState -> Bool)
-> (InlineState -> InlineState -> Bool)
-> (InlineState -> InlineState -> Bool)
-> (InlineState -> InlineState -> InlineState)
-> (InlineState -> InlineState -> InlineState)
-> Ord InlineState
InlineState -> InlineState -> Bool
InlineState -> InlineState -> Ordering
InlineState -> InlineState -> InlineState
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InlineState -> InlineState -> InlineState
$cmin :: InlineState -> InlineState -> InlineState
max :: InlineState -> InlineState -> InlineState
$cmax :: InlineState -> InlineState -> InlineState
>= :: InlineState -> InlineState -> Bool
$c>= :: InlineState -> InlineState -> Bool
> :: InlineState -> InlineState -> Bool
$c> :: InlineState -> InlineState -> Bool
<= :: InlineState -> InlineState -> Bool
$c<= :: InlineState -> InlineState -> Bool
< :: InlineState -> InlineState -> Bool
$c< :: InlineState -> InlineState -> Bool
compare :: InlineState -> InlineState -> Ordering
$ccompare :: InlineState -> InlineState -> Ordering
$cp1Ord :: Eq InlineState
Ord, Int -> InlineState -> ShowS
[InlineState] -> ShowS
InlineState -> String
(Int -> InlineState -> ShowS)
-> (InlineState -> String)
-> ([InlineState] -> ShowS)
-> Show InlineState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InlineState] -> ShowS
$cshowList :: [InlineState] -> ShowS
show :: InlineState -> String
$cshow :: InlineState -> String
showsPrec :: Int -> InlineState -> ShowS
$cshowsPrec :: Int -> InlineState -> ShowS
Show)
parse ::
FilePath ->
Text ->
Either (ParseErrorBundle Text MMarkErr) MMark
parse :: String -> Text -> Either (ParseErrorBundle Text MMarkErr) MMark
parse String
file Text
input =
case BParser (Maybe Value, [Block Isp])
-> String
-> Text
-> Either
(ParseErrorBundle Text MMarkErr) ((Maybe Value, [Block Isp]), Defs)
forall a.
BParser a
-> String
-> Text
-> Either (ParseErrorBundle Text MMarkErr) (a, Defs)
runBParser BParser (Maybe Value, [Block Isp])
pMMark String
file Text
input of
Left ParseErrorBundle Text MMarkErr
bundle -> ParseErrorBundle Text MMarkErr
-> Either (ParseErrorBundle Text MMarkErr) MMark
forall a b. a -> Either a b
Left ParseErrorBundle Text MMarkErr
bundle
Right ((Maybe Value
myaml, [Block Isp]
rawBlocks), Defs
defs) ->
let parsed :: [Block (Either (ParseError Text MMarkErr) (NonEmpty Inline))]
parsed = Block Isp
-> Block (Either (ParseError Text MMarkErr) (NonEmpty Inline))
doInline (Block Isp
-> Block (Either (ParseError Text MMarkErr) (NonEmpty Inline)))
-> [Block Isp]
-> [Block (Either (ParseError Text MMarkErr) (NonEmpty Inline))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block Isp]
rawBlocks
doInline :: Block Isp
-> Block (Either (ParseError Text MMarkErr) (NonEmpty Inline))
doInline =
(Isp -> Either (ParseError Text MMarkErr) (NonEmpty Inline))
-> Block Isp
-> Block (Either (ParseError Text MMarkErr) (NonEmpty Inline))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Isp -> Either (ParseError Text MMarkErr) (NonEmpty Inline))
-> Block Isp
-> Block (Either (ParseError Text MMarkErr) (NonEmpty Inline)))
-> (Isp -> Either (ParseError Text MMarkErr) (NonEmpty Inline))
-> Block Isp
-> Block (Either (ParseError Text MMarkErr) (NonEmpty Inline))
forall a b. (a -> b) -> a -> b
$
(ParseError Text MMarkErr -> ParseError Text MMarkErr)
-> Either (ParseError Text MMarkErr) (NonEmpty Inline)
-> Either (ParseError Text MMarkErr) (NonEmpty Inline)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> ParseError Text MMarkErr -> ParseError Text MMarkErr
forall e.
Show e =>
String -> ParseError Text e -> ParseError Text e
replaceEof String
"end of inline block")
(Either (ParseError Text MMarkErr) (NonEmpty Inline)
-> Either (ParseError Text MMarkErr) (NonEmpty Inline))
-> (Isp -> Either (ParseError Text MMarkErr) (NonEmpty Inline))
-> Isp
-> Either (ParseError Text MMarkErr) (NonEmpty Inline)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defs
-> IParser (NonEmpty Inline)
-> Isp
-> Either (ParseError Text MMarkErr) (NonEmpty Inline)
forall a.
Defs -> IParser a -> Isp -> Either (ParseError Text MMarkErr) a
runIParser Defs
defs IParser (NonEmpty Inline)
pInlinesTop
e2p :: Either a b -> DList a
e2p = (a -> DList a) -> (b -> DList a) -> Either a b -> DList a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> DList a
forall a. a -> DList a
DList.singleton (DList a -> b -> DList a
forall a b. a -> b -> a
const DList a
forall a. DList a
DList.empty)
in case [ParseError Text MMarkErr]
-> Maybe (NonEmpty (ParseError Text MMarkErr))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([ParseError Text MMarkErr]
-> Maybe (NonEmpty (ParseError Text MMarkErr)))
-> (DList (ParseError Text MMarkErr) -> [ParseError Text MMarkErr])
-> DList (ParseError Text MMarkErr)
-> Maybe (NonEmpty (ParseError Text MMarkErr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList (ParseError Text MMarkErr) -> [ParseError Text MMarkErr]
forall a. DList a -> [a]
DList.toList (DList (ParseError Text MMarkErr)
-> Maybe (NonEmpty (ParseError Text MMarkErr)))
-> DList (ParseError Text MMarkErr)
-> Maybe (NonEmpty (ParseError Text MMarkErr))
forall a b. (a -> b) -> a -> b
$ (Block (Either (ParseError Text MMarkErr) (NonEmpty Inline))
-> DList (ParseError Text MMarkErr))
-> [Block (Either (ParseError Text MMarkErr) (NonEmpty Inline))]
-> DList (ParseError Text MMarkErr)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Either (ParseError Text MMarkErr) (NonEmpty Inline)
-> DList (ParseError Text MMarkErr))
-> Block (Either (ParseError Text MMarkErr) (NonEmpty Inline))
-> DList (ParseError Text MMarkErr)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Either (ParseError Text MMarkErr) (NonEmpty Inline)
-> DList (ParseError Text MMarkErr)
forall a b. Either a b -> DList a
e2p) [Block (Either (ParseError Text MMarkErr) (NonEmpty Inline))]
parsed of
Maybe (NonEmpty (ParseError Text MMarkErr))
Nothing ->
MMark -> Either (ParseErrorBundle Text MMarkErr) MMark
forall a b. b -> Either a b
Right
MMark :: Maybe Value -> [Bni] -> Extension -> MMark
MMark
{ mmarkYaml :: Maybe Value
mmarkYaml = Maybe Value
myaml,
mmarkBlocks :: [Bni]
mmarkBlocks = (Either (ParseError Text MMarkErr) (NonEmpty Inline)
-> NonEmpty Inline)
-> Block (Either (ParseError Text MMarkErr) (NonEmpty Inline))
-> Bni
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either (ParseError Text MMarkErr) (NonEmpty Inline)
-> NonEmpty Inline
forall a b. Either a b -> b
fromRight (Block (Either (ParseError Text MMarkErr) (NonEmpty Inline))
-> Bni)
-> [Block (Either (ParseError Text MMarkErr) (NonEmpty Inline))]
-> [Bni]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block (Either (ParseError Text MMarkErr) (NonEmpty Inline))]
parsed,
mmarkExtension :: Extension
mmarkExtension = Extension
forall a. Monoid a => a
mempty
}
Just NonEmpty (ParseError Text MMarkErr)
errs ->
ParseErrorBundle Text MMarkErr
-> Either (ParseErrorBundle Text MMarkErr) MMark
forall a b. a -> Either a b
Left
ParseErrorBundle :: forall s e.
NonEmpty (ParseError s e) -> PosState s -> ParseErrorBundle s e
ParseErrorBundle
{ bundleErrors :: NonEmpty (ParseError Text MMarkErr)
bundleErrors = NonEmpty (ParseError Text MMarkErr)
errs,
bundlePosState :: PosState Text
bundlePosState =
PosState :: forall s. s -> Int -> SourcePos -> Pos -> String -> PosState s
PosState
{ pstateInput :: Text
pstateInput = Text
input,
pstateOffset :: Int
pstateOffset = Int
0,
pstateSourcePos :: SourcePos
pstateSourcePos = String -> SourcePos
initialPos String
file,
pstateTabWidth :: Pos
pstateTabWidth = Int -> Pos
mkPos Int
4,
pstateLinePrefix :: String
pstateLinePrefix = String
""
}
}
pMMark :: BParser (Maybe Aeson.Value, [Block Isp])
pMMark :: BParser (Maybe Value, [Block Isp])
pMMark = do
Maybe (Either (Int, String) Value)
meyaml <- ParsecT
MMarkErr Text (State BlockState) (Either (Int, String) Value)
-> ParsecT
MMarkErr
Text
(State BlockState)
(Maybe (Either (Int, String) Value))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT
MMarkErr Text (State BlockState) (Either (Int, String) Value)
pYamlBlock
[Block Isp]
blocks <- BParser [Block Isp]
pBlocks
ParsecT MMarkErr Text (State BlockState) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
(Maybe Value, [Block Isp]) -> BParser (Maybe Value, [Block Isp])
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe Value, [Block Isp]) -> BParser (Maybe Value, [Block Isp]))
-> (Maybe Value, [Block Isp]) -> BParser (Maybe Value, [Block Isp])
forall a b. (a -> b) -> a -> b
$ case Maybe (Either (Int, String) Value)
meyaml of
Maybe (Either (Int, String) Value)
Nothing ->
(Maybe Value
forall a. Maybe a
Nothing, [Block Isp]
blocks)
Just (Left (Int
o, String
err)) ->
(Maybe Value
forall a. Maybe a
Nothing, Int -> MMarkErr -> [Block Isp] -> [Block Isp]
prependErr Int
o (String -> MMarkErr
YamlParseError String
err) [Block Isp]
blocks)
Just (Right Value
yaml) ->
(Value -> Maybe Value
forall a. a -> Maybe a
Just Value
yaml, [Block Isp]
blocks)
pYamlBlock :: BParser (Either (Int, String) Aeson.Value)
pYamlBlock :: ParsecT
MMarkErr Text (State BlockState) (Either (Int, String) Value)
pYamlBlock = do
Tokens Text
-> ParsecT MMarkErr Text (State BlockState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"---" ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc' ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
eol
let go :: ([Text] -> c) -> m ([Text] -> c)
go [Text] -> c
acc = do
Text
l <- Maybe String -> (Token Text -> Bool) -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
notNewline
m (Maybe ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m () -> m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
eol)
Bool
e <- m Bool
forall e s (m :: * -> *). MonadParsec e s m => m Bool
atEnd
if Bool
e Bool -> Bool -> Bool
|| Text -> Text
T.stripEnd Text
l Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"---"
then ([Text] -> c) -> m ([Text] -> c)
forall (m :: * -> *) a. Monad m => a -> m a
return [Text] -> c
acc
else ([Text] -> c) -> m ([Text] -> c)
go ([Text] -> c
acc ([Text] -> c) -> ([Text] -> [Text]) -> [Text] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:))
Int
doffset <- ParsecT MMarkErr Text (State BlockState) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
[Text]
ls <- ([Text] -> [Text])
-> ParsecT MMarkErr Text (State BlockState) ([Text] -> [Text])
forall (m :: * -> *) e c.
MonadParsec e Text m =>
([Text] -> c) -> m ([Text] -> c)
go [Text] -> [Text]
forall a. a -> a
id ParsecT MMarkErr Text (State BlockState) ([Text] -> [Text])
-> ParsecT MMarkErr Text (State BlockState) [Text]
-> ParsecT MMarkErr Text (State BlockState) [Text]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([] [Text]
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) [Text]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc)
Either (Int, String) Value
-> ParsecT
MMarkErr Text (State BlockState) (Either (Int, String) Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Int, String) Value
-> ParsecT
MMarkErr Text (State BlockState) (Either (Int, String) Value))
-> Either (Int, String) Value
-> ParsecT
MMarkErr Text (State BlockState) (Either (Int, String) Value)
forall a b. (a -> b) -> a -> b
$ [Text] -> Int -> Either (Int, String) Value
decodeYaml [Text]
ls Int
doffset
pBlocks :: BParser [Block Isp]
pBlocks :: BParser [Block Isp]
pBlocks = [Maybe (Block Isp)] -> [Block Isp]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Block Isp)] -> [Block Isp])
-> ParsecT MMarkErr Text (State BlockState) [Maybe (Block Isp)]
-> BParser [Block Isp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
-> ParsecT MMarkErr Text (State BlockState) [Maybe (Block Isp)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
pBlock
pBlock :: BParser (Maybe (Block Isp))
pBlock :: ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
pBlock = do
ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc
Pos
rlevel <- BParser Pos
refLevel
Pos
alevel <- BParser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
Bool
done <- ParsecT MMarkErr Text (State BlockState) Bool
forall e s (m :: * -> *). MonadParsec e s m => m Bool
atEnd
if Bool
done Bool -> Bool -> Bool
|| Pos
alevel Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
< Pos
rlevel
then ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
forall (f :: * -> *) a. Alternative f => f a
empty
else case Pos -> Pos -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Pos
alevel (Pos -> Pos
ilevel Pos
rlevel) of
Ordering
LT ->
[ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))]
-> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ Block Isp -> Maybe (Block Isp)
forall a. a -> Maybe a
Just (Block Isp -> Maybe (Block Isp))
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MMarkErr Text (State BlockState) (Block Isp)
pThematicBreak,
Block Isp -> Maybe (Block Isp)
forall a. a -> Maybe a
Just (Block Isp -> Maybe (Block Isp))
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MMarkErr Text (State BlockState) (Block Isp)
pAtxHeading,
Block Isp -> Maybe (Block Isp)
forall a. a -> Maybe a
Just (Block Isp -> Maybe (Block Isp))
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MMarkErr Text (State BlockState) (Block Isp)
pFencedCodeBlock,
Block Isp -> Maybe (Block Isp)
forall a. a -> Maybe a
Just (Block Isp -> Maybe (Block Isp))
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MMarkErr Text (State BlockState) (Block Isp)
pTable,
Block Isp -> Maybe (Block Isp)
forall a. a -> Maybe a
Just (Block Isp -> Maybe (Block Isp))
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MMarkErr Text (State BlockState) (Block Isp)
pUnorderedList,
Block Isp -> Maybe (Block Isp)
forall a. a -> Maybe a
Just (Block Isp -> Maybe (Block Isp))
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MMarkErr Text (State BlockState) (Block Isp)
pOrderedList,
Block Isp -> Maybe (Block Isp)
forall a. a -> Maybe a
Just (Block Isp -> Maybe (Block Isp))
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MMarkErr Text (State BlockState) (Block Isp)
pBlockquote,
ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
pReferenceDef,
Block Isp -> Maybe (Block Isp)
forall a. a -> Maybe a
Just (Block Isp -> Maybe (Block Isp))
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MMarkErr Text (State BlockState) (Block Isp)
pParagraph
]
Ordering
_ ->
Block Isp -> Maybe (Block Isp)
forall a. a -> Maybe a
Just (Block Isp -> Maybe (Block Isp))
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MMarkErr Text (State BlockState) (Block Isp)
pIndentedCodeBlock
pThematicBreak :: BParser (Block Isp)
pThematicBreak :: ParsecT MMarkErr Text (State BlockState) (Block Isp)
pThematicBreak = do
Text
l' <- ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ParsecT MMarkErr Text (State BlockState) Text
nonEmptyLine
let l :: Text
l = (Char -> Bool) -> Text -> Text
T.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) Text
l'
if Text -> Int
T.length Text
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3
Bool -> Bool -> Bool
&& ( (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*') Text
l
Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') Text
l
Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Text
l
)
then Block Isp
forall a. Block a
ThematicBreak Block Isp
-> ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT MMarkErr Text (State BlockState) Text
nonEmptyLine ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc
else ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall (f :: * -> *) a. Alternative f => f a
empty
pAtxHeading :: BParser (Block Isp)
pAtxHeading :: ParsecT MMarkErr Text (State BlockState) (Block Isp)
pAtxHeading = do
(ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) ())
-> (ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) String)
-> ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) String)
-> (ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) String)
-> ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) ParsecT MMarkErr Text (State BlockState) String
forall (m :: * -> *) e s.
(MonadParsec e s m, Token s ~ Char) =>
m String
hashIntro
(ParseError Text MMarkErr
-> ParsecT MMarkErr Text (State BlockState) (Block Isp))
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
(ParseError s e -> m a) -> m a -> m a
withRecovery ParseError Text MMarkErr
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall e (f :: * -> *).
MonadParsec e Text f =>
ParseError Text MMarkErr -> f (Block Isp)
recover (ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) (Block Isp))
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall a b. (a -> b) -> a -> b
$ do
Int
hlevel <- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int)
-> ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MMarkErr Text (State BlockState) String
forall (m :: * -> *) e s.
(MonadParsec e s m, Token s ~ Char) =>
m String
hashIntro
ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc1'
Int
ispOffset <- ParsecT MMarkErr Text (State BlockState) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
String
r <-
ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
someTill ((Token Text -> Bool)
-> ParsecT MMarkErr Text (State BlockState) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
notNewline ParsecT MMarkErr Text (State BlockState) Char
-> String -> ParsecT MMarkErr Text (State BlockState) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"heading character") (ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) String)
-> (ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ())
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) String)
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) String
forall a b. (a -> b) -> a -> b
$
ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc1' ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Token Text -> ParsecT MMarkErr Text (State BlockState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'#') ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc') ParsecT MMarkErr Text (State BlockState) (Maybe ())
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT MMarkErr Text (State BlockState) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
eol)
let toBlock :: Isp -> Block Isp
toBlock = case Int
hlevel of
Int
1 -> Isp -> Block Isp
forall a. a -> Block a
Heading1
Int
2 -> Isp -> Block Isp
forall a. a -> Block a
Heading2
Int
3 -> Isp -> Block Isp
forall a. a -> Block a
Heading3
Int
4 -> Isp -> Block Isp
forall a. a -> Block a
Heading4
Int
5 -> Isp -> Block Isp
forall a. a -> Block a
Heading5
Int
_ -> Isp -> Block Isp
forall a. a -> Block a
Heading6
Isp -> Block Isp
toBlock (Int -> Text -> Isp
IspSpan Int
ispOffset (Text -> Text
T.strip (String -> Text
T.pack String
r))) Block Isp
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc
where
hashIntro :: m String
hashIntro = Int -> Int -> m Char -> m String
forall (m :: * -> *) a. MonadPlus m => Int -> Int -> m a -> m [a]
count' Int
1 Int
6 (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'#')
recover :: ParseError Text MMarkErr -> f (Block Isp)
recover ParseError Text MMarkErr
err =
Isp -> Block Isp
forall a. a -> Block a
Heading1 (ParseError Text MMarkErr -> Isp
IspError ParseError Text MMarkErr
err) Block Isp -> f Text -> f (Block Isp)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe String -> (Token Text -> Bool) -> f (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
notNewline f (Block Isp) -> f () -> f (Block Isp)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* f ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc
pFencedCodeBlock :: BParser (Block Isp)
pFencedCodeBlock :: ParsecT MMarkErr Text (State BlockState) (Block Isp)
pFencedCodeBlock = do
Pos
alevel <- BParser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
(Char
ch, Int
n, Maybe Text
infoString) <- BParser (Char, Int, Maybe Text)
pOpeningFence
let content :: ParsecT MMarkErr Text (State BlockState) Text
content = String
-> ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"code block content" (Text
-> ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) Text
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Text
"" ParsecT MMarkErr Text (State BlockState) Text
nonEmptyLine ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
eol)
[Text]
ls <- ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) [Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT MMarkErr Text (State BlockState) Text
content (Char -> Int -> ParsecT MMarkErr Text (State BlockState) ()
pClosingFence Char
ch Int
n)
Maybe Text -> Text -> Block Isp
forall a. Maybe Text -> Text -> Block a
CodeBlock Maybe Text
infoString (Pos -> [Text] -> Text
assembleCodeBlock Pos
alevel [Text]
ls) Block Isp
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc
pOpeningFence :: BParser (Char, Int, Maybe Text)
pOpeningFence :: BParser (Char, Int, Maybe Text)
pOpeningFence = Char -> BParser (Char, Int, Maybe Text)
forall (m :: * -> *).
MonadParsec MMarkErr Text m =>
Char -> m (Char, Int, Maybe Text)
p Char
'`' BParser (Char, Int, Maybe Text)
-> BParser (Char, Int, Maybe Text)
-> BParser (Char, Int, Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> BParser (Char, Int, Maybe Text)
forall (m :: * -> *).
MonadParsec MMarkErr Text m =>
Char -> m (Char, Int, Maybe Text)
p Char
'~'
where
p :: Char -> m (Char, Int, Maybe Text)
p Char
ch = m (Char, Int, Maybe Text) -> m (Char, Int, Maybe Text)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m (Char, Int, Maybe Text) -> m (Char, Int, Maybe Text))
-> m (Char, Int, Maybe Text) -> m (Char, Int, Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
m String -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m String -> m ()) -> m String -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> m Char -> m String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
3 (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
ch)
Int
n <- (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Int -> Int) -> (String -> Int) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> m String -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char -> m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
ch)
Maybe Text
ml <-
m Text -> m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
(Text -> Text
T.strip (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> m Text
forall (m :: * -> *).
MonadParsec MMarkErr Text m =>
(Char -> Bool) -> m Text
someEscapedWith Char -> Bool
notNewline m Text -> String -> m Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"info string")
Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`')) Maybe Text
ml)
( Char
ch,
Int
n,
case Maybe Text
ml of
Maybe Text
Nothing -> Maybe Text
forall a. Maybe a
Nothing
Just Text
l ->
if Text -> Bool
T.null Text
l
then Maybe Text
forall a. Maybe a
Nothing
else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
l
)
(Char, Int, Maybe Text) -> m () -> m (Char, Int, Maybe Text)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
eol
pClosingFence :: Char -> Int -> BParser ()
pClosingFence :: Char -> Int -> ParsecT MMarkErr Text (State BlockState) ()
pClosingFence Char
ch Int
n = ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ())
-> (ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ())
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"closing code fence" (ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ())
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall a b. (a -> b) -> a -> b
$ do
Pos
clevel <- Pos -> Pos
ilevel (Pos -> Pos) -> BParser Pos -> BParser Pos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BParser Pos
refLevel
BParser Pos -> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BParser Pos -> ParsecT MMarkErr Text (State BlockState) ())
-> BParser Pos -> ParsecT MMarkErr Text (State BlockState) ()
forall a b. (a -> b) -> a -> b
$ ParsecT MMarkErr Text (State BlockState) ()
-> Ordering -> Pos -> BParser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m () -> Ordering -> Pos -> m Pos
L.indentGuard ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc' Ordering
LT Pos
clevel
ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) ())
-> ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) ()
forall a b. (a -> b) -> a -> b
$ Int
-> ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
n (Token Text -> ParsecT MMarkErr Text (State BlockState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
ch)
(ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) ())
-> (Char -> ParsecT MMarkErr Text (State BlockState) String)
-> Char
-> ParsecT MMarkErr Text (State BlockState) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) String)
-> (Char -> ParsecT MMarkErr Text (State BlockState) Char)
-> Char
-> ParsecT MMarkErr Text (State BlockState) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ParsecT MMarkErr Text (State BlockState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char) Char
ch
ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc'
ParsecT MMarkErr Text (State BlockState) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
eol
pIndentedCodeBlock :: BParser (Block Isp)
pIndentedCodeBlock :: ParsecT MMarkErr Text (State BlockState) (Block Isp)
pIndentedCodeBlock = do
Pos
alevel <- BParser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
Pos
clevel <- Pos -> Pos
ilevel (Pos -> Pos) -> BParser Pos -> BParser Pos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BParser Pos
refLevel
let go :: ([Text] -> [Text])
-> ParsecT MMarkErr Text (State BlockState) ([Text] -> [Text])
go [Text] -> [Text]
ls = do
Bool
indented <-
ParsecT MMarkErr Text (State BlockState) Bool
-> ParsecT MMarkErr Text (State BlockState) Bool
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT MMarkErr Text (State BlockState) Bool
-> ParsecT MMarkErr Text (State BlockState) Bool)
-> ParsecT MMarkErr Text (State BlockState) Bool
-> ParsecT MMarkErr Text (State BlockState) Bool
forall a b. (a -> b) -> a -> b
$
(Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
>= Pos
clevel) (Pos -> Bool)
-> BParser Pos -> ParsecT MMarkErr Text (State BlockState) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc ParsecT MMarkErr Text (State BlockState) ()
-> BParser Pos -> BParser Pos
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BParser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel)
if Bool
indented
then do
Text
l <- Text
-> ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) Text
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Text
"" ParsecT MMarkErr Text (State BlockState) Text
nonEmptyLine
Bool
continue <- ParsecT MMarkErr Text (State BlockState) Bool
forall e (m :: * -> *). MonadParsec e Text m => m Bool
eol'
let ls' :: [Text] -> [Text]
ls' = [Text] -> [Text]
ls ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
if Bool
continue
then ([Text] -> [Text])
-> ParsecT MMarkErr Text (State BlockState) ([Text] -> [Text])
go [Text] -> [Text]
ls'
else ([Text] -> [Text])
-> ParsecT MMarkErr Text (State BlockState) ([Text] -> [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return [Text] -> [Text]
ls'
else ([Text] -> [Text])
-> ParsecT MMarkErr Text (State BlockState) ([Text] -> [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return [Text] -> [Text]
ls
f :: Text -> Text
f Text
x = Int -> Text -> Text
T.replicate (Pos -> Int
unPos Pos
alevel Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x
g :: [Text] -> [Text]
g [] = []
g (Text
x : [Text]
xs) = Text -> Text
f Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
xs
[Text]
ls <- [Text] -> [Text]
g ([Text] -> [Text])
-> (([Text] -> [Text]) -> [Text]) -> ([Text] -> [Text]) -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ []) (([Text] -> [Text]) -> [Text])
-> ParsecT MMarkErr Text (State BlockState) ([Text] -> [Text])
-> ParsecT MMarkErr Text (State BlockState) [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text] -> [Text])
-> ParsecT MMarkErr Text (State BlockState) ([Text] -> [Text])
go [Text] -> [Text]
forall a. a -> a
id
Maybe Text -> Text -> Block Isp
forall a. Maybe Text -> Text -> Block a
CodeBlock Maybe Text
forall a. Maybe a
Nothing (Pos -> [Text] -> Text
assembleCodeBlock Pos
clevel [Text]
ls) Block Isp
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc
pUnorderedList :: BParser (Block Isp)
pUnorderedList :: ParsecT MMarkErr Text (State BlockState) (Block Isp)
pUnorderedList = do
(Char
bullet, SourcePos
bulletPos, Pos
minLevel, Pos
indLevel) <-
Maybe (Char, SourcePos) -> BParser (Char, SourcePos, Pos, Pos)
pListBullet Maybe (Char, SourcePos)
forall a. Maybe a
Nothing
[Block Isp]
x <- SourcePos -> Pos -> Pos -> BParser [Block Isp]
innerBlocks SourcePos
bulletPos Pos
minLevel Pos
indLevel
[[Block Isp]]
xs <- BParser [Block Isp]
-> ParsecT MMarkErr Text (State BlockState) [[Block Isp]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (BParser [Block Isp]
-> ParsecT MMarkErr Text (State BlockState) [[Block Isp]])
-> BParser [Block Isp]
-> ParsecT MMarkErr Text (State BlockState) [[Block Isp]]
forall a b. (a -> b) -> a -> b
$ do
(Char
_, SourcePos
bulletPos', Pos
minLevel', Pos
indLevel') <-
Maybe (Char, SourcePos) -> BParser (Char, SourcePos, Pos, Pos)
pListBullet ((Char, SourcePos) -> Maybe (Char, SourcePos)
forall a. a -> Maybe a
Just (Char
bullet, SourcePos
bulletPos))
SourcePos -> Pos -> Pos -> BParser [Block Isp]
innerBlocks SourcePos
bulletPos' Pos
minLevel' Pos
indLevel'
Block Isp -> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty [Block Isp] -> Block Isp
forall a. NonEmpty [Block a] -> Block a
UnorderedList (NonEmpty [Block Isp] -> NonEmpty [Block Isp]
normalizeListItems ([Block Isp]
x [Block Isp] -> [[Block Isp]] -> NonEmpty [Block Isp]
forall a. a -> [a] -> NonEmpty a
:| [[Block Isp]]
xs)))
where
innerBlocks :: SourcePos -> Pos -> Pos -> BParser [Block Isp]
innerBlocks SourcePos
bulletPos Pos
minLevel Pos
indLevel = do
SourcePos
p <- ParsecT MMarkErr Text (State BlockState) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
let tooFar :: Bool
tooFar = SourcePos -> Pos
sourceLine SourcePos
p Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> SourcePos -> Pos
sourceLine SourcePos
bulletPos Pos -> Pos -> Pos
forall a. Semigroup a => a -> a -> a
<> Pos
pos1
rlevel :: Pos
rlevel = Pos -> Pos -> Pos
slevel Pos
minLevel Pos
indLevel
if Bool
tooFar Bool -> Bool -> Bool
|| SourcePos -> Pos
sourceColumn SourcePos
p Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
< Pos
minLevel
then [Block Isp] -> BParser [Block Isp]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Isp -> Block Isp)
-> (Isp -> Block Isp) -> Bool -> Isp -> Block Isp
forall a. a -> a -> Bool -> a
bool Isp -> Block Isp
forall a. a -> Block a
Naked Isp -> Block Isp
forall a. a -> Block a
Paragraph Bool
tooFar Isp
emptyIspSpan]
else Bool -> Pos -> BParser [Block Isp] -> BParser [Block Isp]
forall a. Bool -> Pos -> BParser a -> BParser a
subEnv Bool
True Pos
rlevel BParser [Block Isp]
pBlocks
pListBullet ::
Maybe (Char, SourcePos) ->
BParser (Char, SourcePos, Pos, Pos)
pListBullet :: Maybe (Char, SourcePos) -> BParser (Char, SourcePos, Pos, Pos)
pListBullet Maybe (Char, SourcePos)
mbullet = BParser (Char, SourcePos, Pos, Pos)
-> BParser (Char, SourcePos, Pos, Pos)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (BParser (Char, SourcePos, Pos, Pos)
-> BParser (Char, SourcePos, Pos, Pos))
-> BParser (Char, SourcePos, Pos, Pos)
-> BParser (Char, SourcePos, Pos, Pos)
forall a b. (a -> b) -> a -> b
$ do
SourcePos
pos <- ParsecT MMarkErr Text (State BlockState) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
Pos
l <- (Pos -> Pos -> Pos
forall a. Semigroup a => a -> a -> a
<> Int -> Pos
mkPos Int
2) (Pos -> Pos) -> BParser Pos -> BParser Pos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BParser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
Char
bullet <-
case Maybe (Char, SourcePos)
mbullet of
Maybe (Char, SourcePos)
Nothing -> Token Text -> ParsecT MMarkErr Text (State BlockState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-' ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT MMarkErr Text (State BlockState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'+' ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT MMarkErr Text (State BlockState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'*'
Just (Char
bullet, SourcePos
bulletPos) -> do
Bool -> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SourcePos -> Pos
sourceColumn SourcePos
pos Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
>= SourcePos -> Pos
sourceColumn SourcePos
bulletPos)
Token Text -> ParsecT MMarkErr Text (State BlockState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
bullet
ParsecT MMarkErr Text (State BlockState) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc1
Pos
l' <- BParser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
(Char, SourcePos, Pos, Pos) -> BParser (Char, SourcePos, Pos, Pos)
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
bullet, SourcePos
pos, Pos
l, Pos
l')
pOrderedList :: BParser (Block Isp)
pOrderedList :: ParsecT MMarkErr Text (State BlockState) (Block Isp)
pOrderedList = do
Int
startOffset <- ParsecT MMarkErr Text (State BlockState) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
(Word
startIx, Char
del, SourcePos
startPos, Pos
minLevel, Pos
indLevel) <-
Maybe (Char, SourcePos)
-> BParser (Word, Char, SourcePos, Pos, Pos)
pListIndex Maybe (Char, SourcePos)
forall a. Maybe a
Nothing
[Block Isp]
x <- SourcePos -> Pos -> Pos -> BParser [Block Isp]
innerBlocks SourcePos
startPos Pos
minLevel Pos
indLevel
[[Block Isp]]
xs <- Word
-> (Word -> BParser [Block Isp])
-> ParsecT MMarkErr Text (State BlockState) [[Block Isp]]
forall (m :: * -> *) n a.
(Alternative m, Num n) =>
n -> (n -> m a) -> m [a]
manyIndexed (Word
startIx Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1) ((Word -> BParser [Block Isp])
-> ParsecT MMarkErr Text (State BlockState) [[Block Isp]])
-> (Word -> BParser [Block Isp])
-> ParsecT MMarkErr Text (State BlockState) [[Block Isp]]
forall a b. (a -> b) -> a -> b
$ \Word
expectedIx -> do
Int
startOffset' <- ParsecT MMarkErr Text (State BlockState) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
(Word
actualIx, Char
_, SourcePos
startPos', Pos
minLevel', Pos
indLevel') <-
Maybe (Char, SourcePos)
-> BParser (Word, Char, SourcePos, Pos, Pos)
pListIndex ((Char, SourcePos) -> Maybe (Char, SourcePos)
forall a. a -> Maybe a
Just (Char
del, SourcePos
startPos))
let f :: [Block Isp] -> [Block Isp]
f [Block Isp]
blocks =
if Word
actualIx Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
expectedIx
then [Block Isp]
blocks
else
Int -> MMarkErr -> [Block Isp] -> [Block Isp]
prependErr
Int
startOffset'
(Word -> Word -> MMarkErr
ListIndexOutOfOrder Word
actualIx Word
expectedIx)
[Block Isp]
blocks
[Block Isp] -> [Block Isp]
f ([Block Isp] -> [Block Isp])
-> BParser [Block Isp] -> BParser [Block Isp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourcePos -> Pos -> Pos -> BParser [Block Isp]
innerBlocks SourcePos
startPos' Pos
minLevel' Pos
indLevel'
Block Isp -> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall (m :: * -> *) a. Monad m => a -> m a
return (Block Isp -> ParsecT MMarkErr Text (State BlockState) (Block Isp))
-> (NonEmpty [Block Isp] -> Block Isp)
-> NonEmpty [Block Isp]
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> NonEmpty [Block Isp] -> Block Isp
forall a. Word -> NonEmpty [Block a] -> Block a
OrderedList Word
startIx (NonEmpty [Block Isp] -> Block Isp)
-> (NonEmpty [Block Isp] -> NonEmpty [Block Isp])
-> NonEmpty [Block Isp]
-> Block Isp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty [Block Isp] -> NonEmpty [Block Isp]
normalizeListItems (NonEmpty [Block Isp]
-> ParsecT MMarkErr Text (State BlockState) (Block Isp))
-> NonEmpty [Block Isp]
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall a b. (a -> b) -> a -> b
$
( if Word
startIx Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
999999999
then [Block Isp]
x
else Int -> MMarkErr -> [Block Isp] -> [Block Isp]
prependErr Int
startOffset (Word -> MMarkErr
ListStartIndexTooBig Word
startIx) [Block Isp]
x
)
[Block Isp] -> [[Block Isp]] -> NonEmpty [Block Isp]
forall a. a -> [a] -> NonEmpty a
:| [[Block Isp]]
xs
where
innerBlocks :: SourcePos -> Pos -> Pos -> BParser [Block Isp]
innerBlocks SourcePos
indexPos Pos
minLevel Pos
indLevel = do
SourcePos
p <- ParsecT MMarkErr Text (State BlockState) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
let tooFar :: Bool
tooFar = SourcePos -> Pos
sourceLine SourcePos
p Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> SourcePos -> Pos
sourceLine SourcePos
indexPos Pos -> Pos -> Pos
forall a. Semigroup a => a -> a -> a
<> Pos
pos1
rlevel :: Pos
rlevel = Pos -> Pos -> Pos
slevel Pos
minLevel Pos
indLevel
if Bool
tooFar Bool -> Bool -> Bool
|| SourcePos -> Pos
sourceColumn SourcePos
p Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
< Pos
minLevel
then [Block Isp] -> BParser [Block Isp]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Isp -> Block Isp)
-> (Isp -> Block Isp) -> Bool -> Isp -> Block Isp
forall a. a -> a -> Bool -> a
bool Isp -> Block Isp
forall a. a -> Block a
Naked Isp -> Block Isp
forall a. a -> Block a
Paragraph Bool
tooFar Isp
emptyIspSpan]
else Bool -> Pos -> BParser [Block Isp] -> BParser [Block Isp]
forall a. Bool -> Pos -> BParser a -> BParser a
subEnv Bool
True Pos
rlevel BParser [Block Isp]
pBlocks
pListIndex ::
Maybe (Char, SourcePos) ->
BParser (Word, Char, SourcePos, Pos, Pos)
pListIndex :: Maybe (Char, SourcePos)
-> BParser (Word, Char, SourcePos, Pos, Pos)
pListIndex Maybe (Char, SourcePos)
mstart = BParser (Word, Char, SourcePos, Pos, Pos)
-> BParser (Word, Char, SourcePos, Pos, Pos)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (BParser (Word, Char, SourcePos, Pos, Pos)
-> BParser (Word, Char, SourcePos, Pos, Pos))
-> BParser (Word, Char, SourcePos, Pos, Pos)
-> BParser (Word, Char, SourcePos, Pos, Pos)
forall a b. (a -> b) -> a -> b
$ do
SourcePos
pos <- ParsecT MMarkErr Text (State BlockState) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
Word
i <- ParsecT MMarkErr Text (State BlockState) Word
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal
Char
del <- case Maybe (Char, SourcePos)
mstart of
Maybe (Char, SourcePos)
Nothing -> Token Text -> ParsecT MMarkErr Text (State BlockState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.' ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT MMarkErr Text (State BlockState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')'
Just (Char
del, SourcePos
startPos) -> do
Bool -> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SourcePos -> Pos
sourceColumn SourcePos
pos Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
>= SourcePos -> Pos
sourceColumn SourcePos
startPos)
Token Text -> ParsecT MMarkErr Text (State BlockState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
del
Pos
l <- (Pos -> Pos -> Pos
forall a. Semigroup a => a -> a -> a
<> Pos
pos1) (Pos -> Pos) -> BParser Pos -> BParser Pos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BParser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
ParsecT MMarkErr Text (State BlockState) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc1
Pos
l' <- BParser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
(Word, Char, SourcePos, Pos, Pos)
-> BParser (Word, Char, SourcePos, Pos, Pos)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word
i, Char
del, SourcePos
pos, Pos
l, Pos
l')
pBlockquote :: BParser (Block Isp)
pBlockquote :: ParsecT MMarkErr Text (State BlockState) (Block Isp)
pBlockquote = do
Pos
minLevel <- BParser Pos -> BParser Pos
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (BParser Pos -> BParser Pos) -> BParser Pos -> BParser Pos
forall a b. (a -> b) -> a -> b
$ do
Pos
minLevel <- (Pos -> Pos -> Pos
forall a. Semigroup a => a -> a -> a
<> Pos
pos1) (Pos -> Pos) -> BParser Pos -> BParser Pos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BParser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text -> ParsecT MMarkErr Text (State BlockState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'>')
ParsecT MMarkErr Text (State BlockState) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc
Pos
l <- BParser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
Pos -> BParser Pos
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> BParser Pos) -> Pos -> BParser Pos
forall a b. (a -> b) -> a -> b
$
if Pos
l Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> Pos
minLevel
then Pos
minLevel Pos -> Pos -> Pos
forall a. Semigroup a => a -> a -> a
<> Pos
pos1
else Pos
minLevel
Pos
indLevel <- BParser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
if Pos
indLevel Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
>= Pos
minLevel
then do
let rlevel :: Pos
rlevel = Pos -> Pos -> Pos
slevel Pos
minLevel Pos
indLevel
[Block Isp]
xs <- Bool -> Pos -> BParser [Block Isp] -> BParser [Block Isp]
forall a. Bool -> Pos -> BParser a -> BParser a
subEnv Bool
False Pos
rlevel BParser [Block Isp]
pBlocks
Block Isp -> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block Isp] -> Block Isp
forall a. [Block a] -> Block a
Blockquote [Block Isp]
xs)
else Block Isp -> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block Isp] -> Block Isp
forall a. [Block a] -> Block a
Blockquote [])
pReferenceDef :: BParser (Maybe (Block Isp))
pReferenceDef :: ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
pReferenceDef = do
(Int
o, Text
dlabel) <- ParsecT MMarkErr Text (State BlockState) (Int, Text)
-> ParsecT MMarkErr Text (State BlockState) (Int, Text)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT MMarkErr Text (State BlockState) (Int, Text)
forall (m :: * -> *). MonadParsec MMarkErr Text m => m (Int, Text)
pRefLabel ParsecT MMarkErr Text (State BlockState) (Int, Text)
-> ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) (Int, Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT MMarkErr Text (State BlockState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':')
(ParseError Text MMarkErr
-> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp)))
-> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
-> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
forall e s (m :: * -> *) a.
MonadParsec e s m =>
(ParseError s e -> m a) -> m a -> m a
withRecovery ParseError Text MMarkErr
-> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
forall e (f :: * -> *).
MonadParsec e Text f =>
ParseError Text MMarkErr -> f (Maybe (Block Isp))
recover (ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
-> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp)))
-> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
-> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
forall a b. (a -> b) -> a -> b
$ do
ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc' ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) (Maybe ())
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
eol ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc'
URI
uri <- ParsecT MMarkErr Text (State BlockState) URI
forall e (m :: * -> *).
(Ord e, Show e, MonadParsec e Text m) =>
m URI
pUri
Maybe Bool
hadSpN <-
ParsecT MMarkErr Text (State BlockState) Bool
-> ParsecT MMarkErr Text (State BlockState) (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT MMarkErr Text (State BlockState) Bool
-> ParsecT MMarkErr Text (State BlockState) (Maybe Bool))
-> ParsecT MMarkErr Text (State BlockState) Bool
-> ParsecT MMarkErr Text (State BlockState) (Maybe Bool)
forall a b. (a -> b) -> a -> b
$
(ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc1' ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) Bool
-> ParsecT MMarkErr Text (State BlockState) Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool
-> ParsecT MMarkErr Text (State BlockState) Bool
-> ParsecT MMarkErr Text (State BlockState) Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True Bool
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
eol)) ParsecT MMarkErr Text (State BlockState) Bool
-> ParsecT MMarkErr Text (State BlockState) Bool
-> ParsecT MMarkErr Text (State BlockState) Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool
True Bool
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc' ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
eol))
ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc'
Maybe Text
mtitle <-
if Maybe Bool -> Bool
forall a. Maybe a -> Bool
isJust Maybe Bool
hadSpN
then ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT MMarkErr Text (State BlockState) Text
forall (m :: * -> *). MonadParsec MMarkErr Text m => m Text
pTitle ParsecT MMarkErr Text (State BlockState) (Maybe Text)
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) (Maybe Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc'
else Maybe Text -> ParsecT MMarkErr Text (State BlockState) (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
case (Maybe Bool
hadSpN, Maybe Text
mtitle) of
(Just Bool
True, Maybe Text
Nothing) -> () -> ParsecT MMarkErr Text (State BlockState) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Maybe Bool, Maybe Text)
_ -> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden ParsecT MMarkErr Text (State BlockState) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
eol
Bool
conflict <- Text
-> (URI, Maybe Text)
-> ParsecT MMarkErr Text (State BlockState) Bool
registerReference Text
dlabel (URI
uri, Maybe Text
mtitle)
Bool
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
conflict (ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ())
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall a b. (a -> b) -> a -> b
$
Int -> MMarkErr -> ParsecT MMarkErr Text (State BlockState) ()
forall (m :: * -> *) a.
MonadParsec MMarkErr Text m =>
Int -> MMarkErr -> m a
customFailure' Int
o (Text -> MMarkErr
DuplicateReferenceDefinition Text
dlabel)
Maybe (Block Isp)
forall a. Maybe a
Nothing Maybe (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) (Maybe (Block Isp))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc
where
recover :: ParseError Text MMarkErr -> f (Maybe (Block Isp))
recover ParseError Text MMarkErr
err =
Block Isp -> Maybe (Block Isp)
forall a. a -> Maybe a
Just (Isp -> Block Isp
forall a. a -> Block a
Naked (ParseError Text MMarkErr -> Isp
IspError ParseError Text MMarkErr
err)) Maybe (Block Isp) -> f Text -> f (Maybe (Block Isp))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe String -> (Token Text -> Bool) -> f (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
notNewline f (Maybe (Block Isp)) -> f () -> f (Maybe (Block Isp))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* f ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc
pTable :: BParser (Block Isp)
pTable :: ParsecT MMarkErr Text (State BlockState) (Block Isp)
pTable = do
(Int
n, NonEmpty Isp
headerRow) <- ParsecT MMarkErr Text (State BlockState) (Int, NonEmpty Isp)
-> ParsecT MMarkErr Text (State BlockState) (Int, NonEmpty Isp)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT MMarkErr Text (State BlockState) (Int, NonEmpty Isp)
-> ParsecT MMarkErr Text (State BlockState) (Int, NonEmpty Isp))
-> ParsecT MMarkErr Text (State BlockState) (Int, NonEmpty Isp)
-> ParsecT MMarkErr Text (State BlockState) (Int, NonEmpty Isp)
forall a b. (a -> b) -> a -> b
$ do
Pos
pos <- BParser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
Bool
-> ParsecT MMarkErr Text (State BlockState) Bool
-> ParsecT MMarkErr Text (State BlockState) Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False ((Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|') (Text -> Bool)
-> ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ParsecT MMarkErr Text (State BlockState) Text
nonEmptyLine) ParsecT MMarkErr Text (State BlockState) Bool
-> (Bool -> ParsecT MMarkErr Text (State BlockState) ())
-> ParsecT MMarkErr Text (State BlockState) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard
let pipe' :: m Bool
pipe' = Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True Bool -> m Char -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m Char
forall e (f :: * -> *). MonadParsec e Text f => f Char
pipe)
Bool
l <- ParsecT MMarkErr Text (State BlockState) Bool
forall (m :: * -> *) e. MonadParsec e Text m => m Bool
pipe'
NonEmpty Isp
headerRow <- ParsecT MMarkErr Text (State BlockState) Isp
-> ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) (NonEmpty Isp)
forall (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (NonEmpty a)
NE.sepBy1 ParsecT MMarkErr Text (State BlockState) Isp
cell (ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT MMarkErr Text (State BlockState) Char
forall e (f :: * -> *). MonadParsec e Text f => f Char
pipe ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
eol))
Bool
r <- ParsecT MMarkErr Text (State BlockState) Bool
forall (m :: * -> *) e. MonadParsec e Text m => m Bool
pipe'
let n :: Int
n = NonEmpty Isp -> Int
forall a. NonEmpty a -> Int
NE.length NonEmpty Isp
headerRow
Bool -> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
|| Bool
l Bool -> Bool -> Bool
|| Bool
r)
ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
eol ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc'
BParser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel BParser Pos
-> (Pos -> ParsecT MMarkErr Text (State BlockState) ())
-> ParsecT MMarkErr Text (State BlockState) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Pos
i -> Bool -> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Pos
i Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Pos
pos Bool -> Bool -> Bool
|| Pos
i Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== (Pos
pos Pos -> Pos -> Pos
forall a. Semigroup a => a -> a -> a
<> Pos
pos1))
ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ParsecT MMarkErr Text (State BlockState) Text
nonEmptyLine ParsecT MMarkErr Text (State BlockState) Text
-> (Text -> ParsecT MMarkErr Text (State BlockState) ())
-> ParsecT MMarkErr Text (State BlockState) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT MMarkErr Text (State BlockState) ())
-> (Text -> Bool)
-> Text
-> ParsecT MMarkErr Text (State BlockState) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
isHeaderLike
(Int, NonEmpty Isp)
-> ParsecT MMarkErr Text (State BlockState) (Int, NonEmpty Isp)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n, NonEmpty Isp
headerRow)
(ParseError Text MMarkErr
-> ParsecT MMarkErr Text (State BlockState) (Block Isp))
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
(ParseError s e -> m a) -> m a -> m a
withRecovery ParseError Text MMarkErr
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
recover (ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) (Block Isp))
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall a b. (a -> b) -> a -> b
$ do
ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc'
NonEmpty CellAlign
caligns <- ParsecT MMarkErr Text (State BlockState) (NonEmpty CellAlign)
-> ParsecT MMarkErr Text (State BlockState) (NonEmpty CellAlign)
forall e (m :: * -> *) b. MonadParsec e Text m => m b -> m b
rowWrapper ([CellAlign] -> NonEmpty CellAlign
forall a. [a] -> NonEmpty a
NE.fromList ([CellAlign] -> NonEmpty CellAlign)
-> ParsecT MMarkErr Text (State BlockState) [CellAlign]
-> ParsecT MMarkErr Text (State BlockState) (NonEmpty CellAlign)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ParsecT MMarkErr Text (State BlockState) CellAlign
-> ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) [CellAlign]
forall (m :: * -> *) a sep.
MonadPlus m =>
Int -> m a -> m sep -> m [a]
sepByCount Int
n ParsecT MMarkErr Text (State BlockState) CellAlign
forall e (m :: * -> *). MonadParsec e Text m => m CellAlign
calign ParsecT MMarkErr Text (State BlockState) Char
forall e (f :: * -> *). MonadParsec e Text f => f Char
pipe)
[NonEmpty Isp]
otherRows <- ParsecT MMarkErr Text (State BlockState) (NonEmpty Isp)
-> ParsecT MMarkErr Text (State BlockState) [NonEmpty Isp]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT MMarkErr Text (State BlockState) (NonEmpty Isp)
-> ParsecT MMarkErr Text (State BlockState) [NonEmpty Isp])
-> ParsecT MMarkErr Text (State BlockState) (NonEmpty Isp)
-> ParsecT MMarkErr Text (State BlockState) [NonEmpty Isp]
forall a b. (a -> b) -> a -> b
$ do
ParsecT MMarkErr Text (State BlockState) Bool
endOfTable ParsecT MMarkErr Text (State BlockState) Bool
-> (Bool -> ParsecT MMarkErr Text (State BlockState) ())
-> ParsecT MMarkErr Text (State BlockState) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT MMarkErr Text (State BlockState) ())
-> (Bool -> Bool)
-> Bool
-> ParsecT MMarkErr Text (State BlockState) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not
ParsecT MMarkErr Text (State BlockState) (NonEmpty Isp)
-> ParsecT MMarkErr Text (State BlockState) (NonEmpty Isp)
forall e (m :: * -> *) b. MonadParsec e Text m => m b -> m b
rowWrapper ([Isp] -> NonEmpty Isp
forall a. [a] -> NonEmpty a
NE.fromList ([Isp] -> NonEmpty Isp)
-> ParsecT MMarkErr Text (State BlockState) [Isp]
-> ParsecT MMarkErr Text (State BlockState) (NonEmpty Isp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ParsecT MMarkErr Text (State BlockState) Isp
-> ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) [Isp]
forall (m :: * -> *) a sep.
MonadPlus m =>
Int -> m a -> m sep -> m [a]
sepByCount Int
n ParsecT MMarkErr Text (State BlockState) Isp
cell ParsecT MMarkErr Text (State BlockState) Char
forall e (f :: * -> *). MonadParsec e Text f => f Char
pipe)
NonEmpty CellAlign -> NonEmpty (NonEmpty Isp) -> Block Isp
forall a. NonEmpty CellAlign -> NonEmpty (NonEmpty a) -> Block a
Table NonEmpty CellAlign
caligns (NonEmpty Isp
headerRow NonEmpty Isp -> [NonEmpty Isp] -> NonEmpty (NonEmpty Isp)
forall a. a -> [a] -> NonEmpty a
:| [NonEmpty Isp]
otherRows) Block Isp
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc
where
cell :: ParsecT MMarkErr Text (State BlockState) Isp
cell = do
Int
o <- ParsecT MMarkErr Text (State BlockState) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Text
txt <-
(String -> Text)
-> ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text
T.stripEnd (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) Text)
-> ([ParsecT MMarkErr Text (State BlockState) ShowS]
-> ParsecT MMarkErr Text (State BlockState) String)
-> [ParsecT MMarkErr Text (State BlockState) ShowS]
-> ParsecT MMarkErr Text (State BlockState) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT MMarkErr Text (State BlockState) ShowS
-> ParsecT MMarkErr Text (State BlockState) String
forall (m :: * -> *) a. MonadPlus m => m ([a] -> [a]) -> m [a]
foldMany' (ParsecT MMarkErr Text (State BlockState) ShowS
-> ParsecT MMarkErr Text (State BlockState) String)
-> ([ParsecT MMarkErr Text (State BlockState) ShowS]
-> ParsecT MMarkErr Text (State BlockState) ShowS)
-> [ParsecT MMarkErr Text (State BlockState) ShowS]
-> ParsecT MMarkErr Text (State BlockState) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsecT MMarkErr Text (State BlockState) ShowS]
-> ParsecT MMarkErr Text (State BlockState) ShowS
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT MMarkErr Text (State BlockState) ShowS]
-> ParsecT MMarkErr Text (State BlockState) Text)
-> [ParsecT MMarkErr Text (State BlockState) ShowS]
-> ParsecT MMarkErr Text (State BlockState) Text
forall a b. (a -> b) -> a -> b
$
[ String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (String -> ShowS) -> (Text -> String) -> Text -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> ShowS)
-> ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (Tokens Text
-> ParsecT MMarkErr Text (State BlockState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\\|"),
String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (String -> ShowS) -> (Text -> String) -> Text -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> ShowS)
-> ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MMarkErr Text (State BlockState) Text
pCodeSpanB,
(:) (Char -> ShowS)
-> ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"inline content" ((Token Text -> Bool)
-> ParsecT MMarkErr Text (State BlockState) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
cellChar)
]
Isp -> ParsecT MMarkErr Text (State BlockState) Isp
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Text -> Isp
IspSpan Int
o Text
txt)
cellChar :: Char -> Bool
cellChar Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'|' Bool -> Bool -> Bool
&& Char -> Bool
notNewline Char
x
rowWrapper :: m b -> m b
rowWrapper m b
p = do
m (Maybe Char) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Char -> m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Char
forall e (f :: * -> *). MonadParsec e Text f => f Char
pipe)
b
r <- m b
p
m (Maybe Char) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Char -> m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Char
forall e (f :: * -> *). MonadParsec e Text f => f Char
pipe)
m ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof m () -> m () -> m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
eol
m ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc'
b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r
pipe :: f Char
pipe = Token Text -> f (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'|' f Char -> f () -> f Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* f ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc'
calign :: m CellAlign
calign = do
let colon' :: m Bool
colon' = Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True Bool -> m Char -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
':')
Bool
l <- m Bool
forall (m :: * -> *) e s.
(MonadParsec e s m, Token s ~ Char) =>
m Bool
colon'
m String -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Int -> m Char -> m String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
3 (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-') m String -> m String -> m String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m Char -> m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-'))
Bool
r <- m Bool
forall (m :: * -> *) e s.
(MonadParsec e s m, Token s ~ Char) =>
m Bool
colon'
m ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc'
CellAlign -> m CellAlign
forall (m :: * -> *) a. Monad m => a -> m a
return (CellAlign -> m CellAlign) -> CellAlign -> m CellAlign
forall a b. (a -> b) -> a -> b
$
case (Bool
l, Bool
r) of
(Bool
False, Bool
False) -> CellAlign
CellAlignDefault
(Bool
True, Bool
False) -> CellAlign
CellAlignLeft
(Bool
False, Bool
True) -> CellAlign
CellAlignRight
(Bool
True, Bool
True) -> CellAlign
CellAlignCenter
isHeaderLike :: Text -> Bool
isHeaderLike Text
txt =
Text -> Int
T.length ((Char -> Bool) -> Text -> Text
T.filter Char -> Bool
isHeaderConstituent Text
txt) Int -> Int -> Ratio Int
forall a. Integral a => a -> a -> Ratio a
% Text -> Int
T.length Text
txt
Ratio Int -> Ratio Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
8 Int -> Int -> Ratio Int
forall a. Integral a => a -> a -> Ratio a
% Int
10
isHeaderConstituent :: Char -> Bool
isHeaderConstituent Char
x =
Char -> Bool
isSpace Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':'
endOfTable :: ParsecT MMarkErr Text (State BlockState) Bool
endOfTable =
ParsecT MMarkErr Text (State BlockState) Bool
-> ParsecT MMarkErr Text (State BlockState) Bool
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Bool
-> ParsecT MMarkErr Text (State BlockState) Bool
-> ParsecT MMarkErr Text (State BlockState) Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
True (Text -> Bool
isBlank (Text -> Bool)
-> ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MMarkErr Text (State BlockState) Text
nonEmptyLine))
recover :: ParseError Text MMarkErr
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
recover ParseError Text MMarkErr
err =
Isp -> Block Isp
forall a. a -> Block a
Naked (ParseError Text MMarkErr -> Isp
IspError (String -> ParseError Text MMarkErr -> ParseError Text MMarkErr
forall e.
Show e =>
String -> ParseError Text e -> ParseError Text e
replaceEof String
"end of table block" ParseError Text MMarkErr
err))
Block Isp
-> ParsecT MMarkErr Text (State BlockState) [Maybe Text]
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT MMarkErr Text (State BlockState) (Maybe Text)
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) [Maybe Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill
(ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT MMarkErr Text (State BlockState) Text
nonEmptyLine)
(ParsecT MMarkErr Text (State BlockState) Bool
endOfTable ParsecT MMarkErr Text (State BlockState) Bool
-> (Bool -> ParsecT MMarkErr Text (State BlockState) ())
-> ParsecT MMarkErr Text (State BlockState) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard)
ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc
pParagraph :: BParser (Block Isp)
pParagraph :: ParsecT MMarkErr Text (State BlockState) (Block Isp)
pParagraph = do
Int
startOffset <- ParsecT MMarkErr Text (State BlockState) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Bool
allowNaked <- ParsecT MMarkErr Text (State BlockState) Bool
isNakedAllowed
Pos
rlevel <- BParser Pos
refLevel
let go :: ([Text] -> [Text])
-> ParsecT
MMarkErr
Text
(State BlockState)
([Text] -> [Text], Isp -> Block Isp)
go [Text] -> [Text]
ls = do
Text
l <- ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Text
-> ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) Text
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Text
"" ParsecT MMarkErr Text (State BlockState) Text
nonEmptyLine)
Bool
broken <- ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) Bool
forall (m :: * -> *). Alternative m => m () -> m Bool
succeeds (ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) Bool)
-> (ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ())
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ())
-> (ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ())
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) Bool)
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) Bool
forall a b. (a -> b) -> a -> b
$ do
ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc
Pos
alevel <- BParser Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
Bool -> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Pos
alevel Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
< Pos -> Pos
ilevel Pos
rlevel)
Bool
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Pos
alevel Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
< Pos
rlevel) (ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ())
-> ([ParsecT MMarkErr Text (State BlockState) ()]
-> ParsecT MMarkErr Text (State BlockState) ())
-> [ParsecT MMarkErr Text (State BlockState) ()]
-> ParsecT MMarkErr Text (State BlockState) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsecT MMarkErr Text (State BlockState) ()]
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT MMarkErr Text (State BlockState) ()]
-> ParsecT MMarkErr Text (State BlockState) ())
-> [ParsecT MMarkErr Text (State BlockState) ()]
-> ParsecT MMarkErr Text (State BlockState) ()
forall a b. (a -> b) -> a -> b
$
[ ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text -> ParsecT MMarkErr Text (State BlockState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'>'),
ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT MMarkErr Text (State BlockState) (Block Isp)
pThematicBreak,
ParsecT MMarkErr Text (State BlockState) (Block Isp)
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT MMarkErr Text (State BlockState) (Block Isp)
pAtxHeading,
BParser (Char, Int, Maybe Text)
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void BParser (Char, Int, Maybe Text)
pOpeningFence,
BParser (Char, SourcePos, Pos, Pos)
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe (Char, SourcePos) -> BParser (Char, SourcePos, Pos, Pos)
pListBullet Maybe (Char, SourcePos)
forall a. Maybe a
Nothing),
BParser (Word, Char, SourcePos, Pos, Pos)
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe (Char, SourcePos)
-> BParser (Word, Char, SourcePos, Pos, Pos)
pListIndex Maybe (Char, SourcePos)
forall a. Maybe a
Nothing)
]
if Text -> Bool
isBlank Text
l
then ([Text] -> [Text], Isp -> Block Isp)
-> ParsecT
MMarkErr
Text
(State BlockState)
([Text] -> [Text], Isp -> Block Isp)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> [Text]
ls, Isp -> Block Isp
forall a. a -> Block a
Paragraph)
else
if Bool
broken
then ([Text] -> [Text], Isp -> Block Isp)
-> ParsecT
MMarkErr
Text
(State BlockState)
([Text] -> [Text], Isp -> Block Isp)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> [Text]
ls, Isp -> Block Isp
forall a. a -> Block a
Naked)
else do
ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT MMarkErr Text (State BlockState) Text
nonEmptyLine
Bool
continue <- ParsecT MMarkErr Text (State BlockState) Bool
forall e (m :: * -> *). MonadParsec e Text m => m Bool
eol'
let ls' :: [Text] -> [Text]
ls' = [Text] -> [Text]
ls ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
if Bool
continue
then ([Text] -> [Text])
-> ParsecT
MMarkErr
Text
(State BlockState)
([Text] -> [Text], Isp -> Block Isp)
go [Text] -> [Text]
ls'
else ([Text] -> [Text], Isp -> Block Isp)
-> ParsecT
MMarkErr
Text
(State BlockState)
([Text] -> [Text], Isp -> Block Isp)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> [Text]
ls', Isp -> Block Isp
forall a. a -> Block a
Naked)
Text
l <- ParsecT MMarkErr Text (State BlockState) Text
nonEmptyLine
Bool
continue <- ParsecT MMarkErr Text (State BlockState) Bool
forall e (m :: * -> *). MonadParsec e Text m => m Bool
eol'
([Text] -> [Text]
ls, Isp -> Block Isp
toBlock) <-
if Bool
continue
then ([Text] -> [Text])
-> ParsecT
MMarkErr
Text
(State BlockState)
([Text] -> [Text], Isp -> Block Isp)
go [Text] -> [Text]
forall a. a -> a
id
else ([Text] -> [Text], Isp -> Block Isp)
-> ParsecT
MMarkErr
Text
(State BlockState)
([Text] -> [Text], Isp -> Block Isp)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> [Text]
forall a. a -> a
id, Isp -> Block Isp
forall a. a -> Block a
Naked)
(if Bool
allowNaked then Isp -> Block Isp
toBlock else Isp -> Block Isp
forall a. a -> Block a
Paragraph)
(Int -> Text -> Isp
IspSpan Int
startOffset ([Text] -> Text
assembleParagraph (Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
ls [])))
Block Isp
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) (Block Isp)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT MMarkErr Text (State BlockState) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc
pCodeSpanB :: BParser Text
pCodeSpanB :: ParsecT MMarkErr Text (State BlockState) Text
pCodeSpanB = ((Text, ()) -> Text)
-> ParsecT MMarkErr Text (State BlockState) (Text, ())
-> ParsecT MMarkErr Text (State BlockState) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, ()) -> Text
forall a b. (a, b) -> a
fst (ParsecT MMarkErr Text (State BlockState) (Text, ())
-> ParsecT MMarkErr Text (State BlockState) Text)
-> (ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) (Text, ()))
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) (Text, ())
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match (ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) (Text, ()))
-> (ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ())
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) (Text, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) Text)
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) Text
forall a b. (a -> b) -> a -> b
$ do
Int
n <- ParsecT MMarkErr Text (State BlockState) Int
-> ParsecT MMarkErr Text (State BlockState) Int
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int)
-> ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Token Text -> ParsecT MMarkErr Text (State BlockState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'`'))
let finalizer :: ParsecT MMarkErr Text (State BlockState) ()
finalizer = ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ())
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall a b. (a -> b) -> a -> b
$ do
ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) ())
-> ParsecT MMarkErr Text (State BlockState) String
-> ParsecT MMarkErr Text (State BlockState) ()
forall a b. (a -> b) -> a -> b
$ Int
-> ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
n (Token Text -> ParsecT MMarkErr Text (State BlockState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'`')
ParsecT MMarkErr Text (State BlockState) Char
-> ParsecT MMarkErr Text (State BlockState) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (Token Text -> ParsecT MMarkErr Text (State BlockState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'`')
ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) ()
-> ParsecT MMarkErr Text (State BlockState) ()
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m end
skipManyTill
( String
-> ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"code span content" (ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) Text)
-> ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) Text
forall a b. (a -> b) -> a -> b
$
Maybe String
-> (Token Text -> Bool)
-> ParsecT MMarkErr Text (State BlockState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`')
ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) Text
-> ParsecT MMarkErr Text (State BlockState) Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
-> (Token Text -> Bool)
-> ParsecT MMarkErr Text (State BlockState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (\Token Text
x -> Char
Token Text
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'`' Bool -> Bool -> Bool
&& Char -> Bool
notNewline Char
Token Text
x)
)
ParsecT MMarkErr Text (State BlockState) ()
finalizer
pInlinesTop :: IParser (NonEmpty Inline)
pInlinesTop :: IParser (NonEmpty Inline)
pInlinesTop = do
NonEmpty Inline
inlines <- IParser (NonEmpty Inline)
pInlines
StateT InlineState (Parsec MMarkErr Text) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT InlineState (Parsec MMarkErr Text) InlineState
-> StateT InlineState (Parsec MMarkErr Text) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT InlineState (Parsec MMarkErr Text) InlineState
pLfdr
NonEmpty Inline -> IParser (NonEmpty Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return NonEmpty Inline
inlines
pInlines :: IParser (NonEmpty Inline)
pInlines :: IParser (NonEmpty Inline)
pInlines = do
Bool
done <- StateT InlineState (Parsec MMarkErr Text) Bool
forall e s (m :: * -> *). MonadParsec e s m => m Bool
atEnd
Bool
allowsEmpty <- StateT InlineState (Parsec MMarkErr Text) Bool
isEmptyAllowed
if Bool
done
then
if Bool
allowsEmpty
then (NonEmpty Inline -> IParser (NonEmpty Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty Inline -> IParser (NonEmpty Inline))
-> (Text -> NonEmpty Inline) -> Text -> IParser (NonEmpty Inline)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> NonEmpty Inline
forall a. a -> NonEmpty a
nes (Inline -> NonEmpty Inline)
-> (Text -> Inline) -> Text -> NonEmpty Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inline
Plain) Text
""
else ErrorItem Char -> IParser (NonEmpty Inline)
forall e (m :: * -> *) a.
MonadParsec e Text m =>
ErrorItem Char -> m a
unexpEic ErrorItem Char
forall t. ErrorItem t
EndOfInput
else StateT InlineState (Parsec MMarkErr Text) Inline
-> IParser (NonEmpty Inline)
forall (m :: * -> *) a. MonadPlus m => m a -> m (NonEmpty a)
NE.some (StateT InlineState (Parsec MMarkErr Text) Inline
-> IParser (NonEmpty Inline))
-> StateT InlineState (Parsec MMarkErr Text) Inline
-> IParser (NonEmpty Inline)
forall a b. (a -> b) -> a -> b
$ do
Char
mch <- StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (StateT InlineState (Parsec MMarkErr Text) Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle StateT InlineState (Parsec MMarkErr Text) Char
-> String -> StateT InlineState (Parsec MMarkErr Text) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"inline content")
case Char
mch of
Char
'`' -> StateT InlineState (Parsec MMarkErr Text) Inline
pCodeSpan
Char
'[' -> do
Bool
allowsLinks <- StateT InlineState (Parsec MMarkErr Text) Bool
isLinksAllowed
if Bool
allowsLinks
then StateT InlineState (Parsec MMarkErr Text) Inline
pLink
else ErrorItem Char -> StateT InlineState (Parsec MMarkErr Text) Inline
forall e (m :: * -> *) a.
MonadParsec e Text m =>
ErrorItem Char -> m a
unexpEic (NonEmpty Char -> ErrorItem Char
forall t. NonEmpty t -> ErrorItem t
Tokens (NonEmpty Char -> ErrorItem Char)
-> NonEmpty Char -> ErrorItem Char
forall a b. (a -> b) -> a -> b
$ Char -> NonEmpty Char
forall a. a -> NonEmpty a
nes Char
'[')
Char
'!' -> do
Bool
gotImage <- (StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) Bool
forall (m :: * -> *). Alternative m => m () -> m Bool
succeeds (StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) Bool)
-> (Text -> StateT InlineState (Parsec MMarkErr Text) ())
-> Text
-> StateT InlineState (Parsec MMarkErr Text) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) ())
-> (Text -> StateT InlineState (Parsec MMarkErr Text) Text)
-> Text
-> StateT InlineState (Parsec MMarkErr Text) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) Text)
-> (Text -> StateT InlineState (Parsec MMarkErr Text) Text)
-> Text
-> StateT InlineState (Parsec MMarkErr Text) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StateT InlineState (Parsec MMarkErr Text) Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string) Text
"!["
Bool
allowsImages <- StateT InlineState (Parsec MMarkErr Text) Bool
isImagesAllowed
if Bool
gotImage
then
if Bool
allowsImages
then StateT InlineState (Parsec MMarkErr Text) Inline
pImage
else ErrorItem Char -> StateT InlineState (Parsec MMarkErr Text) Inline
forall e (m :: * -> *) a.
MonadParsec e Text m =>
ErrorItem Char -> m a
unexpEic (NonEmpty Char -> ErrorItem Char
forall t. NonEmpty t -> ErrorItem t
Tokens (NonEmpty Char -> ErrorItem Char)
-> (String -> NonEmpty Char) -> String -> ErrorItem Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NE.fromList (String -> ErrorItem Char) -> String -> ErrorItem Char
forall a b. (a -> b) -> a -> b
$ String
"![")
else StateT InlineState (Parsec MMarkErr Text) Inline
pPlain
Char
'<' -> do
Bool
allowsLinks <- StateT InlineState (Parsec MMarkErr Text) Bool
isLinksAllowed
if Bool
allowsLinks
then StateT InlineState (Parsec MMarkErr Text) Inline
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try StateT InlineState (Parsec MMarkErr Text) Inline
pAutolink StateT InlineState (Parsec MMarkErr Text) Inline
-> StateT InlineState (Parsec MMarkErr Text) Inline
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT InlineState (Parsec MMarkErr Text) Inline
pPlain
else StateT InlineState (Parsec MMarkErr Text) Inline
pPlain
Char
'\\' ->
StateT InlineState (Parsec MMarkErr Text) Inline
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try StateT InlineState (Parsec MMarkErr Text) Inline
pHardLineBreak StateT InlineState (Parsec MMarkErr Text) Inline
-> StateT InlineState (Parsec MMarkErr Text) Inline
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT InlineState (Parsec MMarkErr Text) Inline
pPlain
Char
ch ->
if Char -> Bool
isFrameConstituent Char
ch
then StateT InlineState (Parsec MMarkErr Text) Inline
pEnclosedInline
else StateT InlineState (Parsec MMarkErr Text) Inline
pPlain
pCodeSpan :: IParser Inline
pCodeSpan :: StateT InlineState (Parsec MMarkErr Text) Inline
pCodeSpan = do
Int
n <- StateT InlineState (Parsec MMarkErr Text) Int
-> StateT InlineState (Parsec MMarkErr Text) Int
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int)
-> StateT InlineState (Parsec MMarkErr Text) String
-> StateT InlineState (Parsec MMarkErr Text) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Token Text
-> StateT InlineState (Parsec MMarkErr Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'`'))
let finalizer :: StateT InlineState (Parsec MMarkErr Text) ()
finalizer = StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) ())
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) ()
forall a b. (a -> b) -> a -> b
$ do
StateT InlineState (Parsec MMarkErr Text) String
-> StateT InlineState (Parsec MMarkErr Text) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT InlineState (Parsec MMarkErr Text) String
-> StateT InlineState (Parsec MMarkErr Text) ())
-> StateT InlineState (Parsec MMarkErr Text) String
-> StateT InlineState (Parsec MMarkErr Text) ()
forall a b. (a -> b) -> a -> b
$ Int
-> StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
n (Token Text
-> StateT InlineState (Parsec MMarkErr Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'`')
StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (Token Text
-> StateT InlineState (Parsec MMarkErr Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'`')
Inline
r <-
Text -> Inline
CodeSpan (Text -> Inline) -> ([Text] -> Text) -> [Text] -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
collapseWhiteSpace (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat
([Text] -> Inline)
-> StateT InlineState (Parsec MMarkErr Text) [Text]
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) [Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill
( String
-> StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"code span content" (StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) Text)
-> StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) Text
forall a b. (a -> b) -> a -> b
$
Maybe String
-> (Token Text -> Bool)
-> StateT InlineState (Parsec MMarkErr Text) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`')
StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
-> (Token Text -> Bool)
-> StateT InlineState (Parsec MMarkErr Text) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'`')
)
StateT InlineState (Parsec MMarkErr Text) ()
finalizer
Inline
r Inline
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ CharType -> StateT InlineState (Parsec MMarkErr Text) ()
lastChar CharType
OtherChar
pLink :: IParser Inline
pLink :: StateT InlineState (Parsec MMarkErr Text) Inline
pLink = do
StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text
-> StateT InlineState (Parsec MMarkErr Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'[')
Int
o <- StateT InlineState (Parsec MMarkErr Text) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
NonEmpty Inline
txt <- IParser (NonEmpty Inline) -> IParser (NonEmpty Inline)
forall a. IParser a -> IParser a
disallowLinks (IParser (NonEmpty Inline) -> IParser (NonEmpty Inline)
forall a. IParser a -> IParser a
disallowEmpty IParser (NonEmpty Inline)
pInlines)
StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text
-> StateT InlineState (Parsec MMarkErr Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']')
(URI
dest, Maybe Text
mtitle) <- Int -> NonEmpty Inline -> IParser (URI, Maybe Text)
pLocation Int
o NonEmpty Inline
txt
NonEmpty Inline -> URI -> Maybe Text -> Inline
Link NonEmpty Inline
txt URI
dest Maybe Text
mtitle Inline
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ CharType -> StateT InlineState (Parsec MMarkErr Text) ()
lastChar CharType
OtherChar
pImage :: IParser Inline
pImage :: StateT InlineState (Parsec MMarkErr Text) Inline
pImage = do
(Int
pos, NonEmpty Inline
alt) <- StateT InlineState (Parsec MMarkErr Text) (Int, NonEmpty Inline)
forall (m :: * -> *) e s.
(MonadParsec e s m, IsString (Tokens s)) =>
m (Int, NonEmpty Inline)
emptyAlt StateT InlineState (Parsec MMarkErr Text) (Int, NonEmpty Inline)
-> StateT InlineState (Parsec MMarkErr Text) (Int, NonEmpty Inline)
-> StateT InlineState (Parsec MMarkErr Text) (Int, NonEmpty Inline)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT InlineState (Parsec MMarkErr Text) (Int, NonEmpty Inline)
nonEmptyAlt
(URI
src, Maybe Text
mtitle) <- Int -> NonEmpty Inline -> IParser (URI, Maybe Text)
pLocation Int
pos NonEmpty Inline
alt
NonEmpty Inline -> URI -> Maybe Text -> Inline
Image NonEmpty Inline
alt URI
src Maybe Text
mtitle Inline
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ CharType -> StateT InlineState (Parsec MMarkErr Text) ()
lastChar CharType
OtherChar
where
emptyAlt :: m (Int, NonEmpty Inline)
emptyAlt = do
Int
o <- m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
m (Tokens s) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
"![]")
(Int, NonEmpty Inline) -> m (Int, NonEmpty Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2, Inline -> NonEmpty Inline
forall a. a -> NonEmpty a
nes (Text -> Inline
Plain Text
""))
nonEmptyAlt :: StateT InlineState (Parsec MMarkErr Text) (Int, NonEmpty Inline)
nonEmptyAlt = do
StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens Text
-> StateT InlineState (Parsec MMarkErr Text) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"![")
Int
o <- StateT InlineState (Parsec MMarkErr Text) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
NonEmpty Inline
alt <- IParser (NonEmpty Inline) -> IParser (NonEmpty Inline)
forall a. IParser a -> IParser a
disallowImages (IParser (NonEmpty Inline) -> IParser (NonEmpty Inline)
forall a. IParser a -> IParser a
disallowEmpty IParser (NonEmpty Inline)
pInlines)
StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text
-> StateT InlineState (Parsec MMarkErr Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']')
(Int, NonEmpty Inline)
-> StateT InlineState (Parsec MMarkErr Text) (Int, NonEmpty Inline)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
o, NonEmpty Inline
alt)
pAutolink :: IParser Inline
pAutolink :: StateT InlineState (Parsec MMarkErr Text) Inline
pAutolink = StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) Inline
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text
-> StateT InlineState (Parsec MMarkErr Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'<') (Token Text
-> StateT InlineState (Parsec MMarkErr Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'>') (StateT InlineState (Parsec MMarkErr Text) Inline
-> StateT InlineState (Parsec MMarkErr Text) Inline)
-> StateT InlineState (Parsec MMarkErr Text) Inline
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall a b. (a -> b) -> a -> b
$ do
StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (Token Text
-> StateT InlineState (Parsec MMarkErr Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'>')
URI
uri' <- StateT InlineState (Parsec MMarkErr Text) URI
forall e (m :: * -> *). MonadParsec e Text m => m URI
URI.parser
let (NonEmpty Inline
txt, URI
uri) =
case URI -> Maybe Text
isEmailUri URI
uri' of
Maybe Text
Nothing ->
( (Inline -> NonEmpty Inline
forall a. a -> NonEmpty a
nes (Inline -> NonEmpty Inline)
-> (URI -> Inline) -> URI -> NonEmpty Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inline
Plain (Text -> Inline) -> (URI -> Text) -> URI -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Text
URI.render) URI
uri',
URI
uri'
)
Just Text
email ->
( Inline -> NonEmpty Inline
forall a. a -> NonEmpty a
nes (Text -> Inline
Plain Text
email),
RText 'Scheme -> URI -> URI
URI.makeAbsolute RText 'Scheme
mailtoScheme URI
uri'
)
NonEmpty Inline -> URI -> Maybe Text -> Inline
Link NonEmpty Inline
txt URI
uri Maybe Text
forall a. Maybe a
Nothing Inline
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ CharType -> StateT InlineState (Parsec MMarkErr Text) ()
lastChar CharType
OtherChar
pEnclosedInline :: IParser Inline
pEnclosedInline :: StateT InlineState (Parsec MMarkErr Text) Inline
pEnclosedInline =
StateT InlineState (Parsec MMarkErr Text) Inline
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall a. IParser a -> IParser a
disallowEmpty (StateT InlineState (Parsec MMarkErr Text) Inline
-> StateT InlineState (Parsec MMarkErr Text) Inline)
-> StateT InlineState (Parsec MMarkErr Text) Inline
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall a b. (a -> b) -> a -> b
$
StateT InlineState (Parsec MMarkErr Text) InlineState
pLfdr StateT InlineState (Parsec MMarkErr Text) InlineState
-> (InlineState
-> StateT InlineState (Parsec MMarkErr Text) Inline)
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
SingleFrame InlineFrame
x ->
InlineFrame -> NonEmpty Inline -> Inline
liftFrame InlineFrame
x (NonEmpty Inline -> Inline)
-> IParser (NonEmpty Inline)
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IParser (NonEmpty Inline)
pInlines StateT InlineState (Parsec MMarkErr Text) Inline
-> StateT InlineState (Parsec MMarkErr Text) InlineFrame
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* InlineFrame
-> StateT InlineState (Parsec MMarkErr Text) InlineFrame
pRfdr InlineFrame
x
DoubleFrame InlineFrame
x InlineFrame
y -> do
NonEmpty Inline
inlines0 <- IParser (NonEmpty Inline)
pInlines
InlineFrame
thisFrame <- InlineFrame
-> StateT InlineState (Parsec MMarkErr Text) InlineFrame
pRfdr InlineFrame
x StateT InlineState (Parsec MMarkErr Text) InlineFrame
-> StateT InlineState (Parsec MMarkErr Text) InlineFrame
-> StateT InlineState (Parsec MMarkErr Text) InlineFrame
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> InlineFrame
-> StateT InlineState (Parsec MMarkErr Text) InlineFrame
pRfdr InlineFrame
y
let thatFrame :: InlineFrame
thatFrame = if InlineFrame
thisFrame InlineFrame -> InlineFrame -> Bool
forall a. Eq a => a -> a -> Bool
== InlineFrame
x then InlineFrame
y else InlineFrame
x
Maybe (NonEmpty Inline)
minlines1 <- IParser (NonEmpty Inline)
-> StateT
InlineState (Parsec MMarkErr Text) (Maybe (NonEmpty Inline))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional IParser (NonEmpty Inline)
pInlines
StateT InlineState (Parsec MMarkErr Text) InlineFrame
-> StateT InlineState (Parsec MMarkErr Text) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (InlineFrame
-> StateT InlineState (Parsec MMarkErr Text) InlineFrame
pRfdr InlineFrame
thatFrame)
Inline -> StateT InlineState (Parsec MMarkErr Text) Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> StateT InlineState (Parsec MMarkErr Text) Inline)
-> (NonEmpty Inline -> Inline)
-> NonEmpty Inline
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InlineFrame -> NonEmpty Inline -> Inline
liftFrame InlineFrame
thatFrame (NonEmpty Inline
-> StateT InlineState (Parsec MMarkErr Text) Inline)
-> NonEmpty Inline
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall a b. (a -> b) -> a -> b
$
case Maybe (NonEmpty Inline)
minlines1 of
Maybe (NonEmpty Inline)
Nothing ->
Inline -> NonEmpty Inline
forall a. a -> NonEmpty a
nes (InlineFrame -> NonEmpty Inline -> Inline
liftFrame InlineFrame
thisFrame NonEmpty Inline
inlines0)
Just NonEmpty Inline
inlines1 ->
InlineFrame -> NonEmpty Inline -> Inline
liftFrame InlineFrame
thisFrame NonEmpty Inline
inlines0 Inline -> NonEmpty Inline -> NonEmpty Inline
forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Inline
inlines1
pHardLineBreak :: IParser Inline
pHardLineBreak :: StateT InlineState (Parsec MMarkErr Text) Inline
pHardLineBreak = do
StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text
-> StateT InlineState (Parsec MMarkErr Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\')
StateT InlineState (Parsec MMarkErr Text) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
eol
StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy StateT InlineState (Parsec MMarkErr Text) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
StateT InlineState (Parsec MMarkErr Text) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc'
CharType -> StateT InlineState (Parsec MMarkErr Text) ()
lastChar CharType
SpaceChar
Inline -> StateT InlineState (Parsec MMarkErr Text) Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
LineBreak
pPlain :: IParser Inline
pPlain :: StateT InlineState (Parsec MMarkErr Text) Inline
pPlain = (ShowS -> Inline)
-> StateT InlineState (Parsec MMarkErr Text) ShowS
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Inline
Plain (Text -> Inline) -> (ShowS -> Text) -> ShowS -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> Text
bakeText) (StateT InlineState (Parsec MMarkErr Text) ShowS
-> StateT InlineState (Parsec MMarkErr Text) Inline)
-> (StateT InlineState (Parsec MMarkErr Text) ShowS
-> StateT InlineState (Parsec MMarkErr Text) ShowS)
-> StateT InlineState (Parsec MMarkErr Text) ShowS
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT InlineState (Parsec MMarkErr Text) ShowS
-> StateT InlineState (Parsec MMarkErr Text) ShowS
forall (m :: * -> *) a. MonadPlus m => m (a -> a) -> m (a -> a)
foldSome (StateT InlineState (Parsec MMarkErr Text) ShowS
-> StateT InlineState (Parsec MMarkErr Text) Inline)
-> StateT InlineState (Parsec MMarkErr Text) ShowS
-> StateT InlineState (Parsec MMarkErr Text) Inline
forall a b. (a -> b) -> a -> b
$ do
Char
ch <- StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (StateT InlineState (Parsec MMarkErr Text) Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle StateT InlineState (Parsec MMarkErr Text) Char
-> String -> StateT InlineState (Parsec MMarkErr Text) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"inline content")
let newline' :: StateT InlineState (Parsec MMarkErr Text) ShowS
newline' =
((Char
'\n' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace) ShowS
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) ShowS
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT InlineState (Parsec MMarkErr Text) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
eol StateT InlineState (Parsec MMarkErr Text) ShowS
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) ShowS
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT InlineState (Parsec MMarkErr Text) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc' StateT InlineState (Parsec MMarkErr Text) ShowS
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) ShowS
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CharType -> StateT InlineState (Parsec MMarkErr Text) ()
lastChar CharType
SpaceChar
case Char
ch of
Char
'\\' ->
(:)
(Char -> ShowS)
-> StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (StateT InlineState (Parsec MMarkErr Text) Char
forall e (f :: * -> *). MonadParsec e Text f => f Char
escapedChar StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CharType -> StateT InlineState (Parsec MMarkErr Text) ()
lastChar CharType
OtherChar)
StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text
-> StateT InlineState (Parsec MMarkErr Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\' StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy StateT InlineState (Parsec MMarkErr Text) ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
eol StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CharType -> StateT InlineState (Parsec MMarkErr Text) ()
lastChar CharType
OtherChar)
)
Char
'\n' ->
StateT InlineState (Parsec MMarkErr Text) ShowS
newline'
Char
'\r' ->
StateT InlineState (Parsec MMarkErr Text) ShowS
newline'
Char
'!' -> do
StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (Tokens Text
-> StateT InlineState (Parsec MMarkErr Text) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"![")
(:) (Char -> ShowS)
-> StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token Text
-> StateT InlineState (Parsec MMarkErr Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'!' StateT InlineState (Parsec MMarkErr Text) ShowS
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) ShowS
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CharType -> StateT InlineState (Parsec MMarkErr Text) ()
lastChar CharType
PunctChar
Char
'<' -> do
StateT InlineState (Parsec MMarkErr Text) Inline
-> StateT InlineState (Parsec MMarkErr Text) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy StateT InlineState (Parsec MMarkErr Text) Inline
pAutolink
(:) (Char -> ShowS)
-> StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token Text
-> StateT InlineState (Parsec MMarkErr Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'<' StateT InlineState (Parsec MMarkErr Text) ShowS
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) ShowS
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CharType -> StateT InlineState (Parsec MMarkErr Text) ()
lastChar CharType
PunctChar
Char
'&' ->
[StateT InlineState (Parsec MMarkErr Text) ShowS]
-> StateT InlineState (Parsec MMarkErr Text) ShowS
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ (:) (Char -> ShowS)
-> StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT InlineState (Parsec MMarkErr Text) Char
forall (m :: * -> *). MonadParsec MMarkErr Text m => m Char
numRef,
String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (String -> ShowS) -> ShowS -> String -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse (String -> ShowS)
-> StateT InlineState (Parsec MMarkErr Text) String
-> StateT InlineState (Parsec MMarkErr Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT InlineState (Parsec MMarkErr Text) String
forall (m :: * -> *). MonadParsec MMarkErr Text m => m String
entityRef,
(:) (Char -> ShowS)
-> StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token Text
-> StateT InlineState (Parsec MMarkErr Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'&'
]
StateT InlineState (Parsec MMarkErr Text) ShowS
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) ShowS
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CharType -> StateT InlineState (Parsec MMarkErr Text) ()
lastChar CharType
PunctChar
Char
_ ->
(:)
(Char -> ShowS)
-> StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if Char -> Bool
Char.isSpace Char
ch
then Token Text
-> StateT InlineState (Parsec MMarkErr Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
ch StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CharType -> StateT InlineState (Parsec MMarkErr Text) ()
lastChar CharType
SpaceChar
else
if Char -> Bool
isSpecialChar Char
ch
then
Maybe (ErrorItem (Token Text))
-> Set (ErrorItem (Token Text))
-> StateT InlineState (Parsec MMarkErr Text) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure
(ErrorItem Char -> Maybe (ErrorItem Char)
forall a. a -> Maybe a
Just (ErrorItem Char -> Maybe (ErrorItem Char))
-> (Char -> ErrorItem Char) -> Char -> Maybe (ErrorItem Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Char -> ErrorItem Char
forall t. NonEmpty t -> ErrorItem t
Tokens (NonEmpty Char -> ErrorItem Char)
-> (Char -> NonEmpty Char) -> Char -> ErrorItem Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> NonEmpty Char
forall a. a -> NonEmpty a
nes (Char -> Maybe (ErrorItem Char)) -> Char -> Maybe (ErrorItem Char)
forall a b. (a -> b) -> a -> b
$ Char
ch)
(ErrorItem Char -> Set (ErrorItem Char)
forall a. a -> Set a
E.singleton (ErrorItem Char -> Set (ErrorItem Char))
-> (String -> ErrorItem Char) -> String -> Set (ErrorItem Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Char -> ErrorItem Char
forall t. NonEmpty Char -> ErrorItem t
Label (NonEmpty Char -> ErrorItem Char)
-> (String -> NonEmpty Char) -> String -> ErrorItem Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NE.fromList (String -> Set (ErrorItem Char)) -> String -> Set (ErrorItem Char)
forall a b. (a -> b) -> a -> b
$ String
"inline content")
else
if Char -> Bool
Char.isPunctuation Char
ch
then Token Text
-> StateT InlineState (Parsec MMarkErr Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
ch StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CharType -> StateT InlineState (Parsec MMarkErr Text) ()
lastChar CharType
PunctChar
else Token Text
-> StateT InlineState (Parsec MMarkErr Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
ch StateT InlineState (Parsec MMarkErr Text) Char
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CharType -> StateT InlineState (Parsec MMarkErr Text) ()
lastChar CharType
OtherChar
pLocation ::
Int ->
NonEmpty Inline ->
IParser (URI, Maybe Text)
pLocation :: Int -> NonEmpty Inline -> IParser (URI, Maybe Text)
pLocation Int
innerOffset NonEmpty Inline
inner = do
Maybe (URI, Maybe Text)
mr <- IParser (URI, Maybe Text)
-> StateT
InlineState (Parsec MMarkErr Text) (Maybe (URI, Maybe Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (IParser (URI, Maybe Text)
forall (m :: * -> *).
MonadParsec MMarkErr Text m =>
m (URI, Maybe Text)
inplace IParser (URI, Maybe Text)
-> IParser (URI, Maybe Text) -> IParser (URI, Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IParser (URI, Maybe Text)
withRef)
case Maybe (URI, Maybe Text)
mr of
Maybe (URI, Maybe Text)
Nothing ->
Int -> NonEmpty Inline -> IParser (URI, Maybe Text)
collapsed Int
innerOffset NonEmpty Inline
inner IParser (URI, Maybe Text)
-> IParser (URI, Maybe Text) -> IParser (URI, Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> NonEmpty Inline -> IParser (URI, Maybe Text)
shortcut Int
innerOffset NonEmpty Inline
inner
Just (URI
dest, Maybe Text
mtitle) ->
(URI, Maybe Text) -> IParser (URI, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI
dest, Maybe Text
mtitle)
where
inplace :: m (URI, Maybe Text)
inplace = do
m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'(')
m ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc'
URI
dest <- m URI
forall e (m :: * -> *).
(Ord e, Show e, MonadParsec e Text m) =>
m URI
pUri
Bool
hadSpace <- Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True Bool -> m () -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc1)
Maybe Text
mtitle <-
if Bool
hadSpace
then m Text -> m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Text
forall (m :: * -> *). MonadParsec MMarkErr Text m => m Text
pTitle m (Maybe Text) -> m () -> m (Maybe Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc'
else Maybe Text -> m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')')
(URI, Maybe Text) -> m (URI, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI
dest, Maybe Text
mtitle)
withRef :: IParser (URI, Maybe Text)
withRef =
StateT InlineState (Parsec MMarkErr Text) (Int, Text)
forall (m :: * -> *). MonadParsec MMarkErr Text m => m (Int, Text)
pRefLabel StateT InlineState (Parsec MMarkErr Text) (Int, Text)
-> ((Int, Text) -> IParser (URI, Maybe Text))
-> IParser (URI, Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Text -> IParser (URI, Maybe Text))
-> (Int, Text) -> IParser (URI, Maybe Text)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Text -> IParser (URI, Maybe Text)
lookupRef
collapsed :: Int -> NonEmpty Inline -> IParser (URI, Maybe Text)
collapsed Int
o NonEmpty Inline
inlines = do
(ParseError Text MMarkErr -> ParseError Text MMarkErr)
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
(ParseError s e -> ParseError s e) -> m a -> m a
region (Int -> ParseError Text MMarkErr -> ParseError Text MMarkErr
forall s e. Int -> ParseError s e -> ParseError s e
setErrorOffset Int
o) (StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) ())
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) ()
forall a b. (a -> b) -> a -> b
$
(StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) ())
-> (Text -> StateT InlineState (Parsec MMarkErr Text) Text)
-> Text
-> StateT InlineState (Parsec MMarkErr Text) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) Text)
-> (Text -> StateT InlineState (Parsec MMarkErr Text) Text)
-> Text
-> StateT InlineState (Parsec MMarkErr Text) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StateT InlineState (Parsec MMarkErr Text) Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string) Text
"[]"
Int -> Text -> IParser (URI, Maybe Text)
lookupRef Int
o (NonEmpty Inline -> Text
mkLabel NonEmpty Inline
inlines)
shortcut :: Int -> NonEmpty Inline -> IParser (URI, Maybe Text)
shortcut Int
o NonEmpty Inline
inlines =
Int -> Text -> IParser (URI, Maybe Text)
lookupRef Int
o (NonEmpty Inline -> Text
mkLabel NonEmpty Inline
inlines)
lookupRef :: Int -> Text -> IParser (URI, Maybe Text)
lookupRef Int
o Text
dlabel =
Text -> IParser (Either [Text] (URI, Maybe Text))
lookupReference Text
dlabel IParser (Either [Text] (URI, Maybe Text))
-> (Either [Text] (URI, Maybe Text) -> IParser (URI, Maybe Text))
-> IParser (URI, Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left [Text]
names ->
Int -> MMarkErr -> IParser (URI, Maybe Text)
forall (m :: * -> *) a.
MonadParsec MMarkErr Text m =>
Int -> MMarkErr -> m a
customFailure' Int
o (Text -> [Text] -> MMarkErr
CouldNotFindReferenceDefinition Text
dlabel [Text]
names)
Right (URI, Maybe Text)
x ->
(URI, Maybe Text) -> IParser (URI, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI, Maybe Text)
x
mkLabel :: NonEmpty Inline -> Text
mkLabel = [Text] -> Text
T.unwords ([Text] -> Text)
-> (NonEmpty Inline -> [Text]) -> NonEmpty Inline -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words (Text -> [Text])
-> (NonEmpty Inline -> Text) -> NonEmpty Inline -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Inline -> Text
asPlainText
pUri :: (Ord e, Show e, MonadParsec e Text m) => m URI
pUri :: m URI
pUri = m Char -> m Char -> m URI -> m URI
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'<') (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'>') m URI
forall e (m :: * -> *). MonadParsec e Text m => m URI
URI.parser m URI -> m URI -> m URI
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m URI
forall e (m :: * -> *). (MonadParsec e Text m, Show e) => m URI
naked
where
naked :: m URI
naked = do
let f :: Char -> Bool
f Char
x = Bool -> Bool
not (Char -> Bool
isSpaceN Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')')
l :: p
l = p
"end of URI"
(Text
s, Text
s') <- (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
f (Text -> (Text, Text)) -> m Text -> m (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Text
forall e s (m :: * -> *). MonadParsec e s m => m s
getInput
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
T.null Text
s) (m () -> m ()) -> (m Char -> m ()) -> m Char -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Char -> m ()) -> m Char -> m ()
forall a b. (a -> b) -> a -> b
$
((Token Text -> Bool) -> m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
f m Char -> String -> m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"URI")
Text -> m ()
forall e s (m :: * -> *). MonadParsec e s m => s -> m ()
setInput Text
s
URI
r <- (ParseError Text e -> ParseError Text e) -> m URI -> m URI
forall e s (m :: * -> *) a.
MonadParsec e s m =>
(ParseError s e -> ParseError s e) -> m a -> m a
region (String -> ParseError Text e -> ParseError Text e
forall e.
Show e =>
String -> ParseError Text e -> ParseError Text e
replaceEof String
forall p. IsString p => p
l) (m URI
forall e (m :: * -> *). MonadParsec e Text m => m URI
URI.parser m URI -> m () -> m URI
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> m () -> m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
forall p. IsString p => p
l m ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)
Text -> m ()
forall e s (m :: * -> *). MonadParsec e s m => s -> m ()
setInput Text
s'
URI -> m URI
forall (m :: * -> *) a. Monad m => a -> m a
return URI
r
pTitle :: MonadParsec MMarkErr Text m => m Text
pTitle :: m Text
pTitle =
[m Text] -> m Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ Char -> Char -> m Text
forall (m :: * -> *).
MonadParsec MMarkErr Text m =>
Char -> Char -> m Text
p Char
'\"' Char
'\"',
Char -> Char -> m Text
forall (m :: * -> *).
MonadParsec MMarkErr Text m =>
Char -> Char -> m Text
p Char
'\'' Char
'\'',
Char -> Char -> m Text
forall (m :: * -> *).
MonadParsec MMarkErr Text m =>
Char -> Char -> m Text
p Char
'(' Char
')'
]
where
p :: Char -> Char -> m Text
p Char
start Char
end =
m Char -> m Char -> m Text -> m Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
start) (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
end) (m Text -> m Text) -> m Text -> m Text
forall a b. (a -> b) -> a -> b
$
let f :: Char -> Bool
f Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
end
in (Char -> Bool) -> String -> m Text
forall (m :: * -> *).
MonadParsec MMarkErr Text m =>
(Char -> Bool) -> String -> m Text
manyEscapedWith Char -> Bool
f String
"unescaped character"
pRefLabel :: MonadParsec MMarkErr Text m => m (Int, Text)
pRefLabel :: m (Int, Text)
pRefLabel = do
m () -> m ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'[')
m Char -> m ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']')
Int
o <- m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
m ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
sc
let f :: Char -> Bool
f Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'[' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']'
Text
dlabel <- (Char -> Bool) -> m Text
forall (m :: * -> *).
MonadParsec MMarkErr Text m =>
(Char -> Bool) -> m Text
someEscapedWith Char -> Bool
f m Text -> String -> m Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"reference label"
m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']')
(Int, Text) -> m (Int, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
o, Text
dlabel)
pLfdr :: IParser InlineState
pLfdr :: StateT InlineState (Parsec MMarkErr Text) InlineState
pLfdr = StateT InlineState (Parsec MMarkErr Text) InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT InlineState (Parsec MMarkErr Text) InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState)
-> StateT InlineState (Parsec MMarkErr Text) InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall a b. (a -> b) -> a -> b
$ do
Int
o <- StateT InlineState (Parsec MMarkErr Text) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
let r :: InlineState -> f InlineState
r InlineState
st = InlineState
st InlineState -> f Text -> f InlineState
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens s -> f (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (InlineState -> Text
inlineStateDel InlineState
st)
InlineState
st <-
StateT InlineState (Parsec MMarkErr Text) InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (StateT InlineState (Parsec MMarkErr Text) InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState)
-> StateT InlineState (Parsec MMarkErr Text) InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall a b. (a -> b) -> a -> b
$
[StateT InlineState (Parsec MMarkErr Text) InlineState]
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall (f :: * -> *) e s.
(MonadParsec e s f, Tokens s ~ Text) =>
InlineState -> f InlineState
r (InlineFrame -> InlineFrame -> InlineState
DoubleFrame InlineFrame
StrongFrame InlineFrame
StrongFrame),
InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall (f :: * -> *) e s.
(MonadParsec e s f, Tokens s ~ Text) =>
InlineState -> f InlineState
r (InlineFrame -> InlineFrame -> InlineState
DoubleFrame InlineFrame
StrongFrame InlineFrame
EmphasisFrame),
InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall (f :: * -> *) e s.
(MonadParsec e s f, Tokens s ~ Text) =>
InlineState -> f InlineState
r (InlineFrame -> InlineState
SingleFrame InlineFrame
StrongFrame),
InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall (f :: * -> *) e s.
(MonadParsec e s f, Tokens s ~ Text) =>
InlineState -> f InlineState
r (InlineFrame -> InlineState
SingleFrame InlineFrame
EmphasisFrame),
InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall (f :: * -> *) e s.
(MonadParsec e s f, Tokens s ~ Text) =>
InlineState -> f InlineState
r (InlineFrame -> InlineFrame -> InlineState
DoubleFrame InlineFrame
StrongFrame_ InlineFrame
StrongFrame_),
InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall (f :: * -> *) e s.
(MonadParsec e s f, Tokens s ~ Text) =>
InlineState -> f InlineState
r (InlineFrame -> InlineFrame -> InlineState
DoubleFrame InlineFrame
StrongFrame_ InlineFrame
EmphasisFrame_),
InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall (f :: * -> *) e s.
(MonadParsec e s f, Tokens s ~ Text) =>
InlineState -> f InlineState
r (InlineFrame -> InlineState
SingleFrame InlineFrame
StrongFrame_),
InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall (f :: * -> *) e s.
(MonadParsec e s f, Tokens s ~ Text) =>
InlineState -> f InlineState
r (InlineFrame -> InlineState
SingleFrame InlineFrame
EmphasisFrame_),
InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall (f :: * -> *) e s.
(MonadParsec e s f, Tokens s ~ Text) =>
InlineState -> f InlineState
r (InlineFrame -> InlineFrame -> InlineState
DoubleFrame InlineFrame
StrikeoutFrame InlineFrame
StrikeoutFrame),
InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall (f :: * -> *) e s.
(MonadParsec e s f, Tokens s ~ Text) =>
InlineState -> f InlineState
r (InlineFrame -> InlineFrame -> InlineState
DoubleFrame InlineFrame
StrikeoutFrame InlineFrame
SubscriptFrame),
InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall (f :: * -> *) e s.
(MonadParsec e s f, Tokens s ~ Text) =>
InlineState -> f InlineState
r (InlineFrame -> InlineState
SingleFrame InlineFrame
StrikeoutFrame),
InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall (f :: * -> *) e s.
(MonadParsec e s f, Tokens s ~ Text) =>
InlineState -> f InlineState
r (InlineFrame -> InlineState
SingleFrame InlineFrame
SubscriptFrame),
InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall (f :: * -> *) e s.
(MonadParsec e s f, Tokens s ~ Text) =>
InlineState -> f InlineState
r (InlineFrame -> InlineState
SingleFrame InlineFrame
SuperscriptFrame)
]
let dels :: Text
dels = InlineState -> Text
inlineStateDel InlineState
st
failNow :: StateT InlineState (Parsec MMarkErr Text) ()
failNow =
Int -> MMarkErr -> StateT InlineState (Parsec MMarkErr Text) ()
forall (m :: * -> *) a.
MonadParsec MMarkErr Text m =>
Int -> MMarkErr -> m a
customFailure' Int
o (NonEmpty Char -> MMarkErr
NonFlankingDelimiterRun (Text -> NonEmpty Char
toNesTokens Text
dels))
CharType
lch <- IParser CharType
getLastChar
CharType
rch <- CharType -> IParser CharType
getNextChar CharType
OtherChar
Bool
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CharType
lch CharType -> CharType -> Bool
forall a. Ord a => a -> a -> Bool
>= CharType
rch) StateT InlineState (Parsec MMarkErr Text) ()
failNow
InlineState
-> StateT InlineState (Parsec MMarkErr Text) InlineState
forall (m :: * -> *) a. Monad m => a -> m a
return InlineState
st
pRfdr :: InlineFrame -> IParser InlineFrame
pRfdr :: InlineFrame
-> StateT InlineState (Parsec MMarkErr Text) InlineFrame
pRfdr InlineFrame
frame = StateT InlineState (Parsec MMarkErr Text) InlineFrame
-> StateT InlineState (Parsec MMarkErr Text) InlineFrame
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT InlineState (Parsec MMarkErr Text) InlineFrame
-> StateT InlineState (Parsec MMarkErr Text) InlineFrame)
-> StateT InlineState (Parsec MMarkErr Text) InlineFrame
-> StateT InlineState (Parsec MMarkErr Text) InlineFrame
forall a b. (a -> b) -> a -> b
$ do
let dels :: Text
dels = InlineFrame -> Text
inlineFrameDel InlineFrame
frame
expectingInlineContent :: m a -> m a
expectingInlineContent = (ParseError s e -> ParseError s e) -> m a -> m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
(ParseError s e -> ParseError s e) -> m a -> m a
region ((ParseError s e -> ParseError s e) -> m a -> m a)
-> (ParseError s e -> ParseError s e) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ \case
TrivialError Int
pos Maybe (ErrorItem (Token s))
us Set (ErrorItem (Token s))
es ->
Int
-> Maybe (ErrorItem (Token s))
-> Set (ErrorItem (Token s))
-> ParseError s e
forall s e.
Int
-> Maybe (ErrorItem (Token s))
-> Set (ErrorItem (Token s))
-> ParseError s e
TrivialError Int
pos Maybe (ErrorItem (Token s))
us (Set (ErrorItem (Token s)) -> ParseError s e)
-> Set (ErrorItem (Token s)) -> ParseError s e
forall a b. (a -> b) -> a -> b
$
ErrorItem (Token s)
-> Set (ErrorItem (Token s)) -> Set (ErrorItem (Token s))
forall a. Ord a => a -> Set a -> Set a
E.insert (NonEmpty Char -> ErrorItem (Token s)
forall t. NonEmpty Char -> ErrorItem t
Label (NonEmpty Char -> ErrorItem (Token s))
-> NonEmpty Char -> ErrorItem (Token s)
forall a b. (a -> b) -> a -> b
$ String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NE.fromList String
"inline content") Set (ErrorItem (Token s))
es
ParseError s e
other -> ParseError s e
other
Int
o <- StateT InlineState (Parsec MMarkErr Text) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
(StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) ())
-> (Text -> StateT InlineState (Parsec MMarkErr Text) Text)
-> Text
-> StateT InlineState (Parsec MMarkErr Text) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
expectingInlineContent (StateT InlineState (Parsec MMarkErr Text) Text
-> StateT InlineState (Parsec MMarkErr Text) Text)
-> (Text -> StateT InlineState (Parsec MMarkErr Text) Text)
-> Text
-> StateT InlineState (Parsec MMarkErr Text) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StateT InlineState (Parsec MMarkErr Text) Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string) Text
dels
let failNow :: StateT InlineState (Parsec MMarkErr Text) ()
failNow =
Int -> MMarkErr -> StateT InlineState (Parsec MMarkErr Text) ()
forall (m :: * -> *) a.
MonadParsec MMarkErr Text m =>
Int -> MMarkErr -> m a
customFailure' Int
o (NonEmpty Char -> MMarkErr
NonFlankingDelimiterRun (Text -> NonEmpty Char
toNesTokens Text
dels))
CharType
lch <- IParser CharType
getLastChar
CharType
rch <- CharType -> IParser CharType
getNextChar CharType
SpaceChar
Bool
-> StateT InlineState (Parsec MMarkErr Text) ()
-> StateT InlineState (Parsec MMarkErr Text) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CharType
lch CharType -> CharType -> Bool
forall a. Ord a => a -> a -> Bool
<= CharType
rch) StateT InlineState (Parsec MMarkErr Text) ()
failNow
InlineFrame
-> StateT InlineState (Parsec MMarkErr Text) InlineFrame
forall (m :: * -> *) a. Monad m => a -> m a
return InlineFrame
frame
getNextChar ::
CharType ->
IParser CharType
getNextChar :: CharType -> IParser CharType
getNextChar CharType
frameType = IParser CharType -> IParser CharType
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (CharType -> IParser CharType -> IParser CharType
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option CharType
SpaceChar (Char -> CharType
charType (Char -> CharType)
-> StateT InlineState (Parsec MMarkErr Text) Char
-> IParser CharType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT InlineState (Parsec MMarkErr Text) Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle))
where
charType :: Char -> CharType
charType Char
ch
| Char -> Bool
isFrameConstituent Char
ch = CharType
frameType
| Char -> Bool
Char.isSpace Char
ch = CharType
SpaceChar
| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' = CharType
OtherChar
| Char -> Bool
Char.isPunctuation Char
ch = CharType
PunctChar
| Bool
otherwise = CharType
OtherChar
manyIndexed :: (Alternative m, Num n) => n -> (n -> m a) -> m [a]
manyIndexed :: n -> (n -> m a) -> m [a]
manyIndexed n
n' n -> m a
m = n -> m [a]
go n
n'
where
go :: n -> m [a]
go !n
n = (a -> [a] -> [a]) -> m a -> m [a] -> m [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (n -> m a
m n
n) (n -> m [a]
go (n
n n -> n -> n
forall a. Num a => a -> a -> a
+ n
1)) m [a] -> m [a] -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
foldMany :: MonadPlus m => m (a -> a) -> m (a -> a)
foldMany :: m (a -> a) -> m (a -> a)
foldMany m (a -> a)
f = (a -> a) -> m (a -> a)
go a -> a
forall a. a -> a
id
where
go :: (a -> a) -> m (a -> a)
go a -> a
g =
m (a -> a) -> m (Maybe (a -> a))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m (a -> a)
f m (Maybe (a -> a)) -> (Maybe (a -> a) -> m (a -> a)) -> m (a -> a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe (a -> a)
Nothing -> (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
g
Just a -> a
h -> (a -> a) -> m (a -> a)
go (a -> a
h (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
g)
foldMany' :: MonadPlus m => m ([a] -> [a]) -> m [a]
foldMany' :: m ([a] -> [a]) -> m [a]
foldMany' m ([a] -> [a])
f = (([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ []) (([a] -> [a]) -> [a]) -> m ([a] -> [a]) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([a] -> [a]) -> m ([a] -> [a])
go [a] -> [a]
forall a. a -> a
id
where
go :: ([a] -> [a]) -> m ([a] -> [a])
go [a] -> [a]
g =
m ([a] -> [a]) -> m (Maybe ([a] -> [a]))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m ([a] -> [a])
f m (Maybe ([a] -> [a]))
-> (Maybe ([a] -> [a]) -> m ([a] -> [a])) -> m ([a] -> [a])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe ([a] -> [a])
Nothing -> ([a] -> [a]) -> m ([a] -> [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a] -> [a]
g
Just [a] -> [a]
h -> ([a] -> [a]) -> m ([a] -> [a])
go ([a] -> [a]
g ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
h)
foldSome :: MonadPlus m => m (a -> a) -> m (a -> a)
foldSome :: m (a -> a) -> m (a -> a)
foldSome m (a -> a)
f = ((a -> a) -> (a -> a) -> a -> a)
-> m (a -> a) -> m (a -> a) -> m (a -> a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (((a -> a) -> (a -> a) -> a -> a) -> (a -> a) -> (a -> a) -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) m (a -> a)
f (m (a -> a) -> m (a -> a)
forall (m :: * -> *) a. MonadPlus m => m (a -> a) -> m (a -> a)
foldMany m (a -> a)
f)
foldSome' :: MonadPlus m => m ([a] -> [a]) -> m [a]
foldSome' :: m ([a] -> [a]) -> m [a]
foldSome' m ([a] -> [a])
f = (([a] -> [a]) -> [a] -> [a]) -> m ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
($) m ([a] -> [a])
f (m ([a] -> [a]) -> m [a]
forall (m :: * -> *) a. MonadPlus m => m ([a] -> [a]) -> m [a]
foldMany' m ([a] -> [a])
f)
sepByCount :: MonadPlus m => Int -> m a -> m sep -> m [a]
sepByCount :: Int -> m a -> m sep -> m [a]
sepByCount Int
0 m a
_ m sep
_ = [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
sepByCount Int
n m a
p m sep
sep = (a -> [a] -> [a]) -> m a -> m [a] -> m [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) m a
p (Int -> m a -> m [a]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (m sep
sep m sep -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a
p))
nonEmptyLine :: BParser Text
nonEmptyLine :: ParsecT MMarkErr Text (State BlockState) Text
nonEmptyLine = Maybe String
-> (Token Text -> Bool)
-> ParsecT MMarkErr Text (State BlockState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
notNewline
manyEscapedWith ::
MonadParsec MMarkErr Text m =>
(Char -> Bool) ->
String ->
m Text
manyEscapedWith :: (Char -> Bool) -> String -> m Text
manyEscapedWith Char -> Bool
f String
l =
(String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (m String -> m Text)
-> ([m ShowS] -> m String) -> [m ShowS] -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m ShowS -> m String
forall (m :: * -> *) a. MonadPlus m => m ([a] -> [a]) -> m [a]
foldMany' (m ShowS -> m String)
-> ([m ShowS] -> m ShowS) -> [m ShowS] -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [m ShowS] -> m ShowS
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([m ShowS] -> m Text) -> [m ShowS] -> m Text
forall a b. (a -> b) -> a -> b
$
[ (:) (Char -> ShowS) -> m Char -> m ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
forall e (f :: * -> *). MonadParsec e Text f => f Char
escapedChar,
(:) (Char -> ShowS) -> m Char -> m ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
forall (m :: * -> *). MonadParsec MMarkErr Text m => m Char
numRef,
String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (String -> ShowS) -> ShowS -> String -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse (String -> ShowS) -> m String -> m ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
forall (m :: * -> *). MonadParsec MMarkErr Text m => m String
entityRef,
(:) (Char -> ShowS) -> m Char -> m ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> Bool) -> m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
f m ShowS -> String -> m ShowS
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
l
]
someEscapedWith ::
MonadParsec MMarkErr Text m =>
(Char -> Bool) ->
m Text
someEscapedWith :: (Char -> Bool) -> m Text
someEscapedWith Char -> Bool
f =
(String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (m String -> m Text)
-> ([m ShowS] -> m String) -> [m ShowS] -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m ShowS -> m String
forall (m :: * -> *) a. MonadPlus m => m ([a] -> [a]) -> m [a]
foldSome' (m ShowS -> m String)
-> ([m ShowS] -> m ShowS) -> [m ShowS] -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [m ShowS] -> m ShowS
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([m ShowS] -> m Text) -> [m ShowS] -> m Text
forall a b. (a -> b) -> a -> b
$
[ (:) (Char -> ShowS) -> m Char -> m ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
forall e (f :: * -> *). MonadParsec e Text f => f Char
escapedChar,
(:) (Char -> ShowS) -> m Char -> m ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
forall (m :: * -> *). MonadParsec MMarkErr Text m => m Char
numRef,
String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (String -> ShowS) -> ShowS -> String -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse (String -> ShowS) -> m String -> m ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
forall (m :: * -> *). MonadParsec MMarkErr Text m => m String
entityRef,
(:) (Char -> ShowS) -> m Char -> m ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> Bool) -> m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
f
]
escapedChar :: MonadParsec e Text m => m Char
escapedChar :: m Char
escapedChar =
String -> m Char -> m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"escaped character" (m Char -> m Char) -> m Char -> m Char
forall a b. (a -> b) -> a -> b
$
m Char -> m Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\' m Char -> m Char -> m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Token Text -> Bool) -> m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAsciiPunctuation)
entityRef :: MonadParsec MMarkErr Text m => m String
entityRef :: m String
entityRef = do
Int
o <- m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
let f :: ParseError Text MMarkErr -> ParseError Text MMarkErr
f (TrivialError Int
_ Maybe (ErrorItem (Token Text))
us Set (ErrorItem (Token Text))
es) = Int
-> Maybe (ErrorItem (Token Text))
-> Set (ErrorItem (Token Text))
-> ParseError Text MMarkErr
forall s e.
Int
-> Maybe (ErrorItem (Token s))
-> Set (ErrorItem (Token s))
-> ParseError s e
TrivialError Int
o Maybe (ErrorItem (Token Text))
us Set (ErrorItem (Token Text))
es
f (FancyError Int
_ Set (ErrorFancy MMarkErr)
xs) = Int -> Set (ErrorFancy MMarkErr) -> ParseError Text MMarkErr
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
o Set (ErrorFancy MMarkErr)
xs
Text
name <-
m Text -> m Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m Text -> m Text) -> (m Text -> m Text) -> m Text -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseError Text MMarkErr -> ParseError Text MMarkErr)
-> m Text -> m Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
(ParseError s e -> ParseError s e) -> m a -> m a
region ParseError Text MMarkErr -> ParseError Text MMarkErr
f (m Text -> m Text) -> m Text -> m Text
forall a b. (a -> b) -> a -> b
$
m Char -> m Char -> m Text -> m Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between
(Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'&')
(Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
';')
(Maybe String -> (Token Text -> Bool) -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
Char.isAlphaNum m Text -> String -> m Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"HTML5 entity name")
case Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
name HashMap Text Text
htmlEntityMap of
Maybe Text
Nothing ->
Int -> MMarkErr -> m String
forall (m :: * -> *) a.
MonadParsec MMarkErr Text m =>
Int -> MMarkErr -> m a
customFailure' Int
o (Text -> MMarkErr
UnknownHtmlEntityName Text
name)
Just Text
txt -> String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> String
T.unpack Text
txt)
numRef :: MonadParsec MMarkErr Text m => m Char
numRef :: m Char
numRef = do
Int
o <- m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
let f :: m a -> m a
f = m (Tokens s) -> m Char -> m a -> m a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
"&#") (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
';')
Int
n <- m Int -> m Int
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m Int -> m Int
forall (m :: * -> *) s e a.
(IsString (Tokens s), MonadParsec e s m, Token s ~ Char) =>
m a -> m a
f (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char' Char
Token Text
'x' m Char -> m Int -> m Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.hexadecimal)) m Int -> m Int -> m Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Int -> m Int
forall (m :: * -> *) s e a.
(IsString (Tokens s), MonadParsec e s m, Token s ~ Char) =>
m a -> m a
f m Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal
if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Char -> Int
forall a. Enum a => a -> Int
fromEnum (Char
forall a. Bounded a => a
maxBound :: Char)
then Int -> MMarkErr -> m Char
forall (m :: * -> *) a.
MonadParsec MMarkErr Text m =>
Int -> MMarkErr -> m a
customFailure' Int
o (Int -> MMarkErr
InvalidNumericCharacter Int
n)
else Char -> m Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
Char.chr Int
n)
sc :: MonadParsec e Text m => m ()
sc :: m ()
sc = m Text -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Text -> m ()) -> m Text -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe String -> (Token Text -> Bool) -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"white space") Char -> Bool
Token Text -> Bool
isSpaceN
sc1 :: MonadParsec e Text m => m ()
sc1 :: m ()
sc1 = m Text -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Text -> m ()) -> m Text -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe String -> (Token Text -> Bool) -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"white space") Char -> Bool
Token Text -> Bool
isSpaceN
sc' :: MonadParsec e Text m => m ()
sc' :: m ()
sc' = m Text -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Text -> m ()) -> m Text -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe String -> (Token Text -> Bool) -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"white space") Char -> Bool
Token Text -> Bool
isSpace
sc1' :: MonadParsec e Text m => m ()
sc1' :: m ()
sc1' = m Text -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Text -> m ()) -> m Text -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe String -> (Token Text -> Bool) -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"white space") Char -> Bool
Token Text -> Bool
isSpace
eol :: MonadParsec e Text m => m ()
eol :: m ()
eol =
m Text -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Text -> m ()) -> (m Text -> m Text) -> m Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m Text -> m Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"newline" (m Text -> m ()) -> m Text -> m ()
forall a b. (a -> b) -> a -> b
$
[m Text] -> m Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\n",
Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\r\n",
Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\r"
]
eol' :: MonadParsec e Text m => m Bool
eol' :: m Bool
eol' = Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True Bool -> m () -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m ()
forall e (m :: * -> *). MonadParsec e Text m => m ()
eol)
isSpace :: Char -> Bool
isSpace :: Char -> Bool
isSpace Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'
isSpaceN :: Char -> Bool
isSpaceN :: Char -> Bool
isSpaceN Char
x = Char -> Bool
isSpace Char
x Bool -> Bool -> Bool
|| Char -> Bool
isNewline Char
x
isNewline :: Char -> Bool
isNewline :: Char -> Bool
isNewline Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r'
notNewline :: Char -> Bool
notNewline :: Char -> Bool
notNewline = Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isNewline
isFrameConstituent :: Char -> Bool
isFrameConstituent :: Char -> Bool
isFrameConstituent = \case
Char
'*' -> Bool
True
Char
'^' -> Bool
True
Char
'_' -> Bool
True
Char
'~' -> Bool
True
Char
_ -> Bool
False
isMarkupChar :: Char -> Bool
isMarkupChar :: Char -> Bool
isMarkupChar Char
x = Char -> Bool
isFrameConstituent Char
x Bool -> Bool -> Bool
|| Char -> Bool
f Char
x
where
f :: Char -> Bool
f = \case
Char
'[' -> Bool
True
Char
']' -> Bool
True
Char
'`' -> Bool
True
Char
_ -> Bool
False
isSpecialChar :: Char -> Bool
isSpecialChar :: Char -> Bool
isSpecialChar Char
x = Char -> Bool
isMarkupChar Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'!' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'<'
isAsciiPunctuation :: Char -> Bool
isAsciiPunctuation :: Char -> Bool
isAsciiPunctuation Char
x =
(Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'!' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'/')
Bool -> Bool -> Bool
|| (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
':' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'@')
Bool -> Bool -> Bool
|| (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'[' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'`')
Bool -> Bool -> Bool
|| (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'{' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'~')
slevel :: Pos -> Pos -> Pos
slevel :: Pos -> Pos -> Pos
slevel Pos
a Pos
l = if Pos
l Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
>= Pos -> Pos
ilevel Pos
a then Pos
a else Pos
l
ilevel :: Pos -> Pos
ilevel :: Pos -> Pos
ilevel = (Pos -> Pos -> Pos
forall a. Semigroup a => a -> a -> a
<> Int -> Pos
mkPos Int
4)
isBlank :: Text -> Bool
isBlank :: Text -> Bool
isBlank = (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace
assembleCodeBlock :: Pos -> [Text] -> Text
assembleCodeBlock :: Pos -> [Text] -> Text
assembleCodeBlock Pos
indent [Text]
ls = [Text] -> Text
T.unlines (Pos -> Text -> Text
stripIndent Pos
indent (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
ls)
stripIndent :: Pos -> Text -> Text
stripIndent :: Pos -> Text -> Text
stripIndent Pos
indent Text
txt = Int -> Text -> Text
T.drop Int
m Text
txt
where
m :: Int
m = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Char -> (Int, Int))
-> (Int, Int) -> Text -> (Int, Int)
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' (Int, Int) -> Char -> (Int, Int)
f (Int
0, Int
0) ((Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
isSpace Text
txt)
f :: (Int, Int) -> Char -> (Int, Int)
f (!Int
j, !Int
n) Char
ch
| Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
i = (Int
j, Int
n)
| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' = (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' = (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise = (Int
j, Int
n)
i :: Int
i = Pos -> Int
unPos Pos
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
assembleParagraph :: [Text] -> Text
assembleParagraph :: [Text] -> Text
assembleParagraph = [Text] -> Text
go
where
go :: [Text] -> Text
go [] = Text
""
go [Text
x] = (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isSpace Text
x
go (Text
x : [Text]
xs) = Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
go [Text]
xs
collapseWhiteSpace :: Text -> Text
collapseWhiteSpace :: Text -> Text
collapseWhiteSpace =
Text -> Text
T.stripEnd (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\0') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, Text) -> Text
forall a b. (a, b) -> b
snd ((Bool, Text) -> Text) -> (Text -> (Bool, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Char -> (Bool, Char)) -> Bool -> Text -> (Bool, Text)
forall a. (a -> Char -> (a, Char)) -> a -> Text -> (a, Text)
T.mapAccumL Bool -> Char -> (Bool, Char)
f Bool
True
where
f :: Bool -> Char -> (Bool, Char)
f Bool
seenSpace Char
ch =
case (Bool
seenSpace, Char -> Bool
g Char
ch) of
(Bool
False, Bool
False) -> (Bool
False, Char
ch)
(Bool
True, Bool
False) -> (Bool
False, Char
ch)
(Bool
False, Bool
True) -> (Bool
True, Char
' ')
(Bool
True, Bool
True) -> (Bool
True, Char
'\0')
g :: Char -> Bool
g Char
' ' = Bool
True
g Char
'\t' = Bool
True
g Char
'\n' = Bool
True
g Char
_ = Bool
False
inlineStateDel :: InlineState -> Text
inlineStateDel :: InlineState -> Text
inlineStateDel = \case
SingleFrame InlineFrame
x -> InlineFrame -> Text
inlineFrameDel InlineFrame
x
DoubleFrame InlineFrame
x InlineFrame
y -> InlineFrame -> Text
inlineFrameDel InlineFrame
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> InlineFrame -> Text
inlineFrameDel InlineFrame
y
liftFrame :: InlineFrame -> NonEmpty Inline -> Inline
liftFrame :: InlineFrame -> NonEmpty Inline -> Inline
liftFrame = \case
InlineFrame
StrongFrame -> NonEmpty Inline -> Inline
Strong
InlineFrame
EmphasisFrame -> NonEmpty Inline -> Inline
Emphasis
InlineFrame
StrongFrame_ -> NonEmpty Inline -> Inline
Strong
InlineFrame
EmphasisFrame_ -> NonEmpty Inline -> Inline
Emphasis
InlineFrame
StrikeoutFrame -> NonEmpty Inline -> Inline
Strikeout
InlineFrame
SubscriptFrame -> NonEmpty Inline -> Inline
Subscript
InlineFrame
SuperscriptFrame -> NonEmpty Inline -> Inline
Superscript
inlineFrameDel :: InlineFrame -> Text
inlineFrameDel :: InlineFrame -> Text
inlineFrameDel = \case
InlineFrame
EmphasisFrame -> Text
"*"
InlineFrame
EmphasisFrame_ -> Text
"_"
InlineFrame
StrongFrame -> Text
"**"
InlineFrame
StrongFrame_ -> Text
"__"
InlineFrame
StrikeoutFrame -> Text
"~~"
InlineFrame
SubscriptFrame -> Text
"~"
InlineFrame
SuperscriptFrame -> Text
"^"
replaceEof :: forall e. Show e => String -> ParseError Text e -> ParseError Text e
replaceEof :: String -> ParseError Text e -> ParseError Text e
replaceEof String
altLabel = \case
TrivialError Int
pos Maybe (ErrorItem (Token Text))
us Set (ErrorItem (Token Text))
es -> Int
-> Maybe (ErrorItem (Token Text))
-> Set (ErrorItem (Token Text))
-> ParseError Text e
forall s e.
Int
-> Maybe (ErrorItem (Token s))
-> Set (ErrorItem (Token s))
-> ParseError s e
TrivialError Int
pos (ErrorItem Char -> ErrorItem Char
f (ErrorItem Char -> ErrorItem Char)
-> Maybe (ErrorItem Char) -> Maybe (ErrorItem Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ErrorItem Char)
Maybe (ErrorItem (Token Text))
us) ((ErrorItem Char -> ErrorItem Char)
-> Set (ErrorItem Char) -> Set (ErrorItem Char)
forall b a. Ord b => (a -> b) -> Set a -> Set b
E.map ErrorItem Char -> ErrorItem Char
f Set (ErrorItem Char)
Set (ErrorItem (Token Text))
es)
FancyError Int
pos Set (ErrorFancy e)
xs -> Int -> Set (ErrorFancy e) -> ParseError Text e
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
pos Set (ErrorFancy e)
xs
where
f :: ErrorItem Char -> ErrorItem Char
f ErrorItem Char
EndOfInput = NonEmpty Char -> ErrorItem Char
forall t. NonEmpty Char -> ErrorItem t
Label (String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NE.fromList String
altLabel)
f ErrorItem Char
x = ErrorItem Char
x
isEmailUri :: URI -> Maybe Text
isEmailUri :: URI -> Maybe Text
isEmailUri URI
uri =
case RText 'PathPiece -> Text
forall (l :: RTextLabel). RText l -> Text
URI.unRText (RText 'PathPiece -> Text) -> [RText 'PathPiece] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI
uri URI
-> Getting [RText 'PathPiece] URI [RText 'PathPiece]
-> [RText 'PathPiece]
forall s a. s -> Getting a s a -> a
^. Getting [RText 'PathPiece] URI [RText 'PathPiece]
Lens' URI [RText 'PathPiece]
uriPath of
[Text
x] ->
if ByteString -> Bool
Email.isValid (Text -> ByteString
TE.encodeUtf8 Text
x)
Bool -> Bool -> Bool
&& ( Maybe (RText 'Scheme) -> Bool
forall a. Maybe a -> Bool
isNothing (URI -> Maybe (RText 'Scheme)
URI.uriScheme URI
uri)
Bool -> Bool -> Bool
|| URI -> Maybe (RText 'Scheme)
URI.uriScheme URI
uri Maybe (RText 'Scheme) -> Maybe (RText 'Scheme) -> Bool
forall a. Eq a => a -> a -> Bool
== RText 'Scheme -> Maybe (RText 'Scheme)
forall a. a -> Maybe a
Just RText 'Scheme
mailtoScheme
)
then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
else Maybe Text
forall a. Maybe a
Nothing
[Text]
_ -> Maybe Text
forall a. Maybe a
Nothing
decodeYaml :: [T.Text] -> Int -> (Either (Int, String) Aeson.Value)
#ifdef ghcjs_HOST_OS
decodeYaml _ _ = pure $ Aeson.object []
#else
decodeYaml :: [Text] -> Int -> Either (Int, String) Value
decodeYaml [Text]
ls Int
doffset =
case (ByteString -> Either ParseException Value
forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither' (ByteString -> Either ParseException Value)
-> ([Text] -> ByteString) -> [Text] -> Either ParseException Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> ([Text] -> Text) -> [Text] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n") [Text]
ls of
Left ParseException
err' ->
let (Maybe Int
moffset, String
err) = ParseException -> (Maybe Int, String)
splitYamlError ParseException
err'
in (Int, String) -> Either (Int, String) Value
forall a b. a -> Either a b
Left (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
doffset (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
doffset) Maybe Int
moffset, String
err)
Right Value
v -> Value -> Either (Int, String) Value
forall a b. b -> Either a b
Right Value
v
splitYamlError ::
Yaml.ParseException ->
(Maybe Int, String)
splitYamlError :: ParseException -> (Maybe Int, String)
splitYamlError = \case
ParseException
Yaml.NonScalarKey -> (Maybe Int
forall a. Maybe a
Nothing, String
"non scalar key")
Yaml.UnknownAlias String
anchor -> (Maybe Int
forall a. Maybe a
Nothing, String
"unknown alias \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
anchor String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"")
Yaml.UnexpectedEvent Maybe Event
exptd Maybe Event
unexptd ->
( Maybe Int
forall a. Maybe a
Nothing,
String
"unexpected event: expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Event -> String
forall a. Show a => a -> String
show Maybe Event
exptd
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", but received "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Event -> String
forall a. Show a => a -> String
show Maybe Event
unexptd
)
Yaml.InvalidYaml Maybe YamlException
myerror -> case Maybe YamlException
myerror of
Maybe YamlException
Nothing -> (Maybe Int
forall a. Maybe a
Nothing, String
"unspecified error")
Just YamlException
yerror -> case YamlException
yerror of
Yaml.YamlException String
s -> (Maybe Int
forall a. Maybe a
Nothing, String
s)
Yaml.YamlParseException String
problem String
context YamlMark
mark ->
( Int -> Maybe Int
forall a. a -> Maybe a
Just (YamlMark -> Int
Yaml.yamlIndex YamlMark
mark),
case String
context of
String
"" -> String
problem
String
_ -> String
context String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
problem
)
Yaml.AesonException String
s -> (Maybe Int
forall a. Maybe a
Nothing, String
s)
Yaml.OtherParseException SomeException
exc -> (Maybe Int
forall a. Maybe a
Nothing, SomeException -> String
forall a. Show a => a -> String
show SomeException
exc)
Yaml.NonStringKeyAlias String
anchor Value
value ->
( Maybe Int
forall a. Maybe a
Nothing,
String
"non-string key alias; anchor name: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
anchor
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", value: "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
value
)
ParseException
Yaml.CyclicIncludes -> (Maybe Int
forall a. Maybe a
Nothing, String
"cyclic includes")
Yaml.LoadSettingsException String
_ ParseException
_ -> (Maybe Int
forall a. Maybe a
Nothing, String
"loading settings exception")
Yaml.NonStringKey JSONPath
_ -> (Maybe Int
forall a. Maybe a
Nothing, String
"non string key")
ParseException
Yaml.MultipleDocuments -> (Maybe Int
forall a. Maybe a
Nothing, String
"multiple documents")
#endif
emptyIspSpan :: Isp
emptyIspSpan :: Isp
emptyIspSpan = Int -> Text -> Isp
IspSpan Int
0 Text
""
normalizeListItems :: NonEmpty [Block Isp] -> NonEmpty [Block Isp]
normalizeListItems :: NonEmpty [Block Isp] -> NonEmpty [Block Isp]
normalizeListItems NonEmpty [Block Isp]
xs' =
if Any -> Bool
getAny (Any -> Bool) -> Any -> Bool
forall a b. (a -> b) -> a -> b
$ ([Block Isp] -> Any) -> NonEmpty [Block Isp] -> Any
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Block Isp -> Any) -> [Block Isp] -> Any
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Bool -> Any
Any (Bool -> Any) -> (Block Isp -> Bool) -> Block Isp -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block Isp -> Bool
forall a. Block a -> Bool
isParagraph)) (Int -> [Block Isp] -> [Block Isp]
forall a. Int -> [a] -> [a]
drop Int
1 [Block Isp]
x [Block Isp] -> [[Block Isp]] -> NonEmpty [Block Isp]
forall a. a -> [a] -> NonEmpty a
:| [[Block Isp]]
xs)
then (Block Isp -> Block Isp) -> [Block Isp] -> [Block Isp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Block Isp -> Block Isp
forall a. Block a -> Block a
toParagraph ([Block Isp] -> [Block Isp])
-> NonEmpty [Block Isp] -> NonEmpty [Block Isp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty [Block Isp]
xs'
else case [Block Isp]
x of
[] -> NonEmpty [Block Isp]
xs'
(Block Isp
y : [Block Isp]
ys) -> NonEmpty [Block Isp] -> NonEmpty [Block Isp]
forall a. NonEmpty [a] -> NonEmpty [a]
r (NonEmpty [Block Isp] -> NonEmpty [Block Isp])
-> NonEmpty [Block Isp] -> NonEmpty [Block Isp]
forall a b. (a -> b) -> a -> b
$ (Block Isp -> Block Isp
forall a. Block a -> Block a
toNaked Block Isp
y Block Isp -> [Block Isp] -> [Block Isp]
forall a. a -> [a] -> [a]
: [Block Isp]
ys) [Block Isp] -> [[Block Isp]] -> NonEmpty [Block Isp]
forall a. a -> [a] -> NonEmpty a
:| [[Block Isp]]
xs
where
([Block Isp]
x :| [[Block Isp]]
xs) = NonEmpty [Block Isp] -> NonEmpty [Block Isp]
forall a. NonEmpty [a] -> NonEmpty [a]
r NonEmpty [Block Isp]
xs'
r :: NonEmpty [a] -> NonEmpty [a]
r = NonEmpty [a] -> NonEmpty [a]
forall a. NonEmpty a -> NonEmpty a
NE.reverse (NonEmpty [a] -> NonEmpty [a])
-> (NonEmpty [a] -> NonEmpty [a]) -> NonEmpty [a] -> NonEmpty [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> NonEmpty [a] -> NonEmpty [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> [a]
forall a. [a] -> [a]
reverse
isParagraph :: Block a -> Bool
isParagraph = \case
OrderedList Word
_ NonEmpty [Block a]
_ -> Bool
False
UnorderedList NonEmpty [Block a]
_ -> Bool
False
Naked a
_ -> Bool
False
Block a
_ -> Bool
True
toParagraph :: Block a -> Block a
toParagraph (Naked a
inner) = a -> Block a
forall a. a -> Block a
Paragraph a
inner
toParagraph Block a
other = Block a
other
toNaked :: Block a -> Block a
toNaked (Paragraph a
inner) = a -> Block a
forall a. a -> Block a
Naked a
inner
toNaked Block a
other = Block a
other
succeeds :: Alternative m => m () -> m Bool
succeeds :: m () -> m Bool
succeeds m ()
m = Bool
True Bool -> m () -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m ()
m m Bool -> m Bool -> m Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
prependErr :: Int -> MMarkErr -> [Block Isp] -> [Block Isp]
prependErr :: Int -> MMarkErr -> [Block Isp] -> [Block Isp]
prependErr Int
o MMarkErr
custom [Block Isp]
blocks = Isp -> Block Isp
forall a. a -> Block a
Naked (ParseError Text MMarkErr -> Isp
IspError ParseError Text MMarkErr
err) Block Isp -> [Block Isp] -> [Block Isp]
forall a. a -> [a] -> [a]
: [Block Isp]
blocks
where
err :: ParseError Text MMarkErr
err = Int -> Set (ErrorFancy MMarkErr) -> ParseError Text MMarkErr
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
o (ErrorFancy MMarkErr -> Set (ErrorFancy MMarkErr)
forall a. a -> Set a
E.singleton (ErrorFancy MMarkErr -> Set (ErrorFancy MMarkErr))
-> ErrorFancy MMarkErr -> Set (ErrorFancy MMarkErr)
forall a b. (a -> b) -> a -> b
$ MMarkErr -> ErrorFancy MMarkErr
forall e. e -> ErrorFancy e
ErrorCustom MMarkErr
custom)
mailtoScheme :: URI.RText 'URI.Scheme
mailtoScheme :: RText 'Scheme
mailtoScheme = Maybe (RText 'Scheme) -> RText 'Scheme
forall a. HasCallStack => Maybe a -> a
fromJust (Text -> Maybe (RText 'Scheme)
forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Scheme)
URI.mkScheme Text
"mailto")
toNesTokens :: Text -> NonEmpty Char
toNesTokens :: Text -> NonEmpty Char
toNesTokens = String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NE.fromList (String -> NonEmpty Char)
-> (Text -> String) -> Text -> NonEmpty Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
unexpEic :: MonadParsec e Text m => ErrorItem Char -> m a
unexpEic :: ErrorItem Char -> m a
unexpEic ErrorItem Char
x =
Maybe (ErrorItem (Token Text))
-> Set (ErrorItem (Token Text)) -> m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure
(ErrorItem Char -> Maybe (ErrorItem Char)
forall a. a -> Maybe a
Just ErrorItem Char
x)
(ErrorItem Char -> Set (ErrorItem Char)
forall a. a -> Set a
E.singleton (ErrorItem Char -> Set (ErrorItem Char))
-> (String -> ErrorItem Char) -> String -> Set (ErrorItem Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Char -> ErrorItem Char
forall t. NonEmpty Char -> ErrorItem t
Label (NonEmpty Char -> ErrorItem Char)
-> (String -> NonEmpty Char) -> String -> ErrorItem Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NE.fromList (String -> Set (ErrorItem Char)) -> String -> Set (ErrorItem Char)
forall a b. (a -> b) -> a -> b
$ String
"inline content")
nes :: a -> NonEmpty a
nes :: a -> NonEmpty a
nes a
a = a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| []
fromRight :: Either a b -> b
fromRight :: Either a b -> b
fromRight (Right b
x) = b
x
fromRight Either a b
_ =
String -> b
forall a. HasCallStack => String -> a
error String
"Text.MMark.Parser.fromRight: the impossible happened"
bakeText :: (String -> String) -> Text
bakeText :: ShowS -> Text
bakeText = String -> Text
T.pack (String -> Text) -> (ShowS -> String) -> ShowS -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> (ShowS -> String) -> ShowS -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [])
customFailure' ::
MonadParsec MMarkErr Text m =>
Int ->
MMarkErr ->
m a
customFailure' :: Int -> MMarkErr -> m a
customFailure' Int
o MMarkErr
e =
ParseError Text MMarkErr -> m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ParseError s e -> m a
parseError (ParseError Text MMarkErr -> m a)
-> ParseError Text MMarkErr -> m a
forall a b. (a -> b) -> a -> b
$
Int -> Set (ErrorFancy MMarkErr) -> ParseError Text MMarkErr
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError
Int
o
(ErrorFancy MMarkErr -> Set (ErrorFancy MMarkErr)
forall a. a -> Set a
E.singleton (MMarkErr -> ErrorFancy MMarkErr
forall e. e -> ErrorFancy e
ErrorCustom MMarkErr
e))