{-# OPTIONS_GHC -fno-warn-orphans #-}

module Servant.Util.Combinators.Filtering.Client () where

import Universum hiding (filter)

import Data.Typeable (cast)
import GHC.TypeLits (KnownSymbol)
import Servant (ToHttpApiData (..), toQueryParam, (:>))
import Servant.Client (HasClient (..))
import Servant.Client.Core.Request (Request, appendToQueryString)

import Servant.Util.Combinators.Filtering.Base
import Servant.Util.Combinators.Filtering.Support ()
import Servant.Util.Common

-------------------------------------------------------------------------
-- Client
-------------------------------------------------------------------------

-- | For given filter return operation name and encoded value.
typeFilterToReq :: ToHttpApiData a => TypeFilter fk a -> (Text, Text)
typeFilterToReq :: TypeFilter fk a -> (Text, Text)
typeFilterToReq = \case
    TypeAutoFilter (SomeTypeAutoFilter filter a
filter) -> filter a -> (Text, Text)
forall (filter :: * -> *) a.
(IsAutoFilter filter, ToHttpApiData a) =>
filter a -> (Text, Text)
autoFilterEncode filter a
filter
    TypeManualFilter a
val                       -> (Text
DefFilteringCmd, a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam a
val)

-- | Apply filter to a client request being built.
class SomeFilterToReq params where
    someFilterToReq :: SomeFilter params -> Request -> Request

instance SomeFilterToReq '[] where
    someFilterToReq :: SomeFilter '[] -> Request -> Request
someFilterToReq = Text -> SomeFilter '[] -> Request -> Request
forall a. HasCallStack => Text -> a
error Text
"Something got wrong"

instance ( KnownSymbol name
         , Typeable (fk :: * -> FilterKind *)
         , Typeable a
         , ToHttpApiData a
         , SomeFilterToReq params
         ) =>
         SomeFilterToReq ('TyNamedParam name (fk a) ': params) where
    someFilterToReq :: SomeFilter ('TyNamedParam name (fk a) : params)
-> Request -> Request
someFilterToReq SomeFilter{Text
TypeFilter fk a
sfFilter :: ()
sfName :: forall (params :: [TyNamedFilter]). SomeFilter params -> Text
sfFilter :: TypeFilter fk a
sfName :: Text
..}
        | KnownSymbol name => Text
forall (s :: Symbol). KnownSymbol s => Text
symbolValT @name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
sfName =
            let TypeFilter fk a
filter :: TypeFilter fk a = TypeFilter fk a -> Maybe (TypeFilter fk a)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast TypeFilter fk a
sfFilter Maybe (TypeFilter fk a) -> TypeFilter fk a -> TypeFilter fk a
forall a. Maybe a -> a -> a
?: Text -> TypeFilter fk a
forall a. HasCallStack => Text -> a
error Text
"Failed to cast filter"
                (Text
op, Text
value) = TypeFilter fk a -> (Text, Text)
forall a (fk :: * -> FilterKind *).
ToHttpApiData a =>
TypeFilter fk a -> (Text, Text)
typeFilterToReq TypeFilter fk a
filter
                keymod :: Text
keymod = if Text
op Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
DefFilteringCmd then Text
"" else Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
op Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
                key :: Text
key = Text
sfName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
keymod
            in Text -> Maybe Text -> Request -> Request
appendToQueryString Text
key (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
value)
        | Bool
otherwise =
            SomeFilter params -> Request -> Request
forall (params :: [TyNamedFilter]).
SomeFilterToReq params =>
SomeFilter params -> Request -> Request
someFilterToReq @params SomeFilter :: forall (fk :: * -> FilterKind *) a (params :: [TyNamedFilter]).
(Typeable fk, Typeable a) =>
Text -> TypeFilter fk a -> SomeFilter params
SomeFilter{Text
TypeFilter fk a
sfFilter :: TypeFilter fk a
sfName :: Text
sfFilter :: TypeFilter fk a
sfName :: Text
..}

instance (HasClient m subApi, SomeFilterToReq params) =>
         HasClient m (FilteringParams params :> subApi) where
    type Client m (FilteringParams params :> subApi) =
        FilteringSpec params -> Client m subApi
    clientWithRoute :: Proxy m
-> Proxy (FilteringParams params :> subApi)
-> Request
-> Client m (FilteringParams params :> subApi)
clientWithRoute Proxy m
mp Proxy (FilteringParams params :> subApi)
_ Request
req (FilteringSpec [SomeFilter params]
filters) =
        Proxy m -> Proxy subApi -> Request -> Client m subApi
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
mp (Proxy subApi
forall k (t :: k). Proxy t
Proxy @subApi) ((Element [SomeFilter params] -> Request -> Request)
-> Request -> [SomeFilter params] -> Request
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr Element [SomeFilter params] -> Request -> Request
forall (params :: [TyNamedFilter]).
SomeFilterToReq params =>
SomeFilter params -> Request -> Request
someFilterToReq Request
req [SomeFilter params]
filters)
    hoistClientMonad :: Proxy m
-> Proxy (FilteringParams params :> subApi)
-> (forall x. mon x -> mon' x)
-> Client mon (FilteringParams params :> subApi)
-> Client mon' (FilteringParams params :> subApi)
hoistClientMonad Proxy m
pm Proxy (FilteringParams params :> subApi)
_ forall x. mon x -> mon' x
hst Client mon (FilteringParams params :> subApi)
subCli = Proxy m
-> Proxy subApi
-> (forall x. mon x -> mon' x)
-> Client mon subApi
-> Client mon' subApi
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy subApi
forall k (t :: k). Proxy t
Proxy @subApi) forall x. mon x -> mon' x
hst (Client mon subApi -> Client mon' subApi)
-> (FilteringSpec params -> Client mon subApi)
-> FilteringSpec params
-> Client mon' subApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Client mon (FilteringParams params :> subApi)
FilteringSpec params -> Client mon subApi
subCli