module Text.MMark.Parser.Internal.Type
(
BlockState
, bstAllowNaked
, bstRefLevel
, bstDefs
, InlineState
, istLastChar
, istAllowEmpty
, istAllowLinks
, istAllowImages
, istDefs
, Isp (..)
, CharType (..)
, Defs
, referenceDefs
, footnoteDefs
, DefLabel
, mkDefLabel
, unDefLabel
, MMarkErr (..) )
where
import Control.DeepSeq
import Data.CaseInsensitive (CI)
import Data.Data (Data)
import Data.Default.Class
import Data.HashMap.Strict (HashMap)
import Data.Hashable (Hashable)
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Semigroup ((<>))
import Data.Text (Text)
import Data.Typeable (Typeable)
import GHC.Generics
import Lens.Micro.TH
import Text.MMark.Internal
import Text.Megaparsec
import Text.URI (URI)
import qualified Data.CaseInsensitive as CI
import qualified Data.HashMap.Strict as HM
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
data BlockState = BlockState
{ _bstAllowNaked :: Bool
, _bstRefLevel :: Pos
, _bstDefs :: Defs
}
instance Default BlockState where
def = BlockState
{ _bstAllowNaked = False
, _bstRefLevel = pos1
, _bstDefs = def
}
data InlineState = InlineState
{ _istLastChar :: !CharType
, _istAllowEmpty :: Bool
, _istAllowLinks :: Bool
, _istAllowImages :: Bool
, _istDefs :: Defs
}
instance Default InlineState where
def = InlineState
{ _istLastChar = SpaceChar
, _istAllowEmpty = True
, _istAllowLinks = True
, _istAllowImages = True
, _istDefs = def
}
data Isp
= IspSpan SourcePos Text
| IspError (ParseError Char MMarkErr)
deriving (Eq, Show)
data CharType
= SpaceChar
| OtherChar
deriving (Eq)
data Defs = Defs
{ _referenceDefs :: HashMap DefLabel (URI, Maybe Text)
, _footnoteDefs :: HashMap DefLabel (NonEmpty Inline)
}
instance Default Defs where
def = Defs
{ _referenceDefs = HM.empty
, _footnoteDefs = HM.empty
}
newtype DefLabel = DefLabel (CI Text)
deriving (Eq, Ord, Hashable)
mkDefLabel :: Text -> DefLabel
mkDefLabel = DefLabel . CI.mk . T.unwords . T.words
unDefLabel :: DefLabel -> Text
unDefLabel (DefLabel x) = CI.original x
data MMarkErr
= YamlParseError String
| ListStartIndexTooBig Word
| ListIndexOutOfOrder Word Word
| NonFlankingDelimiterRun (NonEmpty Char)
| DuplicateReferenceDefinition Text
| CouldNotFindReferenceDefinition Text [Text]
| InvalidNumericCharacter Int
| UnknownHtmlEntityName Text
deriving (Eq, Ord, Show, Read, Generic, Typeable, Data)
instance ShowErrorComponent MMarkErr where
showErrorComponent = \case
YamlParseError str ->
"YAML parse error: " ++ str
ListStartIndexTooBig n ->
"ordered list start numbers must be nine digits or less, " ++ show n
++ " is too big"
ListIndexOutOfOrder actual expected ->
"list index out of order: " ++ show actual ++ ", expected "
++ show expected
NonFlankingDelimiterRun dels ->
showTokens dels ++ " should be in left- or right- flanking position"
DuplicateReferenceDefinition name ->
"duplicate reference definitions are not allowed: \""
++ T.unpack name ++ "\""
CouldNotFindReferenceDefinition name alts ->
"could not find a matching reference definition for \""
++ T.unpack name ++ "\""
++ case NE.nonEmpty alts of
Nothing -> ""
Just xs -> "\nperhaps you meant "
++ orList (quote . T.unpack <$> xs) ++ "?"
where
quote x = "\"" ++ x ++ "\""
InvalidNumericCharacter n ->
"invalid numeric character: " ++ show n
UnknownHtmlEntityName name ->
"unknown HTML5 entity name: \"" ++ T.unpack name ++ "\""
instance NFData MMarkErr
orList :: NonEmpty String -> String
orList (x:|[]) = x
orList (x:|[y]) = x <> " or " <> y
orList xs = intercalate ", " (NE.init xs) <> ", or " <> NE.last xs
makeLenses ''BlockState
makeLenses ''InlineState
makeLenses ''Defs