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