-- editorconfig-checker-disable-file
-- | The exceptions that an abstract machine can throw.

-- appears in the generated instances
{-# OPTIONS_GHC -Wno-overlapping-patterns #-}

{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE DeriveAnyClass         #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings      #-}
{-# LANGUAGE TemplateHaskell        #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeOperators          #-}
{-# LANGUAGE UndecidableInstances   #-}

module PlutusCore.Evaluation.Error
    ( EvaluationError (..)
    , AsEvaluationError (..)
    ) where

import PlutusPrelude

import PlutusCore.Evaluation.Result

import Control.Lens
import Data.Bifoldable
import Data.Bitraversable

{- | The type of errors that can occur during evaluation. There are two kinds of errors:

1. Structural ones -- these are errors that are indicative of the _structure_ of the program being
   wrong. For example, a free variable was encountered during evaluation, a non-function was
   applied to an argument or 'tailList' was applied to a non-list.
2. Operational ones -- these are errors that are indicative of the _logic_ of the program being
   wrong. For example, 'error' was executed, 'tailList' was applied to an empty list or evaluation
   ran out of gas.

On the chain both of these are just regular failures and we don't distinguish between them there:
if a script fails, it fails, it doesn't matter what the reason was. However in the tests it does
matter why the failure occurred: a structural error may indicate that the test was written
incorrectly while an operational error may be entirely expected.

In other words, structural errors are \"runtime type errors\" and operational errors are regular
runtime errors. Which means that evaluating an (erased) well-typed program should never produce a
structural error, only an operational one. This creates a sort of \"runtime type system\" for UPLC
and it would be great to stick to it and enforce in tests etc, but we currently don't.
-}
data EvaluationError structural operational
    = StructuralEvaluationError !structural
    | OperationalEvaluationError !operational
    deriving stock (Int -> EvaluationError structural operational -> ShowS
[EvaluationError structural operational] -> ShowS
EvaluationError structural operational -> String
(Int -> EvaluationError structural operational -> ShowS)
-> (EvaluationError structural operational -> String)
-> ([EvaluationError structural operational] -> ShowS)
-> Show (EvaluationError structural operational)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall structural operational.
(Show structural, Show operational) =>
Int -> EvaluationError structural operational -> ShowS
forall structural operational.
(Show structural, Show operational) =>
[EvaluationError structural operational] -> ShowS
forall structural operational.
(Show structural, Show operational) =>
EvaluationError structural operational -> String
$cshowsPrec :: forall structural operational.
(Show structural, Show operational) =>
Int -> EvaluationError structural operational -> ShowS
showsPrec :: Int -> EvaluationError structural operational -> ShowS
$cshow :: forall structural operational.
(Show structural, Show operational) =>
EvaluationError structural operational -> String
show :: EvaluationError structural operational -> String
$cshowList :: forall structural operational.
(Show structural, Show operational) =>
[EvaluationError structural operational] -> ShowS
showList :: [EvaluationError structural operational] -> ShowS
Show, EvaluationError structural operational
-> EvaluationError structural operational -> Bool
(EvaluationError structural operational
 -> EvaluationError structural operational -> Bool)
-> (EvaluationError structural operational
    -> EvaluationError structural operational -> Bool)
-> Eq (EvaluationError structural operational)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall structural operational.
(Eq structural, Eq operational) =>
EvaluationError structural operational
-> EvaluationError structural operational -> Bool
$c== :: forall structural operational.
(Eq structural, Eq operational) =>
EvaluationError structural operational
-> EvaluationError structural operational -> Bool
== :: EvaluationError structural operational
-> EvaluationError structural operational -> Bool
$c/= :: forall structural operational.
(Eq structural, Eq operational) =>
EvaluationError structural operational
-> EvaluationError structural operational -> Bool
/= :: EvaluationError structural operational
-> EvaluationError structural operational -> Bool
Eq, (forall a b.
 (a -> b)
 -> EvaluationError structural a -> EvaluationError structural b)
-> (forall a b.
    a -> EvaluationError structural b -> EvaluationError structural a)
-> Functor (EvaluationError structural)
forall a b.
a -> EvaluationError structural b -> EvaluationError structural a
forall a b.
(a -> b)
-> EvaluationError structural a -> EvaluationError structural b
forall structural a b.
a -> EvaluationError structural b -> EvaluationError structural a
forall structural a b.
(a -> b)
-> EvaluationError structural a -> EvaluationError structural b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall structural a b.
(a -> b)
-> EvaluationError structural a -> EvaluationError structural b
fmap :: forall a b.
(a -> b)
-> EvaluationError structural a -> EvaluationError structural b
$c<$ :: forall structural a b.
a -> EvaluationError structural b -> EvaluationError structural a
<$ :: forall a b.
a -> EvaluationError structural b -> EvaluationError structural a
Functor, (forall x.
 EvaluationError structural operational
 -> Rep (EvaluationError structural operational) x)
-> (forall x.
    Rep (EvaluationError structural operational) x
    -> EvaluationError structural operational)
-> Generic (EvaluationError structural operational)
forall x.
Rep (EvaluationError structural operational) x
-> EvaluationError structural operational
forall x.
EvaluationError structural operational
-> Rep (EvaluationError structural operational) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall structural operational x.
Rep (EvaluationError structural operational) x
-> EvaluationError structural operational
forall structural operational x.
EvaluationError structural operational
-> Rep (EvaluationError structural operational) x
$cfrom :: forall structural operational x.
EvaluationError structural operational
-> Rep (EvaluationError structural operational) x
from :: forall x.
EvaluationError structural operational
-> Rep (EvaluationError structural operational) x
$cto :: forall structural operational x.
Rep (EvaluationError structural operational) x
-> EvaluationError structural operational
to :: forall x.
Rep (EvaluationError structural operational) x
-> EvaluationError structural operational
Generic)
    deriving anyclass (EvaluationError structural operational -> ()
(EvaluationError structural operational -> ())
-> NFData (EvaluationError structural operational)
forall a. (a -> ()) -> NFData a
forall structural operational.
(NFData structural, NFData operational) =>
EvaluationError structural operational -> ()
$crnf :: forall structural operational.
(NFData structural, NFData operational) =>
EvaluationError structural operational -> ()
rnf :: EvaluationError structural operational -> ()
NFData)

mtraverse makeClassyPrisms
    [ ''EvaluationError
    ]

instance Bifunctor EvaluationError where
    bimap :: forall a b c d.
(a -> b) -> (c -> d) -> EvaluationError a c -> EvaluationError b d
bimap a -> b
f c -> d
_ (StructuralEvaluationError a
err)  = b -> EvaluationError b d
forall structural operational.
structural -> EvaluationError structural operational
StructuralEvaluationError (b -> EvaluationError b d) -> b -> EvaluationError b d
forall a b. (a -> b) -> a -> b
$ a -> b
f a
err
    bimap a -> b
_ c -> d
g (OperationalEvaluationError c
err) = d -> EvaluationError b d
forall structural operational.
operational -> EvaluationError structural operational
OperationalEvaluationError (d -> EvaluationError b d) -> d -> EvaluationError b d
forall a b. (a -> b) -> a -> b
$ c -> d
g c
err
    {-# INLINE bimap #-}

instance Bifoldable EvaluationError where
    bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> EvaluationError a b -> m
bifoldMap a -> m
f b -> m
_ (StructuralEvaluationError a
err)  = a -> m
f a
err
    bifoldMap a -> m
_ b -> m
g (OperationalEvaluationError b
err) = b -> m
g b
err
    {-# INLINE bifoldMap #-}

instance Bitraversable EvaluationError where
    bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> EvaluationError a b -> f (EvaluationError c d)
bitraverse a -> f c
f b -> f d
_ (StructuralEvaluationError a
err)  = c -> EvaluationError c d
forall structural operational.
structural -> EvaluationError structural operational
StructuralEvaluationError (c -> EvaluationError c d) -> f c -> f (EvaluationError c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
err
    bitraverse a -> f c
_ b -> f d
g (OperationalEvaluationError b
err) = d -> EvaluationError c d
forall structural operational.
operational -> EvaluationError structural operational
OperationalEvaluationError (d -> EvaluationError c d) -> f d -> f (EvaluationError c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
err
    {-# INLINE bitraverse #-}

-- | A raw evaluation failure is always an operational error.
instance AsEvaluationFailure operational =>
        AsEvaluationFailure (EvaluationError structural operational) where
    _EvaluationFailure :: Prism' (EvaluationError structural operational) ()
_EvaluationFailure = p operational (f operational)
-> p (EvaluationError structural operational)
     (f (EvaluationError structural operational))
forall r structural operational.
AsEvaluationError r structural operational =>
Prism' r operational
Prism' (EvaluationError structural operational) operational
_OperationalEvaluationError (p operational (f operational)
 -> p (EvaluationError structural operational)
      (f (EvaluationError structural operational)))
-> (p () (f ()) -> p operational (f operational))
-> p () (f ())
-> p (EvaluationError structural operational)
     (f (EvaluationError structural operational))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p operational (f operational)
forall err. AsEvaluationFailure err => Prism' err ()
Prism' operational ()
_EvaluationFailure
    {-# INLINE _EvaluationFailure #-}

instance
        ( HasPrettyDefaults config ~ 'True
        , PrettyBy config structural, Pretty operational
        ) => PrettyBy config (EvaluationError structural operational) where
    prettyBy :: forall ann.
config -> EvaluationError structural operational -> Doc ann
prettyBy config
config (StructuralEvaluationError structural
structural)   = config -> structural -> Doc ann
forall ann. config -> structural -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy config
config structural
structural
    prettyBy config
_      (OperationalEvaluationError operational
operational) = operational -> Doc ann
forall ann. operational -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty operational
operational

instance (Pretty structural, Pretty operational) =>
        Pretty (EvaluationError structural operational) where
    pretty :: forall ann. EvaluationError structural operational -> Doc ann
pretty (StructuralEvaluationError structural
structural)   = structural -> Doc ann
forall ann. structural -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty structural
structural
    pretty (OperationalEvaluationError operational
operational) = operational -> Doc ann
forall ann. operational -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty operational
operational