{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      :  Text.MMark.Parser.Internal.Type
-- Copyright   :  © 2017–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Types for the internal helper definitions for the parser.
module Text.MMark.Parser.Internal.Type
  ( -- * Block-level parser state
    BlockState,
    initialBlockState,
    bstAllowNaked,
    bstRefLevel,
    bstDefs,

    -- * Inline-level parser state
    InlineState,
    initialInlineState,
    istLastChar,
    istAllowEmpty,
    istAllowLinks,
    istAllowImages,
    istDefs,
    Isp (..),
    CharType (..),

    -- * Reference and footnote definitions
    Defs,
    referenceDefs,
    DefLabel,
    mkDefLabel,
    unDefLabel,

    -- * Other
    MMarkErr (..),
  )
where

import Control.DeepSeq
import Data.CaseInsensitive (CI)
import Data.CaseInsensitive qualified as CI
import Data.Data (Data)
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HM
import Data.Hashable (Hashable)
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Proxy
import Data.Text (Text)
import Data.Text qualified as T
import Data.Typeable (Typeable)
import GHC.Generics
import Lens.Micro.TH
import Text.Megaparsec
import Text.URI (URI)

----------------------------------------------------------------------------
-- Block-level parser state

-- | Block-level parser state.
data BlockState = BlockState
  { -- | Should we consider a paragraph that does not end with a blank line
    -- 'Naked'? It does not make sense to do so in the top-level document,
    -- but in lists, 'Naked' text is pretty common.
    BlockState -> Bool
_bstAllowNaked :: Bool,
    -- | Current reference level: 1 column for top-level of document, column
    -- where content starts for block quotes and lists.
    BlockState -> Pos
_bstRefLevel :: Pos,
    -- | Reference and footnote definitions
    BlockState -> Defs
_bstDefs :: Defs
  }

-- | Initial value for 'BlockState'.
initialBlockState :: BlockState
initialBlockState :: BlockState
initialBlockState =
  BlockState
    { _bstAllowNaked :: Bool
_bstAllowNaked = Bool
False,
      _bstRefLevel :: Pos
_bstRefLevel = Pos
pos1,
      _bstDefs :: Defs
_bstDefs = Defs
emptyDefs
    }

----------------------------------------------------------------------------
-- Inline-level parser state

-- | Inline-level parser state.
data InlineState = InlineState
  { -- | Type of the last encountered character
    InlineState -> CharType
_istLastChar :: !CharType,
    -- | Whether to allow empty inlines
    InlineState -> Bool
_istAllowEmpty :: Bool,
    -- | Whether to allow parsing of links
    InlineState -> Bool
_istAllowLinks :: Bool,
    -- | Whether to allow parsing of images
    InlineState -> Bool
_istAllowImages :: Bool,
    -- | Reference link definitions
    InlineState -> Defs
_istDefs :: Defs
  }

-- | Initial value for 'InlineState'.
initialInlineState :: InlineState
initialInlineState :: InlineState
initialInlineState =
  InlineState
    { _istLastChar :: CharType
_istLastChar = CharType
SpaceChar,
      _istAllowEmpty :: Bool
_istAllowEmpty = Bool
True,
      _istAllowLinks :: Bool
_istAllowLinks = Bool
True,
      _istAllowImages :: Bool
_istAllowImages = Bool
True,
      _istDefs :: Defs
_istDefs = Defs
emptyDefs
    }

-- | 'Inline' source pending parsing.
data Isp
  = -- | We have an inline source pending parsing
    IspSpan Int Text
  | -- | We should just return this parse error
    IspError (ParseError Text MMarkErr)
  deriving (Isp -> Isp -> Bool
(Isp -> Isp -> Bool) -> (Isp -> Isp -> Bool) -> Eq Isp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Isp -> Isp -> Bool
== :: Isp -> Isp -> Bool
$c/= :: Isp -> Isp -> Bool
/= :: Isp -> Isp -> Bool
Eq, Int -> Isp -> ShowS
[Isp] -> ShowS
Isp -> String
(Int -> Isp -> ShowS)
-> (Isp -> String) -> ([Isp] -> ShowS) -> Show Isp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Isp -> ShowS
showsPrec :: Int -> Isp -> ShowS
$cshow :: Isp -> String
show :: Isp -> String
$cshowList :: [Isp] -> ShowS
showList :: [Isp] -> ShowS
Show)

-- | Type of the last seen character.
data CharType
  = -- | White space or a transparent character
    SpaceChar
  | -- | Punctuation character
    PunctChar
  | -- | Other character
    OtherChar
  deriving (CharType -> CharType -> Bool
(CharType -> CharType -> Bool)
-> (CharType -> CharType -> Bool) -> Eq CharType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CharType -> CharType -> Bool
== :: CharType -> CharType -> Bool
$c/= :: CharType -> CharType -> Bool
/= :: CharType -> CharType -> Bool
Eq, Eq CharType
Eq CharType =>
(CharType -> CharType -> Ordering)
-> (CharType -> CharType -> Bool)
-> (CharType -> CharType -> Bool)
-> (CharType -> CharType -> Bool)
-> (CharType -> CharType -> Bool)
-> (CharType -> CharType -> CharType)
-> (CharType -> CharType -> CharType)
-> Ord CharType
CharType -> CharType -> Bool
CharType -> CharType -> Ordering
CharType -> CharType -> CharType
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
$ccompare :: CharType -> CharType -> Ordering
compare :: CharType -> CharType -> Ordering
$c< :: CharType -> CharType -> Bool
< :: CharType -> CharType -> Bool
$c<= :: CharType -> CharType -> Bool
<= :: CharType -> CharType -> Bool
$c> :: CharType -> CharType -> Bool
> :: CharType -> CharType -> Bool
$c>= :: CharType -> CharType -> Bool
>= :: CharType -> CharType -> Bool
$cmax :: CharType -> CharType -> CharType
max :: CharType -> CharType -> CharType
$cmin :: CharType -> CharType -> CharType
min :: CharType -> CharType -> CharType
Ord, Int -> CharType -> ShowS
[CharType] -> ShowS
CharType -> String
(Int -> CharType -> ShowS)
-> (CharType -> String) -> ([CharType] -> ShowS) -> Show CharType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CharType -> ShowS
showsPrec :: Int -> CharType -> ShowS
$cshow :: CharType -> String
show :: CharType -> String
$cshowList :: [CharType] -> ShowS
showList :: [CharType] -> ShowS
Show)

----------------------------------------------------------------------------
-- Reference and footnote definitions

-- | An opaque container for reference and footnote definitions.
newtype Defs = Defs
  { -- | Reference definitions containing a 'URI' and optionally title
    Defs -> HashMap DefLabel (URI, Maybe Text)
_referenceDefs :: HashMap DefLabel (URI, Maybe Text)
  }

-- | Empty 'Defs'.
emptyDefs :: Defs
emptyDefs :: Defs
emptyDefs =
  Defs
    { _referenceDefs :: HashMap DefLabel (URI, Maybe Text)
_referenceDefs = HashMap DefLabel (URI, Maybe Text)
forall k v. HashMap k v
HM.empty
    }

-- | An opaque type for definition label.
newtype DefLabel = DefLabel (CI Text)
  deriving (DefLabel -> DefLabel -> Bool
(DefLabel -> DefLabel -> Bool)
-> (DefLabel -> DefLabel -> Bool) -> Eq DefLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DefLabel -> DefLabel -> Bool
== :: DefLabel -> DefLabel -> Bool
$c/= :: DefLabel -> DefLabel -> Bool
/= :: DefLabel -> DefLabel -> Bool
Eq, Eq DefLabel
Eq DefLabel =>
(DefLabel -> DefLabel -> Ordering)
-> (DefLabel -> DefLabel -> Bool)
-> (DefLabel -> DefLabel -> Bool)
-> (DefLabel -> DefLabel -> Bool)
-> (DefLabel -> DefLabel -> Bool)
-> (DefLabel -> DefLabel -> DefLabel)
-> (DefLabel -> DefLabel -> DefLabel)
-> Ord DefLabel
DefLabel -> DefLabel -> Bool
DefLabel -> DefLabel -> Ordering
DefLabel -> DefLabel -> DefLabel
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
$ccompare :: DefLabel -> DefLabel -> Ordering
compare :: DefLabel -> DefLabel -> Ordering
$c< :: DefLabel -> DefLabel -> Bool
< :: DefLabel -> DefLabel -> Bool
$c<= :: DefLabel -> DefLabel -> Bool
<= :: DefLabel -> DefLabel -> Bool
$c> :: DefLabel -> DefLabel -> Bool
> :: DefLabel -> DefLabel -> Bool
$c>= :: DefLabel -> DefLabel -> Bool
>= :: DefLabel -> DefLabel -> Bool
$cmax :: DefLabel -> DefLabel -> DefLabel
max :: DefLabel -> DefLabel -> DefLabel
$cmin :: DefLabel -> DefLabel -> DefLabel
min :: DefLabel -> DefLabel -> DefLabel
Ord, Eq DefLabel
Eq DefLabel =>
(Int -> DefLabel -> Int) -> (DefLabel -> Int) -> Hashable DefLabel
Int -> DefLabel -> Int
DefLabel -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> DefLabel -> Int
hashWithSalt :: Int -> DefLabel -> Int
$chash :: DefLabel -> Int
hash :: DefLabel -> Int
Hashable)

-- | Smart constructor for the 'DefLabel' type.
mkDefLabel :: Text -> DefLabel
mkDefLabel :: Text -> DefLabel
mkDefLabel = CI Text -> DefLabel
DefLabel (CI Text -> DefLabel) -> (Text -> CI Text) -> Text -> DefLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> CI Text) -> (Text -> Text) -> Text -> CI Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unwords ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words

-- | Extract 'Text' value from a 'DefLabel'.
unDefLabel :: DefLabel -> Text
unDefLabel :: DefLabel -> Text
unDefLabel (DefLabel CI Text
x) = CI Text -> Text
forall s. CI s -> s
CI.original CI Text
x

----------------------------------------------------------------------------
-- Other

-- | MMark custom parse errors.
data MMarkErr
  = -- | YAML error that occurred during parsing of a YAML block
    YamlParseError String
  | -- | This delimiter run should be in left- or right- flanking position
    NonFlankingDelimiterRun (NonEmpty Char)
  | -- | Ordered list start numbers must be nine digits or less
    --
    -- @since 0.0.2.0
    ListStartIndexTooBig Word
  | -- | The index in an ordered list is out of order, first number is the
    -- actual index we ran into, the second number is the expected index
    --
    -- @since 0.0.2.0
    ListIndexOutOfOrder Word Word
  | -- | Duplicate reference definitions are not allowed
    --
    -- @since 0.0.3.0
    DuplicateReferenceDefinition Text
  | -- | Could not find this reference definition, the second argument is
    -- the collection of close names (typo corrections)
    --
    -- @since 0.0.3.0
    CouldNotFindReferenceDefinition Text [Text]
  | -- | This numeric character is invalid
    --
    -- @since 0.0.3.0
    InvalidNumericCharacter Int
  | -- | Unknown HTML5 entity name
    --
    -- @since 0.0.3.0
    UnknownHtmlEntityName Text
  deriving (MMarkErr -> MMarkErr -> Bool
(MMarkErr -> MMarkErr -> Bool)
-> (MMarkErr -> MMarkErr -> Bool) -> Eq MMarkErr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MMarkErr -> MMarkErr -> Bool
== :: MMarkErr -> MMarkErr -> Bool
$c/= :: MMarkErr -> MMarkErr -> Bool
/= :: MMarkErr -> MMarkErr -> Bool
Eq, Eq MMarkErr
Eq MMarkErr =>
(MMarkErr -> MMarkErr -> Ordering)
-> (MMarkErr -> MMarkErr -> Bool)
-> (MMarkErr -> MMarkErr -> Bool)
-> (MMarkErr -> MMarkErr -> Bool)
-> (MMarkErr -> MMarkErr -> Bool)
-> (MMarkErr -> MMarkErr -> MMarkErr)
-> (MMarkErr -> MMarkErr -> MMarkErr)
-> Ord MMarkErr
MMarkErr -> MMarkErr -> Bool
MMarkErr -> MMarkErr -> Ordering
MMarkErr -> MMarkErr -> MMarkErr
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
$ccompare :: MMarkErr -> MMarkErr -> Ordering
compare :: MMarkErr -> MMarkErr -> Ordering
$c< :: MMarkErr -> MMarkErr -> Bool
< :: MMarkErr -> MMarkErr -> Bool
$c<= :: MMarkErr -> MMarkErr -> Bool
<= :: MMarkErr -> MMarkErr -> Bool
$c> :: MMarkErr -> MMarkErr -> Bool
> :: MMarkErr -> MMarkErr -> Bool
$c>= :: MMarkErr -> MMarkErr -> Bool
>= :: MMarkErr -> MMarkErr -> Bool
$cmax :: MMarkErr -> MMarkErr -> MMarkErr
max :: MMarkErr -> MMarkErr -> MMarkErr
$cmin :: MMarkErr -> MMarkErr -> MMarkErr
min :: MMarkErr -> MMarkErr -> MMarkErr
Ord, Int -> MMarkErr -> ShowS
[MMarkErr] -> ShowS
MMarkErr -> String
(Int -> MMarkErr -> ShowS)
-> (MMarkErr -> String) -> ([MMarkErr] -> ShowS) -> Show MMarkErr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MMarkErr -> ShowS
showsPrec :: Int -> MMarkErr -> ShowS
$cshow :: MMarkErr -> String
show :: MMarkErr -> String
$cshowList :: [MMarkErr] -> ShowS
showList :: [MMarkErr] -> ShowS
Show, ReadPrec [MMarkErr]
ReadPrec MMarkErr
Int -> ReadS MMarkErr
ReadS [MMarkErr]
(Int -> ReadS MMarkErr)
-> ReadS [MMarkErr]
-> ReadPrec MMarkErr
-> ReadPrec [MMarkErr]
-> Read MMarkErr
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MMarkErr
readsPrec :: Int -> ReadS MMarkErr
$creadList :: ReadS [MMarkErr]
readList :: ReadS [MMarkErr]
$creadPrec :: ReadPrec MMarkErr
readPrec :: ReadPrec MMarkErr
$creadListPrec :: ReadPrec [MMarkErr]
readListPrec :: ReadPrec [MMarkErr]
Read, (forall x. MMarkErr -> Rep MMarkErr x)
-> (forall x. Rep MMarkErr x -> MMarkErr) -> Generic MMarkErr
forall x. Rep MMarkErr x -> MMarkErr
forall x. MMarkErr -> Rep MMarkErr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MMarkErr -> Rep MMarkErr x
from :: forall x. MMarkErr -> Rep MMarkErr x
$cto :: forall x. Rep MMarkErr x -> MMarkErr
to :: forall x. Rep MMarkErr x -> MMarkErr
Generic, Typeable, Typeable MMarkErr
Typeable MMarkErr =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> MMarkErr -> c MMarkErr)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MMarkErr)
-> (MMarkErr -> Constr)
-> (MMarkErr -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MMarkErr))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MMarkErr))
-> ((forall b. Data b => b -> b) -> MMarkErr -> MMarkErr)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MMarkErr -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MMarkErr -> r)
-> (forall u. (forall d. Data d => d -> u) -> MMarkErr -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> MMarkErr -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> MMarkErr -> m MMarkErr)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MMarkErr -> m MMarkErr)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MMarkErr -> m MMarkErr)
-> Data MMarkErr
MMarkErr -> Constr
MMarkErr -> DataType
(forall b. Data b => b -> b) -> MMarkErr -> MMarkErr
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> MMarkErr -> u
forall u. (forall d. Data d => d -> u) -> MMarkErr -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MMarkErr -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MMarkErr -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MMarkErr -> m MMarkErr
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MMarkErr -> m MMarkErr
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MMarkErr
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MMarkErr -> c MMarkErr
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MMarkErr)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MMarkErr)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MMarkErr -> c MMarkErr
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MMarkErr -> c MMarkErr
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MMarkErr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MMarkErr
$ctoConstr :: MMarkErr -> Constr
toConstr :: MMarkErr -> Constr
$cdataTypeOf :: MMarkErr -> DataType
dataTypeOf :: MMarkErr -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MMarkErr)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MMarkErr)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MMarkErr)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MMarkErr)
$cgmapT :: (forall b. Data b => b -> b) -> MMarkErr -> MMarkErr
gmapT :: (forall b. Data b => b -> b) -> MMarkErr -> MMarkErr
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MMarkErr -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MMarkErr -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MMarkErr -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MMarkErr -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MMarkErr -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> MMarkErr -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MMarkErr -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MMarkErr -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MMarkErr -> m MMarkErr
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MMarkErr -> m MMarkErr
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MMarkErr -> m MMarkErr
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MMarkErr -> m MMarkErr
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MMarkErr -> m MMarkErr
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MMarkErr -> m MMarkErr
Data)

instance ShowErrorComponent MMarkErr where
  showErrorComponent :: MMarkErr -> String
showErrorComponent = \case
    YamlParseError String
str ->
      String
"YAML parse error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str
    NonFlankingDelimiterRun NonEmpty Char
dels ->
      Proxy Text -> NonEmpty (Token Text) -> String
forall s. VisualStream s => Proxy s -> NonEmpty (Token s) -> String
showTokens (Proxy Text
forall {k} (t :: k). Proxy t
Proxy :: Proxy Text) NonEmpty Char
NonEmpty (Token Text)
dels
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" should be in left- or right- flanking position"
    ListStartIndexTooBig Word
n ->
      String
"ordered list start numbers must be nine digits or less, "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
n
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is too big"
    ListIndexOutOfOrder Word
actual Word
expected ->
      String
"list index is out of order: "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
actual
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", expected "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
expected
    DuplicateReferenceDefinition Text
name ->
      String
"duplicate reference definitions are not allowed: \""
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
name
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
    CouldNotFindReferenceDefinition Text
name [Text]
alts ->
      String
"could not find a matching reference definition for \""
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
name
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ case [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Text]
alts of
          Maybe (NonEmpty Text)
Nothing -> String
""
          Just NonEmpty Text
xs ->
            String
"\nperhaps you meant "
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ NonEmpty String -> String
orList (ShowS
quote ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> NonEmpty Text -> NonEmpty String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Text
xs)
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"?"
      where
        quote :: ShowS
quote String
x = String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
    InvalidNumericCharacter Int
n ->
      String
"invalid numeric character: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
    UnknownHtmlEntityName Text
name ->
      String
"unknown HTML5 entity name: \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""

instance NFData MMarkErr

-- | Print a pretty list where items are separated with commas and the word
-- “or” according to the rules of English punctuation.
orList :: NonEmpty String -> String
orList :: NonEmpty String -> String
orList (String
x :| []) = String
x
orList (String
x :| [String
y]) = String
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" or " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
y
orList NonEmpty String
xs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NE.init NonEmpty String
xs) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", or " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NonEmpty String -> String
forall a. NonEmpty a -> a
NE.last NonEmpty String
xs

----------------------------------------------------------------------------
-- Lens TH

makeLenses ''BlockState
makeLenses ''InlineState
makeLenses ''Defs