module Argo.Internal.Codec.Array 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.Array as Array 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.Permission as Permission import qualified Argo.Vendor.Map as Map import qualified Argo.Vendor.Transformers as Trans import qualified Data.Functor.Identity as Identity import qualified Data.List.NonEmpty as NonEmpty type Array a = Element a a type Element a b = Codec.Item ( Trans.AccumT (Map.Map Identifier.Identifier Schema.Schema) Identity.Identity [(Maybe Identifier.Identifier, Schema.Schema)] ) Value.Value a b fromArrayCodec :: Permission.Permission -> Array a -> Codec.Value a fromArrayCodec :: Permission -> Array a -> Value a fromArrayCodec = (Permission -> AccumT (Map Identifier Schema) Identity [(Maybe Identifier, Schema)] -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema)) -> Value [Value] -> Permission -> Array 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 [(Maybe Identifier, Schema)] schemasM -> do [(Maybe Identifier, Schema)] schemas <- AccumT (Map Identifier Schema) Identity [(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)) -> (Schema -> (Maybe Identifier, Schema)) -> 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 -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema)) -> Schema -> AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema) forall a b. (a -> b) -> a -> b $ Maybe Natural -> Maybe Natural -> Either Schema (NonEmpty Schema) -> Maybe Schema -> Schema Schema.Array (Natural -> Maybe Natural forall a. a -> Maybe a Just (Natural -> Maybe Natural) -> (Int -> Natural) -> Int -> Maybe Natural forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> Natural forall a b. (Integral a, Num b) => a -> b fromIntegral (Int -> Maybe Natural) -> Int -> Maybe Natural forall a b. (a -> b) -> a -> b $ [(Maybe Identifier, Schema)] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [(Maybe Identifier, Schema)] schemas) (case Permission permission of Permission Permission.Allow -> Maybe Natural forall a. Maybe a Nothing Permission Permission.Forbid -> Natural -> Maybe Natural forall a. a -> Maybe a Just (Natural -> Maybe Natural) -> (Int -> Natural) -> Int -> Maybe Natural forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> Natural forall a b. (Integral a, Num b) => a -> b fromIntegral (Int -> Maybe Natural) -> Int -> Maybe Natural forall a b. (a -> b) -> a -> b $ [(Maybe Identifier, Schema)] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [(Maybe Identifier, Schema)] schemas ) (case [Schema] -> Maybe (NonEmpty Schema) forall a. [a] -> Maybe (NonEmpty a) NonEmpty.nonEmpty ([Schema] -> Maybe (NonEmpty Schema)) -> [Schema] -> Maybe (NonEmpty Schema) forall a b. (a -> b) -> a -> b $ ((Maybe Identifier, Schema) -> Schema) -> [(Maybe Identifier, Schema)] -> [Schema] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Maybe Identifier, Schema) -> Schema Schema.maybeRef [(Maybe Identifier, Schema)] schemas of Maybe (NonEmpty Schema) Nothing -> Schema -> Either Schema (NonEmpty Schema) forall a b. a -> Either a b Left Schema Schema.False Just NonEmpty Schema xs -> NonEmpty Schema -> Either Schema (NonEmpty Schema) forall a b. b -> Either a b Right NonEmpty Schema xs ) Maybe Schema forall a. Maybe a Nothing ) (Value [Value] -> Permission -> Array a -> Value a) -> Value [Value] -> Permission -> Array a -> Value a forall a b. (a -> b) -> a -> b $ (Array Value -> [Value]) -> ([Value] -> Array Value) -> Codec (ReaderT Value (ExceptT String Identity)) (MaybeT (StateT Value Identity)) (AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema)) (Array Value) (Array Value) -> Value [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 Array Value -> [Value] forall value. Array value -> [value] Array.toList [Value] -> Array Value forall value. [value] -> Array value Array.fromList Codec (ReaderT Value (ExceptT String Identity)) (MaybeT (StateT Value Identity)) (AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema)) (Array Value) (Array Value) Codec.arrayCodec element :: Codec.Value a -> Array a element :: Value a -> Array a element 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 [Value] (ExceptT String Identity) a Codec.decode = do [Value] l <- StateT [Value] (ExceptT String Identity) [Value] forall (m :: * -> *) s. Monad m => StateT s m s Trans.get case [Value] l of [] -> ExceptT String Identity a -> StateT [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 [Value] (ExceptT String Identity) a) -> ExceptT String Identity a -> StateT [Value] (ExceptT String Identity) a forall a b. (a -> b) -> a -> b $ String -> ExceptT String Identity a forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a Trans.throwE String "unexpected empty list" Value h : [Value] t -> case Value a -> Value -> Either String a forall a. Value a -> Value -> Either String a Codec.decodeWith Value a c Value h of Left String y -> ExceptT String Identity a -> StateT [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 [Value] (ExceptT String Identity) a) -> ExceptT String Identity a -> StateT [Value] (ExceptT String Identity) a forall a b. (a -> b) -> a -> b $ String -> ExceptT String Identity a forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a Trans.throwE String y Right a y -> do [Value] -> StateT [Value] (ExceptT String Identity) () forall (m :: * -> *) s. Monad m => s -> StateT s m () Trans.put [Value] t a -> StateT [Value] (ExceptT String Identity) a forall (f :: * -> *) a. Applicative f => a -> f a pure a y , encode :: a -> WriterT [Value] Identity a Codec.encode = \a x -> do [Value] -> WriterT [Value] Identity () forall (m :: * -> *) w. Monad m => w -> WriterT w m () Trans.tell [Value a -> a -> Value forall a. Value a -> a -> Value Codec.encodeWith Value a c a x] a -> WriterT [Value] Identity a forall (f :: * -> *) a. Applicative f => a -> f a pure a x , schema :: AccumT (Map Identifier Schema) Identity [(Maybe Identifier, Schema)] Codec.schema = (Maybe Identifier, Schema) -> [(Maybe Identifier, Schema)] forall (f :: * -> *) a. Applicative f => a -> f a pure ((Maybe Identifier, Schema) -> [(Maybe Identifier, Schema)]) -> (Schema -> (Maybe Identifier, Schema)) -> Schema -> [(Maybe Identifier, Schema)] forall b c a. (b -> c) -> (a -> b) -> a -> c . Schema -> (Maybe Identifier, Schema) Schema.unidentified (Schema -> [(Maybe Identifier, Schema)]) -> AccumT (Map Identifier Schema) Identity 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 Schema forall a. Value a -> AccumT (Map Identifier Schema) Identity Schema Codec.getRef Value a c }