{-# 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 {unPVInteger :: Integer}
    | PVBool {unPVBool :: Bool}
    | PVString {unPVString :: Text}
    | PVIntegerArray {unPVIntegerArray :: [Integer]}
    | PVStringArray {unPVStringArray :: [Text]}
    | PVDay {unPVDay :: Day}
    deriving (Show, 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 = PVInteger
    unwrap = unPVInteger
instance ParameterValue Bool where
    wrap = PVBool
    unwrap = unPVBool
instance ParameterValue Text where
    wrap = PVString
    unwrap = unPVString
instance ParameterValue [Integer] where
    wrap = PVIntegerArray
    unwrap = unPVIntegerArray
instance ParameterValue [Text] where
    wrap = PVStringArray
    unwrap = unPVStringArray
instance ParameterValue Day where
    wrap = PVDay
    unwrap = unPVDay

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

rawParam ::
    (Parameters p, ParameterValue a) =>
    -- | key
    ByteString ->
    Lens' p (Maybe a)
rawParam key = lens getter setter
  where
    getter = preview $ params . to (lookup key) . _Just . to unwrap
    setter = flip (over params . replace key)
    replace k (Just v) = ((k, wrap v) :) . dropAssoc k
    replace k Nothing = dropAssoc k
    dropAssoc k = filter ((/= k) . 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 = rawParam key
      where
        key = S8.pack (symbolVal (Proxy :: Proxy label))

# LANGUAGE ConstraintKinds #
# LANGUAGE OverloadedStrings #
# LANGUAGE RankNTypes #
 | key
# LANGUAGE DataKinds #
# LANGUAGE FlexibleInstances #
# LANGUAGE MultiParamTypeClasses #
# 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 {unPVInteger :: Integer}
    | PVBool {unPVBool :: Bool}
    | PVString {unPVString :: Text}
    | PVIntegerArray {unPVIntegerArray :: [Integer]}
    | PVStringArray {unPVStringArray :: [Text]}
    | PVDay {unPVDay :: Day}
    deriving (Show, 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 = PVInteger
    unwrap = unPVInteger
instance ParameterValue Bool where
    wrap = PVBool
    unwrap = unPVBool
instance ParameterValue Text where
    wrap = PVString
    unwrap = unPVString
instance ParameterValue [Integer] where
    wrap = PVIntegerArray
    unwrap = unPVIntegerArray
instance ParameterValue [Text] where
    wrap = PVStringArray
    unwrap = unPVStringArray
instance ParameterValue Day where
    wrap = PVDay
    unwrap = unPVDay

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

rawParam ::
    (Parameters p, ParameterValue a) =>
    ByteString ->
    Lens' p (Maybe a)
rawParam key = lens getter setter
  where
    getter = preview $ params . to (lookup key) . _Just . to unwrap
    setter = flip (over params . replace key)
    replace k (Just v) = ((k, wrap v) :) . dropAssoc k
    replace k Nothing = dropAssoc k
    dropAssoc k = filter ((/= k) . 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 = rawParam key
      where
        key = S8.pack (symbolVal (Proxy :: Proxy label))
