{-# LANGUAGE TypeInType #-}

-- | Filter getters.
--
-- Allows to get a value passed by user to a manual filter.
-- Extracing auto filters is not allowed as soon as they are too complex
-- to make anything useful with them anyway.
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")

-- | Extract a value from manual filter.
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) =
    -- Probably this function should return @Maybe filter@ instead,
    -- but that requires some work (prohibiting specifying the same
    -- manual filter twice in server and in manual filters construction),
    -- and use cases for this getter are not clear yet.

    [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"