{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}

module Web.Twitter.Conduit.Request (
    HasParam,
    APIRequest (..),
) where

import Data.Aeson
import GHC.TypeLits (Symbol)
import Network.HTTP.Client.MultipartFormData
import qualified Network.HTTP.Types as HT
import Web.Twitter.Conduit.Request.Internal

-- $setup
-- >>> :set -XOverloadedStrings -XDataKinds -XTypeOperators
-- >>> import Control.Lens
-- >>> import Web.Twitter.Conduit.Parameters
-- >>> type SampleId = Integer
-- >>> type SampleApi = '["count" ':= Integer, "max_id" ':= Integer]
-- >>> let sampleApiRequest :: APIRequest SampleApi [SampleId]; sampleApiRequest = APIRequest "GET" "https://api.twitter.com/sample/api.json" []

-- | API request. You should use specific builder functions instead of building this directly.
--
-- For example, if there were a @SampleApi@ type and a builder function which named @sampleApiRequest@.
--
-- @
-- type SampleId = 'Integer'
-- sampleApiRequest :: 'APIRequest' SampleApi [SampleId]
-- sampleApiRequest = 'APIRequest' \"GET\" \"https:\/\/api.twitter.com\/sample\/api.json\" []
-- type SampleApi = '[ "count" ':= Integer
--                   , "max_id" ':= Integer
--                   ]
--
-- @
--
-- We can obtain request params from @'APIRequest' SampleApi [SampleId]@ :
--
-- >>> sampleApiRequest ^. params
-- []
--
-- The second type parameter of the APIRequest represents the allowed parameters for the APIRequest.
-- For example, @sampleApiRequest@ has 2 @Integer@ parameters, that is "count" and "max_id".
-- You can update those parameters by label lenses (@#count@ and @#max_id@ respectively)
--
-- >>> (sampleApiRequest & #count ?~ 100 & #max_id ?~ 1234567890) ^. params
-- [("max_id",PVInteger {unPVInteger = 1234567890}),("count",PVInteger {unPVInteger = 100})]
-- >>> (sampleApiRequest & #count ?~ 100 & #max_id ?~ 1234567890 & #count .~ Nothing) ^. params
-- [("max_id",PVInteger {unPVInteger = 1234567890})]
data APIRequest (supports :: [Param Symbol *]) responseType
    = APIRequest
        { APIRequest supports responseType -> Method
_method :: HT.Method
        , APIRequest supports responseType -> String
_url :: String
        , APIRequest supports responseType -> APIQuery
_params :: APIQuery
        }
    | APIRequestMultipart
        { _method :: HT.Method
        , _url :: String
        , _params :: APIQuery
        , APIRequest supports responseType -> [Part]
_part :: [Part]
        }
    | APIRequestJSON
        { _method :: HT.Method
        , _url :: String
        , _params :: APIQuery
        , APIRequest supports responseType -> Value
_body :: Value
        }

instance Parameters (APIRequest supports responseType) where
    type SupportParameters (APIRequest supports responseType) = supports

    params :: (APIQuery -> f APIQuery)
-> APIRequest supports responseType
-> f (APIRequest supports responseType)
params APIQuery -> f APIQuery
f (APIRequest Method
m String
u APIQuery
pa) = Method -> String -> APIQuery -> APIRequest supports responseType
forall (supports :: [Param Symbol *]) responseType.
Method -> String -> APIQuery -> APIRequest supports responseType
APIRequest Method
m String
u (APIQuery -> APIRequest supports responseType)
-> f APIQuery -> f (APIRequest supports responseType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> APIQuery -> f APIQuery
f APIQuery
pa
    params APIQuery -> f APIQuery
f (APIRequestMultipart Method
m String
u APIQuery
pa [Part]
prt) =
        (\APIQuery
p -> Method
-> String -> APIQuery -> [Part] -> APIRequest supports responseType
forall (supports :: [Param Symbol *]) responseType.
Method
-> String -> APIQuery -> [Part] -> APIRequest supports responseType
APIRequestMultipart Method
m String
u APIQuery
p [Part]
prt) (APIQuery -> APIRequest supports responseType)
-> f APIQuery -> f (APIRequest supports responseType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> APIQuery -> f APIQuery
f APIQuery
pa
    params APIQuery -> f APIQuery
f (APIRequestJSON Method
m String
u APIQuery
pa Value
body) = (\APIQuery
p -> Method
-> String -> APIQuery -> Value -> APIRequest supports responseType
forall (supports :: [Param Symbol *]) responseType.
Method
-> String -> APIQuery -> Value -> APIRequest supports responseType
APIRequestJSON Method
m String
u APIQuery
p Value
body) (APIQuery -> APIRequest supports responseType)
-> f APIQuery -> f (APIRequest supports responseType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> APIQuery -> f APIQuery
f APIQuery
pa
instance Show (APIRequest apiName responseType) where
    show :: APIRequest apiName responseType -> String
show (APIRequest Method
m String
u APIQuery
p) = String
"APIRequest " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Method -> String
forall a. Show a => a -> String
show Method
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
u String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SimpleQuery -> String
forall a. Show a => a -> String
show (APIQuery -> SimpleQuery
makeSimpleQuery APIQuery
p)
    show (APIRequestMultipart Method
m String
u APIQuery
p [Part]
_) = String
"APIRequestMultipart " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Method -> String
forall a. Show a => a -> String
show Method
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
u String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SimpleQuery -> String
forall a. Show a => a -> String
show (APIQuery -> SimpleQuery
makeSimpleQuery APIQuery
p)
    show (APIRequestJSON Method
m String
u APIQuery
p Value
_) = String
"APIRequestJSON " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Method -> String
forall a. Show a => a -> String
show Method
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
u String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SimpleQuery -> String
forall a. Show a => a -> String
show (APIQuery -> SimpleQuery
makeSimpleQuery APIQuery
p)