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 :: forall a. Permission -> Array a -> Value a fromArrayCodec = 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 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 $ Maybe Natural -> Maybe Natural -> Either Schema (NonEmpty Schema) -> Maybe Schema -> Schema Schema.Array (forall a. a -> Maybe a Just forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (Integral a, Num b) => a -> b fromIntegral forall a b. (a -> b) -> a -> b $ forall (t :: * -> *) a. Foldable t => t a -> Int length [(Maybe Identifier, Schema)] schemas) (case Permission permission of Permission Permission.Allow -> forall a. Maybe a Nothing Permission Permission.Forbid -> forall a. a -> Maybe a Just forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (Integral a, Num b) => a -> b fromIntegral forall a b. (a -> b) -> a -> b $ forall (t :: * -> *) a. Foldable t => t a -> Int length [(Maybe Identifier, Schema)] schemas ) (case forall a. [a] -> Maybe (NonEmpty a) NonEmpty.nonEmpty forall a b. (a -> b) -> a -> b $ 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 -> forall a b. a -> Either a b Left Schema Schema.False Just NonEmpty Schema xs -> forall a b. b -> Either a b Right NonEmpty Schema xs ) forall a. Maybe a Nothing ) 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. Array value -> [value] Array.toList forall value. [value] -> Array value Array.fromList Value (Array Value) Codec.arrayCodec element :: Codec.Value a -> Array a element :: forall a. Value a -> Array a element Value a c = Codec.Codec { decode :: StateT [Value] (ExceptT String Identity) a Codec.decode = do [Value] l <- forall (m :: * -> *) s. Monad m => StateT s m s Trans.get case [Value] l of [] -> 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 "unexpected empty list" Value h : [Value] t -> case forall a. Value a -> Value -> Either String a Codec.decodeWith Value a c Value h 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 [Value] t forall (f :: * -> *) a. Applicative f => a -> f a pure a y , encode :: a -> WriterT [Value] Identity a Codec.encode = \a x -> do forall (m :: * -> *) w. Monad m => w -> WriterT w m () Trans.tell [forall a. Value a -> a -> Value Codec.encodeWith Value a c a x] forall (f :: * -> *) a. Applicative f => a -> f a pure a x , 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 (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 }