{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}

-- |
-- Module: Covenant.JSON
-- Copyright: (C) MLabs 2025
-- License: Apache 2.0
-- Maintainer: koz@mlabs.city, sean@mlabs.city
--
-- JSON serialization and deserialization utilities for the ASG.
--
-- = Note on Sum Type Encoding:
--
-- Unless otherwise noted, a Haskell sum type like:
--
--    @data Foo = Bar | Baz Int@
--
-- Is encoded to JSON using @{tag: \<CTOR NAME\>, fields: [\<Arg1\>, \<Arg2\>, \<ArgN\>]}@
--
-- This is used for all Haskell sum types which do /not/ have 'LabelOptic'
-- instnaces. For those with field names given by such instances, the @fields@
-- part of the encoded sum is not an array of arguments, but instead a JSON
-- object, with fields whose names correspond to the label optics. Comments make
-- it clear which types are encoded in which way.
--
-- @since 1.3.0
module Covenant.JSON
  ( -- * Serialization
    Version (..),
    SerializeErr (..),
    mkDatatypeInfos,
    compileAndSerialize,

    -- * Deserialization
    DeserializeErr (..),
    deserializeAndValidate,
    deserializeAndValidate_,
  )
where

#if __GLASGOW_HASKELL__==908
import Data.Foldable (foldl')
#endif
import Control.Exception (throwIO)
import Control.Monad (foldM, unless)
import Control.Monad.Error.Class (MonadError (throwError))
import Control.Monad.HashCons (MonadHashCons (lookupRef))
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Reader (local)
import Control.Monad.Trans.Except (ExceptT, runExceptT)
import Covenant.ASG
  ( ASG (ASG),
    ASGBuilder,
    ASGNode,
    Arg,
    CompNodeInfo,
    CovenantError,
    Id,
    Ref,
    ValNodeInfo,
    app,
    builtin1,
    builtin2,
    builtin3,
    builtin6,
    cata,
    dataConstructor,
    err,
    force,
    lam,
    lit,
    match,
    runASGBuilder,
    thunk,
  )
import Covenant.Constant (AConstant (ABoolean, AByteString, AString, AUnit, AnInteger))
import Covenant.Data (DatatypeInfo, mkDatatypeInfo, primBaseFunctorInfos)
import Covenant.DeBruijn (DeBruijn, asInt)
import Covenant.Index (Count, Index, intCount, intIndex)
import Covenant.Internal.KindCheck (checkDataDecls)
import Covenant.Internal.Strategy
  ( InternalStrategy
      ( InternalAssocMapStrat,
        InternalListStrat,
        InternalOpaqueStrat,
        InternalPairStrat
      ),
  )
import Covenant.Internal.Term
  ( ASGNode (ACompNode, AValNode, AnError),
    Arg (Arg),
    BoundTyVar (BoundTyVar),
    CompNodeInfo
      ( Builtin1Internal,
        Builtin2Internal,
        Builtin3Internal,
        Builtin6Internal,
        ForceInternal,
        LamInternal
      ),
    CovenantTypeError (OtherError),
    Id (Id),
    Ref (AnArg, AnId),
    ValNodeInfo
      ( AppInternal,
        CataInternal,
        DataConstructorInternal,
        LitInternal,
        MatchInternal,
        ThunkInternal
      ),
  )
import Covenant.Internal.Type
  ( AbstractTy (BoundAt),
    CompT (CompT),
    CompTBody (CompTBody),
    ConstructorName (ConstructorName),
    DataDeclaration (OpaqueData),
    ValT (BuiltinFlat, ThunkT),
  )
import Covenant.Prim
  ( OneArgFunc
      ( BData,
        BLS12_381_G1_compress,
        BLS12_381_G1_neg,
        BLS12_381_G1_uncompress,
        BLS12_381_G2_compress,
        BLS12_381_G2_neg,
        BLS12_381_G2_uncompress,
        Blake2b_224,
        Blake2b_256,
        ComplementByteString,
        CountSetBits,
        DecodeUtf8,
        EncodeUtf8,
        FindFirstSetBit,
        FstPair,
        HeadList,
        IData,
        Keccak_256,
        LengthOfByteString,
        ListData,
        MapData,
        NullList,
        Ripemd_160,
        SerialiseData,
        Sha2_256,
        Sha3_256,
        SndPair,
        TailList,
        UnBData,
        UnConstrData,
        UnIData,
        UnListData,
        UnMapData
      ),
    SixArgFunc (ChooseData),
    ThreeArgFunc
      ( AndByteString,
        ChooseList,
        ExpModInteger,
        IfThenElse,
        IntegerToByteString,
        OrByteString,
        VerifyEcdsaSecp256k1Signature,
        VerifyEd25519Signature,
        VerifySchnorrSecp256k1Signature,
        WriteBits,
        XorByteString
      ),
    TwoArgFunc
      ( AddInteger,
        AppendByteString,
        AppendString,
        BLS12_381_G1_add,
        BLS12_381_G1_equal,
        BLS12_381_G1_hashToGroup,
        BLS12_381_G1_scalarMul,
        BLS12_381_G2_add,
        BLS12_381_G2_equal,
        BLS12_381_G2_hashToGroup,
        BLS12_381_G2_scalarMul,
        BLS12_381_finalVerify,
        BLS12_381_millerLoop,
        BLS12_381_mulMlResult,
        ByteStringToInteger,
        ChooseUnit,
        ConsByteString,
        ConstrData,
        DivideInteger,
        EqualsByteString,
        EqualsData,
        EqualsInteger,
        EqualsString,
        IndexByteString,
        LessThanByteString,
        LessThanEqualsByteString,
        LessThanEqualsInteger,
        LessThanInteger,
        MkCons,
        MkPairData,
        ModInteger,
        MultiplyInteger,
        QuotientInteger,
        ReadBit,
        RemainderInteger,
        ReplicateByte,
        RotateByteString,
        ShiftByteString,
        SubtractInteger,
        Trace
      ),
  )
import Covenant.Type
  ( BuiltinFlatT
      ( BLS12_381_G1_ElementT,
        BLS12_381_G2_ElementT,
        BLS12_381_MlResultT,
        BoolT,
        ByteStringT,
        IntegerT,
        StringT,
        UnitT
      ),
    Constructor (Constructor),
    DataDeclaration (DataDeclaration),
    DataEncoding (BuiltinStrategy, PlutusData, SOP),
    PlutusDataConstructor
      ( PlutusB,
        PlutusConstr,
        PlutusI,
        PlutusList,
        PlutusMap
      ),
    PlutusDataStrategy (EnumData, NewtypeData, ProductListData),
    TyName (TyName),
    ValT (Abstraction, Datatype),
  )
import Covenant.Type qualified as Ty
import Data.Aeson
  ( FromJSON (parseJSON),
    ToJSON (toEncoding),
    Value,
    eitherDecodeFileStrict,
    (.=),
  )
import Data.Aeson.Encoding
  ( Encoding,
    encodingToLazyByteString,
    int,
    list,
    pair,
    pairs,
    text,
  )
import Data.Aeson.KeyMap qualified as KM
import Data.Aeson.Types
  ( Array,
    Key,
    Object,
    Parser,
    Value (Object, String),
    withArray,
    withObject,
    withText,
  )
import Data.Bifunctor (Bifunctor (first))
import Data.ByteString (ByteString)
import Data.ByteString.Lazy qualified as BL
import Data.Char (isAlphaNum, isUpper)
import Data.Foldable (toList, traverse_)
import Data.Kind (Type)
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (fromJust)
import Data.Set qualified as S
import Data.Text (Text)
import Data.Text qualified as T
import Data.Vector (Vector)
import Data.Vector qualified as Vector
import Data.Vector.NonEmpty qualified as NEV
import Data.Void (Void, absurd)
import Data.Wedge (Wedge (Here, Nowhere, There))
import GHC.TypeLits (KnownSymbol, Symbol)
import Optics.Core (preview, review, set, view)
import Text.Hex qualified as Hex

-- | The errors that can arise from 'compileAndSerialize' not stemming from
-- 'IO'.
--
-- @since 1.3.0
data SerializeErr
  = -- | A datatype was specified in a way that isn't valid.
    DatatypeConversionFailure String
  | -- | The supplied ASG failed to compile.
    ASGCompilationFailure CovenantError
  deriving stock
    ( -- @since 1.3.0
      Int -> SerializeErr -> ShowS
[SerializeErr] -> ShowS
SerializeErr -> String
(Int -> SerializeErr -> ShowS)
-> (SerializeErr -> String)
-> ([SerializeErr] -> ShowS)
-> Show SerializeErr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SerializeErr -> ShowS
showsPrec :: Int -> SerializeErr -> ShowS
$cshow :: SerializeErr -> String
show :: SerializeErr -> String
$cshowList :: [SerializeErr] -> ShowS
showList :: [SerializeErr] -> ShowS
Show,
      -- @since 1.3.0
      SerializeErr -> SerializeErr -> Bool
(SerializeErr -> SerializeErr -> Bool)
-> (SerializeErr -> SerializeErr -> Bool) -> Eq SerializeErr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SerializeErr -> SerializeErr -> Bool
== :: SerializeErr -> SerializeErr -> Bool
$c/= :: SerializeErr -> SerializeErr -> Bool
/= :: SerializeErr -> SerializeErr -> Bool
Eq
    )

-- | Given a 'FilePath' to write output to, a collection of data declarations,
-- an 'ASGBuilder' and a version tag, compile the ASG, then write it to the
-- given file path in its JSON serialized form, together with the data types.
--
-- @since 1.3.0
compileAndSerialize ::
  forall (a :: Type).
  FilePath ->
  [DataDeclaration AbstractTy] ->
  ASGBuilder a ->
  Version ->
  ExceptT SerializeErr IO ()
compileAndSerialize :: forall a.
String
-> [DataDeclaration AbstractTy]
-> ASGBuilder a
-> Version
-> ExceptT SerializeErr IO ()
compileAndSerialize String
path [DataDeclaration AbstractTy]
decls ASGBuilder a
asgBuilder Version
version = do
  case [DataDeclaration AbstractTy]
-> Either String (Map TyName (DatatypeInfo AbstractTy))
mkDatatypeInfos [DataDeclaration AbstractTy]
decls of
    Left String
err' -> SerializeErr -> ExceptT SerializeErr IO ()
forall a. SerializeErr -> ExceptT SerializeErr IO a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (SerializeErr -> ExceptT SerializeErr IO ())
-> (String -> SerializeErr) -> String -> ExceptT SerializeErr IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SerializeErr
DatatypeConversionFailure (String -> ExceptT SerializeErr IO ())
-> String -> ExceptT SerializeErr IO ()
forall a b. (a -> b) -> a -> b
$ String
err'
    Right Map TyName (DatatypeInfo AbstractTy)
infos -> case Map TyName (DatatypeInfo AbstractTy)
-> ASGBuilder a -> Either CovenantError ASG
forall a.
Map TyName (DatatypeInfo AbstractTy)
-> ASGBuilder a -> Either CovenantError ASG
runASGBuilder Map TyName (DatatypeInfo AbstractTy)
infos ASGBuilder a
asgBuilder of
      Left CovenantError
err' -> SerializeErr -> ExceptT SerializeErr IO ()
forall a. SerializeErr -> ExceptT SerializeErr IO a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (SerializeErr -> ExceptT SerializeErr IO ())
-> (CovenantError -> SerializeErr)
-> CovenantError
-> ExceptT SerializeErr IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CovenantError -> SerializeErr
ASGCompilationFailure (CovenantError -> ExceptT SerializeErr IO ())
-> CovenantError -> ExceptT SerializeErr IO ()
forall a b. (a -> b) -> a -> b
$ CovenantError
err'
      Right (ASG Map Id ASGNode
asg) -> do
        let cu :: CompilationUnit
cu = Vector (DataDeclaration AbstractTy)
-> Map Id ASGNode -> Version -> CompilationUnit
CompilationUnit ([DataDeclaration AbstractTy] -> Vector (DataDeclaration AbstractTy)
forall a. [a] -> Vector a
Vector.fromList [DataDeclaration AbstractTy]
decls) Map Id ASGNode
asg Version
version
        IO () -> ExceptT SerializeErr IO ()
forall a. IO a -> ExceptT SerializeErr IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SerializeErr IO ())
-> IO () -> ExceptT SerializeErr IO ()
forall a b. (a -> b) -> a -> b
$ String -> CompilationUnit -> (CompilationUnit -> Encoding) -> IO ()
forall a. String -> a -> (a -> Encoding) -> IO ()
writeJSONWith String
path CompilationUnit
cu CompilationUnit -> Encoding
encodeCompilationUnit

-- | The errors that can arise from 'deserializeAndValidate' not stemming from
-- 'IO'.
--
-- @since 1.3.0
data DeserializeErr
  = -- | The serial form's JSON was not valid. This means that the given file
    -- cannot be an ASG.
    JSONParseFailure String
  | -- | The deserialized JSON corresponds to an ASG, but not a valid one.
    ASGValidationFail CovenantError
  deriving stock
    ( -- @since 1.3.0
      Int -> DeserializeErr -> ShowS
[DeserializeErr] -> ShowS
DeserializeErr -> String
(Int -> DeserializeErr -> ShowS)
-> (DeserializeErr -> String)
-> ([DeserializeErr] -> ShowS)
-> Show DeserializeErr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeserializeErr -> ShowS
showsPrec :: Int -> DeserializeErr -> ShowS
$cshow :: DeserializeErr -> String
show :: DeserializeErr -> String
$cshowList :: [DeserializeErr] -> ShowS
showList :: [DeserializeErr] -> ShowS
Show,
      -- @since 1.3.0
      DeserializeErr -> DeserializeErr -> Bool
(DeserializeErr -> DeserializeErr -> Bool)
-> (DeserializeErr -> DeserializeErr -> Bool) -> Eq DeserializeErr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeserializeErr -> DeserializeErr -> Bool
== :: DeserializeErr -> DeserializeErr -> Bool
$c/= :: DeserializeErr -> DeserializeErr -> Bool
/= :: DeserializeErr -> DeserializeErr -> Bool
Eq
    )

-- | Given a 'FilePath' to a serialized ASG, decode it if possible.
--
-- @since 1.3.0
deserializeAndValidate ::
  FilePath ->
  ExceptT DeserializeErr IO ASG
deserializeAndValidate :: String -> ExceptT DeserializeErr IO ASG
deserializeAndValidate String
path = do
  CompilationUnit
rawCU <- forall a. FromJSON a => String -> ExceptT DeserializeErr IO a
readJSON @CompilationUnit String
path
  case CompilationUnit -> Either CovenantError ASG
validateCompilationUnit CompilationUnit
rawCU of
    Left CovenantError
err' -> DeserializeErr -> ExceptT DeserializeErr IO ASG
forall a. DeserializeErr -> ExceptT DeserializeErr IO a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (DeserializeErr -> ExceptT DeserializeErr IO ASG)
-> (CovenantError -> DeserializeErr)
-> CovenantError
-> ExceptT DeserializeErr IO ASG
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CovenantError -> DeserializeErr
ASGValidationFail (CovenantError -> ExceptT DeserializeErr IO ASG)
-> CovenantError -> ExceptT DeserializeErr IO ASG
forall a b. (a -> b) -> a -> b
$ CovenantError
err'
    Right ASG
asg -> ASG -> ExceptT DeserializeErr IO ASG
forall a. a -> ExceptT DeserializeErr IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ASG
asg

-- | Like 'deserializeAndValidate' but runs directly in 'IO'.
--
-- = Note
--
-- This is mostly designed for use in tests, as it has no ability to \'trap\'
-- validation or deserialization errors. You most likely want
-- 'deserializeAndValidate'.
--
-- @since 1.3.0
deserializeAndValidate_ :: FilePath -> IO ASG
deserializeAndValidate_ :: String -> IO ASG
deserializeAndValidate_ String
path =
  ExceptT DeserializeErr IO ASG -> IO (Either DeserializeErr ASG)
forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
runExceptT (String -> ExceptT DeserializeErr IO ASG
deserializeAndValidate String
path) IO (Either DeserializeErr ASG)
-> (Either DeserializeErr ASG -> IO ASG) -> IO ASG
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (DeserializeErr -> IO ASG)
-> (ASG -> IO ASG) -> Either DeserializeErr ASG -> IO ASG
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IOError -> IO ASG
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO ASG)
-> (DeserializeErr -> IOError) -> DeserializeErr -> IO ASG
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError (String -> IOError)
-> (DeserializeErr -> String) -> DeserializeErr -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeserializeErr -> String
forall a. Show a => a -> String
show) ASG -> IO ASG
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure

-- | Represents a Covenant version. This is currently just a tag, but may be
-- used in the future to enforce compatibility.
--
-- @since 1.3.0
data Version = Version {Version -> Int
_major :: Int, Version -> Int
_minor :: Int}
  deriving stock
    ( -- | @since 1.3.0
      Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Version -> ShowS
showsPrec :: Int -> Version -> ShowS
$cshow :: Version -> String
show :: Version -> String
$cshowList :: [Version] -> ShowS
showList :: [Version] -> ShowS
Show,
      -- | @since 1.3.0
      Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
/= :: Version -> Version -> Bool
Eq,
      -- | @since 1.3.0
      Eq Version
Eq Version =>
(Version -> Version -> Ordering)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> Ord Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Version -> Version -> Ordering
compare :: Version -> Version -> Ordering
$c< :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
>= :: Version -> Version -> Bool
$cmax :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
min :: Version -> Version -> Version
Ord
    )

data CompilationUnit
  = CompilationUnit
  { CompilationUnit -> Vector (DataDeclaration AbstractTy)
_datatypes :: Vector (DataDeclaration AbstractTy),
    CompilationUnit -> Map Id ASGNode
_asg :: Map Id ASGNode,
    CompilationUnit -> Version
_version :: Version
  }
  deriving stock (Int -> CompilationUnit -> ShowS
[CompilationUnit] -> ShowS
CompilationUnit -> String
(Int -> CompilationUnit -> ShowS)
-> (CompilationUnit -> String)
-> ([CompilationUnit] -> ShowS)
-> Show CompilationUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompilationUnit -> ShowS
showsPrec :: Int -> CompilationUnit -> ShowS
$cshow :: CompilationUnit -> String
show :: CompilationUnit -> String
$cshowList :: [CompilationUnit] -> ShowS
showList :: [CompilationUnit] -> ShowS
Show, CompilationUnit -> CompilationUnit -> Bool
(CompilationUnit -> CompilationUnit -> Bool)
-> (CompilationUnit -> CompilationUnit -> Bool)
-> Eq CompilationUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompilationUnit -> CompilationUnit -> Bool
== :: CompilationUnit -> CompilationUnit -> Bool
$c/= :: CompilationUnit -> CompilationUnit -> Bool
/= :: CompilationUnit -> CompilationUnit -> Bool
Eq)

-- NOTE: We run w/ an empty map because the declarations get inserted after they are kindchecked
validateCompilationUnit :: CompilationUnit -> Either CovenantError ASG
validateCompilationUnit :: CompilationUnit -> Either CovenantError ASG
validateCompilationUnit = Map TyName (DatatypeInfo AbstractTy)
-> ASGBuilder () -> Either CovenantError ASG
forall a.
Map TyName (DatatypeInfo AbstractTy)
-> ASGBuilder a -> Either CovenantError ASG
runASGBuilder Map TyName (DatatypeInfo AbstractTy)
forall k a. Map k a
M.empty (ASGBuilder () -> Either CovenantError ASG)
-> (CompilationUnit -> ASGBuilder ())
-> CompilationUnit
-> Either CovenantError ASG
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilationUnit -> ASGBuilder ()
validateCompilationUnit'

validateCompilationUnit' :: CompilationUnit -> ASGBuilder ()
validateCompilationUnit' :: CompilationUnit -> ASGBuilder ()
validateCompilationUnit' (CompilationUnit Vector (DataDeclaration AbstractTy)
datatypes Map Id ASGNode
asg Version
_) = do
  case [DataDeclaration AbstractTy]
-> Either String (Map TyName (DatatypeInfo AbstractTy))
mkDatatypeInfos (Vector (DataDeclaration AbstractTy) -> [DataDeclaration AbstractTy]
forall a. Vector a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList Vector (DataDeclaration AbstractTy)
datatypes) of
    Left String
err' -> CovenantTypeError -> ASGBuilder ()
forall a. CovenantTypeError -> ASGBuilder a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (CovenantTypeError -> ASGBuilder ())
-> CovenantTypeError -> ASGBuilder ()
forall a b. (a -> b) -> a -> b
$ Text -> CovenantTypeError
OtherError (String -> Text
T.pack String
err')
    Right Map TyName (DatatypeInfo AbstractTy)
infos -> (ASGEnv -> ASGEnv) -> ASGBuilder () -> ASGBuilder ()
forall a. (ASGEnv -> ASGEnv) -> ASGBuilder a -> ASGBuilder a
forall r (m :: Type -> Type) a.
MonadReader r m =>
(r -> r) -> m a -> m a
local (Optic
  A_Lens
  NoIx
  ASGEnv
  ASGEnv
  (Map TyName (DatatypeInfo AbstractTy))
  (Map TyName (DatatypeInfo AbstractTy))
-> Map TyName (DatatypeInfo AbstractTy) -> ASGEnv -> ASGEnv
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  ASGEnv
  ASGEnv
  (Map TyName (DatatypeInfo AbstractTy))
  (Map TyName (DatatypeInfo AbstractTy))
#datatypeInfo Map TyName (DatatypeInfo AbstractTy)
infos) (ASGBuilder () -> ASGBuilder ()) -> ASGBuilder () -> ASGBuilder ()
forall a b. (a -> b) -> a -> b
$ ((Id, ASGNode) -> ASGBuilder ())
-> [(Id, ASGNode)] -> ASGBuilder ()
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Id, ASGNode) -> ASGBuilder ()
go (Map Id ASGNode -> [(Id, ASGNode)]
forall k a. Map k a -> [(k, a)]
M.toList Map Id ASGNode
asg)
  where
    go :: (Id, ASGNode) -> ASGBuilder ()
    go :: (Id, ASGNode) -> ASGBuilder ()
go (Id
parsedId, ASGNode
parsedNode) = case ASGNode
parsedNode of
      ACompNode CompT AbstractTy
compT CompNodeInfo
compInfo -> case CompNodeInfo
compInfo of
        Builtin1Internal OneArgFunc
bi1 -> String -> ASGBuilder Id -> ASGBuilder ()
checkNode String
"builtin1" (OneArgFunc -> ASGBuilder Id
forall (m :: Type -> Type).
MonadHashCons Id ASGNode m =>
OneArgFunc -> m Id
builtin1 OneArgFunc
bi1)
        Builtin2Internal TwoArgFunc
bi2 -> String -> ASGBuilder Id -> ASGBuilder ()
checkNode String
"builtin2" (TwoArgFunc -> ASGBuilder Id
forall (m :: Type -> Type).
MonadHashCons Id ASGNode m =>
TwoArgFunc -> m Id
builtin2 TwoArgFunc
bi2)
        Builtin3Internal ThreeArgFunc
bi3 -> String -> ASGBuilder Id -> ASGBuilder ()
checkNode String
"builtin3" (ThreeArgFunc -> ASGBuilder Id
forall (m :: Type -> Type).
MonadHashCons Id ASGNode m =>
ThreeArgFunc -> m Id
builtin3 ThreeArgFunc
bi3)
        Builtin6Internal SixArgFunc
bi6 -> String -> ASGBuilder Id -> ASGBuilder ()
checkNode String
"builtin6" (SixArgFunc -> ASGBuilder Id
forall (m :: Type -> Type).
MonadHashCons Id ASGNode m =>
SixArgFunc -> m Id
builtin6 SixArgFunc
bi6)
        LamInternal Ref
bodyRef -> String -> ASGBuilder Id -> ASGBuilder ()
checkNode String
"lam" (ASGBuilder Id -> ASGBuilder ()) -> ASGBuilder Id -> ASGBuilder ()
forall a b. (a -> b) -> a -> b
$ CompT AbstractTy -> ASGBuilder Ref -> ASGBuilder Id
forall (m :: Type -> Type).
(MonadHashCons Id ASGNode m, MonadError CovenantTypeError m,
 MonadReader ASGEnv m) =>
CompT AbstractTy -> m Ref -> m Id
lam CompT AbstractTy
compT (Ref -> ASGBuilder Ref
forall a. a -> ASGBuilder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Ref
bodyRef)
        ForceInternal Ref
ref -> String -> ASGBuilder Id -> ASGBuilder ()
checkNode String
"force" (ASGBuilder Id -> ASGBuilder ()) -> ASGBuilder Id -> ASGBuilder ()
forall a b. (a -> b) -> a -> b
$ Ref -> ASGBuilder Id
forall (m :: Type -> Type).
(MonadHashCons Id ASGNode m, MonadError CovenantTypeError m) =>
Ref -> m Id
force Ref
ref
      AValNode ValT AbstractTy
_ ValNodeInfo
valInfo -> case ValNodeInfo
valInfo of
        LitInternal AConstant
aConstant -> String -> ASGBuilder Id -> ASGBuilder ()
checkNode String
"Lit" (AConstant -> ASGBuilder Id
forall (m :: Type -> Type).
MonadHashCons Id ASGNode m =>
AConstant -> m Id
lit AConstant
aConstant)
        AppInternal Id
fId Vector Ref
argRefs Vector (Wedge BoundTyVar (ValT Void))
instTys -> String -> ASGBuilder Id -> ASGBuilder ()
checkNode String
"App" (Id
-> Vector Ref
-> Vector (Wedge BoundTyVar (ValT Void))
-> ASGBuilder Id
forall (m :: Type -> Type).
(MonadHashCons Id ASGNode m, MonadError CovenantTypeError m,
 MonadReader ASGEnv m) =>
Id -> Vector Ref -> Vector (Wedge BoundTyVar (ValT Void)) -> m Id
app Id
fId Vector Ref
argRefs Vector (Wedge BoundTyVar (ValT Void))
instTys)
        ThunkInternal Id
i -> String -> ASGBuilder Id -> ASGBuilder ()
checkNode String
"Thunk" (Id -> ASGBuilder Id
forall (m :: Type -> Type).
(MonadHashCons Id ASGNode m, MonadError CovenantTypeError m) =>
Id -> m Id
thunk Id
i)
        CataInternal Ref
r1 Ref
r2 -> String -> ASGBuilder Id -> ASGBuilder ()
checkNode String
"Cata" (Ref -> Ref -> ASGBuilder Id
forall (m :: Type -> Type).
(MonadHashCons Id ASGNode m, MonadError CovenantTypeError m,
 MonadReader ASGEnv m) =>
Ref -> Ref -> m Id
cata Ref
r1 Ref
r2)
        DataConstructorInternal TyName
tn ConstructorName
cn Vector Ref
args -> String -> ASGBuilder Id -> ASGBuilder ()
checkNode String
"DataConstructor" (TyName -> ConstructorName -> Vector Ref -> ASGBuilder Id
forall (m :: Type -> Type).
(MonadHashCons Id ASGNode m, MonadError CovenantTypeError m,
 MonadReader ASGEnv m) =>
TyName -> ConstructorName -> Vector Ref -> m Id
dataConstructor TyName
tn ConstructorName
cn Vector Ref
args)
        MatchInternal Ref
scrut Vector Ref
matcharms -> String -> ASGBuilder Id -> ASGBuilder ()
checkNode String
"Match" (Ref -> Vector Ref -> ASGBuilder Id
forall (m :: Type -> Type).
(MonadHashCons Id ASGNode m, MonadError CovenantTypeError m,
 MonadReader ASGEnv m) =>
Ref -> Vector Ref -> m Id
match Ref
scrut Vector Ref
matcharms)
      ASGNode
AnError -> String -> ASGBuilder Id -> ASGBuilder ()
checkNode String
"errorNode" ASGBuilder Id
forall (m :: Type -> Type). MonadHashCons Id ASGNode m => m Id
err
      where
        checkNode :: String -> ASGBuilder Id -> ASGBuilder ()
        checkNode :: String -> ASGBuilder Id -> ASGBuilder ()
checkNode String
msg ASGBuilder Id
constructedId = do
          Id
xid <- ASGBuilder Id
constructedId
          Bool -> ASGBuilder () -> ASGBuilder ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (Id
parsedId Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
xid) (ASGBuilder () -> ASGBuilder ()) -> ASGBuilder () -> ASGBuilder ()
forall a b. (a -> b) -> a -> b
$ String -> ASGBuilder ()
forall a. HasCallStack => String -> a
error (String -> ASGBuilder ()) -> String -> ASGBuilder ()
forall a b. (a -> b) -> a -> b
$ String
msg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" id mismatch"
          Id -> ASGBuilder (Maybe ASGNode)
forall r e (m :: Type -> Type).
MonadHashCons r e m =>
r -> m (Maybe e)
lookupRef Id
xid ASGBuilder (Maybe ASGNode)
-> (Maybe ASGNode -> ASGBuilder ()) -> ASGBuilder ()
forall a b. ASGBuilder a -> (a -> ASGBuilder b) -> ASGBuilder b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe ASGNode
Nothing -> String -> ASGBuilder ()
forall a. HasCallStack => String -> a
error (String -> ASGBuilder ()) -> String -> ASGBuilder ()
forall a b. (a -> b) -> a -> b
$ String
msg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" node not found"
            Just ASGNode
asgNode ->
              Bool -> ASGBuilder () -> ASGBuilder ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (ASGNode
asgNode ASGNode -> ASGNode -> Bool
forall a. Eq a => a -> a -> Bool
== ASGNode
parsedNode) (ASGBuilder () -> ASGBuilder ()) -> ASGBuilder () -> ASGBuilder ()
forall a b. (a -> b) -> a -> b
$ do
                let errMsg :: String
errMsg =
                      String
"unexpected "
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" node"
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n  expected: "
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ASGNode -> String
forall a. Show a => a -> String
show ASGNode
parsedNode
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n  actual: "
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ASGNode -> String
forall a. Show a => a -> String
show ASGNode
asgNode
                String -> ASGBuilder ()
forall a. HasCallStack => String -> a
error String
errMsg

{- CompilationUnit

   Encodes as an object. The maps are represented by KV pairs in arrays. Example:

   {datatypes: [{k: "Maybe", v: ...}, {k: "Foo", v: ...}],
    asg: [{k: 0, v: ...}],
    version: {major: 1, minor: 2}
   }
-}

encodeCompilationUnit :: CompilationUnit -> Encoding
encodeCompilationUnit :: CompilationUnit -> Encoding
encodeCompilationUnit (CompilationUnit Vector (DataDeclaration AbstractTy)
datatypes Map Id ASGNode
asg Version
version) =
  Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
    Key -> Encoding -> Series
pair Key
"datatypes" ((DataDeclaration AbstractTy -> Encoding)
-> [DataDeclaration AbstractTy] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list DataDeclaration AbstractTy -> Encoding
encodeDataDeclarationAbstractTy ([DataDeclaration AbstractTy] -> Encoding)
-> (Vector (DataDeclaration AbstractTy)
    -> [DataDeclaration AbstractTy])
-> Vector (DataDeclaration AbstractTy)
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (DataDeclaration AbstractTy) -> [DataDeclaration AbstractTy]
forall a. Vector a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (Vector (DataDeclaration AbstractTy) -> Encoding)
-> Vector (DataDeclaration AbstractTy) -> Encoding
forall a b. (a -> b) -> a -> b
$ Vector (DataDeclaration AbstractTy)
datatypes)
      Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key -> Encoding -> Series
pair Key
"asg" ((Id -> Encoding)
-> (ASGNode -> Encoding) -> Map Id ASGNode -> Encoding
forall k v.
(k -> Encoding) -> (v -> Encoding) -> Map k v -> Encoding
encodeMap Id -> Encoding
encodeId ASGNode -> Encoding
encodeASGNode Map Id ASGNode
asg)
      Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key -> Encoding -> Series
pair Key
"version" (Version -> Encoding
encodeVersion Version
version)

instance FromJSON CompilationUnit where
  parseJSON :: Value -> Parser CompilationUnit
parseJSON = String
-> (Object -> Parser CompilationUnit)
-> Value
-> Parser CompilationUnit
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CompilationUnit" ((Object -> Parser CompilationUnit)
 -> Value -> Parser CompilationUnit)
-> (Object -> Parser CompilationUnit)
-> Value
-> Parser CompilationUnit
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Vector (DataDeclaration AbstractTy)
datatypes <- Object
-> Key
-> (Value -> Parser (Vector (DataDeclaration AbstractTy)))
-> Parser (Vector (DataDeclaration AbstractTy))
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
obj Key
"datatypes" ((Value -> Parser (Vector (DataDeclaration AbstractTy)))
 -> Parser (Vector (DataDeclaration AbstractTy)))
-> (Value -> Parser (Vector (DataDeclaration AbstractTy)))
-> Parser (Vector (DataDeclaration AbstractTy))
forall a b. (a -> b) -> a -> b
$ String
-> (Array -> Parser (Vector (DataDeclaration AbstractTy)))
-> Value
-> Parser (Vector (DataDeclaration AbstractTy))
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"datatype" ((Array -> Parser (Vector (DataDeclaration AbstractTy)))
 -> Value -> Parser (Vector (DataDeclaration AbstractTy)))
-> (Array -> Parser (Vector (DataDeclaration AbstractTy)))
-> Value
-> Parser (Vector (DataDeclaration AbstractTy))
forall a b. (a -> b) -> a -> b
$ \Array
arr -> (Value -> Parser (DataDeclaration AbstractTy))
-> Array -> Parser (Vector (DataDeclaration AbstractTy))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse Value -> Parser (DataDeclaration AbstractTy)
decodeDataDeclarationAbstractTy Array
arr
    Map Id ASGNode
asg <- Object
-> Key
-> (Value -> Parser (Map Id ASGNode))
-> Parser (Map Id ASGNode)
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
obj Key
"asg" ((Value -> Parser (Map Id ASGNode)) -> Parser (Map Id ASGNode))
-> (Value -> Parser (Map Id ASGNode)) -> Parser (Map Id ASGNode)
forall a b. (a -> b) -> a -> b
$ (Value -> Parser Id)
-> (Value -> Parser ASGNode) -> Value -> Parser (Map Id ASGNode)
forall k v.
Ord k =>
(Value -> Parser k)
-> (Value -> Parser v) -> Value -> Parser (Map k v)
decodeMap Value -> Parser Id
decodeId Value -> Parser ASGNode
decodeASGNode
    Version
version <- Object -> Key -> (Value -> Parser Version) -> Parser Version
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
obj Key
"version" Value -> Parser Version
decodeVersion
    CompilationUnit -> Parser CompilationUnit
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (CompilationUnit -> Parser CompilationUnit)
-> CompilationUnit -> Parser CompilationUnit
forall a b. (a -> b) -> a -> b
$ Vector (DataDeclaration AbstractTy)
-> Map Id ASGNode -> Version -> CompilationUnit
CompilationUnit Vector (DataDeclaration AbstractTy)
datatypes Map Id ASGNode
asg Version
version

{- Version

   Serializes as an object with the fields you'd expect.

     Version 1 2
   ->
     {major: 1, minor: 2}

-}

-- |  @since 1.3.0
encodeVersion :: Version -> Encoding
encodeVersion :: Version -> Encoding
encodeVersion (Version Int
major Int
minor) = Series -> Encoding
pairs (Key
"major" Key -> Int -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
major Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"minor" Key -> Int -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
minor)

-- | @since 1.3.0
decodeVersion :: Value -> Parser Version
decodeVersion :: Value -> Parser Version
decodeVersion = String -> (Object -> Parser Version) -> Value -> Parser Version
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Version" ((Object -> Parser Version) -> Value -> Parser Version)
-> (Object -> Parser Version) -> Value -> Parser Version
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  Int
major <- Key -> (Value -> Parser Int) -> Object -> Parser Int
forall a. Key -> (Value -> Parser a) -> Object -> Parser a
withField Key
"major" Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Object
obj
  Int
minor <- Key -> (Value -> Parser Int) -> Object -> Parser Int
forall a. Key -> (Value -> Parser a) -> Object -> Parser a
withField Key
"minor" Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Object
obj
  Version -> Parser Version
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Version -> Parser Version) -> Version -> Parser Version
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Version
Version Int
major Int
minor

{- DataDeclaration & its components -}

{- Special handling to account for base functors (including "strange" base functors for Natural)

   {tyName: "Foo"}
   | {baseFunctorOf: "Foo"}
   | "NaturalBF" | "NegativeBF"
-}

-- | @since 1.3.0
encodeTyName :: TyName -> Encoding
encodeTyName :: TyName -> Encoding
encodeTyName (TyName Text
tn) = case Text -> Text -> Maybe Text
T.stripPrefix Text
"#" Text
tn of
  Maybe Text
Nothing -> Series -> Encoding
pairs (Key
"tyName" Key -> Text -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
tn)
  Just Text
rootTypeName -> case Text
rootTypeName of
    Text
"Natural" -> Text -> Encoding
forall a. Text -> Encoding' a
text Text
"NaturalBF"
    Text
"Negative" -> Text -> Encoding
forall a. Text -> Encoding' a
text Text
"NegativeBF"
    Text
other -> Series -> Encoding
pairs (Key
"baseFunctorOf" Key -> Text -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
other)

-- | The type name must conform with the type naming rules, i.e. it must
--   1. Begin with a capital letter
--   2. Consist only of alphanumeric characters and underscores
-- @since 1.3.0
decodeTyName :: Value -> Parser TyName
decodeTyName :: Value -> Parser TyName
decodeTyName = \case
  String Text
str -> case Text
str of
    Text
"NaturalBF" -> TyName -> Parser TyName
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TyName
"#Natural"
    Text
"NegativeBF" -> TyName -> Parser TyName
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TyName
"#Negative"
    Text
other -> String -> Parser TyName
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Parser TyName) -> String -> Parser TyName
forall a b. (a -> b) -> a -> b
$ String
"Expected 'NaturalBF' or 'NegativeBF' but got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
other
  Object Object
km -> case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"tyName" Object
km of
    Maybe Value
Nothing -> case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"baseFunctorOf" Object
km of
      Maybe Value
Nothing -> String -> Parser TyName
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"Received an object for TyName, but it didn't have any valid fields"
      Just Value
rootType -> Text -> TyName
TyName (Text -> TyName) -> (Text -> Text) -> Text -> TyName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> TyName) -> Parser Text -> Parser TyName
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
rootType Parser Text -> (Text -> Parser Text) -> Parser Text
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser Text
validateProperName)
    Just Value
tn -> Text -> TyName
TyName (Text -> TyName) -> Parser Text -> Parser TyName
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
tn Parser Text -> (Text -> Parser Text) -> Parser Text
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser Text
validateProperName)
  Value
other -> String -> Parser TyName
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Parser TyName) -> String -> Parser TyName
forall a b. (a -> b) -> a -> b
$ String
"Expected a String or Object for TyName, but got: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
other

validateProperName :: Text -> Parser Text
validateProperName :: Text -> Parser Text
validateProperName Text
nm
  | Text -> Bool
T.null Text
nm = String -> Parser Text
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"Empty String cannot be a TyName or ConstructorName"
  | (Char -> Bool
isUpper (HasCallStack => Text -> Char
Text -> Char
T.head Text
nm) Bool -> Bool -> Bool
|| HasCallStack => Text -> Char
Text -> Char
T.head Text
nm Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#') Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Text
nm = Text -> Parser Text
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Text
nm
  | Bool
otherwise = String -> Parser Text
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Parser Text) -> String -> Parser Text
forall a b. (a -> b) -> a -> b
$ String
"Could not validate TyName or ConstructorName '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
nm String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'"

{- Encodes as a simple JSON string, e.g.
   ConstructorName "Foo" -> "Foo"
-}

-- | @since 1.3.0
encodeConstructorName :: ConstructorName -> Encoding
encodeConstructorName :: ConstructorName -> Encoding
encodeConstructorName (ConstructorName Text
cn) = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Text
cn

-- | The ctor name must conform with the ctor naming rules, i.e. it must
--   1. Begin with a capital letter
--   2. Consist only of alphanumeric characters and underscores
-- @since 1.3.0
decodeConstructorName :: Value -> Parser ConstructorName
decodeConstructorName :: Value -> Parser ConstructorName
decodeConstructorName = String
-> (Text -> Parser ConstructorName)
-> Value
-> Parser ConstructorName
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ConstructorName" ((Text -> Parser ConstructorName)
 -> Value -> Parser ConstructorName)
-> (Text -> Parser ConstructorName)
-> Value
-> Parser ConstructorName
forall a b. (a -> b) -> a -> b
$ (Text -> ConstructorName) -> Parser Text -> Parser ConstructorName
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ConstructorName
ConstructorName (Parser Text -> Parser ConstructorName)
-> (Text -> Parser Text) -> Text -> Parser ConstructorName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Parser Text
validateProperName

{- Encodes as an object. E.g.:

   Constructor "Just" [IntegerT]
   ->
   { constructorName: "Just"
   , constructorArgs: [...]}

-}

-- | @since 1.3.0
encodeConstructor :: Constructor AbstractTy -> Encoding
encodeConstructor :: Constructor AbstractTy -> Encoding
encodeConstructor (Constructor ConstructorName
nm Vector (ValT AbstractTy)
args) =
  let encodedArgs :: Encoding
encodedArgs = (ValT AbstractTy -> Encoding) -> [ValT AbstractTy] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list ValT AbstractTy -> Encoding
encodeValTAbstractTy ([ValT AbstractTy] -> Encoding) -> [ValT AbstractTy] -> Encoding
forall a b. (a -> b) -> a -> b
$ Vector (ValT AbstractTy) -> [ValT AbstractTy]
forall a. Vector a -> [a]
Vector.toList Vector (ValT AbstractTy)
args
   in Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
        Key -> Encoding -> Series
pair Key
"constructorName" (ConstructorName -> Encoding
encodeConstructorName ConstructorName
nm)
          Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key -> Encoding -> Series
pair Key
"constructorArgs" Encoding
encodedArgs

-- | @since 1.3.0
decodeConstructor :: Value -> Parser (Constructor AbstractTy)
decodeConstructor :: Value -> Parser (Constructor AbstractTy)
decodeConstructor = String
-> (Object -> Parser (Constructor AbstractTy))
-> Value
-> Parser (Constructor AbstractTy)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Constructor" ((Object -> Parser (Constructor AbstractTy))
 -> Value -> Parser (Constructor AbstractTy))
-> (Object -> Parser (Constructor AbstractTy))
-> Value
-> Parser (Constructor AbstractTy)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  ConstructorName
ctorNm <- Object
-> Key
-> (Value -> Parser ConstructorName)
-> Parser ConstructorName
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
obj Key
"constructorName" Value -> Parser ConstructorName
decodeConstructorName
  Vector (ValT AbstractTy)
ctorArgs <-
    Object
-> Key
-> (Value -> Parser (Vector (ValT AbstractTy)))
-> Parser (Vector (ValT AbstractTy))
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
obj Key
"constructorArgs" ((Value -> Parser (Vector (ValT AbstractTy)))
 -> Parser (Vector (ValT AbstractTy)))
-> (Value -> Parser (Vector (ValT AbstractTy)))
-> Parser (Vector (ValT AbstractTy))
forall a b. (a -> b) -> a -> b
$
      String
-> (Array -> Parser (Vector (ValT AbstractTy)))
-> Value
-> Parser (Vector (ValT AbstractTy))
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"Constructor Args" ((Value -> Parser (ValT AbstractTy))
-> Array -> Parser (Vector (ValT AbstractTy))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse Value -> Parser (ValT AbstractTy)
decodeValTAbstractTy)
  Constructor AbstractTy -> Parser (Constructor AbstractTy)
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Constructor AbstractTy -> Parser (Constructor AbstractTy))
-> Constructor AbstractTy -> Parser (Constructor AbstractTy)
forall a b. (a -> b) -> a -> b
$ ConstructorName
-> Vector (ValT AbstractTy) -> Constructor AbstractTy
forall a. ConstructorName -> Vector (ValT a) -> Constructor a
Constructor ConstructorName
ctorNm Vector (ValT AbstractTy)
ctorArgs

{- DataEncoding encodes as a typical sum type, and will look like:

   {tag: "SOP", fields: []}
   | {tag: "PlutusData", fields: [...]}
   | {tag: "BuiltinStrategy", fields: [...]}
-}

-- | @since 1.3.0
encodeDataEncoding :: DataEncoding -> Encoding
encodeDataEncoding :: DataEncoding -> Encoding
encodeDataEncoding = \case
  DataEncoding
SOP -> Text -> [Encoding] -> Encoding
taggedFields Text
"SOP" []
  PlutusData PlutusDataStrategy
strat -> Text -> [Encoding] -> Encoding
taggedFields Text
"PlutusData" [PlutusDataStrategy -> Encoding
encodePlutusDataStrategy PlutusDataStrategy
strat]
  BuiltinStrategy InternalStrategy
internalStrat -> Text -> [Encoding] -> Encoding
taggedFields Text
"BuiltinStrategy" [InternalStrategy -> Encoding
encodeInternalStrategy InternalStrategy
internalStrat]

-- | @since 1.3.0
decodeDataEncoding :: Value -> Parser DataEncoding
decodeDataEncoding :: Value -> Parser DataEncoding
decodeDataEncoding = String
-> (Object -> Parser DataEncoding) -> Value -> Parser DataEncoding
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DataEncoding" Object -> Parser DataEncoding
go
  where
    go :: Object -> Parser DataEncoding
    go :: Object -> Parser DataEncoding
go Object
obj = do
      Text
tagStr <- Object -> Key -> (Value -> Parser Text) -> Parser Text
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
obj Key
"tag" (forall a. FromJSON a => Value -> Parser a
parseJSON @Text)
      Value
fieldsArrVal <- Object -> Key -> (Value -> Parser Value) -> Parser Value
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
obj Key
"fields" Value -> Parser Value
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
      Maybe Value
mfield0 <- String
-> (Array -> Parser (Maybe Value)) -> Value -> Parser (Maybe Value)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"index 0" (\Array
arr -> Maybe Value -> Parser (Maybe Value)
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe Value -> Parser (Maybe Value))
-> Maybe Value -> Parser (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Array
arr Array -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
Vector.!? Int
0) Value
fieldsArrVal
      case Text
tagStr of
        Text
"SOP" -> DataEncoding -> Parser DataEncoding
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure DataEncoding
SOP
        Text
otherTag -> case Maybe Value
mfield0 of
          Maybe Value
Nothing -> String -> Parser DataEncoding
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"No fields present when deserializing a PlutusData"
          Just Value
field0 -> case Text
otherTag of
            Text
"PlutusData" -> PlutusDataStrategy -> DataEncoding
PlutusData (PlutusDataStrategy -> DataEncoding)
-> Parser PlutusDataStrategy -> Parser DataEncoding
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser PlutusDataStrategy
decodePlutusDataStrategy Value
field0
            Text
"BuiltinStrategy" -> InternalStrategy -> DataEncoding
BuiltinStrategy (InternalStrategy -> DataEncoding)
-> Parser InternalStrategy -> Parser DataEncoding
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser InternalStrategy
decodeInternalStrategy Value
field0
            Text
other -> String -> Parser DataEncoding
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Parser DataEncoding) -> String -> Parser DataEncoding
forall a b. (a -> b) -> a -> b
$ String
"Invalid DataEncoding tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
other

{- PlutusDataStrategy encodes as a typical sum type. (Omitting the 'fields' field b/c it's an enumeration)

   {tag: "EnumData"}
   | {tag: "ProductListData"}
   | {tag: "ConstrData"}
   | {tag: "NewtypeData"}

-}

-- | @since 1.3.0
encodePlutusDataStrategy :: PlutusDataStrategy -> Encoding
encodePlutusDataStrategy :: PlutusDataStrategy -> Encoding
encodePlutusDataStrategy = PlutusDataStrategy -> Encoding
forall a. Show a => a -> Encoding
encodeEnum

-- | @since 1.3.0
decodePlutusDataStrategy :: Value -> Parser PlutusDataStrategy
decodePlutusDataStrategy :: Value -> Parser PlutusDataStrategy
decodePlutusDataStrategy =
  [Text :=> (Object -> Parser PlutusDataStrategy)]
-> Value -> Parser PlutusDataStrategy
forall a. [Text :=> (Object -> Parser a)] -> Value -> Parser a
caseOnTag
    [ Text
"EnumData" Text
-> (Object -> Parser PlutusDataStrategy)
-> Text :=> (Object -> Parser PlutusDataStrategy)
forall a b. a -> b -> a :=> b
:=> PlutusDataStrategy -> forall b. b -> Parser PlutusDataStrategy
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM PlutusDataStrategy
EnumData,
      Text
"ProductListData" Text
-> (Object -> Parser PlutusDataStrategy)
-> Text :=> (Object -> Parser PlutusDataStrategy)
forall a b. a -> b -> a :=> b
:=> PlutusDataStrategy -> forall b. b -> Parser PlutusDataStrategy
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM PlutusDataStrategy
ProductListData,
      Text
"ConstrData" Text
-> (Object -> Parser PlutusDataStrategy)
-> Text :=> (Object -> Parser PlutusDataStrategy)
forall a b. a -> b -> a :=> b
:=> PlutusDataStrategy -> forall b. b -> Parser PlutusDataStrategy
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM PlutusDataStrategy
Ty.ConstrData,
      Text
"NewtypeData" Text
-> (Object -> Parser PlutusDataStrategy)
-> Text :=> (Object -> Parser PlutusDataStrategy)
forall a b. a -> b -> a :=> b
:=> PlutusDataStrategy -> forall b. b -> Parser PlutusDataStrategy
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM PlutusDataStrategy
NewtypeData
    ]

{- InternalStrategy encodes as a typical enumeration type:
  {tag: "InternalListStrat"}
  | {tag: "InternalPairStrat"}
  | {tag: "InternalDataStrat"}
  | {tag: "InternalAssocMapStrat"}
  | {tag: "InternalOpaqueStrat"}

-}
encodeInternalStrategy :: InternalStrategy -> Encoding
encodeInternalStrategy :: InternalStrategy -> Encoding
encodeInternalStrategy = InternalStrategy -> Encoding
forall a. Show a => a -> Encoding
encodeEnum

decodeInternalStrategy :: Value -> Parser InternalStrategy
decodeInternalStrategy :: Value -> Parser InternalStrategy
decodeInternalStrategy =
  [Text :=> (Object -> Parser InternalStrategy)]
-> Value -> Parser InternalStrategy
forall a. [Text :=> (Object -> Parser a)] -> Value -> Parser a
caseOnTag
    [ Text
"InternalListStrat" Text
-> (Object -> Parser InternalStrategy)
-> Text :=> (Object -> Parser InternalStrategy)
forall a b. a -> b -> a :=> b
:=> InternalStrategy -> forall b. b -> Parser InternalStrategy
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM InternalStrategy
InternalListStrat,
      Text
"InternalPairStrat" Text
-> (Object -> Parser InternalStrategy)
-> Text :=> (Object -> Parser InternalStrategy)
forall a b. a -> b -> a :=> b
:=> InternalStrategy -> forall b. b -> Parser InternalStrategy
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM InternalStrategy
InternalPairStrat,
      Text
"InternalAssocMapStrat" Text
-> (Object -> Parser InternalStrategy)
-> Text :=> (Object -> Parser InternalStrategy)
forall a b. a -> b -> a :=> b
:=> InternalStrategy -> forall b. b -> Parser InternalStrategy
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM InternalStrategy
InternalAssocMapStrat,
      Text
"InternalOpaqueStrat" Text
-> (Object -> Parser InternalStrategy)
-> Text :=> (Object -> Parser InternalStrategy)
forall a b. a -> b -> a :=> b
:=> InternalStrategy -> forall b. b -> Parser InternalStrategy
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM InternalStrategy
InternalOpaqueStrat
    ]

{- PlutusDataConstructor encodes as a typical enumeration type:

  {tag: "PlutusI"}
  | {tag: "PlutusB"}
  | {tag: "PlutusConstr"}
  | {tag: "PlutusList"}
  | {tag: PlutusMap}

-}

-- | @since 1.3.0
encodePlutusDataConstructor :: PlutusDataConstructor -> Encoding
encodePlutusDataConstructor :: PlutusDataConstructor -> Encoding
encodePlutusDataConstructor = PlutusDataConstructor -> Encoding
forall a. Show a => a -> Encoding
encodeEnum

-- | @since 1.3.0
decodePlutusDataConstructor :: Value -> Parser PlutusDataConstructor
decodePlutusDataConstructor :: Value -> Parser PlutusDataConstructor
decodePlutusDataConstructor =
  [Text :=> (Object -> Parser PlutusDataConstructor)]
-> Value -> Parser PlutusDataConstructor
forall a. [Text :=> (Object -> Parser a)] -> Value -> Parser a
caseOnTag
    [ Text
"PlutusI" Text
-> (Object -> Parser PlutusDataConstructor)
-> Text :=> (Object -> Parser PlutusDataConstructor)
forall a b. a -> b -> a :=> b
:=> PlutusDataConstructor
-> forall b. b -> Parser PlutusDataConstructor
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM PlutusDataConstructor
PlutusI,
      Text
"PlutusB" Text
-> (Object -> Parser PlutusDataConstructor)
-> Text :=> (Object -> Parser PlutusDataConstructor)
forall a b. a -> b -> a :=> b
:=> PlutusDataConstructor
-> forall b. b -> Parser PlutusDataConstructor
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM PlutusDataConstructor
PlutusB,
      Text
"PlutusConstr" Text
-> (Object -> Parser PlutusDataConstructor)
-> Text :=> (Object -> Parser PlutusDataConstructor)
forall a b. a -> b -> a :=> b
:=> PlutusDataConstructor
-> forall b. b -> Parser PlutusDataConstructor
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM PlutusDataConstructor
PlutusConstr,
      Text
"PlutusList" Text
-> (Object -> Parser PlutusDataConstructor)
-> Text :=> (Object -> Parser PlutusDataConstructor)
forall a b. a -> b -> a :=> b
:=> PlutusDataConstructor
-> forall b. b -> Parser PlutusDataConstructor
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM PlutusDataConstructor
PlutusList,
      Text
"PlutusMap" Text
-> (Object -> Parser PlutusDataConstructor)
-> Text :=> (Object -> Parser PlutusDataConstructor)
forall a b. a -> b -> a :=> b
:=> PlutusDataConstructor
-> forall b. b -> Parser PlutusDataConstructor
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM PlutusDataConstructor
PlutusMap
    ]

{- DataDeclaration AbstractTy is a bit atypical. It is a sum type, but we encode
   the arguments to the `DataDeclaration` constructor as an object instead of an array
   (to reduce the possibility for frontend errors).

   For example, if we have:

     @DataDeclaration "Maybe" (Count 1) [...Nothing...,...Just...] SOP@

   It will seralize like:

     {tag: "DataDeclaration"
     , fields: {
        datatypeName: "Maybe",
        datatypeBinders: 1,
        datatypeConstructors: [...],
        datatypeEncoding: {tag: "SOP"}
     }}

   For consistency, we do the same thing with Opaques. E.g.:

     @OpaqueData "Foo" [Plutus_I]@

   Will serialize to:

     { tag: "OpaqueData"
     , fields: {
       datatypeName: "Foo",
       opaquePlutusConstructors: [{tag: "Plutus_I"}]
     }}
-}

-- | @since 1.3.0
encodeDataDeclarationAbstractTy :: DataDeclaration AbstractTy -> Encoding
encodeDataDeclarationAbstractTy :: DataDeclaration AbstractTy -> Encoding
encodeDataDeclarationAbstractTy = \case
  DataDeclaration TyName
nm Count "tyvar"
cnt Vector (Constructor AbstractTy)
ctors DataEncoding
enc ->
    let fieldObj :: Encoding
fieldObj =
          Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
            Key -> Encoding -> Series
pair Key
"datatypeName" (TyName -> Encoding
encodeTyName TyName
nm)
              Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key -> Encoding -> Series
pair Key
"datatypeBinders" (Count "tyvar" -> Encoding
forall (s :: Symbol). Count s -> Encoding
encodeCount Count "tyvar"
cnt)
              Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key -> Encoding -> Series
pair Key
"datatypeConstructors" ((Constructor AbstractTy -> Encoding)
-> [Constructor AbstractTy] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Constructor AbstractTy -> Encoding
encodeConstructor ([Constructor AbstractTy] -> Encoding)
-> (Vector (Constructor AbstractTy) -> [Constructor AbstractTy])
-> Vector (Constructor AbstractTy)
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Constructor AbstractTy) -> [Constructor AbstractTy]
forall a. Vector a -> [a]
Vector.toList (Vector (Constructor AbstractTy) -> Encoding)
-> Vector (Constructor AbstractTy) -> Encoding
forall a b. (a -> b) -> a -> b
$ Vector (Constructor AbstractTy)
ctors)
              Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key -> Encoding -> Series
pair Key
"datatypeEncoding" (DataEncoding -> Encoding
encodeDataEncoding DataEncoding
enc)
     in Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
pair Key
"tag" Encoding
"DataDeclaration" Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key -> Encoding -> Series
pair Key
"fields" Encoding
fieldObj
  OpaqueData TyName
nm Set PlutusDataConstructor
plutusCtors ->
    let fieldObj :: Encoding
fieldObj =
          Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
            Key -> Encoding -> Series
pair Key
"datatypeName" (TyName -> Encoding
encodeTyName TyName
nm)
              Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key -> Encoding -> Series
pair Key
"opaquePlutusConstructors" ((PlutusDataConstructor -> Encoding)
-> [PlutusDataConstructor] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list PlutusDataConstructor -> Encoding
encodePlutusDataConstructor ([PlutusDataConstructor] -> Encoding)
-> (Set PlutusDataConstructor -> [PlutusDataConstructor])
-> Set PlutusDataConstructor
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set PlutusDataConstructor -> [PlutusDataConstructor]
forall a. Set a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (Set PlutusDataConstructor -> Encoding)
-> Set PlutusDataConstructor -> Encoding
forall a b. (a -> b) -> a -> b
$ Set PlutusDataConstructor
plutusCtors)
     in Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
pair Key
"tag" Encoding
"OpaqueData" Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key -> Encoding -> Series
pair Key
"fields" Encoding
fieldObj

-- | @since 1.3.0
decodeDataDeclarationAbstractTy :: Value -> Parser (DataDeclaration AbstractTy)
decodeDataDeclarationAbstractTy :: Value -> Parser (DataDeclaration AbstractTy)
decodeDataDeclarationAbstractTy =
  [Text :=> (Object -> Parser (DataDeclaration AbstractTy))]
-> Value -> Parser (DataDeclaration AbstractTy)
forall a. [Text :=> (Object -> Parser a)] -> Value -> Parser a
caseOnTag
    [ Text
"DataDeclaration" Text
-> (Object -> Parser (DataDeclaration AbstractTy))
-> Text :=> (Object -> Parser (DataDeclaration AbstractTy))
forall a b. a -> b -> a :=> b
:=> Object -> Parser (DataDeclaration AbstractTy)
goDataDecl,
      Text
"OpaqueData" Text
-> (Object -> Parser (DataDeclaration AbstractTy))
-> Text :=> (Object -> Parser (DataDeclaration AbstractTy))
forall a b. a -> b -> a :=> b
:=> Object -> Parser (DataDeclaration AbstractTy)
goOpaqueData
    ]
  where
    goDataDecl :: Object -> Parser (DataDeclaration AbstractTy)
    goDataDecl :: Object -> Parser (DataDeclaration AbstractTy)
goDataDecl Object
obj = do
      Object
fieldsObj <- Object -> Key -> (Value -> Parser Object) -> Parser Object
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
obj Key
"fields" (String -> (Object -> Parser Object) -> Value -> Parser Object
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Datatype fields" Object -> Parser Object
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure)
      TyName
dtName <- Object -> Key -> (Value -> Parser TyName) -> Parser TyName
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
fieldsObj Key
"datatypeName" Value -> Parser TyName
decodeTyName
      Count "tyvar"
dtBinders <- Object
-> Key
-> (Value -> Parser (Count "tyvar"))
-> Parser (Count "tyvar")
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
fieldsObj Key
"datatypeBinders" Value -> Parser (Count "tyvar")
forall (s :: Symbol). KnownSymbol s => Value -> Parser (Count s)
decodeCount
      Vector (Constructor AbstractTy)
dtCtors <- Object
-> Key
-> (Value -> Parser (Vector (Constructor AbstractTy)))
-> Parser (Vector (Constructor AbstractTy))
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
fieldsObj Key
"datatypeConstructors" (String
-> (Array -> Parser (Vector (Constructor AbstractTy)))
-> Value
-> Parser (Vector (Constructor AbstractTy))
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"Datatype ctors" ((Value -> Parser (Constructor AbstractTy))
-> Array -> Parser (Vector (Constructor AbstractTy))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse Value -> Parser (Constructor AbstractTy)
decodeConstructor))
      DataEncoding
dtEncoding <- Object
-> Key -> (Value -> Parser DataEncoding) -> Parser DataEncoding
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
fieldsObj Key
"datatypeEncoding" Value -> Parser DataEncoding
decodeDataEncoding
      DataDeclaration AbstractTy -> Parser (DataDeclaration AbstractTy)
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (DataDeclaration AbstractTy -> Parser (DataDeclaration AbstractTy))
-> DataDeclaration AbstractTy
-> Parser (DataDeclaration AbstractTy)
forall a b. (a -> b) -> a -> b
$ TyName
-> Count "tyvar"
-> Vector (Constructor AbstractTy)
-> DataEncoding
-> DataDeclaration AbstractTy
forall a.
TyName
-> Count "tyvar"
-> Vector (Constructor a)
-> DataEncoding
-> DataDeclaration a
DataDeclaration TyName
dtName Count "tyvar"
dtBinders Vector (Constructor AbstractTy)
dtCtors DataEncoding
dtEncoding

    goOpaqueData :: Object -> Parser (DataDeclaration AbstractTy)
    goOpaqueData :: Object -> Parser (DataDeclaration AbstractTy)
goOpaqueData Object
obj = do
      Object
fieldsObj <- Object -> Key -> (Value -> Parser Object) -> Parser Object
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
obj Key
"fields" (String -> (Object -> Parser Object) -> Value -> Parser Object
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Datatype fields (Opaque)" Object -> Parser Object
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure)
      TyName
dtName <- Object -> Key -> (Value -> Parser TyName) -> Parser TyName
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
fieldsObj Key
"datatypeName" Value -> Parser TyName
decodeTyName
      Vector PlutusDataConstructor
plutusCtors <-
        Object
-> Key
-> (Value -> Parser (Vector PlutusDataConstructor))
-> Parser (Vector PlutusDataConstructor)
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse'
          Object
fieldsObj
          Key
"opaquePlutusConstructors"
          (String
-> (Array -> Parser (Vector PlutusDataConstructor))
-> Value
-> Parser (Vector PlutusDataConstructor)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"Opaque Plutus Ctors" ((Value -> Parser PlutusDataConstructor)
-> Array -> Parser (Vector PlutusDataConstructor)
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse Value -> Parser PlutusDataConstructor
decodePlutusDataConstructor))
      DataDeclaration AbstractTy -> Parser (DataDeclaration AbstractTy)
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (DataDeclaration AbstractTy -> Parser (DataDeclaration AbstractTy))
-> DataDeclaration AbstractTy
-> Parser (DataDeclaration AbstractTy)
forall a b. (a -> b) -> a -> b
$ TyName -> Set PlutusDataConstructor -> DataDeclaration AbstractTy
forall a. TyName -> Set PlutusDataConstructor -> DataDeclaration a
OpaqueData TyName
dtName ([PlutusDataConstructor] -> Set PlutusDataConstructor
forall a. Ord a => [a] -> Set a
S.fromList ([PlutusDataConstructor] -> Set PlutusDataConstructor)
-> (Vector PlutusDataConstructor -> [PlutusDataConstructor])
-> Vector PlutusDataConstructor
-> Set PlutusDataConstructor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector PlutusDataConstructor -> [PlutusDataConstructor]
forall a. Vector a -> [a]
Vector.toList (Vector PlutusDataConstructor -> Set PlutusDataConstructor)
-> Vector PlutusDataConstructor -> Set PlutusDataConstructor
forall a b. (a -> b) -> a -> b
$ Vector PlutusDataConstructor
plutusCtors)

{- ASG Specific Types & Components

-}

{- Id encodes directly as a number. E.g.:

   @Id 101@ -> 101
-}

-- | @since 1.3.0
encodeId :: Id -> Encoding
encodeId :: Id -> Encoding
encodeId (Id Word64
n) = Word64 -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Word64
n

-- | @since 1.3.0
decodeId :: Value -> Parser Id
decodeId :: Value -> Parser Id
decodeId = (Word64 -> Id) -> Parser Word64 -> Parser Id
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Id
Id (Parser Word64 -> Parser Id)
-> (Value -> Parser Word64) -> Value -> Parser Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Word64
forall a. FromJSON a => Value -> Parser a
parseJSON

{- Ref encodes as a typical sum type without named fields:

   {tag: "AnArg", fields: [...]}
   | {tag: "AnId": fields: [101]}
-}

-- | @since 1.3.0
encodeRef :: Ref -> Encoding
encodeRef :: Ref -> Encoding
encodeRef = \case
  AnArg Arg
arg' -> Text -> [Encoding] -> Encoding
taggedFields Text
"AnArg" [Arg -> Encoding
encodeArg Arg
arg']
  AnId Id
i -> Text -> [Encoding] -> Encoding
taggedFields Text
"AnId" [Id -> Encoding
encodeId Id
i]

-- | @since 1.3.0
decodeRef :: Value -> Parser Ref
decodeRef :: Value -> Parser Ref
decodeRef =
  [Text :=> (Object -> Parser Ref)] -> Value -> Parser Ref
forall a. [Text :=> (Object -> Parser a)] -> Value -> Parser a
caseOnTag
    [ Text
"AnArg" Text -> (Object -> Parser Ref) -> Text :=> (Object -> Parser Ref)
forall a b. a -> b -> a :=> b
:=> (Array -> Parser Ref) -> Object -> Parser Ref
forall a. (Array -> Parser a) -> Object -> Parser a
withFields (Int -> (Value -> Parser Ref) -> Array -> Parser Ref
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
0 ((Arg -> Ref) -> Parser Arg -> Parser Ref
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Arg -> Ref
AnArg (Parser Arg -> Parser Ref)
-> (Value -> Parser Arg) -> Value -> Parser Ref
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Arg
decodeArg)),
      Text
"AnId" Text -> (Object -> Parser Ref) -> Text :=> (Object -> Parser Ref)
forall a b. a -> b -> a :=> b
:=> (Array -> Parser Ref) -> Object -> Parser Ref
forall a. (Array -> Parser a) -> Object -> Parser a
withFields (Int -> (Value -> Parser Ref) -> Array -> Parser Ref
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
0 ((Id -> Ref) -> Parser Id -> Parser Ref
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> Ref
AnId (Parser Id -> Parser Ref)
-> (Value -> Parser Id) -> Value -> Parser Ref
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Id
decodeId))
    ]

{- Arg encodes as an object, e.g.:

   {argDeBruijn: 0,
    argIndex: 1,
    argType: ...
   }

-}

-- | @since 1.3.0
encodeArg :: Arg -> Encoding
encodeArg :: Arg -> Encoding
encodeArg (Arg DeBruijn
db Index "arg"
ix ValT AbstractTy
ty) =
  let dbEnc :: Encoding
dbEnc = DeBruijn -> Encoding
encodeDeBruijn DeBruijn
db
      ixEnc :: Encoding
ixEnc = Index "arg" -> Encoding
forall (s :: Symbol). Index s -> Encoding
encodeIndex Index "arg"
ix
      tyEnc :: Encoding
tyEnc = ValT AbstractTy -> Encoding
encodeValTAbstractTy ValT AbstractTy
ty
   in Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
        Key -> Encoding -> Series
pair Key
"argDeBruijn" Encoding
dbEnc
          Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key -> Encoding -> Series
pair Key
"argIndex" Encoding
ixEnc
          Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key -> Encoding -> Series
pair Key
"argType" Encoding
tyEnc

-- | @since 1.3.0
decodeArg :: Value -> Parser Arg
decodeArg :: Value -> Parser Arg
decodeArg = String -> (Object -> Parser Arg) -> Value -> Parser Arg
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Arg" ((Object -> Parser Arg) -> Value -> Parser Arg)
-> (Object -> Parser Arg) -> Value -> Parser Arg
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  DeBruijn
argDB <- Key -> (Value -> Parser DeBruijn) -> Object -> Parser DeBruijn
forall a. Key -> (Value -> Parser a) -> Object -> Parser a
withField Key
"argDeBruijn" Value -> Parser DeBruijn
decodeDeBruijn Object
obj
  Index "arg"
argIX <- Key
-> (Value -> Parser (Index "arg"))
-> Object
-> Parser (Index "arg")
forall a. Key -> (Value -> Parser a) -> Object -> Parser a
withField Key
"argIndex" Value -> Parser (Index "arg")
forall (s :: Symbol). KnownSymbol s => Value -> Parser (Index s)
decodeIndex Object
obj
  ValT AbstractTy
argTy <- Key
-> (Value -> Parser (ValT AbstractTy))
-> Object
-> Parser (ValT AbstractTy)
forall a. Key -> (Value -> Parser a) -> Object -> Parser a
withField Key
"argType" Value -> Parser (ValT AbstractTy)
decodeValTAbstractTy Object
obj
  Arg -> Parser Arg
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Arg -> Parser Arg) -> Arg -> Parser Arg
forall a b. (a -> b) -> a -> b
$ DeBruijn -> Index "arg" -> ValT AbstractTy -> Arg
Arg DeBruijn
argDB Index "arg"
argIX ValT AbstractTy
argTy

{- AConstant

   Serializes as a sum type without named fields:

   {tag: "AUnit"}
   | {tag: "ABoolean", fields: [true]}
   | {tag: "AnInteger", fields: [22]}
   | {tag: "AByteString", fields: ["\0x32"]}
   | {tag: "AString", fields: ["Hello"]}

-}

-- | @since 1.3.0
encodeAConstant :: AConstant -> Encoding
encodeAConstant :: AConstant -> Encoding
encodeAConstant = \case
  AConstant
AUnit -> Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
pair Key
"tag" Encoding
"AUnit"
  ABoolean Bool
b -> Text -> [Encoding] -> Encoding
taggedFields Text
"ABoolean" [Bool -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Bool
b]
  AnInteger Integer
i -> Text -> [Encoding] -> Encoding
taggedFields Text
"AnInteger" [Integer -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Integer
i]
  AByteString ByteString
bs -> Text -> [Encoding] -> Encoding
taggedFields Text
"AByteString" [Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding)
-> (ByteString -> Text) -> ByteString -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Hex.encodeHex (ByteString -> Encoding) -> ByteString -> Encoding
forall a b. (a -> b) -> a -> b
$ ByteString
bs]
  AString Text
str -> Text -> [Encoding] -> Encoding
taggedFields Text
"AString" [Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Text
str]

-- | @since 1.3.0
decodeAConstant :: Value -> Parser AConstant
decodeAConstant :: Value -> Parser AConstant
decodeAConstant =
  [Text :=> (Object -> Parser AConstant)]
-> Value -> Parser AConstant
forall a. [Text :=> (Object -> Parser a)] -> Value -> Parser a
caseOnTag
    [ Text
"AUnit" Text
-> (Object -> Parser AConstant)
-> Text :=> (Object -> Parser AConstant)
forall a b. a -> b -> a :=> b
:=> AConstant -> forall b. b -> Parser AConstant
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM AConstant
AUnit,
      Text
"ABoolean" Text
-> (Object -> Parser AConstant)
-> Text :=> (Object -> Parser AConstant)
forall a b. a -> b -> a :=> b
:=> (Value -> Parser AConstant) -> Object -> Parser AConstant
forall a. (Value -> Parser a) -> Object -> Parser a
withField0 ((Bool -> AConstant) -> Parser Bool -> Parser AConstant
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> AConstant
ABoolean (Parser Bool -> Parser AConstant)
-> (Value -> Parser Bool) -> Value -> Parser AConstant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Bool
forall a. FromJSON a => Value -> Parser a
parseJSON),
      Text
"AnInteger" Text
-> (Object -> Parser AConstant)
-> Text :=> (Object -> Parser AConstant)
forall a b. a -> b -> a :=> b
:=> (Value -> Parser AConstant) -> Object -> Parser AConstant
forall a. (Value -> Parser a) -> Object -> Parser a
withField0 ((Integer -> AConstant) -> Parser Integer -> Parser AConstant
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> AConstant
AnInteger (Parser Integer -> Parser AConstant)
-> (Value -> Parser Integer) -> Value -> Parser AConstant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseJSON),
      Text
"AByteString" Text
-> (Object -> Parser AConstant)
-> Text :=> (Object -> Parser AConstant)
forall a b. a -> b -> a :=> b
:=> (Value -> Parser AConstant) -> Object -> Parser AConstant
forall a. (Value -> Parser a) -> Object -> Parser a
withField0 ((ByteString -> AConstant) -> Parser ByteString -> Parser AConstant
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> AConstant
AByteString (Parser ByteString -> Parser AConstant)
-> (Value -> Parser ByteString) -> Value -> Parser AConstant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser ByteString
decodeByteStringHex),
      Text
"AString" Text
-> (Object -> Parser AConstant)
-> Text :=> (Object -> Parser AConstant)
forall a b. a -> b -> a :=> b
:=> (Value -> Parser AConstant) -> Object -> Parser AConstant
forall a. (Value -> Parser a) -> Object -> Parser a
withField0 ((Text -> AConstant) -> Parser Text -> Parser AConstant
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> AConstant
AString (Parser Text -> Parser AConstant)
-> (Value -> Parser Text) -> Value -> Parser AConstant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON)
    ]

{- ValNodeInfo

   Serializes as a sum type without named fields:

   {tag: "Lit", fields: [a]}
   | {tag: "App", fields: [a,b]}
   | {tag: "Thunk",fields: [a]}
   | {tag: "Cata", fields: [a,b]}
   | {tag: "DataConstructor", fields: [a,b,c]}
   | {tag: "Match", fields: [a,b]}

-}

-- | @since 1.3.0
encodeValNodeInfo :: ValNodeInfo -> Encoding
encodeValNodeInfo :: ValNodeInfo -> Encoding
encodeValNodeInfo = \case
  LitInternal AConstant
aconst -> Text -> [Encoding] -> Encoding
taggedFields Text
"Lit" [AConstant -> Encoding
encodeAConstant AConstant
aconst]
  AppInternal Id
f Vector Ref
args Vector (Wedge BoundTyVar (ValT Void))
instTys ->
    Text -> [Encoding] -> Encoding
taggedFields
      Text
"App"
      [ Id -> Encoding
encodeId Id
f,
        (Ref -> Encoding) -> [Ref] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Ref -> Encoding
encodeRef ([Ref] -> Encoding)
-> (Vector Ref -> [Ref]) -> Vector Ref -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Ref -> [Ref]
forall a. Vector a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (Vector Ref -> Encoding) -> Vector Ref -> Encoding
forall a b. (a -> b) -> a -> b
$ Vector Ref
args,
        (Wedge BoundTyVar (ValT Void) -> Encoding)
-> [Wedge BoundTyVar (ValT Void)] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Wedge BoundTyVar (ValT Void) -> Encoding
encodeInstTy ([Wedge BoundTyVar (ValT Void)] -> Encoding)
-> (Vector (Wedge BoundTyVar (ValT Void))
    -> [Wedge BoundTyVar (ValT Void)])
-> Vector (Wedge BoundTyVar (ValT Void))
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Wedge BoundTyVar (ValT Void))
-> [Wedge BoundTyVar (ValT Void)]
forall a. Vector a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (Vector (Wedge BoundTyVar (ValT Void)) -> Encoding)
-> Vector (Wedge BoundTyVar (ValT Void)) -> Encoding
forall a b. (a -> b) -> a -> b
$ Vector (Wedge BoundTyVar (ValT Void))
instTys
      ]
  ThunkInternal Id
f -> Text -> [Encoding] -> Encoding
taggedFields Text
"Thunk" [Id -> Encoding
encodeId Id
f]
  CataInternal Ref
r1 Ref
r2 -> Text -> [Encoding] -> Encoding
taggedFields Text
"Cata" [Ref -> Encoding
encodeRef Ref
r1, Ref -> Encoding
encodeRef Ref
r2]
  DataConstructorInternal TyName
tn ConstructorName
cn Vector Ref
args ->
    Text -> [Encoding] -> Encoding
taggedFields
      Text
"DataConstructor"
      [ TyName -> Encoding
encodeTyName TyName
tn,
        ConstructorName -> Encoding
encodeConstructorName ConstructorName
cn,
        (Ref -> Encoding) -> [Ref] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Ref -> Encoding
encodeRef ([Ref] -> Encoding)
-> (Vector Ref -> [Ref]) -> Vector Ref -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Ref -> [Ref]
forall a. Vector a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (Vector Ref -> Encoding) -> Vector Ref -> Encoding
forall a b. (a -> b) -> a -> b
$ Vector Ref
args
      ]
  MatchInternal Ref
scrut Vector Ref
branches ->
    Text -> [Encoding] -> Encoding
taggedFields Text
"Match" [Ref -> Encoding
encodeRef Ref
scrut, (Ref -> Encoding) -> [Ref] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Ref -> Encoding
encodeRef ([Ref] -> Encoding)
-> (Vector Ref -> [Ref]) -> Vector Ref -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Ref -> [Ref]
forall a. Vector a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (Vector Ref -> Encoding) -> Vector Ref -> Encoding
forall a b. (a -> b) -> a -> b
$ Vector Ref
branches]

-- | @since 1.3.0
decodeValNodeInfo :: Value -> Parser ValNodeInfo
decodeValNodeInfo :: Value -> Parser ValNodeInfo
decodeValNodeInfo =
  [Text :=> (Object -> Parser ValNodeInfo)]
-> Value -> Parser ValNodeInfo
forall a. [Text :=> (Object -> Parser a)] -> Value -> Parser a
caseOnTag
    [ Text
"Lit" Text
-> (Object -> Parser ValNodeInfo)
-> Text :=> (Object -> Parser ValNodeInfo)
forall a b. a -> b -> a :=> b
:=> (Value -> Parser ValNodeInfo) -> Object -> Parser ValNodeInfo
forall a. (Value -> Parser a) -> Object -> Parser a
withField0 ((AConstant -> ValNodeInfo)
-> Parser AConstant -> Parser ValNodeInfo
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap AConstant -> ValNodeInfo
LitInternal (Parser AConstant -> Parser ValNodeInfo)
-> (Value -> Parser AConstant) -> Value -> Parser ValNodeInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser AConstant
decodeAConstant),
      Text
"App"
        Text
-> (Object -> Parser ValNodeInfo)
-> Text :=> (Object -> Parser ValNodeInfo)
forall a b. a -> b -> a :=> b
:=> (Array -> Parser ValNodeInfo) -> Object -> Parser ValNodeInfo
forall a. (Array -> Parser a) -> Object -> Parser a
withFields
        ((Array -> Parser ValNodeInfo) -> Object -> Parser ValNodeInfo)
-> (Array -> Parser ValNodeInfo) -> Object -> Parser ValNodeInfo
forall a b. (a -> b) -> a -> b
$ \Array
fieldsArr -> do
          Id
f <- Int -> (Value -> Parser Id) -> Array -> Parser Id
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
0 Value -> Parser Id
decodeId Array
fieldsArr
          Vector Ref
args <- Int
-> (Value -> Parser (Vector Ref)) -> Array -> Parser (Vector Ref)
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
1 (String
-> (Array -> Parser (Vector Ref)) -> Value -> Parser (Vector Ref)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"App args" ((Value -> Parser Ref) -> Array -> Parser (Vector Ref)
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse Value -> Parser Ref
decodeRef)) Array
fieldsArr
          Vector (Wedge BoundTyVar (ValT Void))
instTys <- Int
-> (Value -> Parser (Vector (Wedge BoundTyVar (ValT Void))))
-> Array
-> Parser (Vector (Wedge BoundTyVar (ValT Void)))
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
2 (String
-> (Array -> Parser (Vector (Wedge BoundTyVar (ValT Void))))
-> Value
-> Parser (Vector (Wedge BoundTyVar (ValT Void)))
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"App instTys" ((Value -> Parser (Wedge BoundTyVar (ValT Void)))
-> Array -> Parser (Vector (Wedge BoundTyVar (ValT Void)))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse Value -> Parser (Wedge BoundTyVar (ValT Void))
decodeInstTy)) Array
fieldsArr
          ValNodeInfo -> Parser ValNodeInfo
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ValNodeInfo -> Parser ValNodeInfo)
-> ValNodeInfo -> Parser ValNodeInfo
forall a b. (a -> b) -> a -> b
$ Id
-> Vector Ref
-> Vector (Wedge BoundTyVar (ValT Void))
-> ValNodeInfo
AppInternal Id
f Vector Ref
args Vector (Wedge BoundTyVar (ValT Void))
instTys,
      Text
"Thunk" Text
-> (Object -> Parser ValNodeInfo)
-> Text :=> (Object -> Parser ValNodeInfo)
forall a b. a -> b -> a :=> b
:=> (Value -> Parser ValNodeInfo) -> Object -> Parser ValNodeInfo
forall a. (Value -> Parser a) -> Object -> Parser a
withField0 ((Id -> ValNodeInfo) -> Parser Id -> Parser ValNodeInfo
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> ValNodeInfo
ThunkInternal (Parser Id -> Parser ValNodeInfo)
-> (Value -> Parser Id) -> Value -> Parser ValNodeInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Id
decodeId),
      Text
"Cata"
        Text
-> (Object -> Parser ValNodeInfo)
-> Text :=> (Object -> Parser ValNodeInfo)
forall a b. a -> b -> a :=> b
:=> (Array -> Parser ValNodeInfo) -> Object -> Parser ValNodeInfo
forall a. (Array -> Parser a) -> Object -> Parser a
withFields
        ((Array -> Parser ValNodeInfo) -> Object -> Parser ValNodeInfo)
-> (Array -> Parser ValNodeInfo) -> Object -> Parser ValNodeInfo
forall a b. (a -> b) -> a -> b
$ \Array
fieldsArr -> do
          Ref
r1 <- Int -> (Value -> Parser Ref) -> Array -> Parser Ref
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
0 Value -> Parser Ref
decodeRef Array
fieldsArr
          Ref
r2 <- Int -> (Value -> Parser Ref) -> Array -> Parser Ref
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
1 Value -> Parser Ref
decodeRef Array
fieldsArr
          ValNodeInfo -> Parser ValNodeInfo
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ValNodeInfo -> Parser ValNodeInfo)
-> ValNodeInfo -> Parser ValNodeInfo
forall a b. (a -> b) -> a -> b
$ Ref -> Ref -> ValNodeInfo
CataInternal Ref
r1 Ref
r2,
      Text
"DataConstructor"
        Text
-> (Object -> Parser ValNodeInfo)
-> Text :=> (Object -> Parser ValNodeInfo)
forall a b. a -> b -> a :=> b
:=> (Array -> Parser ValNodeInfo) -> Object -> Parser ValNodeInfo
forall a. (Array -> Parser a) -> Object -> Parser a
withFields
        ((Array -> Parser ValNodeInfo) -> Object -> Parser ValNodeInfo)
-> (Array -> Parser ValNodeInfo) -> Object -> Parser ValNodeInfo
forall a b. (a -> b) -> a -> b
$ \Array
fieldsArr -> do
          TyName
tn <- Int -> (Value -> Parser TyName) -> Array -> Parser TyName
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
0 Value -> Parser TyName
decodeTyName Array
fieldsArr
          ConstructorName
ctorNm <- Int
-> (Value -> Parser ConstructorName)
-> Array
-> Parser ConstructorName
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
1 Value -> Parser ConstructorName
decodeConstructorName Array
fieldsArr
          Vector Ref
args <- Int
-> (Value -> Parser (Vector Ref)) -> Array -> Parser (Vector Ref)
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
2 (String
-> (Array -> Parser (Vector Ref)) -> Value -> Parser (Vector Ref)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"Datatype args" ((Value -> Parser Ref) -> Array -> Parser (Vector Ref)
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse Value -> Parser Ref
decodeRef)) Array
fieldsArr
          ValNodeInfo -> Parser ValNodeInfo
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ValNodeInfo -> Parser ValNodeInfo)
-> ValNodeInfo -> Parser ValNodeInfo
forall a b. (a -> b) -> a -> b
$ TyName -> ConstructorName -> Vector Ref -> ValNodeInfo
DataConstructorInternal TyName
tn ConstructorName
ctorNm Vector Ref
args,
      Text
"Match"
        Text
-> (Object -> Parser ValNodeInfo)
-> Text :=> (Object -> Parser ValNodeInfo)
forall a b. a -> b -> a :=> b
:=> (Array -> Parser ValNodeInfo) -> Object -> Parser ValNodeInfo
forall a. (Array -> Parser a) -> Object -> Parser a
withFields
        ((Array -> Parser ValNodeInfo) -> Object -> Parser ValNodeInfo)
-> (Array -> Parser ValNodeInfo) -> Object -> Parser ValNodeInfo
forall a b. (a -> b) -> a -> b
$ \Array
fieldsArr -> do
          Ref
scrut <- Int -> (Value -> Parser Ref) -> Array -> Parser Ref
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
0 Value -> Parser Ref
decodeRef Array
fieldsArr
          Vector Ref
args <- Int
-> (Value -> Parser (Vector Ref)) -> Array -> Parser (Vector Ref)
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
1 (String
-> (Array -> Parser (Vector Ref)) -> Value -> Parser (Vector Ref)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"Match branches" ((Value -> Parser Ref) -> Array -> Parser (Vector Ref)
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse Value -> Parser Ref
decodeRef)) Array
fieldsArr
          ValNodeInfo -> Parser ValNodeInfo
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ValNodeInfo -> Parser ValNodeInfo)
-> ValNodeInfo -> Parser ValNodeInfo
forall a b. (a -> b) -> a -> b
$ Ref -> Vector Ref -> ValNodeInfo
MatchInternal Ref
scrut Vector Ref
args
    ]

{- CompNodeInfo

   Serializes as a sum type without named fields:

   {tag: "Builtin1Internal", fields: [f]}
   | {tag: "Builtin2Internal", fields: [f]}
   | {tag: "Builtin3Internal", fields: [f]}
   | {tag: "Builtin6Internal", fields: [f]}
   | {tag: "LamInternal", fields: [r]}
   | {tag: "ForceInternal", fields: [r]}
-}

-- | @since 1.3.0
encodeCompNodeInfo :: CompNodeInfo -> Encoding
encodeCompNodeInfo :: CompNodeInfo -> Encoding
encodeCompNodeInfo = \case
  Builtin1Internal OneArgFunc
fun1 -> Text -> [Encoding] -> Encoding
taggedFields Text
"Builtin1Internal" [OneArgFunc -> Encoding
encodeOneArgFunc OneArgFunc
fun1]
  Builtin2Internal TwoArgFunc
fun2 -> Text -> [Encoding] -> Encoding
taggedFields Text
"Builtin2Internal" [TwoArgFunc -> Encoding
encodeTwoArgFunc TwoArgFunc
fun2]
  Builtin3Internal ThreeArgFunc
fun3 -> Text -> [Encoding] -> Encoding
taggedFields Text
"Builtin3Internal" [ThreeArgFunc -> Encoding
encodeThreeArgFunc ThreeArgFunc
fun3]
  Builtin6Internal SixArgFunc
fun6 -> Text -> [Encoding] -> Encoding
taggedFields Text
"Builtin6Internal" [SixArgFunc -> Encoding
encodeSixArgFunc SixArgFunc
fun6]
  LamInternal Ref
f -> Text -> [Encoding] -> Encoding
taggedFields Text
"LamInternal" [Ref -> Encoding
encodeRef Ref
f]
  ForceInternal Ref
f -> Text -> [Encoding] -> Encoding
taggedFields Text
"ForceInternal" [Ref -> Encoding
encodeRef Ref
f]

-- | @since 1.3.0
decodeCompNodeInfo :: Value -> Parser CompNodeInfo
decodeCompNodeInfo :: Value -> Parser CompNodeInfo
decodeCompNodeInfo =
  [Text :=> (Object -> Parser CompNodeInfo)]
-> Value -> Parser CompNodeInfo
forall a. [Text :=> (Object -> Parser a)] -> Value -> Parser a
caseOnTag
    [ Text
"Builtin1Internal" Text
-> (Object -> Parser CompNodeInfo)
-> Text :=> (Object -> Parser CompNodeInfo)
forall a b. a -> b -> a :=> b
:=> (Value -> Parser CompNodeInfo) -> Object -> Parser CompNodeInfo
forall a. (Value -> Parser a) -> Object -> Parser a
withField0 ((OneArgFunc -> CompNodeInfo)
-> Parser OneArgFunc -> Parser CompNodeInfo
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap OneArgFunc -> CompNodeInfo
Builtin1Internal (Parser OneArgFunc -> Parser CompNodeInfo)
-> (Value -> Parser OneArgFunc) -> Value -> Parser CompNodeInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser OneArgFunc
decodeOneArgFunc),
      Text
"Builtin2Internal" Text
-> (Object -> Parser CompNodeInfo)
-> Text :=> (Object -> Parser CompNodeInfo)
forall a b. a -> b -> a :=> b
:=> (Value -> Parser CompNodeInfo) -> Object -> Parser CompNodeInfo
forall a. (Value -> Parser a) -> Object -> Parser a
withField0 ((TwoArgFunc -> CompNodeInfo)
-> Parser TwoArgFunc -> Parser CompNodeInfo
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap TwoArgFunc -> CompNodeInfo
Builtin2Internal (Parser TwoArgFunc -> Parser CompNodeInfo)
-> (Value -> Parser TwoArgFunc) -> Value -> Parser CompNodeInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser TwoArgFunc
decodeTwoArgFunc),
      Text
"Builtin3Internal" Text
-> (Object -> Parser CompNodeInfo)
-> Text :=> (Object -> Parser CompNodeInfo)
forall a b. a -> b -> a :=> b
:=> (Value -> Parser CompNodeInfo) -> Object -> Parser CompNodeInfo
forall a. (Value -> Parser a) -> Object -> Parser a
withField0 ((ThreeArgFunc -> CompNodeInfo)
-> Parser ThreeArgFunc -> Parser CompNodeInfo
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ThreeArgFunc -> CompNodeInfo
Builtin3Internal (Parser ThreeArgFunc -> Parser CompNodeInfo)
-> (Value -> Parser ThreeArgFunc) -> Value -> Parser CompNodeInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser ThreeArgFunc
decodeThreeArgFunc),
      Text
"Builtin6Internal" Text
-> (Object -> Parser CompNodeInfo)
-> Text :=> (Object -> Parser CompNodeInfo)
forall a b. a -> b -> a :=> b
:=> (Value -> Parser CompNodeInfo) -> Object -> Parser CompNodeInfo
forall a. (Value -> Parser a) -> Object -> Parser a
withField0 ((SixArgFunc -> CompNodeInfo)
-> Parser SixArgFunc -> Parser CompNodeInfo
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap SixArgFunc -> CompNodeInfo
Builtin6Internal (Parser SixArgFunc -> Parser CompNodeInfo)
-> (Value -> Parser SixArgFunc) -> Value -> Parser CompNodeInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser SixArgFunc
decodeSixArgFunc),
      Text
"LamInternal" Text
-> (Object -> Parser CompNodeInfo)
-> Text :=> (Object -> Parser CompNodeInfo)
forall a b. a -> b -> a :=> b
:=> (Value -> Parser CompNodeInfo) -> Object -> Parser CompNodeInfo
forall a. (Value -> Parser a) -> Object -> Parser a
withField0 ((Ref -> CompNodeInfo) -> Parser Ref -> Parser CompNodeInfo
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Ref -> CompNodeInfo
LamInternal (Parser Ref -> Parser CompNodeInfo)
-> (Value -> Parser Ref) -> Value -> Parser CompNodeInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Ref
decodeRef),
      Text
"ForceInternal" Text
-> (Object -> Parser CompNodeInfo)
-> Text :=> (Object -> Parser CompNodeInfo)
forall a b. a -> b -> a :=> b
:=> (Value -> Parser CompNodeInfo) -> Object -> Parser CompNodeInfo
forall a. (Value -> Parser a) -> Object -> Parser a
withField0 ((Ref -> CompNodeInfo) -> Parser Ref -> Parser CompNodeInfo
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Ref -> CompNodeInfo
ForceInternal (Parser Ref -> Parser CompNodeInfo)
-> (Value -> Parser Ref) -> Value -> Parser CompNodeInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Ref
decodeRef)
    ]

{- ASGNode

   Serializes as a sum type without named fields:

   {tag: "ACompNode", fields: [ty,info]}
   | {tag: "AValNode", fields: [ty,info]}
   | {tag: "AnError"}

-}

-- | @since 1.3.0
encodeASGNode :: ASGNode -> Encoding
encodeASGNode :: ASGNode -> Encoding
encodeASGNode = \case
  ACompNode CompT AbstractTy
compT CompNodeInfo
compInfo -> Text -> [Encoding] -> Encoding
taggedFields Text
"ACompNode" [(AbstractTy -> Encoding) -> CompT AbstractTy -> Encoding
forall a. (a -> Encoding) -> CompT a -> Encoding
encodeCompT AbstractTy -> Encoding
encodeAbstractTy CompT AbstractTy
compT, CompNodeInfo -> Encoding
encodeCompNodeInfo CompNodeInfo
compInfo]
  AValNode ValT AbstractTy
valT ValNodeInfo
valInfo -> Text -> [Encoding] -> Encoding
taggedFields Text
"AValNode" [ValT AbstractTy -> Encoding
encodeValTAbstractTy ValT AbstractTy
valT, ValNodeInfo -> Encoding
encodeValNodeInfo ValNodeInfo
valInfo]
  ASGNode
AnError -> Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
pair Key
"tag" Encoding
"AnError"

-- | @since 1.3.0
decodeASGNode :: Value -> Parser ASGNode
decodeASGNode :: Value -> Parser ASGNode
decodeASGNode =
  [Text :=> (Object -> Parser ASGNode)] -> Value -> Parser ASGNode
forall a. [Text :=> (Object -> Parser a)] -> Value -> Parser a
caseOnTag
    [ Text
"ACompNode" Text
-> (Object -> Parser ASGNode)
-> Text :=> (Object -> Parser ASGNode)
forall a b. a -> b -> a :=> b
:=> (Array -> Parser ASGNode) -> Object -> Parser ASGNode
forall a. (Array -> Parser a) -> Object -> Parser a
withFields ((Array -> Parser ASGNode) -> Object -> Parser ASGNode)
-> (Array -> Parser ASGNode) -> Object -> Parser ASGNode
forall a b. (a -> b) -> a -> b
$ \Array
fields -> do
        CompT AbstractTy
compT <- Int
-> (Value -> Parser (CompT AbstractTy))
-> Array
-> Parser (CompT AbstractTy)
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
0 ((Value -> Parser AbstractTy) -> Value -> Parser (CompT AbstractTy)
forall a. (Value -> Parser a) -> Value -> Parser (CompT a)
decodeCompT Value -> Parser AbstractTy
decodeAbstractTy) Array
fields
        CompNodeInfo
compInfo <- Int
-> (Value -> Parser CompNodeInfo) -> Array -> Parser CompNodeInfo
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
1 Value -> Parser CompNodeInfo
decodeCompNodeInfo Array
fields
        ASGNode -> Parser ASGNode
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ASGNode -> Parser ASGNode) -> ASGNode -> Parser ASGNode
forall a b. (a -> b) -> a -> b
$ CompT AbstractTy -> CompNodeInfo -> ASGNode
ACompNode CompT AbstractTy
compT CompNodeInfo
compInfo,
      Text
"AValNode" Text
-> (Object -> Parser ASGNode)
-> Text :=> (Object -> Parser ASGNode)
forall a b. a -> b -> a :=> b
:=> (Array -> Parser ASGNode) -> Object -> Parser ASGNode
forall a. (Array -> Parser a) -> Object -> Parser a
withFields ((Array -> Parser ASGNode) -> Object -> Parser ASGNode)
-> (Array -> Parser ASGNode) -> Object -> Parser ASGNode
forall a b. (a -> b) -> a -> b
$ \Array
fields -> do
        ValT AbstractTy
valT <- Int
-> (Value -> Parser (ValT AbstractTy))
-> Array
-> Parser (ValT AbstractTy)
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
0 Value -> Parser (ValT AbstractTy)
decodeValTAbstractTy Array
fields
        ValNodeInfo
valInfo <- Int -> (Value -> Parser ValNodeInfo) -> Array -> Parser ValNodeInfo
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
1 Value -> Parser ValNodeInfo
decodeValNodeInfo Array
fields
        ASGNode -> Parser ASGNode
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ASGNode -> Parser ASGNode) -> ASGNode -> Parser ASGNode
forall a b. (a -> b) -> a -> b
$ ValT AbstractTy -> ValNodeInfo -> ASGNode
AValNode ValT AbstractTy
valT ValNodeInfo
valInfo,
      Text
"AnError" Text
-> (Object -> Parser ASGNode)
-> Text :=> (Object -> Parser ASGNode)
forall a b. a -> b -> a :=> b
:=> ASGNode -> forall b. b -> Parser ASGNode
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM ASGNode
AnError
    ]

--
-- ValT, CompT & Friends/Components
--

{- DeBruijn

   Encodes directly as a number. E.g.

     @S Z@
   ->
     1

-}

-- | @since 1.3.0
encodeDeBruijn :: DeBruijn -> Encoding
encodeDeBruijn :: DeBruijn -> Encoding
encodeDeBruijn = Int -> Encoding
int (Int -> Encoding) -> (DeBruijn -> Int) -> DeBruijn -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Prism NoIx Int DeBruijn -> DeBruijn -> Int
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' A_Prism NoIx Int DeBruijn
asInt

-- | @since 1.3.0
decodeDeBruijn :: Value -> Parser DeBruijn
decodeDeBruijn :: Value -> Parser DeBruijn
decodeDeBruijn Value
v = do
  Int
vRaw <- forall a. FromJSON a => Value -> Parser a
parseJSON @Int Value
v
  if Int
vRaw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
    then String -> Parser DeBruijn
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"Negative DeBruijn"
    else DeBruijn -> Parser DeBruijn
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (DeBruijn -> Parser DeBruijn)
-> (Int -> DeBruijn) -> Int -> Parser DeBruijn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe DeBruijn -> DeBruijn
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe DeBruijn -> DeBruijn)
-> (Int -> Maybe DeBruijn) -> Int -> DeBruijn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Prism NoIx Int DeBruijn -> Int -> Maybe DeBruijn
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic' A_Prism NoIx Int DeBruijn
asInt (Int -> Parser DeBruijn) -> Int -> Parser DeBruijn
forall a b. (a -> b) -> a -> b
$ Int
vRaw

{- AbstractTy

   Standard product serialization as array:

     @BoundAt (S Z) ix0@
   ->
     [1,0]
-}

-- | @since 1.3.0
encodeAbstractTy :: AbstractTy -> Encoding
encodeAbstractTy :: AbstractTy -> Encoding
encodeAbstractTy (BoundAt DeBruijn
db Index "tyvar"
i) = (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Encoding -> Encoding
forall a. a -> a
id [DeBruijn -> Encoding
encodeDeBruijn DeBruijn
db, Index "tyvar" -> Encoding
forall (s :: Symbol). Index s -> Encoding
encodeIndex Index "tyvar"
i]

-- | @since 1.3.0
decodeAbstractTy :: Value -> Parser AbstractTy
decodeAbstractTy :: Value -> Parser AbstractTy
decodeAbstractTy = String
-> (Array -> Parser AbstractTy) -> Value -> Parser AbstractTy
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"AbstractTy" ((Array -> Parser AbstractTy) -> Value -> Parser AbstractTy)
-> (Array -> Parser AbstractTy) -> Value -> Parser AbstractTy
forall a b. (a -> b) -> a -> b
$ \Array
arr -> do
  Int -> Array -> Parser ()
guardArrLen Int
2 Array
arr
  DeBruijn
db <- Int -> (Value -> Parser DeBruijn) -> Array -> Parser DeBruijn
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
0 Value -> Parser DeBruijn
decodeDeBruijn Array
arr
  Index "tyvar"
i <- Int
-> (Value -> Parser (Index "tyvar"))
-> Array
-> Parser (Index "tyvar")
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
1 Value -> Parser (Index "tyvar")
forall (s :: Symbol). KnownSymbol s => Value -> Parser (Index s)
decodeIndex Array
arr
  AbstractTy -> Parser AbstractTy
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (AbstractTy -> Parser AbstractTy)
-> AbstractTy -> Parser AbstractTy
forall a b. (a -> b) -> a -> b
$ DeBruijn -> Index "tyvar" -> AbstractTy
BoundAt DeBruijn
db Index "tyvar"
i

{- Count

   Serializes as a Number.

    @count0@
   ->
    0

    count1
   ->
    1
-}

-- | @since 1.3.0
encodeCount :: forall (s :: Symbol). Count s -> Encoding
encodeCount :: forall (s :: Symbol). Count s -> Encoding
encodeCount = Int -> Encoding
int (Int -> Encoding) -> (Count s -> Int) -> Count s -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Prism NoIx Int (Count s) -> Count s -> Int
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' A_Prism NoIx Int (Count s)
forall (ofWhat :: Symbol). Prism' Int (Count ofWhat)
intCount

-- | @since 1.3.0
decodeCount :: forall (s :: Symbol). (KnownSymbol s) => Value -> Parser (Count s)
decodeCount :: forall (s :: Symbol). KnownSymbol s => Value -> Parser (Count s)
decodeCount Value
v = do
  Int
vRaw <- forall a. FromJSON a => Value -> Parser a
parseJSON @Int Value
v
  if Int
vRaw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
    then String -> Parser (Count s)
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"Negative Count"
    else Count s -> Parser (Count s)
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Count s -> Parser (Count s))
-> (Int -> Count s) -> Int -> Parser (Count s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Count s) -> Count s
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Count s) -> Count s)
-> (Int -> Maybe (Count s)) -> Int -> Count s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Prism NoIx Int (Count s) -> Int -> Maybe (Count s)
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic' A_Prism NoIx Int (Count s)
forall (ofWhat :: Symbol). Prism' Int (Count ofWhat)
intCount (Int -> Parser (Count s)) -> Int -> Parser (Count s)
forall a b. (a -> b) -> a -> b
$ Int
vRaw

{- Index

   Serializes as a number. NOTE: Will require a type application for the decoder.

     ix0
   ->
     0

     ix1
   ->
     1
-}

-- | @since 1.3.0
encodeIndex :: forall (s :: Symbol). Index s -> Encoding
encodeIndex :: forall (s :: Symbol). Index s -> Encoding
encodeIndex = Int -> Encoding
int (Int -> Encoding) -> (Index s -> Int) -> Index s -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Prism NoIx Int (Index s) -> Index s -> Int
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' A_Prism NoIx Int (Index s)
forall (ofWhat :: Symbol). Prism' Int (Index ofWhat)
intIndex

-- | @since 1.3.0
decodeIndex :: forall (s :: Symbol). (KnownSymbol s) => Value -> Parser (Index s)
decodeIndex :: forall (s :: Symbol). KnownSymbol s => Value -> Parser (Index s)
decodeIndex Value
v = do
  Int
vRaw <- forall a. FromJSON a => Value -> Parser a
parseJSON @Int Value
v
  if Int
vRaw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
    then String -> Parser (Index s)
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"Negative Index"
    else Index s -> Parser (Index s)
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Index s -> Parser (Index s))
-> (Int -> Index s) -> Int -> Parser (Index s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Index s) -> Index s
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Index s) -> Index s)
-> (Int -> Maybe (Index s)) -> Int -> Index s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Prism NoIx Int (Index s) -> Int -> Maybe (Index s)
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic' A_Prism NoIx Int (Index s)
forall (ofWhat :: Symbol). Prism' Int (Index ofWhat)
intIndex (Int -> Parser (Index s)) -> Int -> Parser (Index s)
forall a b. (a -> b) -> a -> b
$ Int
vRaw

{- CompT AbstractTy

   Standard serialization as an array:

     @CompT count0 ...body...@
    ->
     [0,...encodedBody...]

-}

-- | @since 1.3.0
encodeCompT :: forall (a :: Type). (a -> Encoding) -> CompT a -> Encoding
encodeCompT :: forall a. (a -> Encoding) -> CompT a -> Encoding
encodeCompT a -> Encoding
fa (CompT Count "tyvar"
cnt CompTBody a
body) = (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Encoding -> Encoding
forall a. a -> a
id [Count "tyvar" -> Encoding
forall (s :: Symbol). Count s -> Encoding
encodeCount Count "tyvar"
cnt, (a -> Encoding) -> CompTBody a -> Encoding
forall a. (a -> Encoding) -> CompTBody a -> Encoding
encodeCompTBody a -> Encoding
fa CompTBody a
body]

-- | @since 1.3.0
decodeCompT :: forall (a :: Type). (Value -> Parser a) -> Value -> Parser (CompT a)
decodeCompT :: forall a. (Value -> Parser a) -> Value -> Parser (CompT a)
decodeCompT Value -> Parser a
fa = String -> (Array -> Parser (CompT a)) -> Value -> Parser (CompT a)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"CompT" ((Array -> Parser (CompT a)) -> Value -> Parser (CompT a))
-> (Array -> Parser (CompT a)) -> Value -> Parser (CompT a)
forall a b. (a -> b) -> a -> b
$ \Array
arr -> do
  Int -> Array -> Parser ()
guardArrLen Int
2 Array
arr
  Count "tyvar"
cnt <- Int
-> (Value -> Parser (Count "tyvar"))
-> Array
-> Parser (Count "tyvar")
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
0 Value -> Parser (Count "tyvar")
forall (s :: Symbol). KnownSymbol s => Value -> Parser (Count s)
decodeCount Array
arr
  CompTBody a
body <- Int
-> (Value -> Parser (CompTBody a)) -> Array -> Parser (CompTBody a)
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
1 ((Value -> Parser a) -> Value -> Parser (CompTBody a)
forall a. (Value -> Parser a) -> Value -> Parser (CompTBody a)
decodeCompTBody Value -> Parser a
fa) Array
arr
  CompT a -> Parser (CompT a)
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (CompT a -> Parser (CompT a)) -> CompT a -> Parser (CompT a)
forall a b. (a -> b) -> a -> b
$ Count "tyvar" -> CompTBody a -> CompT a
forall a. Count "tyvar" -> CompTBody a -> CompT a
CompT Count "tyvar"
cnt CompTBody a
body

{- CompTBodyAbstractTy

   This is a newtype over a NonEmptyVector and so encodes directly as an array.

     @CompTBody [t1,t2,t3]@
   ->
     [encodedT1,encodedT2,encodedT3]

-}

-- | @since 1.3.0
encodeCompTBody :: forall (a :: Type). (a -> Encoding) -> CompTBody a -> Encoding
encodeCompTBody :: forall a. (a -> Encoding) -> CompTBody a -> Encoding
encodeCompTBody a -> Encoding
fa (CompTBody NonEmptyVector (ValT a)
tys) = (ValT a -> Encoding) -> [ValT a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list ((a -> Encoding) -> ValT a -> Encoding
forall a. (a -> Encoding) -> ValT a -> Encoding
encodeValT a -> Encoding
fa) ([ValT a] -> Encoding)
-> (NonEmptyVector (ValT a) -> [ValT a])
-> NonEmptyVector (ValT a)
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector (ValT a) -> [ValT a]
forall a. NonEmptyVector a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (NonEmptyVector (ValT a) -> Encoding)
-> NonEmptyVector (ValT a) -> Encoding
forall a b. (a -> b) -> a -> b
$ NonEmptyVector (ValT a)
tys

-- | @since 1.3.0
decodeCompTBody :: forall (a :: Type). (Value -> Parser a) -> Value -> Parser (CompTBody a)
decodeCompTBody :: forall a. (Value -> Parser a) -> Value -> Parser (CompTBody a)
decodeCompTBody Value -> Parser a
fa = String
-> (Array -> Parser (CompTBody a)) -> Value -> Parser (CompTBody a)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"CompTBody" ((Array -> Parser (CompTBody a)) -> Value -> Parser (CompTBody a))
-> (Array -> Parser (CompTBody a)) -> Value -> Parser (CompTBody a)
forall a b. (a -> b) -> a -> b
$ \Array
arr -> do
  Maybe (NonEmptyVector (ValT a))
decodedBody <- Vector (ValT a) -> Maybe (NonEmptyVector (ValT a))
forall a. Vector a -> Maybe (NonEmptyVector a)
NEV.fromVector (Vector (ValT a) -> Maybe (NonEmptyVector (ValT a)))
-> Parser (Vector (ValT a))
-> Parser (Maybe (NonEmptyVector (ValT a)))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser (ValT a)) -> Array -> Parser (Vector (ValT a))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse ((Value -> Parser a) -> Value -> Parser (ValT a)
forall a. (Value -> Parser a) -> Value -> Parser (ValT a)
decodeValT Value -> Parser a
fa) Array
arr
  case Maybe (NonEmptyVector (ValT a))
decodedBody of
    Maybe (NonEmptyVector (ValT a))
Nothing -> String -> Parser (CompTBody a)
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"Empty vector of types in a CompTBody"
    Just NonEmptyVector (ValT a)
res -> CompTBody a -> Parser (CompTBody a)
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (CompTBody a -> Parser (CompTBody a))
-> (NonEmptyVector (ValT a) -> CompTBody a)
-> NonEmptyVector (ValT a)
-> Parser (CompTBody a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector (ValT a) -> CompTBody a
forall a. NonEmptyVector (ValT a) -> CompTBody a
CompTBody (NonEmptyVector (ValT a) -> Parser (CompTBody a))
-> NonEmptyVector (ValT a) -> Parser (CompTBody a)
forall a b. (a -> b) -> a -> b
$ NonEmptyVector (ValT a)
res

{- BuiltinFlatT

   Encodes as an enumeration (i.e. tag-only sum)

   {tag: "UnitT"}
   | {tag: "BoolT"}
   | {tag: "IntegerT"}
   | {tag: "StringT"}
   | {tag: "ByteStringT"}
   | {tag: "BLS12_381_G1_ElementT"}
   | {tag: "BLS12_381_G2_ElementT"}
   | {tag: "BLS12_381_MlResultT"}

-}

-- | @since 1.3.0
encodeBuiltinFlatT :: BuiltinFlatT -> Encoding
encodeBuiltinFlatT :: BuiltinFlatT -> Encoding
encodeBuiltinFlatT = BuiltinFlatT -> Encoding
forall a. Show a => a -> Encoding
encodeEnum

-- | @since 1.3.0
decodeBuiltinFlatT :: Value -> Parser BuiltinFlatT
decodeBuiltinFlatT :: Value -> Parser BuiltinFlatT
decodeBuiltinFlatT =
  [Text :=> (Object -> Parser BuiltinFlatT)]
-> Value -> Parser BuiltinFlatT
forall a. [Text :=> (Object -> Parser a)] -> Value -> Parser a
caseOnTag
    [ Text
"UnitT" Text
-> (Object -> Parser BuiltinFlatT)
-> Text :=> (Object -> Parser BuiltinFlatT)
forall a b. a -> b -> a :=> b
:=> BuiltinFlatT -> forall b. b -> Parser BuiltinFlatT
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM BuiltinFlatT
UnitT,
      Text
"BoolT" Text
-> (Object -> Parser BuiltinFlatT)
-> Text :=> (Object -> Parser BuiltinFlatT)
forall a b. a -> b -> a :=> b
:=> BuiltinFlatT -> forall b. b -> Parser BuiltinFlatT
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM BuiltinFlatT
BoolT,
      Text
"IntegerT" Text
-> (Object -> Parser BuiltinFlatT)
-> Text :=> (Object -> Parser BuiltinFlatT)
forall a b. a -> b -> a :=> b
:=> BuiltinFlatT -> forall b. b -> Parser BuiltinFlatT
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM BuiltinFlatT
IntegerT,
      Text
"StringT" Text
-> (Object -> Parser BuiltinFlatT)
-> Text :=> (Object -> Parser BuiltinFlatT)
forall a b. a -> b -> a :=> b
:=> BuiltinFlatT -> forall b. b -> Parser BuiltinFlatT
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM BuiltinFlatT
StringT,
      Text
"ByteStringT" Text
-> (Object -> Parser BuiltinFlatT)
-> Text :=> (Object -> Parser BuiltinFlatT)
forall a b. a -> b -> a :=> b
:=> BuiltinFlatT -> forall b. b -> Parser BuiltinFlatT
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM BuiltinFlatT
ByteStringT,
      Text
"BLS12_381_G1_ElementT" Text
-> (Object -> Parser BuiltinFlatT)
-> Text :=> (Object -> Parser BuiltinFlatT)
forall a b. a -> b -> a :=> b
:=> BuiltinFlatT -> forall b. b -> Parser BuiltinFlatT
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM BuiltinFlatT
BLS12_381_G1_ElementT,
      Text
"BLS12_381_G2_ElementT" Text
-> (Object -> Parser BuiltinFlatT)
-> Text :=> (Object -> Parser BuiltinFlatT)
forall a b. a -> b -> a :=> b
:=> BuiltinFlatT -> forall b. b -> Parser BuiltinFlatT
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM BuiltinFlatT
BLS12_381_G2_ElementT,
      Text
"BLS12_381_MlResultT" Text
-> (Object -> Parser BuiltinFlatT)
-> Text :=> (Object -> Parser BuiltinFlatT)
forall a b. a -> b -> a :=> b
:=> BuiltinFlatT -> forall b. b -> Parser BuiltinFlatT
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM BuiltinFlatT
BLS12_381_MlResultT
    ]

{- OneArgFunc

   Encodes as an enumeration (i.e. tag-only sum).

   The name of the tag literally matches the name of the constructor. (Too many to list)
-}

-- | @since 1.3.0
encodeOneArgFunc :: OneArgFunc -> Encoding
encodeOneArgFunc :: OneArgFunc -> Encoding
encodeOneArgFunc = OneArgFunc -> Encoding
forall a. Show a => a -> Encoding
encodeEnum

-- | @since 1.3.0
decodeOneArgFunc :: Value -> Parser OneArgFunc
decodeOneArgFunc :: Value -> Parser OneArgFunc
decodeOneArgFunc =
  [Text :=> (Object -> Parser OneArgFunc)]
-> Value -> Parser OneArgFunc
forall a. [Text :=> (Object -> Parser a)] -> Value -> Parser a
caseOnTag
    [ Text
"LengthOfByteString" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
LengthOfByteString,
      Text
"Sha2_256" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
Sha2_256,
      Text
"Sha3_256" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
Sha3_256,
      Text
"Blake2b_256" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
Blake2b_256,
      Text
"EncodeUtf8" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
EncodeUtf8,
      Text
"DecodeUtf8" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
DecodeUtf8,
      Text
"FstPair" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
FstPair,
      Text
"SndPair" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
SndPair,
      Text
"HeadList" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
HeadList,
      Text
"TailList" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
TailList,
      Text
"NullList" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
NullList,
      Text
"MapData" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
MapData,
      Text
"ListData" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
ListData,
      Text
"IData" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
IData,
      Text
"BData" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
BData,
      Text
"UnConstrData" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
UnConstrData,
      Text
"UnMapData" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
UnMapData,
      Text
"UnListData" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
UnListData,
      Text
"UnIData" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
UnIData,
      Text
"UnBData" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
UnBData,
      Text
"SerialiseData" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
SerialiseData,
      Text
"BLS12_381_G1_neg" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
BLS12_381_G1_neg,
      Text
"BLS12_381_G1_compress" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
BLS12_381_G1_compress,
      Text
"BLS12_381_G1_uncompress" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
BLS12_381_G1_uncompress,
      Text
"BLS12_381_G2_neg" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
BLS12_381_G2_neg,
      Text
"BLS12_381_G2_compress" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
BLS12_381_G2_compress,
      Text
"BLS12_381_G2_uncompress" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
BLS12_381_G2_uncompress,
      Text
"Keccak_256" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
Keccak_256,
      Text
"Blake2b_224" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
Blake2b_224,
      Text
"ComplementByteString" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
ComplementByteString,
      Text
"CountSetBits" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
CountSetBits,
      Text
"FindFirstSetBit" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
FindFirstSetBit,
      Text
"Ripemd_160" Text
-> (Object -> Parser OneArgFunc)
-> Text :=> (Object -> Parser OneArgFunc)
forall a b. a -> b -> a :=> b
:=> OneArgFunc -> forall b. b -> Parser OneArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM OneArgFunc
Ripemd_160
    ]

{- TwoArgFunc

   Encodes as an enumeration (i.e. tag-only sum).

   The name of the tag literally matches the name of the constructor. (Too many to list)
-}

-- | @since 1.3.0
encodeTwoArgFunc :: TwoArgFunc -> Encoding
encodeTwoArgFunc :: TwoArgFunc -> Encoding
encodeTwoArgFunc = TwoArgFunc -> Encoding
forall a. Show a => a -> Encoding
encodeEnum

-- | @since 1.3.0
decodeTwoArgFunc :: Value -> Parser TwoArgFunc
decodeTwoArgFunc :: Value -> Parser TwoArgFunc
decodeTwoArgFunc =
  [Text :=> (Object -> Parser TwoArgFunc)]
-> Value -> Parser TwoArgFunc
forall a. [Text :=> (Object -> Parser a)] -> Value -> Parser a
caseOnTag
    [ Text
"AddInteger" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
AddInteger,
      Text
"SubtractInteger" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
SubtractInteger,
      Text
"MultiplyInteger" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
MultiplyInteger,
      Text
"DivideInteger" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
DivideInteger,
      Text
"QuotientInteger" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
QuotientInteger,
      Text
"RemainderInteger" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
RemainderInteger,
      Text
"ModInteger" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
ModInteger,
      Text
"EqualsInteger" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
EqualsInteger,
      Text
"LessThanInteger" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
LessThanInteger,
      Text
"LessThanEqualsInteger" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
LessThanEqualsInteger,
      Text
"AppendByteString" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
AppendByteString,
      Text
"ConsByteString" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
ConsByteString,
      Text
"IndexByteString" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
IndexByteString,
      Text
"EqualsByteString" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
EqualsByteString,
      Text
"LessThanByteString" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
LessThanByteString,
      Text
"LessThanEqualsByteString" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
LessThanEqualsByteString,
      Text
"AppendString" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
AppendString,
      Text
"EqualsString" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
EqualsString,
      Text
"ChooseUnit" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
ChooseUnit,
      Text
"Trace" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
Trace,
      Text
"MkCons" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
MkCons,
      Text
"ConstrData" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
ConstrData,
      Text
"EqualsData" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
EqualsData,
      Text
"MkPairData" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
MkPairData,
      Text
"BLS12_381_G1_add" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
BLS12_381_G1_add,
      Text
"BLS12_381_G1_scalarMul" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
BLS12_381_G1_scalarMul,
      Text
"BLS12_381_G1_equal" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
BLS12_381_G1_equal,
      Text
"BLS12_381_G1_hashToGroup" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
BLS12_381_G1_hashToGroup,
      Text
"BLS12_381_G2_add" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
BLS12_381_G2_add,
      Text
"BLS12_381_G2_scalarMul" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
BLS12_381_G2_scalarMul,
      Text
"BLS12_381_G2_equal" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
BLS12_381_G2_equal,
      Text
"BLS12_381_G2_hashToGroup" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
BLS12_381_G2_hashToGroup,
      Text
"BLS12_381_millerLoop" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
BLS12_381_millerLoop,
      Text
"BLS12_381_mulMlResult" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
BLS12_381_mulMlResult,
      Text
"BLS12_381_finalVerify" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
BLS12_381_finalVerify,
      Text
"ByteStringToInteger" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
ByteStringToInteger,
      Text
"ReadBit" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
ReadBit,
      Text
"ReplicateByte" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
ReplicateByte,
      Text
"ShiftByteString" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
ShiftByteString,
      Text
"RotateByteString" Text
-> (Object -> Parser TwoArgFunc)
-> Text :=> (Object -> Parser TwoArgFunc)
forall a b. a -> b -> a :=> b
:=> TwoArgFunc -> forall b. b -> Parser TwoArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM TwoArgFunc
RotateByteString
    ]

{- ThreeArgFunc

   Encodes as an enumeration (i.e. tag-only sum).

   The name of the tag literally matches the name of the constructor. (Too many to list)
-}

-- | @since 1.3.0
encodeThreeArgFunc :: ThreeArgFunc -> Encoding
encodeThreeArgFunc :: ThreeArgFunc -> Encoding
encodeThreeArgFunc = ThreeArgFunc -> Encoding
forall a. Show a => a -> Encoding
encodeEnum

-- | @since 1.3.0
decodeThreeArgFunc :: Value -> Parser ThreeArgFunc
decodeThreeArgFunc :: Value -> Parser ThreeArgFunc
decodeThreeArgFunc =
  [Text :=> (Object -> Parser ThreeArgFunc)]
-> Value -> Parser ThreeArgFunc
forall a. [Text :=> (Object -> Parser a)] -> Value -> Parser a
caseOnTag
    [ Text
"VerifyEd25519Signature" Text
-> (Object -> Parser ThreeArgFunc)
-> Text :=> (Object -> Parser ThreeArgFunc)
forall a b. a -> b -> a :=> b
:=> ThreeArgFunc -> forall b. b -> Parser ThreeArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM ThreeArgFunc
VerifyEd25519Signature,
      Text
"VerifyEcdsaSecp256k1Signature" Text
-> (Object -> Parser ThreeArgFunc)
-> Text :=> (Object -> Parser ThreeArgFunc)
forall a b. a -> b -> a :=> b
:=> ThreeArgFunc -> forall b. b -> Parser ThreeArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM ThreeArgFunc
VerifyEcdsaSecp256k1Signature,
      Text
"VerifySchnorrSecp256k1Signature" Text
-> (Object -> Parser ThreeArgFunc)
-> Text :=> (Object -> Parser ThreeArgFunc)
forall a b. a -> b -> a :=> b
:=> ThreeArgFunc -> forall b. b -> Parser ThreeArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM ThreeArgFunc
VerifySchnorrSecp256k1Signature,
      Text
"IfThenElse" Text
-> (Object -> Parser ThreeArgFunc)
-> Text :=> (Object -> Parser ThreeArgFunc)
forall a b. a -> b -> a :=> b
:=> ThreeArgFunc -> forall b. b -> Parser ThreeArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM ThreeArgFunc
IfThenElse,
      Text
"ChooseList" Text
-> (Object -> Parser ThreeArgFunc)
-> Text :=> (Object -> Parser ThreeArgFunc)
forall a b. a -> b -> a :=> b
:=> ThreeArgFunc -> forall b. b -> Parser ThreeArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM ThreeArgFunc
ChooseList,
      Text
"IntegerToByteString" Text
-> (Object -> Parser ThreeArgFunc)
-> Text :=> (Object -> Parser ThreeArgFunc)
forall a b. a -> b -> a :=> b
:=> ThreeArgFunc -> forall b. b -> Parser ThreeArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM ThreeArgFunc
IntegerToByteString,
      Text
"AndByteString" Text
-> (Object -> Parser ThreeArgFunc)
-> Text :=> (Object -> Parser ThreeArgFunc)
forall a b. a -> b -> a :=> b
:=> ThreeArgFunc -> forall b. b -> Parser ThreeArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM ThreeArgFunc
AndByteString,
      Text
"OrByteString" Text
-> (Object -> Parser ThreeArgFunc)
-> Text :=> (Object -> Parser ThreeArgFunc)
forall a b. a -> b -> a :=> b
:=> ThreeArgFunc -> forall b. b -> Parser ThreeArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM ThreeArgFunc
OrByteString,
      Text
"XorByteString" Text
-> (Object -> Parser ThreeArgFunc)
-> Text :=> (Object -> Parser ThreeArgFunc)
forall a b. a -> b -> a :=> b
:=> ThreeArgFunc -> forall b. b -> Parser ThreeArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM ThreeArgFunc
XorByteString,
      Text
"WriteBits" Text
-> (Object -> Parser ThreeArgFunc)
-> Text :=> (Object -> Parser ThreeArgFunc)
forall a b. a -> b -> a :=> b
:=> ThreeArgFunc -> forall b. b -> Parser ThreeArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM ThreeArgFunc
WriteBits,
      Text
"ExpModInteger" Text
-> (Object -> Parser ThreeArgFunc)
-> Text :=> (Object -> Parser ThreeArgFunc)
forall a b. a -> b -> a :=> b
:=> ThreeArgFunc -> forall b. b -> Parser ThreeArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM ThreeArgFunc
ExpModInteger
    ]

{- SixArgFunc

   Encodes as an enumeration (i.e. tag-only sum).

   The name of the tag literally matches the name of the constructor. (Too many to list)
-}

-- | @since 1.3.0
encodeSixArgFunc :: SixArgFunc -> Encoding
encodeSixArgFunc :: SixArgFunc -> Encoding
encodeSixArgFunc = SixArgFunc -> Encoding
forall a. Show a => a -> Encoding
encodeEnum

-- | @since 1.3.0
decodeSixArgFunc :: Value -> Parser SixArgFunc
decodeSixArgFunc :: Value -> Parser SixArgFunc
decodeSixArgFunc =
  [Text :=> (Object -> Parser SixArgFunc)]
-> Value -> Parser SixArgFunc
forall a. [Text :=> (Object -> Parser a)] -> Value -> Parser a
caseOnTag
    [ Text
"ChooseData" Text
-> (Object -> Parser SixArgFunc)
-> Text :=> (Object -> Parser SixArgFunc)
forall a b. a -> b -> a :=> b
:=> SixArgFunc -> forall b. b -> Parser SixArgFunc
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM SixArgFunc
ChooseData
    ]

{- ValT

   Encodes as a tagged sum without explicit field names:

   {tag: "Abstraction", fields: [...]}
   | {tag: "ThunkT", fields: [...]}
   | {tag: "BuiltinFlat", fields: : [...]}
   | {tag: "Datatype", fields: [...]}

-}

encodeValT :: forall (a :: Type). (a -> Encoding) -> ValT a -> Encoding
encodeValT :: forall a. (a -> Encoding) -> ValT a -> Encoding
encodeValT a -> Encoding
fa = \case
  Abstraction a
x -> Text -> [Encoding] -> Encoding
taggedFields Text
"Abstraction" [a -> Encoding
fa a
x]
  ThunkT CompT a
compT -> Text -> [Encoding] -> Encoding
taggedFields Text
"ThunkT" [(a -> Encoding) -> CompT a -> Encoding
forall a. (a -> Encoding) -> CompT a -> Encoding
encodeCompT a -> Encoding
fa CompT a
compT]
  BuiltinFlat BuiltinFlatT
biFlat -> Text -> [Encoding] -> Encoding
taggedFields Text
"BuiltinFlat" [BuiltinFlatT -> Encoding
encodeBuiltinFlatT BuiltinFlatT
biFlat]
  Datatype TyName
tn Vector (ValT a)
args -> Text -> [Encoding] -> Encoding
taggedFields Text
"Datatype" [TyName -> Encoding
encodeTyName TyName
tn, (ValT a -> Encoding) -> [ValT a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list ((a -> Encoding) -> ValT a -> Encoding
forall a. (a -> Encoding) -> ValT a -> Encoding
encodeValT a -> Encoding
fa) ([ValT a] -> Encoding)
-> (Vector (ValT a) -> [ValT a]) -> Vector (ValT a) -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (ValT a) -> [ValT a]
forall a. Vector a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (Vector (ValT a) -> Encoding) -> Vector (ValT a) -> Encoding
forall a b. (a -> b) -> a -> b
$ Vector (ValT a)
args]

decodeValT :: forall (a :: Type). (Value -> Parser a) -> Value -> Parser (ValT a)
decodeValT :: forall a. (Value -> Parser a) -> Value -> Parser (ValT a)
decodeValT Value -> Parser a
fa =
  [Text :=> (Object -> Parser (ValT a))] -> Value -> Parser (ValT a)
forall a. [Text :=> (Object -> Parser a)] -> Value -> Parser a
caseOnTag
    [ Text
"Abstraction" Text
-> (Object -> Parser (ValT a))
-> Text :=> (Object -> Parser (ValT a))
forall a b. a -> b -> a :=> b
:=> (Value -> Parser (ValT a)) -> Object -> Parser (ValT a)
forall a. (Value -> Parser a) -> Object -> Parser a
withField0 ((a -> ValT a) -> Parser a -> Parser (ValT a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ValT a
forall a. a -> ValT a
Abstraction (Parser a -> Parser (ValT a))
-> (Value -> Parser a) -> Value -> Parser (ValT a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser a
fa),
      Text
"ThunkT" Text
-> (Object -> Parser (ValT a))
-> Text :=> (Object -> Parser (ValT a))
forall a b. a -> b -> a :=> b
:=> (Value -> Parser (ValT a)) -> Object -> Parser (ValT a)
forall a. (Value -> Parser a) -> Object -> Parser a
withField0 ((CompT a -> ValT a) -> Parser (CompT a) -> Parser (ValT a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap CompT a -> ValT a
forall a. CompT a -> ValT a
ThunkT (Parser (CompT a) -> Parser (ValT a))
-> (Value -> Parser (CompT a)) -> Value -> Parser (ValT a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser a) -> Value -> Parser (CompT a)
forall a. (Value -> Parser a) -> Value -> Parser (CompT a)
decodeCompT Value -> Parser a
fa),
      Text
"BuiltinFlat" Text
-> (Object -> Parser (ValT a))
-> Text :=> (Object -> Parser (ValT a))
forall a b. a -> b -> a :=> b
:=> (Value -> Parser (ValT a)) -> Object -> Parser (ValT a)
forall a. (Value -> Parser a) -> Object -> Parser a
withField0 ((BuiltinFlatT -> ValT a) -> Parser BuiltinFlatT -> Parser (ValT a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap BuiltinFlatT -> ValT a
forall a. BuiltinFlatT -> ValT a
BuiltinFlat (Parser BuiltinFlatT -> Parser (ValT a))
-> (Value -> Parser BuiltinFlatT) -> Value -> Parser (ValT a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser BuiltinFlatT
decodeBuiltinFlatT),
      Text
"Datatype" Text
-> (Object -> Parser (ValT a))
-> Text :=> (Object -> Parser (ValT a))
forall a b. a -> b -> a :=> b
:=> (Array -> Parser (ValT a)) -> Object -> Parser (ValT a)
forall a. (Array -> Parser a) -> Object -> Parser a
withFields ((Array -> Parser (ValT a)) -> Object -> Parser (ValT a))
-> (Array -> Parser (ValT a)) -> Object -> Parser (ValT a)
forall a b. (a -> b) -> a -> b
$ \Array
arr -> do
        TyName
tn <- Int -> (Value -> Parser TyName) -> Array -> Parser TyName
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
0 Value -> Parser TyName
decodeTyName Array
arr
        Vector (ValT a)
ctors <- Int
-> (Value -> Parser (Vector (ValT a)))
-> Array
-> Parser (Vector (ValT a))
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
1 (String
-> (Array -> Parser (Vector (ValT a)))
-> Value
-> Parser (Vector (ValT a))
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"datatype args" ((Value -> Parser (ValT a)) -> Array -> Parser (Vector (ValT a))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse ((Value -> Parser a) -> Value -> Parser (ValT a)
forall a. (Value -> Parser a) -> Value -> Parser (ValT a)
decodeValT Value -> Parser a
fa))) Array
arr
        ValT a -> Parser (ValT a)
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ValT a -> Parser (ValT a)) -> ValT a -> Parser (ValT a)
forall a b. (a -> b) -> a -> b
$ TyName -> Vector (ValT a) -> ValT a
forall a. TyName -> Vector (ValT a) -> ValT a
Datatype TyName
tn Vector (ValT a)
ctors
    ]

{- Encodes as an array [DeBruijn, Index "tyvar"]
-}
encodeBoundTyVar :: BoundTyVar -> Encoding
encodeBoundTyVar :: BoundTyVar -> Encoding
encodeBoundTyVar (BoundTyVar DeBruijn
db Index "tyvar"
ix) = (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Encoding -> Encoding
forall a. a -> a
id [DeBruijn -> Encoding
encodeDeBruijn DeBruijn
db, Index "tyvar" -> Encoding
forall (s :: Symbol). Index s -> Encoding
encodeIndex Index "tyvar"
ix]

decodeBoundTyVar :: Value -> Parser BoundTyVar
decodeBoundTyVar :: Value -> Parser BoundTyVar
decodeBoundTyVar = String
-> (Array -> Parser BoundTyVar) -> Value -> Parser BoundTyVar
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"BoundTyVar" ((Array -> Parser BoundTyVar) -> Value -> Parser BoundTyVar)
-> (Array -> Parser BoundTyVar) -> Value -> Parser BoundTyVar
forall a b. (a -> b) -> a -> b
$ \Array
arr -> do
  DeBruijn
db <- Int -> (Value -> Parser DeBruijn) -> Array -> Parser DeBruijn
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
0 Value -> Parser DeBruijn
decodeDeBruijn Array
arr
  Index "tyvar"
ix <- Int
-> (Value -> Parser (Index "tyvar"))
-> Array
-> Parser (Index "tyvar")
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
1 Value -> Parser (Index "tyvar")
forall (s :: Symbol). KnownSymbol s => Value -> Parser (Index s)
decodeIndex Array
arr
  BoundTyVar -> Parser BoundTyVar
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (BoundTyVar -> Parser BoundTyVar)
-> BoundTyVar -> Parser BoundTyVar
forall a b. (a -> b) -> a -> b
$ DeBruijn -> Index "tyvar" -> BoundTyVar
BoundTyVar DeBruijn
db Index "tyvar"
ix

{- Encoding is fully determined by other functions
-}
encodeInstTy :: Wedge BoundTyVar (ValT Void) -> Encoding
encodeInstTy :: Wedge BoundTyVar (ValT Void) -> Encoding
encodeInstTy = (BoundTyVar -> Encoding)
-> (ValT Void -> Encoding)
-> Wedge BoundTyVar (ValT Void)
-> Encoding
forall a b.
(a -> Encoding) -> (b -> Encoding) -> Wedge a b -> Encoding
encodeWedge BoundTyVar -> Encoding
encodeBoundTyVar ((Void -> Encoding) -> ValT Void -> Encoding
forall a. (a -> Encoding) -> ValT a -> Encoding
encodeValT Void -> Encoding
encodeVoid)

decodeInstTy :: Value -> Parser (Wedge BoundTyVar (ValT Void))
decodeInstTy :: Value -> Parser (Wedge BoundTyVar (ValT Void))
decodeInstTy = (Value -> Parser BoundTyVar)
-> (Value -> Parser (ValT Void))
-> Value
-> Parser (Wedge BoundTyVar (ValT Void))
forall a b.
(Value -> Parser a)
-> (Value -> Parser b) -> Value -> Parser (Wedge a b)
decodeWedge Value -> Parser BoundTyVar
decodeBoundTyVar ((Value -> Parser Void) -> Value -> Parser (ValT Void)
forall a. (Value -> Parser a) -> Value -> Parser (ValT a)
decodeValT Value -> Parser Void
decodeVoid)

-- | @since 1.3.0
encodeValTAbstractTy :: ValT AbstractTy -> Encoding
encodeValTAbstractTy :: ValT AbstractTy -> Encoding
encodeValTAbstractTy = (AbstractTy -> Encoding) -> ValT AbstractTy -> Encoding
forall a. (a -> Encoding) -> ValT a -> Encoding
encodeValT AbstractTy -> Encoding
encodeAbstractTy

-- | @since 1.3.0
decodeValTAbstractTy :: Value -> Parser (ValT AbstractTy)
decodeValTAbstractTy :: Value -> Parser (ValT AbstractTy)
decodeValTAbstractTy = (Value -> Parser AbstractTy) -> Value -> Parser (ValT AbstractTy)
forall a. (Value -> Parser a) -> Value -> Parser (ValT a)
decodeValT Value -> Parser AbstractTy
decodeAbstractTy

-- Helpers

encodeVoid :: Void -> Encoding
encodeVoid :: Void -> Encoding
encodeVoid = Void -> Encoding
forall a. Void -> a
absurd

decodeVoid :: Value -> Parser Void
decodeVoid :: Value -> Parser Void
decodeVoid Value
_ = String -> Parser Void
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"Void isn't inhabited, you can't decode a value to it"

{- We encode maps as arrays of {key: k, value: v} pairs
-}
encodeMap :: forall k v. (k -> Encoding) -> (v -> Encoding) -> Map k v -> Encoding
encodeMap :: forall k v.
(k -> Encoding) -> (v -> Encoding) -> Map k v -> Encoding
encodeMap k -> Encoding
fk v -> Encoding
fv Map k v
m =
  (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Encoding -> Encoding
forall a. a -> a
id ([Encoding] -> Encoding) -> [Encoding] -> Encoding
forall a b. (a -> b) -> a -> b
$
    ([Encoding] -> k -> v -> [Encoding])
-> [Encoding] -> Map k v -> [Encoding]
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey'
      ( \[Encoding]
acc k
k v
v ->
          let entry :: Encoding
entry = Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
pair Key
"key" (k -> Encoding
fk k
k) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key -> Encoding -> Series
pair Key
"value" (v -> Encoding
fv v
v)
           in Encoding
entry Encoding -> [Encoding] -> [Encoding]
forall a. a -> [a] -> [a]
: [Encoding]
acc
      )
      []
      Map k v
m

decodeMap ::
  forall k v.
  (Ord k) =>
  (Value -> Parser k) ->
  (Value -> Parser v) ->
  Value ->
  Parser (Map k v)
decodeMap :: forall k v.
Ord k =>
(Value -> Parser k)
-> (Value -> Parser v) -> Value -> Parser (Map k v)
decodeMap Value -> Parser k
fk Value -> Parser v
fv = String -> (Array -> Parser (Map k v)) -> Value -> Parser (Map k v)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"Map" ((Array -> Parser (Map k v)) -> Value -> Parser (Map k v))
-> (Array -> Parser (Map k v)) -> Value -> Parser (Map k v)
forall a b. (a -> b) -> a -> b
$ \Array
arr ->
  (Map k v -> Value -> Parser (Map k v))
-> Map k v -> Array -> Parser (Map k v)
forall (t :: Type -> Type) (m :: Type -> Type) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
    ( \Map k v
acc Value
x -> ((Object -> Parser (Map k v)) -> Value -> Parser (Map k v))
-> Value -> (Object -> Parser (Map k v)) -> Parser (Map k v)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> (Object -> Parser (Map k v)) -> Value -> Parser (Map k v)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"kvPair") Value
x ((Object -> Parser (Map k v)) -> Parser (Map k v))
-> (Object -> Parser (Map k v)) -> Parser (Map k v)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
        k
kfield <- Object -> Key -> (Value -> Parser k) -> Parser k
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
obj Key
"key" Value -> Parser k
fk
        v
vfield <- Object -> Key -> (Value -> Parser v) -> Parser v
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
obj Key
"value" Value -> Parser v
fv
        Map k v -> Parser (Map k v)
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Map k v -> Parser (Map k v)) -> Map k v -> Parser (Map k v)
forall a b. (a -> b) -> a -> b
$ k -> v -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
kfield v
vfield Map k v
acc
    )
    Map k v
forall k a. Map k a
M.empty
    Array
arr

{- We encode wedges as a normal sum type, a la:

    {tag: "Nowhere"}
    | {tag: "Here", fields: [a]}
    | {tag: "There", fields: [b]}
-}
encodeWedge ::
  forall (a :: Type) (b :: Type).
  (a -> Encoding) ->
  (b -> Encoding) ->
  Wedge a b ->
  Encoding
encodeWedge :: forall a b.
(a -> Encoding) -> (b -> Encoding) -> Wedge a b -> Encoding
encodeWedge a -> Encoding
fa b -> Encoding
fb = \case
  Wedge a b
Nowhere -> Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
pair Key
"tag" Encoding
"Nowhere"
  Here a
a -> Text -> [Encoding] -> Encoding
taggedFields Text
"Here" [a -> Encoding
fa a
a]
  There b
b -> Text -> [Encoding] -> Encoding
taggedFields Text
"There" [b -> Encoding
fb b
b]

decodeWedge ::
  forall (a :: Type) (b :: Type).
  (Value -> Parser a) ->
  (Value -> Parser b) ->
  Value ->
  Parser (Wedge a b)
decodeWedge :: forall a b.
(Value -> Parser a)
-> (Value -> Parser b) -> Value -> Parser (Wedge a b)
decodeWedge Value -> Parser a
fa Value -> Parser b
fb =
  [Text :=> (Object -> Parser (Wedge a b))]
-> Value -> Parser (Wedge a b)
forall a. [Text :=> (Object -> Parser a)] -> Value -> Parser a
caseOnTag
    [ Text
"Nowhere" Text
-> (Object -> Parser (Wedge a b))
-> Text :=> (Object -> Parser (Wedge a b))
forall a b. a -> b -> a :=> b
:=> Wedge a b -> forall b. b -> Parser (Wedge a b)
forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM Wedge a b
forall a b. Wedge a b
Nowhere,
      Text
"Here" Text
-> (Object -> Parser (Wedge a b))
-> Text :=> (Object -> Parser (Wedge a b))
forall a b. a -> b -> a :=> b
:=> (a -> Wedge a b) -> Parser a -> Parser (Wedge a b)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Wedge a b
forall a b. a -> Wedge a b
Here (Parser a -> Parser (Wedge a b))
-> (Object -> Parser a) -> Object -> Parser (Wedge a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser a) -> Object -> Parser a
forall a. (Value -> Parser a) -> Object -> Parser a
withField0 Value -> Parser a
fa,
      Text
"There" Text
-> (Object -> Parser (Wedge a b))
-> Text :=> (Object -> Parser (Wedge a b))
forall a b. a -> b -> a :=> b
:=> (b -> Wedge a b) -> Parser b -> Parser (Wedge a b)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Wedge a b
forall a b. b -> Wedge a b
There (Parser b -> Parser (Wedge a b))
-> (Object -> Parser b) -> Object -> Parser (Wedge a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser b) -> Object -> Parser b
forall a. (Value -> Parser a) -> Object -> Parser a
withField0 Value -> Parser b
fb
    ]

-- Mainly for readability/custom fixity, effectively (,)
data (:=>) a b = a :=> b

infixr 0 :=>

-- Simulated pattern matching on the `tag` field of an object. Will throw an error if the
-- value is not an object. This is a convenience function, and it is *very* convenient.
caseOnTag :: forall (a :: Type). [Text :=> (Object -> Parser a)] -> Value -> Parser a
caseOnTag :: forall a. [Text :=> (Object -> Parser a)] -> Value -> Parser a
caseOnTag [Text :=> (Object -> Parser a)]
xs = String -> (Object -> Parser a) -> Value -> Parser a
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CaseOnTag" Object -> Parser a
go
  where
    go :: Object -> Parser a
    go :: Object -> Parser a
go Object
obj = do
      let caseDict :: Map Text (Object -> Parser a)
caseDict = (Map Text (Object -> Parser a)
 -> (Text :=> (Object -> Parser a))
 -> Map Text (Object -> Parser a))
-> Map Text (Object -> Parser a)
-> [Text :=> (Object -> Parser a)]
-> Map Text (Object -> Parser a)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map Text (Object -> Parser a)
acc (Text
t :=> Object -> Parser a
fn) -> Text
-> (Object -> Parser a)
-> Map Text (Object -> Parser a)
-> Map Text (Object -> Parser a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
t Object -> Parser a
fn Map Text (Object -> Parser a)
acc) Map Text (Object -> Parser a)
forall k a. Map k a
M.empty [Text :=> (Object -> Parser a)]
xs
      Text
tagVal <- Object -> Key -> (Value -> Parser Text) -> Parser Text
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
obj Key
"tag" (forall a. FromJSON a => Value -> Parser a
parseJSON @Text)
      case Text -> Map Text (Object -> Parser a) -> Maybe (Object -> Parser a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
tagVal Map Text (Object -> Parser a)
caseDict of
        Just Object -> Parser a
f -> Object -> Parser a
f Object
obj
        Maybe (Object -> Parser a)
Nothing -> String -> Parser a
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"Expected a tagged object with one of the tags: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Text] -> String
forall a. Show a => a -> String
show (Map Text (Object -> Parser a) -> [Text]
forall k a. Map k a -> [k]
M.keys Map Text (Object -> Parser a)
caseDict) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" but got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Object -> String
forall a. Show a => a -> String
show Object
obj

-- Stupid helper to avoid have to type `\_ -> pure x` a million times in `caseOnTag` matches
constM :: forall (f :: Type -> Type) (a :: Type). (Applicative f) => a -> (forall (b :: Type). b -> f a)
constM :: forall (f :: Type -> Type) a.
Applicative f =>
a -> forall b. b -> f a
constM a
x b
_ = a -> f a
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
x

guardArrLen :: Int -> Array -> Parser ()
guardArrLen :: Int -> Array -> Parser ()
guardArrLen Int
expectedLen Array
arr
  | Array -> Int
forall a. Vector a -> Int
Vector.length Array
arr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
expectedLen = () -> Parser ()
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
  | Bool
otherwise =
      String -> Parser ()
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$
        String
"Expected an array with "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
expectedLen
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" elements, but got one with "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Array -> Int
forall a. Vector a -> Int
Vector.length Array
arr)
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" elements"

-- Do something with the array at the tag "fields" in an object. Convenience helper.
withFields :: forall (a :: Type). (Array -> Parser a) -> Object -> Parser a
withFields :: forall a. (Array -> Parser a) -> Object -> Parser a
withFields Array -> Parser a
f Object
obj = Object -> Key -> (Value -> Parser a) -> Parser a
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
obj Key
"fields" ((Value -> Parser a) -> Parser a)
-> (Value -> Parser a) -> Parser a
forall a b. (a -> b) -> a -> b
$ \Value
arrVal -> String -> (Array -> Parser a) -> Value -> Parser a
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"field array" Array -> Parser a
f Value
arrVal

-- Do something with the element at a given index in a JSON array.
withIndex :: forall (a :: Type). Int -> (Value -> Parser a) -> Array -> Parser a
withIndex :: forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
i Value -> Parser a
f Array
arr = case Array
arr Array -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
Vector.!? Int
i of
  Maybe Value
Nothing -> String -> Parser a
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"No element at index " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found in array " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Array -> String
forall a. Show a => a -> String
show Array
arr
  Just Value
elemAtIx -> Value -> Parser a
f Value
elemAtIx

-- flipped variant of lookupAndParse', for point free functions
withField :: forall (a :: Type). Key -> (Value -> Parser a) -> Object -> Parser a
withField :: forall a. Key -> (Value -> Parser a) -> Object -> Parser a
withField Key
k Value -> Parser a
f Object
obj = Object -> Key -> (Value -> Parser a) -> Parser a
forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
obj Key
k Value -> Parser a
f

-- A lot of our sums have a "fields" object with only one element, this saves us a bit of repetition for that common case.
-- Because this is intended to be used with either `withObject` or `caseOnTag`, it takes an Object which is expected to have a
-- "fields" fieldName with an array
withField0 :: forall (a :: Type). (Value -> Parser a) -> Object -> Parser a
withField0 :: forall a. (Value -> Parser a) -> Object -> Parser a
withField0 Value -> Parser a
f = (Array -> Parser a) -> Object -> Parser a
forall a. (Array -> Parser a) -> Object -> Parser a
withFields (\Array
arr -> Int -> Array -> Parser ()
guardArrLen Int
1 Array
arr Parser () -> Parser a -> Parser a
forall a b. Parser a -> Parser b -> Parser b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Int -> (Value -> Parser a) -> Array -> Parser a
forall a. Int -> (Value -> Parser a) -> Array -> Parser a
withIndex Int
0 Value -> Parser a
f Array
arr)

-- Lookup the key in an object and apply the given monadic function to the value you get.
lookupAndParse' :: forall (a :: Type). Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' :: forall a. Object -> Key -> (Value -> Parser a) -> Parser a
lookupAndParse' Object
obj Key
k Value -> Parser a
f = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
k Object
obj of
  Maybe Value
Nothing -> String -> Parser a
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"No key '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Key -> String
forall a. Show a => a -> String
show Key
k String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"' found in object"
  Just Value
v -> Value -> Parser a
f Value
v

-- NOTE: Must *ONLY* be used on *true* Enums, i.e. sum types with only 0-argument constructors
encodeEnum :: forall (a :: Type). (Show a) => a -> Encoding
encodeEnum :: forall a. Show a => a -> Encoding
encodeEnum = Series -> Encoding
pairs (Series -> Encoding) -> (a -> Series) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"tag" Key -> String -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (String -> Series) -> (a -> String) -> a -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- Helper for constructing sum type Encodings.
-- 'taggedFields "name" [f1,f2,f3]' generates '{tag: "name", fields: [f1,f2,f3]}
taggedFields :: Text -> [Encoding] -> Encoding
taggedFields :: Text -> [Encoding] -> Encoding
taggedFields Text
tg [Encoding]
fieldArgs = Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key
"tag" Key -> Text -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
tg Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key -> Encoding -> Series
pair Key
"fields" ((Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Encoding -> Encoding
forall a. a -> a
id [Encoding]
fieldArgs)

-- Decodes a hex encoded bytestring
decodeByteStringHex :: Value -> Parser ByteString
decodeByteStringHex :: Value -> Parser ByteString
decodeByteStringHex = String -> (Text -> Parser ByteString) -> Value -> Parser ByteString
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ByteString (Hex Encoded)" ((Text -> Parser ByteString) -> Value -> Parser ByteString)
-> (Text -> Parser ByteString) -> Value -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ \Text
txt -> case Text -> Maybe ByteString
Hex.decodeHex Text
txt of
  Maybe ByteString
Nothing -> String -> Parser ByteString
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Parser ByteString) -> String -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ String
"Failed to decode hex bytestring: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
txt
  Just ByteString
bs -> ByteString -> Parser ByteString
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ByteString
bs

-- | Given a collection of datatype declarations, convert them to
-- 'DatatypeInfo's by generating their base functor and Boehm-Berrarducci
-- encodings. Then add to these all the base functors for the built-in types.
--
-- @since 1.3.0
mkDatatypeInfos ::
  [DataDeclaration AbstractTy] ->
  Either String (Map TyName (DatatypeInfo AbstractTy))
mkDatatypeInfos :: [DataDeclaration AbstractTy]
-> Either String (Map TyName (DatatypeInfo AbstractTy))
mkDatatypeInfos [DataDeclaration AbstractTy]
decls = do
  let tyDict :: Map TyName (DataDeclaration AbstractTy)
tyDict = (Map TyName (DataDeclaration AbstractTy)
 -> DataDeclaration AbstractTy
 -> Map TyName (DataDeclaration AbstractTy))
-> Map TyName (DataDeclaration AbstractTy)
-> [DataDeclaration AbstractTy]
-> Map TyName (DataDeclaration AbstractTy)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map TyName (DataDeclaration AbstractTy)
acc DataDeclaration AbstractTy
x -> TyName
-> DataDeclaration AbstractTy
-> Map TyName (DataDeclaration AbstractTy)
-> Map TyName (DataDeclaration AbstractTy)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Optic' A_Lens NoIx (DataDeclaration AbstractTy) TyName
-> DataDeclaration AbstractTy -> TyName
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx (DataDeclaration AbstractTy) TyName
#datatypeName DataDeclaration AbstractTy
x) DataDeclaration AbstractTy
x Map TyName (DataDeclaration AbstractTy)
acc) Map TyName (DataDeclaration AbstractTy)
forall k a. Map k a
M.empty [DataDeclaration AbstractTy]
decls
  case Map TyName (DataDeclaration AbstractTy) -> Either KindCheckError ()
checkDataDecls Map TyName (DataDeclaration AbstractTy)
tyDict of
    Left KindCheckError
kcErr -> String -> Either String (Map TyName (DatatypeInfo AbstractTy))
forall a b. a -> Either a b
Left (String -> Either String (Map TyName (DatatypeInfo AbstractTy)))
-> String -> Either String (Map TyName (DatatypeInfo AbstractTy))
forall a b. (a -> b) -> a -> b
$ String
"KindCheck error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> KindCheckError -> String
forall a. Show a => a -> String
show KindCheckError
kcErr
    Right ()
_ ->
      (BBFError -> String)
-> Either BBFError (Map TyName (DatatypeInfo AbstractTy))
-> Either String (Map TyName (DatatypeInfo AbstractTy))
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((String
"DatatypeInfo error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (BBFError -> String) -> BBFError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BBFError -> String
forall a. Show a => a -> String
show) (Either BBFError (Map TyName (DatatypeInfo AbstractTy))
 -> Either String (Map TyName (DatatypeInfo AbstractTy)))
-> Either BBFError (Map TyName (DatatypeInfo AbstractTy))
-> Either String (Map TyName (DatatypeInfo AbstractTy))
forall a b. (a -> b) -> a -> b
$
        (Either BBFError (Map TyName (DatatypeInfo AbstractTy))
 -> DataDeclaration AbstractTy
 -> Either BBFError (Map TyName (DatatypeInfo AbstractTy)))
-> Either BBFError (Map TyName (DatatypeInfo AbstractTy))
-> Map TyName (DataDeclaration AbstractTy)
-> Either BBFError (Map TyName (DatatypeInfo AbstractTy))
forall b a. (b -> a -> b) -> b -> Map TyName a -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
          (\Either BBFError (Map TyName (DatatypeInfo AbstractTy))
acc DataDeclaration AbstractTy
decl -> Map TyName (DatatypeInfo AbstractTy)
-> Map TyName (DatatypeInfo AbstractTy)
-> Map TyName (DatatypeInfo AbstractTy)
forall a. Semigroup a => a -> a -> a
(<>) (Map TyName (DatatypeInfo AbstractTy)
 -> Map TyName (DatatypeInfo AbstractTy)
 -> Map TyName (DatatypeInfo AbstractTy))
-> Either BBFError (Map TyName (DatatypeInfo AbstractTy))
-> Either
     BBFError
     (Map TyName (DatatypeInfo AbstractTy)
      -> Map TyName (DatatypeInfo AbstractTy))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> DataDeclaration AbstractTy
-> Either BBFError (Map TyName (DatatypeInfo AbstractTy))
mkDatatypeInfo DataDeclaration AbstractTy
decl Either
  BBFError
  (Map TyName (DatatypeInfo AbstractTy)
   -> Map TyName (DatatypeInfo AbstractTy))
-> Either BBFError (Map TyName (DatatypeInfo AbstractTy))
-> Either BBFError (Map TyName (DatatypeInfo AbstractTy))
forall a b.
Either BBFError (a -> b) -> Either BBFError a -> Either BBFError b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Either BBFError (Map TyName (DatatypeInfo AbstractTy))
acc)
          (Map TyName (DatatypeInfo AbstractTy)
-> Either BBFError (Map TyName (DatatypeInfo AbstractTy))
forall a b. b -> Either a b
Right Map TyName (DatatypeInfo AbstractTy)
primBaseFunctorInfos)
          Map TyName (DataDeclaration AbstractTy)
tyDict

-- IO Helpers

writeJSONWith :: forall (a :: Type). FilePath -> a -> (a -> Encoding) -> IO ()
writeJSONWith :: forall a. String -> a -> (a -> Encoding) -> IO ()
writeJSONWith String
path a
x a -> Encoding
f = String -> ByteString -> IO ()
BL.writeFile String
path (Encoding -> ByteString
forall a. Encoding' a -> ByteString
encodingToLazyByteString (Encoding -> ByteString) -> (a -> Encoding) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding
f (a -> ByteString) -> a -> ByteString
forall a b. (a -> b) -> a -> b
$ a
x)

readJSON :: forall (a :: Type). (FromJSON a) => FilePath -> ExceptT DeserializeErr IO a
readJSON :: forall a. FromJSON a => String -> ExceptT DeserializeErr IO a
readJSON String
path =
  IO (Either String a) -> ExceptT DeserializeErr IO (Either String a)
forall a. IO a -> ExceptT DeserializeErr IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (forall a. FromJSON a => String -> IO (Either String a)
eitherDecodeFileStrict @a String
path) ExceptT DeserializeErr IO (Either String a)
-> (Either String a -> ExceptT DeserializeErr IO a)
-> ExceptT DeserializeErr IO a
forall a b.
ExceptT DeserializeErr IO a
-> (a -> ExceptT DeserializeErr IO b)
-> ExceptT DeserializeErr IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left String
err' -> DeserializeErr -> ExceptT DeserializeErr IO a
forall a. DeserializeErr -> ExceptT DeserializeErr IO a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (DeserializeErr -> ExceptT DeserializeErr IO a)
-> (String -> DeserializeErr)
-> String
-> ExceptT DeserializeErr IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DeserializeErr
JSONParseFailure (String -> ExceptT DeserializeErr IO a)
-> String -> ExceptT DeserializeErr IO a
forall a b. (a -> b) -> a -> b
$ String
err'
    Right a
res -> a -> ExceptT DeserializeErr IO a
forall a. a -> ExceptT DeserializeErr IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
res