{-# LANGUAGE OverloadedStrings #-}

module Database.Bloodhound.Internal.Versions.Common.Types.Bulk
  ( -- * Request
    BulkOperation (..),
    UpsertActionMetadata (..),
    UpsertPayload (..),
    buildUpsertActionMetadata,

    -- * Response
    BulkResponse (..),
    BulkActionItem (..),
    BulkItem (..),
    BulkAction (..),
    BulkError (..),

    -- * Optics
    bulkTookLens,
    bulkErrorsLens,
    bulkActionItemsLens,
    baiActionLens,
    baiItemLens,
    biIndexLens,
    biIdLens,
    biStatusLens,
    biErrorLens,
    beTypeLens,
    beReasonLens,
  )
where

import qualified Data.Aeson as A
import qualified Data.Aeson.Key as A
import qualified Data.Aeson.Types as A
import Database.Bloodhound.Internal.Utils.Imports
import Database.Bloodhound.Internal.Versions.Common.Types.Newtypes
import Database.Bloodhound.Internal.Versions.Common.Types.Query

data UpsertActionMetadata
  = UA_RetryOnConflict Int
  | UA_Version Int
  deriving stock (UpsertActionMetadata -> UpsertActionMetadata -> Bool
(UpsertActionMetadata -> UpsertActionMetadata -> Bool)
-> (UpsertActionMetadata -> UpsertActionMetadata -> Bool)
-> Eq UpsertActionMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpsertActionMetadata -> UpsertActionMetadata -> Bool
== :: UpsertActionMetadata -> UpsertActionMetadata -> Bool
$c/= :: UpsertActionMetadata -> UpsertActionMetadata -> Bool
/= :: UpsertActionMetadata -> UpsertActionMetadata -> Bool
Eq, Int -> UpsertActionMetadata -> ShowS
[UpsertActionMetadata] -> ShowS
UpsertActionMetadata -> String
(Int -> UpsertActionMetadata -> ShowS)
-> (UpsertActionMetadata -> String)
-> ([UpsertActionMetadata] -> ShowS)
-> Show UpsertActionMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpsertActionMetadata -> ShowS
showsPrec :: Int -> UpsertActionMetadata -> ShowS
$cshow :: UpsertActionMetadata -> String
show :: UpsertActionMetadata -> String
$cshowList :: [UpsertActionMetadata] -> ShowS
showList :: [UpsertActionMetadata] -> ShowS
Show)

buildUpsertActionMetadata :: UpsertActionMetadata -> Pair
buildUpsertActionMetadata :: UpsertActionMetadata -> Pair
buildUpsertActionMetadata (UA_RetryOnConflict Int
i) = Key
"retry_on_conflict" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
i
buildUpsertActionMetadata (UA_Version Int
i) = Key
"_version" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
i

data UpsertPayload
  = UpsertDoc Value
  | UpsertScript Bool Script Value
  deriving stock (UpsertPayload -> UpsertPayload -> Bool
(UpsertPayload -> UpsertPayload -> Bool)
-> (UpsertPayload -> UpsertPayload -> Bool) -> Eq UpsertPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpsertPayload -> UpsertPayload -> Bool
== :: UpsertPayload -> UpsertPayload -> Bool
$c/= :: UpsertPayload -> UpsertPayload -> Bool
/= :: UpsertPayload -> UpsertPayload -> Bool
Eq, Int -> UpsertPayload -> ShowS
[UpsertPayload] -> ShowS
UpsertPayload -> String
(Int -> UpsertPayload -> ShowS)
-> (UpsertPayload -> String)
-> ([UpsertPayload] -> ShowS)
-> Show UpsertPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpsertPayload -> ShowS
showsPrec :: Int -> UpsertPayload -> ShowS
$cshow :: UpsertPayload -> String
show :: UpsertPayload -> String
$cshowList :: [UpsertPayload] -> ShowS
showList :: [UpsertPayload] -> ShowS
Show)

-- | 'BulkOperation' is a sum type for expressing the four kinds of bulk
--   operation index, create, delete, and update. 'BulkIndex' behaves like an
--   "upsert", 'BulkCreate' will fail if a document already exists at the DocId.
--   Consult the <http://www.elastic.co/guide/en/elasticsearch/reference/current/docs-bulk.html#docs-bulk Bulk API documentation>
--   for further explanation.
--   Warning: Bulk operations suffixed with @Auto@ rely on Elasticsearch to
--   generate the id. Often, people use auto-generated identifiers when
--   Elasticsearch is the only place that their data is stored. Do not let
--   Elasticsearch be the only place your data is stored. It does not guarantee
--   durability, and it may silently discard data.
--   This <https://github.com/elastic/elasticsearch/issues/10708 issue> is
--   discussed further on github.
data BulkOperation
  = -- | Create the document, replacing it if it already exists.
    BulkIndex IndexName DocId Value
  | -- | Create a document with an autogenerated id.
    BulkIndexAuto IndexName Value
  | -- | Create a document with an autogenerated id. Use fast JSON encoding.
    BulkIndexEncodingAuto IndexName Encoding
  | -- | Create a document, failing if it already exists.
    BulkCreate IndexName DocId Value
  | -- | Create a document, failing if it already exists. Use fast JSON encoding.
    BulkCreateEncoding IndexName DocId Encoding
  | -- | Delete the document
    BulkDelete IndexName DocId
  | -- | Update the document, merging the new value with the existing one.
    BulkUpdate IndexName DocId Value
  | -- | Update the document if it already exists, otherwise insert it.
    BulkUpsert IndexName DocId UpsertPayload [UpsertActionMetadata]
  deriving stock (BulkOperation -> BulkOperation -> Bool
(BulkOperation -> BulkOperation -> Bool)
-> (BulkOperation -> BulkOperation -> Bool) -> Eq BulkOperation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BulkOperation -> BulkOperation -> Bool
== :: BulkOperation -> BulkOperation -> Bool
$c/= :: BulkOperation -> BulkOperation -> Bool
/= :: BulkOperation -> BulkOperation -> Bool
Eq, Int -> BulkOperation -> ShowS
[BulkOperation] -> ShowS
BulkOperation -> String
(Int -> BulkOperation -> ShowS)
-> (BulkOperation -> String)
-> ([BulkOperation] -> ShowS)
-> Show BulkOperation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BulkOperation -> ShowS
showsPrec :: Int -> BulkOperation -> ShowS
$cshow :: BulkOperation -> String
show :: BulkOperation -> String
$cshowList :: [BulkOperation] -> ShowS
showList :: [BulkOperation] -> ShowS
Show)

data BulkResponse = BulkResponse
  { BulkResponse -> Int
bulkTook :: Int,
    BulkResponse -> Bool
bulkErrors :: Bool,
    BulkResponse -> [BulkActionItem]
bulkActionItems :: [BulkActionItem]
  }
  deriving stock (BulkResponse -> BulkResponse -> Bool
(BulkResponse -> BulkResponse -> Bool)
-> (BulkResponse -> BulkResponse -> Bool) -> Eq BulkResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BulkResponse -> BulkResponse -> Bool
== :: BulkResponse -> BulkResponse -> Bool
$c/= :: BulkResponse -> BulkResponse -> Bool
/= :: BulkResponse -> BulkResponse -> Bool
Eq, Int -> BulkResponse -> ShowS
[BulkResponse] -> ShowS
BulkResponse -> String
(Int -> BulkResponse -> ShowS)
-> (BulkResponse -> String)
-> ([BulkResponse] -> ShowS)
-> Show BulkResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BulkResponse -> ShowS
showsPrec :: Int -> BulkResponse -> ShowS
$cshow :: BulkResponse -> String
show :: BulkResponse -> String
$cshowList :: [BulkResponse] -> ShowS
showList :: [BulkResponse] -> ShowS
Show)

bulkTookLens :: Lens' BulkResponse Int
bulkTookLens :: Lens' BulkResponse Int
bulkTookLens = (BulkResponse -> Int)
-> (BulkResponse -> Int -> BulkResponse) -> Lens' BulkResponse Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BulkResponse -> Int
bulkTook (\BulkResponse
x Int
y -> BulkResponse
x {bulkTook = y})

bulkErrorsLens :: Lens' BulkResponse Bool
bulkErrorsLens :: Lens' BulkResponse Bool
bulkErrorsLens = (BulkResponse -> Bool)
-> (BulkResponse -> Bool -> BulkResponse)
-> Lens' BulkResponse Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BulkResponse -> Bool
bulkErrors (\BulkResponse
x Bool
y -> BulkResponse
x {bulkErrors = y})

bulkActionItemsLens :: Lens' BulkResponse [BulkActionItem]
bulkActionItemsLens :: Lens' BulkResponse [BulkActionItem]
bulkActionItemsLens = (BulkResponse -> [BulkActionItem])
-> (BulkResponse -> [BulkActionItem] -> BulkResponse)
-> Lens' BulkResponse [BulkActionItem]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BulkResponse -> [BulkActionItem]
bulkActionItems (\BulkResponse
x [BulkActionItem]
y -> BulkResponse
x {bulkActionItems = y})

data BulkActionItem = BulkActionItem
  { BulkActionItem -> BulkAction
baiAction :: BulkAction,
    BulkActionItem -> BulkItem
baiItem :: BulkItem
  }
  deriving stock (BulkActionItem -> BulkActionItem -> Bool
(BulkActionItem -> BulkActionItem -> Bool)
-> (BulkActionItem -> BulkActionItem -> Bool) -> Eq BulkActionItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BulkActionItem -> BulkActionItem -> Bool
== :: BulkActionItem -> BulkActionItem -> Bool
$c/= :: BulkActionItem -> BulkActionItem -> Bool
/= :: BulkActionItem -> BulkActionItem -> Bool
Eq, Int -> BulkActionItem -> ShowS
[BulkActionItem] -> ShowS
BulkActionItem -> String
(Int -> BulkActionItem -> ShowS)
-> (BulkActionItem -> String)
-> ([BulkActionItem] -> ShowS)
-> Show BulkActionItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BulkActionItem -> ShowS
showsPrec :: Int -> BulkActionItem -> ShowS
$cshow :: BulkActionItem -> String
show :: BulkActionItem -> String
$cshowList :: [BulkActionItem] -> ShowS
showList :: [BulkActionItem] -> ShowS
Show)

baiActionLens :: Lens' BulkActionItem BulkAction
baiActionLens :: Lens' BulkActionItem BulkAction
baiActionLens = (BulkActionItem -> BulkAction)
-> (BulkActionItem -> BulkAction -> BulkActionItem)
-> Lens' BulkActionItem BulkAction
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BulkActionItem -> BulkAction
baiAction (\BulkActionItem
x BulkAction
y -> BulkActionItem
x {baiAction = y})

baiItemLens :: Lens' BulkActionItem BulkItem
baiItemLens :: Lens' BulkActionItem BulkItem
baiItemLens = (BulkActionItem -> BulkItem)
-> (BulkActionItem -> BulkItem -> BulkActionItem)
-> Lens' BulkActionItem BulkItem
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BulkActionItem -> BulkItem
baiItem (\BulkActionItem
x BulkItem
y -> BulkActionItem
x {baiItem = y})

data BulkItem = BulkItem
  { BulkItem -> Text
biIndex :: Text,
    BulkItem -> Text
biId :: Text,
    BulkItem -> Maybe Int
biStatus :: Maybe Int,
    BulkItem -> Maybe BulkError
biError :: Maybe BulkError
  }
  deriving stock (BulkItem -> BulkItem -> Bool
(BulkItem -> BulkItem -> Bool)
-> (BulkItem -> BulkItem -> Bool) -> Eq BulkItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BulkItem -> BulkItem -> Bool
== :: BulkItem -> BulkItem -> Bool
$c/= :: BulkItem -> BulkItem -> Bool
/= :: BulkItem -> BulkItem -> Bool
Eq, Int -> BulkItem -> ShowS
[BulkItem] -> ShowS
BulkItem -> String
(Int -> BulkItem -> ShowS)
-> (BulkItem -> String) -> ([BulkItem] -> ShowS) -> Show BulkItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BulkItem -> ShowS
showsPrec :: Int -> BulkItem -> ShowS
$cshow :: BulkItem -> String
show :: BulkItem -> String
$cshowList :: [BulkItem] -> ShowS
showList :: [BulkItem] -> ShowS
Show)

biIndexLens :: Lens' BulkItem Text
biIndexLens :: Lens' BulkItem Text
biIndexLens = (BulkItem -> Text)
-> (BulkItem -> Text -> BulkItem) -> Lens' BulkItem Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BulkItem -> Text
biIndex (\BulkItem
x Text
y -> BulkItem
x {biIndex = y})

biIdLens :: Lens' BulkItem Text
biIdLens :: Lens' BulkItem Text
biIdLens = (BulkItem -> Text)
-> (BulkItem -> Text -> BulkItem) -> Lens' BulkItem Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BulkItem -> Text
biId (\BulkItem
x Text
y -> BulkItem
x {biId = y})

biStatusLens :: Lens' BulkItem (Maybe Int)
biStatusLens :: Lens' BulkItem (Maybe Int)
biStatusLens = (BulkItem -> Maybe Int)
-> (BulkItem -> Maybe Int -> BulkItem)
-> Lens' BulkItem (Maybe Int)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BulkItem -> Maybe Int
biStatus (\BulkItem
x Maybe Int
y -> BulkItem
x {biStatus = y})

biErrorLens :: Lens' BulkItem (Maybe BulkError)
biErrorLens :: Lens' BulkItem (Maybe BulkError)
biErrorLens = (BulkItem -> Maybe BulkError)
-> (BulkItem -> Maybe BulkError -> BulkItem)
-> Lens' BulkItem (Maybe BulkError)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BulkItem -> Maybe BulkError
biError (\BulkItem
x Maybe BulkError
y -> BulkItem
x {biError = y})

data BulkAction = Index | Create | Delete | Update
  deriving stock (BulkAction -> BulkAction -> Bool
(BulkAction -> BulkAction -> Bool)
-> (BulkAction -> BulkAction -> Bool) -> Eq BulkAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BulkAction -> BulkAction -> Bool
== :: BulkAction -> BulkAction -> Bool
$c/= :: BulkAction -> BulkAction -> Bool
/= :: BulkAction -> BulkAction -> Bool
Eq, Int -> BulkAction -> ShowS
[BulkAction] -> ShowS
BulkAction -> String
(Int -> BulkAction -> ShowS)
-> (BulkAction -> String)
-> ([BulkAction] -> ShowS)
-> Show BulkAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BulkAction -> ShowS
showsPrec :: Int -> BulkAction -> ShowS
$cshow :: BulkAction -> String
show :: BulkAction -> String
$cshowList :: [BulkAction] -> ShowS
showList :: [BulkAction] -> ShowS
Show)

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

beTypeLens :: Lens' BulkError Text
beTypeLens :: Lens' BulkError Text
beTypeLens = (BulkError -> Text)
-> (BulkError -> Text -> BulkError) -> Lens' BulkError Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BulkError -> Text
beType (\BulkError
x Text
y -> BulkError
x {beType = y})

beReasonLens :: Lens' BulkError Text
beReasonLens :: Lens' BulkError Text
beReasonLens = (BulkError -> Text)
-> (BulkError -> Text -> BulkError) -> Lens' BulkError Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BulkError -> Text
beReason (\BulkError
x Text
y -> BulkError
x {beReason = y})

instance FromJSON BulkResponse where
  parseJSON :: Value -> Parser BulkResponse
parseJSON = String
-> (Object -> Parser BulkResponse) -> Value -> Parser BulkResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BulkResponse" ((Object -> Parser BulkResponse) -> Value -> Parser BulkResponse)
-> (Object -> Parser BulkResponse) -> Value -> Parser BulkResponse
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Int -> Bool -> [BulkActionItem] -> BulkResponse
BulkResponse (Int -> Bool -> [BulkActionItem] -> BulkResponse)
-> Parser Int -> Parser (Bool -> [BulkActionItem] -> BulkResponse)
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
"took" Parser (Bool -> [BulkActionItem] -> BulkResponse)
-> Parser Bool -> Parser ([BulkActionItem] -> BulkResponse)
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 Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"errors" Parser ([BulkActionItem] -> BulkResponse)
-> Parser [BulkActionItem] -> Parser BulkResponse
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 [BulkActionItem]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"items"

instance FromJSON BulkActionItem where
  parseJSON :: Value -> Parser BulkActionItem
parseJSON Value
j =
    BulkAction -> Value -> Parser BulkActionItem
parseItem BulkAction
Index Value
j
      Parser BulkActionItem
-> Parser BulkActionItem -> Parser BulkActionItem
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BulkAction -> Value -> Parser BulkActionItem
parseItem BulkAction
Create Value
j
      Parser BulkActionItem
-> Parser BulkActionItem -> Parser BulkActionItem
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BulkAction -> Value -> Parser BulkActionItem
parseItem BulkAction
Delete Value
j
      Parser BulkActionItem
-> Parser BulkActionItem -> Parser BulkActionItem
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BulkAction -> Value -> Parser BulkActionItem
parseItem BulkAction
Update Value
j
    where
      -- \| The object has a single key: value pair, where the key encodes
      -- the action.
      parseItem :: BulkAction -> A.Value -> A.Parser BulkActionItem
      parseItem :: BulkAction -> Value -> Parser BulkActionItem
parseItem BulkAction
action = String
-> (Object -> Parser BulkActionItem)
-> Value
-> Parser BulkActionItem
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BulkActionItem" ((Object -> Parser BulkActionItem)
 -> Value -> Parser BulkActionItem)
-> (Object -> Parser BulkActionItem)
-> Value
-> Parser BulkActionItem
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        BulkItem
v <- Object
o Object -> Key -> Parser BulkItem
forall a. FromJSON a => Object -> Key -> Parser a
.: Text -> Key
A.fromText Text
actionText
        BulkActionItem -> Parser BulkActionItem
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BulkActionItem -> Parser BulkActionItem)
-> BulkActionItem -> Parser BulkActionItem
forall a b. (a -> b) -> a -> b
$! BulkActionItem {baiAction :: BulkAction
baiAction = BulkAction
action, baiItem :: BulkItem
baiItem = BulkItem
v}
        where
          actionText :: Text
          actionText :: Text
actionText = case BulkAction
action of
            BulkAction
Index -> Text
"index"
            BulkAction
Create -> Text
"create"
            BulkAction
Delete -> Text
"delete"
            BulkAction
Update -> Text
"update"

instance FromJSON BulkItem where
  parseJSON :: Value -> Parser BulkItem
parseJSON = String -> (Object -> Parser BulkItem) -> Value -> Parser BulkItem
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BulkItem" ((Object -> Parser BulkItem) -> Value -> Parser BulkItem)
-> (Object -> Parser BulkItem) -> Value -> Parser BulkItem
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> Maybe Int -> Maybe BulkError -> BulkItem
BulkItem
      (Text -> Text -> Maybe Int -> Maybe BulkError -> BulkItem)
-> Parser Text
-> Parser (Text -> Maybe Int -> Maybe BulkError -> BulkItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
        Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_index"
      Parser (Text -> Maybe Int -> Maybe BulkError -> BulkItem)
-> Parser Text -> Parser (Maybe Int -> Maybe BulkError -> BulkItem)
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 Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_id"
      Parser (Maybe Int -> Maybe BulkError -> BulkItem)
-> Parser (Maybe Int) -> Parser (Maybe BulkError -> BulkItem)
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 Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"status" -- allegedly present but ES example shows a case where it is missing.. so..
      Parser (Maybe BulkError -> BulkItem)
-> Parser (Maybe BulkError) -> Parser BulkItem
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 BulkError)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error"

instance FromJSON BulkError where
  parseJSON :: Value -> Parser BulkError
parseJSON = String -> (Object -> Parser BulkError) -> Value -> Parser BulkError
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BulkError" ((Object -> Parser BulkError) -> Value -> Parser BulkError)
-> (Object -> Parser BulkError) -> Value -> Parser BulkError
forall a b. (a -> b) -> a -> b
$
    \Object
o -> Text -> Text -> BulkError
BulkError (Text -> Text -> BulkError)
-> Parser Text -> Parser (Text -> BulkError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" Parser (Text -> BulkError) -> Parser Text -> Parser BulkError
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 Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reason"