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

-- | Response to @/_cat/indices@ request. Make sure to set these query string
-- parameters: @format=json&bytes=b@.
module Elasticsearch.Cat.Indices.Response
  ( Response(..)
  , Index(..)
  , Health(..)
  , Status(..)
    -- * Response Parser
  , parser
  ) where

import Control.Monad ((>=>))
import Data.Primitive (SmallArray)
import Data.Text.Short (ShortText)
import Json.Parser (Parser)

import qualified Json as J
import qualified Json.Parser as P

newtype Response = Response
  { Response -> SmallArray Index
indices :: SmallArray Index
  } 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)

data Index = Index
  { Index -> Health
health :: !Health
    -- ^ Health: green, yellow, red (@health@)
  , Index -> Status
status :: !Status
    -- ^ Status: open or closed (@status@)
  , Index -> ShortText
index :: !ShortText
    -- ^ The name of the index (@index@)
  } deriving (Int -> Index -> ShowS
[Index] -> ShowS
Index -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Index] -> ShowS
$cshowList :: [Index] -> ShowS
show :: Index -> String
$cshow :: Index -> String
showsPrec :: Int -> Index -> ShowS
$cshowsPrec :: Int -> Index -> ShowS
Show)

data Health = Green | Yellow | Red
  deriving (Int -> Health -> ShowS
[Health] -> ShowS
Health -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Health] -> ShowS
$cshowList :: [Health] -> ShowS
show :: Health -> String
$cshow :: Health -> String
showsPrec :: Int -> Health -> ShowS
$cshowsPrec :: Int -> Health -> ShowS
Show)

data Status = Open | Closed
  deriving (Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Status] -> ShowS
$cshowList :: [Status] -> ShowS
show :: Status -> String
$cshow :: Status -> String
showsPrec :: Int -> Status -> ShowS
$cshowsPrec :: Int -> Status -> ShowS
Show)

parser :: J.Value -> Parser Response
parser :: Value -> Parser Response
parser Value
v = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SmallArray Index -> Response
Response (Value -> Parser (SmallArray Value)
P.array Value
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a.
(Value -> Parser a) -> SmallArray Value -> Parser (SmallArray a)
P.smallArray Value -> Parser Index
indexParser)

indexParser :: J.Value -> Parser Index
indexParser :: Value -> Parser Index
indexParser 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 Health
health <- forall a. ShortText -> (Value -> Parser a) -> MemberParser a
P.key ShortText
"health" (Value -> Parser ShortText
P.string forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ShortText -> Parser Health
healthParser)
         Status
status <- forall a. ShortText -> (Value -> Parser a) -> MemberParser a
P.key ShortText
"status" (Value -> Parser ShortText
P.string forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ShortText -> Parser Status
statusParser)
         ShortText
index <- forall a. ShortText -> (Value -> Parser a) -> MemberParser a
P.key ShortText
"index" Value -> Parser ShortText
P.string
         pure Index{Health
health :: Health
$sel:health:Index :: Health
health,Status
status :: Status
$sel:status:Index :: Status
status,ShortText
index :: ShortText
$sel:index:Index :: ShortText
index}
    ) SmallArray Member
mbrs

healthParser :: ShortText -> Parser Health
healthParser :: ShortText -> Parser Health
healthParser = \case
  ShortText
"red" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Health
Red
  ShortText
"yellow" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Health
Yellow
  ShortText
"green" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Health
Green
  ShortText
_ -> forall a. ShortText -> Parser a
P.fail ShortText
"expected one of: red, yellow, green"

statusParser :: ShortText -> Parser Status
statusParser :: ShortText -> Parser Status
statusParser = \case
  ShortText
"open" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Status
Open
  ShortText
"closed" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Status
Closed
  ShortText
_ -> forall a. ShortText -> Parser a
P.fail ShortText
"expected one of: open, closed"