{-# LANGUAGE OverloadedStrings #-}

module Database.Bloodhound.Internal.Versions.Common.Types.Count
  ( CountQuery (..),
    CountResponse (..),
    CountShards (..),

    -- * Optics
    crCountLens,
    crShardsLens,
    csTotalLens,
    csSuccessfulLens,
    csFailedLens,
  )
where

import Data.Aeson
import Database.Bloodhound.Internal.Versions.Common.Types.Query
import Numeric.Natural
import Optics.Lens

newtype CountQuery = CountQuery {CountQuery -> Query
countQuery :: Query}
  deriving stock (CountQuery -> CountQuery -> Bool
(CountQuery -> CountQuery -> Bool)
-> (CountQuery -> CountQuery -> Bool) -> Eq CountQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CountQuery -> CountQuery -> Bool
== :: CountQuery -> CountQuery -> Bool
$c/= :: CountQuery -> CountQuery -> Bool
/= :: CountQuery -> CountQuery -> Bool
Eq, Int -> CountQuery -> ShowS
[CountQuery] -> ShowS
CountQuery -> String
(Int -> CountQuery -> ShowS)
-> (CountQuery -> String)
-> ([CountQuery] -> ShowS)
-> Show CountQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CountQuery -> ShowS
showsPrec :: Int -> CountQuery -> ShowS
$cshow :: CountQuery -> String
show :: CountQuery -> String
$cshowList :: [CountQuery] -> ShowS
showList :: [CountQuery] -> ShowS
Show)

instance ToJSON CountQuery where
  toJSON :: CountQuery -> Value
toJSON (CountQuery Query
q) =
    [Pair] -> Value
object [Key
"query" Key -> Query -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Query
q]

data CountResponse = CountResponse
  { CountResponse -> Natural
crCount :: Natural,
    CountResponse -> CountShards
crShards :: CountShards
  }
  deriving stock (CountResponse -> CountResponse -> Bool
(CountResponse -> CountResponse -> Bool)
-> (CountResponse -> CountResponse -> Bool) -> Eq CountResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CountResponse -> CountResponse -> Bool
== :: CountResponse -> CountResponse -> Bool
$c/= :: CountResponse -> CountResponse -> Bool
/= :: CountResponse -> CountResponse -> Bool
Eq, Int -> CountResponse -> ShowS
[CountResponse] -> ShowS
CountResponse -> String
(Int -> CountResponse -> ShowS)
-> (CountResponse -> String)
-> ([CountResponse] -> ShowS)
-> Show CountResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CountResponse -> ShowS
showsPrec :: Int -> CountResponse -> ShowS
$cshow :: CountResponse -> String
show :: CountResponse -> String
$cshowList :: [CountResponse] -> ShowS
showList :: [CountResponse] -> ShowS
Show)

instance FromJSON CountResponse where
  parseJSON :: Value -> Parser CountResponse
parseJSON =
    String
-> (Object -> Parser CountResponse)
-> Value
-> Parser CountResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CountResponse" ((Object -> Parser CountResponse) -> Value -> Parser CountResponse)
-> (Object -> Parser CountResponse)
-> Value
-> Parser CountResponse
forall a b. (a -> b) -> a -> b
$
      \Object
o ->
        Natural -> CountShards -> CountResponse
CountResponse
          (Natural -> CountShards -> CountResponse)
-> Parser Natural -> Parser (CountShards -> CountResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
            Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"count"
          Parser (CountShards -> CountResponse)
-> Parser CountShards -> Parser CountResponse
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 CountShards
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_shards"

crCountLens :: Lens' CountResponse Natural
crCountLens :: Lens' CountResponse Natural
crCountLens = (CountResponse -> Natural)
-> (CountResponse -> Natural -> CountResponse)
-> Lens' CountResponse Natural
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CountResponse -> Natural
crCount (\CountResponse
x Natural
y -> CountResponse
x {crCount = y})

crShardsLens :: Lens' CountResponse CountShards
crShardsLens :: Lens' CountResponse CountShards
crShardsLens = (CountResponse -> CountShards)
-> (CountResponse -> CountShards -> CountResponse)
-> Lens' CountResponse CountShards
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CountResponse -> CountShards
crShards (\CountResponse
x CountShards
y -> CountResponse
x {crShards = y})

data CountShards = CountShards
  { CountShards -> Int
csTotal :: Int,
    CountShards -> Int
csSuccessful :: Int,
    CountShards -> Int
csFailed :: Int
  }
  deriving stock (CountShards -> CountShards -> Bool
(CountShards -> CountShards -> Bool)
-> (CountShards -> CountShards -> Bool) -> Eq CountShards
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CountShards -> CountShards -> Bool
== :: CountShards -> CountShards -> Bool
$c/= :: CountShards -> CountShards -> Bool
/= :: CountShards -> CountShards -> Bool
Eq, Int -> CountShards -> ShowS
[CountShards] -> ShowS
CountShards -> String
(Int -> CountShards -> ShowS)
-> (CountShards -> String)
-> ([CountShards] -> ShowS)
-> Show CountShards
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CountShards -> ShowS
showsPrec :: Int -> CountShards -> ShowS
$cshow :: CountShards -> String
show :: CountShards -> String
$cshowList :: [CountShards] -> ShowS
showList :: [CountShards] -> ShowS
Show)

instance FromJSON CountShards where
  parseJSON :: Value -> Parser CountShards
parseJSON =
    String
-> (Object -> Parser CountShards) -> Value -> Parser CountShards
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CountShards" ((Object -> Parser CountShards) -> Value -> Parser CountShards)
-> (Object -> Parser CountShards) -> Value -> Parser CountShards
forall a b. (a -> b) -> a -> b
$
      \Object
o ->
        Int -> Int -> Int -> CountShards
CountShards
          (Int -> Int -> Int -> CountShards)
-> Parser Int -> Parser (Int -> Int -> CountShards)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
            Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total"
          Parser (Int -> Int -> CountShards)
-> Parser Int -> Parser (Int -> CountShards)
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 Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"successful"
          Parser (Int -> CountShards) -> Parser Int -> Parser CountShards
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 Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"failed"

csTotalLens :: Lens' CountShards Int
csTotalLens :: Lens' CountShards Int
csTotalLens = (CountShards -> Int)
-> (CountShards -> Int -> CountShards) -> Lens' CountShards Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CountShards -> Int
csTotal (\CountShards
x Int
y -> CountShards
x {csTotal = y})

csSuccessfulLens :: Lens' CountShards Int
csSuccessfulLens :: Lens' CountShards Int
csSuccessfulLens = (CountShards -> Int)
-> (CountShards -> Int -> CountShards) -> Lens' CountShards Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CountShards -> Int
csSuccessful (\CountShards
x Int
y -> CountShards
x {csSuccessful = y})

csFailedLens :: Lens' CountShards Int
csFailedLens :: Lens' CountShards Int
csFailedLens = (CountShards -> Int)
-> (CountShards -> Int -> CountShards) -> Lens' CountShards Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CountShards -> Int
csFailed (\CountShards
x Int
y -> CountShards
x {csFailed = y})