{-# LANGUAGE OverloadedStrings #-}

module Database.Bloodhound.Internal.Count (CountQuery (..), CountResponse (..), CountShards (..)) where

import Data.Aeson
import Database.Bloodhound.Internal.Query
import Numeric.Natural

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

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

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

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

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

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