{-# LANGUAGE ScopedTypeVariables #-} module Argo.Codec.Value where import qualified Argo.Codec.Codec as Codec import qualified Argo.Json.Array as Array import qualified Argo.Json.Member as Member import qualified Argo.Json.Name as Name import qualified Argo.Json.Null as Null import qualified Argo.Json.Object as Object import qualified Argo.Json.String as String import qualified Argo.Json.Value as Value import qualified Argo.Schema.Identifier as Identifier import qualified Argo.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 :: Value a -> Value -> Either String a decodeWith Value a c = Identity (Either String a) -> Either String a forall a. Identity a -> a Identity.runIdentity (Identity (Either String a) -> Either String a) -> (Value -> Identity (Either String a)) -> Value -> Either String a forall b c a. (b -> c) -> (a -> b) -> a -> c . ExceptT String Identity a -> Identity (Either String a) forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a) Trans.runExceptT (ExceptT String Identity a -> Identity (Either String a)) -> (Value -> ExceptT String Identity a) -> Value -> Identity (Either String a) forall b c a. (b -> c) -> (a -> b) -> a -> c . ReaderT Value (ExceptT String Identity) a -> Value -> ExceptT String Identity a forall r (m :: * -> *) a. ReaderT r m a -> r -> m a Trans.runReaderT (Value a -> ReaderT Value (ExceptT String Identity) a 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 :: Value a -> a -> Value encodeWith Value a c a x = (Maybe a, Value) -> Value forall a b. (a, b) -> b snd ((Maybe a, Value) -> Value) -> (Null -> (Maybe a, Value)) -> Null -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . Identity (Maybe a, Value) -> (Maybe a, Value) forall a. Identity a -> a Identity.runIdentity (Identity (Maybe a, Value) -> (Maybe a, Value)) -> (Null -> Identity (Maybe a, Value)) -> Null -> (Maybe a, Value) forall b c a. (b -> c) -> (a -> b) -> a -> c . StateT Value Identity (Maybe a) -> Value -> Identity (Maybe a, Value) forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s) Trans.runStateT (MaybeT (StateT Value Identity) a -> StateT Value Identity (Maybe a) forall (m :: * -> *) a. MaybeT m a -> m (Maybe a) Trans.runMaybeT (MaybeT (StateT Value Identity) a -> StateT Value Identity (Maybe a)) -> MaybeT (StateT Value Identity) a -> StateT Value Identity (Maybe a) forall a b. (a -> b) -> a -> b $ Value a -> a -> MaybeT (StateT Value Identity) a forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> i -> w o Codec.encode Value a c a x) (Value -> Identity (Maybe a, Value)) -> (Null -> Value) -> Null -> Identity (Maybe a, Value) forall b c a. (b -> c) -> (a -> b) -> a -> c . Null -> Value Value.Null (Null -> Value) -> Null -> Value 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 :: forall (r :: * -> *) (w :: * -> *) s i o. r o -> (i -> w o) -> s -> Codec r w s i o Codec.Codec { decode :: ReaderT Value (ExceptT String Identity) (Array Value) Codec.decode = do Value x <- ReaderT Value (ExceptT String Identity) Value forall (m :: * -> *) r. Monad m => ReaderT r m r Trans.ask case Value x of Value.Array Array Value y -> Array Value -> ReaderT Value (ExceptT String Identity) (Array Value) forall (f :: * -> *) a. Applicative f => a -> f a pure Array Value y Value _ -> ExceptT String Identity (Array Value) -> ReaderT Value (ExceptT String Identity) (Array Value) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a Trans.lift (ExceptT String Identity (Array Value) -> ReaderT Value (ExceptT String Identity) (Array Value)) -> (String -> ExceptT String Identity (Array Value)) -> String -> ReaderT Value (ExceptT String Identity) (Array Value) forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> ExceptT String Identity (Array Value) forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a Trans.throwE (String -> ReaderT Value (ExceptT String Identity) (Array Value)) -> String -> ReaderT Value (ExceptT String Identity) (Array Value) forall a b. (a -> b) -> a -> b $ String "expected Array but got " String -> String -> String forall a. Semigroup a => a -> a -> a <> Value -> String forall a. Show a => a -> String show Value x , encode :: Array Value -> MaybeT (StateT Value Identity) (Array Value) Codec.encode = \Array Value x -> do StateT Value Identity () -> MaybeT (StateT Value Identity) () forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a Trans.lift (StateT Value Identity () -> MaybeT (StateT Value Identity) ()) -> (Value -> StateT Value Identity ()) -> Value -> MaybeT (StateT Value Identity) () forall b c a. (b -> c) -> (a -> b) -> a -> c . Value -> StateT Value Identity () forall (m :: * -> *) s. Monad m => s -> StateT s m () Trans.put (Value -> MaybeT (StateT Value Identity) ()) -> Value -> MaybeT (StateT Value Identity) () forall a b. (a -> b) -> a -> b $ Array Value -> Value Value.Array Array Value x Array Value -> MaybeT (StateT Value Identity) (Array Value) forall (f :: * -> *) a. Applicative f => a -> f a pure Array Value x , schema :: AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) Codec.schema = (Maybe Identifier, Schema) -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) forall (f :: * -> *) a. Applicative f => a -> f a pure ((Maybe Identifier, Schema) -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema)) -> (Maybe Identifier, Schema) -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) 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 :: forall (r :: * -> *) (w :: * -> *) s i o. r o -> (i -> w o) -> s -> Codec r w s i o Codec.Codec { decode :: ReaderT Value (ExceptT String Identity) (Object Value) Codec.decode = do Value x <- ReaderT Value (ExceptT String Identity) Value forall (m :: * -> *) r. Monad m => ReaderT r m r Trans.ask case Value x of Value.Object Object Value y -> Object Value -> ReaderT Value (ExceptT String Identity) (Object Value) forall (f :: * -> *) a. Applicative f => a -> f a pure Object Value y Value _ -> ExceptT String Identity (Object Value) -> ReaderT Value (ExceptT String Identity) (Object Value) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a Trans.lift (ExceptT String Identity (Object Value) -> ReaderT Value (ExceptT String Identity) (Object Value)) -> (String -> ExceptT String Identity (Object Value)) -> String -> ReaderT Value (ExceptT String Identity) (Object Value) forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> ExceptT String Identity (Object Value) forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a Trans.throwE (String -> ReaderT Value (ExceptT String Identity) (Object Value)) -> String -> ReaderT Value (ExceptT String Identity) (Object Value) forall a b. (a -> b) -> a -> b $ String "expected Object but got " String -> String -> String forall a. Semigroup a => a -> a -> a <> Value -> String forall a. Show a => a -> String show Value x , encode :: Object Value -> MaybeT (StateT Value Identity) (Object Value) Codec.encode = \Object Value x -> do StateT Value Identity () -> MaybeT (StateT Value Identity) () forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a Trans.lift (StateT Value Identity () -> MaybeT (StateT Value Identity) ()) -> (Value -> StateT Value Identity ()) -> Value -> MaybeT (StateT Value Identity) () forall b c a. (b -> c) -> (a -> b) -> a -> c . Value -> StateT Value Identity () forall (m :: * -> *) s. Monad m => s -> StateT s m () Trans.put (Value -> MaybeT (StateT Value Identity) ()) -> Value -> MaybeT (StateT Value Identity) () forall a b. (a -> b) -> a -> b $ Object Value -> Value Value.Object Object Value x Object Value -> MaybeT (StateT Value Identity) (Object Value) forall (f :: * -> *) a. Applicative f => a -> f a pure Object Value x , schema :: AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) Codec.schema = (Maybe Identifier, Schema) -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) forall (f :: * -> *) a. Applicative f => a -> f a pure ((Maybe Identifier, Schema) -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema)) -> (Maybe Identifier, Schema) -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) 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 :: forall (r :: * -> *) (w :: * -> *) s i o. r o -> (i -> w o) -> s -> Codec r w s i o Codec.Codec { decode :: ReaderT Value (ExceptT String Identity) () Codec.decode = do Value actual <- ReaderT Value (ExceptT String Identity) Value forall (m :: * -> *) r. Monad m => ReaderT r m r Trans.ask Bool -> ReaderT Value (ExceptT String Identity) () -> ReaderT Value (ExceptT String Identity) () forall (f :: * -> *). Applicative f => Bool -> f () -> f () Monad.when (Value actual Value -> Value -> Bool forall a. Eq a => a -> a -> Bool /= Value expected) (ReaderT Value (ExceptT String Identity) () -> ReaderT Value (ExceptT String Identity) ()) -> (String -> ReaderT Value (ExceptT String Identity) ()) -> String -> ReaderT Value (ExceptT String Identity) () forall b c a. (b -> c) -> (a -> b) -> a -> c . ExceptT String Identity () -> ReaderT Value (ExceptT String Identity) () forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a Trans.lift (ExceptT String Identity () -> ReaderT Value (ExceptT String Identity) ()) -> (String -> ExceptT String Identity ()) -> String -> ReaderT Value (ExceptT String Identity) () forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> ExceptT String Identity () forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a Trans.throwE (String -> ReaderT Value (ExceptT String Identity) ()) -> String -> ReaderT Value (ExceptT String Identity) () forall a b. (a -> b) -> a -> b $ String "expected " String -> String -> String forall a. Semigroup a => a -> a -> a <> Value -> String forall a. Show a => a -> String show Value expected String -> String -> String forall a. Semigroup a => a -> a -> a <> String " but got " String -> String -> String forall a. Semigroup a => a -> a -> a <> Value -> String forall a. Show a => a -> String show Value actual , encode :: () -> MaybeT (StateT Value Identity) () Codec.encode = MaybeT (StateT Value Identity) () -> () -> MaybeT (StateT Value Identity) () forall a b. a -> b -> a const (MaybeT (StateT Value Identity) () -> () -> MaybeT (StateT Value Identity) ()) -> (StateT Value Identity () -> MaybeT (StateT Value Identity) ()) -> StateT Value Identity () -> () -> MaybeT (StateT Value Identity) () forall b c a. (b -> c) -> (a -> b) -> a -> c . StateT Value Identity () -> MaybeT (StateT Value Identity) () forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a Trans.lift (StateT Value Identity () -> () -> MaybeT (StateT Value Identity) ()) -> StateT Value Identity () -> () -> MaybeT (StateT Value Identity) () forall a b. (a -> b) -> a -> b $ Value -> StateT Value Identity () forall (m :: * -> *) s. Monad m => s -> StateT s m () Trans.put Value expected , schema :: AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) Codec.schema = (Maybe Identifier, Schema) -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) forall (f :: * -> *) a. Applicative f => a -> f a pure ((Maybe Identifier, Schema) -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema)) -> (Object Value -> (Maybe Identifier, Schema)) -> Object Value -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) forall b c a. (b -> c) -> (a -> b) -> a -> c . Schema -> (Maybe Identifier, Schema) Schema.unidentified (Schema -> (Maybe Identifier, Schema)) -> (Object Value -> Schema) -> Object Value -> (Maybe Identifier, Schema) forall b c a. (b -> c) -> (a -> b) -> a -> c . Value -> Schema Schema.fromValue (Value -> Schema) -> (Object Value -> Value) -> Object Value -> Schema forall b c a. (b -> c) -> (a -> b) -> a -> c . Object Value -> Value Value.Object (Object Value -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema)) -> Object Value -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) forall a b. (a -> b) -> a -> b $ [Member Value] -> Object Value forall value. [Member value] -> Object value Object.fromList [ (Name, Value) -> Member Value forall value. (Name, value) -> Member value Member.fromTuple ( String -> Name Name.fromString (String -> Name) -> (Text -> String) -> Text -> Name forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String String.fromText (Text -> Name) -> Text -> Name forall a b. (a -> b) -> a -> b $ String -> Text Text.pack String "const" , Value expected ) ] } identified :: forall a . Typeable.Typeable a => Value a -> Value a identified :: Value a -> Value a identified Value a c = let i :: Identifier i = Text -> Identifier Identifier.fromText (Text -> Identifier) -> (TypeRep -> Text) -> TypeRep -> Identifier forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Text Text.pack (String -> Text) -> (TypeRep -> String) -> TypeRep -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . TypeRep -> String forall a. Show a => a -> String show (TypeRep -> Identifier) -> TypeRep -> Identifier forall a b. (a -> b) -> a -> b $ Proxy a -> TypeRep forall k (proxy :: k -> *) (a :: k). Typeable a => proxy a -> TypeRep Typeable.typeRep (Proxy a forall k (t :: k). Proxy t Typeable.Proxy :: Typeable.Proxy a) in Value a c { schema :: AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) Codec.schema = Identifier -> Schema -> (Maybe Identifier, Schema) Schema.identified Identifier i (Schema -> (Maybe Identifier, Schema)) -> ((Maybe Identifier, Schema) -> Schema) -> (Maybe Identifier, Schema) -> (Maybe Identifier, Schema) forall b c a. (b -> c) -> (a -> b) -> a -> c . (Maybe Identifier, Schema) -> Schema forall a b. (a, b) -> b snd ((Maybe Identifier, Schema) -> (Maybe Identifier, Schema)) -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value a -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> s Codec.schema Value a c } getRef :: Value a -> Trans.AccumT (Map.Map Identifier.Identifier Schema.Schema) Identity.Identity (Either Schema.Schema Identifier.Identifier) getRef :: Value a -> AccumT (Map Identifier Schema) Identity (Either Schema Identifier) getRef Value a codec = do let (Maybe Identifier maybeIdentifier, Schema schema) = ((Maybe Identifier, Schema), Map Identifier Schema) -> (Maybe Identifier, Schema) forall a b. (a, b) -> a fst (((Maybe Identifier, Schema), Map Identifier Schema) -> (Maybe Identifier, Schema)) -> (Identity ((Maybe Identifier, Schema), Map Identifier Schema) -> ((Maybe Identifier, Schema), Map Identifier Schema)) -> Identity ((Maybe Identifier, Schema), Map Identifier Schema) -> (Maybe Identifier, Schema) forall b c a. (b -> c) -> (a -> b) -> a -> c . Identity ((Maybe Identifier, Schema), Map Identifier Schema) -> ((Maybe Identifier, Schema), Map Identifier Schema) forall a. Identity a -> a Identity.runIdentity (Identity ((Maybe Identifier, Schema), Map Identifier Schema) -> (Maybe Identifier, Schema)) -> Identity ((Maybe Identifier, Schema), Map Identifier Schema) -> (Maybe Identifier, Schema) forall a b. (a -> b) -> a -> b $ AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) -> Map Identifier Schema -> Identity ((Maybe Identifier, Schema), Map Identifier Schema) forall w (m :: * -> *) a. AccumT w m a -> w -> m (a, w) Trans.runAccumT (Value a -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> s Codec.schema Value a codec) Map Identifier Schema forall k a. Map k a Map.empty case Maybe Identifier maybeIdentifier of Maybe Identifier Nothing -> Either Schema Identifier -> AccumT (Map Identifier Schema) Identity (Either Schema Identifier) forall (f :: * -> *) a. Applicative f => a -> f a pure (Either Schema Identifier -> AccumT (Map Identifier Schema) Identity (Either Schema Identifier)) -> Either Schema Identifier -> AccumT (Map Identifier Schema) Identity (Either Schema Identifier) forall a b. (a -> b) -> a -> b $ Schema -> Either Schema Identifier forall a b. a -> Either a b Left Schema schema Just Identifier identifier -> do Map Identifier Schema schemas <- AccumT (Map Identifier Schema) Identity (Map Identifier Schema) forall w (m :: * -> *). (Monoid w, Monad m) => AccumT w m w Trans.look Bool -> AccumT (Map Identifier Schema) Identity () -> AccumT (Map Identifier Schema) Identity () forall (f :: * -> *). Applicative f => Bool -> f () -> f () Monad.unless (Identifier -> Map Identifier Schema -> Bool forall k a. Ord k => k -> Map k a -> Bool Map.member Identifier identifier Map Identifier Schema schemas) (AccumT (Map Identifier Schema) Identity () -> AccumT (Map Identifier Schema) Identity ()) -> AccumT (Map Identifier Schema) Identity () -> AccumT (Map Identifier Schema) Identity () forall a b. (a -> b) -> a -> b $ do Map Identifier Schema -> AccumT (Map Identifier Schema) Identity () forall (m :: * -> *) w. Monad m => w -> AccumT w m () Trans.add (Map Identifier Schema -> AccumT (Map Identifier Schema) Identity ()) -> Map Identifier Schema -> AccumT (Map Identifier Schema) Identity () forall a b. (a -> b) -> a -> b $ Identifier -> Schema -> Map Identifier Schema forall k a. k -> a -> Map k a Map.singleton Identifier identifier Schema schema AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) -> AccumT (Map Identifier Schema) Identity () forall (f :: * -> *) a. Functor f => f a -> f () Monad.void (AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) -> AccumT (Map Identifier Schema) Identity ()) -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) -> AccumT (Map Identifier Schema) Identity () forall a b. (a -> b) -> a -> b $ Value a -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> s Codec.schema Value a codec Either Schema Identifier -> AccumT (Map Identifier Schema) Identity (Either Schema Identifier) forall (f :: * -> *) a. Applicative f => a -> f a pure (Either Schema Identifier -> AccumT (Map Identifier Schema) Identity (Either Schema Identifier)) -> Either Schema Identifier -> AccumT (Map Identifier Schema) Identity (Either Schema Identifier) forall a b. (a -> b) -> a -> b $ Identifier -> Either Schema Identifier forall a b. b -> Either a b Right Identifier identifier ref :: Either Schema.Schema Identifier.Identifier -> Value.Value ref :: Either Schema Identifier -> Value ref Either Schema Identifier e = case Either Schema Identifier e of Left Schema s -> Schema -> Value Schema.toValue Schema s Right Identifier i -> Object Value -> Value Value.Object (Object Value -> Value) -> Object Value -> Value forall a b. (a -> b) -> a -> b $ [Member Value] -> Object Value forall value. [Member value] -> Object value Object.fromList [ (Name, Value) -> Member Value forall value. (Name, value) -> Member value Member.fromTuple ( String -> Name Name.fromString (String -> Name) -> (Text -> String) -> Text -> Name forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String String.fromText (Text -> Name) -> Text -> Name forall a b. (a -> b) -> a -> b $ String -> Text Text.pack String "$ref" , String -> Value Value.String (String -> Value) -> (Text -> String) -> Text -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String String.fromText (Text -> String) -> (Text -> Text) -> Text -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Text -> Text forall a. Monoid a => a -> a -> a mappend (String -> Text Text.pack String "#/definitions/") (Text -> Value) -> Text -> Value forall a b. (a -> b) -> a -> b $ Identifier -> Text Identifier.toText Identifier i ) ]