{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE DeriveFunctor #-} 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 , Alias(..) , unAlias ) where import Imports import Data.Monoid (Last(..)) import GHC.Generics import GHC.TypeLits import Data.Proxy 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 Data.Aeson.Config.KeyMap (member) 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], [(String, String)]) decodeValue :: FromValue a => Value -> Result a decodeValue :: forall a. FromValue a => Value -> Result a decodeValue = forall a. (Value -> Parser a) -> Value -> Either String (a, [String], [(String, String)]) runParser forall a. FromValue a => Value -> Parser a fromValue (.:) :: FromValue a => Object -> Key -> Parser a .: :: forall a. FromValue a => Object -> Key -> Parser a (.:) = forall a. (Value -> Parser a) -> Object -> Key -> Parser a explicitParseField forall a. FromValue a => Value -> Parser a fromValue (.:?) :: FromValue a => Object -> Key -> Parser (Maybe a) .:? :: forall a. FromValue a => Object -> Key -> Parser (Maybe a) (.:?) = forall a. (Value -> Parser a) -> Object -> Key -> Parser (Maybe a) explicitParseFieldMaybe 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 = 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 :: forall a (d :: Meta) (m :: * -> *). (Generic a, Rep a ~ D1 d m, Datatype d, GenericDecode (Rep a)) => Value -> Parser a genericFromValue = forall a. (Generic a, GenericDecode (Rep a)) => Options -> Value -> Parser a genericFromValueWith ((String -> String) -> Options Options forall a b. (a -> b) -> a -> b $ String -> String -> String hyphenize String name) where name :: String name :: String name = forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *) (f :: k1 -> *) (a :: k1). Datatype d => t d f a -> String datatypeName (forall a. HasCallStack => a undefined :: D1 d m p) instance FromValue Bool where fromValue :: Value -> Parser Bool fromValue = forall a. Parser a -> Parser a liftParser forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. FromJSON a => Value -> Parser a parseJSON instance FromValue Int where fromValue :: Value -> Parser Int fromValue = forall a. Parser a -> Parser a liftParser forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. FromJSON a => Value -> Parser a parseJSON instance FromValue Text where fromValue :: Value -> Parser Text fromValue = forall a. Parser a -> Parser a liftParser forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. FromJSON a => Value -> Parser a parseJSON instance {-# OVERLAPPING #-} FromValue String where fromValue :: Value -> Parser String fromValue = forall a. Parser a -> Parser a liftParser forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. FromJSON a => Value -> Parser a parseJSON instance FromValue a => FromValue (Maybe a) where fromValue :: Value -> Parser (Maybe a) fromValue Value value = forall a. Parser a -> Parser a liftParser (forall a. FromJSON a => Value -> Parser a parseJSON Value value) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse forall a. FromValue a => Value -> Parser a fromValue instance FromValue a => FromValue [a] where fromValue :: Value -> Parser [a] fromValue = forall a. (Array -> Parser a) -> Value -> Parser a withArray (forall a. (Value -> Parser a) -> Array -> Parser [a] parseArray forall a. FromValue a => Value -> Parser a fromValue) parseArray :: (Value -> Parser a) -> Array -> Parser [a] parseArray :: forall a. (Value -> Parser a) -> Array -> Parser [a] parseArray Value -> Parser a f = forall (m :: * -> *) a b c. Applicative m => (a -> b -> m c) -> [a] -> [b] -> m [c] zipWithM (forall a. (Value -> Parser a) -> Int -> Value -> Parser a parseIndexed Value -> Parser a f) [Int 0..] forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Vector a -> [a] V.toList where parseIndexed :: (Value -> Parser a) -> Int -> Value -> Parser a parseIndexed :: forall a. (Value -> Parser a) -> Int -> Value -> Parser a parseIndexed Value -> Parser a p Int n Value value = Value -> Parser a p Value value 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 = forall a. (Object -> Parser a) -> Value -> Parser a withObject forall a b. (a -> b) -> a -> b $ \ Object o -> do [(Key, a)] xs <- forall a. (Value -> Parser a) -> Object -> Parser [(Key, a)] traverseObject forall a. FromValue a => Value -> Parser a fromValue Object o forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall k a. Ord k => [(k, a)] -> Map k a Map.fromList (forall a b. (a -> b) -> [a] -> [b] map (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 :: forall a. (Value -> Parser a) -> Object -> Parser [(Key, a)] traverseObject Value -> Parser a f Object o = do forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b) forM (forall v. KeyMap v -> [(Key, v)] KeyMap.toList Object o) forall a b. (a -> b) -> a -> b $ \ (Key name, Value value) -> (,) Key name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value -> Parser a f Value value 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 = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. FromValue a => Value -> Parser a fromValue Value v forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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 = forall a b. a -> Either a b Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. FromValue a => Value -> Parser a fromValue Value v forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> forall a b. b -> Either a b Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 :: forall a. (Generic a, GenericDecode (Rep a)) => Options -> Value -> Parser a genericFromValueWith Options opts = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a x. Generic a => Rep a x -> a to forall b c a. (b -> c) -> (a -> b) -> a -> c . 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 :: forall p. Options -> Value -> Parser (D1 d a p) genericDecode Options opts = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p M1 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) p. GenericDecode f => Options -> Value -> Parser (f p) genericDecode Options opts instance (GenericDecode a) => GenericDecode (C1 c a) where genericDecode :: forall p. Options -> Value -> Parser (C1 c a p) genericDecode Options opts = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p M1 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) p. GenericDecode f => Options -> Value -> Parser (f p) genericDecode Options opts instance (GenericDecode a, GenericDecode b) => GenericDecode (a :*: b) where genericDecode :: forall p. Options -> Value -> Parser ((:*:) a b p) genericDecode Options opts Value o = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> g p -> (:*:) f g p (:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (f :: * -> *) p. GenericDecode f => Options -> Value -> Parser (f p) genericDecode Options opts Value o forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall (f :: * -> *) p. GenericDecode f => Options -> Value -> Parser (f p) genericDecode Options opts Value o type RecordField sel a = S1 sel (Rec0 a) instance (Selector sel, FromValue a) => GenericDecode (RecordField sel a) where genericDecode :: forall p. Options -> Value -> Parser (RecordField sel a p) genericDecode = forall (sel :: Meta) a p. Selector sel => (Object -> Key -> Parser a) -> Options -> Value -> Parser (RecordField sel a p) accessFieldWith forall a. FromValue a => Object -> Key -> Parser a (.:) instance {-# OVERLAPPING #-} (Selector sel, FromValue a) => GenericDecode (RecordField sel (Maybe a)) where genericDecode :: forall p. Options -> Value -> Parser (RecordField sel (Maybe a) p) genericDecode = forall (sel :: Meta) a p. Selector sel => (Object -> Key -> Parser a) -> Options -> Value -> Parser (RecordField sel a p) accessFieldWith forall a. FromValue a => Object -> Key -> Parser (Maybe a) (.:?) instance {-# OVERLAPPING #-} (Selector sel, FromValue a) => GenericDecode (RecordField sel (Last a)) where genericDecode :: forall p. Options -> Value -> Parser (RecordField sel (Last a) p) genericDecode = forall (sel :: Meta) a p. Selector sel => (Object -> Key -> Parser a) -> Options -> Value -> Parser (RecordField sel a p) accessFieldWith (\ Object value Key key -> forall a. Maybe a -> Last a Last forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Object value forall a. FromValue a => Object -> Key -> Parser (Maybe a) .:? Key key)) instance {-# OVERLAPPING #-} (Selector sel, FromValue a, KnownBool deprecated, KnownSymbol alias) => GenericDecode (RecordField sel (Alias deprecated alias (Maybe a))) where genericDecode :: forall p. Options -> Value -> Parser (RecordField sel (Alias deprecated alias (Maybe a)) p) genericDecode = forall (sel :: Meta) a p. Selector sel => (Object -> Key -> Parser a) -> Options -> Value -> Parser (RecordField sel a p) accessFieldWith (\ Object value Key key -> forall (deprecated :: Bool) (alias :: Symbol) a. (KnownBool deprecated, KnownSymbol alias) => (Object -> Key -> Parser a) -> Object -> Alias deprecated alias Key -> Parser (Alias deprecated alias a) aliasAccess forall a. FromValue a => Object -> Key -> Parser (Maybe a) (.:?) Object value (forall (deprecated :: Bool) (alias :: Symbol) a. a -> Alias deprecated alias a Alias Key key)) instance {-# OVERLAPPING #-} (Selector sel, FromValue a, KnownBool deprecated, KnownSymbol alias) => GenericDecode (RecordField sel (Alias deprecated alias (Last a))) where genericDecode :: forall p. Options -> Value -> Parser (RecordField sel (Alias deprecated alias (Last a)) p) genericDecode = forall (sel :: Meta) a p. Selector sel => (Object -> Key -> Parser a) -> Options -> Value -> Parser (RecordField sel a p) accessFieldWith (\ Object value Key key -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a. Maybe a -> Last a Last forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (deprecated :: Bool) (alias :: Symbol) a. (KnownBool deprecated, KnownSymbol alias) => (Object -> Key -> Parser a) -> Object -> Alias deprecated alias Key -> Parser (Alias deprecated alias a) aliasAccess forall a. FromValue a => Object -> Key -> Parser (Maybe a) (.:?) Object value (forall (deprecated :: Bool) (alias :: Symbol) a. a -> Alias deprecated alias a Alias Key key)) aliasAccess :: forall deprecated alias a. (KnownBool deprecated, KnownSymbol alias) => (Object -> Key -> Parser a) -> Object -> (Alias deprecated alias Key) -> Parser (Alias deprecated alias a) aliasAccess :: forall (deprecated :: Bool) (alias :: Symbol) a. (KnownBool deprecated, KnownSymbol alias) => (Object -> Key -> Parser a) -> Object -> Alias deprecated alias Key -> Parser (Alias deprecated alias a) aliasAccess Object -> Key -> Parser a op Object value (Alias Key key) | Key alias forall a. Key -> KeyMap a -> Bool `member` Object value Bool -> Bool -> Bool && Bool -> Bool not (Key key forall a. Key -> KeyMap a -> Bool `member` Object value) = forall (deprecated :: Bool) (alias :: Symbol) a. a -> Alias deprecated alias a Alias forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object value Object -> Key -> Parser a `op` Key alias forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Parser () deprecated | Bool otherwise = forall (deprecated :: Bool) (alias :: Symbol) a. a -> Alias deprecated alias a Alias forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object value Object -> Key -> Parser a `op` Key key where deprecated :: Parser () deprecated = case forall (a :: Bool). KnownBool a => Proxy a -> Bool boolVal (forall {k} (t :: k). Proxy t Proxy @deprecated) of Bool False -> forall (m :: * -> *) a. Monad m => a -> m a return () Bool True -> Key -> Key -> Parser () markDeprecated Key alias Key key alias :: Key alias = String -> Key Key.fromString (forall (n :: Symbol) (proxy :: Symbol -> *). KnownSymbol n => proxy n -> String symbolVal forall a b. (a -> b) -> a -> b $ forall {k} (t :: k). Proxy t Proxy @alias) accessFieldWith :: forall sel a p. Selector sel => (Object -> Key -> Parser a) -> Options -> Value -> Parser (RecordField sel a p) accessFieldWith :: forall (sel :: Meta) a p. Selector sel => (Object -> Key -> Parser a) -> Options -> Value -> Parser (RecordField sel a p) accessFieldWith Object -> Key -> Parser a op Options{String -> String optionsRecordSelectorModifier :: String -> String optionsRecordSelectorModifier :: Options -> String -> String ..} Value v = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p M1 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall k i c (p :: k). c -> K1 i c p K1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> 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 forall a b. (a -> b) -> a -> b $ forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *) (f :: k1 -> *) (a :: k1). Selector s => t s f a -> String selName (forall a. HasCallStack => a undefined :: RecordField sel a p) newtype Alias (deprecated :: Bool) (alias :: Symbol) a = Alias a deriving (Int -> Alias deprecated alias a -> String -> String forall (deprecated :: Bool) (alias :: Symbol) a. Show a => Int -> Alias deprecated alias a -> String -> String forall (deprecated :: Bool) (alias :: Symbol) a. Show a => [Alias deprecated alias a] -> String -> String forall (deprecated :: Bool) (alias :: Symbol) a. Show a => Alias deprecated alias a -> String forall a. (Int -> a -> String -> String) -> (a -> String) -> ([a] -> String -> String) -> Show a showList :: [Alias deprecated alias a] -> String -> String $cshowList :: forall (deprecated :: Bool) (alias :: Symbol) a. Show a => [Alias deprecated alias a] -> String -> String show :: Alias deprecated alias a -> String $cshow :: forall (deprecated :: Bool) (alias :: Symbol) a. Show a => Alias deprecated alias a -> String showsPrec :: Int -> Alias deprecated alias a -> String -> String $cshowsPrec :: forall (deprecated :: Bool) (alias :: Symbol) a. Show a => Int -> Alias deprecated alias a -> String -> String Show, Alias deprecated alias a -> Alias deprecated alias a -> Bool forall (deprecated :: Bool) (alias :: Symbol) a. Eq a => Alias deprecated alias a -> Alias deprecated alias a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Alias deprecated alias a -> Alias deprecated alias a -> Bool $c/= :: forall (deprecated :: Bool) (alias :: Symbol) a. Eq a => Alias deprecated alias a -> Alias deprecated alias a -> Bool == :: Alias deprecated alias a -> Alias deprecated alias a -> Bool $c== :: forall (deprecated :: Bool) (alias :: Symbol) a. Eq a => Alias deprecated alias a -> Alias deprecated alias a -> Bool Eq, NonEmpty (Alias deprecated alias a) -> Alias deprecated alias a Alias deprecated alias a -> Alias deprecated alias a -> Alias deprecated alias a forall (deprecated :: Bool) (alias :: Symbol) a. Semigroup a => NonEmpty (Alias deprecated alias a) -> Alias deprecated alias a forall (deprecated :: Bool) (alias :: Symbol) a. Semigroup a => Alias deprecated alias a -> Alias deprecated alias a -> Alias deprecated alias a forall (deprecated :: Bool) (alias :: Symbol) a b. (Semigroup a, Integral b) => b -> Alias deprecated alias a -> Alias deprecated alias a forall b. Integral b => b -> Alias deprecated alias a -> Alias deprecated alias a forall a. (a -> a -> a) -> (NonEmpty a -> a) -> (forall b. Integral b => b -> a -> a) -> Semigroup a stimes :: forall b. Integral b => b -> Alias deprecated alias a -> Alias deprecated alias a $cstimes :: forall (deprecated :: Bool) (alias :: Symbol) a b. (Semigroup a, Integral b) => b -> Alias deprecated alias a -> Alias deprecated alias a sconcat :: NonEmpty (Alias deprecated alias a) -> Alias deprecated alias a $csconcat :: forall (deprecated :: Bool) (alias :: Symbol) a. Semigroup a => NonEmpty (Alias deprecated alias a) -> Alias deprecated alias a <> :: Alias deprecated alias a -> Alias deprecated alias a -> Alias deprecated alias a $c<> :: forall (deprecated :: Bool) (alias :: Symbol) a. Semigroup a => Alias deprecated alias a -> Alias deprecated alias a -> Alias deprecated alias a Semigroup, Alias deprecated alias a [Alias deprecated alias a] -> Alias deprecated alias a Alias deprecated alias a -> Alias deprecated alias a -> Alias deprecated alias a forall {deprecated :: Bool} {alias :: Symbol} {a}. Monoid a => Semigroup (Alias deprecated alias a) forall (deprecated :: Bool) (alias :: Symbol) a. Monoid a => Alias deprecated alias a forall (deprecated :: Bool) (alias :: Symbol) a. Monoid a => [Alias deprecated alias a] -> Alias deprecated alias a forall (deprecated :: Bool) (alias :: Symbol) a. Monoid a => Alias deprecated alias a -> Alias deprecated alias a -> Alias deprecated alias a forall a. Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a mconcat :: [Alias deprecated alias a] -> Alias deprecated alias a $cmconcat :: forall (deprecated :: Bool) (alias :: Symbol) a. Monoid a => [Alias deprecated alias a] -> Alias deprecated alias a mappend :: Alias deprecated alias a -> Alias deprecated alias a -> Alias deprecated alias a $cmappend :: forall (deprecated :: Bool) (alias :: Symbol) a. Monoid a => Alias deprecated alias a -> Alias deprecated alias a -> Alias deprecated alias a mempty :: Alias deprecated alias a $cmempty :: forall (deprecated :: Bool) (alias :: Symbol) a. Monoid a => Alias deprecated alias a Monoid, forall (deprecated :: Bool) (alias :: Symbol) a b. a -> Alias deprecated alias b -> Alias deprecated alias a forall (deprecated :: Bool) (alias :: Symbol) a b. (a -> b) -> Alias deprecated alias a -> Alias deprecated alias b forall a b. a -> Alias deprecated alias b -> Alias deprecated alias a forall a b. (a -> b) -> Alias deprecated alias a -> Alias deprecated alias 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 -> Alias deprecated alias b -> Alias deprecated alias a $c<$ :: forall (deprecated :: Bool) (alias :: Symbol) a b. a -> Alias deprecated alias b -> Alias deprecated alias a fmap :: forall a b. (a -> b) -> Alias deprecated alias a -> Alias deprecated alias b $cfmap :: forall (deprecated :: Bool) (alias :: Symbol) a b. (a -> b) -> Alias deprecated alias a -> Alias deprecated alias b Functor) unAlias :: Alias deprecated alias a -> a unAlias :: forall (deprecated :: Bool) (alias :: Symbol) a. Alias deprecated alias a -> a unAlias (Alias a a) = a a class KnownBool (a :: Bool) where boolVal :: Proxy a -> Bool instance KnownBool 'True where boolVal :: Proxy 'True -> Bool boolVal Proxy 'True _ = Bool True instance KnownBool 'False where boolVal :: Proxy 'False -> Bool boolVal Proxy 'False _ = Bool False