module Servant.Util.Combinators.Sorting.Backend
( SortingBackend (..)
, fieldSort
, SortingApp (..)
, SortingSpecApp
, ApplyToSortItem (..)
, backendApplySorting
) where
import Universum
import GHC.TypeLits (KnownSymbol)
import Servant.Util.Combinators.Sorting.Base
import Servant.Util.Common
class SortingBackend backend where
type SortedValue backend a :: *
type SortedValueConstraint backend a :: Constraint
type SortedValueConstraint backend a = ()
type BackendOrdering backend :: *
backendFieldSort
:: SortedValueConstraint backend a
=> SortedValue backend a
-> SortingApp backend ('TyNamedParam name a)
fieldSort
:: forall name a backend.
(SortingBackend backend, SortedValueConstraint backend a)
=> SortedValue backend a -> SortingApp backend ('TyNamedParam name a)
fieldSort :: SortedValue backend a -> SortingApp backend ('TyNamedParam name a)
fieldSort = SortedValue backend a -> SortingApp backend ('TyNamedParam name a)
forall backend a (name :: Symbol).
(SortingBackend backend, SortedValueConstraint backend a) =>
SortedValue backend a -> SortingApp backend ('TyNamedParam name a)
backendFieldSort
newtype SortingApp backend param
= SortingApp (SortingItemTagged param -> BackendOrdering backend)
type SortingSpecApp backend (allParams :: [TyNamedParam *]) =
HList (SortingApp backend) allParams
class ApplyToSortItem backend params where
applyToSortItem
:: SortingSpecApp backend params
-> SortingItem
-> Maybe (BackendOrdering backend)
instance ApplyToSortItem backend '[] where
applyToSortItem :: SortingSpecApp backend '[]
-> SortingItem -> Maybe (BackendOrdering backend)
applyToSortItem SortingSpecApp backend '[]
HNil SortingItem
_ = Maybe (BackendOrdering backend)
forall a. Maybe a
Nothing
instance (KnownSymbol name, ApplyToSortItem backend params) =>
ApplyToSortItem backend ('TyNamedParam name p ': params) where
applyToSortItem :: SortingSpecApp backend ('TyNamedParam name p : params)
-> SortingItem -> Maybe (BackendOrdering backend)
applyToSortItem (SortingApp SortingItemTagged a -> BackendOrdering backend
app `HCons` HList (SortingApp backend) as
appRem) SortingItem
item = [Maybe (BackendOrdering backend)]
-> Maybe (BackendOrdering backend)
forall t (f :: * -> *) a.
(Container t, Alternative f, Element t ~ f a) =>
t -> f a
asum
[ 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
== SortingItem -> Text
siName SortingItem
item) Maybe ()
-> BackendOrdering backend -> Maybe (BackendOrdering backend)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SortingItemTagged a -> BackendOrdering backend
app (SortingItem -> SortingItemTagged a
forall (provided :: TyNamedParam *).
SortingItem -> SortingItemTagged provided
SortingItemTagged SortingItem
item)
, SortingSpecApp backend params
-> SortingItem -> Maybe (BackendOrdering backend)
forall backend (params :: [TyNamedParam *]).
ApplyToSortItem backend params =>
SortingSpecApp backend params
-> SortingItem -> Maybe (BackendOrdering backend)
applyToSortItem @backend @params SortingSpecApp backend params
HList (SortingApp backend) as
appRem SortingItem
item
]
backendApplySorting
:: forall provided base allParams backend.
( allParams ~ AllSortingParams provided base
, ApplyToSortItem backend allParams
)
=> SortingSpec provided base
-> SortingSpecApp backend allParams
-> [BackendOrdering backend]
backendApplySorting :: SortingSpec provided base
-> SortingSpecApp backend allParams -> [BackendOrdering backend]
backendApplySorting SortingSpec provided base
spec SortingSpecApp backend allParams
app =
SortingSpec provided base -> [SortingItem]
forall (provided :: [TyNamedParam *])
(base :: [TyNamedParam (SortingOrderType *)]).
SortingSpec provided base -> [SortingItem]
ssAll SortingSpec provided base
spec [SortingItem]
-> (SortingItem -> BackendOrdering backend)
-> [BackendOrdering backend]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \SortingItem
sitem ->
SortingSpecApp backend allParams
-> SortingItem -> Maybe (BackendOrdering backend)
forall backend (params :: [TyNamedParam *]).
ApplyToSortItem backend params =>
SortingSpecApp backend params
-> SortingItem -> Maybe (BackendOrdering backend)
applyToSortItem @backend @allParams SortingSpecApp backend allParams
app SortingItem
sitem
Maybe (BackendOrdering backend)
-> BackendOrdering backend -> BackendOrdering backend
forall a. Maybe a -> a -> a
?: Text -> BackendOrdering backend
forall a. HasCallStack => Text -> a
error (Text
"Impossible: don't know how to apply to spec item " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SortingItem -> Text
forall b a. (Show a, IsString b) => a -> b
show SortingItem
sitem)