{-# 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
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 #-}
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