module XmlParser.AstParser
(
parseElement,
renderElementError,
ElementError (..),
NodeType (..),
Element,
elementName,
elementNameIs,
children,
childrenByName,
attributesByName,
astElement,
Nodes,
elementNode,
contentNode,
ByName,
byName,
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
parseElement :: Element a -> Xml.Element -> Either ElementError a
parseElement :: forall a. 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
forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst
renderElementError :: ElementError -> Text
renderElementError :: ElementError -> Text
renderElementError =
Builder -> Text
Tb.run 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
"/" forall a. Semigroup a => a -> a -> a
<> forall (foldable :: * -> *).
Foldable foldable =>
Builder -> foldable Builder -> Builder
Tb.intercalate Builder
"/" (forall a. [a] -> [a]
reverse [Builder]
a) forall a. Semigroup a => a -> a -> a
<> Builder
": " forall a. Semigroup a => a -> a -> a
<> Builder
b) 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 =
forall a. Monoid a => a -> a -> a
mappend Builder
"[" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Monoid a => a -> a -> a
mappend Builder
"]" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (foldable :: * -> *).
Foldable foldable =>
Builder -> foldable Builder -> Builder
Tb.intercalate Builder
", " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Builder
renderer forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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: "
forall a. Semigroup a => a -> a -> a
<> forall {a}. Ord a => (a -> Builder) -> [a] -> Builder
sortedList (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {a}. Maybe a -> Text -> Builder
name) [(Maybe Text, Text)]
a
forall a. Semigroup a => a -> a -> a
<> Builder
". Names available: "
forall a. Semigroup a => a -> a -> a
<> forall {a}. Ord a => (a -> Builder) -> [a] -> Builder
sortedList (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {a}. Maybe a -> Text -> Builder
name) [(Maybe Text, Text)]
b
)
ChildByNameElementError Maybe Text
a Text
b ElementError
c ->
[Builder] -> ElementError -> ([Builder], Builder)
elementError (forall {a}. Maybe a -> Text -> Builder
name Maybe Text
a Text
b forall a. a -> [a] -> [a]
: [Builder]
collectedPath) ElementError
c
ChildAtOffsetElementError Int
a NodeError
b ->
[Builder] -> NodeError -> ([Builder], Builder)
nodeError (forall a. Integral a => a -> Builder
Tb.decimal Int
a forall a. a -> [a] -> [a]
: [Builder]
collectedPath) NodeError
b
AttributeByNameElementError Maybe Text
a Text
b Maybe ContentError
c ->
((Builder
"@" forall a. Semigroup a => a -> a -> a
<> forall {a}. Maybe a -> Text -> Builder
name Maybe Text
a Text
b) 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: " forall a. Semigroup a => a -> a -> a
<> forall {a}. Ord a => (a -> Builder) -> [a] -> Builder
sortedList (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {a}. Maybe a -> Text -> Builder
name) [(Maybe Text, Text)]
a
forall a. Semigroup a => a -> a -> a
<> Builder
". The following are available: "
forall a. Semigroup a => a -> a -> a
<> forall {a}. Ord a => (a -> Builder) -> [a] -> Builder
sortedList (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry 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 " forall a. Semigroup a => a -> a -> a
<> forall {a}. IsString a => NodeType -> a
nodeType NodeType
b forall a. Semigroup a => a -> a -> a
<> Builder
", but expected " forall a. Semigroup a => a -> a -> a
<> forall {a}. IsString a => NodeType -> a
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 -> a
nodeType = \case
NodeType
ElementNodeType -> a
"element"
NodeType
InstructionNodeType -> a
"instruction"
NodeType
ContentNodeType -> a
"content"
NodeType
CommentNodeType -> a
"comment"
maybeContentError :: Maybe ContentError -> Builder
maybeContentError = 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: " forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Tb.text Text
a
UnexpectedValueContentError Text
a ->
Builder
"Unexpected value: " forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Tb.text Text
a
EnumContentError [Text]
a Text
b ->
Builder
"Unexpected value: " forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Tb.text Text
b forall a. Semigroup a => a -> a -> a
<> Builder
". Expecting one of the following: " forall a. Semigroup a => a -> a -> a
<> forall {a}. Ord a => (a -> Builder) -> [a] -> Builder
sortedList Text -> Builder
Tb.text [Text]
a
data ElementError
= AttributeByNameElementError
(Maybe Text)
Text
(Maybe ContentError)
| NoneOfAttributesFoundByNameElementError
[(Maybe Text, Text)]
[(Maybe Text, Text)]
| NoneOfChildrenFoundByNameElementError
[(Maybe Text, Text)]
[(Maybe Text, Text)]
| ChildByNameElementError
(Maybe Text)
Text
ElementError
| ChildAtOffsetElementError
Int
NodeError
| NameElementError Text
|
UserElementError Text
data NodeError
= UnexpectedNodeTypeNodeError
NodeType
NodeType
| NotAvailableNodeError
| ElementNodeError ElementError
| TextNodeError (Maybe ContentError)
data ContentError
= ParsingContentError Text
| NamespaceNotFoundContentError Text
| UnexpectedValueContentError Text
| EnumContentError
[Text]
Text
| UserContentError Text
data NodeType
= ElementNodeType
| InstructionNodeType
| ContentNodeType
|
newtype Element a
= Element
( NamespaceRegistry.NamespaceRegistry ->
Xml.Element ->
ElementDestructionState.ElementDestructionState ->
Either ElementError (a, ElementDestructionState.ElementDestructionState)
)
deriving
(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
<$ :: forall a b. a -> Element b -> Element a
$c<$ :: forall a b. a -> Element b -> Element a
fmap :: forall a b. (a -> b) -> Element a -> Element b
$cfmap :: forall a b. (a -> b) -> Element a -> Element b
Functor, Functor Element
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
<* :: forall a b. Element a -> Element b -> Element a
$c<* :: forall a b. Element a -> Element b -> Element a
*> :: forall a b. Element a -> Element b -> Element b
$c*> :: forall a b. Element a -> Element b -> Element b
liftA2 :: forall a b c. (a -> b -> c) -> Element a -> Element b -> Element c
$cliftA2 :: forall a b c. (a -> b -> c) -> Element a -> Element b -> Element c
<*> :: forall a b. Element (a -> b) -> Element a -> Element b
$c<*> :: forall a b. Element (a -> b) -> Element a -> Element b
pure :: forall a. a -> Element a
$cpure :: forall a. a -> Element a
Applicative, Applicative Element
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 :: forall a. a -> Element a
$creturn :: forall a. a -> Element a
>> :: forall a b. Element a -> Element b -> Element b
$c>> :: forall a b. Element a -> Element b -> Element b
>>= :: forall a b. Element a -> (a -> Element b) -> Element b
$c>>= :: forall a b. Element a -> (a -> Element b) -> Element b
Monad)
via ( ReaderT
(NamespaceRegistry.NamespaceRegistry)
( ReaderT
Xml.Element
( StateT
ElementDestructionState.ElementDestructionState
(Except ElementError)
)
)
)
instance MonadFail Element where
fail :: forall a. String -> Element a
fail = forall a. IsString a => String -> a
fromString 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 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b. a -> Either a b
Left forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a.
(NamespaceRegistry
-> Element
-> ElementDestructionState
-> Either ElementError (a, ElementDestructionState))
-> Element a
Element
elementName :: (Maybe Text -> Text -> Either Text a) -> Element a
elementName :: forall a. (Maybe Text -> Text -> Either Text a) -> Element a
elementName Maybe Text -> Text -> Either Text a
parse =
forall a.
(NamespaceRegistry
-> Element
-> ElementDestructionState
-> Either ElementError (a, ElementDestructionState))
-> Element a
Element forall a b. (a -> b) -> a -> b
$ \NamespaceRegistry
nreg (Xml.Element Name
name Map Name Text
_ [Node]
_) ElementDestructionState
state ->
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,ElementDestructionState
state) 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 -> forall a b. a -> Either a b
Left (Text -> ElementError
NameElementError (Text
"Unresolvable name: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (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 forall a b. a -> (a -> b) -> b
& forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> ElementError
NameElementError
elementNameIs :: Maybe Text -> Text -> Element ()
elementNameIs :: Maybe Text -> Text -> Element ()
elementNameIs Maybe Text
ns Text
name =
forall a. (Maybe Text -> Text -> Either Text a) -> Element a
elementName forall a b. (a -> b) -> a -> b
$ \Maybe Text
actualNs Text
actualName ->
if Maybe Text
actualNs forall a. Eq a => a -> a -> Bool
== Maybe Text
ns
then
if Text
actualName forall a. Eq a => a -> a -> Bool
== Text
name
then forall a b. b -> Either a b
Right ()
else forall a b. a -> Either a b
Left (Text
"Unexpected name: \"" forall a. Semigroup a => a -> a -> a
<> Text
actualName forall a. Semigroup a => a -> a -> a
<> Text
"\". Expecting: \"" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
"\"")
else forall a b. a -> Either a b
Left (Text
"Unexpected namespace: \"" forall a. Semigroup a => a -> a -> a
<> (forall a. IsString a => String -> a
fromString forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Show a => a -> String
show) Maybe Text
actualNs forall a. Semigroup a => a -> a -> a
<> Text
"\". Expecting: \"" forall a. Semigroup a => a -> a -> a
<> (forall a. IsString a => String -> a
fromString forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Show a => a -> String
show) Maybe Text
ns forall a. Semigroup a => a -> a -> a
<> Text
"\"")
childrenByName :: ByName Element a -> Element a
childrenByName :: forall a. 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) =
forall a.
(NamespaceRegistry
-> Element
-> ElementDestructionState
-> Either ElementError (a, ElementDestructionState))
-> Element a
Element 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 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) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 -> forall a b. b -> Either a b
Right (a
res, ElementDestructionState
state)
NotFoundByNameResult [(Maybe Text, Text)]
unfoundNames ->
let availNames :: [(Maybe Text, Text)]
availNames = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. NameMap a -> [(Maybe Text, Text)]
NameMap.extractNames NameMap Element
nameMap
in 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 ->
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
attributesByName :: ByName Content a -> Element a
attributesByName :: forall a. 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) =
forall a.
(NamespaceRegistry
-> Element
-> ElementDestructionState
-> Either ElementError (a, ElementDestructionState))
-> Element a
Element 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 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 -> forall a b. b -> Either a b
Right (a
res, ElementDestructionState
state)
NotFoundByNameResult [(Maybe Text, Text)]
unfoundNames ->
let availNames :: [(Maybe Text, Text)]
availNames = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. NameMap a -> [(Maybe Text, Text)]
NameMap.extractNames NameMap Text
nameMap
in 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 ->
forall a b. a -> Either a b
Left (Maybe Text -> Text -> Maybe ContentError -> ElementError
AttributeByNameElementError Maybe Text
ns Text
name Maybe ContentError
err)
children :: Nodes a -> Element a
children :: forall a. Nodes a -> Element a
children (Nodes NodeConsumerState -> Either ElementError (a, NodeConsumerState)
runNodes) =
forall a.
(NamespaceRegistry
-> Element
-> ElementDestructionState
-> Either ElementError (a, ElementDestructionState))
-> Element a
Element 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)
forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst
forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,ElementDestructionState
state)
astElement :: Element Xml.Element
astElement :: Element Element
astElement =
forall a.
(NamespaceRegistry
-> Element
-> ElementDestructionState
-> Either ElementError (a, ElementDestructionState))
-> Element a
Element forall a b. (a -> b) -> a -> b
$ \NamespaceRegistry
_ Element
element ElementDestructionState
state -> forall a b. b -> Either a b
Right (Element
element, ElementDestructionState
state)
newtype Nodes a
= Nodes (NodeConsumerState.NodeConsumerState -> Either ElementError (a, NodeConsumerState.NodeConsumerState))
deriving
(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
<$ :: forall a b. a -> Nodes b -> Nodes a
$c<$ :: forall a b. a -> Nodes b -> Nodes a
fmap :: forall a b. (a -> b) -> Nodes a -> Nodes b
$cfmap :: forall a b. (a -> b) -> Nodes a -> Nodes b
Functor, Functor Nodes
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
<* :: forall a b. Nodes a -> Nodes b -> Nodes a
$c<* :: forall a b. Nodes a -> Nodes b -> Nodes a
*> :: forall a b. Nodes a -> Nodes b -> Nodes b
$c*> :: forall a b. Nodes a -> Nodes b -> Nodes b
liftA2 :: forall a b c. (a -> b -> c) -> Nodes a -> Nodes b -> Nodes c
$cliftA2 :: forall a b c. (a -> b -> c) -> Nodes a -> Nodes b -> Nodes c
<*> :: forall a b. Nodes (a -> b) -> Nodes a -> Nodes b
$c<*> :: forall a b. Nodes (a -> b) -> Nodes a -> Nodes b
pure :: forall a. a -> Nodes a
$cpure :: forall a. a -> Nodes a
Applicative, Applicative Nodes
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 :: forall a. a -> Nodes a
$creturn :: forall a. a -> Nodes a
>> :: forall a b. Nodes a -> Nodes b -> Nodes b
$c>> :: forall a b. Nodes a -> Nodes b -> Nodes b
>>= :: forall a b. Nodes a -> (a -> Nodes b) -> Nodes b
$c>>= :: forall a b. Nodes a -> (a -> Nodes b) -> Nodes b
Monad)
via (StateT NodeConsumerState.NodeConsumerState (Either ElementError))
elementNode :: Element a -> Nodes a
elementNode :: forall a. Element a -> Nodes a
elementNode (Element NamespaceRegistry
-> Element
-> ElementDestructionState
-> Either ElementError (a, ElementDestructionState)
runElement) =
forall a.
(NodeConsumerState -> Either ElementError (a, NodeConsumerState))
-> Nodes a
Nodes 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 ->
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) 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)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 =
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)
_ -> forall a b. a -> Either a b
Left (Int -> NodeError -> ElementError
ChildAtOffsetElementError (NodeConsumerState -> Int
NodeConsumerState.getOffset NodeConsumerState
x) NodeError
NotAvailableNodeError)
contentNode :: Content content -> Nodes content
contentNode :: forall content. Content content -> Nodes content
contentNode (Content (Text -> Maybe Text) -> Text -> Either (Maybe ContentError) content
parseContent) =
forall a.
(NodeConsumerState -> Either ElementError (a, NodeConsumerState))
-> Nodes a
Nodes 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 ->
forall a b. b -> Either a b
Right (content
parsedContent, NodeConsumerState -> NodeConsumerState
NodeConsumerState.bumpOffset NodeConsumerState
x)
Left Maybe ContentError
contentError ->
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 =
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) forall a. Monoid a => a
mempty of
Right content
parsedContent ->
forall a b. b -> Either a b
Right (content
parsedContent, NodeConsumerState -> NodeConsumerState
NodeConsumerState.bumpOffset NodeConsumerState
x)
Left Maybe ContentError
contentError ->
forall a b. a -> Either a b
Left (Int -> NodeError -> ElementError
ChildAtOffsetElementError Int
0 (Maybe ContentError -> NodeError
TextNodeError Maybe ContentError
contentError))
Int
offset ->
forall a b. a -> Either a b
Left (Int -> NodeError -> ElementError
ChildAtOffsetElementError Int
offset NodeError
NotAvailableNodeError)
newtype Content content
=
Content ((Text -> Maybe Text) -> Text -> Either (Maybe ContentError) content)
deriving
(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
<$ :: forall a b. a -> Content b -> Content a
$c<$ :: forall a b. a -> Content b -> Content a
fmap :: forall a b. (a -> b) -> Content a -> Content b
$cfmap :: forall a b. (a -> b) -> Content a -> Content b
Functor, Functor Content
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
<* :: forall a b. Content a -> Content b -> Content a
$c<* :: forall a b. Content a -> Content b -> Content a
*> :: forall a b. Content a -> Content b -> Content b
$c*> :: forall a b. Content a -> Content b -> Content b
liftA2 :: forall a b c. (a -> b -> c) -> Content a -> Content b -> Content c
$cliftA2 :: forall a b c. (a -> b -> c) -> Content a -> Content b -> Content c
<*> :: forall a b. Content (a -> b) -> Content a -> Content b
$c<*> :: forall a b. Content (a -> b) -> Content a -> Content b
pure :: forall a. a -> Content a
$cpure :: forall a. a -> Content a
Applicative, Applicative Content
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 :: forall a. a -> Content a
$creturn :: forall a. a -> Content a
>> :: forall a b. Content a -> Content b -> Content b
$c>> :: forall a b. Content a -> Content b -> Content b
>>= :: forall a b. Content a -> (a -> Content b) -> Content b
$c>>= :: forall a b. Content a -> (a -> Content b) -> Content b
Monad, Applicative Content
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 :: forall a. Content a -> Content [a]
$cmany :: forall a. Content a -> Content [a]
some :: forall a. Content a -> Content [a]
$csome :: forall a. Content a -> Content [a]
<|> :: forall a. Content a -> Content a -> Content a
$c<|> :: forall a. Content a -> Content a -> Content a
empty :: forall a. Content a
$cempty :: forall a. Content a
Alternative, Monad Content
Alternative Content
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 :: forall a. Content a -> Content a -> Content a
$cmplus :: forall a. Content a -> Content a -> Content a
mzero :: forall a. Content a
$cmzero :: forall a. Content a
MonadPlus)
via (ReaderT (Text -> Maybe Text) (ExceptT (Last ContentError) ((->) Text)))
instance MonadFail Content where
fail :: forall a. String -> Content a
fail = forall a. IsString a => String -> a
fromString 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 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b. a -> Either a b
Left forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall content.
((Text -> Maybe Text)
-> Text -> Either (Maybe ContentError) content)
-> Content content
Content
textContent :: Content Text
textContent :: Content Text
textContent =
forall content.
((Text -> Maybe Text)
-> Text -> Either (Maybe ContentError) content)
-> Content content
Content (forall a b. a -> b -> a
const forall (f :: * -> *) a. Applicative f => a -> f a
pure)
narrowedContent :: (Text -> Maybe a) -> Content a
narrowedContent :: forall a. (Text -> Maybe a) -> Content a
narrowedContent Text -> Maybe a
mapper =
forall content.
((Text -> Maybe Text)
-> Text -> Either (Maybe ContentError) content)
-> Content content
Content (forall a b. a -> b -> a
const (\Text
x -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just (Text -> ContentError
UnexpectedValueContentError Text
x))) forall a b. b -> Either a b
Right (Text -> Maybe a
mapper Text
x)))
refinedContent :: (Text -> Either Text a) -> Content a
refinedContent :: forall a. (Text -> Either Text a) -> Content a
refinedContent Text -> Either Text a
refine =
forall content.
((Text -> Maybe Text)
-> Text -> Either (Maybe ContentError) content)
-> Content content
Content (forall a b. a -> b -> a
const (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a. a -> Maybe a
Just 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) 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))
enumContent :: [(Text, a)] -> Content a
enumContent :: forall a. [(Text, a)] -> Content a
enumContent [(Text, a)]
mappingList =
let !expectedKeysList :: [Text]
expectedKeysList =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(Text, a)]
mappingList
mappingListLength :: Int
mappingListLength =
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, a)]
mappingList
!narrow :: Text -> Maybe a
narrow =
if Int
mappingListLength forall a. Ord a => a -> a -> Bool
> Int
512
then
let !hashMap :: HashMap Text a
hashMap = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, a)]
mappingList
in forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup HashMap Text a
hashMap
else forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 -> forall a b. b -> Either a b
Right a
b
Maybe a
_ -> forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just ([Text] -> Text -> ContentError
EnumContentError [Text]
expectedKeysList Text
a))
in forall content.
((Text -> Maybe Text)
-> Text -> Either (Maybe ContentError) content)
-> Content content
Content (forall a b. a -> b -> a
const Text -> Either (Maybe ContentError) a
extract)
attoparsedContent :: Attoparsec.Parser a -> Content a
attoparsedContent :: forall a. Parser a -> Content a
attoparsedContent Parser a
parser =
forall content.
((Text -> Maybe Text)
-> Text -> Either (Maybe ContentError) content)
-> Content content
Content (forall a b. a -> b -> a
const (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a. a -> Maybe a
Just 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. IsString a => String -> a
fromString) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Parser a -> Text -> Either String a
Attoparsec.parseOnly Parser a
parser))
qNameContent :: Content (Maybe Text, Text)
qNameContent :: Content (Maybe Text, Text)
qNameContent =
forall content.
((Text -> Maybe Text)
-> Text -> Either (Maybe ContentError) content)
-> Content content
Content forall a b. (a -> b) -> a -> b
$ \Text -> Maybe Text
lookup Text
content -> case 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 -> forall a b. b -> Either a b
Right (forall a. a -> Maybe a
Just Text
uri, Text
name)
Maybe Text
Nothing -> forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just (Text -> ContentError
NamespaceNotFoundContentError Text
ns))
Maybe Text
Nothing -> forall a b. b -> Either a b
Right (forall a. Maybe a
Nothing, Text
name)
Left Text
err -> forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just (Text -> ContentError
ParsingContentError Text
err))
data ByNameResult deeperError content a
= NotFoundByNameResult [(Maybe Text, Text)]
| FailedDeeperByNameResult (Maybe Text) Text deeperError
| OkByNameResult (NameMap.NameMap content) a
deriving (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
<$ :: forall a b.
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 :: forall a b.
(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)
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 :: forall a b. (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 (parser :: * -> *) a.
(forall content deeperError.
NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content a)
-> ByName parser a
ByName forall a b. (a -> b) -> a -> b
$ \NameMap content
map content -> forall x. parser x -> Either deeperError x
parse -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
fn (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 :: forall a. a -> ByName parser a
pure a
x =
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 a b. (a -> b) -> a -> b
$ \NameMap content
map content -> forall x. parser x -> Either deeperError x
_ -> 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 <*> :: forall a b.
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 (parser :: * -> *) a.
(forall content deeperError.
NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content a)
-> ByName parser a
ByName forall a b. (a -> b) -> a -> b
$ \NameMap content
map content -> forall x. parser x -> Either deeperError x
parse -> case 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 -> 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 forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
lRes
NotFoundByNameResult [(Maybe Text, Text)]
unfoundNames -> forall deeperError content a.
[(Maybe Text, Text)] -> ByNameResult deeperError content a
NotFoundByNameResult [(Maybe Text, Text)]
unfoundNames
FailedDeeperByNameResult Maybe Text
ns Text
name deeperError
err -> 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 :: forall a. a -> ByName parser a
return = 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 >>= :: forall a b.
ByName parser a -> (a -> ByName parser b) -> ByName parser b
>>= a -> ByName parser b
k =
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 a b. (a -> b) -> a -> b
$ \NameMap content
map content -> forall x. parser x -> Either deeperError x
parse -> case 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 -> 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 -> forall deeperError content a.
[(Maybe Text, Text)] -> ByNameResult deeperError content a
NotFoundByNameResult [(Maybe Text, Text)]
unfoundNames
FailedDeeperByNameResult Maybe Text
ns Text
name deeperError
err -> 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 :: forall a. ByName parser a
empty =
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 a b. (a -> b) -> a -> b
$ \NameMap content
_ content -> forall x. parser x -> Either deeperError x
_ -> 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 <|> :: forall a. 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 (parser :: * -> *) a.
(forall content deeperError.
NameMap content
-> (content -> forall x. parser x -> Either deeperError x)
-> ByNameResult deeperError content a)
-> ByName parser a
ByName forall a b. (a -> b) -> a -> b
$ \NameMap content
map content -> forall x. parser x -> Either deeperError x
parse -> case 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 -> forall deeperError content a.
NameMap content -> a -> ByNameResult deeperError content a
OkByNameResult NameMap content
map a
lRes
NotFoundByNameResult [(Maybe Text, Text)]
unfoundNamesL -> case 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 -> forall deeperError content a.
[(Maybe Text, Text)] -> ByNameResult deeperError content a
NotFoundByNameResult ([(Maybe Text, Text)]
unfoundNamesL 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 -> 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 :: forall a. ByName parser a
mzero = forall (f :: * -> *) a. Alternative f => f a
empty
mplus :: forall a. ByName parser a -> ByName parser a -> ByName parser a
mplus = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
byName :: Maybe Text -> Text -> parser a -> ByName parser a
byName :: forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
ns Text
name parser a
parser =
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 a b. (a -> b) -> a -> b
$ \NameMap content
map content -> forall x. parser x -> Either deeperError x
parse ->
case 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 -> forall x. parser x -> Either deeperError x
parse content
content parser a
parser of
Right a
a -> forall deeperError content a.
NameMap content -> a -> ByNameResult deeperError content a
OkByNameResult NameMap content
map a
a
Left deeperError
err -> 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 -> forall deeperError content a.
[(Maybe Text, Text)] -> ByNameResult deeperError content a
NotFoundByNameResult [(Maybe Text
ns, Text
name)]