module Cloud.AWS.Lib.Parser.Unordered.Convert
( (.<)
, content
, element
, elementM
, elements
, lookupTag
) where
import Control.Monad
import Control.Monad.Trans.Resource (MonadThrow, monadThrow)
import qualified Data.HashMap.Strict as HM
import Data.Maybe
import Data.Monoid
import Data.Text (Text)
import Cloud.AWS.Lib.FromText (FromText (..))
import Cloud.AWS.Lib.Parser.Unordered.Types
getContentText :: XmlElement -> Maybe Text
getContentText (HM _) = Nothing
getContentText (T c) = return c
getSubElements :: XmlElement -> Text -> [XmlElement]
getSubElements (HM hm) name = cat $ HM.lookup name hm
where
cat (Just xs) = xs
cat Nothing = []
getSubElements (T _) _ = []
getSubElement :: XmlElement -> Text -> Maybe XmlElement
getSubElement el = listToMaybe . getSubElements el
(.<) :: (MonadThrow m, FromText a) => XmlElement -> Text -> m a
(.<) xml name = fromNamedText name $
getSubElement xml name >>= getContentText
content :: (MonadThrow m, FromText t) => XmlElement -> m t
content (T t) = fromText t
content _ = monadThrow $ ParseError "This is not a content."
elementM :: MonadThrow m
=> Text
-> (XmlElement -> m a)
-> XmlElement
-> m (Maybe a)
elementM name conv el = maybe
(return Nothing)
(liftM Just . conv)
(getSubElement el name)
element :: MonadThrow m
=> Text
-> (XmlElement -> m a)
-> XmlElement
-> m a
element name conv el = elementM name conv el >>= maybe
(monadThrow $ ParseError $ "element: element '" <> name <> "' not found")
return
elements :: MonadThrow m
=> Text
-> Text
-> (XmlElement -> m a)
-> XmlElement
-> m [a]
elements setname itemname conv el = maybe
(return [])
(mapM conv . flip getSubElements itemname)
(getSubElement el setname)
lookupTag :: MonadThrow m
=> Text
-> XmlElement
-> m XmlElement
lookupTag name el = case getSubElements el name of
[e] -> return e
[] -> monadThrow $ ParseError $ "lookupTag: tag '" <> name <> "' not found"
_ -> monadThrow $ ParseError $ "lookupTag: tag '" <> name <> "' is list. please use lookupTags."