{-# LANGUAGE DeriveFunctor #-}

module Servant.Util.Combinators.Filtering.Filters.General
    ( FilterMatching (..)
    , FilterComparing (..)
    ) where

import Universum

import qualified Data.Map as M
import qualified Data.Text as T
import Fmt (build, listF)
import Servant (FromHttpApiData (..), ToHttpApiData (..))

import Servant.Util.Combinators.Filtering.Base

-------------------------------------------------------------------------
-- Filter types
-------------------------------------------------------------------------

-- | Support for @(==)@, @(/=)@ and @IN <values list>@ operations.
data FilterMatching a
    = FilterMatching a
    | FilterNotMatching a
    | FilterItemsIn [a]
    deriving (a -> FilterMatching b -> FilterMatching a
(a -> b) -> FilterMatching a -> FilterMatching b
(forall a b. (a -> b) -> FilterMatching a -> FilterMatching b)
-> (forall a b. a -> FilterMatching b -> FilterMatching a)
-> Functor FilterMatching
forall a b. a -> FilterMatching b -> FilterMatching a
forall a b. (a -> b) -> FilterMatching a -> FilterMatching b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FilterMatching b -> FilterMatching a
$c<$ :: forall a b. a -> FilterMatching b -> FilterMatching a
fmap :: (a -> b) -> FilterMatching a -> FilterMatching b
$cfmap :: forall a b. (a -> b) -> FilterMatching a -> FilterMatching b
Functor)

instance BuildableAutoFilter FilterMatching where
    buildAutoFilter :: Text -> FilterMatching a -> Builder
buildAutoFilter Text
name = \case
        FilterMatching a
v    -> Text -> Builder
forall p. Buildable p => p -> Builder
build Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" = " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall p. Buildable p => p -> Builder
build a
v
        FilterNotMatching a
v -> Text -> Builder
forall p. Buildable p => p -> Builder
build Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" /= " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall p. Buildable p => p -> Builder
build a
v
        FilterItemsIn [a]
v     -> Text -> Builder
forall p. Buildable p => p -> Builder
build Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" ∊ " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [a] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
listF [a]
v

instance IsAutoFilter FilterMatching where
    autoFilterEnglishOpsNames :: OpsDescriptions
autoFilterEnglishOpsNames =
        [ (Text
DefFilteringCmd, Text
"is equal to, _default operation_")
        , (Text
"neq", Text
"is not equal to")
        , (Text
"in", Text
"is one of")
        ]

    autoFilterParsers :: Proxy FilterMatching
-> Map Text (FilteringValueParser (FilterMatching a))
autoFilterParsers Proxy FilterMatching
_ = [(Text, FilteringValueParser (FilterMatching a))]
-> Map Text (FilteringValueParser (FilterMatching a))
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
        [ ( Text
DefFilteringCmd
          , a -> FilterMatching a
forall a. a -> FilterMatching a
FilterMatching (a -> FilterMatching a)
-> FilteringValueParser a
-> FilteringValueParser (FilterMatching a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilteringValueParser a
forall a. FromHttpApiData a => FilteringValueParser a
parseFilteringValueAsIs
          )
        , ( Text
"neq"
          , a -> FilterMatching a
forall a. a -> FilterMatching a
FilterNotMatching (a -> FilterMatching a)
-> FilteringValueParser a
-> FilteringValueParser (FilterMatching a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilteringValueParser a
forall a. FromHttpApiData a => FilteringValueParser a
parseFilteringValueAsIs
          )
        , ( Text
"in"
          , [a] -> FilterMatching a
forall a. [a] -> FilterMatching a
FilterItemsIn ([a] -> FilterMatching a)
-> FilteringValueParser [a]
-> FilteringValueParser (FilterMatching a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Either Text [a]) -> FilteringValueParser [a]
forall a. (Text -> Either Text a) -> FilteringValueParser a
FilteringValueParser Text -> Either Text [a]
forall b. FromHttpApiData b => Text -> Either Text [b]
parseValuesList
          )
        ]
      where
        parseValuesList :: Text -> Either Text [b]
parseValuesList Text
text = do
            Text
text' <- Text -> Maybe Text -> Either Text Text
forall l r. l -> Maybe r -> Either l r
maybeToRight (Text
"Expected comma-separated list within '[]'") (Maybe Text -> Either Text Text) -> Maybe Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$
                Text -> Text -> Maybe Text
T.stripPrefix Text
"[" Text
text Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Text -> Maybe Text
T.stripSuffix Text
"]"
            let vals :: [Text]
vals = Text -> Text -> [Text]
T.splitOn Text
"," Text
text'
            (Text -> Either Text b) -> [Text] -> Either Text [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Either Text b
forall a. FromHttpApiData a => Text -> Either Text a
parseUrlPiece [Text]
vals

    autoFilterEncode :: FilterMatching a -> (Text, Text)
autoFilterEncode = \case
        FilterMatching a
v    -> (Text
DefFilteringCmd, a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam a
v)
        FilterNotMatching a
v -> (Text
"neq", a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam a
v)
        FilterItemsIn [a]
vs    -> (Text
"in", Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," ((a -> Text) -> [a] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam [a]
vs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")


-- | Support for @(<)@, @(>)@, @(<=)@ and @(>=)@ operations.
data FilterComparing a
    = FilterGT a
    | FilterLT a
    | FilterGTE a
    | FilterLTE a
    deriving (a -> FilterComparing b -> FilterComparing a
(a -> b) -> FilterComparing a -> FilterComparing b
(forall a b. (a -> b) -> FilterComparing a -> FilterComparing b)
-> (forall a b. a -> FilterComparing b -> FilterComparing a)
-> Functor FilterComparing
forall a b. a -> FilterComparing b -> FilterComparing a
forall a b. (a -> b) -> FilterComparing a -> FilterComparing b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FilterComparing b -> FilterComparing a
$c<$ :: forall a b. a -> FilterComparing b -> FilterComparing a
fmap :: (a -> b) -> FilterComparing a -> FilterComparing b
$cfmap :: forall a b. (a -> b) -> FilterComparing a -> FilterComparing b
Functor)

instance BuildableAutoFilter FilterComparing where
    buildAutoFilter :: Text -> FilterComparing a -> Builder
buildAutoFilter Text
name = \case
        FilterGT a
v  -> Text -> Builder
forall p. Buildable p => p -> Builder
build Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" > " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall p. Buildable p => p -> Builder
build a
v
        FilterLT a
v  -> Text -> Builder
forall p. Buildable p => p -> Builder
build Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" < " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall p. Buildable p => p -> Builder
build a
v
        FilterGTE a
v -> Text -> Builder
forall p. Buildable p => p -> Builder
build Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" >= " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall p. Buildable p => p -> Builder
build a
v
        FilterLTE a
v -> Text -> Builder
forall p. Buildable p => p -> Builder
build Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" <= " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall p. Buildable p => p -> Builder
build a
v

instance IsAutoFilter FilterComparing where
    autoFilterEnglishOpsNames :: OpsDescriptions
autoFilterEnglishOpsNames =
        [ (Text
"gt", Text
"is greater")
        , (Text
"lt", Text
"is less")
        , (Text
"gte", Text
"is greater or equal")
        , (Text
"lte", Text
"is less or equal")
        ]

    autoFilterParsers :: Proxy FilterComparing
-> Map Text (FilteringValueParser (FilterComparing a))
autoFilterParsers Proxy FilterComparing
_ = [(Text, FilteringValueParser (FilterComparing a))]
-> Map Text (FilteringValueParser (FilterComparing a))
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
        [ ( Text
"gt"
          , a -> FilterComparing a
forall a. a -> FilterComparing a
FilterGT (a -> FilterComparing a)
-> FilteringValueParser a
-> FilteringValueParser (FilterComparing a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilteringValueParser a
forall a. FromHttpApiData a => FilteringValueParser a
parseFilteringValueAsIs
          )
        , ( Text
"lt"
          , a -> FilterComparing a
forall a. a -> FilterComparing a
FilterLT (a -> FilterComparing a)
-> FilteringValueParser a
-> FilteringValueParser (FilterComparing a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilteringValueParser a
forall a. FromHttpApiData a => FilteringValueParser a
parseFilteringValueAsIs
          )
        , ( Text
"gte"
          , a -> FilterComparing a
forall a. a -> FilterComparing a
FilterGTE (a -> FilterComparing a)
-> FilteringValueParser a
-> FilteringValueParser (FilterComparing a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilteringValueParser a
forall a. FromHttpApiData a => FilteringValueParser a
parseFilteringValueAsIs
          )
        , ( Text
"lte"
          , a -> FilterComparing a
forall a. a -> FilterComparing a
FilterLTE (a -> FilterComparing a)
-> FilteringValueParser a
-> FilteringValueParser (FilterComparing a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilteringValueParser a
forall a. FromHttpApiData a => FilteringValueParser a
parseFilteringValueAsIs
          )
        ]

    autoFilterEncode :: FilterComparing a -> (Text, Text)
autoFilterEncode = \case
        FilterGT a
v  -> (Text
"gt", a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam a
v)
        FilterLT a
v  -> (Text
"lt", a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam a
v)
        FilterGTE a
v -> (Text
"gte", a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam a
v)
        FilterLTE a
v -> (Text
"lte", a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam a
v)


-------------------------------------------------------------------------
-- Basic filters support
-------------------------------------------------------------------------