-- |
-- Attoparsec parsers.
module HTMLEntities.Parser where

import Data.Attoparsec.Text
import qualified Data.Text as Text
import qualified HTMLEntities.NameTable as NameTable
import HTMLEntities.Prelude

-- |
-- A parser of a single entity.
--
-- Parses numeric encoding:
--
-- >>> mapM_ Data.Text.IO.putStrLn $ Data.Attoparsec.Text.parseOnly htmlEntity "©"
-- ©
--
-- as well as the named entities:
--
-- >>> mapM_ Data.Text.IO.putStrLn $ Data.Attoparsec.Text.parseOnly htmlEntity "©"
-- ©
{-# INLINE htmlEntity #-}
htmlEntity :: Parser Text
htmlEntity :: Parser Text
htmlEntity =
  Char -> Parser Char
char Char
'&' Parser Char -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
htmlEntityBody Parser Text -> Parser Char -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
';'

-- |
-- A parser of the body of a single entity.
--
-- Parses numeric encoding:
--
-- >>> mapM_ Data.Text.IO.putStrLn $ Data.Attoparsec.Text.parseOnly htmlEntityBody "#169"
-- ©
--
-- as well as the named entities:
--
-- >>> mapM_ Data.Text.IO.putStrLn $ Data.Attoparsec.Text.parseOnly htmlEntityBody "copy"
-- ©
{-# INLINEABLE htmlEntityBody #-}
htmlEntityBody :: Parser Text
htmlEntityBody :: Parser Text
htmlEntityBody =
  Parser Text
numeric Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
named
  where
    numeric :: Parser Text
numeric =
      Char -> Text
Text.singleton (Char -> Text) -> (Int -> Char) -> Int -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Char
chr (Int -> Text) -> Parser Text Int -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char Char
'#' Parser Char -> Parser Text Int -> Parser Text Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Text Int
forall a. Integral a => Parser a
decimal Parser Text Int -> Parser Text Int -> Parser Text Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
'x' Parser Char -> Parser Text Int -> Parser Text Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Int
forall a. (Integral a, Bits a) => Parser a
hexadecimal)))
    named :: Parser Text
named =
      (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
isAlpha Parser Text -> (Text -> Parser Text) -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Text -> Parser Text
forall (f :: * -> *) a. Alternative f => Maybe a -> f a
liftMaybe (Maybe Text -> Parser Text)
-> (Text -> Maybe Text) -> Text -> Parser Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Maybe Text
NameTable.lookupTextByName
    liftMaybe :: Maybe a -> f a
liftMaybe =
      f a -> (a -> f a) -> Maybe a -> f a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe f a
forall (f :: * -> *) a. Alternative f => f a
empty a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure