module Aws.Core.XmlParse (
  XmlException (..),
  xmlCursorConsumer,
  elContent,
  elCont,
  force,
  forceM,
  maybeInt,
  textReadInt,
  readInt
) where


import qualified Control.Exception            as E
import           Control.Monad.IO.Class       (liftIO)
import           Control.Monad.Trans.Resource (MonadThrow, throwM)
import           Data.Conduit                 (($$+-))
import           Data.IORef                   (IORef)
import           Data.Monoid                  (Monoid)
import qualified Data.Text                    as T
import           Data.Typeable                (Typeable)
import qualified Network.HTTP.Conduit         as HTTP (responseBody)
import           Text.Read                    (readMaybe)
import qualified Text.XML                     as XML
import           Text.XML.Cursor              ((&/), (&|))
import qualified Text.XML.Cursor              as Cu

import           Aws.Core.Response            (HTTPResponseConsumer,
                                               Response (..), tellMetadataRef)

-- | An error that occurred during XML parsing / validation.
newtype XmlException = XmlException { xmlErrorMessage :: String }
    deriving (Show, Typeable)

instance E.Exception XmlException

-- | A specific element (case-insensitive, ignoring namespace - sadly necessary), extracting only the textual contents.
elContent :: T.Text -> Cu.Cursor -> [T.Text]
elContent name = Cu.laxElement name &/ Cu.content

-- | Like 'elContent', but extracts 'String's instead of 'T.Text'.
elCont :: T.Text -> Cu.Cursor -> [String]
elCont name = Cu.laxElement name &/ Cu.content &| T.unpack

-- | Extract the first element from a parser result list, and throw an 'XmlException' if the list is empty.
force :: MonadThrow m => String -> [a] -> m a
force = Cu.force . XmlException

-- | Extract the first element from a monadic parser result list, and throw an 'XmlException' if the list is empty.
forceM :: MonadThrow m => String -> [m a] -> m a
forceM = Cu.forceM . XmlException

-- | Read an integer from a 'T.Text', throwing an 'XmlException' on failure.
textReadInt :: (MonadThrow m, Num a) => T.Text -> m a
textReadInt s = case reads $ T.unpack s of
                  [(n,"")] -> return $ fromInteger n
                  _        -> throwM $ XmlException "Invalid Integer"

-- | Read an integer from a 'String', throwing an 'XmlException' on failure.
readInt :: (MonadThrow m, Num a) => String -> m a
readInt s = case reads s of
              [(n,"")] -> return $ fromInteger n
              _        -> throwM $ XmlException "Invalid Integer"

maybeInt :: Maybe T.Text -> Maybe Int
maybeInt txt = do
  s <- txt
  readMaybe (T.unpack s)

-- | Create a complete 'HTTPResponseConsumer' from a simple function that takes a 'Cu.Cursor' to XML in the response
-- body.
--
-- This function is highly recommended for any services that parse relatively short XML responses. (If status and response
-- headers are required, simply take them as function parameters, and pass them through to this function.)
xmlCursorConsumer ::
    (Monoid m)
    => (Cu.Cursor -> Response m a)
    -> IORef m
    -> HTTPResponseConsumer a
xmlCursorConsumer parse metadataRef res
    = do doc <- HTTP.responseBody res $$+- XML.sinkDoc XML.def
         let cursor = Cu.fromDocument doc
         let Response metadata x = parse cursor
         liftIO $ tellMetadataRef metadataRef metadata
         case x of
           Left err -> liftIO $ throwM err
           Right v  -> return v
