{-# LANGUAGE DataKinds #-}
module GitHub.Tools.Requests where

import           Control.Monad.Catch (throwM)
import           Data.Aeson          (FromJSON, ToJSON (toJSON),
                                      Value (Array, Null, Object))
import qualified Data.Aeson.KeyMap   as KeyMap
import qualified Data.Vector         as V
import qualified GitHub
import           GitHub.Data.Request (MediaType (..))
import           Network.HTTP.Client (Manager)

removeNulls :: ToJSON a => a -> Value
removeNulls :: a -> Value
removeNulls = Value -> Value
go (Value -> Value) -> (a -> Value) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON
  where
    go :: Value -> Value
go (Array  Array
x) = Array -> Value
Array (Array -> Value) -> (Array -> Array) -> Array -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Value) -> Array -> Array
forall a b. (a -> b) -> Vector a -> Vector b
V.map Value -> Value
go (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ Array
x
    go (Object Object
x) = Object -> Value
Object (Object -> Value) -> (Object -> Object) -> Object -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Value) -> Object -> Object
forall a b. (a -> b) -> KeyMap a -> KeyMap b
KeyMap.map Value -> Value
go (Object -> Object) -> (Object -> Object) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Bool) -> Object -> Object
forall v. (v -> Bool) -> KeyMap v -> KeyMap v
KeyMap.filter (Bool -> Bool
not (Bool -> Bool) -> (Value -> Bool) -> Value -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Bool
isEmpty) (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Object
x
    go         Value
x  = Value
x

    isEmpty :: Value -> Bool
isEmpty Value
Null      = Bool
True
    isEmpty (Array Array
x) = Array -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Array
x
    isEmpty Value
_         = Bool
False

request
  :: FromJSON a
  => Maybe GitHub.Auth
  -> Manager
  -> GitHub.Request 'GitHub.RO a
  -> IO a
request :: Maybe Auth -> Manager -> Request 'RO a -> IO a
request Maybe Auth
auth Manager
mgr Request 'RO a
req = do
  Either Error a
response <- IO (Either Error a)
executeRequest
  case Either Error a
response of
    Left  Error
err -> Error -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM Error
err
    Right a
res -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

  where
    executeRequest :: IO (Either Error a)
executeRequest =
      case Maybe Auth
auth of
        Maybe Auth
Nothing -> Manager -> Request 'RO a -> IO (Either Error a)
forall (mt :: MediaType *) a.
ParseResponse mt a =>
Manager -> GenRequest mt 'RO a -> IO (Either Error a)
GitHub.executeRequestWithMgr' Manager
mgr Request 'RO a
req
        Just Auth
tk -> Manager -> Auth -> Request 'RO a -> IO (Either Error a)
forall am (mt :: MediaType *) a (rw :: RW).
(AuthMethod am, ParseResponse mt a) =>
Manager -> am -> GenRequest mt rw a -> IO (Either Error a)
GitHub.executeRequestWithMgr Manager
mgr Auth
tk Request 'RO a
req

mutate
  :: FromJSON a
  => GitHub.Auth
  -> Manager
  -> GitHub.Request 'GitHub.RW a
  -> IO a
mutate :: Auth -> Manager -> Request 'RW a -> IO a
mutate Auth
auth Manager
mgr Request 'RW a
req = do
  Either Error a
response <- Manager -> Auth -> Request 'RW a -> IO (Either Error a)
forall am (mt :: MediaType *) a (rw :: RW).
(AuthMethod am, ParseResponse mt a) =>
Manager -> am -> GenRequest mt rw a -> IO (Either Error a)
GitHub.executeRequestWithMgr Manager
mgr Auth
auth Request 'RW a
req
  case Either Error a
response of
    Left  Error
err -> Error -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM Error
err
    Right a
res -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

mutate_
  :: GitHub.Auth
  -> Manager
  -> GitHub.GenRequest 'MtUnit 'GitHub.RW ()
  -> IO ()
mutate_ :: Auth -> Manager -> GenRequest 'MtUnit 'RW () -> IO ()
mutate_ Auth
auth Manager
mgr GenRequest 'MtUnit 'RW ()
req = do
  Either Error ()
response <- Manager
-> Auth -> GenRequest 'MtUnit 'RW () -> IO (Either Error ())
forall am (mt :: MediaType *) a (rw :: RW).
(AuthMethod am, ParseResponse mt a) =>
Manager -> am -> GenRequest mt rw a -> IO (Either Error a)
GitHub.executeRequestWithMgr Manager
mgr Auth
auth GenRequest 'MtUnit 'RW ()
req
  case Either Error ()
response of
    Left  Error
err -> Error -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM Error
err
    Right ()
res -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
res