{-# language BangPatterns #-}
{-# language DuplicateRecordFields #-}
{-# language LambdaCase #-}
{-# language MagicHash #-}
{-# language NamedFieldPuns #-}
{-# language OverloadedStrings #-}
{-# language PatternSynonyms #-}

module Elasticsearch.Aliases.Request
  ( Action(..)
  , AddAttributes(..)
  , RemoveAttributes(..)
  , encode
  ) where

import Data.Primitive (SmallArray)
import Data.Text.Short (ShortText)
import Json (pattern (:->))

import qualified Json

-- | The action to be taken with the document.
data Action
  = Add AddAttributes
    -- ^ Add an index to an alias
  | Remove RemoveAttributes
    -- ^ Remove an index from an alias
  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)

data AddAttributes = AddAttributes
  { AddAttributes -> ShortText
alias :: !ShortText
  , AddAttributes -> ShortText
index :: !ShortText
  , AddAttributes -> Bool
isWriteIndex :: !Bool
  } deriving (Int -> AddAttributes -> ShowS
[AddAttributes] -> ShowS
AddAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddAttributes] -> ShowS
$cshowList :: [AddAttributes] -> ShowS
show :: AddAttributes -> String
$cshow :: AddAttributes -> String
showsPrec :: Int -> AddAttributes -> ShowS
$cshowsPrec :: Int -> AddAttributes -> ShowS
Show)

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

encode :: SmallArray Action -> Json.Value
encode :: SmallArray Action -> Value
encode !SmallArray Action
xs = Member -> Value
Json.object1 (ShortText
"actions" ShortText -> Value -> Member
:-> SmallArray Value -> Value
Json.Array (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Action -> Value
encodeAction SmallArray Action
xs))

encodeAction :: Action -> Json.Value
encodeAction :: Action -> Value
encodeAction = \case
  Add AddAttributes
x -> AddAttributes -> Value
encodeAdd AddAttributes
x
  Remove RemoveAttributes
x -> RemoveAttributes -> Value
encodeRemove RemoveAttributes
x

encodeAdd :: AddAttributes -> Json.Value
encodeAdd :: AddAttributes -> Value
encodeAdd AddAttributes{ShortText
alias :: ShortText
$sel:alias:AddAttributes :: AddAttributes -> ShortText
alias,ShortText
index :: ShortText
$sel:index:AddAttributes :: AddAttributes -> ShortText
index,Bool
isWriteIndex :: Bool
$sel:isWriteIndex:AddAttributes :: AddAttributes -> Bool
isWriteIndex} =
  Member -> Value
Json.object1 forall a b. (a -> b) -> a -> b
$ ShortText
"add" ShortText -> Value -> Member
:-> Member -> Member -> Member -> Value
Json.object3
    (ShortText
"alias" ShortText -> Value -> Member
:-> ShortText -> Value
Json.String ShortText
alias)
    (ShortText
"index" ShortText -> Value -> Member
:-> ShortText -> Value
Json.String ShortText
index)
    (ShortText
"is_write_index" ShortText -> Value -> Member
:-> (if Bool
isWriteIndex then Value
Json.True else Value
Json.False))

encodeRemove :: RemoveAttributes -> Json.Value
encodeRemove :: RemoveAttributes -> Value
encodeRemove RemoveAttributes{ShortText
alias :: ShortText
$sel:alias:RemoveAttributes :: RemoveAttributes -> ShortText
alias,ShortText
index :: ShortText
$sel:index:RemoveAttributes :: RemoveAttributes -> ShortText
index} =
  Member -> Value
Json.object1 forall a b. (a -> b) -> a -> b
$ ShortText
"remove" ShortText -> Value -> Member
:-> Member -> Member -> Value
Json.object2
    (ShortText
"alias" ShortText -> Value -> Member
:-> ShortText -> Value
Json.String ShortText
alias)
    (ShortText
"index" ShortText -> Value -> Member
:-> ShortText -> Value
Json.String ShortText
index)