{- | Implements plain filtering.

Example:

@
filteringSpecApp
    :: MyObject
    -> FilteringSpecApp
        DummyFilteringBackend
        [ "id" ?: 'AutoFilter Course
        , "desc" ?: 'AutoFilter Text
        , "isAwesome" ?: 'ManualFilter Bool
        ]
filteringSpecApp obj =
    filterOn_ @"id" (id obj) .*.
    filterOn_ @"desc" (desc obj) .*.
    customFilter_ @"isAwesome" (== (awesomeness obj > 42)) .*.
    HNil
@

Annotating 'filterOn' and 'customFilter' calls with parameter name is fully optional
and used only to visually disambiguate filters of the same types.

Next, you use `matches` to check whether a value matches user-provided filters.

@
filterObjects filters = filter (matches filters . filteringSpecApp) allObjects
@

-}
module Servant.Util.Dummy.Filtering
    ( matches
    , filterBySpec
    , filterOn
    , manualFilter
    ) where

import Universum

import Data.Bits ((.|.))
import qualified Text.Regex.Posix as R
import qualified Text.Regex.Posix.String as RS

import Servant.Util.Combinators.Filtering.Backend
import Servant.Util.Combinators.Filtering.Base
import Servant.Util.Combinators.Filtering.Filters

-- | Implements filters via Beam query expressions ('QExpr').
data DummyFilteringBackend

instance FilterBackend DummyFilteringBackend where
    type AutoFilteredValue DummyFilteringBackend a = a
    type MatchPredicate DummyFilteringBackend = Bool

instance Eq a => AutoFilterSupport DummyFilteringBackend FilterMatching a where
    autoFilterSupport :: FilterMatching a -> AutoFilterImpl DummyFilteringBackend a
autoFilterSupport = \case
        FilterMatching a
v    -> (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v)
        FilterNotMatching a
v -> (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
v)
        FilterItemsIn [a]
vs    -> (Element [a] -> [a] -> Bool
forall t. (Container t, Eq (Element t)) => Element t -> t -> Bool
`elem` [a]
vs)

instance Ord a => AutoFilterSupport DummyFilteringBackend FilterComparing a where
    autoFilterSupport :: FilterComparing a -> AutoFilterImpl DummyFilteringBackend a
autoFilterSupport = \case
        FilterGT a
v  -> (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
v)
        FilterLT a
v  -> (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
v)
        FilterGTE a
v -> (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
v)
        FilterLTE a
v -> (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
v)

-- | Supported only for trivial cases yet.
instance ToString s => AutoFilterSupport DummyFilteringBackend FilterLike s where
    autoFilterSupport :: FilterLike s -> AutoFilterImpl DummyFilteringBackend s
autoFilterSupport
      (FilterLike (CaseSensitivity Bool
cs) (LikePatternUnsafe (LText -> String
forall a. ToString a => a -> String
toString -> String
pat))) =
      \(AutoFilteredValue DummyFilteringBackend s -> String
forall a. ToString a => a -> String
toString -> String
txt) -> Maybe () -> Bool
forall a. Maybe a -> Bool
isJust @() (Maybe () -> Bool) -> Maybe () -> Bool
forall a b. (a -> b) -> a -> b
$ do
        let compOpts :: CompOption
compOpts = CompOption
RS.compBlank
                CompOption -> (CompOption -> CompOption) -> CompOption
forall a b. a -> (a -> b) -> b
& if Bool
cs then CompOption -> CompOption
forall a. a -> a
id else (CompOption -> CompOption -> CompOption
forall a. Bits a => a -> a -> a
.|. CompOption
RS.compIgnoreCase)
        -- TODO: report this to servant parser
        Regex
regex <- CompOption -> ExecOption -> String -> Maybe Regex
forall regex compOpt execOpt source (m :: * -> *).
(RegexMaker regex compOpt execOpt source, MonadFail m) =>
compOpt -> execOpt -> source -> m regex
R.makeRegexOptsM CompOption
compOpts ExecOption
RS.execBlank (String -> String
transformPat String
pat)
        Regex -> String -> Maybe ()
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
R.matchM Regex
regex String
txt
      where
        transformPat :: String -> String
transformPat String
s = Char
'^' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
replacePatChars String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$"
        replacePatChars :: String -> String
replacePatChars = \case
          []      -> []
          Char
'*' : String
s -> Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'*' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
replacePatChars String
s
          Char
c : String
s   -> Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
replacePatChars String
s

-- | Applies a whole filtering specification to a set of response fields.
-- Resulting value can be put to 'filter' function.
matches
    :: ( backend ~ DummyFilteringBackend
       , BackendApplySomeFilter backend params
       )
    => FilteringSpec params
    -> FilteringSpecApp backend params
    -> Bool
matches :: FilteringSpec params -> FilteringSpecApp backend params -> Bool
matches = [Bool] -> Bool
forall t. (Container t, Element t ~ Bool) => t -> Bool
and ([Bool] -> Bool)
-> (FilteringSpec params
    -> FilteringSpecApp DummyFilteringBackend params -> [Bool])
-> FilteringSpec params
-> FilteringSpecApp backend params
-> Bool
forall a b c. SuperComposition a b c => a -> b -> c
... FilteringSpec params
-> FilteringSpecApp DummyFilteringBackend params -> [Bool]
forall k (backend :: k) (params :: [TyNamedFilter]).
BackendApplySomeFilter backend params =>
FilteringSpec params
-> FilteringSpecApp backend params -> [MatchPredicate backend]
backendApplyFilters

-- | Filters given values by a filtering specification.
filterBySpec
    :: ( backend ~ DummyFilteringBackend
       , BackendApplySomeFilter backend params
       )
    => FilteringSpec params
    -> (a -> FilteringSpecApp backend params)
    -> [a]
    -> [a]
filterBySpec :: FilteringSpec params
-> (a -> FilteringSpecApp backend params) -> [a] -> [a]
filterBySpec FilteringSpec params
spec a -> FilteringSpecApp backend params
mkApp = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilteringSpec params -> FilteringSpecApp backend params -> Bool
forall backend (params :: [TyNamedFilter]).
(backend ~ DummyFilteringBackend,
 BackendApplySomeFilter backend params) =>
FilteringSpec params -> FilteringSpecApp backend params -> Bool
matches FilteringSpec params
spec (FilteringSpecApp backend params -> Bool)
-> (a -> FilteringSpecApp backend params) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FilteringSpecApp backend params
mkApp)