{-# 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