{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Readers.ODT.Generic.XMLConverter
   Copyright   : Copyright (C) 2015 Martin Linnemann
   License     : GNU GPL, version 2 or above

   Maintainer  : Martin Linnemann <theCodingMarlin@googlemail.com>
   Stability   : alpha
   Portability : portable

A generalized monadic XML parser. The parser navigates through an XML
tree, always looking at a \"current element\", and carries some
additional, converter-specific state.
-}

module Text.Pandoc.Readers.ODT.Generic.XMLConverter
( ElementName
, XMLConverter
, runConverter
, fromMaybeF
, fromFallible
, tryC
, getExtraState
, setExtraState
, modifyExtraState
, getCurrentElement
, elName
, findChild'
, filterChildrenName'
, isSet'
, isSetWithDefault
, searchAttr
, lookupAttr
, lookupAttr'
, lookupDefaultingAttr
, findAttr'
, findAttr
, findAttrWithDefault
, readAttr
, readAttr'
, readAttrWithDefault
, getAttr
, executeIn
, executeInSub
, withEveryL
, tryAll
, ElementMatcher
, matchContent'
, matchContent
) where

import Control.Applicative ( Alternative(..), optional )
import Control.Monad ( filterM, foldM )
import Control.Monad.Except ( ExceptT, runExceptT, throwError, catchError )
import Control.Monad.State ( State, evalState, get, gets, put, modify )

import qualified Data.Map as M
import Data.Text (Text)
import Data.Default
import Data.Maybe

import qualified Text.Pandoc.XML.Light as XML

import Text.Pandoc.Readers.ODT.Generic.Namespaces
import Text.Pandoc.Readers.ODT.Generic.Utils
import Text.Pandoc.Readers.ODT.Generic.Fallible

--------------------------------------------------------------------------------
--  Basis types for readability
--------------------------------------------------------------------------------

type ElementName           = Text
type AttributeName         = Text
type AttributeValue        = Text

type NameSpacePrefix       = Text

--------------------------------------------------------------------------------
-- Converter state
--------------------------------------------------------------------------------

data XMLConverterState nsID extraState = XMLConverterState
  { -- | The element that is currently being read
    forall nsID extraState.
XMLConverterState nsID extraState -> Element
currentElement    :: XML.Element
    -- | A map from internal namespace IDs to the namespace prefixes
    -- used in XML elements
  , forall nsID extraState.
XMLConverterState nsID extraState -> Map nsID Text
namespacePrefixes :: M.Map nsID NameSpacePrefix
    -- | A map from internal namespace IDs to namespace IRIs
    -- (Only necessary for matching namespace IDs and prefixes)
  , forall nsID extraState.
XMLConverterState nsID extraState -> Map nsID Text
namespaceIRIs     :: NameSpaceIRIs nsID
    -- | Converter-specific state
  , forall nsID extraState.
XMLConverterState nsID extraState -> extraState
moreState         :: extraState
  }

createStartState :: (NameSpaceID nsID)
                 => XML.Element
                 -> extraState
                 -> XMLConverterState nsID extraState
createStartState :: forall nsID extraState.
NameSpaceID nsID =>
Element -> extraState -> XMLConverterState nsID extraState
createStartState Element
element extraState
extraState =
  XMLConverterState
       { currentElement :: Element
currentElement    = Element
element
       , namespacePrefixes :: Map nsID Text
namespacePrefixes = Map nsID Text
forall k a. Map k a
M.empty
       , namespaceIRIs :: Map nsID Text
namespaceIRIs     = Map nsID Text
forall nsID. NameSpaceID nsID => NameSpaceIRIs nsID
getInitialIRImap
       , moreState :: extraState
moreState         = extraState
extraState
       }

--------------------------------------------------------------------------------
-- Main type
--------------------------------------------------------------------------------

-- | A converter that can read from an XML tree, may fail (with
-- 'throwError' \/ 'empty'), and carries some additional state.
-- Note that state modifications survive failure; in particular, the
-- current element must be restored explicitly where necessary
-- (see 'executeIn').
type XMLConverter nsID extraState
   = ExceptT () (State (XMLConverterState nsID extraState))

-- | Run a converter on an XML element, with a given initial extra state.
runConverter :: (NameSpaceID nsID)
             => XMLConverter nsID extraState a
             -> extraState
             -> XML.Element
             -> Fallible a
runConverter :: forall nsID extraState a.
NameSpaceID nsID =>
XMLConverter nsID extraState a
-> extraState -> Element -> Fallible a
runConverter XMLConverter nsID extraState a
converter extraState
extraState Element
element
  = State (XMLConverterState nsID extraState) (Fallible a)
-> XMLConverterState nsID extraState -> Fallible a
forall s a. State s a -> s -> a
evalState (XMLConverter nsID extraState a
-> State (XMLConverterState nsID extraState) (Fallible a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (XMLConverter nsID extraState Failure
forall nsID extraState.
NameSpaceID nsID =>
XMLConverter nsID extraState Failure
readNSattributes XMLConverter nsID extraState Failure
-> XMLConverter nsID extraState a -> XMLConverter nsID extraState a
forall a b.
ExceptT
  Failure (StateT (XMLConverterState nsID extraState) Identity) a
-> ExceptT
     Failure (StateT (XMLConverterState nsID extraState) Identity) b
-> ExceptT
     Failure (StateT (XMLConverterState nsID extraState) Identity) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XMLConverter nsID extraState a
converter))
              (Element -> extraState -> XMLConverterState nsID extraState
forall nsID extraState.
NameSpaceID nsID =>
Element -> extraState -> XMLConverterState nsID extraState
createStartState Element
element extraState
extraState)

-- | Lift a 'Maybe' value into the converter, failing on 'Nothing'.
fromMaybeF :: Maybe a -> XMLConverter nsID extraState a
fromMaybeF :: forall a nsID extraState. Maybe a -> XMLConverter nsID extraState a
fromMaybeF = XMLConverter nsID extraState a
-> (a -> XMLConverter nsID extraState a)
-> Maybe a
-> XMLConverter nsID extraState a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Failure -> XMLConverter nsID extraState a
forall a.
Failure
-> ExceptT Failure (State (XMLConverterState nsID extraState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ()) a -> XMLConverter nsID extraState a
forall a.
a -> ExceptT Failure (State (XMLConverterState nsID extraState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Lift a 'Fallible' value into the converter.
fromFallible :: Fallible a -> XMLConverter nsID extraState a
fromFallible :: forall a nsID extraState.
Fallible a -> XMLConverter nsID extraState a
fromFallible = (Failure -> XMLConverter nsID extraState a)
-> (a -> XMLConverter nsID extraState a)
-> Either Failure a
-> XMLConverter nsID extraState a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Failure -> XMLConverter nsID extraState a
forall a.
Failure
-> ExceptT Failure (State (XMLConverterState nsID extraState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError a -> XMLConverter nsID extraState a
forall a.
a -> ExceptT Failure (State (XMLConverterState nsID extraState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Run a converter, catching failure.
tryC :: XMLConverter nsID extraState a
     -> XMLConverter nsID extraState (Fallible a)
tryC :: forall nsID extraState a.
XMLConverter nsID extraState a
-> XMLConverter nsID extraState (Fallible a)
tryC XMLConverter nsID extraState a
converter = ExceptT
  Failure (State (XMLConverterState nsID extraState)) (Fallible a)
-> (Failure
    -> ExceptT
         Failure (State (XMLConverterState nsID extraState)) (Fallible a))
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Fallible a)
forall a.
ExceptT Failure (State (XMLConverterState nsID extraState)) a
-> (Failure
    -> ExceptT Failure (State (XMLConverterState nsID extraState)) a)
-> ExceptT Failure (State (XMLConverterState nsID extraState)) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (a -> Fallible a
forall a b. b -> Either a b
Right (a -> Fallible a)
-> XMLConverter nsID extraState a
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Fallible a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XMLConverter nsID extraState a
converter) (Fallible a
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Fallible a)
forall a.
a -> ExceptT Failure (State (XMLConverterState nsID extraState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fallible a
 -> ExceptT
      Failure (State (XMLConverterState nsID extraState)) (Fallible a))
-> (Failure -> Fallible a)
-> Failure
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Fallible a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> Fallible a
forall a b. a -> Either a b
Left)

--
getCurrentElement :: XMLConverter nsID extraState XML.Element
getCurrentElement :: forall nsID extraState. XMLConverter nsID extraState Element
getCurrentElement = (XMLConverterState nsID extraState -> Element)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) Element
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XMLConverterState nsID extraState -> Element
forall nsID extraState.
XMLConverterState nsID extraState -> Element
currentElement

--
getExtraState :: XMLConverter nsID extraState extraState
getExtraState :: forall nsID extraState. XMLConverter nsID extraState extraState
getExtraState = (XMLConverterState nsID extraState -> extraState)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) extraState
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XMLConverterState nsID extraState -> extraState
forall nsID extraState.
XMLConverterState nsID extraState -> extraState
moreState

--
setExtraState :: extraState -> XMLConverter nsID extraState ()
setExtraState :: forall extraState nsID.
extraState -> XMLConverter nsID extraState Failure
setExtraState extraState
x = (XMLConverterState nsID extraState
 -> XMLConverterState nsID extraState)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) Failure
forall s (m :: * -> *). MonadState s m => (s -> s) -> m Failure
modify ((XMLConverterState nsID extraState
  -> XMLConverterState nsID extraState)
 -> ExceptT
      Failure (State (XMLConverterState nsID extraState)) Failure)
-> (XMLConverterState nsID extraState
    -> XMLConverterState nsID extraState)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) Failure
forall a b. (a -> b) -> a -> b
$ \XMLConverterState nsID extraState
state -> XMLConverterState nsID extraState
state { moreState = x }

--
modifyExtraState :: (extraState -> extraState)
                 -> XMLConverter nsID extraState ()
modifyExtraState :: forall extraState nsID.
(extraState -> extraState) -> XMLConverter nsID extraState Failure
modifyExtraState extraState -> extraState
f = (XMLConverterState nsID extraState
 -> XMLConverterState nsID extraState)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) Failure
forall s (m :: * -> *). MonadState s m => (s -> s) -> m Failure
modify ((XMLConverterState nsID extraState
  -> XMLConverterState nsID extraState)
 -> ExceptT
      Failure (State (XMLConverterState nsID extraState)) Failure)
-> (XMLConverterState nsID extraState
    -> XMLConverterState nsID extraState)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) Failure
forall a b. (a -> b) -> a -> b
$ \XMLConverterState nsID extraState
state -> XMLConverterState nsID extraState
state { moreState = f (moreState state) }

--------------------------------------------------------------------------------
-- Work in namespaces
--------------------------------------------------------------------------------

--
lookupNSiri :: (NameSpaceID nsID)
            => nsID
            -> XMLConverter nsID extraState (Maybe NameSpaceIRI)
lookupNSiri :: forall nsID extraState.
NameSpaceID nsID =>
nsID -> XMLConverter nsID extraState (Maybe Text)
lookupNSiri nsID
nsID = (XMLConverterState nsID extraState -> Maybe Text)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XMLConverterState nsID extraState -> Maybe Text)
 -> ExceptT
      Failure (State (XMLConverterState nsID extraState)) (Maybe Text))
-> (XMLConverterState nsID extraState -> Maybe Text)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Text)
forall a b. (a -> b) -> a -> b
$ nsID -> NameSpaceIRIs nsID -> Maybe Text
forall nsID.
NameSpaceID nsID =>
nsID -> NameSpaceIRIs nsID -> Maybe Text
getIRI nsID
nsID (NameSpaceIRIs nsID -> Maybe Text)
-> (XMLConverterState nsID extraState -> NameSpaceIRIs nsID)
-> XMLConverterState nsID extraState
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XMLConverterState nsID extraState -> NameSpaceIRIs nsID
forall nsID extraState.
XMLConverterState nsID extraState -> Map nsID Text
namespaceIRIs

--
lookupNSprefix :: (NameSpaceID nsID)
               => nsID
               -> XMLConverter nsID extraState (Maybe NameSpacePrefix)
lookupNSprefix :: forall nsID extraState.
NameSpaceID nsID =>
nsID -> XMLConverter nsID extraState (Maybe Text)
lookupNSprefix nsID
nsID = (XMLConverterState nsID extraState -> Maybe Text)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XMLConverterState nsID extraState -> Maybe Text)
 -> ExceptT
      Failure (State (XMLConverterState nsID extraState)) (Maybe Text))
-> (XMLConverterState nsID extraState -> Maybe Text)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Text)
forall a b. (a -> b) -> a -> b
$ nsID -> Map nsID Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup nsID
nsID (Map nsID Text -> Maybe Text)
-> (XMLConverterState nsID extraState -> Map nsID Text)
-> XMLConverterState nsID extraState
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XMLConverterState nsID extraState -> Map nsID Text
forall nsID extraState.
XMLConverterState nsID extraState -> Map nsID Text
namespacePrefixes

-- | Extracts namespace attributes from the current element and tries to
-- update the current mapping accordingly
readNSattributes :: (NameSpaceID nsID) => XMLConverter nsID extraState ()
readNSattributes :: forall nsID extraState.
NameSpaceID nsID =>
XMLConverter nsID extraState Failure
readNSattributes = do
  state <- ExceptT
  Failure
  (State (XMLConverterState nsID extraState))
  (XMLConverterState nsID extraState)
forall s (m :: * -> *). MonadState s m => m s
get
  maybe (throwError ()) put (extractNSAttrs state)
  where
    extractNSAttrs :: (NameSpaceID nsID)
                   => XMLConverterState nsID extraState
                   -> Maybe (XMLConverterState nsID extraState)
    extractNSAttrs :: forall nsID extraState.
NameSpaceID nsID =>
XMLConverterState nsID extraState
-> Maybe (XMLConverterState nsID extraState)
extractNSAttrs XMLConverterState nsID extraState
startState = (XMLConverterState nsID extraState
 -> (Text, Text) -> Maybe (XMLConverterState nsID extraState))
-> XMLConverterState nsID extraState
-> [(Text, Text)]
-> Maybe (XMLConverterState nsID extraState)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM XMLConverterState nsID extraState
-> (Text, Text) -> Maybe (XMLConverterState nsID extraState)
forall {nsID} {extraState}.
NameSpaceID nsID =>
XMLConverterState nsID extraState
-> (Text, Text) -> Maybe (XMLConverterState nsID extraState)
addNS XMLConverterState nsID extraState
startState [(Text, Text)]
nsAttribs
      where nsAttribs :: [(Text, Text)]
nsAttribs    = (Attr -> Maybe (Text, Text)) -> [Attr] -> [(Text, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Attr -> Maybe (Text, Text)
readNSattr
                                    (Element -> [Attr]
XML.elAttribs (Element -> [Attr]) -> Element -> [Attr]
forall a b. (a -> b) -> a -> b
$ XMLConverterState nsID extraState -> Element
forall nsID extraState.
XMLConverterState nsID extraState -> Element
currentElement XMLConverterState nsID extraState
startState)
            readNSattr :: Attr -> Maybe (Text, Text)
readNSattr (XML.Attr (XML.QName Text
name Maybe Text
_ (Just Text
"xmlns")) Text
iri)
                         = (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
name, Text
iri)
            readNSattr Attr
_ = Maybe (Text, Text)
forall a. Maybe a
Nothing
    addNS :: XMLConverterState nsID extraState
-> (Text, Text) -> Maybe (XMLConverterState nsID extraState)
addNS XMLConverterState nsID extraState
state (Text
prefix, Text
iri) = (NameSpaceIRIs nsID, nsID) -> XMLConverterState nsID extraState
updateState
                                ((NameSpaceIRIs nsID, nsID) -> XMLConverterState nsID extraState)
-> Maybe (NameSpaceIRIs nsID, nsID)
-> Maybe (XMLConverterState nsID extraState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> NameSpaceIRIs nsID -> Maybe (NameSpaceIRIs nsID, nsID)
forall nsID.
NameSpaceID nsID =>
Text -> NameSpaceIRIs nsID -> Maybe (NameSpaceIRIs nsID, nsID)
getNamespaceID Text
iri (XMLConverterState nsID extraState -> NameSpaceIRIs nsID
forall nsID extraState.
XMLConverterState nsID extraState -> Map nsID Text
namespaceIRIs XMLConverterState nsID extraState
state)
      where updateState :: (NameSpaceIRIs nsID, nsID) -> XMLConverterState nsID extraState
updateState (NameSpaceIRIs nsID
iris, nsID
nsID)
              = XMLConverterState nsID extraState
state { namespaceIRIs     = iris
                      , namespacePrefixes = M.insert nsID prefix
                                            $ namespacePrefixes state
                      }

--------------------------------------------------------------------------------
-- Common namespace accessors
--------------------------------------------------------------------------------

-- | Given a namespace id and an element name, creates a 'XML.QName' for
-- internal use
qualifyName :: (NameSpaceID nsID)
            => nsID -> ElementName
            -> XMLConverter nsID extraState XML.QName
qualifyName :: forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState QName
qualifyName nsID
nsID Text
name = Text -> Maybe Text -> Maybe Text -> QName
XML.QName Text
name (Maybe Text -> Maybe Text -> QName)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Text)
-> ExceptT
     Failure
     (State (XMLConverterState nsID extraState))
     (Maybe Text -> QName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> nsID
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Text)
forall nsID extraState.
NameSpaceID nsID =>
nsID -> XMLConverter nsID extraState (Maybe Text)
lookupNSiri nsID
nsID
                                       ExceptT
  Failure
  (State (XMLConverterState nsID extraState))
  (Maybe Text -> QName)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Text)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) QName
forall a b.
ExceptT
  Failure (State (XMLConverterState nsID extraState)) (a -> b)
-> ExceptT Failure (State (XMLConverterState nsID extraState)) a
-> ExceptT Failure (State (XMLConverterState nsID extraState)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> nsID
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Text)
forall nsID extraState.
NameSpaceID nsID =>
nsID -> XMLConverter nsID extraState (Maybe Text)
lookupNSprefix nsID
nsID

-- | Checks if a given element matches both a specified namespace id
-- and a predicate
elemNameMatches :: (NameSpaceID nsID)
                => nsID -> (ElementName -> Bool)
                -> XML.Element
                -> XMLConverter nsID extraState Bool
elemNameMatches :: forall nsID extraState.
NameSpaceID nsID =>
nsID
-> (Text -> Bool) -> Element -> XMLConverter nsID extraState Bool
elemNameMatches nsID
nsID Text -> Bool
f Element
element = do
  iri <- nsID -> XMLConverter nsID extraState (Maybe Text)
forall nsID extraState.
NameSpaceID nsID =>
nsID -> XMLConverter nsID extraState (Maybe Text)
lookupNSiri nsID
nsID
  let name = Element -> QName
XML.elName Element
element
  return $ f (XML.qName name) && XML.qURI name == iri

-- | Checks if a given element matches both a specified namespace id
-- and a specified element name
elemNameIs :: (NameSpaceID nsID)
           => nsID -> ElementName
           -> XML.Element
           -> XMLConverter nsID extraState Bool
elemNameIs :: forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> Element -> XMLConverter nsID extraState Bool
elemNameIs nsID
nsID Text
name = nsID
-> (Text -> Bool) -> Element -> XMLConverter nsID extraState Bool
forall nsID extraState.
NameSpaceID nsID =>
nsID
-> (Text -> Bool) -> Element -> XMLConverter nsID extraState Bool
elemNameMatches nsID
nsID (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name)

--------------------------------------------------------------------------------
-- General content
--------------------------------------------------------------------------------

elName :: XML.Element -> ElementName
elName :: Element -> Text
elName = QName -> Text
XML.qName (QName -> Text) -> (Element -> QName) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> QName
XML.elName

--------------------------------------------------------------------------------
-- Children
--------------------------------------------------------------------------------

--
findChildren :: (NameSpaceID nsID)
             => nsID -> ElementName
             -> XMLConverter nsID extraState [XML.Element]
findChildren :: forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState [Element]
findChildren nsID
nsID Text
name = QName -> Element -> [Element]
XML.findChildren (QName -> Element -> [Element])
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) QName
-> ExceptT
     Failure
     (State (XMLConverterState nsID extraState))
     (Element -> [Element])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> nsID
-> Text
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) QName
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState QName
qualifyName nsID
nsID Text
name
                                          ExceptT
  Failure
  (State (XMLConverterState nsID extraState))
  (Element -> [Element])
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) Element
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) [Element]
forall a b.
ExceptT
  Failure (State (XMLConverterState nsID extraState)) (a -> b)
-> ExceptT Failure (State (XMLConverterState nsID extraState)) a
-> ExceptT Failure (State (XMLConverterState nsID extraState)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExceptT Failure (State (XMLConverterState nsID extraState)) Element
forall nsID extraState. XMLConverter nsID extraState Element
getCurrentElement

--
findChild' :: (NameSpaceID nsID)
           => nsID -> ElementName
           -> XMLConverter nsID extraState (Maybe XML.Element)
findChild' :: forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState (Maybe Element)
findChild' nsID
nsID Text
name = QName -> Element -> Maybe Element
XML.findChild (QName -> Element -> Maybe Element)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) QName
-> ExceptT
     Failure
     (State (XMLConverterState nsID extraState))
     (Element -> Maybe Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> nsID
-> Text
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) QName
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState QName
qualifyName nsID
nsID Text
name
                                     ExceptT
  Failure
  (State (XMLConverterState nsID extraState))
  (Element -> Maybe Element)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) Element
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Element)
forall a b.
ExceptT
  Failure (State (XMLConverterState nsID extraState)) (a -> b)
-> ExceptT Failure (State (XMLConverterState nsID extraState)) a
-> ExceptT Failure (State (XMLConverterState nsID extraState)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExceptT Failure (State (XMLConverterState nsID extraState)) Element
forall nsID extraState. XMLConverter nsID extraState Element
getCurrentElement

--
findChild :: (NameSpaceID nsID)
          => nsID -> ElementName
          -> XMLConverter nsID extraState XML.Element
findChild :: forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState Element
findChild nsID
nsID Text
name = nsID -> Text -> XMLConverter nsID extraState (Maybe Element)
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState (Maybe Element)
findChild' nsID
nsID Text
name XMLConverter nsID extraState (Maybe Element)
-> (Maybe Element
    -> ExceptT
         Failure (State (XMLConverterState nsID extraState)) Element)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) Element
forall a b.
ExceptT Failure (State (XMLConverterState nsID extraState)) a
-> (a
    -> ExceptT Failure (State (XMLConverterState nsID extraState)) b)
-> ExceptT Failure (State (XMLConverterState nsID extraState)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Element
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) Element
forall a nsID extraState. Maybe a -> XMLConverter nsID extraState a
fromMaybeF

--
filterChildrenName' :: (NameSpaceID nsID)
                    => nsID
                    -> (ElementName -> Bool)
                    -> XMLConverter nsID extraState [XML.Element]
filterChildrenName' :: forall nsID extraState.
NameSpaceID nsID =>
nsID -> (Text -> Bool) -> XMLConverter nsID extraState [Element]
filterChildrenName' nsID
nsID Text -> Bool
f = XMLConverter nsID extraState Element
forall nsID extraState. XMLConverter nsID extraState Element
getCurrentElement
                             XMLConverter nsID extraState Element
-> (Element
    -> ExceptT
         Failure (State (XMLConverterState nsID extraState)) [Element])
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) [Element]
forall a b.
ExceptT Failure (State (XMLConverterState nsID extraState)) a
-> (a
    -> ExceptT Failure (State (XMLConverterState nsID extraState)) b)
-> ExceptT Failure (State (XMLConverterState nsID extraState)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Element
 -> ExceptT
      Failure (State (XMLConverterState nsID extraState)) Bool)
-> [Element]
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) [Element]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (nsID
-> (Text -> Bool)
-> Element
-> ExceptT Failure (State (XMLConverterState nsID extraState)) Bool
forall nsID extraState.
NameSpaceID nsID =>
nsID
-> (Text -> Bool) -> Element -> XMLConverter nsID extraState Bool
elemNameMatches nsID
nsID Text -> Bool
f) ([Element]
 -> ExceptT
      Failure (State (XMLConverterState nsID extraState)) [Element])
-> (Element -> [Element])
-> Element
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Element]
XML.elChildren

--------------------------------------------------------------------------------
-- Attributes
--------------------------------------------------------------------------------

--
isSet' :: (NameSpaceID nsID)
       => nsID -> AttributeName
       -> XMLConverter nsID extraState (Maybe Bool)
isSet' :: forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState (Maybe Bool)
isSet' nsID
nsID Text
attrName = (Maybe Text -> (Text -> Maybe Bool) -> Maybe Bool
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Bool
stringToBool') (Maybe Text -> Maybe Bool)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Text)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> nsID
-> Text
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Text)
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState (Maybe Text)
findAttr' nsID
nsID Text
attrName

isSetWithDefault :: (NameSpaceID nsID)
                 => nsID -> AttributeName
                 -> Bool
                 -> XMLConverter nsID extraState Bool
isSetWithDefault :: forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> Bool -> XMLConverter nsID extraState Bool
isSetWithDefault nsID
nsID Text
attrName Bool
def' =
  Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
def' (Maybe Bool -> Bool)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Bool)
-> ExceptT Failure (State (XMLConverterState nsID extraState)) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> nsID
-> Text
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Bool)
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState (Maybe Bool)
isSet' nsID
nsID Text
attrName

-- | Lookup value in a dictionary, fail if no attribute found or value
-- not in dictionary
searchAttrIn :: (NameSpaceID nsID)
             => nsID -> AttributeName
             -> [(AttributeValue,a)]
             -> XMLConverter nsID extraState a
searchAttrIn :: forall nsID a extraState.
NameSpaceID nsID =>
nsID -> Text -> [(Text, a)] -> XMLConverter nsID extraState a
searchAttrIn nsID
nsID Text
attrName [(Text, a)]
dict = do
  value <- nsID -> Text -> XMLConverter nsID extraState Text
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState Text
findAttr nsID
nsID Text
attrName
  fromMaybeF $ lookup value dict

-- | Lookup value in a dictionary. If attribute or value not found,
-- return default value
searchAttr :: (NameSpaceID nsID)
           => nsID -> AttributeName
           -> a
           -> [(AttributeValue,a)]
           -> XMLConverter nsID extraState a
searchAttr :: forall nsID a extraState.
NameSpaceID nsID =>
nsID -> Text -> a -> [(Text, a)] -> XMLConverter nsID extraState a
searchAttr nsID
nsID Text
attrName a
defV [(Text, a)]
dict =
  nsID -> Text -> [(Text, a)] -> XMLConverter nsID extraState a
forall nsID a extraState.
NameSpaceID nsID =>
nsID -> Text -> [(Text, a)] -> XMLConverter nsID extraState a
searchAttrIn nsID
nsID Text
attrName [(Text, a)]
dict XMLConverter nsID extraState a
-> XMLConverter nsID extraState a -> XMLConverter nsID extraState a
forall a.
ExceptT Failure (State (XMLConverterState nsID extraState)) a
-> ExceptT Failure (State (XMLConverterState nsID extraState)) a
-> ExceptT Failure (State (XMLConverterState nsID extraState)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> XMLConverter nsID extraState a
forall a.
a -> ExceptT Failure (State (XMLConverterState nsID extraState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
defV

-- | Read a 'Lookupable' attribute. Fail if no match.
lookupAttr :: (NameSpaceID nsID, Lookupable a)
           => nsID -> AttributeName
           -> XMLConverter nsID extraState a
lookupAttr :: forall nsID a extraState.
(NameSpaceID nsID, Lookupable a) =>
nsID -> Text -> XMLConverter nsID extraState a
lookupAttr nsID
nsID Text
attrName = nsID -> Text -> XMLConverter nsID extraState (Maybe a)
forall nsID a extraState.
(NameSpaceID nsID, Lookupable a) =>
nsID -> Text -> XMLConverter nsID extraState (Maybe a)
lookupAttr' nsID
nsID Text
attrName XMLConverter nsID extraState (Maybe a)
-> (Maybe a
    -> ExceptT Failure (State (XMLConverterState nsID extraState)) a)
-> ExceptT Failure (State (XMLConverterState nsID extraState)) a
forall a b.
ExceptT Failure (State (XMLConverterState nsID extraState)) a
-> (a
    -> ExceptT Failure (State (XMLConverterState nsID extraState)) b)
-> ExceptT Failure (State (XMLConverterState nsID extraState)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe a
-> ExceptT Failure (State (XMLConverterState nsID extraState)) a
forall a nsID extraState. Maybe a -> XMLConverter nsID extraState a
fromMaybeF

-- | Read a 'Lookupable' attribute. Return the result as a 'Maybe'.
lookupAttr' :: (NameSpaceID nsID, Lookupable a)
            => nsID -> AttributeName
            -> XMLConverter nsID extraState (Maybe a)
lookupAttr' :: forall nsID a extraState.
(NameSpaceID nsID, Lookupable a) =>
nsID -> Text -> XMLConverter nsID extraState (Maybe a)
lookupAttr' nsID
nsID Text
attrName =
  (Maybe Text -> (Text -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe a
forall a. Lookupable a => Text -> Maybe a
readLookupable) (Maybe Text -> Maybe a)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Text)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> nsID
-> Text
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Text)
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState (Maybe Text)
findAttr' nsID
nsID Text
attrName

-- | Read a 'Lookupable' attribute with explicit default
lookupAttrWithDefault :: (NameSpaceID nsID, Lookupable a)
                      => nsID -> AttributeName
                      -> a
                      -> XMLConverter nsID extraState a
lookupAttrWithDefault :: forall nsID a extraState.
(NameSpaceID nsID, Lookupable a) =>
nsID -> Text -> a -> XMLConverter nsID extraState a
lookupAttrWithDefault nsID
nsID Text
attrName a
deflt =
  a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
deflt (Maybe a -> a)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe a)
-> ExceptT Failure (State (XMLConverterState nsID extraState)) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> nsID
-> Text
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe a)
forall nsID a extraState.
(NameSpaceID nsID, Lookupable a) =>
nsID -> Text -> XMLConverter nsID extraState (Maybe a)
lookupAttr' nsID
nsID Text
attrName

-- | Read a 'Lookupable' attribute with implicit default
lookupDefaultingAttr :: (NameSpaceID nsID, Lookupable a, Default a)
                     => nsID -> AttributeName
                     -> XMLConverter nsID extraState a
lookupDefaultingAttr :: forall nsID a extraState.
(NameSpaceID nsID, Lookupable a, Default a) =>
nsID -> Text -> XMLConverter nsID extraState a
lookupDefaultingAttr nsID
nsID Text
attrName =
  nsID -> Text -> a -> XMLConverter nsID extraState a
forall nsID a extraState.
(NameSpaceID nsID, Lookupable a) =>
nsID -> Text -> a -> XMLConverter nsID extraState a
lookupAttrWithDefault nsID
nsID Text
attrName a
forall a. Default a => a
def

-- | Return value as a (Maybe Text)
findAttr' :: (NameSpaceID nsID)
          => nsID -> AttributeName
          -> XMLConverter nsID extraState (Maybe AttributeValue)
findAttr' :: forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState (Maybe Text)
findAttr' nsID
nsID Text
attrName = QName -> Element -> Maybe Text
XML.findAttr (QName -> Element -> Maybe Text)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) QName
-> ExceptT
     Failure
     (State (XMLConverterState nsID extraState))
     (Element -> Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> nsID
-> Text
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) QName
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState QName
qualifyName nsID
nsID Text
attrName
                                       ExceptT
  Failure
  (State (XMLConverterState nsID extraState))
  (Element -> Maybe Text)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) Element
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Text)
forall a b.
ExceptT
  Failure (State (XMLConverterState nsID extraState)) (a -> b)
-> ExceptT Failure (State (XMLConverterState nsID extraState)) a
-> ExceptT Failure (State (XMLConverterState nsID extraState)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExceptT Failure (State (XMLConverterState nsID extraState)) Element
forall nsID extraState. XMLConverter nsID extraState Element
getCurrentElement

-- | Return value or fail
findAttr :: (NameSpaceID nsID)
         => nsID -> AttributeName
         -> XMLConverter nsID extraState AttributeValue
findAttr :: forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState Text
findAttr nsID
nsID Text
attrName = nsID -> Text -> XMLConverter nsID extraState (Maybe Text)
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState (Maybe Text)
findAttr' nsID
nsID Text
attrName XMLConverter nsID extraState (Maybe Text)
-> (Maybe Text
    -> ExceptT
         Failure (State (XMLConverterState nsID extraState)) Text)
-> ExceptT Failure (State (XMLConverterState nsID extraState)) Text
forall a b.
ExceptT Failure (State (XMLConverterState nsID extraState)) a
-> (a
    -> ExceptT Failure (State (XMLConverterState nsID extraState)) b)
-> ExceptT Failure (State (XMLConverterState nsID extraState)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Text
-> ExceptT Failure (State (XMLConverterState nsID extraState)) Text
forall a nsID extraState. Maybe a -> XMLConverter nsID extraState a
fromMaybeF

-- | Return value or return provided default value
findAttrWithDefault :: (NameSpaceID nsID)
                    => nsID -> AttributeName
                    -> AttributeValue
                    -> XMLConverter nsID extraState AttributeValue
findAttrWithDefault :: forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> Text -> XMLConverter nsID extraState Text
findAttrWithDefault nsID
nsID Text
attrName Text
deflt =
  Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
deflt (Maybe Text -> Text)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Text)
-> ExceptT Failure (State (XMLConverterState nsID extraState)) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> nsID
-> Text
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Text)
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState (Maybe Text)
findAttr' nsID
nsID Text
attrName

-- | Read and return value or fail
readAttr :: (NameSpaceID nsID, Read attrValue)
         => nsID -> AttributeName
         -> XMLConverter nsID extraState attrValue
readAttr :: forall nsID attrValue extraState.
(NameSpaceID nsID, Read attrValue) =>
nsID -> Text -> XMLConverter nsID extraState attrValue
readAttr nsID
nsID Text
attrName = nsID -> Text -> XMLConverter nsID extraState (Maybe attrValue)
forall nsID attrValue extraState.
(NameSpaceID nsID, Read attrValue) =>
nsID -> Text -> XMLConverter nsID extraState (Maybe attrValue)
readAttr' nsID
nsID Text
attrName XMLConverter nsID extraState (Maybe attrValue)
-> (Maybe attrValue
    -> ExceptT
         Failure (State (XMLConverterState nsID extraState)) attrValue)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) attrValue
forall a b.
ExceptT Failure (State (XMLConverterState nsID extraState)) a
-> (a
    -> ExceptT Failure (State (XMLConverterState nsID extraState)) b)
-> ExceptT Failure (State (XMLConverterState nsID extraState)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe attrValue
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) attrValue
forall a nsID extraState. Maybe a -> XMLConverter nsID extraState a
fromMaybeF

-- | Read and return value or return Nothing
readAttr' :: (NameSpaceID nsID, Read attrValue)
          => nsID -> AttributeName
          -> XMLConverter nsID extraState (Maybe attrValue)
readAttr' :: forall nsID attrValue extraState.
(NameSpaceID nsID, Read attrValue) =>
nsID -> Text -> XMLConverter nsID extraState (Maybe attrValue)
readAttr' nsID
nsID Text
attrName = (Maybe Text -> (Text -> Maybe attrValue) -> Maybe attrValue
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe attrValue
forall r. Read r => Text -> Maybe r
tryToRead) (Maybe Text -> Maybe attrValue)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Text)
-> ExceptT
     Failure
     (State (XMLConverterState nsID extraState))
     (Maybe attrValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> nsID
-> Text
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe Text)
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState (Maybe Text)
findAttr' nsID
nsID Text
attrName

-- | Read and return value or return provided default value
readAttrWithDefault :: (NameSpaceID nsID, Read attrValue)
                    => nsID -> AttributeName
                    -> attrValue
                    -> XMLConverter nsID extraState attrValue
readAttrWithDefault :: forall nsID attrValue extraState.
(NameSpaceID nsID, Read attrValue) =>
nsID -> Text -> attrValue -> XMLConverter nsID extraState attrValue
readAttrWithDefault nsID
nsID Text
attrName attrValue
deflt =
  attrValue -> Maybe attrValue -> attrValue
forall a. a -> Maybe a -> a
fromMaybe attrValue
deflt (Maybe attrValue -> attrValue)
-> ExceptT
     Failure
     (State (XMLConverterState nsID extraState))
     (Maybe attrValue)
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) attrValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> nsID
-> Text
-> ExceptT
     Failure
     (State (XMLConverterState nsID extraState))
     (Maybe attrValue)
forall nsID attrValue extraState.
(NameSpaceID nsID, Read attrValue) =>
nsID -> Text -> XMLConverter nsID extraState (Maybe attrValue)
readAttr' nsID
nsID Text
attrName

-- | Read and return value or return default value from 'Default' instance
getAttr :: (NameSpaceID nsID, Read attrValue, Default attrValue)
        => nsID -> AttributeName
        -> XMLConverter nsID extraState attrValue
getAttr :: forall nsID attrValue extraState.
(NameSpaceID nsID, Read attrValue, Default attrValue) =>
nsID -> Text -> XMLConverter nsID extraState attrValue
getAttr nsID
nsID Text
attrName = nsID -> Text -> attrValue -> XMLConverter nsID extraState attrValue
forall nsID attrValue extraState.
(NameSpaceID nsID, Read attrValue) =>
nsID -> Text -> attrValue -> XMLConverter nsID extraState attrValue
readAttrWithDefault nsID
nsID Text
attrName attrValue
forall a. Default a => a
def

--------------------------------------------------------------------------------
-- Movements
--------------------------------------------------------------------------------

-- | Execute a converter in a specific element, then come back.
-- The current element is restored even if the converter fails.
executeIn :: XML.Element
          -> XMLConverter nsID extraState a
          -> XMLConverter nsID extraState a
executeIn :: forall nsID extraState a.
Element
-> XMLConverter nsID extraState a -> XMLConverter nsID extraState a
executeIn Element
element XMLConverter nsID extraState a
converter = do
  oldElement <- XMLConverter nsID extraState Element
forall nsID extraState. XMLConverter nsID extraState Element
getCurrentElement
  modify $ \XMLConverterState nsID extraState
state -> XMLConverterState nsID extraState
state { currentElement = element }
  result <- tryC converter
  modify $ \XMLConverterState nsID extraState
state -> XMLConverterState nsID extraState
state { currentElement = oldElement }
  fromFallible result

-- | Execute a converter in a sub-element of the current element,
-- then come back. Fails if there is no such sub-element.
executeInSub :: (NameSpaceID nsID)
             => nsID -> ElementName
             -> XMLConverter nsID extraState a
             -> XMLConverter nsID extraState a
executeInSub :: forall nsID extraState a.
NameSpaceID nsID =>
nsID
-> Text
-> XMLConverter nsID extraState a
-> XMLConverter nsID extraState a
executeInSub nsID
nsID Text
name XMLConverter nsID extraState a
converter = do
  child <- nsID -> Text -> XMLConverter nsID extraState Element
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState Element
findChild nsID
nsID Text
name
  executeIn child converter

--------------------------------------------------------------------------------
-- Iterating over children
--------------------------------------------------------------------------------

-- | Applies a converter to every child element of a specific type.
-- Fails completely if any conversion fails.
withEveryL :: (NameSpaceID nsID)
           => nsID -> ElementName
           -> XMLConverter nsID extraState a
           -> XMLConverter nsID extraState [a]
withEveryL :: forall nsID extraState a.
NameSpaceID nsID =>
nsID
-> Text
-> XMLConverter nsID extraState a
-> XMLConverter nsID extraState [a]
withEveryL nsID
nsID Text
name XMLConverter nsID extraState a
converter = do
  children <- nsID -> Text -> XMLConverter nsID extraState [Element]
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState [Element]
findChildren nsID
nsID Text
name
  mapM (`executeIn` converter) children

-- | Applies a converter to every child element of a specific type.
-- Collects all successful results in a list.
tryAll :: (NameSpaceID nsID)
       => nsID -> ElementName
       -> XMLConverter nsID extraState a
       -> XMLConverter nsID extraState [a]
tryAll :: forall nsID extraState a.
NameSpaceID nsID =>
nsID
-> Text
-> XMLConverter nsID extraState a
-> XMLConverter nsID extraState [a]
tryAll nsID
nsID Text
name XMLConverter nsID extraState a
converter = do
  children <- nsID -> Text -> XMLConverter nsID extraState [Element]
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState [Element]
findChildren nsID
nsID Text
name
  catMaybes <$> mapM (\Element
child -> XMLConverter nsID extraState a
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Element
-> XMLConverter nsID extraState a -> XMLConverter nsID extraState a
forall nsID extraState a.
Element
-> XMLConverter nsID extraState a -> XMLConverter nsID extraState a
executeIn Element
child XMLConverter nsID extraState a
converter)) children

--------------------------------------------------------------------------------
-- Matching children
--------------------------------------------------------------------------------

-- | A converter for a child element with a specific name in a specific
-- namespace. The converter produces that element's contribution to the
-- overall result.
type ElementMatcher nsID extraState a
   = (nsID, ElementName, XMLConverter nsID extraState a)

-- | Like 'matchContent', but ignores non-matching content.
matchContent' :: (NameSpaceID nsID, Monoid a)
              => [ElementMatcher nsID extraState a]
              -> XMLConverter nsID extraState a
matchContent' :: forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> XMLConverter nsID extraState a
matchContent' [ElementMatcher nsID extraState a]
lookups = [ElementMatcher nsID extraState a]
-> (Content -> XMLConverter nsID extraState a)
-> XMLConverter nsID extraState a
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> (Content -> XMLConverter nsID extraState a)
-> XMLConverter nsID extraState a
matchContent [ElementMatcher nsID extraState a]
lookups (\Content
_ -> a -> XMLConverter nsID extraState a
forall a.
a -> ExceptT Failure (State (XMLConverterState nsID extraState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty)

-- | Takes a list of element matchers and a fallback converter, and
-- converts the content of the current element in order: for each child
-- element, the first matcher with a matching name (if any) is applied
-- in that element; all other content is passed to the fallback
-- converter. The results are combined with 'mappend'.
-- If a matched converter fails, the corresponding element contributes
-- nothing to the result.
matchContent :: (NameSpaceID nsID, Monoid a)
             => [ElementMatcher nsID extraState a]
             -> (XML.Content -> XMLConverter nsID extraState a)
             -> XMLConverter nsID extraState a
matchContent :: forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> (Content -> XMLConverter nsID extraState a)
-> XMLConverter nsID extraState a
matchContent [ElementMatcher nsID extraState a]
lookups Content -> XMLConverter nsID extraState a
fallback = do
  contents <- Element -> [Content]
XML.elContent (Element -> [Content])
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) Element
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT Failure (State (XMLConverterState nsID extraState)) Element
forall nsID extraState. XMLConverter nsID extraState Element
getCurrentElement
  mconcat <$> mapM matchOne contents
  where
    matchOne :: Content -> XMLConverter nsID extraState a
matchOne content :: Content
content@(XML.Elem Element
element) = do
      mConverter <- Element
-> [ElementMatcher nsID extraState a]
-> ExceptT
     Failure
     (State (XMLConverterState nsID extraState))
     (Maybe (XMLConverter nsID extraState a))
forall {nsID} {a} {extraState}.
NameSpaceID nsID =>
Element
-> [(nsID, Text, a)]
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe a)
findConverter Element
element [ElementMatcher nsID extraState a]
lookups
      case mConverter of
        Just XMLConverter nsID extraState a
converter -> Element
-> XMLConverter nsID extraState a -> XMLConverter nsID extraState a
forall nsID extraState a.
Element
-> XMLConverter nsID extraState a -> XMLConverter nsID extraState a
executeIn Element
element XMLConverter nsID extraState a
converter XMLConverter nsID extraState a
-> XMLConverter nsID extraState a -> XMLConverter nsID extraState a
forall a.
ExceptT Failure (State (XMLConverterState nsID extraState)) a
-> ExceptT Failure (State (XMLConverterState nsID extraState)) a
-> ExceptT Failure (State (XMLConverterState nsID extraState)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> XMLConverter nsID extraState a
forall a.
a -> ExceptT Failure (State (XMLConverterState nsID extraState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
        Maybe (XMLConverter nsID extraState a)
Nothing        -> Content -> XMLConverter nsID extraState a
fallback Content
content
    matchOne Content
content = Content -> XMLConverter nsID extraState a
fallback Content
content

    findConverter :: Element
-> [(nsID, Text, a)]
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe a)
findConverter Element
_ [] = Maybe a
-> ExceptT
     Failure (State (XMLConverterState nsID extraState)) (Maybe a)
forall a.
a -> ExceptT Failure (State (XMLConverterState nsID extraState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    findConverter Element
element ((nsID
nsID, Text
name, a
converter):[(nsID, Text, a)]
rest) = do
      matches <- nsID -> Text -> Element -> XMLConverter nsID extraState Bool
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> Element -> XMLConverter nsID extraState Bool
elemNameIs nsID
nsID Text
name Element
element
      if matches
        then return $ Just converter
        else findConverter element rest

--------------------------------------------------------------------------------
-- Internals
--------------------------------------------------------------------------------

stringToBool' :: Text -> Maybe Bool
stringToBool' :: Text -> Maybe Bool
stringToBool' Text
val | Text
val Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
trueValues  = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
                  | Text
val Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
falseValues = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                  | Bool
otherwise              = Maybe Bool
forall a. Maybe a
Nothing
  where trueValues :: [Text]
trueValues  = [Text
"true" ,Text
"on" ,Text
"1"]
        falseValues :: [Text]
falseValues = [Text
"false",Text
"off",Text
"0"]