{-# LANGUAGE OverloadedStrings #-}

module Database.Bloodhound.Internal.Versions.Common.Types.Query.Wildcard
  ( WildcardQuery (..),
  )
where

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 WildcardQuery = WildcardQuery
  { WildcardQuery -> FieldName
wildcardQueryField :: FieldName,
    WildcardQuery -> Key
wildcardQuery :: Key,
    WildcardQuery -> Maybe Boost
wildcardQueryBoost :: Maybe Boost
  }
  deriving stock (WildcardQuery -> WildcardQuery -> Bool
(WildcardQuery -> WildcardQuery -> Bool)
-> (WildcardQuery -> WildcardQuery -> Bool) -> Eq WildcardQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WildcardQuery -> WildcardQuery -> Bool
== :: WildcardQuery -> WildcardQuery -> Bool
$c/= :: WildcardQuery -> WildcardQuery -> Bool
/= :: WildcardQuery -> WildcardQuery -> Bool
Eq, Int -> WildcardQuery -> ShowS
[WildcardQuery] -> ShowS
WildcardQuery -> String
(Int -> WildcardQuery -> ShowS)
-> (WildcardQuery -> String)
-> ([WildcardQuery] -> ShowS)
-> Show WildcardQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WildcardQuery -> ShowS
showsPrec :: Int -> WildcardQuery -> ShowS
$cshow :: WildcardQuery -> String
show :: WildcardQuery -> String
$cshowList :: [WildcardQuery] -> ShowS
showList :: [WildcardQuery] -> ShowS
Show, (forall x. WildcardQuery -> Rep WildcardQuery x)
-> (forall x. Rep WildcardQuery x -> WildcardQuery)
-> Generic WildcardQuery
forall x. Rep WildcardQuery x -> WildcardQuery
forall x. WildcardQuery -> Rep WildcardQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WildcardQuery -> Rep WildcardQuery x
from :: forall x. WildcardQuery -> Rep WildcardQuery x
$cto :: forall x. Rep WildcardQuery x -> WildcardQuery
to :: forall x. Rep WildcardQuery x -> WildcardQuery
Generic)

instance ToJSON WildcardQuery where
  toJSON :: WildcardQuery -> Value
toJSON
    ( WildcardQuery
        (FieldName Text
wcQueryField)
        Key
wcQueryQuery
        Maybe Boost
wcQueryBoost
      ) =
      [Pair] -> Value
object [Text -> Key
fromText Text
wcQueryField 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 -> Key -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Key
wcQueryQuery,
            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
wcQueryBoost
          ]

instance FromJSON WildcardQuery where
  parseJSON :: Value -> Parser WildcardQuery
parseJSON = String
-> (Object -> Parser WildcardQuery)
-> Value
-> Parser WildcardQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"WildcardQuery" Object -> Parser WildcardQuery
parse
    where
      parse :: Object -> Parser WildcardQuery
parse = (FieldName -> Object -> Parser WildcardQuery)
-> Object -> Parser WildcardQuery
forall (m :: * -> *) a.
(Monad m, MonadFail m) =>
(FieldName -> Object -> m a) -> Object -> m a
fieldTagged ((FieldName -> Object -> Parser WildcardQuery)
 -> Object -> Parser WildcardQuery)
-> (FieldName -> Object -> Parser WildcardQuery)
-> Object
-> Parser WildcardQuery
forall a b. (a -> b) -> a -> b
$ \FieldName
fn Object
o ->
        FieldName -> Key -> Maybe Boost -> WildcardQuery
WildcardQuery FieldName
fn
          (Key -> Maybe Boost -> WildcardQuery)
-> Parser Key -> Parser (Maybe Boost -> WildcardQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Key
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
          Parser (Maybe Boost -> WildcardQuery)
-> Parser (Maybe Boost) -> Parser WildcardQuery
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"