module XmlParser.AstParser
  ( -- * Execution
    parseElement,
    renderElementError,
    ElementError (..),
    NodeType (..),

    -- * Parsers by context

    -- ** Element
    Element,
    elementName,
    elementNameIs,
    children,
    childrenByName,
    attributesByName,
    astElement,

    -- ** Nodes
    Nodes,
    elementNode,
    contentNode,

    -- ** ByName
    ByName,
    byName,

    -- ** Content
    Content,
    textContent,
    narrowedContent,
    refinedContent,
    enumContent,
    attoparsedContent,
    qNameContent,
  )
where

import qualified Data.Attoparsec.Text as Attoparsec
import qualified Data.HashMap.Strict as HashMap
import qualified Data.List as List
import qualified Text.Builder as Tb
import qualified Text.XML as Xml
import qualified XmlParser.Attoparsec as Attoparsec
import qualified XmlParser.ElementDestructionState as ElementDestructionState
import qualified XmlParser.NameMap as NameMap
import qualified XmlParser.NamespaceRegistry as NamespaceRegistry
import qualified XmlParser.NodeConsumerState as NodeConsumerState
import XmlParser.Prelude

-- |
-- Parse an \"xml-conduit\" element AST.
parseElement :: Element a -> Xml.Element -> Either ElementError a
parseElement :: Element a -> Element -> Either ElementError a
parseElement (Element NamespaceRegistry
-> Element
-> ElementDestructionState
-> Either ElementError (a, ElementDestructionState)
run) Element
element =
  NamespaceRegistry
-> Element
-> ElementDestructionState
-> Either ElementError (a, ElementDestructionState)
run
    (Map Name Text -> NamespaceRegistry -> NamespaceRegistry
NamespaceRegistry.interpretAttributes (Element -> Map Name Text
Xml.elementAttributes Element
element) NamespaceRegistry
NamespaceRegistry.new)
    Element
element
    ElementDestructionState
ElementDestructionState.new
    Either ElementError (a, ElementDestructionState)
-> (Either ElementError (a, ElementDestructionState)
    -> Either ElementError a)
-> Either ElementError a
forall a b. a -> (a -> b) -> b
& ((a, ElementDestructionState) -> a)
-> Either ElementError (a, ElementDestructionState)
-> Either ElementError a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, ElementDestructionState) -> a
forall a b. (a, b) -> a
fst

renderElementError :: ElementError -> Text
renderElementError :: ElementError -> Text
renderElementError =
  Builder -> Text
Tb.run (Builder -> Text)
-> (ElementError -> Builder) -> ElementError -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\([Builder]
a, Builder
b) -> Builder
"/" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> [Builder] -> Builder
forall (foldable :: * -> *).
Foldable foldable =>
Builder -> foldable Builder -> Builder
Tb.intercalate Builder
"/" ([Builder] -> [Builder]
forall a. [a] -> [a]
reverse [Builder]
a) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
": " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b) (([Builder], Builder) -> Builder)
-> (ElementError -> ([Builder], Builder))
-> ElementError
-> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ElementError -> ([Builder], Builder)
simplifyElementError

simplifyElementError :: ElementError -> ([Tb.Builder], Tb.Builder)
simplifyElementError :: ElementError -> ([Builder], Builder)
simplifyElementError =
  [Builder] -> ElementError -> ([Builder], Builder)
elementError []
  where
    sortedList :: (a -> Builder) -> [a] -> Builder
sortedList a -> Builder
renderer =
      Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend Builder
"[" (Builder -> Builder) -> ([a] -> Builder) -> [a] -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Builder -> Builder -> Builder) -> Builder -> Builder -> Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend Builder
"]" (Builder -> Builder) -> ([a] -> Builder) -> [a] -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> [Builder] -> Builder
forall (foldable :: * -> *).
Foldable foldable =>
Builder -> foldable Builder -> Builder
Tb.intercalate Builder
", " ([Builder] -> Builder) -> ([a] -> [Builder]) -> [a] -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> Builder) -> [a] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Builder
renderer ([a] -> [Builder]) -> ([a] -> [a]) -> [a] -> [Builder]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
sort
    name :: Maybe a -> Text -> Builder
name Maybe a
a Text
b =
      case Maybe a
a of
        Just a
_ -> Text -> Builder
Tb.text Text
b
        Maybe a
Nothing -> Text -> Builder
Tb.text Text
b
    elementError :: [Builder] -> ElementError -> ([Builder], Builder)
elementError [Builder]
collectedPath = \case
      NoneOfChildrenFoundByNameElementError [(Maybe Text, Text)]
a [(Maybe Text, Text)]
b ->
        ( [Builder]
collectedPath,
          Builder
"None of following child element names found: "
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ((Maybe Text, Text) -> Builder) -> [(Maybe Text, Text)] -> Builder
forall a. Ord a => (a -> Builder) -> [a] -> Builder
sortedList ((Maybe Text -> Text -> Builder) -> (Maybe Text, Text) -> Builder
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe Text -> Text -> Builder
forall a. Maybe a -> Text -> Builder
name) [(Maybe Text, Text)]
a
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
". Names available: "
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ((Maybe Text, Text) -> Builder) -> [(Maybe Text, Text)] -> Builder
forall a. Ord a => (a -> Builder) -> [a] -> Builder
sortedList ((Maybe Text -> Text -> Builder) -> (Maybe Text, Text) -> Builder
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe Text -> Text -> Builder
forall a. Maybe a -> Text -> Builder
name) [(Maybe Text, Text)]
b
        )
      ChildByNameElementError Maybe Text
a Text
b ElementError
c ->
        [Builder] -> ElementError -> ([Builder], Builder)
elementError (Maybe Text -> Text -> Builder
forall a. Maybe a -> Text -> Builder
name Maybe Text
a Text
b Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
collectedPath) ElementError
c
      ChildAtOffsetElementError Int
a NodeError
b ->
        [Builder] -> NodeError -> ([Builder], Builder)
nodeError (Int -> Builder
forall a. Integral a => a -> Builder
Tb.decimal Int
a Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
collectedPath) NodeError
b
      AttributeByNameElementError Maybe Text
a Text
b Maybe ContentError
c ->
        ((Builder
"@" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Text -> Builder
forall a. Maybe a -> Text -> Builder
name Maybe Text
a Text
b) Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
collectedPath, Maybe ContentError -> Builder
maybeContentError Maybe ContentError
c)
      NoneOfAttributesFoundByNameElementError [(Maybe Text, Text)]
a [(Maybe Text, Text)]
b ->
        ( [Builder]
collectedPath,
          Builder
"Found none of the following attributes: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ((Maybe Text, Text) -> Builder) -> [(Maybe Text, Text)] -> Builder
forall a. Ord a => (a -> Builder) -> [a] -> Builder
sortedList ((Maybe Text -> Text -> Builder) -> (Maybe Text, Text) -> Builder
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe Text -> Text -> Builder
forall a. Maybe a -> Text -> Builder
name) [(Maybe Text, Text)]
a
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
". The following are available: "
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ((Maybe Text, Text) -> Builder) -> [(Maybe Text, Text)] -> Builder
forall a. Ord a => (a -> Builder) -> [a] -> Builder
sortedList ((Maybe Text -> Text -> Builder) -> (Maybe Text, Text) -> Builder
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe Text -> Text -> Builder
forall a. Maybe a -> Text -> Builder
name) [(Maybe Text, Text)]
b
        )
      NameElementError Text
a ->
        ([Builder]
collectedPath, Text -> Builder
Tb.text Text
a)
      UserElementError Text
a ->
        ([Builder]
collectedPath, Text -> Builder
Tb.text Text
a)
    nodeError :: [Builder] -> NodeError -> ([Builder], Builder)
nodeError [Builder]
collectedPath = \case
      UnexpectedNodeTypeNodeError NodeType
a NodeType
b ->
        ( [Builder]
collectedPath,
          Builder
"Unexpected node type. Got " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NodeType -> Builder
forall p. IsString p => NodeType -> p
nodeType NodeType
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", but expected " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NodeType -> Builder
forall p. IsString p => NodeType -> p
nodeType NodeType
a
        )
      NodeError
NotAvailableNodeError ->
        ([Builder]
collectedPath, Builder
"No nodes left")
      ElementNodeError ElementError
a ->
        [Builder] -> ElementError -> ([Builder], Builder)
elementError [Builder]
collectedPath ElementError
a
      TextNodeError Maybe ContentError
a ->
        ([Builder]
collectedPath, Maybe ContentError -> Builder
maybeContentError Maybe ContentError
a)
    nodeType :: NodeType -> p
nodeType = \case
      NodeType
ElementNodeType -> p
"element"
      NodeType
InstructionNodeType -> p
"instruction"
      NodeType
ContentNodeType -> p
"content"
      NodeType
CommentNodeType -> p
"comment"
    maybeContentError :: Maybe ContentError -> Builder
maybeContentError = Builder
-> (ContentError -> Builder) -> Maybe ContentError -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"Empty alternative" ContentError -> Builder
contentError
    contentError :: ContentError -> Builder
contentError = \case
      UserContentError Text
a ->
        Text -> Builder
Tb.text Text
a
      ParsingContentError Text
a ->
        Text -> Builder
Tb.text Text
a
      NamespaceNotFoundContentError Text
a ->
        Builder
"Namespace not found: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Tb.text Text
a
      UnexpectedValueContentError Text
a ->
        Builder
"Unexpected value: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Tb.text Text
a
      EnumContentError [Text]
a Text
b ->
        Builder
"Unexpected value: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Tb.text Text
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
". Expecting one of the following: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder) -> [Text] -> Builder
forall a. Ord a => (a -> Builder) -> [a] -> Builder
sortedList Text -> Builder
Tb.text [Text]
a

-- |
-- Error in the context of an element.
--
-- It has a tree structure specifying the context of containing operations.
data ElementError
  = AttributeByNameElementError
      (Maybe Text)
      Text
      (Maybe ContentError)
  | NoneOfAttributesFoundByNameElementError
      [(Maybe Text, Text)]
      -- ^ Not found.
      [(Maybe Text, Text)]
      -- ^ Out of.
  | NoneOfChildrenFoundByNameElementError
      [(Maybe Text, Text)]
      -- ^ Not found.
      [(Maybe Text, Text)]
      -- ^ Out of.
  | ChildByNameElementError
      (Maybe Text)
      -- ^ Namespace.
      Text
      -- ^ Name.
      ElementError
      -- ^ Reason. Not 'NodeError' because only element nodes can be looked up by name.
  | ChildAtOffsetElementError
      Int
      -- ^ Offset.
      NodeError
      -- ^ Reason.
  | NameElementError Text
  | -- | Error raised by the user of this library.
    UserElementError Text

data NodeError
  = UnexpectedNodeTypeNodeError
      NodeType
      -- ^ Expected.
      NodeType
      -- ^ Actual.
  | NotAvailableNodeError
  | ElementNodeError ElementError
  | TextNodeError (Maybe ContentError)

data ContentError
  = ParsingContentError Text
  | NamespaceNotFoundContentError Text
  | UnexpectedValueContentError Text
  | EnumContentError
      [Text]
      -- ^ List of expected values.
      Text
      -- ^ Actual value
  | UserContentError Text

data NodeType
  = ElementNodeType
  | InstructionNodeType
  | ContentNodeType
  | CommentNodeType

-- |
-- Parse in the context of an element node.
newtype Element a
  = Element
      ( NamespaceRegistry.NamespaceRegistry ->
        Xml.Element ->
        ElementDestructionState.ElementDestructionState ->
        Either ElementError (a, ElementDestructionState.ElementDestructionState)
      )
  deriving
    (a -> Element b -> Element a
(a -> b) -> Element a -> Element b
(forall a b. (a -> b) -> Element a -> Element b)
-> (forall a b. a -> Element b -> Element a) -> Functor Element
forall a b. a -> Element b -> Element a
forall a b. (a -> b) -> Element a -> Element b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Element b -> Element a
$c<$ :: forall a b. a -> Element b -> Element a
fmap :: (a -> b) -> Element a -> Element b
$cfmap :: forall a b. (a -> b) -> Element a -> Element b
Functor, Functor Element
a -> Element a
Functor Element
-> (forall a. a -> Element a)
-> (forall a b. Element (a -> b) -> Element a -> Element b)
-> (forall a b c.
    (a -> b -> c) -> Element a -> Element b -> Element c)
-> (forall a b. Element a -> Element b -> Element b)
-> (forall a b. Element a -> Element b -> Element a)
-> Applicative Element
Element a -> Element b -> Element b
Element a -> Element b -> Element a
Element (a -> b) -> Element a -> Element b
(a -> b -> c) -> Element a -> Element b -> Element c
forall a. a -> Element a
forall a b. Element a -> Element b -> Element a
forall a b. Element a -> Element b -> Element b
forall a b. Element (a -> b) -> Element a -> Element b
forall a b c. (a -> b -> c) -> Element a -> Element b -> Element c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Element a -> Element b -> Element a
$c<* :: forall a b. Element a -> Element b -> Element a
*> :: Element a -> Element b -> Element b
$c*> :: forall a b. Element a -> Element b -> Element b
liftA2 :: (a -> b -> c) -> Element a -> Element b -> Element c
$cliftA2 :: forall a b c. (a -> b -> c) -> Element a -> Element b -> Element c
<*> :: Element (a -> b) -> Element a -> Element b
$c<*> :: forall a b. Element (a -> b) -> Element a -> Element b
pure :: a -> Element a
$cpure :: forall a. a -> Element a
$cp1Applicative :: Functor Element
Applicative, Applicative Element
a -> Element a
Applicative Element
-> (forall a b. Element a -> (a -> Element b) -> Element b)
-> (forall a b. Element a -> Element b -> Element b)
-> (forall a. a -> Element a)
-> Monad Element
Element a -> (a -> Element b) -> Element b
Element a -> Element b -> Element b
forall a. a -> Element a
forall a b. Element a -> Element b -> Element b
forall a b. Element a -> (a -> Element b) -> Element b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Element a
$creturn :: forall a. a -> Element a
>> :: Element a -> Element b -> Element b
$c>> :: forall a b. Element a -> Element b -> Element b
>>= :: Element a -> (a -> Element b) -> Element b
$c>>= :: forall a b. Element a -> (a -> Element b) -> Element b
$cp1Monad :: Applicative Element
Monad)
    via ( ReaderT
            (NamespaceRegistry.NamespaceRegistry)
            ( ReaderT
                Xml.Element
                ( StateT
                    ElementDestructionState.ElementDestructionState
                    (Except ElementError)
                )
            )
        )

instance MonadFail Element where
  fail :: String -> Element a
fail = String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (Text -> Element a) -> String -> Element a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> ElementError
UserElementError (Text -> ElementError)
-> (ElementError -> Element a) -> Text -> Element a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ElementError -> Either ElementError (a, ElementDestructionState)
forall a b. a -> Either a b
Left (ElementError -> Either ElementError (a, ElementDestructionState))
-> (Either ElementError (a, ElementDestructionState) -> Element a)
-> ElementError
-> Element a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Either ElementError (a, ElementDestructionState)
-> ElementDestructionState
-> Either ElementError (a, ElementDestructionState)
forall a b. a -> b -> a
const (Either ElementError (a, ElementDestructionState)
 -> ElementDestructionState
 -> Either ElementError (a, ElementDestructionState))
-> ((ElementDestructionState
     -> Either ElementError (a, ElementDestructionState))
    -> Element a)
-> Either ElementError (a, ElementDestructionState)
-> Element a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (ElementDestructionState
 -> Either ElementError (a, ElementDestructionState))
-> Element
-> ElementDestructionState
-> Either ElementError (a, ElementDestructionState)
forall a b. a -> b -> a
const ((ElementDestructionState
  -> Either ElementError (a, ElementDestructionState))
 -> Element
 -> ElementDestructionState
 -> Either ElementError (a, ElementDestructionState))
-> ((Element
     -> ElementDestructionState
     -> Either ElementError (a, ElementDestructionState))
    -> Element a)
-> (ElementDestructionState
    -> Either ElementError (a, ElementDestructionState))
-> Element a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Element
 -> ElementDestructionState
 -> Either ElementError (a, ElementDestructionState))
-> NamespaceRegistry
-> Element
-> ElementDestructionState
-> Either ElementError (a, ElementDestructionState)
forall a b. a -> b -> a
const ((Element
  -> ElementDestructionState
  -> Either ElementError (a, ElementDestructionState))
 -> NamespaceRegistry
 -> Element
 -> ElementDestructionState
 -> Either ElementError (a, ElementDestructionState))
-> ((NamespaceRegistry
     -> Element
     -> ElementDestructionState
     -> Either ElementError (a, ElementDestructionState))
    -> Element a)
-> (Element
    -> ElementDestructionState
    -> Either ElementError (a, ElementDestructionState))
-> Element a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (NamespaceRegistry
 -> Element
 -> ElementDestructionState
 -> Either ElementError (a, ElementDestructionState))
-> Element a
forall a.
(NamespaceRegistry
 -> Element
 -> ElementDestructionState
 -> Either ElementError (a, ElementDestructionState))
-> Element a
Element

-- |
-- Parse namespace and name with the given function.
elementName :: (Maybe Text -> Text -> Either Text a) -> Element a
elementName :: (Maybe Text -> Text -> Either Text a) -> Element a
elementName Maybe Text -> Text -> Either Text a
parse =
  (NamespaceRegistry
 -> Element
 -> ElementDestructionState
 -> Either ElementError (a, ElementDestructionState))
-> Element a
forall a.
(NamespaceRegistry
 -> Element
 -> ElementDestructionState
 -> Either ElementError (a, ElementDestructionState))
-> Element a
Element ((NamespaceRegistry
  -> Element
  -> ElementDestructionState
  -> Either ElementError (a, ElementDestructionState))
 -> Element a)
-> (NamespaceRegistry
    -> Element
    -> ElementDestructionState
    -> Either ElementError (a, ElementDestructionState))
-> Element a
forall a b. (a -> b) -> a -> b
$ \NamespaceRegistry
nreg (Xml.Element Name
name Map Name Text
_ [Node]
_) ElementDestructionState
state ->
    (a -> (a, ElementDestructionState))
-> Either ElementError a
-> Either ElementError (a, ElementDestructionState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,ElementDestructionState
state) (Either ElementError a
 -> Either ElementError (a, ElementDestructionState))
-> Either ElementError a
-> Either ElementError (a, ElementDestructionState)
forall a b. (a -> b) -> a -> b
$ case Name -> NamespaceRegistry -> Maybe (Maybe Text, Text)
NamespaceRegistry.resolveElementName Name
name NamespaceRegistry
nreg of
      Maybe (Maybe Text, Text)
Nothing -> ElementError -> Either ElementError a
forall a b. a -> Either a b
Left (Text -> ElementError
NameElementError (Text
"Unresolvable name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString (Name -> String
forall a. Show a => a -> String
show Name
name)))
      Just (Maybe Text
ns, Text
name) -> Maybe Text -> Text -> Either Text a
parse Maybe Text
ns Text
name Either Text a
-> (Either Text a -> Either ElementError a)
-> Either ElementError a
forall a b. a -> (a -> b) -> b
& (Text -> ElementError) -> Either Text a -> Either ElementError a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> ElementError
NameElementError

-- |
-- Fail if the namespace and name don't match the provided.
elementNameIs :: Maybe Text -> Text -> Element ()
elementNameIs :: Maybe Text -> Text -> Element ()
elementNameIs Maybe Text
ns Text
name =
  (Maybe Text -> Text -> Either Text ()) -> Element ()
forall a. (Maybe Text -> Text -> Either Text a) -> Element a
elementName ((Maybe Text -> Text -> Either Text ()) -> Element ())
-> (Maybe Text -> Text -> Either Text ()) -> Element ()
forall a b. (a -> b) -> a -> b
$ \Maybe Text
actualNs Text
actualName ->
    if Maybe Text
actualNs Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text
ns
      then
        if Text
actualName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name
          then () -> Either Text ()
forall a b. b -> Either a b
Right ()
          else Text -> Either Text ()
forall a b. a -> Either a b
Left (Text
"Unexpected name: \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
actualName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\". Expecting: \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"")
      else Text -> Either Text ()
forall a b. a -> Either a b
Left (Text
"Unexpected namespace: \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (Maybe Text -> String) -> Maybe Text -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Maybe Text -> String
forall a. Show a => a -> String
show) Maybe Text
actualNs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\". Expecting: \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (Maybe Text -> String) -> Maybe Text -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Maybe Text -> String
forall a. Show a => a -> String
show) Maybe Text
ns Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"")

-- |
-- Look up elements by name and parse them.
childrenByName :: ByName Element a -> Element a
childrenByName :: ByName Element a -> Element a
childrenByName (ByName forall content deeperError.
NameMap content
-> (content -> forall x. Element x -> Either deeperError x)
-> ByNameResult deeperError content a
runByName) =
  (NamespaceRegistry
 -> Element
 -> ElementDestructionState
 -> Either ElementError (a, ElementDestructionState))
-> Element a
forall a.
(NamespaceRegistry
 -> Element
 -> ElementDestructionState
 -> Either ElementError (a, ElementDestructionState))
-> Element a
Element ((NamespaceRegistry
  -> Element
  -> ElementDestructionState
  -> Either ElementError (a, ElementDestructionState))
 -> Element a)
-> (NamespaceRegistry
    -> Element
    -> ElementDestructionState
    -> Either ElementError (a, ElementDestructionState))
-> Element a
forall a b. (a -> b) -> a -> b
$ \NamespaceRegistry
nreg element :: Element
element@(Xml.Element Name
_ Map Name Text
attributes [Node]
_) ElementDestructionState
state ->
    case ElementDestructionContext
-> ElementDestructionState
-> (NameMap Element, ElementDestructionState)
ElementDestructionState.resolveChildNames (NamespaceRegistry -> Element -> ElementDestructionContext
ElementDestructionState.ElementDestructionContext NamespaceRegistry
nreg Element
element) ElementDestructionState
state of
      (NameMap Element
nameMap, ElementDestructionState
state) ->
        case NameMap Element
-> (Element -> forall x. Element x -> Either ElementError x)
-> ByNameResult ElementError Element a
forall content deeperError.
NameMap content
-> (content -> forall x. Element x -> Either deeperError x)
-> ByNameResult deeperError content a
runByName NameMap Element
nameMap (\Element
element (Element NamespaceRegistry
-> Element
-> ElementDestructionState
-> Either ElementError (x, ElementDestructionState)
run) -> ((x, ElementDestructionState) -> x)
-> Either ElementError (x, ElementDestructionState)
-> Either ElementError x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x, ElementDestructionState) -> x
forall a b. (a, b) -> a
fst (NamespaceRegistry
-> Element
-> ElementDestructionState
-> Either ElementError (x, ElementDestructionState)
run NamespaceRegistry
deeperNreg Element
element ElementDestructionState
ElementDestructionState.new)) of
          OkByNameResult NameMap Element
_ a
res -> (a, ElementDestructionState)
-> Either ElementError (a, ElementDestructionState)
forall a b. b -> Either a b
Right (a
res, ElementDestructionState
state)
          NotFoundByNameResult [(Maybe Text, Text)]
unfoundNames ->
            let availNames :: [(Maybe Text, Text)]
availNames = [(Maybe Text, Text)] -> [(Maybe Text, Text)]
forall a. Eq a => [a] -> [a]
nub ([(Maybe Text, Text)] -> [(Maybe Text, Text)])
-> [(Maybe Text, Text)] -> [(Maybe Text, Text)]
forall a b. (a -> b) -> a -> b
$ NameMap Element -> [(Maybe Text, Text)]
forall a. NameMap a -> [(Maybe Text, Text)]
NameMap.extractNames NameMap Element
nameMap
             in ElementError -> Either ElementError (a, ElementDestructionState)
forall a b. a -> Either a b
Left ([(Maybe Text, Text)] -> [(Maybe Text, Text)] -> ElementError
NoneOfChildrenFoundByNameElementError [(Maybe Text, Text)]
unfoundNames [(Maybe Text, Text)]
availNames)
          FailedDeeperByNameResult Maybe Text
ns Text
name ElementError
err ->
            ElementError -> Either ElementError (a, ElementDestructionState)
forall a b. a -> Either a b
Left (Maybe Text -> Text -> ElementError -> ElementError
ChildByNameElementError Maybe Text
ns Text
name ElementError
err)
        where
          deeperNreg :: NamespaceRegistry
deeperNreg = Map Name Text -> NamespaceRegistry -> NamespaceRegistry
NamespaceRegistry.interpretAttributes Map Name Text
attributes NamespaceRegistry
nreg

-- |
-- Look up the last attribute by name and parse it.
attributesByName :: ByName Content a -> Element a
attributesByName :: ByName Content a -> Element a
attributesByName (ByName forall content deeperError.
NameMap content
-> (content -> forall x. Content x -> Either deeperError x)
-> ByNameResult deeperError content a
runByName) =
  (NamespaceRegistry
 -> Element
 -> ElementDestructionState
 -> Either ElementError (a, ElementDestructionState))
-> Element a
forall a.
(NamespaceRegistry
 -> Element
 -> ElementDestructionState
 -> Either ElementError (a, ElementDestructionState))
-> Element a
Element ((NamespaceRegistry
  -> Element
  -> ElementDestructionState
  -> Either ElementError (a, ElementDestructionState))
 -> Element a)
-> (NamespaceRegistry
    -> Element
    -> ElementDestructionState
    -> Either ElementError (a, ElementDestructionState))
-> Element a
forall a b. (a -> b) -> a -> b
$ \NamespaceRegistry
nreg Element
element ElementDestructionState
state ->
    case ElementDestructionContext
-> ElementDestructionState
-> (NameMap Text, ElementDestructionState)
ElementDestructionState.resolveAttributeNames (NamespaceRegistry -> Element -> ElementDestructionContext
ElementDestructionState.ElementDestructionContext NamespaceRegistry
nreg Element
element) ElementDestructionState
state of
      (NameMap Text
nameMap, ElementDestructionState
state) -> case NameMap Text
-> (Text -> forall x. Content x -> Either (Maybe ContentError) x)
-> ByNameResult (Maybe ContentError) Text a
forall content deeperError.
NameMap content
-> (content -> forall x. Content x -> Either deeperError x)
-> ByNameResult deeperError content a
runByName NameMap Text
nameMap (\Text
content (Content (Text -> Maybe Text) -> Text -> Either (Maybe ContentError) x
parseContent) -> (Text -> Maybe Text) -> Text -> Either (Maybe ContentError) x
parseContent (\Text
ns -> Text -> NamespaceRegistry -> Maybe Text
NamespaceRegistry.lookup Text
ns NamespaceRegistry
nreg) Text
content) of
        OkByNameResult NameMap Text
_ a
res -> (a, ElementDestructionState)
-> Either ElementError (a, ElementDestructionState)
forall a b. b -> Either a b
Right (a
res, ElementDestructionState
state)
        NotFoundByNameResult [(Maybe Text, Text)]
unfoundNames ->
          let availNames :: [(Maybe Text, Text)]
availNames = [(Maybe Text, Text)] -> [(Maybe Text, Text)]
forall a. Eq a => [a] -> [a]
nub ([(Maybe Text, Text)] -> [(Maybe Text, Text)])
-> [(Maybe Text, Text)] -> [(Maybe Text, Text)]
forall a b. (a -> b) -> a -> b
$ NameMap Text -> [(Maybe Text, Text)]
forall a. NameMap a -> [(Maybe Text, Text)]
NameMap.extractNames NameMap Text
nameMap
           in ElementError -> Either ElementError (a, ElementDestructionState)
forall a b. a -> Either a b
Left ([(Maybe Text, Text)] -> [(Maybe Text, Text)] -> ElementError
NoneOfAttributesFoundByNameElementError [(Maybe Text, Text)]
unfoundNames [(Maybe Text, Text)]
availNames)
        FailedDeeperByNameResult Maybe Text
ns Text
name Maybe ContentError
err ->
          ElementError -> Either ElementError (a, ElementDestructionState)
forall a b. a -> Either a b
Left (Maybe Text -> Text -> Maybe ContentError -> ElementError
AttributeByNameElementError Maybe Text
ns Text
name Maybe ContentError
err)

-- |
-- Children sequence by order.
children :: Nodes a -> Element a
children :: Nodes a -> Element a
children (Nodes NodeConsumerState -> Either ElementError (a, NodeConsumerState)
runNodes) =
  (NamespaceRegistry
 -> Element
 -> ElementDestructionState
 -> Either ElementError (a, ElementDestructionState))
-> Element a
forall a.
(NamespaceRegistry
 -> Element
 -> ElementDestructionState
 -> Either ElementError (a, ElementDestructionState))
-> Element a
Element ((NamespaceRegistry
  -> Element
  -> ElementDestructionState
  -> Either ElementError (a, ElementDestructionState))
 -> Element a)
-> (NamespaceRegistry
    -> Element
    -> ElementDestructionState
    -> Either ElementError (a, ElementDestructionState))
-> Element a
forall a b. (a -> b) -> a -> b
$ \NamespaceRegistry
nreg (Xml.Element Name
_ Map Name Text
_ [Node]
nodes) ElementDestructionState
state ->
    NodeConsumerState -> Either ElementError (a, NodeConsumerState)
runNodes ([Node] -> NamespaceRegistry -> NodeConsumerState
NodeConsumerState.new [Node]
nodes NamespaceRegistry
nreg)
      Either ElementError (a, NodeConsumerState)
-> (Either ElementError (a, NodeConsumerState)
    -> Either ElementError a)
-> Either ElementError a
forall a b. a -> (a -> b) -> b
& ((a, NodeConsumerState) -> a)
-> Either ElementError (a, NodeConsumerState)
-> Either ElementError a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, NodeConsumerState) -> a
forall a b. (a, b) -> a
fst
      Either ElementError a
-> (Either ElementError a
    -> Either ElementError (a, ElementDestructionState))
-> Either ElementError (a, ElementDestructionState)
forall a b. a -> (a -> b) -> b
& (a -> (a, ElementDestructionState))
-> Either ElementError a
-> Either ElementError (a, ElementDestructionState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,ElementDestructionState
state)

-- |
-- Expose the element's AST.
astElement :: Element Xml.Element
astElement :: Element Element
astElement =
  (NamespaceRegistry
 -> Element
 -> ElementDestructionState
 -> Either ElementError (Element, ElementDestructionState))
-> Element Element
forall a.
(NamespaceRegistry
 -> Element
 -> ElementDestructionState
 -> Either ElementError (a, ElementDestructionState))
-> Element a
Element ((NamespaceRegistry
  -> Element
  -> ElementDestructionState
  -> Either ElementError (Element, ElementDestructionState))
 -> Element Element)
-> (NamespaceRegistry
    -> Element
    -> ElementDestructionState
    -> Either ElementError (Element, ElementDestructionState))
-> Element Element
forall a b. (a -> b) -> a -> b
$ \NamespaceRegistry
_ Element
element ElementDestructionState
state -> (Element, ElementDestructionState)
-> Either ElementError (Element, ElementDestructionState)
forall a b. b -> Either a b
Right (Element
element, ElementDestructionState
state)

-- |
-- Parser in the context of a sequence of nodes.
newtype Nodes a
  = Nodes (NodeConsumerState.NodeConsumerState -> Either ElementError (a, NodeConsumerState.NodeConsumerState))
  deriving
    (a -> Nodes b -> Nodes a
(a -> b) -> Nodes a -> Nodes b
(forall a b. (a -> b) -> Nodes a -> Nodes b)
-> (forall a b. a -> Nodes b -> Nodes a) -> Functor Nodes
forall a b. a -> Nodes b -> Nodes a
forall a b. (a -> b) -> Nodes a -> Nodes b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Nodes b -> Nodes a
$c<$ :: forall a b. a -> Nodes b -> Nodes a
fmap :: (a -> b) -> Nodes a -> Nodes b
$cfmap :: forall a b. (a -> b) -> Nodes a -> Nodes b
Functor, Functor Nodes
a -> Nodes a
Functor Nodes
-> (forall a. a -> Nodes a)
-> (forall a b. Nodes (a -> b) -> Nodes a -> Nodes b)
-> (forall a b c. (a -> b -> c) -> Nodes a -> Nodes b -> Nodes c)
-> (forall a b. Nodes a -> Nodes b -> Nodes b)
-> (forall a b. Nodes a -> Nodes b -> Nodes a)
-> Applicative Nodes
Nodes a -> Nodes b -> Nodes b
Nodes a -> Nodes b -> Nodes a
Nodes (a -> b) -> Nodes a -> Nodes b
(a -> b -> c) -> Nodes a -> Nodes b -> Nodes c
forall a. a -> Nodes a
forall a b. Nodes a -> Nodes b -> Nodes a
forall a b. Nodes a -> Nodes b -> Nodes b
forall a b. Nodes (a -> b) -> Nodes a -> Nodes b
forall a b c. (a -> b -> c) -> Nodes a -> Nodes b -> Nodes c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Nodes a -> Nodes b -> Nodes a
$c<* :: forall a b. Nodes a -> Nodes b -> Nodes a
*> :: Nodes a -> Nodes b -> Nodes b
$c*> :: forall a b. Nodes a -> Nodes b -> Nodes b
liftA2 :: (a -> b -> c) -> Nodes a -> Nodes b -> Nodes c
$cliftA2 :: forall a b c. (a -> b -> c) -> Nodes a -> Nodes b -> Nodes c
<*> :: Nodes (a -> b) -> Nodes a -> Nodes b
$c<*> :: forall a b. Nodes (a -> b) -> Nodes a -> Nodes b
pure :: a -> Nodes a
$cpure :: forall a. a -> Nodes a
$cp1Applicative :: Functor Nodes
Applicative, Applicative Nodes
a -> Nodes a
Applicative Nodes
-> (forall a b. Nodes a -> (a -> Nodes b) -> Nodes b)
-> (forall a b. Nodes a -> Nodes b -> Nodes b)
-> (forall a. a -> Nodes a)
-> Monad Nodes
Nodes a -> (a -> Nodes b) -> Nodes b
Nodes a -> Nodes b -> Nodes b
forall a. a -> Nodes a
forall a b. Nodes a -> Nodes b -> Nodes b
forall a b. Nodes a -> (a -> Nodes b) -> Nodes b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Nodes a
$creturn :: forall a. a -> Nodes a
>> :: Nodes a -> Nodes b -> Nodes b
$c>> :: forall a b. Nodes a -> Nodes b -> Nodes b
>>= :: Nodes a -> (a -> Nodes b) -> Nodes b
$c>>= :: forall a b. Nodes a -> (a -> Nodes b) -> Nodes b
$cp1Monad :: Applicative Nodes
Monad)
    via (StateT NodeConsumerState.NodeConsumerState (Either ElementError))

-- |
-- Consume the next node expecting it to be element and parse its contents.
elementNode :: Element a -> Nodes a
elementNode :: Element a -> Nodes a
elementNode (Element NamespaceRegistry
-> Element
-> ElementDestructionState
-> Either ElementError (a, ElementDestructionState)
runElement) =
  (NodeConsumerState -> Either ElementError (a, NodeConsumerState))
-> Nodes a
forall a.
(NodeConsumerState -> Either ElementError (a, NodeConsumerState))
-> Nodes a
Nodes ((NodeConsumerState -> Either ElementError (a, NodeConsumerState))
 -> Nodes a)
-> (NodeConsumerState
    -> Either ElementError (a, NodeConsumerState))
-> Nodes a
forall a b. (a -> b) -> a -> b
$ \NodeConsumerState
x ->
    case NodeConsumerState -> Maybe (Node, NodeConsumerState)
NodeConsumerState.fetchNode NodeConsumerState
x of
      Just (Node
node, NodeConsumerState
x) -> case Node
node of
        Xml.NodeElement Element
element ->
          (ElementError -> ElementError)
-> (a -> (a, NodeConsumerState))
-> Either ElementError a
-> Either ElementError (a, NodeConsumerState)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
            (Int -> NodeError -> ElementError
ChildAtOffsetElementError (NodeConsumerState -> Int
NodeConsumerState.getOffset NodeConsumerState
x) (NodeError -> ElementError)
-> (ElementError -> NodeError) -> ElementError -> ElementError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ElementError -> NodeError
ElementNodeError)
            (,NodeConsumerState -> NodeConsumerState
NodeConsumerState.bumpOffset NodeConsumerState
x)
            (((a, ElementDestructionState) -> a)
-> Either ElementError (a, ElementDestructionState)
-> Either ElementError a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, ElementDestructionState) -> a
forall a b. (a, b) -> a
fst (NamespaceRegistry
-> Element
-> ElementDestructionState
-> Either ElementError (a, ElementDestructionState)
runElement (NodeConsumerState -> NamespaceRegistry
NodeConsumerState.getNamespaceRegistry NodeConsumerState
x) Element
element ElementDestructionState
ElementDestructionState.new))
        Xml.NodeInstruction Instruction
_ -> NodeType -> Either ElementError (a, NodeConsumerState)
failWithUnexpectedNodeType NodeType
InstructionNodeType
        Xml.NodeContent Text
_ -> NodeType -> Either ElementError (a, NodeConsumerState)
failWithUnexpectedNodeType NodeType
ContentNodeType
        Xml.NodeComment Text
_ -> NodeType -> Either ElementError (a, NodeConsumerState)
failWithUnexpectedNodeType NodeType
CommentNodeType
        where
          failWithUnexpectedNodeType :: NodeType -> Either ElementError (a, NodeConsumerState)
failWithUnexpectedNodeType NodeType
actualType =
            ElementError -> Either ElementError (a, NodeConsumerState)
forall a b. a -> Either a b
Left
              ( Int -> NodeError -> ElementError
ChildAtOffsetElementError
                  (NodeConsumerState -> Int
NodeConsumerState.getOffset NodeConsumerState
x)
                  (NodeType -> NodeType -> NodeError
UnexpectedNodeTypeNodeError NodeType
ElementNodeType NodeType
actualType)
              )
      Maybe (Node, NodeConsumerState)
_ -> ElementError -> Either ElementError (a, NodeConsumerState)
forall a b. a -> Either a b
Left (Int -> NodeError -> ElementError
ChildAtOffsetElementError (NodeConsumerState -> Int
NodeConsumerState.getOffset NodeConsumerState
x) NodeError
NotAvailableNodeError)

-- |
-- Consume the next node expecting it to be textual and parse its contents.
contentNode :: Content content -> Nodes content
contentNode :: Content content -> Nodes content
contentNode (Content (Text -> Maybe Text) -> Text -> Either (Maybe ContentError) content
parseContent) =
  (NodeConsumerState
 -> Either ElementError (content, NodeConsumerState))
-> Nodes content
forall a.
(NodeConsumerState -> Either ElementError (a, NodeConsumerState))
-> Nodes a
Nodes ((NodeConsumerState
  -> Either ElementError (content, NodeConsumerState))
 -> Nodes content)
-> (NodeConsumerState
    -> Either ElementError (content, NodeConsumerState))
-> Nodes content
forall a b. (a -> b) -> a -> b
$ \NodeConsumerState
x ->
    case NodeConsumerState -> Maybe (Node, NodeConsumerState)
NodeConsumerState.fetchNode NodeConsumerState
x of
      Just (Node
node, NodeConsumerState
x) -> case Node
node of
        Xml.NodeContent Text
content ->
          case (Text -> Maybe Text) -> Text -> Either (Maybe ContentError) content
parseContent (\Text
ns -> Text -> NodeConsumerState -> Maybe Text
NodeConsumerState.lookupNamespace Text
ns NodeConsumerState
x) Text
content of
            Right content
parsedContent ->
              (content, NodeConsumerState)
-> Either ElementError (content, NodeConsumerState)
forall a b. b -> Either a b
Right (content
parsedContent, NodeConsumerState -> NodeConsumerState
NodeConsumerState.bumpOffset NodeConsumerState
x)
            Left Maybe ContentError
contentError ->
              ElementError -> Either ElementError (content, NodeConsumerState)
forall a b. a -> Either a b
Left
                ( Int -> NodeError -> ElementError
ChildAtOffsetElementError
                    (NodeConsumerState -> Int
NodeConsumerState.getOffset NodeConsumerState
x)
                    (Maybe ContentError -> NodeError
TextNodeError Maybe ContentError
contentError)
                )
        Xml.NodeElement Element
_ -> NodeType -> Either ElementError (content, NodeConsumerState)
failWithUnexpectedNodeType NodeType
ElementNodeType
        Xml.NodeInstruction Instruction
_ -> NodeType -> Either ElementError (content, NodeConsumerState)
failWithUnexpectedNodeType NodeType
InstructionNodeType
        Xml.NodeComment Text
_ -> NodeType -> Either ElementError (content, NodeConsumerState)
failWithUnexpectedNodeType NodeType
CommentNodeType
        where
          failWithUnexpectedNodeType :: NodeType -> Either ElementError (content, NodeConsumerState)
failWithUnexpectedNodeType NodeType
actualType =
            ElementError -> Either ElementError (content, NodeConsumerState)
forall a b. a -> Either a b
Left
              ( Int -> NodeError -> ElementError
ChildAtOffsetElementError
                  (NodeConsumerState -> Int
NodeConsumerState.getOffset NodeConsumerState
x)
                  (NodeType -> NodeType -> NodeError
UnexpectedNodeTypeNodeError NodeType
ContentNodeType NodeType
actualType)
              )
      Maybe (Node, NodeConsumerState)
_ ->
        case NodeConsumerState -> Int
NodeConsumerState.getOffset NodeConsumerState
x of
          Int
0 ->
            case (Text -> Maybe Text) -> Text -> Either (Maybe ContentError) content
parseContent (\Text
ns -> Text -> NodeConsumerState -> Maybe Text
NodeConsumerState.lookupNamespace Text
ns NodeConsumerState
x) Text
forall a. Monoid a => a
mempty of
              Right content
parsedContent ->
                (content, NodeConsumerState)
-> Either ElementError (content, NodeConsumerState)
forall a b. b -> Either a b
Right (content
parsedContent, NodeConsumerState -> NodeConsumerState
NodeConsumerState.bumpOffset NodeConsumerState
x)
              Left Maybe ContentError
contentError ->
                ElementError -> Either ElementError (content, NodeConsumerState)
forall a b. a -> Either a b
Left (Int -> NodeError -> ElementError
ChildAtOffsetElementError Int
0 (Maybe ContentError -> NodeError
TextNodeError Maybe ContentError
contentError))
          Int
offset ->
            ElementError -> Either ElementError (content, NodeConsumerState)
forall a b. a -> Either a b
Left (Int -> NodeError -> ElementError
ChildAtOffsetElementError Int
offset NodeError
NotAvailableNodeError)

-- * Content

-- |
-- Parser in the context of decoded textual content,
-- which can be the value of an attribute or a textual node.
newtype Content content
  = -- | Parser in the context of an xml namespace URI by alias lookup function.
    Content ((Text -> Maybe Text) -> Text -> Either (Maybe ContentError) content)
  deriving
    (a -> Content b -> Content a
(a -> b) -> Content a -> Content b
(forall a b. (a -> b) -> Content a -> Content b)
-> (forall a b. a -> Content b -> Content a) -> Functor Content
forall a b. a -> Content b -> Content a
forall a b. (a -> b) -> Content a -> Content b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Content b -> Content a
$c<$ :: forall a b. a -> Content b -> Content a
fmap :: (a -> b) -> Content a -> Content b
$cfmap :: forall a b. (a -> b) -> Content a -> Content b
Functor, Functor Content
a -> Content a
Functor Content
-> (forall a. a -> Content a)
-> (forall a b. Content (a -> b) -> Content a -> Content b)
-> (forall a b c.
    (a -> b -> c) -> Content a -> Content b -> Content c)
-> (forall a b. Content a -> Content b -> Content b)
-> (forall a b. Content a -> Content b -> Content a)
-> Applicative Content
Content a -> Content b -> Content b
Content a -> Content b -> Content a
Content (a -> b) -> Content a -> Content b
(a -> b -> c) -> Content a -> Content b -> Content c
forall a. a -> Content a
forall a b. Content a -> Content b -> Content a
forall a b. Content a -> Content b -> Content b
forall a b. Content (a -> b) -> Content a -> Content b
forall a b c. (a -> b -> c) -> Content a -> Content b -> Content c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Content a -> Content b -> Content a
$c<* :: forall a b. Content a -> Content b -> Content a
*> :: Content a -> Content b -> Content b
$c*> :: forall a b. Content a -> Content b -> Content b
liftA2 :: (a -> b -> c) -> Content a -> Content b -> Content c
$cliftA2 :: forall a b c. (a -> b -> c) -> Content a -> Content b -> Content c
<*> :: Content (a -> b) -> Content a -> Content b
$c<*> :: forall a b. Content (a -> b) -> Content a -> Content b
pure :: a -> Content a
$cpure :: forall a. a -> Content a
$cp1Applicative :: Functor Content
Applicative, Applicative Content
a -> Content a
Applicative Content
-> (forall a b. Content a -> (a -> Content b) -> Content b)
-> (forall a b. Content a -> Content b -> Content b)
-> (forall a. a -> Content a)
-> Monad Content
Content a -> (a -> Content b) -> Content b
Content a -> Content b -> Content b
forall a. a -> Content a
forall a b. Content a -> Content b -> Content b
forall a b. Content a -> (a -> Content b) -> Content b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Content a
$creturn :: forall a. a -> Content a
>> :: Content a -> Content b -> Content b
$c>> :: forall a b. Content a -> Content b -> Content b
>>= :: Content a -> (a -> Content b) -> Content b
$c>>= :: forall a b. Content a -> (a -> Content b) -> Content b
$cp1Monad :: Applicative Content
Monad, Applicative Content
Content a
Applicative Content
-> (forall a. Content a)
-> (forall a. Content a -> Content a -> Content a)
-> (forall a. Content a -> Content [a])
-> (forall a. Content a -> Content [a])
-> Alternative Content
Content a -> Content a -> Content a
Content a -> Content [a]
Content a -> Content [a]
forall a. Content a
forall a. Content a -> Content [a]
forall a. Content a -> Content a -> Content a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: Content a -> Content [a]
$cmany :: forall a. Content a -> Content [a]
some :: Content a -> Content [a]
$csome :: forall a. Content a -> Content [a]
<|> :: Content a -> Content a -> Content a
$c<|> :: forall a. Content a -> Content a -> Content a
empty :: Content a
$cempty :: forall a. Content a
$cp1Alternative :: Applicative Content
Alternative, Monad Content
Alternative Content
Content a
Alternative Content
-> Monad Content
-> (forall a. Content a)
-> (forall a. Content a -> Content a -> Content a)
-> MonadPlus Content
Content a -> Content a -> Content a
forall a. Content a
forall a. Content a -> Content a -> Content a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: Content a -> Content a -> Content a
$cmplus :: forall a. Content a -> Content a -> Content a
mzero :: Content a
$cmzero :: forall a. Content a
$cp2MonadPlus :: Monad Content
$cp1MonadPlus :: Alternative Content
MonadPlus)
    via (ReaderT (Text -> Maybe Text) (ExceptT (Last ContentError) ((->) Text)))

instance MonadFail Content where
  fail :: String -> Content a
fail = String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (Text -> Content a) -> String -> Content a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> ContentError
UserContentError (Text -> ContentError)
-> (ContentError -> Content a) -> Text -> Content a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ContentError -> Maybe ContentError
forall a. a -> Maybe a
Just (ContentError -> Maybe ContentError)
-> (Maybe ContentError -> Content a) -> ContentError -> Content a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Maybe ContentError -> Either (Maybe ContentError) a
forall a b. a -> Either a b
Left (Maybe ContentError -> Either (Maybe ContentError) a)
-> (Either (Maybe ContentError) a -> Content a)
-> Maybe ContentError
-> Content a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Either (Maybe ContentError) a
-> Text -> Either (Maybe ContentError) a
forall a b. a -> b -> a
const (Either (Maybe ContentError) a
 -> Text -> Either (Maybe ContentError) a)
-> ((Text -> Either (Maybe ContentError) a) -> Content a)
-> Either (Maybe ContentError) a
-> Content a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Text -> Either (Maybe ContentError) a)
-> (Text -> Maybe Text) -> Text -> Either (Maybe ContentError) a
forall a b. a -> b -> a
const ((Text -> Either (Maybe ContentError) a)
 -> (Text -> Maybe Text) -> Text -> Either (Maybe ContentError) a)
-> (((Text -> Maybe Text) -> Text -> Either (Maybe ContentError) a)
    -> Content a)
-> (Text -> Either (Maybe ContentError) a)
-> Content a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((Text -> Maybe Text) -> Text -> Either (Maybe ContentError) a)
-> Content a
forall content.
((Text -> Maybe Text)
 -> Text -> Either (Maybe ContentError) content)
-> Content content
Content

-- |
-- Return the content as it is.
textContent :: Content Text
textContent :: Content Text
textContent =
  ((Text -> Maybe Text) -> Text -> Either (Maybe ContentError) Text)
-> Content Text
forall content.
((Text -> Maybe Text)
 -> Text -> Either (Maybe ContentError) content)
-> Content content
Content ((Text -> Either (Maybe ContentError) Text)
-> (Text -> Maybe Text) -> Text -> Either (Maybe ContentError) Text
forall a b. a -> b -> a
const Text -> Either (Maybe ContentError) Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

-- |
-- Map the content to a type if it's valid.
narrowedContent :: (Text -> Maybe a) -> Content a
narrowedContent :: (Text -> Maybe a) -> Content a
narrowedContent Text -> Maybe a
mapper =
  ((Text -> Maybe Text) -> Text -> Either (Maybe ContentError) a)
-> Content a
forall content.
((Text -> Maybe Text)
 -> Text -> Either (Maybe ContentError) content)
-> Content content
Content ((Text -> Either (Maybe ContentError) a)
-> (Text -> Maybe Text) -> Text -> Either (Maybe ContentError) a
forall a b. a -> b -> a
const (\Text
x -> Either (Maybe ContentError) a
-> (a -> Either (Maybe ContentError) a)
-> Maybe a
-> Either (Maybe ContentError) a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe ContentError -> Either (Maybe ContentError) a
forall a b. a -> Either a b
Left (ContentError -> Maybe ContentError
forall a. a -> Maybe a
Just (Text -> ContentError
UnexpectedValueContentError Text
x))) a -> Either (Maybe ContentError) a
forall a b. b -> Either a b
Right (Text -> Maybe a
mapper Text
x)))

-- |
-- Parse the content with a possibly failing function.
refinedContent :: (Text -> Either Text a) -> Content a
refinedContent :: (Text -> Either Text a) -> Content a
refinedContent Text -> Either Text a
refine =
  ((Text -> Maybe Text) -> Text -> Either (Maybe ContentError) a)
-> Content a
forall content.
((Text -> Maybe Text)
 -> Text -> Either (Maybe ContentError) content)
-> Content content
Content ((Text -> Either (Maybe ContentError) a)
-> (Text -> Maybe Text) -> Text -> Either (Maybe ContentError) a
forall a b. a -> b -> a
const ((Text -> Maybe ContentError)
-> Either Text a -> Either (Maybe ContentError) a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ContentError -> Maybe ContentError
forall a. a -> Maybe a
Just (ContentError -> Maybe ContentError)
-> (Text -> ContentError) -> Text -> Maybe ContentError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ContentError
ParsingContentError) (Either Text a -> Either (Maybe ContentError) a)
-> (Text -> Either Text a) -> Text -> Either (Maybe ContentError) a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Either Text a
refine))

-- |
-- Map the content using a dictionary.
enumContent :: [(Text, a)] -> Content a
enumContent :: [(Text, a)] -> Content a
enumContent [(Text, a)]
mappingList =
  let !expectedKeysList :: [Text]
expectedKeysList =
        ((Text, a) -> Text) -> [(Text, a)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, a) -> Text
forall a b. (a, b) -> a
fst [(Text, a)]
mappingList
      mappingListLength :: Int
mappingListLength =
        [(Text, a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, a)]
mappingList
      !narrow :: Text -> Maybe a
narrow =
        if Int
mappingListLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
512
          then
            let !hashMap :: HashMap Text a
hashMap = [(Text, a)] -> HashMap Text a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, a)]
mappingList
             in (Text -> HashMap Text a -> Maybe a)
-> HashMap Text a -> Text -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> HashMap Text a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup HashMap Text a
hashMap
          else (Text -> [(Text, a)] -> Maybe a) -> [(Text, a)] -> Text -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [(Text, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup [(Text, a)]
mappingList
      extract :: Text -> Either (Maybe ContentError) a
extract Text
a =
        case Text -> Maybe a
narrow Text
a of
          Just a
b -> a -> Either (Maybe ContentError) a
forall a b. b -> Either a b
Right a
b
          Maybe a
_ -> Maybe ContentError -> Either (Maybe ContentError) a
forall a b. a -> Either a b
Left (ContentError -> Maybe ContentError
forall a. a -> Maybe a
Just ([Text] -> Text -> ContentError
EnumContentError [Text]
expectedKeysList Text
a))
   in ((Text -> Maybe Text) -> Text -> Either (Maybe ContentError) a)
-> Content a
forall content.
((Text -> Maybe Text)
 -> Text -> Either (Maybe ContentError) content)
-> Content content
Content ((Text -> Either (Maybe ContentError) a)
-> (Text -> Maybe Text) -> Text -> Either (Maybe ContentError) a
forall a b. a -> b -> a
const Text -> Either (Maybe ContentError) a
extract)

-- |
-- Parse the content using the \"attoparsec\" parser.
attoparsedContent :: Attoparsec.Parser a -> Content a
attoparsedContent :: Parser a -> Content a
attoparsedContent Parser a
parser =
  ((Text -> Maybe Text) -> Text -> Either (Maybe ContentError) a)
-> Content a
forall content.
((Text -> Maybe Text)
 -> Text -> Either (Maybe ContentError) content)
-> Content content
Content ((Text -> Either (Maybe ContentError) a)
-> (Text -> Maybe Text) -> Text -> Either (Maybe ContentError) a
forall a b. a -> b -> a
const ((String -> Maybe ContentError)
-> Either String a -> Either (Maybe ContentError) a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ContentError -> Maybe ContentError
forall a. a -> Maybe a
Just (ContentError -> Maybe ContentError)
-> (String -> ContentError) -> String -> Maybe ContentError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ContentError
ParsingContentError (Text -> ContentError)
-> (String -> Text) -> String -> ContentError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
forall a. IsString a => String -> a
fromString) (Either String a -> Either (Maybe ContentError) a)
-> (Text -> Either String a)
-> Text
-> Either (Maybe ContentError) a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
Attoparsec.parseOnly Parser a
parser))

-- |
-- Parse the content as XML Schema QName,
-- automatically resolving the namespace as URI and failing,
-- if none is associated.
--
-- Produces a URI associated with the namespace and name.
-- If the content does not contain colon, produces an unnamespaced name.
--
-- Refs:
--
-- - https://www.w3.org/2001/tag/doc/qnameids.html#sec-qnames-xml
-- - https://en.wikipedia.org/wiki/QName
qNameContent :: Content (Maybe Text, Text)
qNameContent :: Content (Maybe Text, Text)
qNameContent =
  ((Text -> Maybe Text)
 -> Text -> Either (Maybe ContentError) (Maybe Text, Text))
-> Content (Maybe Text, Text)
forall content.
((Text -> Maybe Text)
 -> Text -> Either (Maybe ContentError) content)
-> Content content
Content (((Text -> Maybe Text)
  -> Text -> Either (Maybe ContentError) (Maybe Text, Text))
 -> Content (Maybe Text, Text))
-> ((Text -> Maybe Text)
    -> Text -> Either (Maybe ContentError) (Maybe Text, Text))
-> Content (Maybe Text, Text)
forall a b. (a -> b) -> a -> b
$ \Text -> Maybe Text
lookup Text
content -> case Parser (Maybe Text, Text) -> Text -> Either Text (Maybe Text, Text)
forall a. Parser a -> Text -> Either Text a
Attoparsec.parseStripped Parser (Maybe Text, Text)
Attoparsec.qName Text
content of
    Right (Maybe Text
ns, Text
name) -> case Maybe Text
ns of
      Just Text
ns -> case Text -> Maybe Text
lookup Text
ns of
        Just Text
uri -> (Maybe Text, Text)
-> Either (Maybe ContentError) (Maybe Text, Text)
forall a b. b -> Either a b
Right (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
uri, Text
name)
        Maybe Text
Nothing -> Maybe ContentError
-> Either (Maybe ContentError) (Maybe Text, Text)
forall a b. a -> Either a b
Left (ContentError -> Maybe ContentError
forall a. a -> Maybe a
Just (Text -> ContentError
NamespaceNotFoundContentError Text
ns))
      Maybe Text
Nothing -> (Maybe Text, Text)
-> Either (Maybe ContentError) (Maybe Text, Text)
forall a b. b -> Either a b
Right (Maybe Text
forall a. Maybe a
Nothing, Text
name)
    Left Text
err -> Maybe ContentError
-> Either (Maybe ContentError) (Maybe Text, Text)
forall a b. a -> Either a b
Left (ContentError -> Maybe ContentError
forall a. a -> Maybe a
Just (Text -> ContentError
ParsingContentError Text
err))

-- * ByName

data ByNameResult deeperError content a
  = NotFoundByNameResult [(Maybe Text, Text)]
  | FailedDeeperByNameResult (Maybe Text) Text deeperError
  | OkByNameResult (NameMap.NameMap content) a
  deriving (a
-> ByNameResult deeperError content b
-> ByNameResult deeperError content a
(a -> b)
-> ByNameResult deeperError content a
-> ByNameResult deeperError content b
(forall a b.
 (a -> b)
 -> ByNameResult deeperError content a
 -> ByNameResult deeperError content b)
-> (forall a b.
    a
    -> ByNameResult deeperError content b
    -> ByNameResult deeperError content a)
-> Functor (ByNameResult deeperError content)
forall a b.
a
-> ByNameResult deeperError content b
-> ByNameResult deeperError content a
forall a b.
(a -> b)
-> ByNameResult deeperError content a
-> ByNameResult deeperError content b
forall deeperError content a b.
a
-> ByNameResult deeperError content b
-> ByNameResult deeperError content a
forall deeperError content a b.
(a -> b)
-> ByNameResult deeperError content a
-> ByNameResult deeperError content b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a
-> ByNameResult deeperError content b
-> ByNameResult deeperError content a
$c<$ :: forall deeperError content a b.
a
-> ByNameResult deeperError content b
-> ByNameResult deeperError content a
fmap :: (a -> b)
-> ByNameResult deeperError content a
-> ByNameResult deeperError content b
$cfmap :: forall deeperError content a b.
(a -> b)
-> ByNameResult deeperError content a
-> ByNameResult deeperError content b
Functor)

-- |
-- Composable extension to a parser, which looks up its input by name.
--
-- Useful for searching elements and attributes by name.
--
-- Alternative and MonadPlus alternate only on lookup errors.
-- When lookup is successful, but the deeper parser fails,
-- the error propagates.
--
-- Monad and Applicative sequentially fetch contents by matching names.
newtype ByName parser a
  = ByName
      ( forall content deeperError.
        NameMap.NameMap content ->
        (content -> forall x. parser x -> Either deeperError x) ->
        ByNameResult deeperError content a
      )

instance Functor (ByName parser) where
  fmap :: (a -> b) -> ByName parser a -> ByName parser b
fmap a -> b
fn (ByName forall content deeperError.
NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content a
run) =
    (forall content deeperError.
 NameMap content
 -> (content -> forall x. parser x -> Either deeperError x)
 -> ByNameResult deeperError content b)
-> ByName parser b
forall (parser :: * -> *) a.
(forall content deeperError.
 NameMap content
 -> (content -> forall x. parser x -> Either deeperError x)
 -> ByNameResult deeperError content a)
-> ByName parser a
ByName ((forall content deeperError.
  NameMap content
  -> (content -> forall x. parser x -> Either deeperError x)
  -> ByNameResult deeperError content b)
 -> ByName parser b)
-> (forall content deeperError.
    NameMap content
    -> (content -> forall x. parser x -> Either deeperError x)
    -> ByNameResult deeperError content b)
-> ByName parser b
forall a b. (a -> b) -> a -> b
$ \NameMap content
map content -> forall x. parser x -> Either deeperError x
parse -> (a -> b)
-> ByNameResult deeperError content a
-> ByNameResult deeperError content b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
fn (NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content a
forall content deeperError.
NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content a
run NameMap content
map content -> forall x. parser x -> Either deeperError x
parse)

instance Applicative (ByName parser) where
  pure :: a -> ByName parser a
pure a
x =
    (forall content deeperError.
 NameMap content
 -> (content -> forall x. parser x -> Either deeperError x)
 -> ByNameResult deeperError content a)
-> ByName parser a
forall (parser :: * -> *) a.
(forall content deeperError.
 NameMap content
 -> (content -> forall x. parser x -> Either deeperError x)
 -> ByNameResult deeperError content a)
-> ByName parser a
ByName ((forall content deeperError.
  NameMap content
  -> (content -> forall x. parser x -> Either deeperError x)
  -> ByNameResult deeperError content a)
 -> ByName parser a)
-> (forall content deeperError.
    NameMap content
    -> (content -> forall x. parser x -> Either deeperError x)
    -> ByNameResult deeperError content a)
-> ByName parser a
forall a b. (a -> b) -> a -> b
$ \NameMap content
map content -> forall x. parser x -> Either deeperError x
_ -> NameMap content -> a -> ByNameResult deeperError content a
forall deeperError content a.
NameMap content -> a -> ByNameResult deeperError content a
OkByNameResult NameMap content
map a
x
  ByName forall content deeperError.
NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content (a -> b)
runL <*> :: ByName parser (a -> b) -> ByName parser a -> ByName parser b
<*> ByName forall content deeperError.
NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content a
runR =
    (forall content deeperError.
 NameMap content
 -> (content -> forall x. parser x -> Either deeperError x)
 -> ByNameResult deeperError content b)
-> ByName parser b
forall (parser :: * -> *) a.
(forall content deeperError.
 NameMap content
 -> (content -> forall x. parser x -> Either deeperError x)
 -> ByNameResult deeperError content a)
-> ByName parser a
ByName ((forall content deeperError.
  NameMap content
  -> (content -> forall x. parser x -> Either deeperError x)
  -> ByNameResult deeperError content b)
 -> ByName parser b)
-> (forall content deeperError.
    NameMap content
    -> (content -> forall x. parser x -> Either deeperError x)
    -> ByNameResult deeperError content b)
-> ByName parser b
forall a b. (a -> b) -> a -> b
$ \NameMap content
map content -> forall x. parser x -> Either deeperError x
parse -> case NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content (a -> b)
forall content deeperError.
NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content (a -> b)
runL NameMap content
map content -> forall x. parser x -> Either deeperError x
parse of
      OkByNameResult NameMap content
map a -> b
lRes -> NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content a
forall content deeperError.
NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content a
runR NameMap content
map content -> forall x. parser x -> Either deeperError x
parse ByNameResult deeperError content a
-> (ByNameResult deeperError content a
    -> ByNameResult deeperError content b)
-> ByNameResult deeperError content b
forall a b. a -> (a -> b) -> b
& (a -> b)
-> ByNameResult deeperError content a
-> ByNameResult deeperError content b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
lRes
      NotFoundByNameResult [(Maybe Text, Text)]
unfoundNames -> [(Maybe Text, Text)] -> ByNameResult deeperError content b
forall deeperError content a.
[(Maybe Text, Text)] -> ByNameResult deeperError content a
NotFoundByNameResult [(Maybe Text, Text)]
unfoundNames
      FailedDeeperByNameResult Maybe Text
ns Text
name deeperError
err -> Maybe Text
-> Text -> deeperError -> ByNameResult deeperError content b
forall deeperError content a.
Maybe Text
-> Text -> deeperError -> ByNameResult deeperError content a
FailedDeeperByNameResult Maybe Text
ns Text
name deeperError
err

instance Monad (ByName parser) where
  return :: a -> ByName parser a
return = a -> ByName parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ByName forall content deeperError.
NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content a
runL >>= :: ByName parser a -> (a -> ByName parser b) -> ByName parser b
>>= a -> ByName parser b
k =
    (forall content deeperError.
 NameMap content
 -> (content -> forall x. parser x -> Either deeperError x)
 -> ByNameResult deeperError content b)
-> ByName parser b
forall (parser :: * -> *) a.
(forall content deeperError.
 NameMap content
 -> (content -> forall x. parser x -> Either deeperError x)
 -> ByNameResult deeperError content a)
-> ByName parser a
ByName ((forall content deeperError.
  NameMap content
  -> (content -> forall x. parser x -> Either deeperError x)
  -> ByNameResult deeperError content b)
 -> ByName parser b)
-> (forall content deeperError.
    NameMap content
    -> (content -> forall x. parser x -> Either deeperError x)
    -> ByNameResult deeperError content b)
-> ByName parser b
forall a b. (a -> b) -> a -> b
$ \NameMap content
map content -> forall x. parser x -> Either deeperError x
parse -> case NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content a
forall content deeperError.
NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content a
runL NameMap content
map content -> forall x. parser x -> Either deeperError x
parse of
      OkByNameResult NameMap content
map a
lRes -> case a -> ByName parser b
k a
lRes of ByName forall content deeperError.
NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content b
runR -> NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content b
forall content deeperError.
NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content b
runR NameMap content
map content -> forall x. parser x -> Either deeperError x
parse
      NotFoundByNameResult [(Maybe Text, Text)]
unfoundNames -> [(Maybe Text, Text)] -> ByNameResult deeperError content b
forall deeperError content a.
[(Maybe Text, Text)] -> ByNameResult deeperError content a
NotFoundByNameResult [(Maybe Text, Text)]
unfoundNames
      FailedDeeperByNameResult Maybe Text
ns Text
name deeperError
err -> Maybe Text
-> Text -> deeperError -> ByNameResult deeperError content b
forall deeperError content a.
Maybe Text
-> Text -> deeperError -> ByNameResult deeperError content a
FailedDeeperByNameResult Maybe Text
ns Text
name deeperError
err

instance Alternative (ByName parser) where
  empty :: ByName parser a
empty =
    (forall content deeperError.
 NameMap content
 -> (content -> forall x. parser x -> Either deeperError x)
 -> ByNameResult deeperError content a)
-> ByName parser a
forall (parser :: * -> *) a.
(forall content deeperError.
 NameMap content
 -> (content -> forall x. parser x -> Either deeperError x)
 -> ByNameResult deeperError content a)
-> ByName parser a
ByName ((forall content deeperError.
  NameMap content
  -> (content -> forall x. parser x -> Either deeperError x)
  -> ByNameResult deeperError content a)
 -> ByName parser a)
-> (forall content deeperError.
    NameMap content
    -> (content -> forall x. parser x -> Either deeperError x)
    -> ByNameResult deeperError content a)
-> ByName parser a
forall a b. (a -> b) -> a -> b
$ \NameMap content
_ content -> forall x. parser x -> Either deeperError x
_ -> [(Maybe Text, Text)] -> ByNameResult deeperError content a
forall deeperError content a.
[(Maybe Text, Text)] -> ByNameResult deeperError content a
NotFoundByNameResult []
  ByName forall content deeperError.
NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content a
runL <|> :: ByName parser a -> ByName parser a -> ByName parser a
<|> ByName forall content deeperError.
NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content a
runR =
    (forall content deeperError.
 NameMap content
 -> (content -> forall x. parser x -> Either deeperError x)
 -> ByNameResult deeperError content a)
-> ByName parser a
forall (parser :: * -> *) a.
(forall content deeperError.
 NameMap content
 -> (content -> forall x. parser x -> Either deeperError x)
 -> ByNameResult deeperError content a)
-> ByName parser a
ByName ((forall content deeperError.
  NameMap content
  -> (content -> forall x. parser x -> Either deeperError x)
  -> ByNameResult deeperError content a)
 -> ByName parser a)
-> (forall content deeperError.
    NameMap content
    -> (content -> forall x. parser x -> Either deeperError x)
    -> ByNameResult deeperError content a)
-> ByName parser a
forall a b. (a -> b) -> a -> b
$ \NameMap content
map content -> forall x. parser x -> Either deeperError x
parse -> case NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content a
forall content deeperError.
NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content a
runL NameMap content
map content -> forall x. parser x -> Either deeperError x
parse of
      OkByNameResult NameMap content
map a
lRes -> NameMap content -> a -> ByNameResult deeperError content a
forall deeperError content a.
NameMap content -> a -> ByNameResult deeperError content a
OkByNameResult NameMap content
map a
lRes
      NotFoundByNameResult [(Maybe Text, Text)]
unfoundNamesL -> case NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content a
forall content deeperError.
NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content a
runR NameMap content
map content -> forall x. parser x -> Either deeperError x
parse of
        NotFoundByNameResult [(Maybe Text, Text)]
unfoundNamesR -> [(Maybe Text, Text)] -> ByNameResult deeperError content a
forall deeperError content a.
[(Maybe Text, Text)] -> ByNameResult deeperError content a
NotFoundByNameResult ([(Maybe Text, Text)]
unfoundNamesL [(Maybe Text, Text)]
-> [(Maybe Text, Text)] -> [(Maybe Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Maybe Text, Text)]
unfoundNamesR)
        ByNameResult deeperError content a
resR -> ByNameResult deeperError content a
resR
      FailedDeeperByNameResult Maybe Text
ns Text
name deeperError
err -> Maybe Text
-> Text -> deeperError -> ByNameResult deeperError content a
forall deeperError content a.
Maybe Text
-> Text -> deeperError -> ByNameResult deeperError content a
FailedDeeperByNameResult Maybe Text
ns Text
name deeperError
err

instance MonadPlus (ByName parser) where
  mzero :: ByName parser a
mzero = ByName parser a
forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: ByName parser a -> ByName parser a -> ByName parser a
mplus = ByName parser a -> ByName parser a -> ByName parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

-- |
-- Execute a parser on the result of looking up a content by namespace and name.
byName :: Maybe Text -> Text -> parser a -> ByName parser a
byName :: Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
ns Text
name parser a
parser =
  (forall content deeperError.
 NameMap content
 -> (content -> forall x. parser x -> Either deeperError x)
 -> ByNameResult deeperError content a)
-> ByName parser a
forall (parser :: * -> *) a.
(forall content deeperError.
 NameMap content
 -> (content -> forall x. parser x -> Either deeperError x)
 -> ByNameResult deeperError content a)
-> ByName parser a
ByName ((forall content deeperError.
  NameMap content
  -> (content -> forall x. parser x -> Either deeperError x)
  -> ByNameResult deeperError content a)
 -> ByName parser a)
-> (forall content deeperError.
    NameMap content
    -> (content -> forall x. parser x -> Either deeperError x)
    -> ByNameResult deeperError content a)
-> ByName parser a
forall a b. (a -> b) -> a -> b
$ \NameMap content
map content -> forall x. parser x -> Either deeperError x
parse ->
    case Maybe Text
-> Text -> NameMap content -> Maybe (content, NameMap content)
forall a. Maybe Text -> Text -> NameMap a -> Maybe (a, NameMap a)
NameMap.fetch Maybe Text
ns Text
name NameMap content
map of
      Just (content
content, NameMap content
map) -> case content -> parser a -> Either deeperError a
content -> forall x. parser x -> Either deeperError x
parse content
content parser a
parser of
        Right a
a -> NameMap content -> a -> ByNameResult deeperError content a
forall deeperError content a.
NameMap content -> a -> ByNameResult deeperError content a
OkByNameResult NameMap content
map a
a
        Left deeperError
err -> Maybe Text
-> Text -> deeperError -> ByNameResult deeperError content a
forall deeperError content a.
Maybe Text
-> Text -> deeperError -> ByNameResult deeperError content a
FailedDeeperByNameResult Maybe Text
ns Text
name deeperError
err
      Maybe (content, NameMap content)
Nothing -> [(Maybe Text, Text)] -> ByNameResult deeperError content a
forall deeperError content a.
[(Maybe Text, Text)] -> ByNameResult deeperError content a
NotFoundByNameResult [(Maybe Text
ns, Text
name)]