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

newtype VersionParser a = VersionParser
  { VersionParser a -> (Maybe Text, Object -> Parser a)
fromVersionParser :: (Maybe Text, Object -> Parser a)
  }
  deriving (a -> VersionParser b -> VersionParser a
(a -> b) -> VersionParser a -> VersionParser b
(forall a b. (a -> b) -> VersionParser a -> VersionParser b)
-> (forall a b. a -> VersionParser b -> VersionParser a)
-> Functor VersionParser
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
<$ :: a -> VersionParser b -> VersionParser a
$c<$ :: forall a b. a -> VersionParser b -> VersionParser a
fmap :: (a -> b) -> VersionParser a -> VersionParser b
$cfmap :: forall a b. (a -> b) -> VersionParser a -> VersionParser b
Functor)

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

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

withVersions :: forall a. [VersionParser a] -> Object -> Parser a
withVersions :: [VersionParser a] -> Object -> Parser a
withVersions [VersionParser a]
vps' Object
o = do
  let vps :: [(Maybe Text, Object -> Parser a)]
vps = [VersionParser a] -> [(Maybe Text, Object -> Parser a)]
coerce [VersionParser a]
vps' :: [(Maybe Text, Object -> Parser a)]
  Maybe Text
v <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"apiVersion"
  case Maybe Text
-> [(Maybe Text, Object -> Parser a)] -> Maybe (Object -> Parser a)
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 = ((Maybe Text, Object -> Parser a) -> Maybe Text)
-> [(Maybe Text, Object -> Parser a)] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Text, Object -> Parser a) -> Maybe Text
forall a b. (a, b) -> a
fst [(Maybe Text, Object -> Parser a)]
vps
       in case [Maybe Text]
vs of
            [Maybe Text
Nothing] -> String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected apiVersion field. "
            [Maybe Text]
_ ->
              String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$
                String
"Expected apiVersion to be one of "
                  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
unwords
                    ((Maybe Text -> String) -> [Maybe Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Maybe Text -> String
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) = a -> String
forall a. Show a => a -> String
show a
t