{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Database.Bloodhound.Internal.PointInTime where

import Bloodhound.Import

data PointInTime = PointInTime
  { PointInTime -> Text
pPitId :: Text,
    PointInTime -> Text
keepAlive :: Text
  }
  deriving (PointInTime -> PointInTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PointInTime -> PointInTime -> Bool
$c/= :: PointInTime -> PointInTime -> Bool
== :: PointInTime -> PointInTime -> Bool
$c== :: PointInTime -> PointInTime -> Bool
Eq, Int -> PointInTime -> ShowS
[PointInTime] -> ShowS
PointInTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PointInTime] -> ShowS
$cshowList :: [PointInTime] -> ShowS
show :: PointInTime -> String
$cshow :: PointInTime -> String
showsPrec :: Int -> PointInTime -> ShowS
$cshowsPrec :: Int -> PointInTime -> ShowS
Show)

instance ToJSON PointInTime where
  toJSON :: PointInTime -> Value
toJSON PointInTime {Text
keepAlive :: Text
pPitId :: Text
keepAlive :: PointInTime -> Text
pPitId :: PointInTime -> Text
..} =
    [Pair] -> Value
object
      [ Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pPitId,
        Key
"keep_alive" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
keepAlive
      ]

instance FromJSON PointInTime where
  parseJSON :: Value -> Parser PointInTime
parseJSON (Object Object
o) = Text -> Text -> PointInTime
PointInTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"keep_alive"
  parseJSON Value
x = forall a. String -> Value -> Parser a
typeMismatch String
"PointInTime" Value
x

data OpenPointInTimeResponse = OpenPointInTimeResponse
  { OpenPointInTimeResponse -> Text
oPitId :: Text
  }
  deriving (OpenPointInTimeResponse -> OpenPointInTimeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenPointInTimeResponse -> OpenPointInTimeResponse -> Bool
$c/= :: OpenPointInTimeResponse -> OpenPointInTimeResponse -> Bool
== :: OpenPointInTimeResponse -> OpenPointInTimeResponse -> Bool
$c== :: OpenPointInTimeResponse -> OpenPointInTimeResponse -> Bool
Eq, Int -> OpenPointInTimeResponse -> ShowS
[OpenPointInTimeResponse] -> ShowS
OpenPointInTimeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenPointInTimeResponse] -> ShowS
$cshowList :: [OpenPointInTimeResponse] -> ShowS
show :: OpenPointInTimeResponse -> String
$cshow :: OpenPointInTimeResponse -> String
showsPrec :: Int -> OpenPointInTimeResponse -> ShowS
$cshowsPrec :: Int -> OpenPointInTimeResponse -> ShowS
Show)

instance ToJSON OpenPointInTimeResponse where
  toJSON :: OpenPointInTimeResponse -> Value
toJSON OpenPointInTimeResponse {Text
oPitId :: Text
oPitId :: OpenPointInTimeResponse -> Text
..} =
    [Pair] -> Value
object [Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
oPitId]

instance FromJSON OpenPointInTimeResponse where
  parseJSON :: Value -> Parser OpenPointInTimeResponse
parseJSON (Object Object
o) = Text -> OpenPointInTimeResponse
OpenPointInTimeResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
  parseJSON Value
x = forall a. String -> Value -> Parser a
typeMismatch String
"OpenPointInTimeResponse" Value
x

data ClosePointInTime = ClosePointInTime
  { ClosePointInTime -> Text
cPitId :: Text
  }
  deriving (ClosePointInTime -> ClosePointInTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClosePointInTime -> ClosePointInTime -> Bool
$c/= :: ClosePointInTime -> ClosePointInTime -> Bool
== :: ClosePointInTime -> ClosePointInTime -> Bool
$c== :: ClosePointInTime -> ClosePointInTime -> Bool
Eq, Int -> ClosePointInTime -> ShowS
[ClosePointInTime] -> ShowS
ClosePointInTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClosePointInTime] -> ShowS
$cshowList :: [ClosePointInTime] -> ShowS
show :: ClosePointInTime -> String
$cshow :: ClosePointInTime -> String
showsPrec :: Int -> ClosePointInTime -> ShowS
$cshowsPrec :: Int -> ClosePointInTime -> ShowS
Show)

instance ToJSON ClosePointInTime where
  toJSON :: ClosePointInTime -> Value
toJSON ClosePointInTime {Text
cPitId :: Text
cPitId :: ClosePointInTime -> Text
..} =
    [Pair] -> Value
object [Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
cPitId]

instance FromJSON ClosePointInTime where
  parseJSON :: Value -> Parser ClosePointInTime
parseJSON (Object Object
o) = Text -> ClosePointInTime
ClosePointInTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
  parseJSON Value
x = forall a. String -> Value -> Parser a
typeMismatch String
"ClosePointInTime" Value
x

data ClosePointInTimeResponse = ClosePointInTimeResponse
  { ClosePointInTimeResponse -> Bool
succeeded :: Bool,
    ClosePointInTimeResponse -> Int
numFreed :: Int
  }
  deriving (ClosePointInTimeResponse -> ClosePointInTimeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClosePointInTimeResponse -> ClosePointInTimeResponse -> Bool
$c/= :: ClosePointInTimeResponse -> ClosePointInTimeResponse -> Bool
== :: ClosePointInTimeResponse -> ClosePointInTimeResponse -> Bool
$c== :: ClosePointInTimeResponse -> ClosePointInTimeResponse -> Bool
Eq, Int -> ClosePointInTimeResponse -> ShowS
[ClosePointInTimeResponse] -> ShowS
ClosePointInTimeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClosePointInTimeResponse] -> ShowS
$cshowList :: [ClosePointInTimeResponse] -> ShowS
show :: ClosePointInTimeResponse -> String
$cshow :: ClosePointInTimeResponse -> String
showsPrec :: Int -> ClosePointInTimeResponse -> ShowS
$cshowsPrec :: Int -> ClosePointInTimeResponse -> ShowS
Show)

instance ToJSON ClosePointInTimeResponse where
  toJSON :: ClosePointInTimeResponse -> Value
toJSON ClosePointInTimeResponse {Bool
Int
numFreed :: Int
succeeded :: Bool
numFreed :: ClosePointInTimeResponse -> Int
succeeded :: ClosePointInTimeResponse -> Bool
..} =
    [Pair] -> Value
object
      [ Key
"succeeded" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
succeeded,
        Key
"num_freed" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
numFreed
      ]

instance FromJSON ClosePointInTimeResponse where
  parseJSON :: Value -> Parser ClosePointInTimeResponse
parseJSON (Object Object
o) = do
    Bool
succeeded' <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"succeeded"
    Int
numFreed' <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"num_freed"
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Int -> ClosePointInTimeResponse
ClosePointInTimeResponse Bool
succeeded' Int
numFreed'
  parseJSON Value
x = forall a. String -> Value -> Parser a
typeMismatch String
"ClosePointInTimeResponse" Value
x