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

-- | Response to @/_cat/aliases@ request.
module Elasticsearch.Cat.Aliases.Response
  ( Response(..)
  , Alias(..)
    -- * Response Parser
  , parser
  ) where

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 Alias
indices :: SmallArray Alias
  } 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 Alias = Alias
  { Alias -> ShortText
alias :: !ShortText
  , Alias -> ShortText
index :: !ShortText
  } deriving (Int -> Alias -> ShowS
[Alias] -> ShowS
Alias -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alias] -> ShowS
$cshowList :: [Alias] -> ShowS
show :: Alias -> String
$cshow :: Alias -> String
showsPrec :: Int -> Alias -> ShowS
$cshowsPrec :: Int -> Alias -> 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 Alias -> 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 Alias
aliasParser)

aliasParser :: J.Value -> Parser Alias
aliasParser :: Value -> Parser Alias
aliasParser 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 ShortText
alias <- forall a. ShortText -> (Value -> Parser a) -> MemberParser a
P.key ShortText
"alias" Value -> Parser ShortText
P.string
         ShortText
index <- forall a. ShortText -> (Value -> Parser a) -> MemberParser a
P.key ShortText
"index" Value -> Parser ShortText
P.string
         pure Alias{ShortText
alias :: ShortText
$sel:alias:Alias :: ShortText
alias,ShortText
index :: ShortText
$sel:index:Alias :: ShortText
index}
    ) SmallArray Member
mbrs