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

import           Control.Exception     (try)
import           Control.Lens          ((^.), (^?))
import           Data.Aeson            (FromJSON (..), decode)
import           Data.Aeson.Result     (Err, List, Ok, err, throwError, toList,
                                        toOk)
import qualified Data.ByteString.Char8 as B (unpack)
import qualified Data.ByteString.Lazy  as LB (ByteString, fromStrict)
import           Data.Text             (Text)
import           Network.HTTP.Client   (HttpException (..),
                                        HttpExceptionContent (..))
import           Network.Wreq          (Response, asJSON, responseBody)

eitherToError :: IO (Either Err a) -> IO a
eitherToError :: IO (Either Err a) -> IO a
eitherToError io :: IO (Either Err a)
io  = do
  Either Err a
r <- IO (Either Err a)
io
  case Either Err a
r of
    Left e :: Err
e  -> Err -> IO a
forall a. Err -> IO a
throwError Err
e
    Right v :: 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 req :: IO (Response a)
req = do
  Response a
r <- IO (Response a)
req
  a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ Response a
r Response a -> Getting a (Response a) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (Response a) a
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody

responseMaybe :: IO (Response a) -> IO (Maybe a)
responseMaybe :: IO (Response a) -> IO (Maybe a)
responseMaybe req :: 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 r :: Response a
r                   -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ Response a
r Response a -> Getting (First a) (Response a) a -> Maybe a
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First a) (Response a) a
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody

tryResponse :: IO (Response a) -> IO (Either Err (Response a))
tryResponse :: IO (Response a) -> IO (Either Err (Response a))
tryResponse req :: 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 _ content :: HttpExceptionContent
content) ->
      case HttpExceptionContent
content of
        (StatusCodeException _ body :: 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 er :: 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
            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
        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
$ "ResponseTimeout"
        other :: 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 _ _) ->
      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
$ "InvalidUrlException"
    Right r :: 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 req :: 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 e :: 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 r :: 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
r Response a -> Getting a (Response a) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (Response a) a
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody

responseEither' :: IO (Response LB.ByteString) -> IO (Either Err ())
responseEither' :: IO (Response ByteString) -> IO (Either Err ())
responseEither' req :: 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 e :: 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 _ -> 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 req :: 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 (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Response ByteString -> m (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 okey :: Text
okey req :: 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 e :: 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 r :: Value
r -> case Text -> Value -> Maybe (Ok a)
forall a. FromJSON a => Text -> Value -> Maybe (Ok a)
toOk Text
okey Value
r of
                 Just v :: 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
                 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 "Invalid Result"

responseOk_ :: FromJSON a => Text -> IO (Response LB.ByteString) -> IO (Ok a)
responseOk_ :: Text -> IO (Response ByteString) -> IO (Ok a)
responseOk_ okey :: Text
okey req :: 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 okey :: Text
okey req :: 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 e :: 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 r :: Value
r -> case Text -> Value -> Maybe (List a)
forall a. FromJSON a => Text -> Value -> Maybe (List a)
toList Text
okey Value
r of
                 Just v :: 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
                 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 "Invalid Result"

responseList_ :: FromJSON a => Text -> IO (Response LB.ByteString) -> IO (List a)
responseList_ :: Text -> IO (Response ByteString) -> IO (List a)
responseList_ okey :: Text
okey req :: 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)