{-# LANGUAGE ScopedTypeVariables #-} module Argo.Internal.Codec.Value where import qualified Argo.Internal.Codec.Codec as Codec import qualified Argo.Internal.Json.Array as Array import qualified Argo.Internal.Json.Null as Null import qualified Argo.Internal.Json.Object as Object import qualified Argo.Internal.Json.Value as Value import qualified Argo.Internal.Schema.Identifier as Identifier import qualified Argo.Internal.Schema.Schema as Schema import qualified Argo.Vendor.Map as Map import qualified Argo.Vendor.Text as Text import qualified Argo.Vendor.Transformers as Trans import qualified Control.Monad as Monad import qualified Data.Functor.Identity as Identity import qualified Data.Typeable as Typeable decodeWith :: Value a -> Value.Value -> Either String a decodeWith :: forall a. Value a -> Value -> Either String a decodeWith Value a c = forall a. Identity a -> a Identity.runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c . forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a) Trans.runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c . forall r (m :: * -> *) a. ReaderT r m a -> r -> m a Trans.runReaderT (forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> r o Codec.decode Value a c) encodeWith :: Value a -> a -> Value.Value encodeWith :: forall a. Value a -> a -> Value encodeWith Value a c a x = forall a b. (a, b) -> b snd forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Identity a -> a Identity.runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c . forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s) Trans.runStateT (forall (m :: * -> *) a. MaybeT m a -> m (Maybe a) Trans.runMaybeT forall a b. (a -> b) -> a -> b $ forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> i -> w o Codec.encode Value a c a x) forall b c a. (b -> c) -> (a -> b) -> a -> c . Null -> Value Value.Null forall a b. (a -> b) -> a -> b $ () -> Null Null.fromUnit () type Value a = Codec.Codec (Trans.ReaderT Value.Value (Trans.ExceptT String Identity.Identity)) (Trans.MaybeT (Trans.StateT Value.Value Identity.Identity)) ( Trans.AccumT (Map.Map Identifier.Identifier Schema.Schema) Identity.Identity (Maybe Identifier.Identifier, Schema.Schema) ) a a arrayCodec :: Value (Array.Array Value.Value) arrayCodec :: Value (Array Value) arrayCodec = Codec.Codec { decode :: ReaderT Value (ExceptT String Identity) (Array Value) Codec.decode = do Value x <- forall (m :: * -> *) r. Monad m => ReaderT r m r Trans.ask case Value x of Value.Array Array Value y -> forall (f :: * -> *) a. Applicative f => a -> f a pure Array Value y Value _ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a Trans.throwE forall a b. (a -> b) -> a -> b $ String "expected Array but got " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String show Value x , encode :: Array Value -> MaybeT (StateT Value Identity) (Array Value) Codec.encode = \Array Value x -> do forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *) s. Monad m => s -> StateT s m () Trans.put forall a b. (a -> b) -> a -> b $ Array Value -> Value Value.Array Array Value x forall (f :: * -> *) a. Applicative f => a -> f a pure Array Value x , schema :: AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) Codec.schema = forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ Schema -> (Maybe Identifier, Schema) Schema.unidentified Schema Schema.false } objectCodec :: Value (Object.Object Value.Value) objectCodec :: Value (Object Value) objectCodec = Codec.Codec { decode :: ReaderT Value (ExceptT String Identity) (Object Value) Codec.decode = do Value x <- forall (m :: * -> *) r. Monad m => ReaderT r m r Trans.ask case Value x of Value.Object Object Value y -> forall (f :: * -> *) a. Applicative f => a -> f a pure Object Value y Value _ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a Trans.throwE forall a b. (a -> b) -> a -> b $ String "expected Object but got " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String show Value x , encode :: Object Value -> MaybeT (StateT Value Identity) (Object Value) Codec.encode = \Object Value x -> do forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *) s. Monad m => s -> StateT s m () Trans.put forall a b. (a -> b) -> a -> b $ Object Value -> Value Value.Object Object Value x forall (f :: * -> *) a. Applicative f => a -> f a pure Object Value x , schema :: AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) Codec.schema = forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ Schema -> (Maybe Identifier, Schema) Schema.unidentified Schema Schema.false } literalCodec :: Value.Value -> Value () literalCodec :: Value -> Value () literalCodec Value expected = Codec.Codec { decode :: ReaderT Value (ExceptT String Identity) () Codec.decode = do Value actual <- forall (m :: * -> *) r. Monad m => ReaderT r m r Trans.ask forall (f :: * -> *). Applicative f => Bool -> f () -> f () Monad.when (Value actual forall a. Eq a => a -> a -> Bool /= Value expected) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a Trans.throwE forall a b. (a -> b) -> a -> b $ String "expected " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String show Value expected forall a. Semigroup a => a -> a -> a <> String " but got " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String show Value actual , encode :: () -> MaybeT (StateT Value Identity) () Codec.encode = forall a b. a -> b -> a const forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a Trans.lift forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) s. Monad m => s -> StateT s m () Trans.put Value expected , schema :: AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) Codec.schema = forall (f :: * -> *) a. Applicative f => a -> f a pure forall b c a. (b -> c) -> (a -> b) -> a -> c . Schema -> (Maybe Identifier, Schema) Schema.unidentified forall a b. (a -> b) -> a -> b $ Value -> Schema Schema.Const Value expected } identified :: forall a . Typeable.Typeable a => Value a -> Value a identified :: forall a. Typeable a => Value a -> Value a identified = forall a. Identifier -> Value a -> Value a withIdentifier forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Identifier Identifier.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Text Text.pack forall a b. (a -> b) -> a -> b $ forall a. Typeable a => Proxy a -> String typeName (forall {k} (t :: k). Proxy t Typeable.Proxy :: Typeable.Proxy a) withIdentifier :: Identifier.Identifier -> Value a -> Value a withIdentifier :: forall a. Identifier -> Value a -> Value a withIdentifier Identifier identifier Value a codec = let newSchema :: AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) newSchema = do (Maybe Identifier _, Schema schema) <- forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> s Codec.schema Value a codec forall (m :: * -> *) w. Monad m => w -> AccumT w m () Trans.add forall a b. (a -> b) -> a -> b $ forall k a. k -> a -> Map k a Map.singleton Identifier identifier Schema schema forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ Identifier -> Schema -> (Maybe Identifier, Schema) Schema.withIdentifier Identifier identifier Schema schema in Value a codec { schema :: AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) Codec.schema = AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) newSchema } typeName :: Typeable.Typeable a => Typeable.Proxy a -> String typeName :: forall a. Typeable a => Proxy a -> String typeName = forall a. Show a => a -> String show forall b c a. (b -> c) -> (a -> b) -> a -> c . forall {k} (proxy :: k -> *) (a :: k). Typeable a => proxy a -> TypeRep Typeable.typeRep getRef :: Value a -> Trans.AccumT (Map.Map Identifier.Identifier Schema.Schema) Identity.Identity Schema.Schema getRef :: forall a. Value a -> AccumT (Map Identifier Schema) Identity Schema getRef Value a codec = do let (Maybe Identifier maybeIdentifier, Schema schema) = forall a b. (a, b) -> a fst forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Identity a -> a Identity.runIdentity forall a b. (a -> b) -> a -> b $ forall w (m :: * -> *) a. AccumT w m a -> w -> m (a, w) Trans.runAccumT (forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> s Codec.schema Value a codec) forall k a. Map k a Map.empty case Maybe Identifier maybeIdentifier of Maybe Identifier Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a pure Schema schema Just Identifier identifier -> do Map Identifier Schema schemas <- forall w (m :: * -> *). (Monoid w, Monad m) => AccumT w m w Trans.look forall (f :: * -> *). Applicative f => Bool -> f () -> f () Monad.unless (forall k a. Ord k => k -> Map k a -> Bool Map.member Identifier identifier Map Identifier Schema schemas) forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *) w. Monad m => w -> AccumT w m () Trans.add forall a b. (a -> b) -> a -> b $ forall k a. k -> a -> Map k a Map.singleton Identifier identifier Schema schema forall (f :: * -> *) a. Functor f => f a -> f () Monad.void forall a b. (a -> b) -> a -> b $ forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> s Codec.schema Value a codec forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ Identifier -> Schema Schema.Ref Identifier identifier