-- editorconfig-checker-disable-file
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}

-- | Reading and writing ASTs with various name types in flat format.
module PlutusCore.Executable.AstIO
  ( serialisePirProgramFlat
  , serialisePlcProgramFlat
  , serialiseUplcProgramFlat
  , loadPirASTfromFlat
  , loadPlcASTfromFlat
  , loadUplcASTfromFlat
  , fromNamedDeBruijnUPLC
  , toDeBruijnTermPLC
  , toDeBruijnTermUPLC
  , toDeBruijnTypePLC
  , toNamedDeBruijnUPLC
  )
where

import PlutusCore.Executable.Types
import PlutusPrelude

import PlutusCore qualified as PLC
import PlutusCore.DeBruijn
  ( deBruijnTy
  , fakeNameDeBruijn
  , fakeTyNameDeBruijn
  , unNameDeBruijn
  , unNameTyDeBruijn
  )

import PlutusIR.Core.Instance.Pretty ()

import UntypedPlutusCore qualified as UPLC

import Control.Lens (traverseOf)
import Data.ByteString.Lazy qualified as BSL
import PlutusCore.Flat (Flat, flat, unflat)

type UplcProgDB ann = UPLC.Program PLC.DeBruijn PLC.DefaultUni PLC.DefaultFun ann
type UplcProgNDB ann = UPLC.Program PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ann

type PlcProgDB ann = PLC.Program PLC.TyDeBruijn PLC.DeBruijn PLC.DefaultUni PLC.DefaultFun ann
type PlcProgNDB ann = PLC.Program PLC.NamedTyDeBruijn PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ann

-- For the plutus-metatheory tests
type UplcTermDB ann = UPLC.Term PLC.DeBruijn PLC.DefaultUni PLC.DefaultFun ann
type UplcTermNDB ann = UPLC.Term PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ann

type PlcTermDB ann = PLC.Term PLC.TyDeBruijn PLC.DeBruijn PLC.DefaultUni PLC.DefaultFun ann
type PlcTermNDB ann = PLC.Term PLC.NamedTyDeBruijn PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ann

type PlcType ann = PLC.Type PLC.TyName PLC.DefaultUni ann
type PlcTypeDB ann = PLC.Type PLC.TyDeBruijn PLC.DefaultUni ann
type PlcTypeNDB ann = PLC.Type PLC.NamedTyDeBruijn PLC.DefaultUni ann

{-| PIR does not support names involving de Bruijn indices. We do allow these
formats here to facilitate code sharing, but issue the error below if they're
encountered.  This should never happen in practice because the options
parsers for the `pir` command only accept the Named and Textual formats. -}
unsupportedNameTypeError :: AstNameType -> a
unsupportedNameTypeError :: forall a. AstNameType -> a
unsupportedNameTypeError AstNameType
nameType = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"ASTs with " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AstNameType -> [Char]
forall a. Show a => a -> [Char]
show AstNameType
nameType [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" names are not supported for PIR"

---------------- Name conversions ----------------

-- Untyped terms and programs
{-| Convert an untyped term to one where the 'name' type is textual names
with de Bruijn indices. -}
toNamedDeBruijnTermUPLC :: UplcTerm ann -> UplcTermNDB ann
toNamedDeBruijnTermUPLC :: forall ann. UplcTerm ann -> UplcTermNDB ann
toNamedDeBruijnTermUPLC = forall e a. Show e => Either e a -> a
unsafeFromRight @PLC.FreeVariableError (Either FreeVariableError (UplcTermNDB ann) -> UplcTermNDB ann)
-> (UplcTerm ann -> Either FreeVariableError (UplcTermNDB ann))
-> UplcTerm ann
-> UplcTermNDB ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UplcTerm ann -> Either FreeVariableError (UplcTermNDB ann)
forall (m :: * -> *) (uni :: * -> *) fun ann.
MonadError FreeVariableError m =>
Term Name uni fun ann -> m (Term NamedDeBruijn uni fun ann)
UPLC.deBruijnTerm

-- | Convert an untyped term to one where the 'name' type is de Bruijn indices.
toDeBruijnTermUPLC :: UplcTerm ann -> UplcTermDB ann
toDeBruijnTermUPLC :: forall ann. UplcTerm ann -> UplcTermDB ann
toDeBruijnTermUPLC = (NamedDeBruijn -> DeBruijn)
-> Term NamedDeBruijn DefaultUni DefaultFun ann
-> Term DeBruijn DefaultUni DefaultFun ann
forall name name' (uni :: * -> *) fun ann.
(name -> name') -> Term name uni fun ann -> Term name' uni fun ann
UPLC.termMapNames NamedDeBruijn -> DeBruijn
unNameDeBruijn (Term NamedDeBruijn DefaultUni DefaultFun ann
 -> Term DeBruijn DefaultUni DefaultFun ann)
-> (UplcTerm ann -> Term NamedDeBruijn DefaultUni DefaultFun ann)
-> UplcTerm ann
-> Term DeBruijn DefaultUni DefaultFun ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UplcTerm ann -> Term NamedDeBruijn DefaultUni DefaultFun ann
forall ann. UplcTerm ann -> UplcTermNDB ann
toNamedDeBruijnTermUPLC

{-| Convert an untyped program to one where the 'name' type is textual names
with de Bruijn indices. -}
toNamedDeBruijnUPLC :: UplcProg ann -> UplcProgNDB ann
toNamedDeBruijnUPLC :: forall ann. UplcProg ann -> UplcProgNDB ann
toNamedDeBruijnUPLC (UPLC.Program ann
ann Version
ver Term Name DefaultUni DefaultFun ann
term) =
  ann
-> Version
-> Term NamedDeBruijn DefaultUni DefaultFun ann
-> Program NamedDeBruijn DefaultUni DefaultFun ann
forall name (uni :: * -> *) fun ann.
ann -> Version -> Term name uni fun ann -> Program name uni fun ann
UPLC.Program ann
ann Version
ver (Term Name DefaultUni DefaultFun ann
-> Term NamedDeBruijn DefaultUni DefaultFun ann
forall ann. UplcTerm ann -> UplcTermNDB ann
toNamedDeBruijnTermUPLC Term Name DefaultUni DefaultFun ann
term)

-- | Convert an untyped program to one where the 'name' type is de Bruijn indices.
toDeBruijnUPLC :: UplcProg ann -> UplcProgDB ann
toDeBruijnUPLC :: forall ann. UplcProg ann -> UplcProgDB ann
toDeBruijnUPLC (UPLC.Program ann
ann Version
ver Term Name DefaultUni DefaultFun ann
term) =
  ann
-> Version
-> Term DeBruijn DefaultUni DefaultFun ann
-> Program DeBruijn DefaultUni DefaultFun ann
forall name (uni :: * -> *) fun ann.
ann -> Version -> Term name uni fun ann -> Program name uni fun ann
UPLC.Program ann
ann Version
ver (Term Name DefaultUni DefaultFun ann
-> Term DeBruijn DefaultUni DefaultFun ann
forall ann. UplcTerm ann -> UplcTermDB ann
toDeBruijnTermUPLC Term Name DefaultUni DefaultFun ann
term)

-- | Convert an untyped program with named de Bruijn indices to one with textual names.
fromNamedDeBruijnUPLC :: UplcProgNDB ann -> UplcProg ann
fromNamedDeBruijnUPLC :: forall ann. UplcProgNDB ann -> UplcProg ann
fromNamedDeBruijnUPLC =
  forall e a. Show e => Either e a -> a
unsafeFromRight @PLC.FreeVariableError
    (Either FreeVariableError (UplcProg ann) -> UplcProg ann)
-> (UplcProgNDB ann -> Either FreeVariableError (UplcProg ann))
-> UplcProgNDB ann
-> UplcProg ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuoteT (Either FreeVariableError) (UplcProg ann)
-> Either FreeVariableError (UplcProg ann)
forall (m :: * -> *) a. Monad m => QuoteT m a -> m a
PLC.runQuoteT
    (QuoteT (Either FreeVariableError) (UplcProg ann)
 -> Either FreeVariableError (UplcProg ann))
-> (UplcProgNDB ann
    -> QuoteT (Either FreeVariableError) (UplcProg ann))
-> UplcProgNDB ann
-> Either FreeVariableError (UplcProg ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  (QuoteT (Either FreeVariableError))
  (UplcProgNDB ann)
  (UplcProg ann)
  (Term NamedDeBruijn DefaultUni DefaultFun ann)
  (Term Name DefaultUni DefaultFun ann)
-> LensLike
     (QuoteT (Either FreeVariableError))
     (UplcProgNDB ann)
     (UplcProg ann)
     (Term NamedDeBruijn DefaultUni DefaultFun ann)
     (Term Name DefaultUni DefaultFun ann)
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  (QuoteT (Either FreeVariableError))
  (UplcProgNDB ann)
  (UplcProg ann)
  (Term NamedDeBruijn DefaultUni DefaultFun ann)
  (Term Name DefaultUni DefaultFun ann)
forall name1 (uni1 :: * -> *) fun1 ann name2 (uni2 :: * -> *) fun2
       (f :: * -> *).
Functor f =>
(Term name1 uni1 fun1 ann -> f (Term name2 uni2 fun2 ann))
-> Program name1 uni1 fun1 ann -> f (Program name2 uni2 fun2 ann)
UPLC.progTerm Term NamedDeBruijn DefaultUni DefaultFun ann
-> QuoteT
     (Either FreeVariableError) (Term Name DefaultUni DefaultFun ann)
forall (m :: * -> *) (uni :: * -> *) fun ann.
(MonadQuote m, MonadError FreeVariableError m) =>
Term NamedDeBruijn uni fun ann -> m (Term Name uni fun ann)
UPLC.unDeBruijnTerm

-- | Convert an untyped program with de Bruijn indices to one with textual names.
fromDeBruijnUPLC :: UplcProgDB ann -> UplcProg ann
fromDeBruijnUPLC :: forall ann. UplcProgDB ann -> UplcProg ann
fromDeBruijnUPLC = UplcProgNDB ann -> UplcProg ann
forall ann. UplcProgNDB ann -> UplcProg ann
fromNamedDeBruijnUPLC (UplcProgNDB ann -> UplcProg ann)
-> (UplcProgDB ann -> UplcProgNDB ann)
-> UplcProgDB ann
-> UplcProg ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeBruijn -> NamedDeBruijn) -> UplcProgDB ann -> UplcProgNDB ann
forall name name' (uni :: * -> *) fun ann.
(name -> name')
-> Program name uni fun ann -> Program name' uni fun ann
UPLC.programMapNames DeBruijn -> NamedDeBruijn
fakeNameDeBruijn

-- Typed terms and programs

{-| Convert a typed term to one where the 'name' type is textual names
with de Bruijn indices. -}
toNamedDeBruijnTermPLC :: PlcTerm ann -> PlcTermNDB ann
toNamedDeBruijnTermPLC :: forall ann. PlcTerm ann -> PlcTermNDB ann
toNamedDeBruijnTermPLC = forall e a. Show e => Either e a -> a
unsafeFromRight @PLC.FreeVariableError (Either FreeVariableError (PlcTermNDB ann) -> PlcTermNDB ann)
-> (PlcTerm ann -> Either FreeVariableError (PlcTermNDB ann))
-> PlcTerm ann
-> PlcTermNDB ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlcTerm ann -> Either FreeVariableError (PlcTermNDB ann)
forall (m :: * -> *) (uni :: * -> *) fun ann.
MonadError FreeVariableError m =>
Term TyName Name uni fun ann
-> m (Term NamedTyDeBruijn NamedDeBruijn uni fun ann)
PLC.deBruijnTerm

-- | Convert a typed term to one where the 'name' type is de Bruijn indices.
toDeBruijnTermPLC :: PlcTerm ann -> PlcTermDB ann
toDeBruijnTermPLC :: forall ann. PlcTerm ann -> PlcTermDB ann
toDeBruijnTermPLC = (NamedTyDeBruijn -> TyDeBruijn)
-> (NamedDeBruijn -> DeBruijn)
-> Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ann
-> Term TyDeBruijn DeBruijn DefaultUni DefaultFun ann
forall tyname tyname' name name' (uni :: * -> *) fun ann.
(tyname -> tyname')
-> (name -> name')
-> Term tyname name uni fun ann
-> Term tyname' name' uni fun ann
PLC.termMapNames NamedTyDeBruijn -> TyDeBruijn
unNameTyDeBruijn NamedDeBruijn -> DeBruijn
unNameDeBruijn (Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ann
 -> Term TyDeBruijn DeBruijn DefaultUni DefaultFun ann)
-> (PlcTerm ann
    -> Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ann)
-> PlcTerm ann
-> Term TyDeBruijn DeBruijn DefaultUni DefaultFun ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlcTerm ann
-> Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ann
forall ann. PlcTerm ann -> PlcTermNDB ann
toNamedDeBruijnTermPLC

{-| Convert a typed program to one where the 'name' type is textual names with
de Bruijn indices. -}
toNamedDeBruijnPLC :: PlcProg ann -> PlcProgNDB ann
toNamedDeBruijnPLC :: forall ann. PlcProg ann -> PlcProgNDB ann
toNamedDeBruijnPLC (PLC.Program ann
ann Version
ver Term TyName Name DefaultUni DefaultFun ann
term) =
  ann
-> Version
-> Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ann
-> Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ann
forall tyname name (uni :: * -> *) fun ann.
ann
-> Version
-> Term tyname name uni fun ann
-> Program tyname name uni fun ann
PLC.Program ann
ann Version
ver (Term TyName Name DefaultUni DefaultFun ann
-> Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ann
forall ann. PlcTerm ann -> PlcTermNDB ann
toNamedDeBruijnTermPLC Term TyName Name DefaultUni DefaultFun ann
term)

-- | Convert a typed program to one where the 'name' type is de Bruijn indices.
toDeBruijnPLC :: PlcProg ann -> PlcProgDB ann
toDeBruijnPLC :: forall ann. PlcProg ann -> PlcProgDB ann
toDeBruijnPLC (PLC.Program ann
ann Version
ver Term TyName Name DefaultUni DefaultFun ann
term) =
  ann
-> Version
-> Term TyDeBruijn DeBruijn DefaultUni DefaultFun ann
-> Program TyDeBruijn DeBruijn DefaultUni DefaultFun ann
forall tyname name (uni :: * -> *) fun ann.
ann
-> Version
-> Term tyname name uni fun ann
-> Program tyname name uni fun ann
PLC.Program ann
ann Version
ver (Term TyName Name DefaultUni DefaultFun ann
-> Term TyDeBruijn DeBruijn DefaultUni DefaultFun ann
forall ann. PlcTerm ann -> PlcTermDB ann
toDeBruijnTermPLC Term TyName Name DefaultUni DefaultFun ann
term)

-- | Convert a type to one where the 'tyname' type is named de Bruijn indices.
toNamedDeBruijnTypePLC :: PlcType ann -> PlcTypeNDB ann
toNamedDeBruijnTypePLC :: forall ann. PlcType ann -> PlcTypeNDB ann
toNamedDeBruijnTypePLC = forall e a. Show e => Either e a -> a
unsafeFromRight @PLC.FreeVariableError (Either FreeVariableError (PlcTypeNDB ann) -> PlcTypeNDB ann)
-> (PlcType ann -> Either FreeVariableError (PlcTypeNDB ann))
-> PlcType ann
-> PlcTypeNDB ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlcType ann -> Either FreeVariableError (PlcTypeNDB ann)
forall (m :: * -> *) (uni :: * -> *) ann.
MonadError FreeVariableError m =>
Type TyName uni ann -> m (Type NamedTyDeBruijn uni ann)
deBruijnTy

-- | Convert a type to one where the 'tyname' type is de Bruijn indices.
toDeBruijnTypePLC :: PlcType ann -> PlcTypeDB ann
toDeBruijnTypePLC :: forall ann. PlcType ann -> PlcTypeDB ann
toDeBruijnTypePLC = (NamedTyDeBruijn -> TyDeBruijn)
-> Type NamedTyDeBruijn DefaultUni ann
-> Type TyDeBruijn DefaultUni ann
forall tyname tyname' (uni :: * -> *) ann.
(tyname -> tyname') -> Type tyname uni ann -> Type tyname' uni ann
PLC.typeMapNames NamedTyDeBruijn -> TyDeBruijn
unNameTyDeBruijn (Type NamedTyDeBruijn DefaultUni ann
 -> Type TyDeBruijn DefaultUni ann)
-> (PlcType ann -> Type NamedTyDeBruijn DefaultUni ann)
-> PlcType ann
-> Type TyDeBruijn DefaultUni ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlcType ann -> Type NamedTyDeBruijn DefaultUni ann
forall ann. PlcType ann -> PlcTypeNDB ann
toNamedDeBruijnTypePLC

-- | Convert a typed program with named de Bruijn indices to one with textual names.
fromNamedDeBruijnPLC :: PlcProgNDB ann -> PlcProg ann
fromNamedDeBruijnPLC :: forall ann. PlcProgNDB ann -> PlcProg ann
fromNamedDeBruijnPLC =
  forall e a. Show e => Either e a -> a
unsafeFromRight @PLC.FreeVariableError
    (Either FreeVariableError (PlcProg ann) -> PlcProg ann)
-> (PlcProgNDB ann -> Either FreeVariableError (PlcProg ann))
-> PlcProgNDB ann
-> PlcProg ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuoteT (Either FreeVariableError) (PlcProg ann)
-> Either FreeVariableError (PlcProg ann)
forall (m :: * -> *) a. Monad m => QuoteT m a -> m a
PLC.runQuoteT
    (QuoteT (Either FreeVariableError) (PlcProg ann)
 -> Either FreeVariableError (PlcProg ann))
-> (PlcProgNDB ann
    -> QuoteT (Either FreeVariableError) (PlcProg ann))
-> PlcProgNDB ann
-> Either FreeVariableError (PlcProg ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  (QuoteT (Either FreeVariableError))
  (PlcProgNDB ann)
  (PlcProg ann)
  (Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ann)
  (Term TyName Name DefaultUni DefaultFun ann)
-> LensLike
     (QuoteT (Either FreeVariableError))
     (PlcProgNDB ann)
     (PlcProg ann)
     (Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ann)
     (Term TyName Name DefaultUni DefaultFun ann)
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  (QuoteT (Either FreeVariableError))
  (PlcProgNDB ann)
  (PlcProg ann)
  (Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ann)
  (Term TyName Name DefaultUni DefaultFun ann)
forall tyname1 name1 (uni1 :: * -> *) fun1 ann tyname2 name2
       (uni2 :: * -> *) fun2 (f :: * -> *).
Functor f =>
(Term tyname1 name1 uni1 fun1 ann
 -> f (Term tyname2 name2 uni2 fun2 ann))
-> Program tyname1 name1 uni1 fun1 ann
-> f (Program tyname2 name2 uni2 fun2 ann)
PLC.progTerm Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ann
-> QuoteT
     (Either FreeVariableError)
     (Term TyName Name DefaultUni DefaultFun ann)
forall (m :: * -> *) (uni :: * -> *) fun ann.
(MonadQuote m, MonadError FreeVariableError m) =>
Term NamedTyDeBruijn NamedDeBruijn uni fun ann
-> m (Term TyName Name uni fun ann)
PLC.unDeBruijnTerm

-- | Convert a typed program with de Bruijn indices to one with textual names.
fromDeBruijnPLC :: PlcProgDB ann -> PlcProg ann
fromDeBruijnPLC :: forall ann. PlcProgDB ann -> PlcProg ann
fromDeBruijnPLC = PlcProgNDB ann -> PlcProg ann
forall ann. PlcProgNDB ann -> PlcProg ann
fromNamedDeBruijnPLC (PlcProgNDB ann -> PlcProg ann)
-> (PlcProgDB ann -> PlcProgNDB ann)
-> PlcProgDB ann
-> PlcProg ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TyDeBruijn -> NamedTyDeBruijn)
-> (DeBruijn -> NamedDeBruijn) -> PlcProgDB ann -> PlcProgNDB ann
forall tyname tyname' name name' (uni :: * -> *) fun ann.
(tyname -> tyname')
-> (name -> name')
-> Program tyname name uni fun ann
-> Program tyname' name' uni fun ann
PLC.programMapNames TyDeBruijn -> NamedTyDeBruijn
fakeTyNameDeBruijn DeBruijn -> NamedDeBruijn
fakeNameDeBruijn

-- Flat serialisation in various formats.

serialisePirProgramFlat
  :: Flat ann
  => AstNameType
  -> PirProg ann
  -> BSL.ByteString
serialisePirProgramFlat :: forall ann. Flat ann => AstNameType -> PirProg ann -> ByteString
serialisePirProgramFlat =
  \case
    AstNameType
Named -> ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString)
-> (PirProg ann -> ByteString) -> PirProg ann -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PirProg ann -> ByteString
forall a. Flat a => a -> ByteString
flat
    AstNameType
DeBruijn -> AstNameType -> PirProg ann -> ByteString
forall a. AstNameType -> a
unsupportedNameTypeError AstNameType
DeBruijn
    AstNameType
NamedDeBruijn -> AstNameType -> PirProg ann -> ByteString
forall a. AstNameType -> a
unsupportedNameTypeError AstNameType
NamedDeBruijn

serialisePlcProgramFlat
  :: Flat ann
  => AstNameType
  -> PlcProg ann
  -> BSL.ByteString
serialisePlcProgramFlat :: forall ann. Flat ann => AstNameType -> PlcProg ann -> ByteString
serialisePlcProgramFlat =
  \case
    AstNameType
Named -> ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString)
-> (PlcProg ann -> ByteString) -> PlcProg ann -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlcProg ann -> ByteString
forall a. Flat a => a -> ByteString
flat
    AstNameType
DeBruijn -> ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString)
-> (PlcProg ann -> ByteString) -> PlcProg ann -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlcProgDB ann -> ByteString
forall a. Flat a => a -> ByteString
flat (PlcProgDB ann -> ByteString)
-> (PlcProg ann -> PlcProgDB ann) -> PlcProg ann -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlcProg ann -> PlcProgDB ann
forall ann. PlcProg ann -> PlcProgDB ann
toDeBruijnPLC
    AstNameType
NamedDeBruijn -> ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString)
-> (PlcProg ann -> ByteString) -> PlcProg ann -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlcProgNDB ann -> ByteString
forall a. Flat a => a -> ByteString
flat (PlcProgNDB ann -> ByteString)
-> (PlcProg ann -> PlcProgNDB ann) -> PlcProg ann -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlcProg ann -> PlcProgNDB ann
forall ann. PlcProg ann -> PlcProgNDB ann
toNamedDeBruijnPLC

serialiseUplcProgramFlat
  :: Flat ann
  => AstNameType
  -> UplcProg ann
  -> BSL.ByteString
serialiseUplcProgramFlat :: forall ann. Flat ann => AstNameType -> UplcProg ann -> ByteString
serialiseUplcProgramFlat =
  \case
    AstNameType
Named -> ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString)
-> (UplcProg ann -> ByteString) -> UplcProg ann -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnrestrictedProgram Name DefaultUni DefaultFun ann -> ByteString
forall a. Flat a => a -> ByteString
flat (UnrestrictedProgram Name DefaultUni DefaultFun ann -> ByteString)
-> (UplcProg ann
    -> UnrestrictedProgram Name DefaultUni DefaultFun ann)
-> UplcProg ann
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UplcProg ann -> UnrestrictedProgram Name DefaultUni DefaultFun ann
forall name (uni :: * -> *) fun ann.
Program name uni fun ann -> UnrestrictedProgram name uni fun ann
UPLC.UnrestrictedProgram
    AstNameType
DeBruijn -> ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString)
-> (UplcProg ann -> ByteString) -> UplcProg ann -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnrestrictedProgram DeBruijn DefaultUni DefaultFun ann
-> ByteString
forall a. Flat a => a -> ByteString
flat (UnrestrictedProgram DeBruijn DefaultUni DefaultFun ann
 -> ByteString)
-> (UplcProg ann
    -> UnrestrictedProgram DeBruijn DefaultUni DefaultFun ann)
-> UplcProg ann
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program DeBruijn DefaultUni DefaultFun ann
-> UnrestrictedProgram DeBruijn DefaultUni DefaultFun ann
forall name (uni :: * -> *) fun ann.
Program name uni fun ann -> UnrestrictedProgram name uni fun ann
UPLC.UnrestrictedProgram (Program DeBruijn DefaultUni DefaultFun ann
 -> UnrestrictedProgram DeBruijn DefaultUni DefaultFun ann)
-> (UplcProg ann -> Program DeBruijn DefaultUni DefaultFun ann)
-> UplcProg ann
-> UnrestrictedProgram DeBruijn DefaultUni DefaultFun ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UplcProg ann -> Program DeBruijn DefaultUni DefaultFun ann
forall ann. UplcProg ann -> UplcProgDB ann
toDeBruijnUPLC
    AstNameType
NamedDeBruijn -> ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString)
-> (UplcProg ann -> ByteString) -> UplcProg ann -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun ann
-> ByteString
forall a. Flat a => a -> ByteString
flat (UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun ann
 -> ByteString)
-> (UplcProg ann
    -> UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun ann)
-> UplcProg ann
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program NamedDeBruijn DefaultUni DefaultFun ann
-> UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun ann
forall name (uni :: * -> *) fun ann.
Program name uni fun ann -> UnrestrictedProgram name uni fun ann
UPLC.UnrestrictedProgram (Program NamedDeBruijn DefaultUni DefaultFun ann
 -> UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun ann)
-> (UplcProg ann
    -> Program NamedDeBruijn DefaultUni DefaultFun ann)
-> UplcProg ann
-> UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UplcProg ann -> Program NamedDeBruijn DefaultUni DefaultFun ann
forall ann. UplcProg ann -> UplcProgNDB ann
toNamedDeBruijnUPLC

-- Deserialising ASTs from Flat

-- Read a binary-encoded file (eg, Flat-encoded PLC)
getBinaryInput :: Input -> IO BSL.ByteString
getBinaryInput :: Input -> IO ByteString
getBinaryInput Input
StdInput = IO ByteString
BSL.getContents
getBinaryInput (FileInput [Char]
file) = [Char] -> IO ByteString
BSL.readFile [Char]
file

unflatOrFail :: Flat a => BSL.ByteString -> a
unflatOrFail :: forall a. Flat a => ByteString -> a
unflatOrFail ByteString
input =
  case ByteString -> Decoded a
forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat ByteString
input of
    Left DecodeException
e -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"Flat deserialisation failure: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ DecodeException -> [Char]
forall a. Show a => a -> [Char]
show DecodeException
e
    Right a
r -> a
r

loadPirASTfromFlat
  :: Flat a
  => AstNameType
  -> Input
  -> IO (PirProg a)
loadPirASTfromFlat :: forall a. Flat a => AstNameType -> Input -> IO (PirProg a)
loadPirASTfromFlat AstNameType
flatMode Input
inp =
  Input -> IO ByteString
getBinaryInput Input
inp
    IO ByteString -> (ByteString -> PirProg a) -> IO (PirProg a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> case AstNameType
flatMode of
      AstNameType
Named -> ByteString -> PirProg a
forall a. Flat a => ByteString -> a
unflatOrFail
      AstNameType
_ -> AstNameType -> ByteString -> PirProg a
forall a. AstNameType -> a
unsupportedNameTypeError AstNameType
flatMode

-- | Read and deserialise a Flat-encoded PIR/PLC AST
loadPlcASTfromFlat
  :: Flat a
  => AstNameType
  -> Input
  -> IO (PlcProg a)
loadPlcASTfromFlat :: forall a. Flat a => AstNameType -> Input -> IO (PlcProg a)
loadPlcASTfromFlat AstNameType
flatMode Input
inp =
  Input -> IO ByteString
getBinaryInput Input
inp
    IO ByteString -> (ByteString -> PlcProg a) -> IO (PlcProg a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> case AstNameType
flatMode of
      AstNameType
Named -> ByteString -> PlcProg a
forall a. Flat a => ByteString -> a
unflatOrFail
      AstNameType
DeBruijn -> ByteString -> PlcProgDB a
forall a. Flat a => ByteString -> a
unflatOrFail (ByteString -> PlcProgDB a)
-> (PlcProgDB a -> PlcProg a) -> ByteString -> PlcProg a
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> PlcProgDB a -> PlcProg a
forall ann. PlcProgDB ann -> PlcProg ann
fromDeBruijnPLC
      AstNameType
NamedDeBruijn -> ByteString -> PlcProgNDB a
forall a. Flat a => ByteString -> a
unflatOrFail (ByteString -> PlcProgNDB a)
-> (PlcProgNDB a -> PlcProg a) -> ByteString -> PlcProg a
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> PlcProgNDB a -> PlcProg a
forall ann. PlcProgNDB ann -> PlcProg ann
fromNamedDeBruijnPLC

-- | Read and deserialise a Flat-encoded UPLC AST
loadUplcASTfromFlat
  :: Flat ann
  => AstNameType
  -> Input
  -> IO (UplcProg ann)
loadUplcASTfromFlat :: forall ann. Flat ann => AstNameType -> Input -> IO (UplcProg ann)
loadUplcASTfromFlat AstNameType
flatMode Input
inp =
  Input -> IO ByteString
getBinaryInput Input
inp
    IO ByteString -> (ByteString -> UplcProg ann) -> IO (UplcProg ann)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> case AstNameType
flatMode of
      AstNameType
Named -> ByteString -> UnrestrictedProgram Name DefaultUni DefaultFun ann
forall a. Flat a => ByteString -> a
unflatOrFail (ByteString -> UnrestrictedProgram Name DefaultUni DefaultFun ann)
-> (UnrestrictedProgram Name DefaultUni DefaultFun ann
    -> UplcProg ann)
-> ByteString
-> UplcProg ann
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> UnrestrictedProgram Name DefaultUni DefaultFun ann -> UplcProg ann
forall name (uni :: * -> *) fun ann.
UnrestrictedProgram name uni fun ann -> Program name uni fun ann
UPLC.unUnrestrictedProgram
      AstNameType
DeBruijn -> ByteString
-> UnrestrictedProgram DeBruijn DefaultUni DefaultFun ann
forall a. Flat a => ByteString -> a
unflatOrFail (ByteString
 -> UnrestrictedProgram DeBruijn DefaultUni DefaultFun ann)
-> (UnrestrictedProgram DeBruijn DefaultUni DefaultFun ann
    -> Program DeBruijn DefaultUni DefaultFun ann)
-> ByteString
-> Program DeBruijn DefaultUni DefaultFun ann
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> UnrestrictedProgram DeBruijn DefaultUni DefaultFun ann
-> Program DeBruijn DefaultUni DefaultFun ann
forall name (uni :: * -> *) fun ann.
UnrestrictedProgram name uni fun ann -> Program name uni fun ann
UPLC.unUnrestrictedProgram (ByteString -> Program DeBruijn DefaultUni DefaultFun ann)
-> (Program DeBruijn DefaultUni DefaultFun ann -> UplcProg ann)
-> ByteString
-> UplcProg ann
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Program DeBruijn DefaultUni DefaultFun ann -> UplcProg ann
forall ann. UplcProgDB ann -> UplcProg ann
fromDeBruijnUPLC
      AstNameType
NamedDeBruijn -> ByteString
-> UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun ann
forall a. Flat a => ByteString -> a
unflatOrFail (ByteString
 -> UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun ann)
-> (UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun ann
    -> Program NamedDeBruijn DefaultUni DefaultFun ann)
-> ByteString
-> Program NamedDeBruijn DefaultUni DefaultFun ann
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun ann
-> Program NamedDeBruijn DefaultUni DefaultFun ann
forall name (uni :: * -> *) fun ann.
UnrestrictedProgram name uni fun ann -> Program name uni fun ann
UPLC.unUnrestrictedProgram (ByteString -> Program NamedDeBruijn DefaultUni DefaultFun ann)
-> (Program NamedDeBruijn DefaultUni DefaultFun ann
    -> UplcProg ann)
-> ByteString
-> UplcProg ann
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Program NamedDeBruijn DefaultUni DefaultFun ann -> UplcProg ann
forall ann. UplcProgNDB ann -> UplcProg ann
fromNamedDeBruijnUPLC