{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Web.Twitter.Conduit.Request.Internal where

import Control.Lens
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as S8
import Data.Proxy
import Data.Text (Text)
import qualified Data.Text.Encoding as T
import Data.Time.Calendar (Day)
import GHC.OverloadedLabels
import GHC.TypeLits
import qualified Network.HTTP.Types as HT

data Param label t = label := t

type EmptyParams = ('[] :: [Param Symbol *])

type HasParam (label :: Symbol) (paramType :: *) (params :: [Param Symbol *]) = ParamType label params ~ paramType
type family ParamType (label :: Symbol) (params :: [Param Symbol *]) :: * where
    ParamType label ((label ':= paramType) ': ks) = paramType
    ParamType label ((label' ':= paramType') ': ks) = ParamType label ks

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

data PV
    = PVInteger {PV -> Integer
unPVInteger :: Integer}
    | PVBool {PV -> Bool
unPVBool :: Bool}
    | PVString {PV -> Text
unPVString :: Text}
    | PVIntegerArray {PV -> [Integer]
unPVIntegerArray :: [Integer]}
    | PVStringArray {PV -> [Text]
unPVStringArray :: [Text]}
    | PVDay {PV -> Day
unPVDay :: Day}
    deriving (Int -> PV -> ShowS
[PV] -> ShowS
PV -> String
(Int -> PV -> ShowS)
-> (PV -> String) -> ([PV] -> ShowS) -> Show PV
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PV] -> ShowS
$cshowList :: [PV] -> ShowS
show :: PV -> String
$cshow :: PV -> String
showsPrec :: Int -> PV -> ShowS
$cshowsPrec :: Int -> PV -> ShowS
Show, PV -> PV -> Bool
(PV -> PV -> Bool) -> (PV -> PV -> Bool) -> Eq PV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PV -> PV -> Bool
$c/= :: PV -> PV -> Bool
== :: PV -> PV -> Bool
$c== :: PV -> PV -> Bool
Eq)

class Parameters req where
    type SupportParameters req :: [Param Symbol *]
    params :: Lens' req APIQuery

class ParameterValue a where
    wrap :: a -> PV
    unwrap :: PV -> a
instance ParameterValue Integer where
    wrap :: Integer -> PV
wrap = Integer -> PV
PVInteger
    unwrap :: PV -> Integer
unwrap = PV -> Integer
unPVInteger
instance ParameterValue Bool where
    wrap :: Bool -> PV
wrap = Bool -> PV
PVBool
    unwrap :: PV -> Bool
unwrap = PV -> Bool
unPVBool
instance ParameterValue Text where
    wrap :: Text -> PV
wrap = Text -> PV
PVString
    unwrap :: PV -> Text
unwrap = PV -> Text
unPVString
instance ParameterValue [Integer] where
    wrap :: [Integer] -> PV
wrap = [Integer] -> PV
PVIntegerArray
    unwrap :: PV -> [Integer]
unwrap = PV -> [Integer]
unPVIntegerArray
instance ParameterValue [Text] where
    wrap :: [Text] -> PV
wrap = [Text] -> PV
PVStringArray
    unwrap :: PV -> [Text]
unwrap = PV -> [Text]
unPVStringArray
instance ParameterValue Day where
    wrap :: Day -> PV
wrap = Day -> PV
PVDay
    unwrap :: PV -> Day
unwrap = PV -> Day
unPVDay

makeSimpleQuery :: APIQuery -> HT.SimpleQuery
makeSimpleQuery :: APIQuery -> SimpleQuery
makeSimpleQuery = (APIQueryItem -> Identity SimpleQueryItem)
-> APIQuery -> Identity SimpleQuery
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((APIQueryItem -> Identity SimpleQueryItem)
 -> APIQuery -> Identity SimpleQuery)
-> ((PV -> Identity ByteString)
    -> APIQueryItem -> Identity SimpleQueryItem)
-> (PV -> Identity ByteString)
-> APIQuery
-> Identity SimpleQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PV -> Identity ByteString)
-> APIQueryItem -> Identity SimpleQueryItem
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((PV -> Identity ByteString) -> APIQuery -> Identity SimpleQuery)
-> (PV -> ByteString) -> APIQuery -> SimpleQuery
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ PV -> ByteString
paramValueBS

paramValueBS :: PV -> ByteString
paramValueBS :: PV -> ByteString
paramValueBS (PVInteger Integer
i) = String -> ByteString
S8.pack (String -> ByteString)
-> (Integer -> String) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> ByteString) -> Integer -> ByteString
forall a b. (a -> b) -> a -> b
$ Integer
i
paramValueBS (PVBool Bool
True) = ByteString
"true"
paramValueBS (PVBool Bool
False) = ByteString
"false"
paramValueBS (PVString Text
txt) = Text -> ByteString
T.encodeUtf8 Text
txt
paramValueBS (PVIntegerArray [Integer]
iarr) = ByteString -> [ByteString] -> ByteString
S8.intercalate ByteString
"," ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Integer -> ByteString) -> [Integer] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ByteString
S8.pack (String -> ByteString)
-> (Integer -> String) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show) [Integer]
iarr
paramValueBS (PVStringArray [Text]
iarr) = ByteString -> [ByteString] -> ByteString
S8.intercalate ByteString
"," ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Text -> ByteString) -> [Text] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Text -> ByteString
T.encodeUtf8 [Text]
iarr
paramValueBS (PVDay Day
day) = String -> ByteString
S8.pack (String -> ByteString) -> (Day -> String) -> Day -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> String
forall a. Show a => a -> String
show (Day -> ByteString) -> Day -> ByteString
forall a b. (a -> b) -> a -> b
$ Day
day

rawParam ::
    (Parameters p, ParameterValue a) =>
    -- | key
    ByteString ->
    Lens' p (Maybe a)
rawParam :: ByteString -> Lens' p (Maybe a)
rawParam ByteString
key = (p -> Maybe a) -> (p -> Maybe a -> p) -> Lens' p (Maybe a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens p -> Maybe a
getter p -> Maybe a -> p
setter
  where
    getter :: p -> Maybe a
getter = Getting (First a) p a -> p -> Maybe a
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Getting (First a) p a -> p -> Maybe a)
-> Getting (First a) p a -> p -> Maybe a
forall a b. (a -> b) -> a -> b
$ (APIQuery -> Const (First a) APIQuery) -> p -> Const (First a) p
forall req. Parameters req => Lens' req APIQuery
params ((APIQuery -> Const (First a) APIQuery) -> p -> Const (First a) p)
-> ((a -> Const (First a) a)
    -> APIQuery -> Const (First a) APIQuery)
-> Getting (First a) p a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (APIQuery -> Maybe PV)
-> Optic' (->) (Const (First a)) APIQuery (Maybe PV)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (ByteString -> APIQuery -> Maybe PV
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
key) Optic' (->) (Const (First a)) APIQuery (Maybe PV)
-> ((a -> Const (First a) a)
    -> Maybe PV -> Const (First a) (Maybe PV))
-> (a -> Const (First a) a)
-> APIQuery
-> Const (First a) APIQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PV -> Const (First a) PV)
-> Maybe PV -> Const (First a) (Maybe PV)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((PV -> Const (First a) PV)
 -> Maybe PV -> Const (First a) (Maybe PV))
-> ((a -> Const (First a) a) -> PV -> Const (First a) PV)
-> (a -> Const (First a) a)
-> Maybe PV
-> Const (First a) (Maybe PV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PV -> a) -> (a -> Const (First a) a) -> PV -> Const (First a) PV
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to PV -> a
forall a. ParameterValue a => PV -> a
unwrap
    setter :: p -> Maybe a -> p
setter = (Maybe a -> p -> p) -> p -> Maybe a -> p
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ASetter p p APIQuery APIQuery -> (APIQuery -> APIQuery) -> p -> p
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter p p APIQuery APIQuery
forall req. Parameters req => Lens' req APIQuery
params ((APIQuery -> APIQuery) -> p -> p)
-> (Maybe a -> APIQuery -> APIQuery) -> Maybe a -> p -> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe a -> APIQuery -> APIQuery
forall a a.
(ParameterValue a, Eq a) =>
a -> Maybe a -> [(a, PV)] -> [(a, PV)]
replace ByteString
key)
    replace :: a -> Maybe a -> [(a, PV)] -> [(a, PV)]
replace a
k (Just a
v) = ((a
k, a -> PV
forall a. ParameterValue a => a -> PV
wrap a
v) (a, PV) -> [(a, PV)] -> [(a, PV)]
forall a. a -> [a] -> [a]
:) ([(a, PV)] -> [(a, PV)])
-> ([(a, PV)] -> [(a, PV)]) -> [(a, PV)] -> [(a, PV)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [(a, PV)] -> [(a, PV)]
forall a b. Eq a => a -> [(a, b)] -> [(a, b)]
dropAssoc a
k
    replace a
k Maybe a
Nothing = a -> [(a, PV)] -> [(a, PV)]
forall a b. Eq a => a -> [(a, b)] -> [(a, b)]
dropAssoc a
k
    dropAssoc :: a -> [(a, b)] -> [(a, b)]
dropAssoc a
k = ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
k) (a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst)

instance
    ( Parameters req
    , ParameterValue a
    , KnownSymbol label
    , HasParam label a (SupportParameters req)
    , Functor f
    , lens ~ ((Maybe a -> f (Maybe a)) -> req -> f req)
    ) =>
    IsLabel label lens
    where
    fromLabel :: lens
fromLabel = ByteString -> Lens' req (Maybe a)
forall p a.
(Parameters p, ParameterValue a) =>
ByteString -> Lens' p (Maybe a)
rawParam ByteString
key
      where
        key :: ByteString
key = String -> ByteString
S8.pack (Proxy label -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy label
forall k (t :: k). Proxy t
Proxy :: Proxy label))