Request.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE CPP #-}

module Web.Twitter.Conduit.Request
       ( Parameters(..)
       , APIRequest(..)
       , APIQuery
       , APIQueryItem
       , PV(..)
       , makeSimpleQuery
       , paramValueBS
       ) where

import Control.Applicative
import Control.Lens
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as S8
import Data.Text (Text)
import qualified Data.Text.Encoding as T
import Data.Time.Calendar (Day)
import Network.HTTP.Client.MultipartFormData
import qualified Network.HTTP.Types as HT

class Parameters a where
    params :: Lens' a APIQuery

-- In GHC 7.4.2, the following test fails with Overlapping instances error.
-- It may be caused by #5820 "defining instance in GHCi leads to duplicated instances".
-- So, we bypass below tests when GHC version older than 7.6.
-- see details: https://ghc.haskell.org/trac/ghc/ticket/5820
#if __GLASGOW_HASKELL__ >= 706
-- $setup
-- >>> :set -XOverloadedStrings -XRank2Types -XEmptyDataDecls -XFlexibleInstances -XOverlappingInstances -XIncoherentInstances
-- >>> import Control.Lens
-- >>> import Data.Default
-- >>> import Web.Twitter.Conduit.Parameters
-- >>> data SampleApi
-- >>> type SampleId = Integer
-- >>> instance HasCountParam (APIRequest SampleApi [SampleId])
-- >>> instance HasMaxIdParam (APIRequest SampleApi [SampleId])
-- >>> let sampleApiRequest :: APIRequest SampleApi [SampleId]; sampleApiRequest = APIRequestGet "https://api.twitter.com/sample/api.json" def

-- | 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@.
-- In addition, @'APIRequest' SampleApi [SampleId]@ is a instance of both of 'HasCountParam' and 'HasMaxIdParam'.
--
-- @
-- data 'SampleApi'
-- type 'SampleId' = 'Integer'
-- instance 'HasCountParam' ('APIRequest' 'SampleApi' ['SampleId'])
-- instance 'HasMaxIdParam' ('APIRequest' 'SampleApi' ['SampleId'])
-- 'sampleApiRequest' :: 'APIRequest' 'SampleApi' ['SampleId']
-- 'sampleApiRequest' = 'APIRequestGet' \"https:\/\/api.twitter.com\/sample\/api.json\" 'def'
-- @
--
-- We can obtain request params from @'APIRequest' SampleApi [SampleId]@ :
--
-- >>> sampleApiRequest ^. params
-- []
--
-- And update request parameters.
--
-- >>> (sampleApiRequest & count ?~ 100 & maxId ?~ 1234567890) ^. params
-- [("max_id",PVInteger {unPVInteger = 1234567890}),("count",PVInteger {unPVInteger = 100})]
-- >>> (sampleApiRequest & count ?~ 100 & maxId ?~ 1234567890 & count .~ Nothing) ^. params
-- [("max_id",PVInteger {unPVInteger = 1234567890})]
#endif
data APIRequest apiName responseType
    = APIRequestGet
      { _url :: String
      , _params :: APIQuery
      }
    | APIRequestPost
      { _url :: String
      , _params :: APIQuery
      }
    | APIRequestPostMultipart
      { _url :: String
      , _params :: APIQuery
      , _part :: [Part]
      }
instance Parameters (APIRequest apiName responseType) where
    params f (APIRequestGet u pa) = APIRequestGet u <$> f pa
    params f (APIRequestPost u pa) = APIRequestPost u <$> f pa
    params f (APIRequestPostMultipart u pa prt) =
        (\p -> APIRequestPostMultipart u p prt) <$> f pa
instance Show (APIRequest apiName responseType) where
    show (APIRequestGet u p) = "APIRequestGet " ++ show u ++ " " ++ show (makeSimpleQuery p)
    show (APIRequestPost u p) = "APIRequestPost " ++ show u ++ " " ++ show (makeSimpleQuery p)
    show (APIRequestPostMultipart u p _) = "APIRequestPostMultipart " ++ show u ++ " " ++ show (makeSimpleQuery p)

type APIQuery = [APIQueryItem]
type APIQueryItem = (ByteString, PV)

data PV
    = PVInteger { unPVInteger :: Integer }
    | PVBool { unPVBool :: Bool }
    | PVString { unPVString :: Text }
    | PVIntegerArray { unPVIntegerArray :: [Integer] }
    | PVStringArray { unPVStringArray :: [Text] }
    | PVDay { unPVDay :: Day }
    deriving (Show, Eq)

makeSimpleQuery :: APIQuery -> HT.SimpleQuery
makeSimpleQuery = traversed . _2 %~ paramValueBS

paramValueBS :: PV -> ByteString
paramValueBS (PVInteger i) = S8.pack . show $ i
paramValueBS (PVBool True) = "true"
paramValueBS (PVBool False) = "false"
paramValueBS (PVString txt) = T.encodeUtf8 txt
paramValueBS (PVIntegerArray iarr) = S8.intercalate "," $ map (S8.pack . show) iarr
paramValueBS (PVStringArray iarr) = S8.intercalate "," $ map T.encodeUtf8 iarr
paramValueBS (PVDay day) = S8.pack . show $ day