{-# language ApplicativeDo #-}
{-# language BangPatterns #-}
{-# language DuplicateRecordFields #-}
{-# language MagicHash #-}
{-# language NamedFieldPuns #-}
{-# language OverloadedStrings #-}
{-# language UnboxedTuples #-}

-- | Response to @/_bulk@ request.
module Elasticsearch.Bulk.Response
  ( -- * Types
    Response(..)
  , Action(..)
  , Item(..)
  , ConcurrencyControl(..)
  , Error(..)
  , Details(..)
    -- * Response Parser
  , parser
    -- * Example Data
    -- $example
  ) where

import Prelude hiding (id)

import Control.Monad ((>=>))
import Data.Foldable (find)
import Data.Primitive (SmallArray)
import Data.Text.Short (ShortText)
import Data.Word (Word64,Word16)
import Elasticsearch.Bulk.Request (Action(Update,Create,Delete,Index))
import Json (Member(Member))
import Json.Parser (Parser,MemberParser)
import Json.Context (Context(Key))

import qualified Data.Primitive as PM
import qualified Json as J
import qualified Json.Parser as P

data Response = Response
  { Response -> Word64
took :: !Word64
    -- ^ How many milliseconds did the operation take?
  , Response -> Bool
errors :: !Bool
    -- ^ Did anything go wrong?
  , Response -> SmallArray Item
items :: !(SmallArray Item)
    -- ^ Individual responses for each operation.
  } deriving (Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show)

-- | The _type field is omitted because it is always _doc in Elasticsearch 7+.
-- Some other fields are omitted because they are only present when an operation
-- succeeds.
data Item = Item
  { Item -> Action
action :: !Action
  , Item -> ShortText
index :: !ShortText
    -- ^ @_index@
  , Item -> ShortText
id :: !ShortText
    -- ^ @_id@
  , Item -> Word16
status :: !Word16
    -- ^ @status@
  , Item -> Details
details :: !Details
    -- ^ No single field dictates the details.
  } deriving (Int -> Item -> ShowS
[Item] -> ShowS
Item -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Item] -> ShowS
$cshowList :: [Item] -> ShowS
show :: Item -> String
$cshow :: Item -> String
showsPrec :: Int -> Item -> ShowS
$cshowsPrec :: Int -> Item -> ShowS
Show)

-- | An item has different fields depending on whether the operation
-- was considered to have succeeded.
data Details 
  = Success !ConcurrencyControl
  | Failure !Error
  deriving (Int -> Details -> ShowS
[Details] -> ShowS
Details -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Details] -> ShowS
$cshowList :: [Details] -> ShowS
show :: Details -> String
$cshow :: Details -> String
showsPrec :: Int -> Details -> ShowS
$cshowsPrec :: Int -> Details -> ShowS
Show)

data ConcurrencyControl = ConcurrencyControl
  { ConcurrencyControl -> Word64
version :: !Word64
    -- ^ @_version@
  , ConcurrencyControl -> Word64
sequenceNumber :: !Word64
    -- ^ @_seq_no@
  } deriving (Int -> ConcurrencyControl -> ShowS
[ConcurrencyControl] -> ShowS
ConcurrencyControl -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConcurrencyControl] -> ShowS
$cshowList :: [ConcurrencyControl] -> ShowS
show :: ConcurrencyControl -> String
$cshow :: ConcurrencyControl -> String
showsPrec :: Int -> ConcurrencyControl -> ShowS
$cshowsPrec :: Int -> ConcurrencyControl -> ShowS
Show)

data Error = Error
  { Error -> ShortText
type_ :: !ShortText
  , Error -> ShortText
reason :: !ShortText
  } deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show)

-- | Decode the JSON response to a bulk request.
parser :: J.Value -> Parser Response
parser :: Value -> Parser Response
parser Value
v = do
  SmallArray Member
mbrs <- Value -> Parser (SmallArray Member)
P.object Value
v
  forall a. MemberParser a -> SmallArray Member -> Parser a
P.members
    ( do Word64
took <- forall a. ShortText -> (Value -> Parser a) -> MemberParser a
P.key ShortText
"took" (Value -> Parser Scientific
P.number forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Scientific -> Parser Word64
P.word64)
         Bool
errors <- forall a. ShortText -> (Value -> Parser a) -> MemberParser a
P.key ShortText
"errors" Value -> Parser Bool
P.boolean
         SmallArray Item
items <- forall a. ShortText -> (Value -> Parser a) -> MemberParser a
P.key ShortText
"items" (Value -> Parser (SmallArray Value)
P.array forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a.
(Value -> Parser a) -> SmallArray Value -> Parser (SmallArray a)
P.smallArray Value -> Parser Item
itemParser)
         pure Response{Word64
took :: Word64
$sel:took:Response :: Word64
took,Bool
errors :: Bool
$sel:errors:Response :: Bool
errors,SmallArray Item
items :: SmallArray Item
$sel:items:Response :: SmallArray Item
items}
    ) SmallArray Member
mbrs

itemParser :: J.Value -> Parser Item
itemParser :: Value -> Parser Item
itemParser Value
v = do
  SmallArray Member
mbrsTop <- Value -> Parser (SmallArray Member)
P.object Value
v
  case forall a. SmallArray a -> Int
PM.sizeofSmallArray SmallArray Member
mbrsTop of
    Int
1 -> do
      let !(# Member{key :: Member -> ShortText
key=ShortText
keyAction,value :: Member -> Value
value=Value
valueAction} #) = forall a. SmallArray a -> Int -> (# a #)
PM.indexSmallArray## SmallArray Member
mbrsTop Int
0
      Action
action <- case ShortText
keyAction of
        ShortText
"update" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Action
Update
        ShortText
"create" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Action
Create
        ShortText
"delete" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Action
Delete
        ShortText
"index" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Action
Index
        ShortText
_ -> forall a. ShortText -> Parser a
P.fail ShortText
"expected one of: update, create, delete, index"
      forall a. (Context -> Context) -> Parser a -> Parser a
P.contextually (ShortText -> Context -> Context
Key ShortText
keyAction) forall a b. (a -> b) -> a -> b
$ do
        SmallArray Member
mbrsProps <- Value -> Parser (SmallArray Member)
P.object Value
valueAction
        case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Member{key :: Member -> ShortText
key=ShortText
keyProp} -> ShortText
keyProp forall a. Eq a => a -> a -> Bool
== ShortText
"error") SmallArray Member
mbrsProps of
          Maybe Member
Nothing -> forall a. MemberParser a -> SmallArray Member -> Parser a
P.members -- item indicates a success
            ( do ShortText
index <- forall a. ShortText -> (Value -> Parser a) -> MemberParser a
P.key ShortText
"_index" Value -> Parser ShortText
P.string
                 ShortText
id <- forall a. ShortText -> (Value -> Parser a) -> MemberParser a
P.key ShortText
"_id" Value -> Parser ShortText
P.string
                 Word16
status <- forall a. ShortText -> (Value -> Parser a) -> MemberParser a
P.key ShortText
"status" (Value -> Parser Scientific
P.number forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Scientific -> Parser Word16
P.word16)
                 Word64
version <- forall a. ShortText -> (Value -> Parser a) -> MemberParser a
P.key ShortText
"_version" (Value -> Parser Scientific
P.number forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Scientific -> Parser Word64
P.word64)
                 Word64
sequenceNumber <- forall a. ShortText -> (Value -> Parser a) -> MemberParser a
P.key ShortText
"_seq_no" (Value -> Parser Scientific
P.number forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Scientific -> Parser Word64
P.word64)
                 pure Item
                   { Action
action :: Action
$sel:action:Item :: Action
action,ShortText
index :: ShortText
$sel:index:Item :: ShortText
index,ShortText
id :: ShortText
$sel:id:Item :: ShortText
id,Word16
status :: Word16
$sel:status:Item :: Word16
status
                   , $sel:details:Item :: Details
details=ConcurrencyControl -> Details
Success ConcurrencyControl{Word64
version :: Word64
$sel:version:ConcurrencyControl :: Word64
version,Word64
sequenceNumber :: Word64
$sel:sequenceNumber:ConcurrencyControl :: Word64
sequenceNumber}
                   }
            ) SmallArray Member
mbrsProps
          Just Member{value :: Member -> Value
value=Value
errorValue} -> do -- item indicates a failure
            SmallArray Member
mbrsError <- Value -> Parser (SmallArray Member)
P.object Value
errorValue
            Error
err <- forall a. (Context -> Context) -> Parser a -> Parser a
P.contextually (ShortText -> Context -> Context
Key ShortText
"error") (forall a. MemberParser a -> SmallArray Member -> Parser a
P.members MemberParser Error
errorMemberParser SmallArray Member
mbrsError)
            forall a. MemberParser a -> SmallArray Member -> Parser a
P.members
              ( do ShortText
index <- forall a. ShortText -> (Value -> Parser a) -> MemberParser a
P.key ShortText
"_index" Value -> Parser ShortText
P.string
                   ShortText
id <- forall a. ShortText -> (Value -> Parser a) -> MemberParser a
P.key ShortText
"_id" Value -> Parser ShortText
P.string
                   Word16
status <- forall a. ShortText -> (Value -> Parser a) -> MemberParser a
P.key ShortText
"status" (Value -> Parser Scientific
P.number forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Scientific -> Parser Word16
P.word16)
                   pure Item
                     { Action
action :: Action
$sel:action:Item :: Action
action,ShortText
index :: ShortText
$sel:index:Item :: ShortText
index,ShortText
id :: ShortText
$sel:id:Item :: ShortText
id,Word16
status :: Word16
$sel:status:Item :: Word16
status
                     , $sel:details:Item :: Details
details=Error -> Details
Failure Error
err
                     }
              ) SmallArray Member
mbrsProps
    Int
_ -> forall a. ShortText -> Parser a
P.fail ShortText
"expected object with single member"

errorMemberParser :: MemberParser Error
errorMemberParser :: MemberParser Error
errorMemberParser = do
  ShortText
type_ <- forall a. ShortText -> (Value -> Parser a) -> MemberParser a
P.key ShortText
"type" Value -> Parser ShortText
P.string
  ShortText
reason <- forall a. ShortText -> (Value -> Parser a) -> MemberParser a
P.key ShortText
"reason" Value -> Parser ShortText
P.string
  pure Error{ShortText
type_ :: ShortText
$sel:type_:Error :: ShortText
type_,ShortText
reason :: ShortText
$sel:reason:Error :: ShortText
reason}


-- $example
--
-- Example responses from Elasticsearch documentation with additional
-- commentary. This one does not include any detailed error messages:
--
-- > {
-- >   "took": 30,
-- >   "errors": false,
-- >   "items": [
-- >     {
-- >       "index": {
-- >         "_index": "test",
-- >         "_type": "_doc",
-- >         "_id": "1",
-- >         "_version": 1,
-- >         "result": "created",
-- >         "_shards": {
-- >           "total": 2,
-- >           "successful": 1,
-- >           "failed": 0
-- >         },
-- >         "status": 201,
-- >         "_seq_no" : 0,
-- >         "_primary_term": 1
-- >       }
-- >     },
-- >     {
-- >       "delete": {
-- >         "_index": "test",
-- >         "_type": "_doc",
-- >         "_id": "2",
-- >         "_version": 1,
-- >         "result": "not_found",
-- >         "_shards": {
-- >           "total": 2,
-- >           "successful": 1,
-- >           "failed": 0
-- >         },
-- >         "status": 404,
-- >         "_seq_no" : 1,
-- >         "_primary_term" : 2
-- >       }
-- >     }
-- >   ]
-- > }
--
-- This one does have detailed error messages in it:
--
-- > {
-- >   "took": 486,
-- >   "errors": true,
-- >   "items": [
-- >     {
-- >       "update": {
-- >         "_index": "index1",
-- >         "_type" : "_doc",
-- >         "_id": "5",
-- >         "status": 404,
-- >         "error": {
-- >           "type": "document_missing_exception",
-- >           "reason": "[_doc][5]: document missing",
-- >           "index_uuid": "aAsFqTI0Tc2W0LCWgPNrOA",
-- >           "shard": "0",
-- >           "index": "index1"
-- >         }
-- >       }
-- >     },
-- >     {
-- >       "update": {
-- >         "_index": "index1",
-- >         "_type" : "_doc",
-- >         "_id": "6",
-- >         "status": 404,
-- >         "error": {
-- >           "type": "document_missing_exception",
-- >           "reason": "[_doc][6]: document missing",
-- >           "index_uuid": "aAsFqTI0Tc2W0LCWgPNrOA",
-- >           "shard": "0",
-- >           "index": "index1"
-- >         }
-- >       }
-- >     },
-- >     {
-- >       "create": {
-- >         "_index": "index1",
-- >         "_type" : "_doc",
-- >         "_id": "7",
-- >         "_version": 1,
-- >         "result": "created",
-- >         "_shards": {
-- >           "total": 2,
-- >           "successful": 1,
-- >           "failed": 0
-- >         },
-- >         "_seq_no": 0,
-- >         "_primary_term": 1,
-- >         "status": 201
-- >       }
-- >     }
-- >   ]
-- > }
--
-- Even though the documentation shows an @index_uuid@ field in the
-- error details, Elasticsearch 7.10 does not always populate this field.
-- It is not terribly useful, so it is omitted from the 'Error' type.