{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module PlutusTx.Test.Orphans where

import Prelude

import Flat (Flat)
import PlutusCore qualified as PLC
import PlutusCore.Builtin qualified as PLC
import PlutusCore.Pretty (Pretty, PrettyConst)
import PlutusCore.Pretty qualified as PLC
import PlutusCore.Test (ToTPlc (..), ToUPlc (..), catchAll)
import PlutusIR.Analysis.Builtins qualified as PIR
import PlutusIR.Test ()
import PlutusIR.Transform.RewriteRules qualified as PIR
import PlutusPrelude (Default)
import PlutusTx.Code (CompiledCodeIn, getPir, getPlcNoAnn)
import Test.Tasty.Extras ()

instance
  (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun)
  => ToUPlc (CompiledCodeIn uni fun a) uni fun
  where
  toUPlc :: CompiledCodeIn uni fun a
-> ExceptT SomeException IO (Program Name uni fun ())
toUPlc CompiledCodeIn uni fun a
compiledCode = Program NamedDeBruijn 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 (Program NamedDeBruijn uni fun ()
 -> ExceptT SomeException IO (Program Name uni fun ()))
-> ExceptT SomeException IO (Program NamedDeBruijn uni fun ())
-> ExceptT SomeException IO (Program Name uni fun ())
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Program NamedDeBruijn uni fun ()
-> ExceptT SomeException IO (Program NamedDeBruijn uni fun ())
forall a. a -> ExceptT SomeException IO a
catchAll (CompiledCodeIn uni fun a -> Program NamedDeBruijn uni fun ()
forall (uni :: * -> *) fun a.
(Closed uni, Everywhere uni Flat, Flat fun) =>
CompiledCodeIn uni fun a -> Program NamedDeBruijn uni fun ()
getPlcNoAnn CompiledCodeIn uni fun a
compiledCode)

instance
  ( PLC.PrettyParens (PLC.SomeTypeIn uni)
  , PLC.GEq uni
  , PLC.Typecheckable uni fun
  , PLC.Closed uni
  , uni `PLC.Everywhere` PrettyConst
  , Pretty fun
  , uni `PLC.Everywhere` Flat
  , Flat fun
  , Default (PLC.CostingPart uni fun)
  , Default (PIR.BuiltinsInfo uni fun)
  , Default (PIR.RewriteRules uni fun)
  )
  => ToTPlc (CompiledCodeIn uni fun a) uni fun
  where
  toTPlc :: CompiledCodeIn uni fun a
-> ExceptT SomeException IO (Program TyName Name uni fun ())
toTPlc CompiledCodeIn uni fun a
compiledCode =
    Maybe (Program TyName Name uni fun SrcSpans)
-> ExceptT
     SomeException IO (Maybe (Program TyName Name uni fun SrcSpans))
forall a. a -> ExceptT SomeException IO a
catchAll (CompiledCodeIn uni fun a
-> Maybe (Program TyName Name uni fun SrcSpans)
forall (uni :: * -> *) fun a.
(Closed uni, Everywhere uni Flat, Flat fun) =>
CompiledCodeIn uni fun a
-> Maybe (Program TyName Name uni fun SrcSpans)
getPir CompiledCodeIn uni fun a
compiledCode) ExceptT
  SomeException IO (Maybe (Program TyName Name uni fun SrcSpans))
-> (Maybe (Program TyName Name uni fun SrcSpans)
    -> ExceptT SomeException IO (Program TyName Name uni fun ()))
-> ExceptT SomeException IO (Program TyName Name uni fun ())
forall a b.
ExceptT SomeException IO a
-> (a -> ExceptT SomeException IO b) -> ExceptT SomeException IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe (Program TyName Name uni fun SrcSpans)
Nothing -> String -> ExceptT SomeException IO (Program TyName Name uni fun ())
forall a. String -> ExceptT SomeException IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No PIR available"
      Just Program TyName Name uni fun SrcSpans
program -> Program TyName Name uni fun SrcSpans
-> 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 SrcSpans
program