{-# LANGUAGE OverloadedStrings #-}

module Database.Bloodhound.Internal.Versions.Common.Types.Query.Regexp
  ( Regexp (..),
    RegexpFlag (..),
    RegexpFlags (..),
    RegexpQuery (..),
  )
where

import qualified Data.Text as T
import Database.Bloodhound.Internal.Utils.Imports
import Database.Bloodhound.Internal.Versions.Common.Types.Newtypes
import Database.Bloodhound.Internal.Versions.Common.Types.Query.Commons
import GHC.Generics

data RegexpQuery = RegexpQuery
  { RegexpQuery -> FieldName
regexpQueryField :: FieldName,
    RegexpQuery -> Regexp
regexpQuery :: Regexp,
    RegexpQuery -> RegexpFlags
regexpQueryFlags :: RegexpFlags,
    RegexpQuery -> Maybe Boost
regexpQueryBoost :: Maybe Boost
  }
  deriving stock (RegexpQuery -> RegexpQuery -> Bool
(RegexpQuery -> RegexpQuery -> Bool)
-> (RegexpQuery -> RegexpQuery -> Bool) -> Eq RegexpQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegexpQuery -> RegexpQuery -> Bool
== :: RegexpQuery -> RegexpQuery -> Bool
$c/= :: RegexpQuery -> RegexpQuery -> Bool
/= :: RegexpQuery -> RegexpQuery -> Bool
Eq, Int -> RegexpQuery -> ShowS
[RegexpQuery] -> ShowS
RegexpQuery -> String
(Int -> RegexpQuery -> ShowS)
-> (RegexpQuery -> String)
-> ([RegexpQuery] -> ShowS)
-> Show RegexpQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegexpQuery -> ShowS
showsPrec :: Int -> RegexpQuery -> ShowS
$cshow :: RegexpQuery -> String
show :: RegexpQuery -> String
$cshowList :: [RegexpQuery] -> ShowS
showList :: [RegexpQuery] -> ShowS
Show, (forall x. RegexpQuery -> Rep RegexpQuery x)
-> (forall x. Rep RegexpQuery x -> RegexpQuery)
-> Generic RegexpQuery
forall x. Rep RegexpQuery x -> RegexpQuery
forall x. RegexpQuery -> Rep RegexpQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RegexpQuery -> Rep RegexpQuery x
from :: forall x. RegexpQuery -> Rep RegexpQuery x
$cto :: forall x. Rep RegexpQuery x -> RegexpQuery
to :: forall x. Rep RegexpQuery x -> RegexpQuery
Generic)

instance ToJSON RegexpQuery where
  toJSON :: RegexpQuery -> Value
toJSON
    ( RegexpQuery
        (FieldName Text
rqQueryField)
        (Regexp Text
regexpQueryQuery)
        RegexpFlags
rqQueryFlags
        Maybe Boost
rqQueryBoost
      ) =
      [Pair] -> Value
object [Text -> Key
fromText Text
rqQueryField Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
omitNulls [Pair]
base]
      where
        base :: [Pair]
base =
          [ Key
"value" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
regexpQueryQuery,
            Key
"flags" Key -> RegexpFlags -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RegexpFlags
rqQueryFlags,
            Key
"boost" Key -> Maybe Boost -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Boost
rqQueryBoost
          ]

instance FromJSON RegexpQuery where
  parseJSON :: Value -> Parser RegexpQuery
parseJSON = String
-> (Object -> Parser RegexpQuery) -> Value -> Parser RegexpQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RegexpQuery" Object -> Parser RegexpQuery
parse
    where
      parse :: Object -> Parser RegexpQuery
parse = (FieldName -> Object -> Parser RegexpQuery)
-> Object -> Parser RegexpQuery
forall (m :: * -> *) a.
(Monad m, MonadFail m) =>
(FieldName -> Object -> m a) -> Object -> m a
fieldTagged ((FieldName -> Object -> Parser RegexpQuery)
 -> Object -> Parser RegexpQuery)
-> (FieldName -> Object -> Parser RegexpQuery)
-> Object
-> Parser RegexpQuery
forall a b. (a -> b) -> a -> b
$ \FieldName
fn Object
o ->
        FieldName -> Regexp -> RegexpFlags -> Maybe Boost -> RegexpQuery
RegexpQuery FieldName
fn
          (Regexp -> RegexpFlags -> Maybe Boost -> RegexpQuery)
-> Parser Regexp
-> Parser (RegexpFlags -> Maybe Boost -> RegexpQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Regexp
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
          Parser (RegexpFlags -> Maybe Boost -> RegexpQuery)
-> Parser RegexpFlags -> Parser (Maybe Boost -> RegexpQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser RegexpFlags
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"flags"
          Parser (Maybe Boost -> RegexpQuery)
-> Parser (Maybe Boost) -> Parser RegexpQuery
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Boost)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"boost"

newtype Regexp = Regexp Text deriving newtype (Regexp -> Regexp -> Bool
(Regexp -> Regexp -> Bool)
-> (Regexp -> Regexp -> Bool) -> Eq Regexp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Regexp -> Regexp -> Bool
== :: Regexp -> Regexp -> Bool
$c/= :: Regexp -> Regexp -> Bool
/= :: Regexp -> Regexp -> Bool
Eq, Int -> Regexp -> ShowS
[Regexp] -> ShowS
Regexp -> String
(Int -> Regexp -> ShowS)
-> (Regexp -> String) -> ([Regexp] -> ShowS) -> Show Regexp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Regexp -> ShowS
showsPrec :: Int -> Regexp -> ShowS
$cshow :: Regexp -> String
show :: Regexp -> String
$cshowList :: [Regexp] -> ShowS
showList :: [Regexp] -> ShowS
Show, Maybe Regexp
Value -> Parser [Regexp]
Value -> Parser Regexp
(Value -> Parser Regexp)
-> (Value -> Parser [Regexp]) -> Maybe Regexp -> FromJSON Regexp
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Regexp
parseJSON :: Value -> Parser Regexp
$cparseJSONList :: Value -> Parser [Regexp]
parseJSONList :: Value -> Parser [Regexp]
$comittedField :: Maybe Regexp
omittedField :: Maybe Regexp
FromJSON)

data RegexpFlags
  = AllRegexpFlags
  | NoRegexpFlags
  | SomeRegexpFlags (NonEmpty RegexpFlag)
  deriving stock (RegexpFlags -> RegexpFlags -> Bool
(RegexpFlags -> RegexpFlags -> Bool)
-> (RegexpFlags -> RegexpFlags -> Bool) -> Eq RegexpFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegexpFlags -> RegexpFlags -> Bool
== :: RegexpFlags -> RegexpFlags -> Bool
$c/= :: RegexpFlags -> RegexpFlags -> Bool
/= :: RegexpFlags -> RegexpFlags -> Bool
Eq, Int -> RegexpFlags -> ShowS
[RegexpFlags] -> ShowS
RegexpFlags -> String
(Int -> RegexpFlags -> ShowS)
-> (RegexpFlags -> String)
-> ([RegexpFlags] -> ShowS)
-> Show RegexpFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegexpFlags -> ShowS
showsPrec :: Int -> RegexpFlags -> ShowS
$cshow :: RegexpFlags -> String
show :: RegexpFlags -> String
$cshowList :: [RegexpFlags] -> ShowS
showList :: [RegexpFlags] -> ShowS
Show, (forall x. RegexpFlags -> Rep RegexpFlags x)
-> (forall x. Rep RegexpFlags x -> RegexpFlags)
-> Generic RegexpFlags
forall x. Rep RegexpFlags x -> RegexpFlags
forall x. RegexpFlags -> Rep RegexpFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RegexpFlags -> Rep RegexpFlags x
from :: forall x. RegexpFlags -> Rep RegexpFlags x
$cto :: forall x. Rep RegexpFlags x -> RegexpFlags
to :: forall x. Rep RegexpFlags x -> RegexpFlags
Generic)

instance ToJSON RegexpFlags where
  toJSON :: RegexpFlags -> Value
toJSON RegexpFlags
AllRegexpFlags = Text -> Value
String Text
"ALL"
  toJSON RegexpFlags
NoRegexpFlags = Text -> Value
String Text
"NONE"
  toJSON (SomeRegexpFlags (RegexpFlag
h :| [RegexpFlag]
fs)) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"|" [Text]
flagStrs
    where
      flagStrs :: [Text]
flagStrs = (RegexpFlag -> Text) -> [RegexpFlag] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map RegexpFlag -> Text
forall {a}. IsString a => RegexpFlag -> a
flagStr ([RegexpFlag] -> [Text])
-> ([RegexpFlag] -> [RegexpFlag]) -> [RegexpFlag] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RegexpFlag] -> [RegexpFlag]
forall a. Eq a => [a] -> [a]
nub ([RegexpFlag] -> [Text]) -> [RegexpFlag] -> [Text]
forall a b. (a -> b) -> a -> b
$ RegexpFlag
h RegexpFlag -> [RegexpFlag] -> [RegexpFlag]
forall a. a -> [a] -> [a]
: [RegexpFlag]
fs
      flagStr :: RegexpFlag -> a
flagStr RegexpFlag
AnyString = a
"ANYSTRING"
      flagStr RegexpFlag
Automaton = a
"AUTOMATON"
      flagStr RegexpFlag
Complement = a
"COMPLEMENT"
      flagStr RegexpFlag
Empty = a
"EMPTY"
      flagStr RegexpFlag
Intersection = a
"INTERSECTION"
      flagStr RegexpFlag
Interval = a
"INTERVAL"

instance FromJSON RegexpFlags where
  parseJSON :: Value -> Parser RegexpFlags
parseJSON = String
-> (Text -> Parser RegexpFlags) -> Value -> Parser RegexpFlags
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"RegexpFlags" Text -> Parser RegexpFlags
parse
    where
      parse :: Text -> Parser RegexpFlags
parse Text
"ALL" = RegexpFlags -> Parser RegexpFlags
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RegexpFlags
AllRegexpFlags
      parse Text
"NONE" = RegexpFlags -> Parser RegexpFlags
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RegexpFlags
NoRegexpFlags
      parse Text
t = NonEmpty RegexpFlag -> RegexpFlags
SomeRegexpFlags (NonEmpty RegexpFlag -> RegexpFlags)
-> Parser (NonEmpty RegexpFlag) -> Parser RegexpFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value] -> Parser (NonEmpty RegexpFlag)
forall a. FromJSON a => [Value] -> Parser (NonEmpty a)
parseNEJSON (Text -> Value
String (Text -> Value) -> [Text] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"|" Text
t)

data RegexpFlag
  = AnyString
  | Automaton
  | Complement
  | Empty
  | Intersection
  | Interval
  deriving stock (RegexpFlag -> RegexpFlag -> Bool
(RegexpFlag -> RegexpFlag -> Bool)
-> (RegexpFlag -> RegexpFlag -> Bool) -> Eq RegexpFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegexpFlag -> RegexpFlag -> Bool
== :: RegexpFlag -> RegexpFlag -> Bool
$c/= :: RegexpFlag -> RegexpFlag -> Bool
/= :: RegexpFlag -> RegexpFlag -> Bool
Eq, Int -> RegexpFlag -> ShowS
[RegexpFlag] -> ShowS
RegexpFlag -> String
(Int -> RegexpFlag -> ShowS)
-> (RegexpFlag -> String)
-> ([RegexpFlag] -> ShowS)
-> Show RegexpFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegexpFlag -> ShowS
showsPrec :: Int -> RegexpFlag -> ShowS
$cshow :: RegexpFlag -> String
show :: RegexpFlag -> String
$cshowList :: [RegexpFlag] -> ShowS
showList :: [RegexpFlag] -> ShowS
Show, (forall x. RegexpFlag -> Rep RegexpFlag x)
-> (forall x. Rep RegexpFlag x -> RegexpFlag) -> Generic RegexpFlag
forall x. Rep RegexpFlag x -> RegexpFlag
forall x. RegexpFlag -> Rep RegexpFlag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RegexpFlag -> Rep RegexpFlag x
from :: forall x. RegexpFlag -> Rep RegexpFlag x
$cto :: forall x. Rep RegexpFlag x -> RegexpFlag
to :: forall x. Rep RegexpFlag x -> RegexpFlag
Generic)

instance FromJSON RegexpFlag where
  parseJSON :: Value -> Parser RegexpFlag
parseJSON = String -> (Text -> Parser RegexpFlag) -> Value -> Parser RegexpFlag
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"RegexpFlag" Text -> Parser RegexpFlag
forall {a} {f :: * -> *}.
(Eq a, IsString a, MonadFail f, Show a) =>
a -> f RegexpFlag
parse
    where
      parse :: a -> f RegexpFlag
parse a
"ANYSTRING" = RegexpFlag -> f RegexpFlag
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RegexpFlag
AnyString
      parse a
"AUTOMATON" = RegexpFlag -> f RegexpFlag
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RegexpFlag
Automaton
      parse a
"COMPLEMENT" = RegexpFlag -> f RegexpFlag
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RegexpFlag
Complement
      parse a
"EMPTY" = RegexpFlag -> f RegexpFlag
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RegexpFlag
Empty
      parse a
"INTERSECTION" = RegexpFlag -> f RegexpFlag
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RegexpFlag
Intersection
      parse a
"INTERVAL" = RegexpFlag -> f RegexpFlag
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RegexpFlag
Interval
      parse a
f = String -> f RegexpFlag
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown RegexpFlag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
f)