{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module MSU.Match
( Match(..)
, matches
, matchesMaybe
)
where
import Control.Applicative ((<|>))
import Data.Aeson
import Data.Maybe (fromMaybe)
data Match a
= Any
| Eq a
| In [a]
instance FromJSON a => FromJSON (Match a) where
parseJSON :: Value -> Parser (Match a)
parseJSON = String -> (Object -> Parser (Match a)) -> Value -> Parser (Match a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"match operator" ((Object -> Parser (Match a)) -> Value -> Parser (Match a))
-> (Object -> Parser (Match a)) -> Value -> Parser (Match a)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Maybe a
mEq <- Object
o Object -> Key -> Parser (Maybe a)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"eq"
Maybe [a]
mIn <- Object
o Object -> Key -> Parser (Maybe [a])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"in"
Match a -> Parser (Match a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Match a -> Parser (Match a)) -> Match a -> Parser (Match a)
forall a b. (a -> b) -> a -> b
$ Match a -> Maybe (Match a) -> Match a
forall a. a -> Maybe a -> a
fromMaybe Match a
forall a. Match a
Any (Maybe (Match a) -> Match a) -> Maybe (Match a) -> Match a
forall a b. (a -> b) -> a -> b
$ (a -> Match a
forall a. a -> Match a
Eq (a -> Match a) -> Maybe a -> Maybe (Match a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mEq) Maybe (Match a) -> Maybe (Match a) -> Maybe (Match a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([a] -> Match a
forall a. [a] -> Match a
In ([a] -> Match a) -> Maybe [a] -> Maybe (Match a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [a]
mIn)
instance ToJSON a => ToJSON (Match a) where
toJSON :: Match a -> Value
toJSON = \case
Match a
Any -> Value
Null
Eq a
a -> [Pair] -> Value
object [Key
"eq" Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a
a]
In [a]
as -> [Pair] -> Value
object [Key
"in" Key -> [a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [a]
as]
matches :: Eq a => Maybe (Match a) -> a -> Bool
matches :: Maybe (Match a) -> a -> Bool
matches = Match a -> a -> Bool
forall a. Eq a => Match a -> a -> Bool
matchFn (Match a -> a -> Bool)
-> (Maybe (Match a) -> Match a) -> Maybe (Match a) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match a -> Maybe (Match a) -> Match a
forall a. a -> Maybe a -> a
fromMaybe Match a
forall a. Match a
Any
matchesMaybe :: Eq a => Maybe (Match a) -> Maybe a -> Bool
matchesMaybe :: Maybe (Match a) -> Maybe a -> Bool
matchesMaybe Maybe (Match a)
mm = Bool -> (a -> Bool) -> Maybe a -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Maybe (Match a)
mm Maybe (Match a) -> a -> Bool
forall a. Eq a => Maybe (Match a) -> a -> Bool
`matches`)
matchFn :: Eq a => Match a -> a -> Bool
matchFn :: Match a -> a -> Bool
matchFn = \case
Match a
Any -> Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True
Eq a
a -> (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a)
In [a]
as -> (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
as)