module Text.MMark.Parser.Internal.Type
(
BlockState
, bstAllowNaked
, bstRefLevel
, bstDefs
, InlineState
, istLastChar
, istAllowEmpty
, istAllowLinks
, istAllowImages
, istDefs
, Isp (..)
, CharType (..)
, Defs
, referenceDefs
, 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.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
| PunctChar
| OtherChar
deriving (Eq, Ord, Show)
newtype Defs = Defs
{ _referenceDefs :: HashMap DefLabel (URI, Maybe Text)
}
instance Default Defs where
def = Defs
{ _referenceDefs = 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
| NonFlankingDelimiterRun (NonEmpty Char)
| ListStartIndexTooBig Word
| ListIndexOutOfOrder Word Word
| 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
NonFlankingDelimiterRun dels ->
showTokens dels ++ " should be in left- or right- flanking position"
ListStartIndexTooBig n ->
"ordered list start numbers must be nine digits or less, " ++ show n
++ " is too big"
ListIndexOutOfOrder actual expected ->
"list index is out of order: " ++ show actual ++ ", expected "
++ show expected
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