{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}

-- | Some helpers to parse documents with Text.XML.Cursor.

module Network.SOAP.Parsing.Cursor
    (
      -- * Extract single element
      readT, readC
      -- * Extract from multiple elements
    , Dict, readDict, dictBy
    ) where

import Network.SOAP (ResponseParser(CursorParser))

import Text.XML
import Text.XML.Cursor

import           Data.Text (Text)
import qualified Data.Text as T
import qualified Data.HashMap.Strict as HM
import           Data.Maybe (mapMaybe)

-- ** Single-element extraction.

-- | Grab node content by element name.
--
-- > pair cur = (readT "fst" cur, readT "snd" cur)
readT :: Text -> Cursor -> Text
readT :: Text -> Cursor -> Text
readT Text
n Cursor
c = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
laxElement Text
n Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
{-# INLINE readT #-}

-- | Extract a read-able type from a content of a node with given name.
--
-- > age = readC "age" :: Cursor -> Integer
readC :: (Read a) => Text -> Cursor -> a
readC :: forall a. Read a => Text -> Cursor -> a
readC Text
n Cursor
c = 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
T.unpack (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Text -> Cursor -> Text
readT Text
n Cursor
c
{-# INLINE readC #-}

-- ** Multi-element extraction.

-- | Very generic type to catch server reply when you don't care about types.
type Dict = HM.HashMap Text Text

-- | Apply an axis and extract a key-value from child elements.
--
-- > invokeWS … (CursorParser . readDict $ laxElement "WebScaleResponse" &/ laxElement "BigDataResult")
readDict :: Axis -> Cursor -> Dict
readDict :: Axis -> Cursor -> Dict
readDict Axis
a Cursor
c = Cursor -> Dict
extract (Cursor -> Dict) -> ([Cursor] -> Cursor) -> [Cursor] -> Dict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Cursor] -> Cursor
forall a. HasCallStack => [a] -> a
head ([Cursor] -> Dict) -> [Cursor] -> Dict
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> Axis -> [Cursor]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Axis
a
    where
        extract :: Cursor -> Dict
extract Cursor
cur = [(Text, Text)] -> Dict
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Text, Text)] -> Dict)
-> ([Cursor] -> [(Text, Text)]) -> [Cursor] -> Dict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> Maybe (Text, Text)) -> [Node] -> [(Text, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node -> Maybe (Text, Text)
dict ([Node] -> [(Text, Text)])
-> ([Cursor] -> [Node]) -> [Cursor] -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cursor -> Node) -> [Cursor] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Cursor -> Node
forall node. Cursor node -> node
node ([Cursor] -> Dict) -> [Cursor] -> Dict
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> Axis -> [Cursor]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| Axis
forall node. Cursor node -> [Cursor node]
child

        dict :: Node -> Maybe (Text, Text)
dict (NodeElement (Element (Name Text
n Maybe Text
_ Maybe Text
_) Map Name Text
_ [NodeContent Text
cont])) = (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
n, Text
cont)
        dict (NodeElement (Element (Name Text
n Maybe Text
_ Maybe Text
_) Map Name Text
_ []))              = (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
n, Text
T.empty)
        dict Node
_                                                      = Maybe (Text, Text)
forall a. Maybe a
Nothing

-- | Simple parser to grab a flat response by an element name.
--
-- > result <- invokeWS … (dictBy "BigDataResult")
-- > case HM.lookup "SuccessError" result of …
dictBy :: T.Text -> ResponseParser Dict
dictBy :: Text -> ResponseParser Dict
dictBy Text
n = (Cursor -> Dict) -> ResponseParser Dict
forall a. (Cursor -> a) -> ResponseParser a
CursorParser ((Cursor -> Dict) -> ResponseParser Dict)
-> (Axis -> Cursor -> Dict) -> Axis -> ResponseParser Dict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Axis -> Cursor -> Dict
readDict (Axis -> ResponseParser Dict) -> Axis -> ResponseParser Dict
forall a b. (a -> b) -> a -> b
$ Axis
anyElement Axis -> Axis -> Axis
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Text -> Axis
laxElement Text
n