<commit_before>{-# LANGUAGE FlexibleContexts #-}

-- Module      : Network.AWS.Response
-- Copyright   : (c) 2013-2014 <NAME> <<EMAIL>>
-- License     : This Source Code Form is subject to the terms of
--               the Mozilla Public License, v. 2.0.
--               A copy of the MPL can be found in the LICENSE file or
--               you can obtain it at http://mozilla.org/MPL/2.0/.
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)

module Network.AWS.Response
    ( headerResponse
    , cursorResponse
    , xmlResponse
    , bodyResponse
    ) where

import           Control.Monad
import           Data.Bifunctor
import           Data.ByteString      (ByteString)
import qualified Data.ByteString      as BS
import qualified Data.ByteString.Lazy as LBS
import           Data.Default
import           Data.Monoid
import           Network.AWS.Data
import           Network.AWS.Types
import           Network.HTTP.Client
import           Network.HTTP.Types
import qualified Text.XML             as XML
import           Text.XML.Cursor

headerResponse :: (Monad m, ServiceError e)
               => (ResponseHeaders -> Either String a)
               -> Either HttpException (ClientResponse m)
               -> m (Either e a)
headerResponse f = bodyResponse' $
    const . return . first serializerError . f

cursorResponse :: (Monad m, ServiceError e)
               => (ResponseHeaders -> Cursor -> Either String a)
               -> Either HttpException (ClientResponse m)
               -> m (Either e a)
cursorResponse f = bodyResponse' $ \hs bdy -> do
    lbs <- consume bdy
    case XML.parseLBS def lbs of
        Left  ex  -> return . Left . serializerError $ show ex
        Right doc ->
            case f hs (fromDocument doc) of
                Left  s -> return . Left $ serviceError s
                Right x -> return (Right x)

xmlResponse :: (Monad m, ServiceError e, FromXML a)
            => Either HttpException (ClientResponse m)
            -> m (Either e a)
xmlResponse = bodyResponse' $
     const (liftM (first serializerError . decodeXML) . consume)

bodyResponse :: (Monad m, ServiceError e)
             => (ResponseHeaders -> m ByteString -> m (Either String b))
             -> Either HttpException (Response (m ByteString))
             -> m (Either e b)
bodyResponse f = bodyResponse' $ \hs bdy ->
    liftM (first serializerError) (f hs bdy)

bodyResponse' :: (Monad m, ServiceError e)
             => (ResponseHeaders -> m ByteString -> m (Either e b))
             -> Either HttpException (Response (m ByteString))
             -> m (Either e b)
bodyResponse' f = either failure success
  where
    failure = return . Left . clientError

    success rs
        | statusCode st >= 400 = failure (StatusCodeException st hs mempty)
        | otherwise = f hs (responseBody rs)
      where
        st = responseStatus  rs<commit_msg>Formatting<commit_after>{-# LANGUAGE FlexibleContexts #-}

-- Module      : Network.AWS.Response
-- Copyright   : (c) 2013-2014 <NAME> <<EMAIL>>
-- License     : This Source Code Form is subject to the terms of
--               the Mozilla Public License, v. 2.0.
--               A copy of the MPL can be found in the LICENSE file or
--               you can obtain it at http://mozilla.org/MPL/2.0/.
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)

module Network.AWS.Response
    ( headerResponse
    , cursorResponse
    , xmlResponse
    , bodyResponse
    ) where

import           Control.Monad
import           Data.Bifunctor
import           Data.ByteString      (ByteString)
import qualified Data.ByteString      as BS
import qualified Data.ByteString.Lazy as LBS
import           Data.Default
import           Data.Monoid
import           Network.AWS.Data
import           Network.AWS.Types
import           Network.HTTP.Client
import           Network.HTTP.Types
import qualified Text.XML             as XML
import           Text.XML.Cursor

headerResponse :: (Monad m, ServiceError e)
               => (ResponseHeaders -> Either String a)
               -> Either HttpException (ClientResponse m)
               -> m (Either e a)
headerResponse f = receive (const . return . first serializerError . f)

cursorResponse :: (Monad m, ServiceError e)
               => (ResponseHeaders -> Cursor -> Either String a)
               -> Either HttpException (ClientResponse m)
               -> m (Either e a)
cursorResponse f = receive $ \hs bdy -> do
    lbs <- consume bdy
    case XML.parseLBS def lbs of
        Left  ex  -> return . Left . serializerError $ show ex
        Right doc ->
            case f hs (fromDocument doc) of
                Left  s -> return . Left $ serviceError s
                Right x -> return (Right x)

xmlResponse :: (Monad m, ServiceError e, FromXML a)
            => Either HttpException (ClientResponse m)
            -> m (Either e a)
xmlResponse = receive (const (liftM (first serializerError . decodeXML) . consume))

bodyResponse :: (Monad m, ServiceError e)
             => (ResponseHeaders -> m ByteString -> m (Either String b))
             -> Either HttpException (Response (m ByteString))
             -> m (Either e b)
bodyResponse f = receive (\hs bdy -> liftM (first serializerError) (f hs bdy))

receive :: (Monad m, ServiceError e)
        => (ResponseHeaders -> m ByteString -> m (Either e b))
        -> Either HttpException (Response (m ByteString))
        -> m (Either e b)
receive f = either failure success
  where
    failure = return . Left . clientError

    success rs
        | statusCode st >= 400 = failure (StatusCodeException st hs mempty)
        | otherwise = f hs (responseBody rs)
      where
        st = responseStatus  rs
{'fraction_non_alphanumeric': 0.09109695195453762, 'fraction_numerical': 0.0051661787497847425, 'mean_word_length': 2.0, 'pattern_counts': {'":': 0, '<': 17, '<?xml version=': 0, '>': 71, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 6}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '956739', 'n_tokens_mistral': 1596, 'n_tokens_neox': 1533, 'n_words': 571}