    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE MultiWayIf #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TupleSections #-}
    module Codec.Xlsx.Parser.Internal.Fast
      ( FromXenoNode(..)
      , collectChildren
      , maybeChild
      , requireChild
      , childList
      , maybeFromChild
      , fromChild
      , fromChildList
      , maybeParse
      , requireAndParse
      , childListAny
      , maybeElementVal
      , toAttrParser
      , parseAttributes
      , FromAttrBs(..)
      , unexpectedAttrBs
      , maybeAttrBs
      , maybeAttr
      , fromAttr
      , fromAttrDef
      , contentBs
      , contentX
      , nsPrefixes
      , addPrefix
      ) where

    import Control.Applicative
    import Control.Arrow (second)
    import Control.Exception (Exception, throw)
    import Control.Monad (ap, forM, join, liftM)
    import Data.Bifunctor (first)
    import Data.Bits ((.|.), shiftL)
    import Data.ByteString (ByteString)
    import qualified Data.ByteString as BS
    import qualified Data.ByteString.Unsafe as SU
    import Data.Char (chr)
    import Data.Maybe
    import Data.Monoid ((<>))
    import Data.Text (Text)
    import qualified Data.Text as T
    import qualified Data.Text.Encoding as T
    import Data.Word (Word8)
    import Xeno.DOM hiding (parse)

    import Codec.Xlsx.Parser.Internal.Util

    class FromXenoNode a where
      fromXenoNode :: Node -> Either Text a

    newtype ChildCollector a = ChildCollector
      { forall a. ChildCollector a -> [Node] -> Either Text ([Node], a)
    runChildCollector :: [Node] -> Either Text ([Node], a)
      }

    instance Functor ChildCollector where
      fmap :: forall a b. (a -> b) -> ChildCollector a -> ChildCollector b
    fmap a -> b
    f ChildCollector a
    a = ([Node] -> Either Text ([Node], b)) -> ChildCollector b
    forall a. ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    ChildCollector (([Node] -> Either Text ([Node], b)) -> ChildCollector b)
    -> ([Node] -> Either Text ([Node], b)) -> ChildCollector b
    forall a b. (a -> b) -> a -> b
    $ \[Node]
    ns ->
        (a -> b) -> ([Node], a) -> ([Node], b)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second a -> b
    f (([Node], a) -> ([Node], b))
    -> Either Text ([Node], a) -> Either Text ([Node], b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ChildCollector a -> [Node] -> Either Text ([Node], a)
    forall a. ChildCollector a -> [Node] -> Either Text ([Node], a)
    runChildCollector ChildCollector a
    a [Node]
    ns

    instance Applicative ChildCollector where
      pure :: forall a. a -> ChildCollector a
    pure a
    a = ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    forall a. ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    ChildCollector (([Node] -> Either Text ([Node], a)) -> ChildCollector a)
    -> ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    forall a b. (a -> b) -> a -> b
    $ \[Node]
    ns ->
        ([Node], a) -> Either Text ([Node], a)
    forall a. a -> Either Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Node]
    ns, a
    a)
      ChildCollector (a -> b)
    cf <*> :: forall a b.
    ChildCollector (a -> b) -> ChildCollector a -> ChildCollector b
    <*> ChildCollector a
    ca = ([Node] -> Either Text ([Node], b)) -> ChildCollector b
    forall a. ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    ChildCollector (([Node] -> Either Text ([Node], b)) -> ChildCollector b)
    -> ([Node] -> Either Text ([Node], b)) -> ChildCollector b
    forall a b. (a -> b) -> a -> b
    $ \[Node]
    ns -> do
        ([Node]
    ns', a -> b
    f) <- ChildCollector (a -> b) -> [Node] -> Either Text ([Node], a -> b)
    forall a. ChildCollector a -> [Node] -> Either Text ([Node], a)
    runChildCollector ChildCollector (a -> b)
    cf [Node]
    ns
        ([Node]
    ns'', a
    a) <- ChildCollector a -> [Node] -> Either Text ([Node], a)
    forall a. ChildCollector a -> [Node] -> Either Text ([Node], a)
    runChildCollector ChildCollector a
    ca [Node]
    ns'
        ([Node], b) -> Either Text ([Node], b)
    forall a. a -> Either Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Node]
    ns'', a -> b
    f a
    a)

    instance Alternative ChildCollector where
      empty :: forall a. ChildCollector a
    empty = ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    forall a. ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    ChildCollector (([Node] -> Either Text ([Node], a)) -> ChildCollector a)
    -> ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    forall a b. (a -> b) -> a -> b
    $ \[Node]
    _ -> Text -> Either Text ([Node], a)
    forall a b. a -> Either a b
    Left Text
    "ChildCollector.empty"
      ChildCollector [Node] -> Either Text ([Node], a)
    f <|> :: forall a. ChildCollector a -> ChildCollector a -> ChildCollector a
    <|> ChildCollector [Node] -> Either Text ([Node], a)
    g = ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    forall a. ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    ChildCollector (([Node] -> Either Text ([Node], a)) -> ChildCollector a)
    -> ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    forall a b. (a -> b) -> a -> b
    $ \[Node]
    ns ->
        (Text -> Either Text ([Node], a))
    -> (([Node], a) -> Either Text ([Node], a))
    -> Either Text ([Node], a)
    -> Either Text ([Node], a)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Either Text ([Node], a) -> Text -> Either Text ([Node], a)
    forall a b. a -> b -> a
    const (Either Text ([Node], a) -> Text -> Either Text ([Node], a))
    -> Either Text ([Node], a) -> Text -> Either Text ([Node], a)
    forall a b. (a -> b) -> a -> b
    $ [Node] -> Either Text ([Node], a)
    g [Node]
    ns) ([Node], a) -> Either Text ([Node], a)
    forall a b. b -> Either a b
    Right ([Node] -> Either Text ([Node], a)
    f [Node]
    ns)

    instance Monad ChildCollector where
      return :: forall a. a -> ChildCollector a
    return = a -> ChildCollector a
    forall a. a -> ChildCollector a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      ChildCollector [Node] -> Either Text ([Node], a)
    f >>= :: forall a b.
    ChildCollector a -> (a -> ChildCollector b) -> ChildCollector b
    >>= a -> ChildCollector b
    g = ([Node] -> Either Text ([Node], b)) -> ChildCollector b
    forall a. ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    ChildCollector (([Node] -> Either Text ([Node], b)) -> ChildCollector b)
    -> ([Node] -> Either Text ([Node], b)) -> ChildCollector b
    forall a b. (a -> b) -> a -> b
    $ \[Node]
    ns ->
        (Text -> Either Text ([Node], b))
    -> (([Node], a) -> Either Text ([Node], b))
    -> Either Text ([Node], a)
    -> Either Text ([Node], b)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Text -> Either Text ([Node], b)
    forall a b. a -> Either a b
    Left (\(![Node]
    ns', a
    f') -> ChildCollector b -> [Node] -> Either Text ([Node], b)
    forall a. ChildCollector a -> [Node] -> Either Text ([Node], a)
    runChildCollector (a -> ChildCollector b
    g a
    f') [Node]
    ns') ([Node] -> Either Text ([Node], a)
    f [Node]
    ns)

    toChildCollector :: Either Text a -> ChildCollector a
    toChildCollector :: forall a. Either Text a -> ChildCollector a
    toChildCollector Either Text a
    unlifted =
      case Either Text a
    unlifted of
        Right a
    a -> a -> ChildCollector a
    forall a. a -> ChildCollector a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a
        Left Text
    e -> ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    forall a. ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    ChildCollector (([Node] -> Either Text ([Node], a)) -> ChildCollector a)
    -> ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    forall a b. (a -> b) -> a -> b
    $ \[Node]
    _ -> Text -> Either Text ([Node], a)
    forall a b. a -> Either a b
    Left Text
    e

    collectChildren :: Node -> ChildCollector a -> Either Text a
    collectChildren :: forall a. Node -> ChildCollector a -> Either Text a
    collectChildren Node
    n ChildCollector a
    c = ([Node], a) -> a
    forall a b. (a, b) -> b
    snd (([Node], a) -> a) -> Either Text ([Node], a) -> Either Text a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ChildCollector a -> [Node] -> Either Text ([Node], a)
    forall a. ChildCollector a -> [Node] -> Either Text ([Node], a)
    runChildCollector ChildCollector a
    c (Node -> [Node]
    children Node
    n)

    maybeChild :: ByteString -> ChildCollector (Maybe Node)
    maybeChild :: ByteString -> ChildCollector (Maybe Node)
    maybeChild ByteString
    nm =
      ([Node] -> Either Text ([Node], Maybe Node))
    -> ChildCollector (Maybe Node)
    forall a. ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    ChildCollector (([Node] -> Either Text ([Node], Maybe Node))
     -> ChildCollector (Maybe Node))
    -> ([Node] -> Either Text ([Node], Maybe Node))
    -> ChildCollector (Maybe Node)
    forall a b. (a -> b) -> a -> b
    $ \case
        (Node
    n:[Node]
    ns)
          | Node -> ByteString
    name Node
    n ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    nm -> ([Node], Maybe Node) -> Either Text ([Node], Maybe Node)
    forall a. a -> Either Text a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([Node]
    ns, Node -> Maybe Node
    forall a. a -> Maybe a
    Just Node
    n)
        [Node]
    ns -> ([Node], Maybe Node) -> Either Text ([Node], Maybe Node)
    forall a. a -> Either Text a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([Node]
    ns, Maybe Node
    forall a. Maybe a
    Nothing)

    requireChild :: ByteString -> ChildCollector Node
    requireChild :: ByteString -> ChildCollector Node
    requireChild ByteString
    nm =
      ([Node] -> Either Text ([Node], Node)) -> ChildCollector Node
    forall a. ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    ChildCollector (([Node] -> Either Text ([Node], Node)) -> ChildCollector Node)
    -> ([Node] -> Either Text ([Node], Node)) -> ChildCollector Node
    forall a b. (a -> b) -> a -> b
    $ \case
        (Node
    n:[Node]
    ns)
          | Node -> ByteString
    name Node
    n ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    nm -> ([Node], Node) -> Either Text ([Node], Node)
    forall a. a -> Either Text a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([Node]
    ns, Node
    n)
        [Node]
    _ ->
          Text -> Either Text ([Node], Node)
    forall a b. a -> Either a b
    Left (Text -> Either Text ([Node], Node))
    -> Text -> Either Text ([Node], Node)
    forall a b. (a -> b) -> a -> b
    $ Text
    "required element " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack (ByteString -> String
    forall a. Show a => a -> String
    show ByteString
    nm) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " was not found"

    childList :: ByteString -> ChildCollector [Node]
    childList :: ByteString -> ChildCollector [Node]
    childList ByteString
    nm = do
      Maybe Node
    mNode <- ByteString -> ChildCollector (Maybe Node)
    maybeChild ByteString
    nm
      case Maybe Node
    mNode of
        Just Node
    n -> (Node
    nNode -> [Node] -> [Node]
    forall a. a -> [a] -> [a]
    :) ([Node] -> [Node])
    -> ChildCollector [Node] -> ChildCollector [Node]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ByteString -> ChildCollector [Node]
    childList ByteString
    nm
        Maybe Node
    Nothing -> [Node] -> ChildCollector [Node]
    forall a. a -> ChildCollector a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    maybeFromChild :: (FromXenoNode a) => ByteString -> ChildCollector (Maybe a)
    maybeFromChild :: forall a. FromXenoNode a => ByteString -> ChildCollector (Maybe a)
    maybeFromChild ByteString
    nm = do
      Maybe Node
    mNode <- ByteString -> ChildCollector (Maybe Node)
    maybeChild ByteString
    nm
      (Node -> ChildCollector a)
    -> Maybe Node -> ChildCollector (Maybe a)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Maybe a -> m (Maybe b)
    mapM (Either Text a -> ChildCollector a
    forall a. Either Text a -> ChildCollector a
    toChildCollector (Either Text a -> ChildCollector a)
    -> (Node -> Either Text a) -> Node -> ChildCollector a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Node -> Either Text a
    forall a. FromXenoNode a => Node -> Either Text a
    fromXenoNode) Maybe Node
    mNode

    fromChild :: (FromXenoNode a) => ByteString -> ChildCollector a
    fromChild :: forall a. FromXenoNode a => ByteString -> ChildCollector a
    fromChild ByteString
    nm = do
      Node
    n <- ByteString -> ChildCollector Node
    requireChild ByteString
    nm
      case Node -> Either Text a
    forall a. FromXenoNode a => Node -> Either Text a
    fromXenoNode Node
    n of
        Right a
    a -> a -> ChildCollector a
    forall a. a -> ChildCollector a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a
        Left Text
    e -> ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    forall a. ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    ChildCollector (([Node] -> Either Text ([Node], a)) -> ChildCollector a)
    -> ([Node] -> Either Text ([Node], a)) -> ChildCollector a
    forall a b. (a -> b) -> a -> b
    $ \[Node]
    _ -> Text -> Either Text ([Node], a)
    forall a b. a -> Either a b
    Left Text
    e

    fromChildList :: (FromXenoNode a) => ByteString -> ChildCollector [a]
    fromChildList :: forall a. FromXenoNode a => ByteString -> ChildCollector [a]
    fromChildList ByteString
    nm = do
      Maybe a
    mA <- ByteString -> ChildCollector (Maybe a)
    forall a. FromXenoNode a => ByteString -> ChildCollector (Maybe a)
    maybeFromChild ByteString
    nm
      case Maybe a
    mA of
        Just a
    a -> (a
    aa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :) ([a] -> [a]) -> ChildCollector [a] -> ChildCollector [a]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ByteString -> ChildCollector [a]
    forall a. FromXenoNode a => ByteString -> ChildCollector [a]
    fromChildList ByteString
    nm
        Maybe a
    Nothing -> [a] -> ChildCollector [a]
    forall a. a -> ChildCollector a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    maybeParse :: ByteString -> (Node -> Either Text a) -> ChildCollector (Maybe a)
    maybeParse :: forall a.
    ByteString -> (Node -> Either Text a) -> ChildCollector (Maybe a)
    maybeParse ByteString
    nm Node -> Either Text a
    parse = ByteString -> ChildCollector (Maybe Node)
    maybeChild ByteString
    nm ChildCollector (Maybe Node)
    -> (Maybe Node -> ChildCollector (Maybe a))
    -> ChildCollector (Maybe a)
    forall a b.
    ChildCollector a -> (a -> ChildCollector b) -> ChildCollector b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Either Text (Maybe a) -> ChildCollector (Maybe a)
    forall a. Either Text a -> ChildCollector a
    toChildCollector (Either Text (Maybe a) -> ChildCollector (Maybe a))
    -> (Maybe Node -> Either Text (Maybe a))
    -> Maybe Node
    -> ChildCollector (Maybe a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Node -> Either Text a) -> Maybe Node -> Either Text (Maybe a)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Maybe a -> m (Maybe b)
    mapM Node -> Either Text a
    parse)

    requireAndParse :: ByteString -> (Node -> Either Text a) -> ChildCollector a
    requireAndParse :: forall a. ByteString -> (Node -> Either Text a) -> ChildCollector a
    requireAndParse ByteString
    nm Node -> Either Text a
    parse = ByteString -> ChildCollector Node
    requireChild ByteString
    nm ChildCollector Node
    -> (Node -> ChildCollector a) -> ChildCollector a
    forall a b.
    ChildCollector a -> (a -> ChildCollector b) -> ChildCollector b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Either Text a -> ChildCollector a
    forall a. Either Text a -> ChildCollector a
    toChildCollector (Either Text a -> ChildCollector a)
    -> (Node -> Either Text a) -> Node -> ChildCollector a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Node -> Either Text a
    parse)

    childListAny :: (FromXenoNode a) => Node -> Either Text [a]
    childListAny :: forall a. FromXenoNode a => Node -> Either Text [a]
    childListAny = (Node -> Either Text a) -> [Node] -> Either Text [a]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Node -> Either Text a
    forall a. FromXenoNode a => Node -> Either Text a
    fromXenoNode ([Node] -> Either Text [a])
    -> (Node -> [Node]) -> Node -> Either Text [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Node -> [Node]
    children

    maybeElementVal :: (FromAttrBs a) => ByteString -> ChildCollector (Maybe a)
    maybeElementVal :: forall a. FromAttrBs a => ByteString -> ChildCollector (Maybe a)
    maybeElementVal ByteString
    nm = do
      Maybe Node
    mN <- ByteString -> ChildCollector (Maybe Node)
    maybeChild ByteString
    nm
      (Maybe (Maybe a) -> Maybe a)
    -> ChildCollector (Maybe (Maybe a)) -> ChildCollector (Maybe a)
    forall a b. (a -> b) -> ChildCollector a -> ChildCollector b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Maybe (Maybe a) -> Maybe a
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (ChildCollector (Maybe (Maybe a)) -> ChildCollector (Maybe a))
    -> ((Node -> ChildCollector (Maybe a))
        -> ChildCollector (Maybe (Maybe a)))
    -> (Node -> ChildCollector (Maybe a))
    -> ChildCollector (Maybe a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Node
    -> (Node -> ChildCollector (Maybe a))
    -> ChildCollector (Maybe (Maybe a))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM Maybe Node
    mN ((Node -> ChildCollector (Maybe a)) -> ChildCollector (Maybe a))
    -> (Node -> ChildCollector (Maybe a)) -> ChildCollector (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ \Node
    n ->
        Either Text (Maybe a) -> ChildCollector (Maybe a)
    forall a. Either Text a -> ChildCollector a
    toChildCollector (Either Text (Maybe a) -> ChildCollector (Maybe a))
    -> (AttrParser (Maybe a) -> Either Text (Maybe a))
    -> AttrParser (Maybe a)
    -> ChildCollector (Maybe a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Node -> AttrParser (Maybe a) -> Either Text (Maybe a)
    forall a. Node -> AttrParser a -> Either Text a
    parseAttributes Node
    n (AttrParser (Maybe a) -> ChildCollector (Maybe a))
    -> AttrParser (Maybe a) -> ChildCollector (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ ByteString -> AttrParser (Maybe a)
    forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
    maybeAttr ByteString
    "val"

    -- Stolen from XML Conduit
    newtype AttrParser a = AttrParser
      { forall a.
    AttrParser a
    -> [(ByteString, ByteString)]
    -> Either Text ([(ByteString, ByteString)], a)
    runAttrParser :: [(ByteString, ByteString)] -> Either Text ( [( ByteString
                                                                      , ByteString)]
                                                                   , a)
      }

    instance Monad AttrParser where
      return :: forall a. a -> AttrParser a
    return a
    a = ([(ByteString, ByteString)]
     -> Either Text ([(ByteString, ByteString)], a))
    -> AttrParser a
    forall a.
    ([(ByteString, ByteString)]
     -> Either Text ([(ByteString, ByteString)], a))
    -> AttrParser a
    AttrParser (([(ByteString, ByteString)]
      -> Either Text ([(ByteString, ByteString)], a))
     -> AttrParser a)
    -> ([(ByteString, ByteString)]
        -> Either Text ([(ByteString, ByteString)], a))
    -> AttrParser a
    forall a b. (a -> b) -> a -> b
    $ \[(ByteString, ByteString)]
    as -> ([(ByteString, ByteString)], a)
    -> Either Text ([(ByteString, ByteString)], a)
    forall a b. b -> Either a b
    Right ([(ByteString, ByteString)]
    as, a
    a)
      (AttrParser [(ByteString, ByteString)]
    -> Either Text ([(ByteString, ByteString)], a)
    f) >>= :: forall a b. AttrParser a -> (a -> AttrParser b) -> AttrParser b
    >>= a -> AttrParser b
    g =
        ([(ByteString, ByteString)]
     -> Either Text ([(ByteString, ByteString)], b))
    -> AttrParser b
    forall a.
    ([(ByteString, ByteString)]
     -> Either Text ([(ByteString, ByteString)], a))
    -> AttrParser a
    AttrParser (([(ByteString, ByteString)]
      -> Either Text ([(ByteString, ByteString)], b))
     -> AttrParser b)
    -> ([(ByteString, ByteString)]
        -> Either Text ([(ByteString, ByteString)], b))
    -> AttrParser b
    forall a b. (a -> b) -> a -> b
    $ \[(ByteString, ByteString)]
    as ->
          (Text -> Either Text ([(ByteString, ByteString)], b))
    -> (([(ByteString, ByteString)], a)
        -> Either Text ([(ByteString, ByteString)], b))
    -> Either Text ([(ByteString, ByteString)], a)
    -> Either Text ([(ByteString, ByteString)], b)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Text -> Either Text ([(ByteString, ByteString)], b)
    forall a b. a -> Either a b
    Left (\([(ByteString, ByteString)]
    as', a
    f') -> AttrParser b
    -> [(ByteString, ByteString)]
    -> Either Text ([(ByteString, ByteString)], b)
    forall a.
    AttrParser a
    -> [(ByteString, ByteString)]
    -> Either Text ([(ByteString, ByteString)], a)
    runAttrParser (a -> AttrParser b
    g a
    f') [(ByteString, ByteString)]
    as') ([(ByteString, ByteString)]
    -> Either Text ([(ByteString, ByteString)], a)
    f [(ByteString, ByteString)]
    as)
    instance Applicative AttrParser where
        pure :: forall a. a -> AttrParser a
    pure = a -> AttrParser a
    forall a. a -> AttrParser a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
        <*> :: forall a b. AttrParser (a -> b) -> AttrParser a -> AttrParser b
    (<*>) = AttrParser (a -> b) -> AttrParser a -> AttrParser b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap
    instance Functor AttrParser where
      fmap :: forall a b. (a -> b) -> AttrParser a -> AttrParser b
    fmap = (a -> b) -> AttrParser a -> AttrParser b
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM

    attrError :: Text -> AttrParser a
    attrError :: forall a. Text -> AttrParser a
    attrError Text
    err = ([(ByteString, ByteString)]
     -> Either Text ([(ByteString, ByteString)], a))
    -> AttrParser a
    forall a.
    ([(ByteString, ByteString)]
     -> Either Text ([(ByteString, ByteString)], a))
    -> AttrParser a
    AttrParser (([(ByteString, ByteString)]
      -> Either Text ([(ByteString, ByteString)], a))
     -> AttrParser a)
    -> ([(ByteString, ByteString)]
        -> Either Text ([(ByteString, ByteString)], a))
    -> AttrParser a
    forall a b. (a -> b) -> a -> b
    $ \[(ByteString, ByteString)]
    _ -> Text -> Either Text ([(ByteString, ByteString)], a)
    forall a b. a -> Either a b
    Left Text
    err

    toAttrParser :: Either Text a -> AttrParser a
    toAttrParser :: forall a. Either Text a -> AttrParser a
    toAttrParser Either Text a
    unlifted =
      case Either Text a
    unlifted of
        Right a
    a -> a -> AttrParser a
    forall a. a -> AttrParser a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a
        Left Text
    e -> ([(ByteString, ByteString)]
     -> Either Text ([(ByteString, ByteString)], a))
    -> AttrParser a
    forall a.
    ([(ByteString, ByteString)]
     -> Either Text ([(ByteString, ByteString)], a))
    -> AttrParser a
    AttrParser (([(ByteString, ByteString)]
      -> Either Text ([(ByteString, ByteString)], a))
     -> AttrParser a)
    -> ([(ByteString, ByteString)]
        -> Either Text ([(ByteString, ByteString)], a))
    -> AttrParser a
    forall a b. (a -> b) -> a -> b
    $ \[(ByteString, ByteString)]
    _ -> Text -> Either Text ([(ByteString, ByteString)], a)
    forall a b. a -> Either a b
    Left Text
    e

    maybeAttrBs :: ByteString -> AttrParser (Maybe ByteString)
    maybeAttrBs :: ByteString -> AttrParser (Maybe ByteString)
    maybeAttrBs ByteString
    attrName = ([(ByteString, ByteString)]
     -> Either Text ([(ByteString, ByteString)], Maybe ByteString))
    -> AttrParser (Maybe ByteString)
    forall a.
    ([(ByteString, ByteString)]
     -> Either Text ([(ByteString, ByteString)], a))
    -> AttrParser a
    AttrParser (([(ByteString, ByteString)]
      -> Either Text ([(ByteString, ByteString)], Maybe ByteString))
     -> AttrParser (Maybe ByteString))
    -> ([(ByteString, ByteString)]
        -> Either Text ([(ByteString, ByteString)], Maybe ByteString))
    -> AttrParser (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
    -> [(ByteString, ByteString)]
    -> Either Text ([(ByteString, ByteString)], Maybe ByteString)
    forall {a} {c} {a}.
    ([(ByteString, a)] -> c)
    -> [(ByteString, a)] -> Either a (c, Maybe a)
    go [(ByteString, ByteString)] -> [(ByteString, ByteString)]
    forall a. a -> a
    id
      where
        go :: ([(ByteString, a)] -> c)
    -> [(ByteString, a)] -> Either a (c, Maybe a)
    go [(ByteString, a)] -> c
    front [] = (c, Maybe a) -> Either a (c, Maybe a)
    forall a b. b -> Either a b
    Right ([(ByteString, a)] -> c
    front [], Maybe a
    forall a. Maybe a
    Nothing)
        go [(ByteString, a)] -> c
    front (a :: (ByteString, a)
    a@(ByteString
    nm, a
    val):[(ByteString, a)]
    as) =
          if ByteString
    nm ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    attrName
            then (c, Maybe a) -> Either a (c, Maybe a)
    forall a b. b -> Either a b
    Right ([(ByteString, a)] -> c
    front [(ByteString, a)]
    as, a -> Maybe a
    forall a. a -> Maybe a
    Just a
    val)
            else ([(ByteString, a)] -> c)
    -> [(ByteString, a)] -> Either a (c, Maybe a)
    go ([(ByteString, a)] -> c
    front ([(ByteString, a)] -> c)
    -> ([(ByteString, a)] -> [(ByteString, a)])
    -> [(ByteString, a)]
    -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (:) (ByteString, a)
    a) [(ByteString, a)]
    as

    requireAttrBs :: ByteString -> AttrParser ByteString
    requireAttrBs :: ByteString -> AttrParser ByteString
    requireAttrBs ByteString
    nm = do
      Maybe ByteString
    mVal <- ByteString -> AttrParser (Maybe ByteString)
    maybeAttrBs ByteString
    nm
      case Maybe ByteString
    mVal of
        Just ByteString
    val -> ByteString -> AttrParser ByteString
    forall a. a -> AttrParser a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    val
        Maybe ByteString
    Nothing -> Text -> AttrParser ByteString
    forall a. Text -> AttrParser a
    attrError (Text -> AttrParser ByteString) -> Text -> AttrParser ByteString
    forall a b. (a -> b) -> a -> b
    $ Text
    "attribute " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack (ByteString -> String
    forall a. Show a => a -> String
    show ByteString
    nm) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " is required"

    unexpectedAttrBs :: Text -> ByteString -> Either Text a
    unexpectedAttrBs :: forall a. Text -> ByteString -> Either Text a
    unexpectedAttrBs Text
    typ ByteString
    val =
      Text -> Either Text a
    forall a b. a -> Either a b
    Left (Text -> Either Text a) -> Text -> Either Text a
    forall a b. (a -> b) -> a -> b
    $ Text
    "Unexpected value for " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    typ Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ": " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack (ByteString -> String
    forall a. Show a => a -> String
    show ByteString
    val)

    fromAttr :: FromAttrBs a => ByteString -> AttrParser a
    fromAttr :: forall a. FromAttrBs a => ByteString -> AttrParser a
    fromAttr ByteString
    nm = do
      ByteString
    bs <- ByteString -> AttrParser ByteString
    requireAttrBs ByteString
    nm
      Either Text a -> AttrParser a
    forall a. Either Text a -> AttrParser a
    toAttrParser (Either Text a -> AttrParser a) -> Either Text a -> AttrParser a
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Either Text a
    forall a. FromAttrBs a => ByteString -> Either Text a
    fromAttrBs ByteString
    bs

    maybeAttr :: FromAttrBs a => ByteString -> AttrParser (Maybe a)
    maybeAttr :: forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
    maybeAttr ByteString
    nm = do
      Maybe ByteString
    mBs <- ByteString -> AttrParser (Maybe ByteString)
    maybeAttrBs ByteString
    nm
      Maybe ByteString
    -> (ByteString -> AttrParser a) -> AttrParser (Maybe a)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM Maybe ByteString
    mBs (Either Text a -> AttrParser a
    forall a. Either Text a -> AttrParser a
    toAttrParser (Either Text a -> AttrParser a)
    -> (ByteString -> Either Text a) -> ByteString -> AttrParser a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Either Text a
    forall a. FromAttrBs a => ByteString -> Either Text a
    fromAttrBs)

    fromAttrDef :: FromAttrBs a => ByteString -> a -> AttrParser a
    fromAttrDef :: forall a. FromAttrBs a => ByteString -> a -> AttrParser a
    fromAttrDef ByteString
    nm a
    defVal = a -> Maybe a -> a
    forall a. a -> Maybe a -> a
    fromMaybe a
    defVal (Maybe a -> a) -> AttrParser (Maybe a) -> AttrParser a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ByteString -> AttrParser (Maybe a)
    forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
    maybeAttr ByteString
    nm

    parseAttributes :: Node -> AttrParser a -> Either Text a
    parseAttributes :: forall a. Node -> AttrParser a -> Either Text a
    parseAttributes Node
    n AttrParser a
    attrParser =
      case AttrParser a
    -> [(ByteString, ByteString)]
    -> Either Text ([(ByteString, ByteString)], a)
    forall a.
    AttrParser a
    -> [(ByteString, ByteString)]
    -> Either Text ([(ByteString, ByteString)], a)
    runAttrParser AttrParser a
    attrParser (Node -> [(ByteString, ByteString)]
    attributes Node
    n) of
        Left Text
    e -> Text -> Either Text a
    forall a b. a -> Either a b
    Left Text
    e
        Right ([(ByteString, ByteString)]
    _, a
    a) -> a -> Either Text a
    forall a. a -> Either Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a

    class FromAttrBs a where
      fromAttrBs :: ByteString -> Either Text a

    instance FromAttrBs ByteString where
      fromAttrBs :: ByteString -> Either Text ByteString
    fromAttrBs = ByteString -> Either Text ByteString
    forall a. a -> Either Text a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure

    instance FromAttrBs Bool where
        fromAttrBs :: ByteString -> Either Text Bool
    fromAttrBs ByteString
    x | ByteString
    x ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "1" Bool -> Bool -> Bool
    || ByteString
    x ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "true"  = Bool -> Either Text Bool
    forall a. a -> Either Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
                     | ByteString
    x ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "0" Bool -> Bool -> Bool
    || ByteString
    x ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "false" = Bool -> Either Text Bool
    forall a. a -> Either Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
                     | Bool
    otherwise                = Text -> ByteString -> Either Text Bool
    forall a. Text -> ByteString -> Either Text a
    unexpectedAttrBs Text
    "boolean" ByteString
    x

    instance FromAttrBs Int where
      -- it appears that parser in text is more optimized than the one in
      -- attoparsec at least as of text-1.2.2.2 and attoparsec-0.13.1.0
      fromAttrBs :: ByteString -> Either Text Int
    fromAttrBs = (String -> Text) -> Either String Int -> Either Text Int
    forall a b c. (a -> b) -> Either a c -> Either b c
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first String -> Text
    T.pack (Either String Int -> Either Text Int)
    -> (ByteString -> Either String Int)
    -> ByteString
    -> Either Text Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Either String Int
    forall a. Integral a => Text -> Either String a
    eitherDecimal (Text -> Either String Int)
    -> (ByteString -> Text) -> ByteString -> Either String Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Text
    T.decodeLatin1

    instance FromAttrBs Double where
      -- as for rationals
      fromAttrBs :: ByteString -> Either Text Double
    fromAttrBs = (String -> Text) -> Either String Double -> Either Text Double
    forall a b c. (a -> b) -> Either a c -> Either b c
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first String -> Text
    T.pack (Either String Double -> Either Text Double)
    -> (ByteString -> Either String Double)
    -> ByteString
    -> Either Text Double
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Either String Double
    eitherRational (Text -> Either String Double)
    -> (ByteString -> Text) -> ByteString -> Either String Double
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Text
    T.decodeLatin1

    instance FromAttrBs Text where
      fromAttrBs :: ByteString -> Either Text Text
    fromAttrBs = ByteString -> Either Text Text
    replaceEntititesBs

    replaceEntititesBs :: ByteString -> Either Text Text
    replaceEntititesBs :: ByteString -> Either Text Text
    replaceEntititesBs ByteString
    str =
      ByteString -> Text
    T.decodeUtf8 (ByteString -> Text)
    -> ([ByteString] -> ByteString) -> [ByteString] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ByteString] -> ByteString
    BS.concat ([ByteString] -> Text)
    -> Either Text [ByteString] -> Either Text Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Either Text [ByteString]
    findAmp Int
    0
      where
        findAmp :: Int -> Either Text [ByteString]
        findAmp :: Int -> Either Text [ByteString]
    findAmp Int
    index =
          case Word8 -> ByteString -> Int -> Maybe Int
    elemIndexFrom Word8
    ampersand ByteString
    str Int
    index of
            Maybe Int
    Nothing -> if ByteString -> Bool
    BS.null ByteString
    text then [ByteString] -> Either Text [ByteString]
    forall a. a -> Either Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [] else [ByteString] -> Either Text [ByteString]
    forall a. a -> Either Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ByteString
    text]
              where text :: ByteString
    text = Int -> ByteString -> ByteString
    BS.drop Int
    index ByteString
    str
            Just Int
    fromAmp ->
              if ByteString -> Bool
    BS.null ByteString
    text
                 then Int -> Either Text [ByteString]
    checkEntity Int
    fromAmp
                 else (ByteString
    textByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :) ([ByteString] -> [ByteString])
    -> Either Text [ByteString] -> Either Text [ByteString]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Either Text [ByteString]
    checkEntity Int
    fromAmp
              where text :: ByteString
    text = ByteString -> Int -> Int -> ByteString
    substring ByteString
    str Int
    index Int
    fromAmp
        checkEntity :: Int -> Either Text [ByteString]
    checkEntity Int
    index =
          case Word8 -> ByteString -> Int -> Maybe Int
    elemIndexFrom Word8
    semicolon ByteString
    str Int
    index of
            Just Int
    fromSemi | Int
    fromSemi Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    index Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3 -> do
                              Word8
    entity <- Int -> Int -> Either Text Word8
    forall {a}. (Num a, Enum a) => Int -> Int -> Either Text a
    checkElementVal (Int
    index Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int
    fromSemi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    index Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
                              (Word8 -> ByteString
    BS.singleton Word8
    entityByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :) ([ByteString] -> [ByteString])
    -> Either Text [ByteString] -> Either Text [ByteString]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Either Text [ByteString]
    findAmp (Int
    fromSemi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
            Maybe Int
    _ -> Text -> Either Text [ByteString]
    forall a b. a -> Either a b
    Left Text
    "Unending entity"
        checkElementVal :: Int -> Int -> Either Text a
    checkElementVal Int
    index Int
    len =
          if | Int
    len Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    2
               Bool -> Bool -> Bool
    && ByteString -> Int -> Word8
    s_index ByteString
    this Int
    0 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    108 -- l
               Bool -> Bool -> Bool
    && ByteString -> Int -> Word8
    s_index ByteString
    this Int
    1 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    116 -- t
                -> a -> Either Text a
    forall a. a -> Either Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    60 -- '<'
             | Int
    len Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    2
               Bool -> Bool -> Bool
    && ByteString -> Int -> Word8
    s_index ByteString
    this Int
    0 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    103 -- g
               Bool -> Bool -> Bool
    && ByteString -> Int -> Word8
    s_index ByteString
    this Int
    1 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    116 -- t
                -> a -> Either Text a
    forall a. a -> Either Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    62 -- '>'
             | Int
    len Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    3
               Bool -> Bool -> Bool
    && ByteString -> Int -> Word8
    s_index ByteString
    this Int
    0 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    ==  Word8
    97 -- a
               Bool -> Bool -> Bool
    && ByteString -> Int -> Word8
    s_index ByteString
    this Int
    1 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    109 -- m
               Bool -> Bool -> Bool
    && ByteString -> Int -> Word8
    s_index ByteString
    this Int
    2 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    112 -- p
                -> a -> Either Text a
    forall a. a -> Either Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    38 -- '&'
             | Int
    len Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    4
               Bool -> Bool -> Bool
    && ByteString -> Int -> Word8
    s_index ByteString
    this Int
    0 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    113 -- q
               Bool -> Bool -> Bool
    && ByteString -> Int -> Word8
    s_index ByteString
    this Int
    1 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    117 -- u
               Bool -> Bool -> Bool
    && ByteString -> Int -> Word8
    s_index ByteString
    this Int
    2 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    111 -- o
               Bool -> Bool -> Bool
    && ByteString -> Int -> Word8
    s_index ByteString
    this Int
    3 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    116 -- t
                -> a -> Either Text a
    forall a. a -> Either Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    34 -- '"'
             | Int
    len Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    4
               Bool -> Bool -> Bool
    && ByteString -> Int -> Word8
    s_index ByteString
    this Int
    0 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    ==  Word8
    97 -- a
               Bool -> Bool -> Bool
    && ByteString -> Int -> Word8
    s_index ByteString
    this Int
    1 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    112 -- p
               Bool -> Bool -> Bool
    && ByteString -> Int -> Word8
    s_index ByteString
    this Int
    2 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    111 -- o
               Bool -> Bool -> Bool
    && ByteString -> Int -> Word8
    s_index ByteString
    this Int
    3 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    115 -- s
               -> a -> Either Text a
    forall a. a -> Either Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    39 -- '\''
             |    ByteString -> Int -> Word8
    s_index ByteString
    this Int
    0 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    35  -- '#'
               ->
               if ByteString -> Int -> Word8
    s_index ByteString
    this Int
    1 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    120 -- 'x'
                  then Int -> a
    forall a. Enum a => Int -> a
    toEnum (Int -> a) -> Either Text Int -> Either Text a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Int -> Either Text Int
    checkHexadecimal (Int
    index Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2) (Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2)
                  else Int -> a
    forall a. Enum a => Int -> a
    toEnum (Int -> a) -> Either Text Int -> Either Text a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Int -> Either Text Int
    checkDecimal (Int
    index Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
             | Bool
    otherwise -> Text -> Either Text a
    forall a b. a -> Either a b
    Left (Text -> Either Text a) -> Text -> Either Text a
    forall a b. (a -> b) -> a -> b
    $ Text
    "Bad entity " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack (ByteString -> String
    forall a. Show a => a -> String
    show (ByteString -> String) -> ByteString -> String
    forall a b. (a -> b) -> a -> b
    $ (ByteString -> Int -> Int -> ByteString
    substring ByteString
    str (Int
    indexInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) (Int
    indexInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    lenInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)))
          where
            this :: ByteString
    this = Int -> ByteString -> ByteString
    BS.drop Int
    index ByteString
    str
        checkDecimal :: Int -> Int -> Either Text Int
    checkDecimal Int
    index Int
    len = (Either Text Int -> Word8 -> Either Text Int)
    -> Either Text Int -> ByteString -> Either Text Int
    forall a. (a -> Word8 -> a) -> a -> ByteString -> a
    BS.foldl' Either Text Int -> Word8 -> Either Text Int
    go (Int -> Either Text Int
    forall a b. b -> Either a b
    Right Int
    0) (ByteString -> Int -> Int -> ByteString
    substring ByteString
    str Int
    index (Int
    index Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    len))
          where
            go :: Either Text Int -> Word8 -> Either Text Int
            go :: Either Text Int -> Word8 -> Either Text Int
    go Either Text Int
    prev Word8
    c = do
              Int
    a <- Either Text Int
    prev
              if Word8
    c Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word8
    48 Bool -> Bool -> Bool
    && Word8
    c Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    57
                then Int -> Either Text Int
    forall a. a -> Either Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Either Text Int) -> Int -> Either Text Int
    forall a b. (a -> b) -> a -> b
    $ Int
    a Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    10 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8
    c Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    - Word8
    48)
                else Text -> Either Text Int
    forall a b. a -> Either a b
    Left (Text -> Either Text Int) -> Text -> Either Text Int
    forall a b. (a -> b) -> a -> b
    $ Text
    "Expected decimal digit but encountered " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack (Char -> String
    forall a. Show a => a -> String
    show (Int -> Char
    chr (Int -> Char) -> Int -> Char
    forall a b. (a -> b) -> a -> b
    $ Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    c))
        checkHexadecimal :: Int -> Int -> Either Text Int
    checkHexadecimal Int
    index Int
    len = (Either Text Int -> Word8 -> Either Text Int)
    -> Either Text Int -> ByteString -> Either Text Int
    forall a. (a -> Word8 -> a) -> a -> ByteString -> a
    BS.foldl' Either Text Int -> Word8 -> Either Text Int
    go (Int -> Either Text Int
    forall a b. b -> Either a b
    Right Int
    0) (ByteString -> Int -> Int -> ByteString
    substring ByteString
    str Int
    index (Int
    index Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    len))
          where
            go :: Either Text Int -> Word8 -> Either Text Int
            go :: Either Text Int -> Word8 -> Either Text Int
    go Either Text Int
    prev Word8
    c = do
              Int
    a <- Either Text Int
    prev
              if | Word8
    c Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word8
    48 Bool -> Bool -> Bool
    && Word8
    c Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    57
                   -> Int -> Either Text Int
    forall a. a -> Either Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Either Text Int) -> Int -> Either Text Int
    forall a b. (a -> b) -> a -> b
    $ (Int
    a Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    4) Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .|. Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8
    c Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    - Word8
    48)
                 | Word8
    c Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word8
    97 Bool -> Bool -> Bool
    && Word8
    c Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    122
                   -> Int -> Either Text Int
    forall a. a -> Either Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Either Text Int) -> Int -> Either Text Int
    forall a b. (a -> b) -> a -> b
    $ (Int
    a Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    4) Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .|. Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8
    c Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    - Word8
    87)
                 | Word8
    c Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word8
    65 Bool -> Bool -> Bool
    && Word8
    c Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    90
                   -> Int -> Either Text Int
    forall a. a -> Either Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Either Text Int) -> Int -> Either Text Int
    forall a b. (a -> b) -> a -> b
    $ (Int
    a Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    4) Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .|. Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8
    c Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    - Word8
    55)
                 | Bool
    otherwise
                   ->
                   Text -> Either Text Int
    forall a b. a -> Either a b
    Left (Text -> Either Text Int) -> Text -> Either Text Int
    forall a b. (a -> b) -> a -> b
    $ Text
    "Expected hexadecimal digit but encountered " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack (Char -> String
    forall a. Show a => a -> String
    show (Int -> Char
    chr (Int -> Char) -> Int -> Char
    forall a b. (a -> b) -> a -> b
    $ Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    c))
        ampersand :: Word8
    ampersand = Word8
    38
        semicolon :: Word8
    semicolon = Word8
    59

    data EntityReplaceException = EntityReplaceException deriving Int -> EntityReplaceException -> ShowS
    [EntityReplaceException] -> ShowS
    EntityReplaceException -> String
    (Int -> EntityReplaceException -> ShowS)
    -> (EntityReplaceException -> String)
    -> ([EntityReplaceException] -> ShowS)
    -> Show EntityReplaceException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> EntityReplaceException -> ShowS
    showsPrec :: Int -> EntityReplaceException -> ShowS
    $cshow :: EntityReplaceException -> String
    show :: EntityReplaceException -> String
    $cshowList :: [EntityReplaceException] -> ShowS
    showList :: [EntityReplaceException] -> ShowS
    Show

    instance Exception EntityReplaceException

    -- | /O(1)/ 'ByteString' index (subscript) operator, starting from 0.
    s_index :: ByteString -> Int -> Word8
    s_index :: ByteString -> Int -> Word8
    s_index ByteString
    ps Int
    n
        | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0             = EntityReplaceException -> Word8
    forall a e. Exception e => e -> a
    throw EntityReplaceException
    EntityReplaceException
        | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= ByteString -> Int
    BS.length ByteString
    ps = EntityReplaceException -> Word8
    forall a e. Exception e => e -> a
    throw EntityReplaceException
    EntityReplaceException
        | Bool
    otherwise         = ByteString
    ps ByteString -> Int -> Word8
    `SU.unsafeIndex` Int
    n
    {-# INLINE s_index #-}

    -- | Get index of an element starting from offset.
    elemIndexFrom :: Word8 -> ByteString -> Int -> Maybe Int
    elemIndexFrom :: Word8 -> ByteString -> Int -> Maybe Int
    elemIndexFrom Word8
    c ByteString
    str Int
    offset = (Int -> Int) -> Maybe Int -> Maybe Int
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    offset) (Word8 -> ByteString -> Maybe Int
    BS.elemIndex Word8
    c (Int -> ByteString -> ByteString
    BS.drop Int
    offset ByteString
    str))
    -- Without the INLINE below, the whole function is twice as slow and
    -- has linear allocation. See git commit with this comment for
    -- results.
    {-# INLINE elemIndexFrom #-}

    -- | Get a substring of a string.
    substring :: ByteString -> Int -> Int -> ByteString
    substring :: ByteString -> Int -> Int -> ByteString
    substring ByteString
    s Int
    start Int
    end = Int -> ByteString -> ByteString
    BS.take (Int
    end Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    start) (Int -> ByteString -> ByteString
    BS.drop Int
    start ByteString
    s)
    {-# INLINE substring #-}

    newtype NsPrefixes = NsPrefixes [(ByteString, ByteString)]

    nsPrefixes :: Node -> NsPrefixes
    nsPrefixes :: Node -> NsPrefixes
    nsPrefixes Node
    root =
      [(ByteString, ByteString)] -> NsPrefixes
    NsPrefixes ([(ByteString, ByteString)] -> NsPrefixes)
    -> (((ByteString, ByteString) -> Maybe (ByteString, ByteString))
        -> [(ByteString, ByteString)])
    -> ((ByteString, ByteString) -> Maybe (ByteString, ByteString))
    -> NsPrefixes
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (((ByteString, ByteString) -> Maybe (ByteString, ByteString))
     -> [(ByteString, ByteString)] -> [(ByteString, ByteString)])
    -> [(ByteString, ByteString)]
    -> ((ByteString, ByteString) -> Maybe (ByteString, ByteString))
    -> [(ByteString, ByteString)]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((ByteString, ByteString) -> Maybe (ByteString, ByteString))
    -> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Node -> [(ByteString, ByteString)]
    attributes Node
    root) (((ByteString, ByteString) -> Maybe (ByteString, ByteString))
     -> NsPrefixes)
    -> ((ByteString, ByteString) -> Maybe (ByteString, ByteString))
    -> NsPrefixes
    forall a b. (a -> b) -> a -> b
    $ \(ByteString
    nm, ByteString
    val) ->
        (ByteString
    val, ) (ByteString -> (ByteString, ByteString))
    -> Maybe ByteString -> Maybe (ByteString, ByteString)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ByteString -> ByteString -> Maybe ByteString
    BS.stripPrefix ByteString
    "xmlns:" ByteString
    nm

    addPrefix :: NsPrefixes -> ByteString -> (ByteString -> ByteString)
    addPrefix :: NsPrefixes -> ByteString -> ByteString -> ByteString
    addPrefix (NsPrefixes [(ByteString, ByteString)]
    prefixes) ByteString
    ns =
      (ByteString -> ByteString)
    -> (ByteString -> ByteString -> ByteString)
    -> Maybe ByteString
    -> ByteString
    -> ByteString
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ByteString -> ByteString
    forall a. a -> a
    id (\ByteString
    prefix ByteString
    nm -> [ByteString] -> ByteString
    BS.concat [ByteString
    prefix, ByteString
    ":", ByteString
    nm]) (Maybe ByteString -> ByteString -> ByteString)
    -> Maybe ByteString -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [(ByteString, ByteString)] -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    Prelude.lookup ByteString
    ns [(ByteString, ByteString)]
    prefixes

    contentBs :: Node -> ByteString
    contentBs :: Node -> ByteString
    contentBs Node
    n = [ByteString] -> ByteString
    BS.concat ([ByteString] -> ByteString)
    -> ([Content] -> [ByteString]) -> [Content] -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Content -> ByteString) -> [Content] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map Content -> ByteString
    toBs ([Content] -> ByteString) -> [Content] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Node -> [Content]
    contents Node
    n
      where
        toBs :: Content -> ByteString
    toBs (Element Node
    _) = ByteString
    BS.empty
        toBs (Text ByteString
    bs) = ByteString
    bs
        toBs (CData ByteString
    bs) = ByteString
    bs

    contentX :: Node -> Either Text Text
    contentX :: Node -> Either Text Text
    contentX = ByteString -> Either Text Text
    replaceEntititesBs (ByteString -> Either Text Text)
    -> (Node -> ByteString) -> Node -> Either Text Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Node -> ByteString
    contentBs