{-# LANGUAGE TypeInType #-}
module Servant.Util.Combinators.Filtering.Getters
( manualFilterValue
) where
import Universum
import GHC.TypeLits (ErrorMessage (..), KnownSymbol, TypeError)
import Servant.Util.Combinators.Filtering.Base
import Servant.Util.Common
type family UnManualFilter (fk :: FilterKind k) :: k where
UnManualFilter ('ManualFilter a) = a
UnManualFilter ('AutoFilter a) =
TypeError ('Text "Getting an auto filter is not allowed")
manualFilterValue
:: forall name params filter filterKind.
( filterKind ~ LookupParam "filter" name (params :: [TyNamedFilter])
, filter ~ UnManualFilter filterKind
, Typeable filter
, KnownSymbol name
)
=> NameLabel name -> FilteringSpec params -> [filter]
manualFilterValue :: NameLabel name -> FilteringSpec params -> [filter]
manualFilterValue NameLabel name
_ (FilteringSpec [SomeFilter params]
filters) =
[Maybe filter] -> [filter]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe filter] -> [filter]) -> [Maybe filter] -> [filter]
forall a b. (a -> b) -> a -> b
$ [SomeFilter params]
filters [SomeFilter params]
-> (SomeFilter params -> Maybe filter) -> [Maybe filter]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \SomeFilter{Text
TypeFilter fk a
sfFilter :: ()
sfName :: forall (params :: [TyNamedFilter]). SomeFilter params -> Text
sfFilter :: TypeFilter fk a
sfName :: Text
..} ->
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
sfName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== KnownSymbol name => Text
forall (s :: Symbol). KnownSymbol s => Text
symbolValT @name) Maybe () -> filter -> Maybe filter
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$>
case TypeFilter fk a -> Maybe (TypeFilter 'ManualFilter filter)
forall (fk1 :: * -> FilterKind *) a1 (fk2 :: * -> FilterKind *) a2.
(Typeable fk1, Typeable a1, Typeable fk2, Typeable a2) =>
TypeFilter fk1 a1 -> Maybe (TypeFilter fk2 a2)
castTypeFilter @_ @_ @'ManualFilter TypeFilter fk a
sfFilter of
Just (TypeManualFilter filter
v) -> filter
v
Maybe (TypeFilter 'ManualFilter filter)
_ -> Text -> filter
forall a. HasCallStack => Text -> a
error Text
"Failed to cast filter"