{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Network.Wreq.Helper
  ( responseValue
  , responseMaybe
  , responseEither
  , responseEither'
  , responseEitherJSON
  , responseJSON
  , responseOk
  , responseOk_
  , responseList
  , responseList_
  , tryResponse
  , eitherToError
  ) where


import           Control.Exception     (Exception, throwIO, try)
import           Control.Monad         (unless)
import           Data.Aeson            (FromJSON (..), decode, eitherDecode')
import           Data.Aeson.Result     (Err, List, Ok, err, throwError, toList,
                                        toOk)
import qualified Data.ByteString       as B (break, isPrefixOf, isSuffixOf)
import qualified Data.ByteString.Char8 as B (unpack)
import qualified Data.ByteString.Lazy  as LB (ByteString, fromStrict)
import           Data.Maybe            (fromMaybe)
import           Data.Text             (Text)
import           Network.HTTP.Client   (HttpException (..),
                                        HttpExceptionContent (..), Response,
                                        responseBody, responseHeaders)

data JSONError = JSONError String
  deriving (Int -> JSONError -> ShowS
[JSONError] -> ShowS
JSONError -> String
(Int -> JSONError -> ShowS)
-> (JSONError -> String)
-> ([JSONError] -> ShowS)
-> Show JSONError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONError] -> ShowS
$cshowList :: [JSONError] -> ShowS
show :: JSONError -> String
$cshow :: JSONError -> String
showsPrec :: Int -> JSONError -> ShowS
$cshowsPrec :: Int -> JSONError -> ShowS
Show)

instance Exception JSONError

asJSON :: FromJSON a => Response LB.ByteString -> IO (Response a)
asJSON :: Response ByteString -> IO (Response a)
asJSON Response ByteString
resp = do
  let contentType :: ByteString
contentType = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (Response ByteString -> (ByteString, ByteString))
-> Response ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==Word8
59) (ByteString -> (ByteString, ByteString))
-> (Response ByteString -> ByteString)
-> Response ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"unknown" (Maybe ByteString -> ByteString)
-> (Response ByteString -> Maybe ByteString)
-> Response ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"Content-Type" ([(HeaderName, ByteString)] -> Maybe ByteString)
-> (Response ByteString -> [(HeaderName, ByteString)])
-> Response ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> [(HeaderName, ByteString)]
forall body. Response body -> [(HeaderName, ByteString)]
responseHeaders (Response ByteString -> ByteString)
-> Response ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString
resp
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
"application/json" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
contentType
        Bool -> Bool -> Bool
|| (ByteString
"application/" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
contentType Bool -> Bool -> Bool
&& ByteString
"+json" ByteString -> ByteString -> Bool
`B.isSuffixOf` ByteString
contentType)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    JSONError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (JSONError -> IO ()) -> (String -> JSONError) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> JSONError
JSONError (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"content type of response is " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
contentType
  case ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecode' (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
resp) of
    Left String
e    -> JSONError -> IO (Response a)
forall e a. Exception e => e -> IO a
throwIO (String -> JSONError
JSONError String
e)
    Right a
val -> Response a -> IO (Response a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString -> a) -> Response ByteString -> Response a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> ByteString -> a
forall a b. a -> b -> a
const a
val) Response ByteString
resp)

eitherToError :: IO (Either Err a) -> IO a
eitherToError :: IO (Either Err a) -> IO a
eitherToError IO (Either Err a)
io  = do
  Either Err a
r <- IO (Either Err a)
io
  case Either Err a
r of
    Left Err
e  -> Err -> IO a
forall a. Err -> IO a
throwError Err
e
    Right a
v -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v

responseValue :: IO (Response a) -> IO a
responseValue :: IO (Response a) -> IO a
responseValue IO (Response a)
req = Response a -> a
forall body. Response body -> body
responseBody (Response a -> a) -> IO (Response a) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Response a)
req

responseMaybe :: IO (Response a) -> IO (Maybe a)
responseMaybe :: IO (Response a) -> IO (Maybe a)
responseMaybe IO (Response a)
req = do
  Either HttpException (Response a)
e <- IO (Response a) -> IO (Either HttpException (Response a))
forall e a. Exception e => IO a -> IO (Either e a)
try IO (Response a)
req
  case Either HttpException (Response a)
e of
    Left (HttpException
_ :: HttpException) -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    Right Response a
r                   -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> IO (Maybe a)) -> (a -> Maybe a) -> a -> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just (a -> IO (Maybe a)) -> a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ Response a -> a
forall body. Response body -> body
responseBody Response a
r

tryResponse :: IO (Response a) -> IO (Either Err (Response a))
tryResponse :: IO (Response a) -> IO (Either Err (Response a))
tryResponse IO (Response a)
req = do
  Either HttpException (Response a)
e <- IO (Response a) -> IO (Either HttpException (Response a))
forall e a. Exception e => IO a -> IO (Either e a)
try IO (Response a)
req
  case Either HttpException (Response a)
e of
    Left (HttpExceptionRequest Request
_ HttpExceptionContent
content) ->
      case HttpExceptionContent
content of
        (StatusCodeException Response ()
_ ByteString
body) ->
          case ByteString -> Maybe Err
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe Err)
-> (ByteString -> ByteString) -> ByteString -> Maybe Err
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LB.fromStrict (ByteString -> Maybe Err) -> ByteString -> Maybe Err
forall a b. (a -> b) -> a -> b
$ ByteString
body of
            Just Err
er -> Either Err (Response a) -> IO (Either Err (Response a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Err (Response a) -> IO (Either Err (Response a)))
-> Either Err (Response a) -> IO (Either Err (Response a))
forall a b. (a -> b) -> a -> b
$ Err -> Either Err (Response a)
forall a b. a -> Either a b
Left Err
er
            Maybe Err
Nothing -> Either Err (Response a) -> IO (Either Err (Response a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Err (Response a) -> IO (Either Err (Response a)))
-> (ByteString -> Either Err (Response a))
-> ByteString
-> IO (Either Err (Response a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err -> Either Err (Response a)
forall a b. a -> Either a b
Left (Err -> Either Err (Response a))
-> (ByteString -> Err) -> ByteString -> Either Err (Response a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Err
err (String -> Err) -> (ByteString -> String) -> ByteString -> Err
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack (ByteString -> IO (Either Err (Response a)))
-> ByteString -> IO (Either Err (Response a))
forall a b. (a -> b) -> a -> b
$ ByteString
body
        HttpExceptionContent
ResponseTimeout -> Either Err (Response a) -> IO (Either Err (Response a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Err (Response a) -> IO (Either Err (Response a)))
-> (String -> Either Err (Response a))
-> String
-> IO (Either Err (Response a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err -> Either Err (Response a)
forall a b. a -> Either a b
Left (Err -> Either Err (Response a))
-> (String -> Err) -> String -> Either Err (Response a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Err
err (String -> IO (Either Err (Response a)))
-> String -> IO (Either Err (Response a))
forall a b. (a -> b) -> a -> b
$ String
"ResponseTimeout"
        HttpExceptionContent
other -> Either Err (Response a) -> IO (Either Err (Response a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Err (Response a) -> IO (Either Err (Response a)))
-> (String -> Either Err (Response a))
-> String
-> IO (Either Err (Response a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err -> Either Err (Response a)
forall a b. a -> Either a b
Left (Err -> Either Err (Response a))
-> (String -> Err) -> String -> Either Err (Response a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Err
err (String -> IO (Either Err (Response a)))
-> String -> IO (Either Err (Response a))
forall a b. (a -> b) -> a -> b
$ HttpExceptionContent -> String
forall a. Show a => a -> String
show HttpExceptionContent
other

    Left (InvalidUrlException String
_ String
_) ->
      Either Err (Response a) -> IO (Either Err (Response a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Err (Response a) -> IO (Either Err (Response a)))
-> (String -> Either Err (Response a))
-> String
-> IO (Either Err (Response a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err -> Either Err (Response a)
forall a b. a -> Either a b
Left (Err -> Either Err (Response a))
-> (String -> Err) -> String -> Either Err (Response a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Err
err (String -> IO (Either Err (Response a)))
-> String -> IO (Either Err (Response a))
forall a b. (a -> b) -> a -> b
$ String
"InvalidUrlException"
    Right Response a
r  -> Either Err (Response a) -> IO (Either Err (Response a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Err (Response a) -> IO (Either Err (Response a)))
-> Either Err (Response a) -> IO (Either Err (Response a))
forall a b. (a -> b) -> a -> b
$ Response a -> Either Err (Response a)
forall a b. b -> Either a b
Right Response a
r

responseEither :: IO (Response a) -> IO (Either Err a)
responseEither :: IO (Response a) -> IO (Either Err a)
responseEither IO (Response a)
req = do
  Either Err (Response a)
rsp <- IO (Response a) -> IO (Either Err (Response a))
forall a. IO (Response a) -> IO (Either Err (Response a))
tryResponse IO (Response a)
req
  case Either Err (Response a)
rsp of
    Left Err
e  -> Either Err a -> IO (Either Err a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Err a -> IO (Either Err a))
-> Either Err a -> IO (Either Err a)
forall a b. (a -> b) -> a -> b
$ Err -> Either Err a
forall a b. a -> Either a b
Left Err
e
    Right Response a
r -> Either Err a -> IO (Either Err a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Err a -> IO (Either Err a))
-> (a -> Either Err a) -> a -> IO (Either Err a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either Err a
forall a b. b -> Either a b
Right (a -> IO (Either Err a)) -> a -> IO (Either Err a)
forall a b. (a -> b) -> a -> b
$ Response a -> a
forall body. Response body -> body
responseBody Response a
r

responseEither' :: IO (Response LB.ByteString) -> IO (Either Err ())
responseEither' :: IO (Response ByteString) -> IO (Either Err ())
responseEither' IO (Response ByteString)
req = do
  Either Err (Response ByteString)
rsp <- IO (Response ByteString) -> IO (Either Err (Response ByteString))
forall a. IO (Response a) -> IO (Either Err (Response a))
tryResponse IO (Response ByteString)
req
  case Either Err (Response ByteString)
rsp of
    Left Err
e  -> Either Err () -> IO (Either Err ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Err () -> IO (Either Err ()))
-> Either Err () -> IO (Either Err ())
forall a b. (a -> b) -> a -> b
$ Err -> Either Err ()
forall a b. a -> Either a b
Left Err
e
    Right Response ByteString
_ -> Either Err () -> IO (Either Err ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Err () -> IO (Either Err ()))
-> Either Err () -> IO (Either Err ())
forall a b. (a -> b) -> a -> b
$ () -> Either Err ()
forall a b. b -> Either a b
Right ()

responseEitherJSON :: FromJSON a => IO (Response LB.ByteString) -> IO (Either Err a)
responseEitherJSON :: IO (Response ByteString) -> IO (Either Err a)
responseEitherJSON IO (Response ByteString)
req = IO (Response a) -> IO (Either Err a)
forall a. IO (Response a) -> IO (Either Err a)
responseEither (IO (Response a) -> IO (Either Err a))
-> IO (Response a) -> IO (Either Err a)
forall a b. (a -> b) -> a -> b
$ Response ByteString -> IO (Response a)
forall a. FromJSON a => Response ByteString -> IO (Response a)
asJSON (Response ByteString -> IO (Response a))
-> IO (Response ByteString) -> IO (Response a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Response ByteString)
req

responseJSON :: FromJSON a => IO (Response LB.ByteString) -> IO a
responseJSON :: IO (Response ByteString) -> IO a
responseJSON = IO (Either Err a) -> IO a
forall a. IO (Either Err a) -> IO a
eitherToError (IO (Either Err a) -> IO a)
-> (IO (Response ByteString) -> IO (Either Err a))
-> IO (Response ByteString)
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Response ByteString) -> IO (Either Err a)
forall a.
FromJSON a =>
IO (Response ByteString) -> IO (Either Err a)
responseEitherJSON

responseOk :: FromJSON a => Text -> IO (Response LB.ByteString) -> IO (Either Err (Ok a))
responseOk :: Text -> IO (Response ByteString) -> IO (Either Err (Ok a))
responseOk Text
okey IO (Response ByteString)
req = do
  Either Err Value
rsp <- IO (Response ByteString) -> IO (Either Err Value)
forall a.
FromJSON a =>
IO (Response ByteString) -> IO (Either Err a)
responseEitherJSON IO (Response ByteString)
req
  case Either Err Value
rsp of
    Left Err
e  -> Either Err (Ok a) -> IO (Either Err (Ok a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Err (Ok a) -> IO (Either Err (Ok a)))
-> Either Err (Ok a) -> IO (Either Err (Ok a))
forall a b. (a -> b) -> a -> b
$ Err -> Either Err (Ok a)
forall a b. a -> Either a b
Left Err
e
    Right Value
r -> case Text -> Value -> Maybe (Ok a)
forall a. FromJSON a => Text -> Value -> Maybe (Ok a)
toOk Text
okey Value
r of
                 Just Ok a
v  -> Either Err (Ok a) -> IO (Either Err (Ok a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Err (Ok a) -> IO (Either Err (Ok a)))
-> Either Err (Ok a) -> IO (Either Err (Ok a))
forall a b. (a -> b) -> a -> b
$ Ok a -> Either Err (Ok a)
forall a b. b -> Either a b
Right Ok a
v
                 Maybe (Ok a)
Nothing -> Either Err (Ok a) -> IO (Either Err (Ok a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Err (Ok a) -> IO (Either Err (Ok a)))
-> (Err -> Either Err (Ok a)) -> Err -> IO (Either Err (Ok a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err -> Either Err (Ok a)
forall a b. a -> Either a b
Left (Err -> IO (Either Err (Ok a))) -> Err -> IO (Either Err (Ok a))
forall a b. (a -> b) -> a -> b
$ String -> Err
err String
"Invalid Result"

responseOk_ :: FromJSON a => Text -> IO (Response LB.ByteString) -> IO (Ok a)
responseOk_ :: Text -> IO (Response ByteString) -> IO (Ok a)
responseOk_ Text
okey IO (Response ByteString)
req = IO (Either Err (Ok a)) -> IO (Ok a)
forall a. IO (Either Err a) -> IO a
eitherToError (Text -> IO (Response ByteString) -> IO (Either Err (Ok a))
forall a.
FromJSON a =>
Text -> IO (Response ByteString) -> IO (Either Err (Ok a))
responseOk Text
okey IO (Response ByteString)
req)

responseList :: FromJSON a => Text -> IO (Response LB.ByteString) -> IO (Either Err (List a))
responseList :: Text -> IO (Response ByteString) -> IO (Either Err (List a))
responseList Text
okey IO (Response ByteString)
req = do
  Either Err Value
rsp <- IO (Response ByteString) -> IO (Either Err Value)
forall a.
FromJSON a =>
IO (Response ByteString) -> IO (Either Err a)
responseEitherJSON IO (Response ByteString)
req
  case Either Err Value
rsp of
    Left Err
e  -> Either Err (List a) -> IO (Either Err (List a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Err (List a) -> IO (Either Err (List a)))
-> Either Err (List a) -> IO (Either Err (List a))
forall a b. (a -> b) -> a -> b
$ Err -> Either Err (List a)
forall a b. a -> Either a b
Left Err
e
    Right Value
r -> case Text -> Value -> Maybe (List a)
forall a. FromJSON a => Text -> Value -> Maybe (List a)
toList Text
okey Value
r of
                 Just List a
v  -> Either Err (List a) -> IO (Either Err (List a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Err (List a) -> IO (Either Err (List a)))
-> Either Err (List a) -> IO (Either Err (List a))
forall a b. (a -> b) -> a -> b
$ List a -> Either Err (List a)
forall a b. b -> Either a b
Right List a
v
                 Maybe (List a)
Nothing -> Either Err (List a) -> IO (Either Err (List a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Err (List a) -> IO (Either Err (List a)))
-> (Err -> Either Err (List a)) -> Err -> IO (Either Err (List a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err -> Either Err (List a)
forall a b. a -> Either a b
Left (Err -> IO (Either Err (List a)))
-> Err -> IO (Either Err (List a))
forall a b. (a -> b) -> a -> b
$ String -> Err
err String
"Invalid Result"

responseList_ :: FromJSON a => Text -> IO (Response LB.ByteString) -> IO (List a)
responseList_ :: Text -> IO (Response ByteString) -> IO (List a)
responseList_ Text
okey IO (Response ByteString)
req = IO (Either Err (List a)) -> IO (List a)
forall a. IO (Either Err a) -> IO a
eitherToError (Text -> IO (Response ByteString) -> IO (Either Err (List a))
forall a.
FromJSON a =>
Text -> IO (Response ByteString) -> IO (Either Err (List a))
responseList Text
okey IO (Response ByteString)
req)