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