module Argo.Internal.Codec.Object where import qualified Argo.Internal.Codec.Codec as Codec import qualified Argo.Internal.Codec.List as Codec import qualified Argo.Internal.Codec.Value as Codec import qualified Argo.Internal.Json.Member as Member import qualified Argo.Internal.Json.Name as Name import qualified Argo.Internal.Json.Object as Object import qualified Argo.Internal.Json.String as String 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.Internal.Type.Optional as Optional import qualified Argo.Internal.Type.Permission as Permission 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.List as List import qualified Data.Maybe as Maybe type Object a = Member a a type Member a b = Codec.Item ( Trans.AccumT (Map.Map Identifier.Identifier Schema.Schema) Identity.Identity [ ( (Name.Name, Bool) , (Maybe Identifier.Identifier, Schema.Schema) ) ] ) (Member.Member Value.Value) a b fromObjectCodec :: Permission.Permission -> Object a -> Codec.Value a fromObjectCodec :: Permission -> Object a -> Value a fromObjectCodec = (Permission -> AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))] -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema)) -> Value [Member Value] -> Permission -> Object a -> Value a forall s e a. (Permission -> s -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema)) -> Value [e] -> Permission -> List s e a -> Value a Codec.fromListCodec (\Permission permission AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))] schemasM -> do [((Name, Bool), (Maybe Identifier, Schema))] schemas <- AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))] schemasM (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 Schema -> (Maybe Identifier, Schema)) -> Maybe Schema -> 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)) -> (Maybe Schema -> Schema) -> Maybe Schema -> (Maybe Identifier, Schema) forall b c a. (b -> c) -> (a -> b) -> a -> c . [(Name, Schema)] -> [Name] -> Maybe Schema -> Schema Schema.Object ((((Name, Bool), (Maybe Identifier, Schema)) -> (Name, Schema)) -> [((Name, Bool), (Maybe Identifier, Schema))] -> [(Name, Schema)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (\((Name k, Bool _), (Maybe Identifier, Schema) s) -> (Name k, (Maybe Identifier, Schema) -> Schema Schema.maybeRef (Maybe Identifier, Schema) s)) [((Name, Bool), (Maybe Identifier, Schema))] schemas ) ((((Name, Bool), (Maybe Identifier, Schema)) -> Maybe Name) -> [((Name, Bool), (Maybe Identifier, Schema))] -> [Name] forall a b. (a -> Maybe b) -> [a] -> [b] Maybe.mapMaybe (\((Name k, Bool r), (Maybe Identifier, Schema) _) -> if Bool r then Name -> Maybe Name forall a. a -> Maybe a Just Name k else Maybe Name forall a. Maybe a Nothing) [((Name, Bool), (Maybe Identifier, Schema))] schemas ) (Maybe Schema -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema)) -> Maybe Schema -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) forall a b. (a -> b) -> a -> b $ case Permission permission of Permission Permission.Allow -> Maybe Schema forall a. Maybe a Nothing Permission Permission.Forbid -> Schema -> Maybe Schema forall a. a -> Maybe a Just Schema Schema.False ) (Value [Member Value] -> Permission -> Object a -> Value a) -> Value [Member Value] -> Permission -> Object a -> Value a forall a b. (a -> b) -> a -> b $ (Object Value -> [Member Value]) -> ([Member Value] -> Object Value) -> Codec (ReaderT Value (ExceptT String Identity)) (MaybeT (StateT Value Identity)) (AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema)) (Object Value) (Object Value) -> Value [Member Value] forall (r :: * -> *) (w :: * -> *) a b s. (Functor r, Functor w) => (a -> b) -> (b -> a) -> Codec r w s a a -> Codec r w s b b Codec.map Object Value -> [Member Value] forall value. Object value -> [Member value] Object.toList [Member Value] -> Object Value forall value. [Member value] -> Object value Object.fromList Codec (ReaderT Value (ExceptT String Identity)) (MaybeT (StateT Value Identity)) (AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema)) (Object Value) (Object Value) Codec.objectCodec required :: Name.Name -> Codec.Value a -> Object a required :: Name -> Value a -> Object a required Name k Value a c = Codec :: forall (r :: * -> *) (w :: * -> *) s i o. r o -> (i -> w o) -> s -> Codec r w s i o Codec.Codec { decode :: StateT [Member Value] (ExceptT String Identity) a Codec.decode = do Optional a m <- Codec (StateT [Member Value] (ExceptT String Identity)) (WriterT [Member Value] Identity) (AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))]) (Optional a) (Optional a) -> StateT [Member Value] (ExceptT String Identity) (Optional a) forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> r o Codec.decode (Name -> Value a -> Codec (StateT [Member Value] (ExceptT String Identity)) (WriterT [Member Value] Identity) (AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))]) (Optional a) (Optional a) forall a. Name -> Value a -> Object (Optional a) optional Name k Value a c) case Optional a -> Maybe a forall a. Optional a -> Maybe a Optional.toMaybe Optional a m of Maybe a Nothing -> ExceptT String Identity a -> StateT [Member Value] (ExceptT String Identity) a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a Trans.lift (ExceptT String Identity a -> StateT [Member Value] (ExceptT String Identity) a) -> (String -> ExceptT String Identity a) -> String -> StateT [Member Value] (ExceptT String Identity) a forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> ExceptT String Identity a forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a Trans.throwE (String -> StateT [Member Value] (ExceptT String Identity) a) -> String -> StateT [Member Value] (ExceptT String Identity) a forall a b. (a -> b) -> a -> b $ String "missing required member: " String -> String -> String forall a. Semigroup a => a -> a -> a <> Name -> String forall a. Show a => a -> String show Name k Just a x -> a -> StateT [Member Value] (ExceptT String Identity) a forall (f :: * -> *) a. Applicative f => a -> f a pure a x , encode :: a -> WriterT [Member Value] Identity a Codec.encode = \a x -> do WriterT [Member Value] Identity (Optional a) -> WriterT [Member Value] Identity () forall (f :: * -> *) a. Functor f => f a -> f () Monad.void (WriterT [Member Value] Identity (Optional a) -> WriterT [Member Value] Identity ()) -> (Optional a -> WriterT [Member Value] Identity (Optional a)) -> Optional a -> WriterT [Member Value] Identity () forall b c a. (b -> c) -> (a -> b) -> a -> c . Codec (StateT [Member Value] (ExceptT String Identity)) (WriterT [Member Value] Identity) (AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))]) (Optional a) (Optional a) -> Optional a -> WriterT [Member Value] Identity (Optional a) forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> i -> w o Codec.encode (Name -> Value a -> Codec (StateT [Member Value] (ExceptT String Identity)) (WriterT [Member Value] Identity) (AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))]) (Optional a) (Optional a) forall a. Name -> Value a -> Object (Optional a) optional Name k Value a c) (Optional a -> WriterT [Member Value] Identity ()) -> Optional a -> WriterT [Member Value] Identity () forall a b. (a -> b) -> a -> b $ a -> Optional a forall a. a -> Optional a Optional.just a x a -> WriterT [Member Value] Identity a forall (f :: * -> *) a. Applicative f => a -> f a pure a x , schema :: AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))] Codec.schema = ((Name, Bool), (Maybe Identifier, Schema)) -> [((Name, Bool), (Maybe Identifier, Schema))] forall (f :: * -> *) a. Applicative f => a -> f a pure (((Name, Bool), (Maybe Identifier, Schema)) -> [((Name, Bool), (Maybe Identifier, Schema))]) -> (Schema -> ((Name, Bool), (Maybe Identifier, Schema))) -> Schema -> [((Name, Bool), (Maybe Identifier, Schema))] forall b c a. (b -> c) -> (a -> b) -> a -> c . (,) (Name k, Bool True) ((Maybe Identifier, Schema) -> ((Name, Bool), (Maybe Identifier, Schema))) -> (Schema -> (Maybe Identifier, Schema)) -> Schema -> ((Name, Bool), (Maybe Identifier, Schema)) forall b c a. (b -> c) -> (a -> b) -> a -> c . Schema -> (Maybe Identifier, Schema) Schema.unidentified (Schema -> [((Name, Bool), (Maybe Identifier, Schema))]) -> AccumT (Map Identifier Schema) Identity Schema -> AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value a -> AccumT (Map Identifier Schema) Identity Schema forall a. Value a -> AccumT (Map Identifier Schema) Identity Schema Codec.getRef Value a c } optional :: Name.Name -> Codec.Value a -> Object (Optional.Optional a) optional :: Name -> Value a -> Object (Optional a) optional Name k Value a c = Codec :: forall (r :: * -> *) (w :: * -> *) s i o. r o -> (i -> w o) -> s -> Codec r w s i o Codec.Codec { decode :: StateT [Member Value] (ExceptT String Identity) (Optional a) Codec.decode = do [Member Value] xs <- StateT [Member Value] (ExceptT String Identity) [Member Value] forall (m :: * -> *) s. Monad m => StateT s m s Trans.get case (Member Value -> Bool) -> [Member Value] -> ([Member Value], [Member Value]) forall a. (a -> Bool) -> [a] -> ([a], [a]) List.partition (\(Member.Member Name j Value _) -> Name j Name -> Name -> Bool forall a. Eq a => a -> a -> Bool == Name k) [Member Value] xs of (Member.Member Name _ Value x : [Member Value] _, [Member Value] ys) -> case Value a -> Value -> Either String a forall a. Value a -> Value -> Either String a Codec.decodeWith Value a c Value x of Left String y -> ExceptT String Identity (Optional a) -> StateT [Member Value] (ExceptT String Identity) (Optional a) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a Trans.lift (ExceptT String Identity (Optional a) -> StateT [Member Value] (ExceptT String Identity) (Optional a)) -> ExceptT String Identity (Optional a) -> StateT [Member Value] (ExceptT String Identity) (Optional a) forall a b. (a -> b) -> a -> b $ String -> ExceptT String Identity (Optional a) forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a Trans.throwE String y Right a y -> do [Member Value] -> StateT [Member Value] (ExceptT String Identity) () forall (m :: * -> *) s. Monad m => s -> StateT s m () Trans.put [Member Value] ys Optional a -> StateT [Member Value] (ExceptT String Identity) (Optional a) forall (f :: * -> *) a. Applicative f => a -> f a pure (Optional a -> StateT [Member Value] (ExceptT String Identity) (Optional a)) -> Optional a -> StateT [Member Value] (ExceptT String Identity) (Optional a) forall a b. (a -> b) -> a -> b $ a -> Optional a forall a. a -> Optional a Optional.just a y ([Member Value], [Member Value]) _ -> Optional a -> StateT [Member Value] (ExceptT String Identity) (Optional a) forall (f :: * -> *) a. Applicative f => a -> f a pure Optional a forall a. Optional a Optional.nothing , encode :: Optional a -> WriterT [Member Value] Identity (Optional a) Codec.encode = \Optional a x -> do case Optional a -> Maybe a forall a. Optional a -> Maybe a Optional.toMaybe Optional a x of Maybe a Nothing -> () -> WriterT [Member Value] Identity () forall (f :: * -> *) a. Applicative f => a -> f a pure () Just a y -> [Member Value] -> WriterT [Member Value] Identity () forall (m :: * -> *) w. Monad m => w -> WriterT w m () Trans.tell [Name -> Value -> Member Value forall value. Name -> value -> Member value Member.Member Name k (Value -> Member Value) -> Value -> Member Value forall a b. (a -> b) -> a -> b $ Value a -> a -> Value forall a. Value a -> a -> Value Codec.encodeWith Value a c a y] Optional a -> WriterT [Member Value] Identity (Optional a) forall (f :: * -> *) a. Applicative f => a -> f a pure Optional a x , schema :: AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))] Codec.schema = ((Name, Bool), (Maybe Identifier, Schema)) -> [((Name, Bool), (Maybe Identifier, Schema))] forall (f :: * -> *) a. Applicative f => a -> f a pure (((Name, Bool), (Maybe Identifier, Schema)) -> [((Name, Bool), (Maybe Identifier, Schema))]) -> (Schema -> ((Name, Bool), (Maybe Identifier, Schema))) -> Schema -> [((Name, Bool), (Maybe Identifier, Schema))] forall b c a. (b -> c) -> (a -> b) -> a -> c . (,) (Name k, Bool False) ((Maybe Identifier, Schema) -> ((Name, Bool), (Maybe Identifier, Schema))) -> (Schema -> (Maybe Identifier, Schema)) -> Schema -> ((Name, Bool), (Maybe Identifier, Schema)) forall b c a. (b -> c) -> (a -> b) -> a -> c . Schema -> (Maybe Identifier, Schema) Schema.unidentified (Schema -> [((Name, Bool), (Maybe Identifier, Schema))]) -> AccumT (Map Identifier Schema) Identity Schema -> AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value a -> AccumT (Map Identifier Schema) Identity Schema forall a. Value a -> AccumT (Map Identifier Schema) Identity Schema Codec.getRef Value a c } tagged :: String -> Codec.Value a -> Codec.Value a tagged :: String -> Value a -> Value a tagged String t Value a c = (((), a) -> a) -> (a -> ((), a)) -> Codec (ReaderT Value (ExceptT String Identity)) (MaybeT (StateT Value Identity)) (AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema)) ((), a) ((), a) -> Value a forall (r :: * -> *) (w :: * -> *) a b s. (Functor r, Functor w) => (a -> b) -> (b -> a) -> Codec r w s a a -> Codec r w s b b Codec.map ((), a) -> a forall a b. (a, b) -> b snd ((,) ()) (Codec (ReaderT Value (ExceptT String Identity)) (MaybeT (StateT Value Identity)) (AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema)) ((), a) ((), a) -> Value a) -> (Object ((), a) -> Codec (ReaderT Value (ExceptT String Identity)) (MaybeT (StateT Value Identity)) (AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema)) ((), a) ((), a)) -> Object ((), a) -> Value a forall b c a. (b -> c) -> (a -> b) -> a -> c . Permission -> Object ((), a) -> Codec (ReaderT Value (ExceptT String Identity)) (MaybeT (StateT Value Identity)) (AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema)) ((), a) ((), a) forall a. Permission -> Object a -> Value a fromObjectCodec Permission Permission.Forbid (Object ((), a) -> Value a) -> Object ((), a) -> Value a forall a b. (a -> b) -> a -> b $ (,) (() -> a -> ((), a)) -> Codec (StateT [Member Value] (ExceptT String Identity)) (WriterT [Member Value] Identity) (AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))]) ((), a) () -> Codec (StateT [Member Value] (ExceptT String Identity)) (WriterT [Member Value] Identity) (AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))]) ((), a) (a -> ((), a)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (((), a) -> ()) -> Codec (StateT [Member Value] (ExceptT String Identity)) (WriterT [Member Value] Identity) (AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))]) () () -> Codec (StateT [Member Value] (ExceptT String Identity)) (WriterT [Member Value] Identity) (AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))]) ((), a) () forall i f (r :: * -> *) (w :: * -> *) s o. (i -> f) -> Codec r w s f o -> Codec r w s i o Codec.project ((), a) -> () forall a b. (a, b) -> a fst (Name -> Value () -> Codec (StateT [Member Value] (ExceptT String Identity)) (WriterT [Member Value] Identity) (AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))]) () () forall a. Name -> Value a -> Object a required (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 "type") (Value -> Value () Codec.literalCodec (Value -> Value ()) -> (Text -> Value) -> Text -> Value () forall b c a. (b -> c) -> (a -> b) -> a -> c . 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 -> Value ()) -> Text -> Value () forall a b. (a -> b) -> a -> b $ String -> Text Text.pack String t ) ) Codec (StateT [Member Value] (ExceptT String Identity)) (WriterT [Member Value] Identity) (AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))]) ((), a) (a -> ((), a)) -> Codec (StateT [Member Value] (ExceptT String Identity)) (WriterT [Member Value] Identity) (AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))]) ((), a) a -> Object ((), a) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (((), a) -> a) -> Codec (StateT [Member Value] (ExceptT String Identity)) (WriterT [Member Value] Identity) (AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))]) a a -> Codec (StateT [Member Value] (ExceptT String Identity)) (WriterT [Member Value] Identity) (AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))]) ((), a) a forall i f (r :: * -> *) (w :: * -> *) s o. (i -> f) -> Codec r w s f o -> Codec r w s i o Codec.project ((), a) -> a forall a b. (a, b) -> b snd (Name -> Value a -> Codec (StateT [Member Value] (ExceptT String Identity)) (WriterT [Member Value] Identity) (AccumT (Map Identifier Schema) Identity [((Name, Bool), (Maybe Identifier, Schema))]) a a forall a. Name -> Value a -> Object a required (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 "value") Value a c )