{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Hercules.Formats.Common where

import Control.Monad
import Data.Aeson
  ( (.:),
    (.:?),
  )
import Data.Aeson.Types
  ( Object,
    Parser,
    Value,
    withObject,
  )
import Data.Coerce (coerce)
import qualified Data.List
import Data.Text (Text)
import qualified Data.Text as T
import Prelude

withKind :: Text -> (Object -> Parser a) -> Value -> Parser a
withKind :: forall a. Text -> (Object -> Parser a) -> Value -> Parser a
withKind Text
k Object -> Parser a
f = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject (Text -> String
T.unpack Text
k) forall a b. (a -> b) -> a -> b
$ \Object
o -> do
  Text
k' <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
k' forall a. Eq a => a -> a -> Bool
/= Text
k) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"kind field must be " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
k forall a. Semigroup a => a -> a -> a
<> String
", not " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
k'
  Object -> Parser a
f Object
o

newtype VersionParser a = VersionParser
  { forall a. VersionParser a -> (Maybe Text, Object -> Parser a)
fromVersionParser :: (Maybe Text, Object -> Parser a)
  }
  deriving (forall a b. a -> VersionParser b -> VersionParser a
forall a b. (a -> b) -> VersionParser a -> VersionParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> VersionParser b -> VersionParser a
$c<$ :: forall a b. a -> VersionParser b -> VersionParser a
fmap :: forall a b. (a -> b) -> VersionParser a -> VersionParser b
$cfmap :: forall a b. (a -> b) -> VersionParser a -> VersionParser b
Functor)

noVersion :: (Object -> Parser a) -> VersionParser a
noVersion :: forall a. (Object -> Parser a) -> VersionParser a
noVersion = forall a. (Maybe Text, Object -> Parser a) -> VersionParser a
VersionParser forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Maybe a
Nothing,)

version :: Text -> (Object -> Parser a) -> VersionParser a
version :: forall a. Text -> (Object -> Parser a) -> VersionParser a
version Text
t Object -> Parser a
p = forall a. (Maybe Text, Object -> Parser a) -> VersionParser a
VersionParser (forall a. a -> Maybe a
Just Text
t, Object -> Parser a
p)

withVersions :: forall a. [VersionParser a] -> Object -> Parser a
withVersions :: forall a. [VersionParser a] -> Object -> Parser a
withVersions [VersionParser a]
vps' Object
o = do
  let vps :: [(Maybe Text, Object -> Parser a)]
vps = coerce :: forall a b. Coercible a b => a -> b
coerce [VersionParser a]
vps' :: [(Maybe Text, Object -> Parser a)]
  Maybe Text
v <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"apiVersion"
  case forall a b. Eq a => a -> [(a, b)] -> Maybe b
Data.List.lookup Maybe Text
v [(Maybe Text, Object -> Parser a)]
vps of
    Just Object -> Parser a
p -> Object -> Parser a
p Object
o
    Maybe (Object -> Parser a)
Nothing ->
      let vs :: [Maybe Text]
vs = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Maybe Text, Object -> Parser a)]
vps
       in case [Maybe Text]
vs of
            [Maybe Text
Nothing] -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected apiVersion field. "
            [Maybe Text]
_ ->
              forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
                String
"Expected apiVersion to be one of "
                  forall a. Semigroup a => a -> a -> a
<> [String] -> String
unwords
                    (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => Maybe a -> String
showVersion [Maybe Text]
vs)
              where
                showVersion :: Maybe a -> String
showVersion Maybe a
Nothing = String
"<no version field>"
                showVersion (Just a
t) = forall a. Show a => a -> String
show a
t