-- 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. 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.
2. 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.

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, operational errors are regular runtime errors and structural errors are \"runtime
type 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. For example,
a built-in function expecting a list but getting something else should throw a structural error,
but currently it'll throw an operational one. This is something that we plan to improve upon in
future.
-}
data EvaluationError operational structural
    = OperationalEvaluationError !operational
    | StructuralEvaluationError !structural
    deriving stock (Int -> EvaluationError operational structural -> ShowS
[EvaluationError operational structural] -> ShowS
EvaluationError operational structural -> String
(Int -> EvaluationError operational structural -> ShowS)
-> (EvaluationError operational structural -> String)
-> ([EvaluationError operational structural] -> ShowS)
-> Show (EvaluationError operational structural)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall operational structural.
(Show operational, Show structural) =>
Int -> EvaluationError operational structural -> ShowS
forall operational structural.
(Show operational, Show structural) =>
[EvaluationError operational structural] -> ShowS
forall operational structural.
(Show operational, Show structural) =>
EvaluationError operational structural -> String
$cshowsPrec :: forall operational structural.
(Show operational, Show structural) =>
Int -> EvaluationError operational structural -> ShowS
showsPrec :: Int -> EvaluationError operational structural -> ShowS
$cshow :: forall operational structural.
(Show operational, Show structural) =>
EvaluationError operational structural -> String
show :: EvaluationError operational structural -> String
$cshowList :: forall operational structural.
(Show operational, Show structural) =>
[EvaluationError operational structural] -> ShowS
showList :: [EvaluationError operational structural] -> ShowS
Show, EvaluationError operational structural
-> EvaluationError operational structural -> Bool
(EvaluationError operational structural
 -> EvaluationError operational structural -> Bool)
-> (EvaluationError operational structural
    -> EvaluationError operational structural -> Bool)
-> Eq (EvaluationError operational structural)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall operational structural.
(Eq operational, Eq structural) =>
EvaluationError operational structural
-> EvaluationError operational structural -> Bool
$c== :: forall operational structural.
(Eq operational, Eq structural) =>
EvaluationError operational structural
-> EvaluationError operational structural -> Bool
== :: EvaluationError operational structural
-> EvaluationError operational structural -> Bool
$c/= :: forall operational structural.
(Eq operational, Eq structural) =>
EvaluationError operational structural
-> EvaluationError operational structural -> Bool
/= :: EvaluationError operational structural
-> EvaluationError operational structural -> Bool
Eq, (forall a b.
 (a -> b)
 -> EvaluationError operational a -> EvaluationError operational b)
-> (forall a b.
    a
    -> EvaluationError operational b -> EvaluationError operational a)
-> Functor (EvaluationError operational)
forall a b.
a -> EvaluationError operational b -> EvaluationError operational a
forall a b.
(a -> b)
-> EvaluationError operational a -> EvaluationError operational b
forall operational a b.
a -> EvaluationError operational b -> EvaluationError operational a
forall operational a b.
(a -> b)
-> EvaluationError operational a -> EvaluationError operational b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall operational a b.
(a -> b)
-> EvaluationError operational a -> EvaluationError operational b
fmap :: forall a b.
(a -> b)
-> EvaluationError operational a -> EvaluationError operational b
$c<$ :: forall operational a b.
a -> EvaluationError operational b -> EvaluationError operational a
<$ :: forall a b.
a -> EvaluationError operational b -> EvaluationError operational a
Functor, (forall x.
 EvaluationError operational structural
 -> Rep (EvaluationError operational structural) x)
-> (forall x.
    Rep (EvaluationError operational structural) x
    -> EvaluationError operational structural)
-> Generic (EvaluationError operational structural)
forall x.
Rep (EvaluationError operational structural) x
-> EvaluationError operational structural
forall x.
EvaluationError operational structural
-> Rep (EvaluationError operational structural) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall operational structural x.
Rep (EvaluationError operational structural) x
-> EvaluationError operational structural
forall operational structural x.
EvaluationError operational structural
-> Rep (EvaluationError operational structural) x
$cfrom :: forall operational structural x.
EvaluationError operational structural
-> Rep (EvaluationError operational structural) x
from :: forall x.
EvaluationError operational structural
-> Rep (EvaluationError operational structural) x
$cto :: forall operational structural x.
Rep (EvaluationError operational structural) x
-> EvaluationError operational structural
to :: forall x.
Rep (EvaluationError operational structural) x
-> EvaluationError operational structural
Generic)
    deriving anyclass (EvaluationError operational structural -> ()
(EvaluationError operational structural -> ())
-> NFData (EvaluationError operational structural)
forall a. (a -> ()) -> NFData a
forall operational structural.
(NFData operational, NFData structural) =>
EvaluationError operational structural -> ()
$crnf :: forall operational structural.
(NFData operational, NFData structural) =>
EvaluationError operational structural -> ()
rnf :: EvaluationError operational structural -> ()
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
_ (OperationalEvaluationError a
err) = b -> EvaluationError b d
forall operational structural.
operational -> EvaluationError operational structural
OperationalEvaluationError (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 (StructuralEvaluationError c
err)  = d -> EvaluationError b d
forall operational structural.
structural -> EvaluationError operational structural
StructuralEvaluationError (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
_ (OperationalEvaluationError a
err) = a -> m
f a
err
    bifoldMap a -> m
_ b -> m
g (StructuralEvaluationError 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
_ (OperationalEvaluationError a
err) = c -> EvaluationError c d
forall operational structural.
operational -> EvaluationError operational structural
OperationalEvaluationError (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 (StructuralEvaluationError b
err)  = d -> EvaluationError c d
forall operational structural.
structural -> EvaluationError operational structural
StructuralEvaluationError (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 operational structural) where
    _EvaluationFailure :: Prism' (EvaluationError operational structural) ()
_EvaluationFailure = p operational (f operational)
-> p (EvaluationError operational structural)
     (f (EvaluationError operational structural))
forall r operational structural.
AsEvaluationError r operational structural =>
Prism' r operational
Prism' (EvaluationError operational structural) operational
_OperationalEvaluationError (p operational (f operational)
 -> p (EvaluationError operational structural)
      (f (EvaluationError operational structural)))
-> (p () (f ()) -> p operational (f operational))
-> p () (f ())
-> p (EvaluationError operational structural)
     (f (EvaluationError operational structural))
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
        , Pretty operational, PrettyBy config structural
        ) => PrettyBy config (EvaluationError operational structural) where
    prettyBy :: forall ann.
config -> EvaluationError operational structural -> Doc ann
prettyBy config
_      (OperationalEvaluationError operational
operational) = operational -> Doc ann
forall ann. operational -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty operational
operational
    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

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