{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module PlutusIR.Test
    ( module PlutusIR.Test
    , initialSrcSpan
    , topSrcSpan
    , rethrow
    , PLC.prettyPlcClassicSimple
    ) where

import PlutusPrelude
import Test.Tasty.Extras

import Control.Exception
import Control.Lens hiding (op, transform)
import Control.Monad.Except
import Control.Monad.Morph (hoist)
import Control.Monad.Reader as Reader

import PlutusCore.Annotation qualified as PLC
import PlutusCore.Builtin qualified as PLC
import PlutusCore.Core qualified as PLC
import PlutusCore.DeBruijn qualified as PLC
import PlutusCore.Default qualified as PLC
import PlutusCore.Error (ParserErrorBundle)
import PlutusCore.Pretty
import PlutusCore.Pretty qualified as PLC
import PlutusCore.Quote (runQuoteT)
import PlutusCore.Test hiding (ppCatch)
import PlutusCore.TypeCheck qualified as PLC
import PlutusIR as PIR
import PlutusIR.Analysis.Builtins
import PlutusIR.Compiler as PIR
import PlutusIR.Parser (Parser, pTerm, parse)
import PlutusIR.Transform.RewriteRules
import PlutusIR.TypeCheck
import System.FilePath (joinPath, (</>))

import Data.Hashable
import Data.Text qualified as T
import Data.Text.IO qualified as T

import Prettyprinter
import Prettyprinter.Render.Text

instance
  ( PLC.GEq uni
  , PLC.Typecheckable uni fun
  , PLC.PrettyUni uni
  , Pretty fun
  , Pretty a
  , Typeable a
  , Ord a
  , Default (PLC.CostingPart uni fun)
  , Default (BuiltinsInfo uni fun)
  , Default (RewriteRules uni fun)
  ) =>
  ToTPlc (PIR.Program PIR.TyName PIR.Name uni fun a) uni fun
  where
  toTPlc :: Program TyName Name uni fun a
-> ExceptT SomeException IO (Program TyName Name uni fun ())
toTPlc = Except
  (Error uni fun (Provenance a)) (Program TyName Name uni fun ())
-> ExceptT SomeException IO (Program TyName Name uni fun ())
forall e a. Exception e => Except e a -> ExceptT SomeException IO a
asIfThrown (Except
   (Error uni fun (Provenance a)) (Program TyName Name uni fun ())
 -> ExceptT SomeException IO (Program TyName Name uni fun ()))
-> (Program TyName Name uni fun a
    -> Except
         (Error uni fun (Provenance a)) (Program TyName Name uni fun ()))
-> Program TyName Name uni fun a
-> ExceptT SomeException IO (Program TyName Name uni fun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Program TyName Name uni fun (Provenance a)
 -> Program TyName Name uni fun ())
-> ExceptT
     (Error uni fun (Provenance a))
     Identity
     (Program TyName Name uni fun (Provenance a))
-> Except
     (Error uni fun (Provenance a)) (Program TyName Name uni fun ())
forall a b.
(a -> b)
-> ExceptT (Error uni fun (Provenance a)) Identity a
-> ExceptT (Error uni fun (Provenance a)) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Program TyName Name uni fun (Provenance a)
-> Program TyName Name uni fun ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   (Error uni fun (Provenance a))
   Identity
   (Program TyName Name uni fun (Provenance a))
 -> Except
      (Error uni fun (Provenance a)) (Program TyName Name uni fun ()))
-> (Program TyName Name uni fun a
    -> ExceptT
         (Error uni fun (Provenance a))
         Identity
         (Program TyName Name uni fun (Provenance a)))
-> Program TyName Name uni fun a
-> Except
     (Error uni fun (Provenance a)) (Program TyName Name uni fun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompilationCtx uni fun a -> CompilationCtx uni fun a)
-> Program TyName Name uni fun a
-> ExceptT
     (Error uni fun (Provenance a))
     Identity
     (Program TyName Name uni fun (Provenance a))
forall (uni :: * -> *) fun a.
(GEq uni, Typecheckable uni fun, Ord a, PrettyUni uni, Pretty fun,
 Pretty a, Default (BuiltinsInfo uni fun),
 Default (CostingPart uni fun), Default (RewriteRules uni fun)) =>
(CompilationCtx uni fun a -> CompilationCtx uni fun a)
-> Program TyName Name uni fun a
-> Except
     (Error uni fun (Provenance a))
     (Program TyName Name uni fun (Provenance a))
compileWithOpts CompilationCtx uni fun a -> CompilationCtx uni fun a
forall a. a -> a
id

instance
  ( PLC.GEq uni
  , PLC.Typecheckable uni fun
  , PLC.PrettyUni uni
  , Pretty fun
  , Hashable fun
  , Pretty a
  , Typeable a
  , Ord a
  , Default (PLC.CostingPart uni fun)
  , Default (BuiltinsInfo uni fun)
  , Default (RewriteRules uni fun)
  ) =>
  ToUPlc (PIR.Program PIR.TyName PIR.Name uni fun a) uni fun
  where
  toUPlc :: Program TyName Name uni fun a
-> ExceptT SomeException IO (Program Name uni fun ())
toUPlc = Program TyName Name uni fun a
-> ExceptT SomeException IO (Program TyName Name uni fun ())
forall a (uni :: * -> *) fun.
ToTPlc a uni fun =>
a -> ExceptT SomeException IO (Program TyName Name uni fun ())
toTPlc (Program TyName Name uni fun a
 -> ExceptT SomeException IO (Program TyName Name uni fun ()))
-> (Program TyName Name uni fun ()
    -> ExceptT SomeException IO (Program Name uni fun ()))
-> Program TyName Name uni fun a
-> ExceptT SomeException IO (Program Name uni fun ())
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Program TyName Name uni fun ()
-> ExceptT SomeException IO (Program Name uni fun ())
forall a (uni :: * -> *) fun.
ToUPlc a uni fun =>
a -> ExceptT SomeException IO (Program Name uni fun ())
toUPlc

pTermAsProg :: Parser (PIR.Program PIR.TyName PIR.Name PLC.DefaultUni PLC.DefaultFun PLC.SrcSpan)
pTermAsProg :: Parser (Program TyName Name DefaultUni DefaultFun SrcSpan)
pTermAsProg = (Term TyName Name DefaultUni DefaultFun SrcSpan
 -> Program TyName Name DefaultUni DefaultFun SrcSpan)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Term TyName Name DefaultUni DefaultFun SrcSpan)
-> Parser (Program TyName Name DefaultUni DefaultFun SrcSpan)
forall a b.
(a -> b)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SrcSpan
-> Version
-> Term TyName Name DefaultUni DefaultFun SrcSpan
-> Program TyName Name DefaultUni DefaultFun SrcSpan
forall tyname name (uni :: * -> *) fun ann.
ann
-> Version
-> Term tyname name uni fun ann
-> Program tyname name uni fun ann
PIR.Program SrcSpan
forall a. Monoid a => a
mempty Version
PLC.latestVersion) ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Term TyName Name DefaultUni DefaultFun SrcSpan)
pTerm

{- | Adapt an computation that keeps its errors in an 'Except' into one that looks as if
it caught them in 'IO'.
-}
asIfThrown ::
  (Exception e) =>
  Except e a ->
  ExceptT SomeException IO a
asIfThrown :: forall e a. Exception e => Except e a -> ExceptT SomeException IO a
asIfThrown = (e -> SomeException)
-> ExceptT e IO a -> ExceptT SomeException IO a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT e -> SomeException
forall e. Exception e => e -> SomeException
SomeException (ExceptT e IO a -> ExceptT SomeException IO a)
-> (Except e a -> ExceptT e IO a)
-> Except e a
-> ExceptT SomeException IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Identity a -> IO a) -> Except e a -> ExceptT e IO a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> ExceptT e m b -> ExceptT e n b
hoist (a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> IO a) -> (Identity a -> a) -> Identity a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity)

compileWithOpts ::
  ( PLC.GEq uni
  , PLC.Typecheckable uni fun
  , Ord a
  , PLC.PrettyUni uni
  , PLC.Pretty fun
  , PLC.Pretty a
  , Default (BuiltinsInfo uni fun)
  , Default (PLC.CostingPart uni fun)
  , Default (RewriteRules uni fun)
  ) =>
  (CompilationCtx uni fun a -> CompilationCtx uni fun a) ->
  PIR.Program PIR.TyName PIR.Name uni fun a ->
  Except
    (PIR.Error uni fun (PIR.Provenance a))
    (PLC.Program PIR.TyName PIR.Name uni fun (PIR.Provenance a))
compileWithOpts :: forall (uni :: * -> *) fun a.
(GEq uni, Typecheckable uni fun, Ord a, PrettyUni uni, Pretty fun,
 Pretty a, Default (BuiltinsInfo uni fun),
 Default (CostingPart uni fun), Default (RewriteRules uni fun)) =>
(CompilationCtx uni fun a -> CompilationCtx uni fun a)
-> Program TyName Name uni fun a
-> Except
     (Error uni fun (Provenance a))
     (Program TyName Name uni fun (Provenance a))
compileWithOpts CompilationCtx uni fun a -> CompilationCtx uni fun a
optsMod Program TyName Name uni fun a
pir = do
  TypeCheckConfig uni fun
tcConfig <- Provenance a
-> ExceptT
     (Error uni fun (Provenance a)) Identity (TypeCheckConfig uni fun)
forall err term (uni :: * -> *) fun ann (m :: * -> *).
(MonadKindCheck err term uni fun ann m, Typecheckable uni fun) =>
ann -> m (TypeCheckConfig uni fun)
PLC.getDefTypeCheckConfig Provenance a
forall a. Provenance a
noProvenance
  let pirCtx :: CompilationCtx uni fun a
pirCtx = CompilationCtx uni fun a -> CompilationCtx uni fun a
optsMod (TypeCheckConfig uni fun -> CompilationCtx uni fun a
forall (uni :: * -> *) fun a.
(Default (BuiltinsInfo uni fun), Default (CostingPart uni fun),
 Default (RewriteRules uni fun)) =>
TypeCheckConfig uni fun -> CompilationCtx uni fun a
toDefaultCompilationCtx TypeCheckConfig uni fun
tcConfig)
  (ReaderT
   (CompilationCtx uni fun a)
   (ExceptT (Error uni fun (Provenance a)) Identity)
   (Program TyName Name uni fun (Provenance a))
 -> CompilationCtx uni fun a
 -> Except
      (Error uni fun (Provenance a))
      (Program TyName Name uni fun (Provenance a)))
-> CompilationCtx uni fun a
-> ReaderT
     (CompilationCtx uni fun a)
     (ExceptT (Error uni fun (Provenance a)) Identity)
     (Program TyName Name uni fun (Provenance a))
-> Except
     (Error uni fun (Provenance a))
     (Program TyName Name uni fun (Provenance a))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  (CompilationCtx uni fun a)
  (ExceptT (Error uni fun (Provenance a)) Identity)
  (Program TyName Name uni fun (Provenance a))
-> CompilationCtx uni fun a
-> Except
     (Error uni fun (Provenance a))
     (Program TyName Name uni fun (Provenance a))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CompilationCtx uni fun a
pirCtx (ReaderT
   (CompilationCtx uni fun a)
   (ExceptT (Error uni fun (Provenance a)) Identity)
   (Program TyName Name uni fun (Provenance a))
 -> Except
      (Error uni fun (Provenance a))
      (Program TyName Name uni fun (Provenance a)))
-> ReaderT
     (CompilationCtx uni fun a)
     (ExceptT (Error uni fun (Provenance a)) Identity)
     (Program TyName Name uni fun (Provenance a))
-> Except
     (Error uni fun (Provenance a))
     (Program TyName Name uni fun (Provenance a))
forall a b. (a -> b) -> a -> b
$ QuoteT
  (ReaderT
     (CompilationCtx uni fun a)
     (ExceptT (Error uni fun (Provenance a)) Identity))
  (Program TyName Name uni fun (Provenance a))
-> ReaderT
     (CompilationCtx uni fun a)
     (ExceptT (Error uni fun (Provenance a)) Identity)
     (Program TyName Name uni fun (Provenance a))
forall (m :: * -> *) a. Monad m => QuoteT m a -> m a
runQuoteT (QuoteT
   (ReaderT
      (CompilationCtx uni fun a)
      (ExceptT (Error uni fun (Provenance a)) Identity))
   (Program TyName Name uni fun (Provenance a))
 -> ReaderT
      (CompilationCtx uni fun a)
      (ExceptT (Error uni fun (Provenance a)) Identity)
      (Program TyName Name uni fun (Provenance a)))
-> QuoteT
     (ReaderT
        (CompilationCtx uni fun a)
        (ExceptT (Error uni fun (Provenance a)) Identity))
     (Program TyName Name uni fun (Provenance a))
-> ReaderT
     (CompilationCtx uni fun a)
     (ExceptT (Error uni fun (Provenance a)) Identity)
     (Program TyName Name uni fun (Provenance a))
forall a b. (a -> b) -> a -> b
$ do
    Program TyName Name uni fun (Provenance a)
compiled <- Program TyName Name uni fun a
-> QuoteT
     (ReaderT
        (CompilationCtx uni fun a)
        (ExceptT (Error uni fun (Provenance a)) Identity))
     (Program TyName Name uni fun (Provenance a))
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
Program TyName Name uni fun a -> m (PLCProgram uni fun a)
compileProgram Program TyName Name uni fun a
pir
    -- PLC errors are parameterized over PLC.Terms, whereas PIR errors over PIR.Terms
    -- and as such, these prism errors cannot be unified.
    -- We instead run the ExceptT, collect any PLC error and explicitly lift into a PIR
    -- error by wrapping with PIR._PLCError
    Either (Error uni fun (Provenance a)) ()
plcConcrete <- ExceptT
  (Error uni fun (Provenance a))
  (QuoteT
     (ReaderT
        (CompilationCtx uni fun a)
        (ExceptT (Error uni fun (Provenance a)) Identity)))
  ()
-> QuoteT
     (ReaderT
        (CompilationCtx uni fun a)
        (ExceptT (Error uni fun (Provenance a)) Identity))
     (Either (Error uni fun (Provenance a)) ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (Error uni fun (Provenance a))
   (QuoteT
      (ReaderT
         (CompilationCtx uni fun a)
         (ExceptT (Error uni fun (Provenance a)) Identity)))
   ()
 -> QuoteT
      (ReaderT
         (CompilationCtx uni fun a)
         (ExceptT (Error uni fun (Provenance a)) Identity))
      (Either (Error uni fun (Provenance a)) ()))
-> ExceptT
     (Error uni fun (Provenance a))
     (QuoteT
        (ReaderT
           (CompilationCtx uni fun a)
           (ExceptT (Error uni fun (Provenance a)) Identity)))
     ()
-> QuoteT
     (ReaderT
        (CompilationCtx uni fun a)
        (ExceptT (Error uni fun (Provenance a)) Identity))
     (Either (Error uni fun (Provenance a)) ())
forall a b. (a -> b) -> a -> b
$ ExceptT
  (Error uni fun (Provenance a))
  (QuoteT
     (ReaderT
        (CompilationCtx uni fun a)
        (ExceptT (Error uni fun (Provenance a)) Identity)))
  (Normalized (Type TyName uni ()))
-> ExceptT
     (Error uni fun (Provenance a))
     (QuoteT
        (ReaderT
           (CompilationCtx uni fun a)
           (ExceptT (Error uni fun (Provenance a)) Identity)))
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   (Error uni fun (Provenance a))
   (QuoteT
      (ReaderT
         (CompilationCtx uni fun a)
         (ExceptT (Error uni fun (Provenance a)) Identity)))
   (Normalized (Type TyName uni ()))
 -> ExceptT
      (Error uni fun (Provenance a))
      (QuoteT
         (ReaderT
            (CompilationCtx uni fun a)
            (ExceptT (Error uni fun (Provenance a)) Identity)))
      ())
-> ExceptT
     (Error uni fun (Provenance a))
     (QuoteT
        (ReaderT
           (CompilationCtx uni fun a)
           (ExceptT (Error uni fun (Provenance a)) Identity)))
     (Normalized (Type TyName uni ()))
-> ExceptT
     (Error uni fun (Provenance a))
     (QuoteT
        (ReaderT
           (CompilationCtx uni fun a)
           (ExceptT (Error uni fun (Provenance a)) Identity)))
     ()
forall a b. (a -> b) -> a -> b
$ TypeCheckConfig uni fun
-> Program TyName Name uni fun (Provenance a)
-> ExceptT
     (Error uni fun (Provenance a))
     (QuoteT
        (ReaderT
           (CompilationCtx uni fun a)
           (ExceptT (Error uni fun (Provenance a)) Identity)))
     (Normalized (Type TyName uni ()))
forall err (uni :: * -> *) fun ann (m :: * -> *).
MonadTypeCheckPlc err uni fun ann m =>
TypeCheckConfig uni fun
-> Program TyName Name uni fun ann
-> m (Normalized (Type TyName uni ()))
PLC.inferTypeOfProgram TypeCheckConfig uni fun
tcConfig Program TyName Name uni fun (Provenance a)
compiled
    Either (Error uni fun (Provenance a)) ()
-> QuoteT
     (ReaderT
        (CompilationCtx uni fun a)
        (ExceptT (Error uni fun (Provenance a)) Identity))
     ()
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either (Error uni fun (Provenance a)) ()
 -> QuoteT
      (ReaderT
         (CompilationCtx uni fun a)
         (ExceptT (Error uni fun (Provenance a)) Identity))
      ())
-> Either (Error uni fun (Provenance a)) ()
-> QuoteT
     (ReaderT
        (CompilationCtx uni fun a)
        (ExceptT (Error uni fun (Provenance a)) Identity))
     ()
forall a b. (a -> b) -> a -> b
$ (Error uni fun (Provenance a) -> Error uni fun (Provenance a))
-> Either (Error uni fun (Provenance a)) ()
-> Either (Error uni fun (Provenance a)) ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Getting
  (Error uni fun (Provenance a))
  (Error uni fun (Provenance a))
  (Error uni fun (Provenance a))
-> Error uni fun (Provenance a) -> Error uni fun (Provenance a)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (AReview
  (Error uni fun (Provenance a)) (Error uni fun (Provenance a))
-> Getter
     (Error uni fun (Provenance a)) (Error uni fun (Provenance a))
forall t b. AReview t b -> Getter b t
re AReview
  (Error uni fun (Provenance a)) (Error uni fun (Provenance a))
forall r (uni :: * -> *) fun a.
AsError r uni fun a =>
Prism' r (Error uni fun a)
Prism'
  (Error uni fun (Provenance a)) (Error uni fun (Provenance a))
_PLCError)) Either (Error uni fun (Provenance a)) ()
plcConcrete
    Program TyName Name uni fun (Provenance a)
-> QuoteT
     (ReaderT
        (CompilationCtx uni fun a)
        (ExceptT (Error uni fun (Provenance a)) Identity))
     (Program TyName Name uni fun (Provenance a))
forall a.
a
-> QuoteT
     (ReaderT
        (CompilationCtx uni fun a)
        (ExceptT (Error uni fun (Provenance a)) Identity))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Program TyName Name uni fun (Provenance a)
compiled

withGoldenFileM :: String -> (T.Text -> IO T.Text) -> TestNested
withGoldenFileM :: [Char] -> (Text -> IO Text) -> TestNested
withGoldenFileM [Char]
name Text -> IO Text
op = do
  [Char]
dir <- TestNestedM [Char]
currentDir
  let testFile :: [Char]
testFile = [Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
name
      goldenFile :: [Char]
goldenFile = [Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".golden"
  TestTree -> TestNested
forall a (m :: * -> *). MonadFree ((,) a) m => a -> m ()
embed (TestTree -> TestNested) -> TestTree -> TestNested
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO Text -> TestTree
goldenVsTextM [Char]
name [Char]
goldenFile (Text -> IO Text
op (Text -> IO Text) -> IO Text -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> IO Text
T.readFile [Char]
testFile)
  where
    currentDir :: TestNestedM [Char]
currentDir = [[Char]] -> [Char]
joinPath ([[Char]] -> [Char]) -> TestNestedM [[Char]] -> TestNestedM [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestNestedM [[Char]]
forall r (m :: * -> *). MonadReader r m => m r
ask

-- TODO: deduplicate with the Plutus Core one
ppCatch :: (a -> Doc ann) -> ExceptT SomeException IO a -> IO T.Text
ppCatch :: forall a ann.
(a -> Doc ann) -> ExceptT SomeException IO a -> IO Text
ppCatch a -> Doc ann
toDoc ExceptT SomeException IO a
value = Doc ann -> Text
forall ann. Doc ann -> Text
forall str ann. Render str => Doc ann -> str
render (Doc ann -> Text)
-> (Either SomeException a -> Doc ann)
-> Either SomeException a
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeException -> Doc ann)
-> (a -> Doc ann) -> Either SomeException a -> Doc ann
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ann)
-> (SomeException -> [Char]) -> SomeException -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> [Char]
forall a. Show a => a -> [Char]
show) a -> Doc ann
toDoc (Either SomeException a -> Text)
-> IO (Either SomeException a) -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT SomeException IO a -> IO (Either SomeException a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT SomeException IO a
value

goldenPir :: (PrettyPlc b) => (a -> b) -> Parser a -> String -> TestNested
goldenPir :: forall b a.
PrettyPlc b =>
(a -> b) -> Parser a -> [Char] -> TestNested
goldenPir a -> b
op = (a -> IO b) -> Parser a -> [Char] -> TestNested
forall a b.
PrettyPlc b =>
(a -> IO b) -> Parser a -> [Char] -> TestNested
goldenPirM (b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> IO b) -> (a -> b) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
op)

goldenPirUnique :: (Pretty b) => (a -> b) -> Parser a -> String -> TestNested
goldenPirUnique :: forall b a.
Pretty b =>
(a -> b) -> Parser a -> [Char] -> TestNested
goldenPirUnique a -> b
op = (a -> IO b) -> Parser a -> [Char] -> TestNested
forall a b.
Pretty b =>
(a -> IO b) -> Parser a -> [Char] -> TestNested
goldenPirMUnique (b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> IO b) -> (a -> b) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
op)

goldenPirDoc :: (a -> Doc ann) -> Parser a -> String -> TestNested
goldenPirDoc :: forall a ann. (a -> Doc ann) -> Parser a -> [Char] -> TestNested
goldenPirDoc a -> Doc ann
op = (a -> IO (Doc ann)) -> Parser a -> [Char] -> TestNested
forall a ann.
(a -> IO (Doc ann)) -> Parser a -> [Char] -> TestNested
goldenPirDocM (Doc ann -> IO (Doc ann)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> IO (Doc ann)) -> (a -> Doc ann) -> a -> IO (Doc ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc ann
op)

goldenPirMUnique :: forall a b. (Pretty b) => (a -> IO b) -> Parser a -> String -> TestNested
goldenPirMUnique :: forall a b.
Pretty b =>
(a -> IO b) -> Parser a -> [Char] -> TestNested
goldenPirMUnique a -> IO b
op Parser a
parser [Char]
name = [Char] -> (Text -> IO Text) -> TestNested
withGoldenFileM [Char]
name Text -> IO Text
parseOrError
  where
    parseOrError :: T.Text -> IO T.Text
    parseOrError :: Text -> IO Text
parseOrError =
      let parseTxt :: T.Text -> Either ParserErrorBundle a
          parseTxt :: Text -> Either ParserErrorBundle a
parseTxt Text
txt = QuoteT (Either ParserErrorBundle) a -> Either ParserErrorBundle a
forall (m :: * -> *) a. Monad m => QuoteT m a -> m a
runQuoteT (QuoteT (Either ParserErrorBundle) a -> Either ParserErrorBundle a)
-> QuoteT (Either ParserErrorBundle) a
-> Either ParserErrorBundle a
forall a b. (a -> b) -> a -> b
$ Parser a -> [Char] -> Text -> QuoteT (Either ParserErrorBundle) a
forall e (m :: * -> *) a.
(AsParserErrorBundle e, MonadError e m, MonadQuote m) =>
Parser a -> [Char] -> Text -> m a
parse Parser a
parser [Char]
name Text
txt
       in (ParserErrorBundle -> IO Text)
-> (a -> IO Text) -> Either ParserErrorBundle a -> IO Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text)
-> (ParserErrorBundle -> Text) -> ParserErrorBundle -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserErrorBundle -> Text
forall str a. (Pretty a, Render str) => a -> str
display) ((b -> Text) -> IO b -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Text
forall str a. (Pretty a, Render str) => a -> str
display (IO b -> IO Text) -> (a -> IO b) -> a -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO b
op) (Either ParserErrorBundle a -> IO Text)
-> (Text -> Either ParserErrorBundle a) -> Text -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParserErrorBundle a
parseTxt

goldenPirM :: forall a b. (PrettyPlc b) => (a -> IO b) -> Parser a -> String -> TestNested
goldenPirM :: forall a b.
PrettyPlc b =>
(a -> IO b) -> Parser a -> [Char] -> TestNested
goldenPirM a -> IO b
op Parser a
parser [Char]
name = [Char] -> (Text -> IO Text) -> TestNested
withGoldenFileM [Char]
name Text -> IO Text
parseOrError
  where
    parseOrError :: T.Text -> IO T.Text
    parseOrError :: Text -> IO Text
parseOrError =
      let parseTxt :: T.Text -> Either ParserErrorBundle a
          parseTxt :: Text -> Either ParserErrorBundle a
parseTxt Text
txt = QuoteT (Either ParserErrorBundle) a -> Either ParserErrorBundle a
forall (m :: * -> *) a. Monad m => QuoteT m a -> m a
runQuoteT (QuoteT (Either ParserErrorBundle) a -> Either ParserErrorBundle a)
-> QuoteT (Either ParserErrorBundle) a
-> Either ParserErrorBundle a
forall a b. (a -> b) -> a -> b
$ Parser a -> [Char] -> Text -> QuoteT (Either ParserErrorBundle) a
forall e (m :: * -> *) a.
(AsParserErrorBundle e, MonadError e m, MonadQuote m) =>
Parser a -> [Char] -> Text -> m a
parse Parser a
parser [Char]
name Text
txt
       in (ParserErrorBundle -> IO Text)
-> (a -> IO Text) -> Either ParserErrorBundle a -> IO Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text)
-> (ParserErrorBundle -> Text) -> ParserErrorBundle -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserErrorBundle -> Text
forall str a. (Pretty a, Render str) => a -> str
display) ((Doc Any -> Text
forall ann. Doc ann -> Text
forall str ann. Render str => Doc ann -> str
render (Doc Any -> Text) -> (b -> Doc Any) -> b -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Doc Any
forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcReadableSimple (b -> Text) -> IO b -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO b -> IO Text) -> (a -> IO b) -> a -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO b
op) (Either ParserErrorBundle a -> IO Text)
-> (Text -> Either ParserErrorBundle a) -> Text -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParserErrorBundle a
parseTxt

goldenPirDocM :: forall a ann. (a -> IO (Doc ann)) -> Parser a -> String -> TestNested
goldenPirDocM :: forall a ann.
(a -> IO (Doc ann)) -> Parser a -> [Char] -> TestNested
goldenPirDocM a -> IO (Doc ann)
op Parser a
parser [Char]
name = [Char] -> (Text -> IO Text) -> TestNested
withGoldenFileM [Char]
name Text -> IO Text
parseOrError
  where
    parseOrError :: T.Text -> IO T.Text
    parseOrError :: Text -> IO Text
parseOrError =
      let parseTxt :: T.Text -> Either ParserErrorBundle a
          parseTxt :: Text -> Either ParserErrorBundle a
parseTxt Text
txt = QuoteT (Either ParserErrorBundle) a -> Either ParserErrorBundle a
forall (m :: * -> *) a. Monad m => QuoteT m a -> m a
runQuoteT (QuoteT (Either ParserErrorBundle) a -> Either ParserErrorBundle a)
-> QuoteT (Either ParserErrorBundle) a
-> Either ParserErrorBundle a
forall a b. (a -> b) -> a -> b
$ Parser a -> [Char] -> Text -> QuoteT (Either ParserErrorBundle) a
forall e (m :: * -> *) a.
(AsParserErrorBundle e, MonadError e m, MonadQuote m) =>
Parser a -> [Char] -> Text -> m a
parse Parser a
parser [Char]
name Text
txt
       in (ParserErrorBundle -> IO Text)
-> (a -> IO Text) -> Either ParserErrorBundle a -> IO Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text)
-> (ParserErrorBundle -> Text) -> ParserErrorBundle -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserErrorBundle -> Text
forall str a. (Pretty a, Render str) => a -> str
display) ((Doc ann -> Text) -> IO (Doc ann) -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SimpleDocStream ann -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict (SimpleDocStream ann -> Text)
-> (Doc ann -> SimpleDocStream ann) -> Doc ann -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc ann -> SimpleDocStream ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions) (IO (Doc ann) -> IO Text) -> (a -> IO (Doc ann)) -> a -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO (Doc ann)
op)
            (Either ParserErrorBundle a -> IO Text)
-> (Text -> Either ParserErrorBundle a) -> Text -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParserErrorBundle a
parseTxt

goldenPlcFromPir ::
  (ToTPlc a PLC.DefaultUni PLC.DefaultFun) =>
  Parser a ->
  String ->
  TestNested
goldenPlcFromPir :: forall a.
ToTPlc a DefaultUni DefaultFun =>
Parser a -> [Char] -> TestNested
goldenPlcFromPir = (a -> IO Text) -> Parser a -> [Char] -> TestNested
forall a b.
PrettyPlc b =>
(a -> IO b) -> Parser a -> [Char] -> TestNested
goldenPirM ((a -> IO Text) -> Parser a -> [Char] -> TestNested)
-> (a -> IO Text) -> Parser a -> [Char] -> TestNested
forall a b. (a -> b) -> a -> b
$ \a
ast -> (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ()
 -> Doc Any)
-> ExceptT
     SomeException
     IO
     (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
-> IO Text
forall a ann.
(a -> Doc ann) -> ExceptT SomeException IO a -> IO Text
ppCatch Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ()
-> Doc Any
forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcReadableSimple (ExceptT
   SomeException
   IO
   (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
 -> IO Text)
-> ExceptT
     SomeException
     IO
     (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
-> IO Text
forall a b. (a -> b) -> a -> b
$ do
  Program TyName Name DefaultUni DefaultFun ()
p <- a
-> ExceptT
     SomeException IO (Program TyName Name DefaultUni DefaultFun ())
forall a (uni :: * -> *) fun.
ToTPlc a uni fun =>
a -> ExceptT SomeException IO (Program TyName Name uni fun ())
toTPlc a
ast
  forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT @_ @PLC.FreeVariableError FreeVariableError -> SomeException
forall e. Exception e => e -> SomeException
toException (ExceptT
   FreeVariableError
   IO
   (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
 -> ExceptT
      SomeException
      IO
      (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ()))
-> ExceptT
     FreeVariableError
     IO
     (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
-> ExceptT
     SomeException
     IO
     (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ LensLike
  (ExceptT FreeVariableError IO)
  (Program TyName Name DefaultUni DefaultFun ())
  (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
  (Term TyName Name DefaultUni DefaultFun ())
  (Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
-> LensLike
     (ExceptT FreeVariableError IO)
     (Program TyName Name DefaultUni DefaultFun ())
     (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
     (Term TyName Name DefaultUni DefaultFun ())
     (Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  (ExceptT FreeVariableError IO)
  (Program TyName Name DefaultUni DefaultFun ())
  (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
  (Term TyName Name DefaultUni DefaultFun ())
  (Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
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 ()
-> ExceptT
     FreeVariableError
     IO
     (Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
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 Program TyName Name DefaultUni DefaultFun ()
p

goldenPlcFromPirScott ::
  (Ord a, Typeable a, Pretty a
  , prog ~ PIR.Program PIR.TyName PIR.Name PLC.DefaultUni PLC.DefaultFun a) =>
  Parser prog ->
  String ->
  TestNested
goldenPlcFromPirScott :: forall a prog.
(Ord a, Typeable a, Pretty a,
 prog ~ Program TyName Name DefaultUni DefaultFun a) =>
Parser prog -> [Char] -> TestNested
goldenPlcFromPirScott = (prog -> IO Text) -> Parser prog -> [Char] -> TestNested
forall a b.
PrettyPlc b =>
(a -> IO b) -> Parser a -> [Char] -> TestNested
goldenPirM ((prog -> IO Text) -> Parser prog -> [Char] -> TestNested)
-> (prog -> IO Text) -> Parser prog -> [Char] -> TestNested
forall a b. (a -> b) -> a -> b
$ \prog
ast -> (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ()
 -> Doc Any)
-> ExceptT
     SomeException
     IO
     (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
-> IO Text
forall a ann.
(a -> Doc ann) -> ExceptT SomeException IO a -> IO Text
ppCatch Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ()
-> Doc Any
forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcReadableSimple (ExceptT
   SomeException
   IO
   (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
 -> IO Text)
-> ExceptT
     SomeException
     IO
     (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
-> IO Text
forall a b. (a -> b) -> a -> b
$ do
  Program TyName Name DefaultUni DefaultFun ()
p <-
    Except
  (Error DefaultUni DefaultFun (Provenance a))
  (Program TyName Name DefaultUni DefaultFun ())
-> ExceptT
     SomeException IO (Program TyName Name DefaultUni DefaultFun ())
forall e a. Exception e => Except e a -> ExceptT SomeException IO a
asIfThrown
      (Except
   (Error DefaultUni DefaultFun (Provenance a))
   (Program TyName Name DefaultUni DefaultFun ())
 -> ExceptT
      SomeException IO (Program TyName Name DefaultUni DefaultFun ()))
-> (prog
    -> Except
         (Error DefaultUni DefaultFun (Provenance a))
         (Program TyName Name DefaultUni DefaultFun ()))
-> prog
-> ExceptT
     SomeException IO (Program TyName Name DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Program TyName Name DefaultUni DefaultFun (Provenance a)
 -> Program TyName Name DefaultUni DefaultFun ())
-> ExceptT
     (Error DefaultUni DefaultFun (Provenance a))
     Identity
     (Program TyName Name DefaultUni DefaultFun (Provenance a))
-> Except
     (Error DefaultUni DefaultFun (Provenance a))
     (Program TyName Name DefaultUni DefaultFun ())
forall a b.
(a -> b)
-> ExceptT (Error DefaultUni DefaultFun (Provenance a)) Identity a
-> ExceptT (Error DefaultUni DefaultFun (Provenance a)) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Program TyName Name DefaultUni DefaultFun (Provenance a)
-> Program TyName Name DefaultUni DefaultFun ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      (ExceptT
   (Error DefaultUni DefaultFun (Provenance a))
   Identity
   (Program TyName Name DefaultUni DefaultFun (Provenance a))
 -> Except
      (Error DefaultUni DefaultFun (Provenance a))
      (Program TyName Name DefaultUni DefaultFun ()))
-> (prog
    -> ExceptT
         (Error DefaultUni DefaultFun (Provenance a))
         Identity
         (Program TyName Name DefaultUni DefaultFun (Provenance a)))
-> prog
-> Except
     (Error DefaultUni DefaultFun (Provenance a))
     (Program TyName Name DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompilationCtx DefaultUni DefaultFun a
 -> CompilationCtx DefaultUni DefaultFun a)
-> Program TyName Name DefaultUni DefaultFun a
-> ExceptT
     (Error DefaultUni DefaultFun (Provenance a))
     Identity
     (Program TyName Name DefaultUni DefaultFun (Provenance a))
forall (uni :: * -> *) fun a.
(GEq uni, Typecheckable uni fun, Ord a, PrettyUni uni, Pretty fun,
 Pretty a, Default (BuiltinsInfo uni fun),
 Default (CostingPart uni fun), Default (RewriteRules uni fun)) =>
(CompilationCtx uni fun a -> CompilationCtx uni fun a)
-> Program TyName Name uni fun a
-> Except
     (Error uni fun (Provenance a))
     (Program TyName Name uni fun (Provenance a))
compileWithOpts (ASetter
  (CompilationCtx DefaultUni DefaultFun a)
  (CompilationCtx DefaultUni DefaultFun a)
  DatatypeStyle
  DatatypeStyle
-> DatatypeStyle
-> CompilationCtx DefaultUni DefaultFun a
-> CompilationCtx DefaultUni DefaultFun a
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts a -> Identity (CompilationOpts a))
-> CompilationCtx DefaultUni DefaultFun a
-> Identity (CompilationCtx DefaultUni DefaultFun a)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts a -> Identity (CompilationOpts a))
 -> CompilationCtx DefaultUni DefaultFun a
 -> Identity (CompilationCtx DefaultUni DefaultFun a))
-> ((DatatypeStyle -> Identity DatatypeStyle)
    -> CompilationOpts a -> Identity (CompilationOpts a))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun a)
     (CompilationCtx DefaultUni DefaultFun a)
     DatatypeStyle
     DatatypeStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DatatypeCompilationOpts -> Identity DatatypeCompilationOpts)
-> CompilationOpts a -> Identity (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(DatatypeCompilationOpts -> f DatatypeCompilationOpts)
-> CompilationOpts a -> f (CompilationOpts a)
PIR.coDatatypes ((DatatypeCompilationOpts -> Identity DatatypeCompilationOpts)
 -> CompilationOpts a -> Identity (CompilationOpts a))
-> ((DatatypeStyle -> Identity DatatypeStyle)
    -> DatatypeCompilationOpts -> Identity DatatypeCompilationOpts)
-> (DatatypeStyle -> Identity DatatypeStyle)
-> CompilationOpts a
-> Identity (CompilationOpts a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DatatypeStyle -> Identity DatatypeStyle)
-> DatatypeCompilationOpts -> Identity DatatypeCompilationOpts
Iso' DatatypeCompilationOpts DatatypeStyle
PIR.dcoStyle) DatatypeStyle
ScottEncoding)
      (prog
 -> ExceptT
      SomeException IO (Program TyName Name DefaultUni DefaultFun ()))
-> prog
-> ExceptT
     SomeException IO (Program TyName Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ prog
ast
  forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT @_ @PLC.FreeVariableError FreeVariableError -> SomeException
forall e. Exception e => e -> SomeException
toException (ExceptT
   FreeVariableError
   IO
   (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
 -> ExceptT
      SomeException
      IO
      (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ()))
-> ExceptT
     FreeVariableError
     IO
     (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
-> ExceptT
     SomeException
     IO
     (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ LensLike
  (ExceptT FreeVariableError IO)
  (Program TyName Name DefaultUni DefaultFun ())
  (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
  (Term TyName Name DefaultUni DefaultFun ())
  (Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
-> LensLike
     (ExceptT FreeVariableError IO)
     (Program TyName Name DefaultUni DefaultFun ())
     (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
     (Term TyName Name DefaultUni DefaultFun ())
     (Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  (ExceptT FreeVariableError IO)
  (Program TyName Name DefaultUni DefaultFun ())
  (Program NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
  (Term TyName Name DefaultUni DefaultFun ())
  (Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
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 ()
-> ExceptT
     FreeVariableError
     IO
     (Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun ())
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 Program TyName Name DefaultUni DefaultFun ()
p

goldenNamedUPlcFromPir ::
  (ToUPlc a PLC.DefaultUni PLC.DefaultFun) =>
  Parser a ->
  String ->
  TestNested
goldenNamedUPlcFromPir :: forall a.
ToUPlc a DefaultUni DefaultFun =>
Parser a -> [Char] -> TestNested
goldenNamedUPlcFromPir = (a -> IO Text) -> Parser a -> [Char] -> TestNested
forall a b.
PrettyPlc b =>
(a -> IO b) -> Parser a -> [Char] -> TestNested
goldenPirM ((a -> IO Text) -> Parser a -> [Char] -> TestNested)
-> (a -> IO Text) -> Parser a -> [Char] -> TestNested
forall a b. (a -> b) -> a -> b
$ (Program Name DefaultUni DefaultFun () -> Doc Any)
-> ExceptT SomeException IO (Program Name DefaultUni DefaultFun ())
-> IO Text
forall a ann.
(a -> Doc ann) -> ExceptT SomeException IO a -> IO Text
ppCatch Program Name DefaultUni DefaultFun () -> Doc Any
forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcReadableSimple (ExceptT SomeException IO (Program Name DefaultUni DefaultFun ())
 -> IO Text)
-> (a
    -> ExceptT
         SomeException IO (Program Name DefaultUni DefaultFun ()))
-> a
-> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a
-> ExceptT SomeException IO (Program Name DefaultUni DefaultFun ())
forall a (uni :: * -> *) fun.
ToUPlc a uni fun =>
a -> ExceptT SomeException IO (Program Name uni fun ())
toUPlc

goldenEvalPir ::
  (ToUPlc a PLC.DefaultUni PLC.DefaultFun) =>
  Parser a ->
  String ->
  TestNested
goldenEvalPir :: forall a.
ToUPlc a DefaultUni DefaultFun =>
Parser a -> [Char] -> TestNested
goldenEvalPir = (a -> IO Text) -> Parser a -> [Char] -> TestNested
forall a b.
PrettyPlc b =>
(a -> IO b) -> Parser a -> [Char] -> TestNested
goldenPirM (\a
ast -> (Term Name DefaultUni DefaultFun () -> Doc Any)
-> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
-> IO Text
forall a ann.
(a -> Doc ann) -> ExceptT SomeException IO a -> IO Text
ppCatch Term Name DefaultUni DefaultFun () -> Doc Any
forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcReadableSimple (ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
 -> IO Text)
-> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
-> IO Text
forall a b. (a -> b) -> a -> b
$ [a]
-> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
forall a.
ToUPlc a DefaultUni DefaultFun =>
[a]
-> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
runUPlc [a
ast])

goldenTypeFromPir ::
  forall a.
  (Pretty a, Typeable a) =>
  a ->
  Parser (Term PIR.TyName PIR.Name PLC.DefaultUni PLC.DefaultFun a) ->
  String ->
  TestNested
goldenTypeFromPir :: forall a.
(Pretty a, Typeable a) =>
a
-> Parser (Term TyName Name DefaultUni DefaultFun a)
-> [Char]
-> TestNested
goldenTypeFromPir a
x =
  (Term TyName Name DefaultUni DefaultFun a -> IO Text)
-> Parser (Term TyName Name DefaultUni DefaultFun a)
-> [Char]
-> TestNested
forall a b.
PrettyPlc b =>
(a -> IO b) -> Parser a -> [Char] -> TestNested
goldenPirM ((Term TyName Name DefaultUni DefaultFun a -> IO Text)
 -> Parser (Term TyName Name DefaultUni DefaultFun a)
 -> [Char]
 -> TestNested)
-> (Term TyName Name DefaultUni DefaultFun a -> IO Text)
-> Parser (Term TyName Name DefaultUni DefaultFun a)
-> [Char]
-> TestNested
forall a b. (a -> b) -> a -> b
$ \Term TyName Name DefaultUni DefaultFun a
ast -> (Normalized (Type TyName DefaultUni ()) -> Doc Any)
-> ExceptT
     SomeException IO (Normalized (Type TyName DefaultUni ()))
-> IO Text
forall a ann.
(a -> Doc ann) -> ExceptT SomeException IO a -> IO Text
ppCatch Normalized (Type TyName DefaultUni ()) -> Doc Any
forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcReadable (ExceptT SomeException IO (Normalized (Type TyName DefaultUni ()))
 -> IO Text)
-> ExceptT
     SomeException IO (Normalized (Type TyName DefaultUni ()))
-> IO Text
forall a b. (a -> b) -> a -> b
$
    (Error DefaultUni DefaultFun a -> SomeException)
-> ExceptT
     (Error DefaultUni DefaultFun a)
     IO
     (Normalized (Type TyName DefaultUni ()))
-> ExceptT
     SomeException IO (Normalized (Type TyName DefaultUni ()))
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT (Error DefaultUni DefaultFun a -> SomeException
forall e. Exception e => e -> SomeException
toException :: PIR.Error PLC.DefaultUni PLC.DefaultFun a -> SomeException) (ExceptT
   (Error DefaultUni DefaultFun a)
   IO
   (Normalized (Type TyName DefaultUni ()))
 -> ExceptT
      SomeException IO (Normalized (Type TyName DefaultUni ())))
-> ExceptT
     (Error DefaultUni DefaultFun a)
     IO
     (Normalized (Type TyName DefaultUni ()))
-> ExceptT
     SomeException IO (Normalized (Type TyName DefaultUni ()))
forall a b. (a -> b) -> a -> b
$
      QuoteT
  (ExceptT (Error DefaultUni DefaultFun a) IO)
  (Normalized (Type TyName DefaultUni ()))
-> ExceptT
     (Error DefaultUni DefaultFun a)
     IO
     (Normalized (Type TyName DefaultUni ()))
forall (m :: * -> *) a. Monad m => QuoteT m a -> m a
runQuoteT (QuoteT
   (ExceptT (Error DefaultUni DefaultFun a) IO)
   (Normalized (Type TyName DefaultUni ()))
 -> ExceptT
      (Error DefaultUni DefaultFun a)
      IO
      (Normalized (Type TyName DefaultUni ())))
-> QuoteT
     (ExceptT (Error DefaultUni DefaultFun a) IO)
     (Normalized (Type TyName DefaultUni ()))
-> ExceptT
     (Error DefaultUni DefaultFun a)
     IO
     (Normalized (Type TyName DefaultUni ()))
forall a b. (a -> b) -> a -> b
$ do
        PirTCConfig DefaultUni DefaultFun
tcConfig <- a
-> QuoteT
     (ExceptT (Error DefaultUni DefaultFun a) IO)
     (PirTCConfig DefaultUni DefaultFun)
forall err term (uni :: * -> *) fun ann (m :: * -> *).
(MonadKindCheck err term uni fun ann m, Typecheckable uni fun) =>
ann -> m (PirTCConfig uni fun)
getDefTypeCheckConfig a
x
        PirTCConfig DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun a
-> QuoteT
     (ExceptT (Error DefaultUni DefaultFun a) IO)
     (Normalized (Type TyName DefaultUni ()))
forall err (uni :: * -> *) fun ann (m :: * -> *).
MonadTypeCheckPir err uni fun ann m =>
PirTCConfig uni fun
-> Term TyName Name uni fun ann
-> m (Normalized (Type TyName uni ()))
inferType PirTCConfig DefaultUni DefaultFun
tcConfig Term TyName Name DefaultUni DefaultFun a
ast