{-# LANGUAGE CPP #-}
-- | Collection of helpers to use with Text.XML.Stream.Parse parsers.
--
-- > let sink = flaxTag "MethodNameResponse"
-- >          $ flaxTag "MethodNameResult" $ do
-- >              info <- flaxTag "Info" $ do
-- >                          q <- readTag "quantity"
-- >                          b <- readTag "balance"
-- >                          return $ Info q b
-- >              rc <- readTag "ResponseCode"
-- >              return (rc, info)

module Network.SOAP.Parsing.Stream
    ( -- * Tags
      laxTag, flaxTag
      -- * Content
    , laxContent, flaxContent
    , readContent, readTag
      -- * Types to use in custom parser sinks
    , Event
    , ConduitM, Void
    , Sink
    ) where

#if MIN_VERSION_conduit(1,1,0)
import Control.Monad.Catch (MonadThrow)
#endif
import Data.Conduit (ConduitM, Sink)
import Data.Void (Void)
import Data.XML.Types (Event)

import           Text.XML (Name(..))
import qualified Text.XML.Stream.Parse as XSP

import           Data.Text (Text, unpack)

-- | Namespace- and attribute- ignorant tagNoAttr.
laxTag :: (MonadThrow m) => Text -> ConduitM Event Void m a -> ConduitM Event Void m (Maybe a)
#if MIN_VERSION_xml_conduit(1,5,0)
laxTag :: Text -> ConduitM Event Void m a -> ConduitM Event Void m (Maybe a)
laxTag ln :: Text
ln = NameMatcher Name
-> AttrParser ()
-> (() -> ConduitM Event Void m a)
-> ConduitM Event Void m (Maybe a)
forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
XSP.tag' ((Name -> Bool) -> NameMatcher Name
XSP.matching ((Name -> Bool) -> NameMatcher Name)
-> (Name -> Bool) -> NameMatcher Name
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ln) (Text -> Bool) -> (Name -> Text) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
nameLocalName) AttrParser ()
XSP.ignoreAttrs ((() -> ConduitM Event Void m a)
 -> ConduitM Event Void m (Maybe a))
-> (ConduitM Event Void m a -> () -> ConduitM Event Void m a)
-> ConduitM Event Void m a
-> ConduitM Event Void m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitM Event Void m a -> () -> ConduitM Event Void m a
forall a b. a -> b -> a
const
#else
laxTag ln = XSP.tagPredicate ((== ln) . nameLocalName) XSP.ignoreAttrs . const
#endif

-- | Non-maybe version of laxTag/tagNoAttr.
flaxTag :: (MonadThrow m) => Text -> ConduitM Event Void m a -> ConduitM Event Void m a
flaxTag :: Text -> ConduitM Event Void m a -> ConduitM Event Void m a
flaxTag ln :: Text
ln s :: ConduitM Event Void m a
s = String
-> ConduitT Event Void m (Maybe a) -> ConduitM Event Void m a
forall (m :: * -> *) a.
MonadThrow m =>
String -> m (Maybe a) -> m a
XSP.force ("got no " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
ln) (ConduitT Event Void m (Maybe a) -> ConduitM Event Void m a)
-> ConduitT Event Void m (Maybe a) -> ConduitM Event Void m a
forall a b. (a -> b) -> a -> b
$ Text -> ConduitM Event Void m a -> ConduitT Event Void m (Maybe a)
forall (m :: * -> *) a.
MonadThrow m =>
Text -> ConduitM Event Void m a -> ConduitM Event Void m (Maybe a)
laxTag Text
ln ConduitM Event Void m a
s

laxContent :: (MonadThrow m) => Text -> ConduitM Event Void m (Maybe Text)
laxContent :: Text -> ConduitM Event Void m (Maybe Text)
laxContent ln :: Text
ln = Text
-> ConduitM Event Void m Text -> ConduitM Event Void m (Maybe Text)
forall (m :: * -> *) a.
MonadThrow m =>
Text -> ConduitM Event Void m a -> ConduitM Event Void m (Maybe a)
laxTag Text
ln ConduitM Event Void m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
XSP.content

flaxContent :: (MonadThrow m) => Text -> ConduitM Event Void m Text
flaxContent :: Text -> ConduitM Event Void m Text
flaxContent ln :: Text
ln = Text -> ConduitM Event Void m Text -> ConduitM Event Void m Text
forall (m :: * -> *) a.
MonadThrow m =>
Text -> ConduitM Event Void m a -> ConduitM Event Void m a
flaxTag Text
ln ConduitM Event Void m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
XSP.content

-- | Unpack and read a current tag content.
readContent :: (Read a, MonadThrow m) => ConduitM Event Void m a
readContent :: ConduitM Event Void m a
readContent = (Text -> a)
-> ConduitT Event Void m Text -> ConduitM Event Void m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> a
forall a. Read a => String -> a
read (String -> a) -> (Text -> String) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack) ConduitT Event Void m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
XSP.content

-- | Unpack and read tag content by local name.
readTag :: (Read a, MonadThrow m) => Text -> ConduitM Event Void m a
readTag :: Text -> ConduitM Event Void m a
readTag n :: Text
n = Text -> ConduitM Event Void m a -> ConduitM Event Void m a
forall (m :: * -> *) a.
MonadThrow m =>
Text -> ConduitM Event Void m a -> ConduitM Event Void m a
flaxTag Text
n ConduitM Event Void m a
forall a (m :: * -> *).
(Read a, MonadThrow m) =>
ConduitM Event Void m a
readContent