{-# LANGUAGE TypeInType #-}
module Servant.Util.Combinators.Filtering.Backend
(
FilterBackend (..)
, AutoFilterImpl
, FilteringApp (..)
, AutoFilterSupport (..)
, FilteringSpecApp
, BackendApplySomeFilter
, typeAutoFiltersSupport
, backendApplyFilters
, filterOn
, manualFilter
) where
import Universum
import Data.Typeable (gcast1)
import GHC.TypeLits (KnownSymbol)
import Servant.Util.Combinators.Filtering.Base
import Servant.Util.Common
class FilterBackend backend where
type AutoFilteredValue backend a
type MatchPredicate backend
type AutoFilterImpl backend a =
AutoFilteredValue backend a -> MatchPredicate backend
data FilteringApp backend param where
AutoFilteringApp
:: Typeable a
=> AutoFilteredValue backend a
-> FilteringApp backend ('TyNamedParam name ('AutoFilter a))
ManualFilteringApp
:: Typeable a
=> (a -> MatchPredicate backend)
-> FilteringApp backend ('TyNamedParam name ('ManualFilter a))
class (Typeable filter, FilterBackend backend) =>
AutoFilterSupport backend filter a where
autoFilterSupport :: filter a -> AutoFilterImpl backend a
type FilteringSpecApp backend params =
HList (FilteringApp backend) params
type family AreFiltersDefined (a :: [Type -> Type]) :: Constraint where
AreFiltersDefined '[] = Show (Int -> Int)
AreFiltersDefined a = ()
class backend (filters :: [Type -> Type]) a where
:: SomeTypeAutoFilter a -> Maybe (AutoFilterImpl backend a)
instance TypeAutoFiltersSupport' backend '[] a where
typeAutoFiltersSupport' :: SomeTypeAutoFilter a -> Maybe (AutoFilterImpl backend a)
typeAutoFiltersSupport' SomeTypeAutoFilter a
_ = Maybe (AutoFilterImpl backend a)
forall a. Maybe a
Nothing
instance ( AutoFilterSupport backend filter a
, TypeAutoFiltersSupport' backend filters a
) =>
TypeAutoFiltersSupport' backend (filter ': filters) a where
typeAutoFiltersSupport' :: SomeTypeAutoFilter a -> Maybe (AutoFilterImpl backend a)
typeAutoFiltersSupport' sf :: SomeTypeAutoFilter a
sf@(SomeTypeAutoFilter filter a
filtr) = [Maybe (AutoFilterImpl backend a)]
-> Maybe (AutoFilterImpl backend a)
forall t (f :: * -> *) a.
(Container t, Alternative f, Element t ~ f a) =>
t -> f a
asum
[ do
Identity filter a
filter' <- Identity (filter a) -> Maybe (Identity (filter a))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
(a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 @_ @_ @filter (filter a -> Identity (filter a)
forall a. a -> Identity a
Identity filter a
filtr)
AutoFilterImpl backend a -> Maybe (AutoFilterImpl backend a)
forall (m :: * -> *) a. Monad m => a -> m a
return (AutoFilterImpl backend a -> Maybe (AutoFilterImpl backend a))
-> AutoFilterImpl backend a -> Maybe (AutoFilterImpl backend a)
forall a b. (a -> b) -> a -> b
$ filter a -> AutoFilterImpl backend a
forall k (backend :: k) (filter :: * -> *) a.
AutoFilterSupport backend filter a =>
filter a -> AutoFilterImpl backend a
autoFilterSupport @backend filter a
filter'
, SomeTypeAutoFilter a -> Maybe (AutoFilterImpl backend a)
forall k (backend :: k) (filters :: [* -> *]) a.
TypeAutoFiltersSupport' backend filters a =>
SomeTypeAutoFilter a -> Maybe (AutoFilterImpl backend a)
typeAutoFiltersSupport' @backend @filters SomeTypeAutoFilter a
sf
]
type backend a =
( AreFiltersDefined (SupportedFilters a)
, TypeAutoFiltersSupport' backend (SupportedFilters a) a
)
typeAutoFiltersSupport
:: forall backend a.
TypeAutoFiltersSupport backend a
=> SomeTypeAutoFilter a -> AutoFilterImpl backend a
SomeTypeAutoFilter a
filtr =
SomeTypeAutoFilter a -> Maybe (AutoFilterImpl backend a)
forall k (backend :: k) (filters :: [* -> *]) a.
TypeAutoFiltersSupport' backend filters a =>
SomeTypeAutoFilter a -> Maybe (AutoFilterImpl backend a)
typeAutoFiltersSupport' @backend @(SupportedFilters a) @a SomeTypeAutoFilter a
filtr
Maybe (AutoFilterImpl backend a)
-> AutoFilterImpl backend a -> AutoFilterImpl backend a
forall a. Maybe a -> a -> a
?: Text -> AutoFilterImpl backend a
forall a. HasCallStack => Text -> a
error Text
"impossible, invariants of SomeTypeFilter are violated"
class BackendApplyTypeFilter backend (fk :: Type -> FilterKind Type) a where
backendApplyTypeFilter
:: FilteringApp backend ('TyNamedParam name (fk a))
-> TypeFilter fk a
-> MatchPredicate backend
instance TypeAutoFiltersSupport backend a =>
BackendApplyTypeFilter backend 'AutoFilter a where
backendApplyTypeFilter :: FilteringApp backend ('TyNamedParam name ('AutoFilter a))
-> TypeFilter 'AutoFilter a -> MatchPredicate backend
backendApplyTypeFilter (AutoFilteringApp AutoFilteredValue backend a
field) (TypeAutoFilter SomeTypeAutoFilter a
filtr) =
SomeTypeAutoFilter a -> AutoFilterImpl backend a
forall k (backend :: k) a.
TypeAutoFiltersSupport backend a =>
SomeTypeAutoFilter a -> AutoFilterImpl backend a
typeAutoFiltersSupport @backend SomeTypeAutoFilter a
filtr AutoFilteredValue backend a
AutoFilteredValue backend a
field
instance BackendApplyTypeFilter backend 'ManualFilter a where
backendApplyTypeFilter :: FilteringApp backend ('TyNamedParam name ('ManualFilter a))
-> TypeFilter 'ManualFilter a -> MatchPredicate backend
backendApplyTypeFilter (ManualFilteringApp a -> MatchPredicate backend
app) (TypeManualFilter a
val) =
a -> MatchPredicate backend
app a
a
val
class FilterBackend backend =>
BackendApplySomeFilter backend (params :: [TyNamedFilter]) where
backendApplySomeFilter'
:: FilteringSpecApp backend params
-> SomeFilter params
-> Maybe (MatchPredicate backend)
instance FilterBackend backend =>
BackendApplySomeFilter backend '[] where
backendApplySomeFilter' :: FilteringSpecApp backend '[]
-> SomeFilter '[] -> Maybe (MatchPredicate backend)
backendApplySomeFilter' FilteringSpecApp backend '[]
_ SomeFilter '[]
_ = Maybe (MatchPredicate backend)
forall a. Maybe a
Nothing
instance ( Typeable fk, Typeable a
, FilterBackend backend
, KnownSymbol name
, BackendApplyTypeFilter backend fk a
, BackendApplySomeFilter backend params
) =>
BackendApplySomeFilter backend ('TyNamedParam name (fk a) ': params) where
backendApplySomeFilter' :: FilteringSpecApp backend ('TyNamedParam name (fk a) : params)
-> SomeFilter ('TyNamedParam name (fk a) : params)
-> Maybe (MatchPredicate backend)
backendApplySomeFilter' (FilteringApp backend a
app `HCons` HList (FilteringApp backend) as
fields) (SomeFilter Text
name TypeFilter fk a
filtr) = [Maybe (MatchPredicate backend)] -> Maybe (MatchPredicate backend)
forall t (f :: * -> *) a.
(Container t, Alternative f, Element t ~ f a) =>
t -> f a
asum
[ do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (KnownSymbol name => Text
forall (s :: Symbol). KnownSymbol s => Text
symbolValT @name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name)
let filtr' :: TypeFilter fk a
filtr' = TypeFilter fk a -> Maybe (TypeFilter fk a)
forall (fk1 :: * -> FilterKind *) a1 (fk2 :: * -> FilterKind *) a2.
(Typeable fk1, Typeable a1, Typeable fk2, Typeable a2) =>
TypeFilter fk1 a1 -> Maybe (TypeFilter fk2 a2)
castTypeFilter TypeFilter fk a
filtr
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
"Something is wrong, failed to cast filter!"
MatchPredicate backend -> Maybe (MatchPredicate backend)
forall (m :: * -> *) a. Monad m => a -> m a
return (MatchPredicate backend -> Maybe (MatchPredicate backend))
-> MatchPredicate backend -> Maybe (MatchPredicate backend)
forall a b. (a -> b) -> a -> b
$ FilteringApp backend ('TyNamedParam name (fk a))
-> TypeFilter fk a -> MatchPredicate backend
forall k (backend :: k) (fk :: * -> FilterKind *) a
(name :: Symbol).
BackendApplyTypeFilter backend fk a =>
FilteringApp backend ('TyNamedParam name (fk a))
-> TypeFilter fk a -> MatchPredicate backend
backendApplyTypeFilter FilteringApp backend a
FilteringApp backend ('TyNamedParam name (fk a))
app TypeFilter fk a
filtr'
, FilteringSpecApp backend params
-> SomeFilter params -> Maybe (MatchPredicate backend)
forall k (backend :: k) (params :: [TyNamedFilter]).
BackendApplySomeFilter backend params =>
FilteringSpecApp backend params
-> SomeFilter params -> Maybe (MatchPredicate backend)
backendApplySomeFilter' @backend @params FilteringSpecApp backend params
HList (FilteringApp backend) as
fields (Text -> TypeFilter fk a -> SomeFilter params
forall (fk :: * -> FilterKind *) a (params :: [TyNamedFilter]).
(Typeable fk, Typeable a) =>
Text -> TypeFilter fk a -> SomeFilter params
SomeFilter Text
name TypeFilter fk a
filtr)
]
backendApplySomeFilter
:: BackendApplySomeFilter backend params
=> FilteringSpecApp backend params
-> SomeFilter params
-> MatchPredicate backend
backendApplySomeFilter :: FilteringSpecApp backend params
-> SomeFilter params -> MatchPredicate backend
backendApplySomeFilter FilteringSpecApp backend params
app SomeFilter params
filtr =
FilteringSpecApp backend params
-> SomeFilter params -> Maybe (MatchPredicate backend)
forall k (backend :: k) (params :: [TyNamedFilter]).
BackendApplySomeFilter backend params =>
FilteringSpecApp backend params
-> SomeFilter params -> Maybe (MatchPredicate backend)
backendApplySomeFilter' FilteringSpecApp backend params
app SomeFilter params
filtr Maybe (MatchPredicate backend)
-> MatchPredicate backend -> MatchPredicate backend
forall a. Maybe a -> a -> a
?: Text -> MatchPredicate backend
forall a. HasCallStack => Text -> a
error Text
"SomeFilter invariants violated"
backendApplyFilters
:: forall backend params.
BackendApplySomeFilter backend params
=> FilteringSpec params
-> FilteringSpecApp backend params
-> [MatchPredicate backend]
backendApplyFilters :: FilteringSpec params
-> FilteringSpecApp backend params -> [MatchPredicate backend]
backendApplyFilters (FilteringSpec [SomeFilter params]
filters) FilteringSpecApp backend params
app =
(SomeFilter params -> MatchPredicate backend)
-> [SomeFilter params] -> [MatchPredicate backend]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (FilteringSpecApp backend params
-> SomeFilter params -> MatchPredicate backend
forall k (backend :: k) (params :: [TyNamedFilter]).
BackendApplySomeFilter backend params =>
FilteringSpecApp backend params
-> SomeFilter params -> MatchPredicate backend
backendApplySomeFilter FilteringSpecApp backend params
app) [SomeFilter params]
filters
filterOn
:: forall name backend a.
(Typeable a)
=> AutoFilteredValue backend a
-> FilteringApp backend ('TyNamedParam name ('AutoFilter a))
filterOn :: AutoFilteredValue backend a
-> FilteringApp backend ('TyNamedParam name ('AutoFilter a))
filterOn = AutoFilteredValue backend a
-> FilteringApp backend ('TyNamedParam name ('AutoFilter a))
forall k a (backend :: k) (a :: Symbol).
Typeable a =>
AutoFilteredValue backend a
-> FilteringApp backend ('TyNamedParam a ('AutoFilter a))
AutoFilteringApp
manualFilter
:: forall name backend a.
(Typeable a)
=> (a -> MatchPredicate backend)
-> FilteringApp backend ('TyNamedParam name ('ManualFilter a))
manualFilter :: (a -> MatchPredicate backend)
-> FilteringApp backend ('TyNamedParam name ('ManualFilter a))
manualFilter = (a -> MatchPredicate backend)
-> FilteringApp backend ('TyNamedParam name ('ManualFilter a))
forall k a (backend :: k) (name :: Symbol).
Typeable a =>
(a -> MatchPredicate backend)
-> FilteringApp backend ('TyNamedParam name ('ManualFilter a))
ManualFilteringApp