{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE TypeInType #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.Util.Combinators.Filtering.Construction
( noFilters
, mkFilteringSpec
, (?/)
, (?/=)
, (?/<)
, (?/>)
, (?/<=)
, (?/>=)
, (?/~)
, textLike
, textILike
, textContains
, textIContains
) where
import Universum hiding (filter)
import Data.Coerce (coerce)
import Data.Default (Default (..))
import GHC.TypeLits (ErrorMessage (..), KnownSymbol, TypeError)
import Servant.Util.Combinators.Filtering.Base
import Servant.Util.Combinators.Filtering.Filters
import Servant.Util.Combinators.Filtering.Support ()
import Servant.Util.Common
mkFilteringSpec :: [SomeFilter params] -> FilteringSpec params
mkFilteringSpec :: [SomeFilter params] -> FilteringSpec params
mkFilteringSpec = [SomeFilter params] -> FilteringSpec params
forall (params :: [TyNamedFilter]).
[SomeFilter params] -> FilteringSpec params
FilteringSpec
instance Default (FilteringSpec params) where
def :: FilteringSpec params
def = FilteringSpec params
forall (params :: [TyNamedFilter]). FilteringSpec params
noFilters
noFilters :: FilteringSpec params
noFilters :: FilteringSpec params
noFilters = [SomeFilter params] -> FilteringSpec params
forall (params :: [TyNamedFilter]).
[SomeFilter params] -> FilteringSpec params
FilteringSpec []
type family IsSupportedFilter filter a :: Constraint where
IsSupportedFilter filter a =
If (Elem filter (SupportedFilters a))
(() :: Constraint)
(TypeError
( 'Text "Filter '" ':<>: 'ShowType filter ':<>:
'Text "' is not supported for '" ':<>: 'ShowType a ':<>:
'Text "' type"
)
)
class MkTypeFilter filter fk a where
mkTypeFilter :: filter -> TypeFilter fk a
instance ( filter ~ filterType a
, IsAutoFilter filterType
, IsSupportedFilter filterType a
) =>
MkTypeFilter filter 'AutoFilter a where
mkTypeFilter :: filter -> TypeFilter 'AutoFilter a
mkTypeFilter filter
filter = SomeTypeAutoFilter a -> TypeFilter 'AutoFilter a
forall a. SomeTypeAutoFilter a -> TypeFilter 'AutoFilter a
TypeAutoFilter (filterType a -> SomeTypeAutoFilter a
forall a (filter :: * -> *).
IsAutoFilter filter =>
filter a -> SomeTypeAutoFilter a
SomeTypeAutoFilter filter
filterType a
filter)
instance (filter ~ a) => MkTypeFilter filter 'ManualFilter a where
mkTypeFilter :: filter -> TypeFilter 'ManualFilter a
mkTypeFilter = filter -> TypeFilter 'ManualFilter a
forall a. a -> TypeFilter 'ManualFilter a
TypeManualFilter
class MkSomeFilter name filter (origParams :: [TyNamedFilter]) (params :: [TyNamedFilter]) where
mkSomeFilter :: filter -> SomeFilter params
instance TypeError ('Text "Unknown filter " ':<>: 'ShowType name ':$$:
'Text "Allowed ones here: " ':<>: 'ShowType (TyNamedParamsNames origParams)) =>
MkSomeFilter name filter origParams '[] where
mkSomeFilter :: filter -> SomeFilter '[]
mkSomeFilter = Text -> filter -> SomeFilter '[]
forall a. HasCallStack => Text -> a
error Text
":shrug:"
instance {-# OVERLAPPING #-}
(MkTypeFilter filter fk a, KnownSymbol name, Typeable fk, Typeable a) =>
MkSomeFilter name filter origParams ('TyNamedParam name (fk a) ': params) where
mkSomeFilter :: filter -> SomeFilter ('TyNamedParam name (fk a) : params)
mkSomeFilter filter
filter =
SomeFilter :: forall (fk :: * -> FilterKind *) a (params :: [TyNamedFilter]).
(Typeable fk, Typeable a) =>
Text -> TypeFilter fk a -> SomeFilter params
SomeFilter
{ sfName :: Text
sfName = KnownSymbol name => Text
forall (s :: Symbol). KnownSymbol s => Text
symbolValT @name
, sfFilter :: TypeFilter fk a
sfFilter = filter -> TypeFilter fk a
forall filter (fk :: * -> FilterKind *) a.
MkTypeFilter filter fk a =>
filter -> TypeFilter fk a
mkTypeFilter @filter @fk @a filter
filter
}
instance MkSomeFilter name filter origParams params =>
MkSomeFilter name filter origParams (param ': params) where
mkSomeFilter :: filter -> SomeFilter (param : params)
mkSomeFilter filter
filter = SomeFilter params -> SomeFilter (param : params)
coerce (SomeFilter params -> SomeFilter (param : params))
-> SomeFilter params -> SomeFilter (param : params)
forall a b. (a -> b) -> a -> b
$ filter -> SomeFilter params
forall k (name :: k) filter (origParams :: [TyNamedFilter])
(params :: [TyNamedFilter]).
MkSomeFilter name filter origParams params =>
filter -> SomeFilter params
mkSomeFilter @name @filter @origParams @params filter
filter
(?/)
:: forall name params filter.
MkSomeFilter name filter params params
=> NameLabel name -> filter -> SomeFilter params
?/ :: NameLabel name -> filter -> SomeFilter params
(?/) NameLabel name
_ = forall (params :: [TyNamedFilter]).
MkSomeFilter name filter params params =>
filter -> SomeFilter params
forall k (name :: k) filter (origParams :: [TyNamedFilter])
(params :: [TyNamedFilter]).
MkSomeFilter name filter origParams params =>
filter -> SomeFilter params
mkSomeFilter @name @_ @params
infixr 0 ?/
(?/=)
:: forall name params filter.
MkSomeFilter name (FilterMatching filter) params params
=> NameLabel name -> filter -> SomeFilter params
NameLabel name
l ?/= :: NameLabel name -> filter -> SomeFilter params
?/= filter
f = NameLabel name
l NameLabel name -> FilterMatching filter -> SomeFilter params
forall (name :: Symbol) (params :: [TyNamedFilter]) filter.
MkSomeFilter name filter params params =>
NameLabel name -> filter -> SomeFilter params
?/ filter -> FilterMatching filter
forall a. a -> FilterMatching a
FilterMatching filter
f
infixr 0 ?/=
(?/>), (?/<), (?/>=), (?/<=)
:: forall name params filter.
MkSomeFilter name (FilterComparing filter) params params
=> NameLabel name -> filter -> SomeFilter params
NameLabel name
l ?/> :: NameLabel name -> filter -> SomeFilter params
?/> filter
f = NameLabel name
l NameLabel name -> FilterComparing filter -> SomeFilter params
forall (name :: Symbol) (params :: [TyNamedFilter]) filter.
MkSomeFilter name filter params params =>
NameLabel name -> filter -> SomeFilter params
?/ filter -> FilterComparing filter
forall a. a -> FilterComparing a
FilterGT filter
f
NameLabel name
l ?/< :: NameLabel name -> filter -> SomeFilter params
?/< filter
f = NameLabel name
l NameLabel name -> FilterComparing filter -> SomeFilter params
forall (name :: Symbol) (params :: [TyNamedFilter]) filter.
MkSomeFilter name filter params params =>
NameLabel name -> filter -> SomeFilter params
?/ filter -> FilterComparing filter
forall a. a -> FilterComparing a
FilterLT filter
f
NameLabel name
l ?/>= :: NameLabel name -> filter -> SomeFilter params
?/>= filter
f = NameLabel name
l NameLabel name -> FilterComparing filter -> SomeFilter params
forall (name :: Symbol) (params :: [TyNamedFilter]) filter.
MkSomeFilter name filter params params =>
NameLabel name -> filter -> SomeFilter params
?/ filter -> FilterComparing filter
forall a. a -> FilterComparing a
FilterGTE filter
f
NameLabel name
l ?/<= :: NameLabel name -> filter -> SomeFilter params
?/<= filter
f = NameLabel name
l NameLabel name -> FilterComparing filter -> SomeFilter params
forall (name :: Symbol) (params :: [TyNamedFilter]) filter.
MkSomeFilter name filter params params =>
NameLabel name -> filter -> SomeFilter params
?/ filter -> FilterComparing filter
forall a. a -> FilterComparing a
FilterLTE filter
f
infixr 0 ?/>
infixr 0 ?/<
infixr 0 ?/>=
infixr 0 ?/<=
textLike
:: forall name params text.
(MkSomeFilter name (FilterLike text) params params, HasCallStack)
=> NameLabel name -> LText -> SomeFilter params
NameLabel name
l textLike :: NameLabel name -> LText -> SomeFilter params
`textLike` LText
p = NameLabel name
l NameLabel name -> FilterLike text -> SomeFilter params
forall (name :: Symbol) (params :: [TyNamedFilter]) filter.
MkSomeFilter name filter params params =>
NameLabel name -> filter -> SomeFilter params
?/ CaseSensitivity -> LikePattern -> FilterLike text
forall a. CaseSensitivity -> LikePattern -> FilterLike a
FilterLike @text (Bool -> CaseSensitivity
CaseSensitivity Bool
True) (LText -> LikePattern
mkLikePatternUnsafe LText
p)
infixr 0 `textLike`
textILike
:: forall name params text.
(MkSomeFilter name (FilterLike text) params params, HasCallStack)
=> NameLabel name -> LText -> SomeFilter params
NameLabel name
l textILike :: NameLabel name -> LText -> SomeFilter params
`textILike` LText
p = NameLabel name
l NameLabel name -> FilterLike text -> SomeFilter params
forall (name :: Symbol) (params :: [TyNamedFilter]) filter.
MkSomeFilter name filter params params =>
NameLabel name -> filter -> SomeFilter params
?/ CaseSensitivity -> LikePattern -> FilterLike text
forall a. CaseSensitivity -> LikePattern -> FilterLike a
FilterLike @text (Bool -> CaseSensitivity
CaseSensitivity Bool
False) (LText -> LikePattern
mkLikePatternUnsafe LText
p)
infixr 0 `textILike`
textContains
:: forall name params text.
MkSomeFilter name (FilterLike text) params params
=> NameLabel name -> Text -> SomeFilter params
NameLabel name
l textContains :: NameLabel name -> Text -> SomeFilter params
`textContains` Text
p = NameLabel name
l NameLabel name -> FilterLike text -> SomeFilter params
forall (name :: Symbol) (params :: [TyNamedFilter]) filter.
MkSomeFilter name filter params params =>
NameLabel name -> filter -> SomeFilter params
?/ CaseSensitivity -> Text -> FilterLike text
forall a. CaseSensitivity -> Text -> FilterLike a
filterContains @text (Bool -> CaseSensitivity
CaseSensitivity Bool
True) Text
p
infixr 0 `textContains`
textIContains
:: forall name params text.
MkSomeFilter name (FilterLike text) params params
=> NameLabel name -> Text -> SomeFilter params
NameLabel name
l textIContains :: NameLabel name -> Text -> SomeFilter params
`textIContains` Text
p = NameLabel name
l NameLabel name -> FilterLike text -> SomeFilter params
forall (name :: Symbol) (params :: [TyNamedFilter]) filter.
MkSomeFilter name filter params params =>
NameLabel name -> filter -> SomeFilter params
?/ CaseSensitivity -> Text -> FilterLike text
forall a. CaseSensitivity -> Text -> FilterLike a
filterContains @text (Bool -> CaseSensitivity
CaseSensitivity Bool
False) Text
p
infixr 0 `textIContains`
(?/~)
:: forall name filter' params filter.
(MkSomeFilter name filter' params params, Coercible filter filter')
=> NameLabel name -> filter -> SomeFilter params
NameLabel name
l ?/~ :: NameLabel name -> filter -> SomeFilter params
?/~ filter
f = NameLabel name
l NameLabel name -> filter' -> SomeFilter params
forall (name :: Symbol) (params :: [TyNamedFilter]) filter.
MkSomeFilter name filter params params =>
NameLabel name -> filter -> SomeFilter params
?/ filter -> filter'
coerce @_ @filter' filter
f
_sample :: FilteringSpec ["id" ?: 'AutoFilter Int, "desc" ?: 'ManualFilter Text]
_sample :: FilteringSpec
'["id" ?: 'AutoFilter Int, "desc" ?: 'ManualFilter Text]
_sample =
[ IsLabel "id" (NameLabel "id")
NameLabel "id"
#id NameLabel "id"
-> FilterMatching Int
-> SomeFilter
'["id" ?: 'AutoFilter Int, "desc" ?: 'ManualFilter Text]
forall (name :: Symbol) (params :: [TyNamedFilter]) filter.
MkSomeFilter name filter params params =>
NameLabel name -> filter -> SomeFilter params
?/ Int -> FilterMatching Int
forall a. a -> FilterMatching a
FilterMatching Int
5
, IsLabel "id" (NameLabel "id")
NameLabel "id"
#id NameLabel "id"
-> Int
-> SomeFilter
'["id" ?: 'AutoFilter Int, "desc" ?: 'ManualFilter Text]
forall (name :: Symbol) (params :: [TyNamedFilter]) filter.
MkSomeFilter name (FilterMatching filter) params params =>
NameLabel name -> filter -> SomeFilter params
?/= Int
5
, IsLabel "desc" (NameLabel "desc")
NameLabel "desc"
#desc NameLabel "desc"
-> Text
-> SomeFilter
'["id" ?: 'AutoFilter Int, "desc" ?: 'ManualFilter Text]
forall (name :: Symbol) (params :: [TyNamedFilter]) filter.
MkSomeFilter name filter params params =>
NameLabel name -> filter -> SomeFilter params
?/ Text
"Kek"
, IsLabel "id" (NameLabel "id")
NameLabel "id"
#id NameLabel "id"
-> FilterComparing Int
-> SomeFilter
'["id" ?: 'AutoFilter Int, "desc" ?: 'ManualFilter Text]
forall (name :: Symbol) (params :: [TyNamedFilter]) filter.
MkSomeFilter name filter params params =>
NameLabel name -> filter -> SomeFilter params
?/ Int -> FilterComparing Int
forall a. a -> FilterComparing a
FilterGT Int
3
]