Array.hs

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 =
    Codec.fromListCodec
            (\permission schemasM -> do
                schemas <- schemasM
                pure . Schema.unidentified $ Schema.Array
                    (Just . fromIntegral $ length schemas)
                    (case permission of
                        Permission.Allow -> Nothing
                        Permission.Forbid ->
                            Just . fromIntegral $ length schemas
                    )
                    (case NonEmpty.nonEmpty $ fmap Schema.maybeRef schemas of
                        Nothing -> Left Schema.False
                        Just xs -> Right xs
                    )
                    Nothing
            )
        $ Codec.map Array.toList Array.fromList Codec.arrayCodec

element :: Codec.Value a -> Array a
element c = Codec.Codec
    { Codec.decode = do
        l <- Trans.get
        case l of
            [] -> Trans.lift $ Trans.throwE "unexpected empty list"
            h : t -> case Codec.decodeWith c h of
                Left y -> Trans.lift $ Trans.throwE y
                Right y -> do
                    Trans.put t
                    pure y
    , Codec.encode = \x -> do
        Trans.tell [Codec.encodeWith c x]
        pure x
    , Codec.schema = pure . Schema.unidentified <$> Codec.getRef c
    }