-- 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
    )
where

import PlutusCore.Executable.Types
import PlutusPrelude

import PlutusCore qualified as PLC
import PlutusCore.DeBruijn (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 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

-- | 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 programs

-- | 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 = forall e a. Show e => Either e a -> a
unsafeFromRight @PLC.FreeVariableError
                    (Either FreeVariableError (UplcProgNDB ann) -> UplcProgNDB ann)
-> (UplcProg ann -> Either FreeVariableError (UplcProgNDB ann))
-> UplcProg ann
-> UplcProgNDB ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  (Either FreeVariableError)
  (UplcProg ann)
  (UplcProgNDB ann)
  (Term Name DefaultUni DefaultFun ann)
  (Term NamedDeBruijn DefaultUni DefaultFun ann)
-> LensLike
     (Either FreeVariableError)
     (UplcProg ann)
     (UplcProgNDB ann)
     (Term Name DefaultUni DefaultFun ann)
     (Term NamedDeBruijn DefaultUni DefaultFun ann)
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  (Either FreeVariableError)
  (UplcProg ann)
  (UplcProgNDB ann)
  (Term Name DefaultUni DefaultFun ann)
  (Term NamedDeBruijn 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 Name DefaultUni DefaultFun ann
-> Either
     FreeVariableError (Term NamedDeBruijn DefaultUni DefaultFun ann)
forall e (m :: * -> *) (uni :: * -> *) fun ann.
(AsFreeVariableError e, MonadError e m) =>
Term Name uni fun ann -> m (Term NamedDeBruijn uni fun ann)
UPLC.deBruijnTerm

-- | 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 = (NamedDeBruijn -> DeBruijn)
-> Program NamedDeBruijn DefaultUni DefaultFun ann
-> Program DeBruijn DefaultUni DefaultFun ann
forall name name' (uni :: * -> *) fun ann.
(name -> name')
-> Program name uni fun ann -> Program name' uni fun ann
UPLC.programMapNames NamedDeBruijn -> DeBruijn
unNameDeBruijn (Program NamedDeBruijn DefaultUni DefaultFun ann
 -> Program DeBruijn DefaultUni DefaultFun ann)
-> (UplcProg ann
    -> Program NamedDeBruijn DefaultUni DefaultFun ann)
-> UplcProg ann
-> Program DeBruijn 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

-- | 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 :: * -> *) e (uni :: * -> *) fun ann.
(MonadQuote m, AsFreeVariableError e, MonadError e 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 programs

-- | 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 = forall e a. Show e => Either e a -> a
unsafeFromRight @PLC.FreeVariableError
                   (Either FreeVariableError (PlcProgNDB ann) -> PlcProgNDB ann)
-> (PlcProg ann -> Either FreeVariableError (PlcProgNDB ann))
-> PlcProg ann
-> PlcProgNDB ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  (Either FreeVariableError)
  (PlcProg ann)
  (PlcProgNDB ann)
  (Term TyName Name DefaultUni DefaultFun ann)
  (Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ann)
-> LensLike
     (Either FreeVariableError)
     (PlcProg ann)
     (PlcProgNDB ann)
     (Term TyName Name DefaultUni DefaultFun ann)
     (Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ann)
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  (Either FreeVariableError)
  (PlcProg ann)
  (PlcProgNDB ann)
  (Term TyName Name DefaultUni DefaultFun ann)
  (Term NamedTyDeBruijn NamedDeBruijn 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 TyName Name DefaultUni DefaultFun ann
-> Either
     FreeVariableError
     (Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ann)
forall e (m :: * -> *) (uni :: * -> *) fun ann.
(AsFreeVariableError e, MonadError e m) =>
Term TyName Name uni fun ann
-> m (Term NamedTyDeBruijn NamedDeBruijn uni fun ann)
PLC.deBruijnTerm

-- | 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 = (NamedTyDeBruijn -> TyDeBruijn)
-> (NamedDeBruijn -> DeBruijn)
-> Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ann
-> Program TyDeBruijn DeBruijn DefaultUni DefaultFun 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 NamedTyDeBruijn -> TyDeBruijn
unNameTyDeBruijn NamedDeBruijn -> DeBruijn
unNameDeBruijn (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ann
 -> Program TyDeBruijn DeBruijn DefaultUni DefaultFun ann)
-> (PlcProg ann
    -> Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ann)
-> PlcProg ann
-> Program TyDeBruijn DeBruijn DefaultUni DefaultFun ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlcProg ann
-> Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ann
forall ann. PlcProg ann -> PlcProgNDB ann
toNamedDeBruijnPLC


-- | 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 :: * -> *) e (uni :: * -> *) fun ann.
(MonadQuote m, AsFreeVariableError e, MonadError e 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