    {-# 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