{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeInType #-}
module Servant.Util.Combinators.Filtering.Base
( FilterKind (..)
, TyNamedFilter
, FilteringParams
, SupportedFilters
, FilteringSpec (..)
, pattern DefFilteringCmd
, SomeTypeAutoFilter (..)
, TypeFilter (..)
, SomeFilter (..)
, extendSomeFilter
, castTypeFilter
, BuildableAutoFilter (..)
, IsAutoFilter (..)
, AreAutoFilters (..)
, FilteringValueParser (..)
, OpsDescriptions
, parseFilteringValueAsIs
, unsupportedFilteringValue
, autoFiltersParsers
, FilteringParamTypesOf
, FilteringParamsOf
, FilteringSpecOf
) where
import Universum
import qualified Data.Map as M
import Data.Typeable (cast)
import Fmt (Buildable (..), Builder)
import GHC.Exts (IsList)
import Servant (FromHttpApiData (..), ToHttpApiData (..))
import Servant.API (NoContent)
import Servant.Util.Common
data FilterKind a
= AutoFilter a
| ManualFilter a
type TyNamedFilter = TyNamedParam (FilterKind Type)
data FilteringParams (params :: [TyNamedFilter])
type family SupportedFilters ty :: [Type -> Type]
pattern DefFilteringCmd :: Text
pattern $bDefFilteringCmd :: Text
$mDefFilteringCmd :: forall r. Text -> (Void# -> r) -> (Void# -> r) -> r
DefFilteringCmd = "eq"
newtype FilteringValueParser a = FilteringValueParser (Text -> Either Text a)
deriving (a -> FilteringValueParser b -> FilteringValueParser a
(a -> b) -> FilteringValueParser a -> FilteringValueParser b
(forall a b.
(a -> b) -> FilteringValueParser a -> FilteringValueParser b)
-> (forall a b.
a -> FilteringValueParser b -> FilteringValueParser a)
-> Functor FilteringValueParser
forall a b. a -> FilteringValueParser b -> FilteringValueParser a
forall a b.
(a -> b) -> FilteringValueParser a -> FilteringValueParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FilteringValueParser b -> FilteringValueParser a
$c<$ :: forall a b. a -> FilteringValueParser b -> FilteringValueParser a
fmap :: (a -> b) -> FilteringValueParser a -> FilteringValueParser b
$cfmap :: forall a b.
(a -> b) -> FilteringValueParser a -> FilteringValueParser b
Functor)
parseFilteringValueAsIs :: FromHttpApiData a => FilteringValueParser a
parseFilteringValueAsIs :: FilteringValueParser a
parseFilteringValueAsIs = (Text -> Either Text a) -> FilteringValueParser a
forall a. (Text -> Either Text a) -> FilteringValueParser a
FilteringValueParser Text -> Either Text a
forall a. FromHttpApiData a => Text -> Either Text a
parseUrlPiece
unsupportedFilteringValue :: Text -> FilteringValueParser a
unsupportedFilteringValue :: Text -> FilteringValueParser a
unsupportedFilteringValue Text
errMsg = (Text -> Either Text a) -> FilteringValueParser a
forall a. (Text -> Either Text a) -> FilteringValueParser a
FilteringValueParser (\Text
_ -> Text -> Either Text a
forall a b. a -> Either a b
Left Text
errMsg)
type OpsDescriptions = [(Text, Text)]
class BuildableAutoFilter (filter :: Type -> Type) where
buildAutoFilter
:: Buildable a => Text -> filter a -> Builder
class (Typeable filter, BuildableAutoFilter filter) =>
IsAutoFilter (filter :: Type -> Type) where
autoFilterEnglishOpsNames
:: OpsDescriptions
autoFilterParsers
:: FromHttpApiData a
=> Proxy filter -> Map Text (FilteringValueParser (filter a))
autoFilterEncode
:: ToHttpApiData a
=> filter a -> (Text, Text)
mapAutoFilterValue
:: (a -> b) -> filter a -> filter b
default mapAutoFilterValue
:: Functor filter => (a -> b) -> filter a -> filter b
mapAutoFilterValue = (a -> b) -> filter a -> filter b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
class AreAutoFilters (filters :: [Type -> Type]) where
mapFilterTypes
:: (forall filter. IsAutoFilter filter => Proxy filter -> a)
-> Proxy filters -> [a]
instance AreAutoFilters '[] where
mapFilterTypes :: (forall (filter :: * -> *).
IsAutoFilter filter =>
Proxy filter -> a)
-> Proxy '[] -> [a]
mapFilterTypes forall (filter :: * -> *). IsAutoFilter filter => Proxy filter -> a
_ Proxy '[]
_ = []
instance (IsAutoFilter filter, AreAutoFilters filters) =>
AreAutoFilters (filter ': filters) where
mapFilterTypes :: (forall (filter :: * -> *).
IsAutoFilter filter =>
Proxy filter -> a)
-> Proxy (filter : filters) -> [a]
mapFilterTypes forall (filter :: * -> *). IsAutoFilter filter => Proxy filter -> a
mapper Proxy (filter : filters)
_ =
Proxy filter -> a
forall (filter :: * -> *). IsAutoFilter filter => Proxy filter -> a
mapper (Proxy filter
forall k (t :: k). Proxy t
Proxy @filter) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (forall (filter :: * -> *).
IsAutoFilter filter =>
Proxy filter -> a)
-> Proxy filters -> [a]
forall (filters :: [* -> *]) a.
AreAutoFilters filters =>
(forall (filter :: * -> *).
IsAutoFilter filter =>
Proxy filter -> a)
-> Proxy filters -> [a]
mapFilterTypes forall (filter :: * -> *). IsAutoFilter filter => Proxy filter -> a
mapper (Proxy filters
forall k (t :: k). Proxy t
Proxy @filters)
autoFiltersParsers
:: forall filters a.
(AreAutoFilters filters, FromHttpApiData a)
=> Map Text $ FilteringValueParser (SomeTypeAutoFilter a)
autoFiltersParsers :: Map Text $ FilteringValueParser (SomeTypeAutoFilter a)
autoFiltersParsers =
let parsers :: [Map Text $ FilteringValueParser (SomeTypeAutoFilter a)]
parsers = (forall (filter :: * -> *).
IsAutoFilter filter =>
Proxy filter
-> Map Text $ FilteringValueParser (SomeTypeAutoFilter a))
-> Proxy filters
-> [Map Text $ FilteringValueParser (SomeTypeAutoFilter a)]
forall (filters :: [* -> *]) a.
AreAutoFilters filters =>
(forall (filter :: * -> *).
IsAutoFilter filter =>
Proxy filter -> a)
-> Proxy filters -> [a]
mapFilterTypes ((FilteringValueParser (filter a)
-> FilteringValueParser (SomeTypeAutoFilter a))
-> Map Text (FilteringValueParser (filter a))
-> Map Text $ FilteringValueParser (SomeTypeAutoFilter a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((filter a -> SomeTypeAutoFilter a)
-> FilteringValueParser (filter a)
-> FilteringValueParser (SomeTypeAutoFilter a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap filter a -> SomeTypeAutoFilter a
forall a (filter :: * -> *).
IsAutoFilter filter =>
filter a -> SomeTypeAutoFilter a
SomeTypeAutoFilter) (Map Text (FilteringValueParser (filter a))
-> Map Text $ FilteringValueParser (SomeTypeAutoFilter a))
-> (Proxy filter -> Map Text (FilteringValueParser (filter a)))
-> Proxy filter
-> Map Text $ FilteringValueParser (SomeTypeAutoFilter a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy filter -> Map Text (FilteringValueParser (filter a))
forall (filter :: * -> *) a.
(IsAutoFilter filter, FromHttpApiData a) =>
Proxy filter -> Map Text (FilteringValueParser (filter a))
autoFilterParsers)
(Proxy filters
forall k (t :: k). Proxy t
Proxy @filters)
in ((Map Text $ FilteringValueParser (SomeTypeAutoFilter a))
-> Element [Map Text $ FilteringValueParser (SomeTypeAutoFilter a)]
-> Map Text $ FilteringValueParser (SomeTypeAutoFilter a))
-> (Map Text $ FilteringValueParser (SomeTypeAutoFilter a))
-> [Map Text $ FilteringValueParser (SomeTypeAutoFilter a)]
-> Map Text $ FilteringValueParser (SomeTypeAutoFilter a)
forall t b. Container t => (b -> Element t -> b) -> b -> t -> b
foldl' ((Text
-> FilteringValueParser (SomeTypeAutoFilter a)
-> FilteringValueParser (SomeTypeAutoFilter a)
-> FilteringValueParser (SomeTypeAutoFilter a))
-> (Map Text $ FilteringValueParser (SomeTypeAutoFilter a))
-> (Map Text $ FilteringValueParser (SomeTypeAutoFilter a))
-> Map Text $ FilteringValueParser (SomeTypeAutoFilter a)
forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWithKey Text
-> FilteringValueParser (SomeTypeAutoFilter a)
-> FilteringValueParser (SomeTypeAutoFilter a)
-> FilteringValueParser (SomeTypeAutoFilter a)
forall a a. Show a => a -> a
onDuplicateCmd) Map Text $ FilteringValueParser (SomeTypeAutoFilter a)
forall a. Monoid a => a
mempty [Map Text $ FilteringValueParser (SomeTypeAutoFilter a)]
parsers
where
onDuplicateCmd :: a -> a
onDuplicateCmd a
cmd = Text -> a
forall a. HasCallStack => Text -> a
error (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Text
"Different filters have the same command " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall b a. (Show a, IsString b) => a -> b
show a
cmd
data SomeTypeAutoFilter a =
forall filter. IsAutoFilter filter => SomeTypeAutoFilter (filter a)
instance Functor SomeTypeAutoFilter where
fmap :: (a -> b) -> SomeTypeAutoFilter a -> SomeTypeAutoFilter b
fmap a -> b
f (SomeTypeAutoFilter filter a
filtr) = filter b -> SomeTypeAutoFilter b
forall a (filter :: * -> *).
IsAutoFilter filter =>
filter a -> SomeTypeAutoFilter a
SomeTypeAutoFilter ((a -> b) -> filter a -> filter b
forall (filter :: * -> *) a b.
IsAutoFilter filter =>
(a -> b) -> filter a -> filter b
mapAutoFilterValue a -> b
f filter a
filtr)
instance Buildable a => Buildable (Text, SomeTypeAutoFilter a) where
build :: (Text, SomeTypeAutoFilter a) -> Builder
build (Text
name, SomeTypeAutoFilter filter a
f) = Text -> filter a -> Builder
forall (filter :: * -> *) a.
(BuildableAutoFilter filter, Buildable a) =>
Text -> filter a -> Builder
buildAutoFilter Text
name filter a
f
data TypeFilter (fk :: Type -> FilterKind Type) a where
TypeAutoFilter
:: SomeTypeAutoFilter a -> TypeFilter 'AutoFilter a
TypeManualFilter
:: a -> TypeFilter 'ManualFilter a
castTypeFilter
:: forall fk1 a1 fk2 a2.
(Typeable fk1, Typeable a1, Typeable fk2, Typeable a2)
=> TypeFilter fk1 a1 -> Maybe (TypeFilter fk2 a2)
castTypeFilter :: TypeFilter fk1 a1 -> Maybe (TypeFilter fk2 a2)
castTypeFilter = TypeFilter fk1 a1 -> Maybe (TypeFilter fk2 a2)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast
data SomeFilter (params :: [TyNamedFilter]) where
SomeFilter :: (Typeable fk, Typeable a) =>
{ SomeFilter params -> Text
sfName :: Text
, ()
sfFilter :: TypeFilter fk a
} -> SomeFilter params
extendSomeFilter :: SomeFilter params -> SomeFilter (param ': params)
extendSomeFilter :: SomeFilter params -> SomeFilter (param : params)
extendSomeFilter (SomeFilter Text
f TypeFilter fk a
n) = Text -> TypeFilter fk a -> SomeFilter (param : params)
forall (fk :: * -> FilterKind *) a (params :: [TyNamedFilter]).
(Typeable fk, Typeable a) =>
Text -> TypeFilter fk a -> SomeFilter params
SomeFilter Text
f TypeFilter fk a
n
newtype FilteringSpec (params :: [TyNamedFilter]) = FilteringSpec [SomeFilter params]
deriving (Int -> [Item (FilteringSpec params)] -> FilteringSpec params
[Item (FilteringSpec params)] -> FilteringSpec params
FilteringSpec params -> [Item (FilteringSpec params)]
([Item (FilteringSpec params)] -> FilteringSpec params)
-> (Int -> [Item (FilteringSpec params)] -> FilteringSpec params)
-> (FilteringSpec params -> [Item (FilteringSpec params)])
-> IsList (FilteringSpec params)
forall (params :: [TyNamedFilter]).
Int -> [Item (FilteringSpec params)] -> FilteringSpec params
forall (params :: [TyNamedFilter]).
[Item (FilteringSpec params)] -> FilteringSpec params
forall (params :: [TyNamedFilter]).
FilteringSpec params -> [Item (FilteringSpec params)]
forall l.
([Item l] -> l)
-> (Int -> [Item l] -> l) -> (l -> [Item l]) -> IsList l
toList :: FilteringSpec params -> [Item (FilteringSpec params)]
$ctoList :: forall (params :: [TyNamedFilter]).
FilteringSpec params -> [Item (FilteringSpec params)]
fromListN :: Int -> [Item (FilteringSpec params)] -> FilteringSpec params
$cfromListN :: forall (params :: [TyNamedFilter]).
Int -> [Item (FilteringSpec params)] -> FilteringSpec params
fromList :: [Item (FilteringSpec params)] -> FilteringSpec params
$cfromList :: forall (params :: [TyNamedFilter]).
[Item (FilteringSpec params)] -> FilteringSpec params
IsList)
type family FilteringParamTypesOf a :: [TyNamedFilter]
type FilteringParamsOf a = FilteringParams (FilteringParamTypesOf a)
type FilteringSpecOf a = FilteringSpec (FilteringParamTypesOf a)
type instance FilteringParamTypesOf NoContent = '[]