{-# language BangPatterns #-}
{-# language DuplicateRecordFields #-}
{-# language MagicHash #-}
{-# language NamedFieldPuns #-}

module Elasticsearch.Bulk.Request
  ( Operation(..)
  , Action(..)
  , encode
  , encodeSmile
  ) where

import Data.Bytes.Builder (Builder)
import Data.Primitive (SmallArray)
import Data.Text.Short (ShortText)
import GHC.Exts (Ptr(Ptr))

import qualified Data.Maybe.Unpacked.Text.Short as M
import qualified Data.Bytes.Builder as Builder
import qualified Json
import qualified Json.Smile

-- | A single operation in a bulk request.
data Operation = Operation
  { Operation -> Action
action :: !Action
    -- ^ The action to take. Usually 'Create' or 'Index'.
  , Operation -> ShortText
index :: {-# UNPACK #-} !ShortText
    -- ^ Index name, required
  , Operation -> MaybeShortText
id_ :: {-# UNPACK #-} !M.MaybeShortText
    -- ^ Document ID, optional but strongly recommended.
  , Operation -> SmallArray Member
document :: !(SmallArray Json.Member)
    -- ^ Document 
  } deriving (Int -> Operation -> ShowS
[Operation] -> ShowS
Operation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Operation] -> ShowS
$cshowList :: [Operation] -> ShowS
show :: Operation -> String
$cshow :: Operation -> String
showsPrec :: Int -> Operation -> ShowS
$cshowsPrec :: Int -> Operation -> ShowS
Show)

-- | The action to be taken with the document.
data Action
  = Create
    -- ^ Create a new document. Fails if document with ID already exists.
  | Index
    -- ^ Create or update a document.
  | Delete
    -- ^ Delete a document. Note: Currently broken. Results in
    --   malformed request.
  | Update
    -- ^ Update a document. Fails if document with ID does not exist.
  deriving (Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Action] -> ShowS
$cshowList :: [Action] -> ShowS
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> ShowS
$cshowsPrec :: Int -> Action -> ShowS
Show)

-- | Encode returns a builder, not a JSON value, because the body of
-- an Elasticsearch bulk requests is not JSON. Technically, it is
-- <http://ndjson.org ndjson>, but since there is no common type for
-- that, this module just converts it straight to a builder.
encode :: SmallArray Operation -> Builder
encode :: SmallArray Operation -> Builder
encode !SmallArray Operation
xs = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Operation -> Builder
encodeOne SmallArray Operation
xs

encodeOne :: Operation -> Builder
encodeOne :: Operation -> Builder
encodeOne Operation{Action
action :: Action
$sel:action:Operation :: Operation -> Action
action,ShortText
index :: ShortText
$sel:index:Operation :: Operation -> ShortText
index,MaybeShortText
id_ :: MaybeShortText
$sel:id_:Operation :: Operation -> MaybeShortText
id_,SmallArray Member
document :: SmallArray Member
$sel:document:Operation :: Operation -> SmallArray Member
document} =
     Action -> Builder
encodePreamble Action
action
  forall a. Semigroup a => a -> a -> a
<> ShortText -> Builder
Builder.shortTextJsonString ShortText
index
  forall a. Semigroup a => a -> a -> a
<> forall a. a -> (ShortText -> a) -> MaybeShortText -> a
M.maybe forall a. Monoid a => a
mempty
     (\ShortText
t -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Builder
Builder.ascii7 Char
',' Char
'"' Char
'_' Char
'i' Char
'd' Char
'"' Char
':'
         forall a. Semigroup a => a -> a -> a
<> ShortText -> Builder
Builder.shortTextJsonString ShortText
t
     ) MaybeShortText
id_
  forall a. Semigroup a => a -> a -> a
<> Char -> Char -> Char -> Builder
Builder.ascii3 Char
'}' Char
'}' Char
'\n'
  forall a. Semigroup a => a -> a -> a
<> Value -> Builder
Json.encode (SmallArray Member -> Value
Json.Object SmallArray Member
document)
  forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.ascii Char
'\n'

-- When we encode the first part of the operation, we are trying to
-- build something like this:
--   {"index":{"_index":"test","_id":"1"}}
--   {"index":{"_index":"test"}
--   {"create":{"_index":"test","_id":"1"}}
-- This function encodes just the beginning part. For example:
--   {"index":{"_index":
--   {"create":{"_index":
encodePreamble :: Action -> Builder
encodePreamble :: Action -> Builder
encodePreamble Action
x = case Action
x of
  Action
Create -> CString -> Builder
Builder.cstring (forall a. Addr# -> Ptr a
Ptr Addr#
"{\"create\":{\"_index\":"# )
  Action
Index -> CString -> Builder
Builder.cstring (forall a. Addr# -> Ptr a
Ptr Addr#
"{\"index\":{\"_index\":"# )
  Action
Delete -> CString -> Builder
Builder.cstring (forall a. Addr# -> Ptr a
Ptr Addr#
"{\"delete\":{\"_index\":"# )
  Action
Update -> CString -> Builder
Builder.cstring (forall a. Addr# -> Ptr a
Ptr Addr#
"{\"update\":{\"_index\":"# )

-- | Encode with SMILE. This does not use backreferences.
encodeSmile :: SmallArray Operation -> Builder
{-# noinline encodeSmile #-}
encodeSmile :: SmallArray Operation -> Builder
encodeSmile !SmallArray Operation
xs = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Operation -> Builder
encodeSmileOne SmallArray Operation
xs

encodeSmileAction :: Action -> ShortText -> ShortText -> Builder
{-# inline encodeSmileAction #-}
encodeSmileAction :: Action -> ShortText -> ShortText -> Builder
encodeSmileAction Action
x !ShortText
indexName !ShortText
docId =
  ( case Action
x of
      Action
Create ->
        -- Breakdown:
        -- [0-3]: four-byte prefix, smiley face
        -- [4]: object (0xfa)
        -- [5]: key, length 6
        -- [6-11]: "create"
        -- [12]: object (0xfa)
        -- [13]: key, length 6
        -- [14-19]: "_index"
        CString -> Builder
Builder.cstring (forall a. Addr# -> Ptr a
Ptr Addr#
"\x3a\x29\x0a\x00\xfa\x85\x63\x72\x65\x61\x74\x65\xfa\x85\x5f\x69\x6e\x64\x65\x78"#)
      Action
Index -> 
        -- Nearly the same as create but with the action key different
        CString -> Builder
Builder.cstring (forall a. Addr# -> Ptr a
Ptr Addr#
"\x3a\x29\x0a\x00\xfa\x84\x69\x6e\x64\x65\x78\xfa\x85\x5f\x69\x6e\x64\x65\x78"#)
      Action
_ -> forall a. String -> a
errorWithoutStackTrace String
"Elasticsearch.Bulk.Request[encodeSmileAction]: write Update and Delete cases"
  )
  forall a. Semigroup a => a -> a -> a
<>
  ShortText -> Builder
Json.Smile.encodeString ShortText
indexName
  forall a. Semigroup a => a -> a -> a
<>
  CString -> Builder
Builder.cstring (forall a. Addr# -> Ptr a
Ptr Addr#
"\x82\x5f\x69\x64"#) -- the "_id" key
  forall a. Semigroup a => a -> a -> a
<>
  ShortText -> Builder
Json.Smile.encodeString ShortText
docId
  forall a. Semigroup a => a -> a -> a
<>
  CString -> Builder
Builder.cstring (forall a. Addr# -> Ptr a
Ptr Addr#
"\xfb\xfb\xff"#) -- close objects and stream separator 0xFF

encodeSmileActionWithoutDocId :: Action -> ShortText -> Builder
{-# inline encodeSmileActionWithoutDocId #-}
encodeSmileActionWithoutDocId :: Action -> ShortText -> Builder
encodeSmileActionWithoutDocId Action
x !ShortText
indexName =
  ( case Action
x of
      Action
Create ->
        CString -> Builder
Builder.cstring (forall a. Addr# -> Ptr a
Ptr Addr#
"\x3a\x29\x0a\x00\xfa\x85\x63\x72\x65\x61\x74\x65\xfa\x85\x5f\x69\x6e\x64\x65\x78"#)
      Action
Index -> 
        -- Nearly the same as create but with the action key different
        CString -> Builder
Builder.cstring (forall a. Addr# -> Ptr a
Ptr Addr#
"\x3a\x29\x0a\x00\xfa\x84\x69\x6e\x64\x65\x78\xfa\x85\x5f\x69\x6e\x64\x65\x78"#)
      Action
_ -> forall a. String -> a
errorWithoutStackTrace String
"Elasticsearch.Bulk.Request[encodeSmileAction]: write Update and Delete cases"
  )
  forall a. Semigroup a => a -> a -> a
<>
  ShortText -> Builder
Json.Smile.encodeString ShortText
indexName
  forall a. Semigroup a => a -> a -> a
<>
  CString -> Builder
Builder.cstring (forall a. Addr# -> Ptr a
Ptr Addr#
"\xfb\xfb\xff"#) -- close objects and stream separator 0xFF

encodeSmileOne :: Operation -> Builder
encodeSmileOne :: Operation -> Builder
encodeSmileOne Operation{Action
action :: Action
$sel:action:Operation :: Operation -> Action
action,ShortText
index :: ShortText
$sel:index:Operation :: Operation -> ShortText
index,MaybeShortText
id_ :: MaybeShortText
$sel:id_:Operation :: Operation -> MaybeShortText
id_,SmallArray Member
document :: SmallArray Member
$sel:document:Operation :: Operation -> SmallArray Member
document} =
     forall a. a -> (ShortText -> a) -> MaybeShortText -> a
M.maybe
       (Action -> ShortText -> Builder
encodeSmileActionWithoutDocId Action
action ShortText
index)
       (Action -> ShortText -> ShortText -> Builder
encodeSmileAction Action
action ShortText
index)
       MaybeShortText
id_
  forall a. Semigroup a => a -> a -> a
<> Value -> Builder
Json.Smile.encode (SmallArray Member -> Value
Json.Object SmallArray Member
document)
  forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
Builder.word8 Word8
0xFF