{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

-- |
-- Module      :  Text.MMark.Parser
-- Copyright   :  © 2017–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- MMark markdown parser.
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

----------------------------------------------------------------------------
-- Auxiliary data types

-- | Frame that describes where we are in parsing inlines.
data InlineFrame
  = -- | Emphasis with asterisk @*@
    EmphasisFrame
  | -- | Emphasis with underscore @_@
    EmphasisFrame_
  | -- | Strong emphasis with asterisk @**@
    StrongFrame
  | -- | Strong emphasis with underscore @__@
    StrongFrame_
  | -- | Strikeout
    StrikeoutFrame
  | -- | Subscript
    SubscriptFrame
  | -- | Superscript
    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)

-- | State of inline parsing that specifies whether we expect to close one
-- frame or there is a possibility to close one of two alternatives.
data InlineState
  = -- | One frame to be closed
    SingleFrame InlineFrame
  | -- | Two frames to be closed
    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)

----------------------------------------------------------------------------
-- Top-level API

-- | Parse a markdown document in the form of a strict 'Text' value and
-- either report parse errors or return an 'MMark' document.
parse ::
  -- | File name (only to be used in error messages), may be empty
  FilePath ->
  -- | Input to parse
  Text ->
  -- | Parse errors or parsed document
  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
""
                        }
                  }

----------------------------------------------------------------------------
-- Block parser

-- | Parse an MMark document on block level.
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)

-- | Parse a YAML block. On success return the actual parsed 'Aeson.Value' in
-- 'Right', otherwise return 'SourcePos' of parse error and 'String'
-- describing the error as generated by the @yaml@ package in 'Left'.
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

-- | Parse several (possibly zero) blocks in a row.
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

-- | Parse a single block of markdown document.
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

-- | Parse a thematic break.
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

-- | Parse an ATX heading.
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

-- | Parse a fenced code block.
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

-- | Parse the opening fence of a fenced code block.
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

-- | Parse the closing fence of a fenced code block.
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

-- | Parse an indented code block.
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
      -- NOTE This is a bit unfortunate, but it's difficult to guarantee
      -- that preceding space is not yet consumed when we get to
      -- interpreting input as an indented code block, so we need to restore
      -- the space this way.
      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

-- | Parse an unorederd list.
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

-- | Parse a list bullet. Return a tuple with the following components (in
-- order):
--
--     * 'Char' used to represent the bullet
--     * 'SourcePos' at which the bullet was located
--     * the closest column position where content could start
--     * the indentation level after the bullet
pListBullet ::
  -- | Bullet 'Char' and start position of the first bullet in a list
  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')

-- | Parse an ordered list.
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

-- | Parse a list index. Return a tuple with the following components (in
-- order):
--
--     * 'Word' parsed numeric index
--     * 'Char' used as delimiter after the numeric index
--     * 'SourcePos' at which the index was located
--     * the closest column position where content could start
--     * the indentation level after the index
pListIndex ::
  -- | Delimiter 'Char' and start position of the first index in a list
  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')

-- | Parse a block quote.
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 [])

-- | Parse a link\/image reference definition and register it.
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

-- | Parse a pipe table.
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

-- | Parse a paragraph or naked text (in some cases).
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

----------------------------------------------------------------------------
-- Auxiliary block-level parsers

-- | 'match' a code span, this is a specialised and adjusted version of
-- 'pCodeSpan'.
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

----------------------------------------------------------------------------
-- Inline parser

-- | The top level inline parser.
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

-- | Parse inlines using settings from given 'InlineConfig'.
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

-- | Parse a code span.
--
-- See also: 'pCodeSpanB'.
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

-- | Parse a link.
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

-- | Parse an image.
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)

-- | Parse an autolink.
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

-- | Parse inline content inside an enclosing construction such as emphasis,
-- strikeout, superscript, and\/or subscript markup.
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

-- | Parse a hard line break.
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

-- | Parse plain text.
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

----------------------------------------------------------------------------
-- Auxiliary inline-level parsers

-- | Parse an inline and reference-style link\/image location.
pLocation ::
  -- | Offset where the content inlines start
  Int ->
  -- | The inner content inlines
  NonEmpty Inline ->
  -- | URI and optionally title
  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

-- | Parse a URI.
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") -- this will now fail
      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

-- | Parse a title of a link or an image.
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"

-- | Parse label of a reference link.
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)

-- | Parse an opening markup sequence corresponding to given 'InlineState'.
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

-- | Parse a closing markup sequence corresponding to given 'InlineFrame'.
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

-- | Get 'CharType' of the next char in the input stream.
getNextChar ::
  -- | What we should consider frame constituent characters
  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

----------------------------------------------------------------------------
-- Parsing helpers

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)

-- | Parse an HTML5 entity reference.
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)

-- | Parse a numeric character using the given numeric parser.
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)

----------------------------------------------------------------------------
-- Char classification

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
'~')

----------------------------------------------------------------------------
-- Other helpers

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

-- | Decode the yaml block to a 'Aeson.Value'. On GHCJs, without access to
-- libyaml we just return an empty object. It's worth using a pure haskell
-- parser later if this is unacceptable for someone's needs.
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
$ [])

-- | Report custom failure at specified location.
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))