{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ConstraintKinds #-} module Data.Aeson.Config.FromValue ( FromValue(..) , Parser , Result , decodeValue , Generic , GenericDecode , genericFromValue , Options(..) , genericFromValueWith , typeMismatch , withObject , withText , withString , withArray , withNumber , withBool , parseArray , traverseObject , (.:) , (.:?) , Key , Value(..) , Object , Array ) where import Imports import GHC.Generics import Data.Map.Lazy (Map) import qualified Data.Map.Lazy as Map import qualified Data.Vector as V import Data.Aeson.Config.Key (Key) import qualified Data.Aeson.Config.Key as Key import qualified Data.Aeson.Config.KeyMap as KeyMap import Data.Aeson.Types (FromJSON(..)) import Data.Aeson.Config.Util import Data.Aeson.Config.Parser type Result a = Either String (a, [String]) decodeValue :: FromValue a => Value -> Result a decodeValue :: Value -> Result a decodeValue = (Value -> Parser a) -> Value -> Result a forall a. (Value -> Parser a) -> Value -> Either String (a, [String]) runParser Value -> Parser a forall a. FromValue a => Value -> Parser a fromValue (.:) :: FromValue a => Object -> Key -> Parser a .: :: Object -> Key -> Parser a (.:) = (Value -> Parser a) -> Object -> Key -> Parser a forall a. (Value -> Parser a) -> Object -> Key -> Parser a explicitParseField Value -> Parser a forall a. FromValue a => Value -> Parser a fromValue (.:?) :: FromValue a => Object -> Key -> Parser (Maybe a) .:? :: Object -> Key -> Parser (Maybe a) (.:?) = (Value -> Parser a) -> Object -> Key -> Parser (Maybe a) forall a. (Value -> Parser a) -> Object -> Key -> Parser (Maybe a) explicitParseFieldMaybe Value -> Parser a forall a. FromValue a => Value -> Parser a fromValue class FromValue a where fromValue :: Value -> Parser a default fromValue :: forall d m. (Generic a, Rep a ~ D1 d m, Datatype d, GenericDecode (Rep a)) => Value -> Parser a fromValue = Value -> Parser a forall a (d :: Meta) (m :: * -> *). (Generic a, Rep a ~ D1 d m, Datatype d, GenericDecode (Rep a)) => Value -> Parser a genericFromValue genericFromValue :: forall a d m. (Generic a, Rep a ~ D1 d m, Datatype d, GenericDecode (Rep a)) => Value -> Parser a genericFromValue :: Value -> Parser a genericFromValue = Options -> Value -> Parser a forall a. (Generic a, GenericDecode (Rep a)) => Options -> Value -> Parser a genericFromValueWith ((String -> String) -> Options Options ((String -> String) -> Options) -> (String -> String) -> Options forall a b. (a -> b) -> a -> b $ String -> String -> String hyphenize String name) where name :: String name :: String name = M1 D d m Any -> String forall k (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *) (f :: k1 -> *) (a :: k1). Datatype d => t d f a -> String datatypeName (forall p. M1 D d m p forall a. HasCallStack => a undefined :: D1 d m p) instance FromValue Bool where fromValue :: Value -> Parser Bool fromValue = Parser Bool -> Parser Bool forall a. Parser a -> Parser a liftParser (Parser Bool -> Parser Bool) -> (Value -> Parser Bool) -> Value -> Parser Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Value -> Parser Bool forall a. FromJSON a => Value -> Parser a parseJSON instance FromValue Int where fromValue :: Value -> Parser Int fromValue = Parser Int -> Parser Int forall a. Parser a -> Parser a liftParser (Parser Int -> Parser Int) -> (Value -> Parser Int) -> Value -> Parser Int forall b c a. (b -> c) -> (a -> b) -> a -> c . Value -> Parser Int forall a. FromJSON a => Value -> Parser a parseJSON instance FromValue Text where fromValue :: Value -> Parser Text fromValue = Parser Text -> Parser Text forall a. Parser a -> Parser a liftParser (Parser Text -> Parser Text) -> (Value -> Parser Text) -> Value -> Parser Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Value -> Parser Text forall a. FromJSON a => Value -> Parser a parseJSON instance {-# OVERLAPPING #-} FromValue String where fromValue :: Value -> Parser String fromValue = Parser String -> Parser String forall a. Parser a -> Parser a liftParser (Parser String -> Parser String) -> (Value -> Parser String) -> Value -> Parser String forall b c a. (b -> c) -> (a -> b) -> a -> c . Value -> Parser String forall a. FromJSON a => Value -> Parser a parseJSON instance FromValue a => FromValue (Maybe a) where fromValue :: Value -> Parser (Maybe a) fromValue Value value = Parser (Maybe Value) -> Parser (Maybe Value) forall a. Parser a -> Parser a liftParser (Value -> Parser (Maybe Value) forall a. FromJSON a => Value -> Parser a parseJSON Value value) Parser (Maybe Value) -> (Maybe Value -> Parser (Maybe a)) -> Parser (Maybe a) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (Value -> Parser a) -> Maybe Value -> Parser (Maybe a) forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse Value -> Parser a forall a. FromValue a => Value -> Parser a fromValue instance FromValue a => FromValue [a] where fromValue :: Value -> Parser [a] fromValue = (Array -> Parser [a]) -> Value -> Parser [a] forall a. (Array -> Parser a) -> Value -> Parser a withArray ((Value -> Parser a) -> Array -> Parser [a] forall a. (Value -> Parser a) -> Array -> Parser [a] parseArray Value -> Parser a forall a. FromValue a => Value -> Parser a fromValue) parseArray :: (Value -> Parser a) -> Array -> Parser [a] parseArray :: (Value -> Parser a) -> Array -> Parser [a] parseArray Value -> Parser a f = (Int -> Value -> Parser a) -> [Int] -> [Value] -> Parser [a] forall (m :: * -> *) a b c. Applicative m => (a -> b -> m c) -> [a] -> [b] -> m [c] zipWithM ((Value -> Parser a) -> Int -> Value -> Parser a forall a. (Value -> Parser a) -> Int -> Value -> Parser a parseIndexed Value -> Parser a f) [Int 0..] ([Value] -> Parser [a]) -> (Array -> [Value]) -> Array -> Parser [a] forall b c a. (b -> c) -> (a -> b) -> a -> c . Array -> [Value] forall a. Vector a -> [a] V.toList where parseIndexed :: (Value -> Parser a) -> Int -> Value -> Parser a parseIndexed :: (Value -> Parser a) -> Int -> Value -> Parser a parseIndexed Value -> Parser a p Int n Value value = Value -> Parser a p Value value Parser a -> JSONPathElement -> Parser a forall a. Parser a -> JSONPathElement -> Parser a <?> Int -> JSONPathElement Index Int n instance FromValue a => FromValue (Map String a) where fromValue :: Value -> Parser (Map String a) fromValue = (Object -> Parser (Map String a)) -> Value -> Parser (Map String a) forall a. (Object -> Parser a) -> Value -> Parser a withObject ((Object -> Parser (Map String a)) -> Value -> Parser (Map String a)) -> (Object -> Parser (Map String a)) -> Value -> Parser (Map String a) forall a b. (a -> b) -> a -> b $ \ Object o -> do [(Key, a)] xs <- (Value -> Parser a) -> Object -> Parser [(Key, a)] forall a. (Value -> Parser a) -> Object -> Parser [(Key, a)] traverseObject Value -> Parser a forall a. FromValue a => Value -> Parser a fromValue Object o Map String a -> Parser (Map String a) forall (m :: * -> *) a. Monad m => a -> m a return (Map String a -> Parser (Map String a)) -> Map String a -> Parser (Map String a) forall a b. (a -> b) -> a -> b $ [(String, a)] -> Map String a forall k a. Ord k => [(k, a)] -> Map k a Map.fromList (((Key, a) -> (String, a)) -> [(Key, a)] -> [(String, a)] forall a b. (a -> b) -> [a] -> [b] map ((Key -> String) -> (Key, a) -> (String, a) forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first Key -> String Key.toString) [(Key, a)] xs) traverseObject :: (Value -> Parser a) -> Object -> Parser [(Key, a)] traverseObject :: (Value -> Parser a) -> Object -> Parser [(Key, a)] traverseObject Value -> Parser a f Object o = do [(Key, Value)] -> ((Key, Value) -> Parser (Key, a)) -> Parser [(Key, a)] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b) forM (Object -> [(Key, Value)] forall v. KeyMap v -> [(Key, v)] KeyMap.toList Object o) (((Key, Value) -> Parser (Key, a)) -> Parser [(Key, a)]) -> ((Key, Value) -> Parser (Key, a)) -> Parser [(Key, a)] forall a b. (a -> b) -> a -> b $ \ (Key name, Value value) -> (,) Key name (a -> (Key, a)) -> Parser a -> Parser (Key, a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value -> Parser a f Value value Parser a -> JSONPathElement -> Parser a forall a. Parser a -> JSONPathElement -> Parser a <?> Key -> JSONPathElement Key Key name instance (FromValue a, FromValue b) => FromValue (a, b) where fromValue :: Value -> Parser (a, b) fromValue Value v = (,) (a -> b -> (a, b)) -> Parser a -> Parser (b -> (a, b)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value -> Parser a forall a. FromValue a => Value -> Parser a fromValue Value v Parser (b -> (a, b)) -> Parser b -> Parser (a, b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Value -> Parser b forall a. FromValue a => Value -> Parser a fromValue Value v instance (FromValue a, FromValue b) => FromValue (Either a b) where fromValue :: Value -> Parser (Either a b) fromValue Value v = a -> Either a b forall a b. a -> Either a b Left (a -> Either a b) -> Parser a -> Parser (Either a b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value -> Parser a forall a. FromValue a => Value -> Parser a fromValue Value v Parser (Either a b) -> Parser (Either a b) -> Parser (Either a b) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> b -> Either a b forall a b. b -> Either a b Right (b -> Either a b) -> Parser b -> Parser (Either a b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value -> Parser b forall a. FromValue a => Value -> Parser a fromValue Value v data Options = Options { Options -> String -> String optionsRecordSelectorModifier :: String -> String } genericFromValueWith :: (Generic a, GenericDecode (Rep a)) => Options -> Value -> Parser a genericFromValueWith :: Options -> Value -> Parser a genericFromValueWith Options opts = (Rep a Any -> a) -> Parser (Rep a Any) -> Parser a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Rep a Any -> a forall a x. Generic a => Rep a x -> a to (Parser (Rep a Any) -> Parser a) -> (Value -> Parser (Rep a Any)) -> Value -> Parser a forall b c a. (b -> c) -> (a -> b) -> a -> c . Options -> Value -> Parser (Rep a Any) forall (f :: * -> *) p. GenericDecode f => Options -> Value -> Parser (f p) genericDecode Options opts class GenericDecode f where genericDecode :: Options -> Value -> Parser (f p) instance (GenericDecode a) => GenericDecode (D1 d a) where genericDecode :: Options -> Value -> Parser (D1 d a p) genericDecode Options opts = (a p -> D1 d a p) -> Parser (a p) -> Parser (D1 d a p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a p -> D1 d a p forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p M1 (Parser (a p) -> Parser (D1 d a p)) -> (Value -> Parser (a p)) -> Value -> Parser (D1 d a p) forall b c a. (b -> c) -> (a -> b) -> a -> c . Options -> Value -> Parser (a p) forall (f :: * -> *) p. GenericDecode f => Options -> Value -> Parser (f p) genericDecode Options opts instance (GenericDecode a) => GenericDecode (C1 c a) where genericDecode :: Options -> Value -> Parser (C1 c a p) genericDecode Options opts = (a p -> C1 c a p) -> Parser (a p) -> Parser (C1 c a p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a p -> C1 c a p forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p M1 (Parser (a p) -> Parser (C1 c a p)) -> (Value -> Parser (a p)) -> Value -> Parser (C1 c a p) forall b c a. (b -> c) -> (a -> b) -> a -> c . Options -> Value -> Parser (a p) forall (f :: * -> *) p. GenericDecode f => Options -> Value -> Parser (f p) genericDecode Options opts instance (GenericDecode a, GenericDecode b) => GenericDecode (a :*: b) where genericDecode :: Options -> Value -> Parser ((:*:) a b p) genericDecode Options opts Value o = a p -> b p -> (:*:) a b p forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> g p -> (:*:) f g p (:*:) (a p -> b p -> (:*:) a b p) -> Parser (a p) -> Parser (b p -> (:*:) a b p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Options -> Value -> Parser (a p) forall (f :: * -> *) p. GenericDecode f => Options -> Value -> Parser (f p) genericDecode Options opts Value o Parser (b p -> (:*:) a b p) -> Parser (b p) -> Parser ((:*:) a b p) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Options -> Value -> Parser (b p) forall (f :: * -> *) p. GenericDecode f => Options -> Value -> Parser (f p) genericDecode Options opts Value o instance (Selector sel, FromValue a) => GenericDecode (S1 sel (Rec0 a)) where genericDecode :: Options -> Value -> Parser (S1 sel (Rec0 a) p) genericDecode = (Object -> Key -> Parser a) -> Options -> Value -> Parser (S1 sel (Rec0 a) p) forall (sel :: Meta) a p. Selector sel => (Object -> Key -> Parser a) -> Options -> Value -> Parser (S1 sel (Rec0 a) p) accessFieldWith Object -> Key -> Parser a forall a. FromValue a => Object -> Key -> Parser a (.:) instance {-# OVERLAPPING #-} (Selector sel, FromValue a) => GenericDecode (S1 sel (Rec0 (Maybe a))) where genericDecode :: Options -> Value -> Parser (S1 sel (Rec0 (Maybe a)) p) genericDecode = (Object -> Key -> Parser (Maybe a)) -> Options -> Value -> Parser (S1 sel (Rec0 (Maybe a)) p) forall (sel :: Meta) a p. Selector sel => (Object -> Key -> Parser a) -> Options -> Value -> Parser (S1 sel (Rec0 a) p) accessFieldWith Object -> Key -> Parser (Maybe a) forall a. FromValue a => Object -> Key -> Parser (Maybe a) (.:?) accessFieldWith :: forall sel a p. Selector sel => (Object -> Key -> Parser a) -> Options -> Value -> Parser (S1 sel (Rec0 a) p) accessFieldWith :: (Object -> Key -> Parser a) -> Options -> Value -> Parser (S1 sel (Rec0 a) p) accessFieldWith Object -> Key -> Parser a op Options{String -> String optionsRecordSelectorModifier :: String -> String optionsRecordSelectorModifier :: Options -> String -> String ..} Value v = K1 R a p -> S1 sel (Rec0 a) p forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p M1 (K1 R a p -> S1 sel (Rec0 a) p) -> (a -> K1 R a p) -> a -> S1 sel (Rec0 a) p forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> K1 R a p forall k i c (p :: k). c -> K1 i c p K1 (a -> S1 sel (Rec0 a) p) -> Parser a -> Parser (S1 sel (Rec0 a) p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Object -> Parser a) -> Value -> Parser a forall a. (Object -> Parser a) -> Value -> Parser a withObject (Object -> Key -> Parser a `op` String -> Key Key.fromString String label) Value v where label :: String label = String -> String optionsRecordSelectorModifier (String -> String) -> String -> String forall a b. (a -> b) -> a -> b $ S1 sel (Rec0 a) p -> String forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *) (f :: k1 -> *) (a :: k1). Selector s => t s f a -> String selName (S1 sel (Rec0 a) p forall a. HasCallStack => a undefined :: S1 sel (Rec0 a) p)