{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedLists  #-}
{-# LANGUAGE TypeInType       #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Helpers for defining filters manually.
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

{- | Build a filtering specification.
Used along with "OverloadedLabels" extension and @($)@ / @($=)@ operators.

Example:

@
filteringSpec :: FilteringSpec ["id" ?: 'AutoFilter Int, "desc" ?: 'ManualFilter Text]
filteringSpec = mkFilteringSpec
    [ -- Constructing an auto filter
    , #id ?/ FilterGT 0

      -- The following two lines are equivalent
    , #id ?/ FilterMatching 5
    , #id ?/= 5

      -- Constructing a manually implemented filter
    , #desc ?/~ "You are my sunshine, my only sunshine"
    ]
@

You can freely use 'GHC.Exts.fromList' instead of this function.
-}
mkFilteringSpec :: [SomeFilter params] -> FilteringSpec params
mkFilteringSpec :: [SomeFilter params] -> FilteringSpec params
mkFilteringSpec = [SomeFilter params] -> FilteringSpec params
forall (params :: [TyNamedFilter]).
[SomeFilter params] -> FilteringSpec params
FilteringSpec

-- | By default 'noFilters' is used.
instance Default (FilteringSpec params) where
    def :: FilteringSpec params
def = FilteringSpec params
forall (params :: [TyNamedFilter]). FilteringSpec params
noFilters

-- | Return all items.
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"
              )
          )

-- | Safely construct 'TypeFilter'.
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

-- | Safely construct 'SomeFilter'.
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

-- | "Filter by" operation.
-- Wraps a filter corresponding to the given name into 'SomeFilter' which can later be
-- passed to 'mkSomeFilter'.
(?/)
    :: 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 ?/

-- | "Filter by matching" operation.
(?/=)
    :: 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 ?/=

-- | Make a comparing filter.
(?/>), (?/<), (?/>=), (?/<=)
    :: 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 ?/<=

-- | Make a simple POSIX regex filter.
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`

-- | Make a simple POSIX regex case-insensitive filter.
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`

-- | Make a filter that checks whether the given text is included.
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`

-- | Make a filter that checks whether the given text is included,
-- case-insensitive.
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`

-- | Construct a (manual) filter from a value with the same representation as expected one.
-- Helpful when newtypes are heavely used in API parameters.
(?/~)
    :: 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
    ]