{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}

-- | Backtracking combinators for consuming XML productions (elements, attributes).
module Fadno.Xml.XParser {-# DEPRECATED "in favor of XParse" #-}
    (
     -- * XParser monad
     XParser
    ,parseX
    -- * Stack manipulation
    ,peek,push,pop,checkStack
    -- * Element operations
    ,atEl,findChild,findChildren,anyChildren,oneChild,allChildren,manyOrdered
    -- * Attribute/Text operations
    ,attr,textContent
    -- * QNames
    ,name,xsName
    -- * Utility
    ,readXml
    ) where

import qualified Text.XML.Light as X

import Control.Exception
import Control.Monad
import Control.Monad.State.Strict hiding (sequence)
import Control.Monad.Except hiding (sequence)
import Data.Either
import Control.Applicative
import Prelude hiding (sequence)
import Control.Lens

-- Element lenses
lAttrs :: Lens' X.Element [X.Attr]
lAttrs :: Lens' Element [Attr]
lAttrs [Attr] -> f [Attr]
f Element
s = ([Attr] -> Element) -> f [Attr] -> f Element
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Attr]
a -> Element
s { X.elAttribs = a }) ([Attr] -> f [Attr]
f ([Attr] -> f [Attr]) -> [Attr] -> f [Attr]
forall a b. (a -> b) -> a -> b
$ Element -> [Attr]
X.elAttribs Element
s)
lContent :: Lens' X.Element [X.Content]
lContent :: Lens' Element [Content]
lContent [Content] -> f [Content]
f Element
s = ([Content] -> Element) -> f [Content] -> f Element
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Content]
a -> Element
s { X.elContent = a }) ([Content] -> f [Content]
f ([Content] -> f [Content]) -> [Content] -> f [Content]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
X.elContent Element
s)
_Elem :: Prism' X.Content X.Element
_Elem :: Prism' Content Element
_Elem = (Element -> Content)
-> (Content -> Either Content Element) -> Prism' Content Element
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Element -> Content
X.Elem ((Content -> Either Content Element) -> Prism' Content Element)
-> (Content -> Either Content Element) -> Prism' Content Element
forall a b. (a -> b) -> a -> b
$ \Content
c -> case Content
c of X.Elem Element
e -> Element -> Either Content Element
forall a b. b -> Either a b
Right Element
e; Content
_ -> Content -> Either Content Element
forall a b. a -> Either a b
Left Content
c

-- | Stack entry tracking identified elements.

-- | XParser constraint kind. Stack state + alternative + errors.
type XParser m = (Alternative m, MonadState [X.Element] m, MonadError String m)

-- | run XParser on an element.
parseX :: (Monad m) => StateT [X.Element] (ExceptT String m) b -> X.Element -> m (Either String b)
parseX :: forall (m :: * -> *) b.
Monad m =>
StateT [Element] (ExceptT String m) b
-> Element -> m (Either String b)
parseX StateT [Element] (ExceptT String m) b
sel Element
e = ExceptT String m b -> m (Either String b)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (StateT [Element] (ExceptT String m) b
-> [Element] -> ExceptT String m b
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT [Element] (ExceptT String m) b
sel [Element
e])

-- | Stack peek.
peek :: XParser m => m X.Element
peek :: forall (m :: * -> *). XParser m => m Element
peek = [Element] -> Element
forall a. HasCallStack => [a] -> a
head ([Element] -> Element) -> m [Element] -> m Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Element]
forall (m :: * -> *). XParser m => m [Element]
checkStack

-- | Verify populated stack.
checkStack :: XParser m => m [X.Element]
checkStack :: forall (m :: * -> *). XParser m => m [Element]
checkStack = m [Element]
forall s (m :: * -> *). MonadState s m => m s
get m [Element] -> ([Element] -> m [Element]) -> m [Element]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Element]
s ->
             if [Element] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Element]
s then String -> m [Element]
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"Invalid stack" else [Element] -> m [Element]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Element]
s

-- | Stack push.
push :: XParser m => X.Element -> m ()
push :: forall (m :: * -> *). XParser m => Element -> m ()
push Element
e = ([Element] -> [Element]) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Element
eElement -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:)

-- | Stack pop.
pop :: XParser m => m ()
pop :: forall (m :: * -> *). XParser m => m ()
pop = m [Element]
forall (m :: * -> *). XParser m => m [Element]
checkStack m [Element] -> ([Element] -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Element
_:[Element]
rest) -> [Element] -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Element]
rest

-- | Expect/consume a particular attribute.
attr :: XParser m => X.QName -> m String
attr :: forall (m :: * -> *). XParser m => QName -> m String
attr QName
n = do
  [Attr]
as <- Getting [Attr] Element [Attr] -> Element -> [Attr]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Attr] Element [Attr]
Lens' Element [Attr]
lAttrs (Element -> [Attr]) -> m Element -> m [Attr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Element
forall (m :: * -> *). XParser m => m Element
peek
  let ([Attr]
as',Maybe String
found) = (([Attr], Maybe String) -> Attr -> ([Attr], Maybe String))
-> ([Attr], Maybe String) -> [Attr] -> ([Attr], Maybe String)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ([Attr], Maybe String) -> Attr -> ([Attr], Maybe String)
test ([],Maybe String
forall a. Maybe a
Nothing) [Attr]
as
      test :: ([Attr], Maybe String) -> Attr -> ([Attr], Maybe String)
test ([Attr]
rs,f :: Maybe String
f@(Just String
_)) Attr
a = (Attr
aAttr -> [Attr] -> [Attr]
forall a. a -> [a] -> [a]
:[Attr]
rs,Maybe String
f)
      test ([Attr]
rs,Maybe String
_) Attr
a | Attr -> QName
X.attrKey Attr
a QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== QName
n = ([Attr]
rs,String -> Maybe String
forall a. a -> Maybe a
Just (Attr -> String
X.attrVal Attr
a))
                    | Bool
otherwise = (Attr
aAttr -> [Attr] -> [Attr]
forall a. a -> [a] -> [a]
:[Attr]
rs,Maybe String
forall a. Maybe a
Nothing)
  case Maybe String
found of
    Maybe String
Nothing -> String -> m String
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
"Attribute not found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QName -> String
forall a. Show a => a -> String
show QName
n
    Just String
t -> do
               (Element -> Identity Element) -> [Element] -> Identity [Element]
forall s a. Cons s s a a => Traversal' s a
Traversal' [Element] Element
_head((Element -> Identity Element) -> [Element] -> Identity [Element])
-> (([Attr] -> Identity [Attr]) -> Element -> Identity Element)
-> ([Attr] -> Identity [Attr])
-> [Element]
-> Identity [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Attr] -> Identity [Attr]) -> Element -> Identity Element
Lens' Element [Attr]
lAttrs (([Attr] -> Identity [Attr]) -> [Element] -> Identity [Element])
-> [Attr] -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [Attr]
as'
               String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
t

-- | Get text content, returning empty string if none, per 'strContent'.
textContent :: XParser m => m String
textContent :: forall (m :: * -> *). XParser m => m String
textContent = Element -> String
X.strContent (Element -> String) -> m Element -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Element
forall (m :: * -> *). XParser m => m Element
peek

-- | Verify and "consume" current element.
atEl :: XParser m => X.QName -> m ()
atEl :: forall (m :: * -> *). XParser m => QName -> m ()
atEl QName
n = do
  QName
e <- Element -> QName
X.elName (Element -> QName) -> m Element -> m QName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Element
forall (m :: * -> *). XParser m => m Element
peek
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (QName
n QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
/= QName
e) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
"Wrong element name: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QName -> String
forall a. Show a => a -> String
show QName
e)

-- | Find child element and act on it.
findChild :: XParser m => X.QName -> m a -> m a
findChild :: forall (m :: * -> *) a. XParser m => QName -> m a -> m a
findChild QName
n m a
act = do
  [a]
c <- (Element -> Bool) -> Bool -> Bool -> m a -> m [a]
forall (m :: * -> *) a.
XParser m =>
(Element -> Bool) -> Bool -> Bool -> m a -> m [a]
onChildren ((QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
==QName
n) (QName -> Bool) -> (Element -> QName) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> QName
X.elName) Bool
True Bool
True m a
act
  case [a]
c of
    [] -> String -> m a
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"No such child " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QName -> String
forall a. Show a => a -> String
show QName
n
    [a
e] -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
e
    [a]
_ -> String -> m a
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"findChild: multiple results: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QName -> String
forall a. Show a => a -> String
show QName
n

-- | Expect to find one child only, and run action on it.
oneChild :: XParser m => m a -> m a
oneChild :: forall (m :: * -> *) a. XParser m => m a -> m a
oneChild m a
act = do
  [a]
cs <- (Element -> Bool) -> Bool -> Bool -> m a -> m [a]
forall (m :: * -> *) a.
XParser m =>
(Element -> Bool) -> Bool -> Bool -> m a -> m [a]
onChildren (Bool -> Element -> Bool
forall a b. a -> b -> a
const Bool
True) Bool
True Bool
True m a
act
  case [a]
cs of
    [a
c] -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
c
    [a]
_ -> String -> m a
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"oneChild: found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
cs)

-- | Find zero or many children and act on them.
findChildren :: XParser m => X.QName -> m a -> m [a]
findChildren :: forall (m :: * -> *) a. XParser m => QName -> m a -> m [a]
findChildren QName
n = (Element -> Bool) -> Bool -> Bool -> m a -> m [a]
forall (m :: * -> *) a.
XParser m =>
(Element -> Bool) -> Bool -> Bool -> m a -> m [a]
onChildren ((QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
==QName
n) (QName -> Bool) -> (Element -> QName) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> QName
X.elName) Bool
False Bool
False

-- | Act on all children.
allChildren :: XParser m => m a -> m [a]
allChildren :: forall (m :: * -> *) a. XParser m => m a -> m [a]
allChildren = (Element -> Bool) -> Bool -> Bool -> m a -> m [a]
forall (m :: * -> *) a.
XParser m =>
(Element -> Bool) -> Bool -> Bool -> m a -> m [a]
onChildren (Bool -> Element -> Bool
forall a b. a -> b -> a
const Bool
True) Bool
False Bool
False

-- | Act on, consume children.
-- Accepts filter, optional flag, "just1" flag.
onChildren :: XParser m => (X.Element -> Bool) -> Bool -> Bool -> m a -> m [a]
onChildren :: forall (m :: * -> *) a.
XParser m =>
(Element -> Bool) -> Bool -> Bool -> m a -> m [a]
onChildren Element -> Bool
filt Bool
opt Bool
just1 m a
act = do
  Element
h <- m Element
forall (m :: * -> *). XParser m => m Element
peek
  let exec :: s -> Content -> m s
exec s
rs c :: Content
c@(X.Elem Element
e)
          | Element -> Bool
filt Element
e =
              if Bool
just1 Bool -> Bool -> Bool
&& Bool -> Bool
not ([a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Getting [a] s [a] -> s -> [a]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [a] s [a]
forall s t a b. Field2 s t a b => Lens s t a b
Lens s s [a] [a]
_2 s
rs))
              then s -> m s
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> m s) -> s -> m s
forall a b. (a -> b) -> a -> b
$ ASetter s s [Content] [Content]
-> ([Content] -> [Content]) -> s -> s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter s s [Content] [Content]
forall s t a b. Field1 s t a b => Lens s t a b
Lens s s [Content] [Content]
_1 (Content
cContent -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:) s
rs
              else do
                Element -> m ()
forall (m :: * -> *). XParser m => Element -> m ()
push Element
e
                Either String a
r <- m (Either String a)
-> (String -> m (Either String a)) -> m (Either String a)
forall a. m a -> (String -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> m a -> m (Either String a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act) (Either String a -> m (Either String a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> m (Either String a))
-> (String -> Either String a) -> String -> m (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a b. a -> Either a b
Left)
                m ()
forall (m :: * -> *). XParser m => m ()
pop
                case Either String a
r of
                  Left String
err | Bool
opt -> s -> m s
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> m s) -> s -> m s
forall a b. (a -> b) -> a -> b
$ ASetter s s [Content] [Content]
-> ([Content] -> [Content]) -> s -> s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter s s [Content] [Content]
forall s t a b. Field1 s t a b => Lens s t a b
Lens s s [Content] [Content]
_1 (Content
cContent -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:) s
rs
                           | Bool
otherwise -> s -> m s
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> m s) -> s -> m s
forall a b. (a -> b) -> a -> b
$ ASetter s s [String] [String] -> ([String] -> [String]) -> s -> s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter s s [String] [String]
forall s t a b. Field3 s t a b => Lens s t a b
Lens s s [String] [String]
_3 (String
errString -> [String] -> [String]
forall a. a -> [a] -> [a]
:) s
rs
                  Right a
v -> s -> m s
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> m s) -> s -> m s
forall a b. (a -> b) -> a -> b
$ ASetter s s [a] [a] -> ([a] -> [a]) -> s -> s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter s s [a] [a]
forall s t a b. Field2 s t a b => Lens s t a b
Lens s s [a] [a]
_2 (a
va -> [a] -> [a]
forall a. a -> [a] -> [a]
:) s
rs
          | Bool
otherwise = s -> m s
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> m s) -> s -> m s
forall a b. (a -> b) -> a -> b
$ ASetter s s [Content] [Content]
-> ([Content] -> [Content]) -> s -> s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter s s [Content] [Content]
forall s t a b. Field1 s t a b => Lens s t a b
Lens s s [Content] [Content]
_1 (Content
cContent -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:) s
rs
      exec s
rs Content
c = s -> m s
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> m s) -> s -> m s
forall a b. (a -> b) -> a -> b
$ ASetter s s [Content] [Content]
-> ([Content] -> [Content]) -> s -> s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter s s [Content] [Content]
forall s t a b. Field1 s t a b => Lens s t a b
Lens s s [Content] [Content]
_1 (Content
cContent -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:) s
rs
  ([Content]
cs',[a]
rs,[String]
fs) <- (([Content], [a], [String])
 -> Content -> m ([Content], [a], [String]))
-> ([Content], [a], [String])
-> [Content]
-> m ([Content], [a], [String])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([Content], [a], [String])
-> Content -> m ([Content], [a], [String])
forall {s}.
(Field1 s s [Content] [Content], Field3 s s [String] [String],
 Field2 s s [a] [a]) =>
s -> Content -> m s
exec ([],[],[]) (Getting [Content] Element [Content] -> Element -> [Content]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Content] Element [Content]
Lens' Element [Content]
lContent Element
h)
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
fs) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Failure: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
fs
  (Element -> Identity Element) -> [Element] -> Identity [Element]
forall s a. Cons s s a a => Traversal' s a
Traversal' [Element] Element
_head((Element -> Identity Element) -> [Element] -> Identity [Element])
-> (([Content] -> Identity [Content])
    -> Element -> Identity Element)
-> ([Content] -> Identity [Content])
-> [Element]
-> Identity [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Content] -> Identity [Content]) -> Element -> Identity Element
Lens' Element [Content]
lContent (([Content] -> Identity [Content])
 -> [Element] -> Identity [Element])
-> [Content] -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [Content] -> [Content]
forall a. [a] -> [a]
reverse [Content]
cs'
  [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
rs)

-- | Flailing attempt to restore "order" by faking a single-child element one at a time.
manyOrdered :: XParser m => m a -> m [a]
manyOrdered :: forall (m :: * -> *) a. XParser m => m a -> m [a]
manyOrdered m a
act = do
  [Content]
cs <- Getting [Content] Element [Content] -> Element -> [Content]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Content] Element [Content]
Lens' Element [Content]
lContent (Element -> [Content]) -> m Element -> m [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Element
forall (m :: * -> *). XParser m => m Element
peek
  let fake :: Content -> Element
fake Content
c = QName -> [Attr] -> [Content] -> Maybe Line -> Element
X.Element (String -> QName
name String
"fake") [] [Content
c] Maybe Line
forall a. Maybe a
Nothing
      exec :: s -> Content -> m b
exec s
rs Content
c = do
                Element -> m ()
forall (m :: * -> *). XParser m => Element -> m ()
push (Content -> Element
fake Content
c)
                Either String a
r <- m (Either String a)
-> (String -> m (Either String a)) -> m (Either String a)
forall a. m a -> (String -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> m a -> m (Either String a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act) (Either String a -> m (Either String a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> m (Either String a))
-> (String -> Either String a) -> String -> m (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a b. a -> Either a b
Left)
                m ()
forall (m :: * -> *). XParser m => m ()
pop
                case Either String a
r of
                  Left String
_ -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ASetter s b [Content] [Content]
-> ([Content] -> [Content]) -> s -> b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter s b [Content] [Content]
forall s t a b. Field2 s t a b => Lens s t a b
Lens s b [Content] [Content]
_2 (Content
cContent -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:) s
rs)
                  Right a
a -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ASetter s b [a] [a] -> ([a] -> [a]) -> s -> b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter s b [a] [a]
forall s t a b. Field1 s t a b => Lens s t a b
Lens s b [a] [a]
_1 (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) s
rs)
  ([a]
as,[Content]
cs') <- (([a], [Content]) -> Content -> m ([a], [Content]))
-> ([a], [Content]) -> [Content] -> m ([a], [Content])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([a], [Content]) -> Content -> m ([a], [Content])
forall {s} {b}.
(Field2 s b [Content] [Content], Field1 s b [a] [a]) =>
s -> Content -> m b
exec ([],[]) [Content]
cs
  (Element -> Identity Element) -> [Element] -> Identity [Element]
forall s a. Cons s s a a => Traversal' s a
Traversal' [Element] Element
_head((Element -> Identity Element) -> [Element] -> Identity [Element])
-> (([Content] -> Identity [Content])
    -> Element -> Identity Element)
-> ([Content] -> Identity [Content])
-> [Element]
-> Identity [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Content] -> Identity [Content]) -> Element -> Identity Element
Lens' Element [Content]
lContent (([Content] -> Identity [Content])
 -> [Element] -> Identity [Element])
-> [Content] -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [Content] -> [Content]
forall a. [a] -> [a]
reverse [Content]
cs'
  [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> m [a]) -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
as


-- | Run optional action on all children.
anyChildren :: XParser m => m a -> m [a]
anyChildren :: forall (m :: * -> *) a. XParser m => m a -> m [a]
anyChildren = (Element -> Bool) -> Bool -> Bool -> m a -> m [a]
forall (m :: * -> *) a.
XParser m =>
(Element -> Bool) -> Bool -> Bool -> m a -> m [a]
onChildren (Bool -> Element -> Bool
forall a b. a -> b -> a
const Bool
True) Bool
True Bool
False

-- | Special support for XSD QNames.
xsName :: String -> X.QName
xsName :: String -> QName
xsName String
n = String -> Maybe String -> Maybe String -> QName
X.QName String
n (String -> Maybe String
forall a. a -> Maybe a
Just String
"http://www.w3.org/2001/XMLSchema") (String -> Maybe String
forall a. a -> Maybe a
Just String
"xs")

-- | Local-only QName.
name :: String -> X.QName
name :: String -> QName
name String
n = String -> Maybe String -> Maybe String -> QName
X.QName String
n Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing

-- | Convenience to read in top element from file.
readXml :: FilePath -> IO X.Element
readXml :: String -> IO Element
readXml String
f = IO Element
-> (Element -> IO Element) -> Maybe Element -> IO Element
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IOError -> IO Element
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO Element) -> IOError -> IO Element
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
"parse failed") Element -> IO Element
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Element -> IO Element) -> IO (Maybe Element) -> IO Element
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
X.parseXMLDoc (String -> Maybe Element) -> IO String -> IO (Maybe Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
f