{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module PlutusCore.Builtin.Result
( EvaluationError (..)
, AsEvaluationError (..)
, UnliftingError (..)
, UnliftingEvaluationError (..)
, BuiltinError (..)
, BuiltinResult (..)
, AsUnliftingEvaluationError (..)
, AsUnliftingError (..)
, AsBuiltinError (..)
, AsBuiltinResult (..)
, _UnliftingErrorVia
, _StructuralUnliftingError
, _OperationalUnliftingError
, throwNotAConstant
, throwUnderTypeError
, emit
, withLogs
, throwing
, throwing_
) where
import PlutusPrelude
import PlutusCore.Evaluation.Error
import PlutusCore.Evaluation.Result
import Control.Lens
import Control.Monad.Error.Lens (throwing, throwing_)
import Control.Monad.Except
import Data.Bitraversable
import Data.DList (DList)
import Data.String (IsString)
import Data.Text (Text)
import Data.Text qualified as Text
import Prettyprinter
newtype UnliftingError = MkUnliftingError
{ UnliftingError -> Text
unUnliftingError :: Text
} deriving stock (Int -> UnliftingError -> ShowS
[UnliftingError] -> ShowS
UnliftingError -> String
(Int -> UnliftingError -> ShowS)
-> (UnliftingError -> String)
-> ([UnliftingError] -> ShowS)
-> Show UnliftingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnliftingError -> ShowS
showsPrec :: Int -> UnliftingError -> ShowS
$cshow :: UnliftingError -> String
show :: UnliftingError -> String
$cshowList :: [UnliftingError] -> ShowS
showList :: [UnliftingError] -> ShowS
Show, UnliftingError -> UnliftingError -> Bool
(UnliftingError -> UnliftingError -> Bool)
-> (UnliftingError -> UnliftingError -> Bool) -> Eq UnliftingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnliftingError -> UnliftingError -> Bool
== :: UnliftingError -> UnliftingError -> Bool
$c/= :: UnliftingError -> UnliftingError -> Bool
/= :: UnliftingError -> UnliftingError -> Bool
Eq)
deriving newtype (String -> UnliftingError
(String -> UnliftingError) -> IsString UnliftingError
forall a. (String -> a) -> IsString a
$cfromString :: String -> UnliftingError
fromString :: String -> UnliftingError
IsString, NonEmpty UnliftingError -> UnliftingError
UnliftingError -> UnliftingError -> UnliftingError
(UnliftingError -> UnliftingError -> UnliftingError)
-> (NonEmpty UnliftingError -> UnliftingError)
-> (forall b. Integral b => b -> UnliftingError -> UnliftingError)
-> Semigroup UnliftingError
forall b. Integral b => b -> UnliftingError -> UnliftingError
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: UnliftingError -> UnliftingError -> UnliftingError
<> :: UnliftingError -> UnliftingError -> UnliftingError
$csconcat :: NonEmpty UnliftingError -> UnliftingError
sconcat :: NonEmpty UnliftingError -> UnliftingError
$cstimes :: forall b. Integral b => b -> UnliftingError -> UnliftingError
stimes :: forall b. Integral b => b -> UnliftingError -> UnliftingError
Semigroup, Semigroup UnliftingError
UnliftingError
Semigroup UnliftingError =>
UnliftingError
-> (UnliftingError -> UnliftingError -> UnliftingError)
-> ([UnliftingError] -> UnliftingError)
-> Monoid UnliftingError
[UnliftingError] -> UnliftingError
UnliftingError -> UnliftingError -> UnliftingError
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: UnliftingError
mempty :: UnliftingError
$cmappend :: UnliftingError -> UnliftingError -> UnliftingError
mappend :: UnliftingError -> UnliftingError -> UnliftingError
$cmconcat :: [UnliftingError] -> UnliftingError
mconcat :: [UnliftingError] -> UnliftingError
Monoid, UnliftingError -> ()
(UnliftingError -> ()) -> NFData UnliftingError
forall a. (a -> ()) -> NFData a
$crnf :: UnliftingError -> ()
rnf :: UnliftingError -> ()
NFData)
newtype UnliftingEvaluationError = MkUnliftingEvaluationError
{ UnliftingEvaluationError
-> EvaluationError UnliftingError UnliftingError
unUnliftingEvaluationError :: EvaluationError UnliftingError UnliftingError
} deriving stock (Int -> UnliftingEvaluationError -> ShowS
[UnliftingEvaluationError] -> ShowS
UnliftingEvaluationError -> String
(Int -> UnliftingEvaluationError -> ShowS)
-> (UnliftingEvaluationError -> String)
-> ([UnliftingEvaluationError] -> ShowS)
-> Show UnliftingEvaluationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnliftingEvaluationError -> ShowS
showsPrec :: Int -> UnliftingEvaluationError -> ShowS
$cshow :: UnliftingEvaluationError -> String
show :: UnliftingEvaluationError -> String
$cshowList :: [UnliftingEvaluationError] -> ShowS
showList :: [UnliftingEvaluationError] -> ShowS
Show, UnliftingEvaluationError -> UnliftingEvaluationError -> Bool
(UnliftingEvaluationError -> UnliftingEvaluationError -> Bool)
-> (UnliftingEvaluationError -> UnliftingEvaluationError -> Bool)
-> Eq UnliftingEvaluationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnliftingEvaluationError -> UnliftingEvaluationError -> Bool
== :: UnliftingEvaluationError -> UnliftingEvaluationError -> Bool
$c/= :: UnliftingEvaluationError -> UnliftingEvaluationError -> Bool
/= :: UnliftingEvaluationError -> UnliftingEvaluationError -> Bool
Eq)
deriving newtype (UnliftingEvaluationError -> ()
(UnliftingEvaluationError -> ()) -> NFData UnliftingEvaluationError
forall a. (a -> ()) -> NFData a
$crnf :: UnliftingEvaluationError -> ()
rnf :: UnliftingEvaluationError -> ()
NFData)
data BuiltinError
= BuiltinUnliftingEvaluationError UnliftingEvaluationError
| BuiltinEvaluationFailure
deriving stock (Int -> BuiltinError -> ShowS
[BuiltinError] -> ShowS
BuiltinError -> String
(Int -> BuiltinError -> ShowS)
-> (BuiltinError -> String)
-> ([BuiltinError] -> ShowS)
-> Show BuiltinError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuiltinError -> ShowS
showsPrec :: Int -> BuiltinError -> ShowS
$cshow :: BuiltinError -> String
show :: BuiltinError -> String
$cshowList :: [BuiltinError] -> ShowS
showList :: [BuiltinError] -> ShowS
Show, BuiltinError -> BuiltinError -> Bool
(BuiltinError -> BuiltinError -> Bool)
-> (BuiltinError -> BuiltinError -> Bool) -> Eq BuiltinError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuiltinError -> BuiltinError -> Bool
== :: BuiltinError -> BuiltinError -> Bool
$c/= :: BuiltinError -> BuiltinError -> Bool
/= :: BuiltinError -> BuiltinError -> Bool
Eq)
data BuiltinResult a
=
BuiltinSuccess a
| BuiltinSuccessWithLogs (DList Text) a
| BuiltinFailure (DList Text) BuiltinError
deriving stock (Int -> BuiltinResult a -> ShowS
[BuiltinResult a] -> ShowS
BuiltinResult a -> String
(Int -> BuiltinResult a -> ShowS)
-> (BuiltinResult a -> String)
-> ([BuiltinResult a] -> ShowS)
-> Show (BuiltinResult a)
forall a. Show a => Int -> BuiltinResult a -> ShowS
forall a. Show a => [BuiltinResult a] -> ShowS
forall a. Show a => BuiltinResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> BuiltinResult a -> ShowS
showsPrec :: Int -> BuiltinResult a -> ShowS
$cshow :: forall a. Show a => BuiltinResult a -> String
show :: BuiltinResult a -> String
$cshowList :: forall a. Show a => [BuiltinResult a] -> ShowS
showList :: [BuiltinResult a] -> ShowS
Show, (forall m. Monoid m => BuiltinResult m -> m)
-> (forall m a. Monoid m => (a -> m) -> BuiltinResult a -> m)
-> (forall m a. Monoid m => (a -> m) -> BuiltinResult a -> m)
-> (forall a b. (a -> b -> b) -> b -> BuiltinResult a -> b)
-> (forall a b. (a -> b -> b) -> b -> BuiltinResult a -> b)
-> (forall b a. (b -> a -> b) -> b -> BuiltinResult a -> b)
-> (forall b a. (b -> a -> b) -> b -> BuiltinResult a -> b)
-> (forall a. (a -> a -> a) -> BuiltinResult a -> a)
-> (forall a. (a -> a -> a) -> BuiltinResult a -> a)
-> (forall a. BuiltinResult a -> [a])
-> (forall a. BuiltinResult a -> Bool)
-> (forall a. BuiltinResult a -> Int)
-> (forall a. Eq a => a -> BuiltinResult a -> Bool)
-> (forall a. Ord a => BuiltinResult a -> a)
-> (forall a. Ord a => BuiltinResult a -> a)
-> (forall a. Num a => BuiltinResult a -> a)
-> (forall a. Num a => BuiltinResult a -> a)
-> Foldable BuiltinResult
forall a. Eq a => a -> BuiltinResult a -> Bool
forall a. Num a => BuiltinResult a -> a
forall a. Ord a => BuiltinResult a -> a
forall m. Monoid m => BuiltinResult m -> m
forall a. BuiltinResult a -> Bool
forall a. BuiltinResult a -> Int
forall a. BuiltinResult a -> [a]
forall a. (a -> a -> a) -> BuiltinResult a -> a
forall m a. Monoid m => (a -> m) -> BuiltinResult a -> m
forall b a. (b -> a -> b) -> b -> BuiltinResult a -> b
forall a b. (a -> b -> b) -> b -> BuiltinResult a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => BuiltinResult m -> m
fold :: forall m. Monoid m => BuiltinResult m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> BuiltinResult a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> BuiltinResult a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> BuiltinResult a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> BuiltinResult a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> BuiltinResult a -> b
foldr :: forall a b. (a -> b -> b) -> b -> BuiltinResult a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> BuiltinResult a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> BuiltinResult a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> BuiltinResult a -> b
foldl :: forall b a. (b -> a -> b) -> b -> BuiltinResult a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> BuiltinResult a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> BuiltinResult a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> BuiltinResult a -> a
foldr1 :: forall a. (a -> a -> a) -> BuiltinResult a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> BuiltinResult a -> a
foldl1 :: forall a. (a -> a -> a) -> BuiltinResult a -> a
$ctoList :: forall a. BuiltinResult a -> [a]
toList :: forall a. BuiltinResult a -> [a]
$cnull :: forall a. BuiltinResult a -> Bool
null :: forall a. BuiltinResult a -> Bool
$clength :: forall a. BuiltinResult a -> Int
length :: forall a. BuiltinResult a -> Int
$celem :: forall a. Eq a => a -> BuiltinResult a -> Bool
elem :: forall a. Eq a => a -> BuiltinResult a -> Bool
$cmaximum :: forall a. Ord a => BuiltinResult a -> a
maximum :: forall a. Ord a => BuiltinResult a -> a
$cminimum :: forall a. Ord a => BuiltinResult a -> a
minimum :: forall a. Ord a => BuiltinResult a -> a
$csum :: forall a. Num a => BuiltinResult a -> a
sum :: forall a. Num a => BuiltinResult a -> a
$cproduct :: forall a. Num a => BuiltinResult a -> a
product :: forall a. Num a => BuiltinResult a -> a
Foldable)
mtraverse makeClassyPrisms
[ ''UnliftingError
, ''UnliftingEvaluationError
, ''BuiltinError
, ''BuiltinResult
]
instance AsEvaluationError UnliftingEvaluationError UnliftingError UnliftingError where
_EvaluationError :: Prism'
UnliftingEvaluationError
(EvaluationError UnliftingError UnliftingError)
_EvaluationError = p (EvaluationError UnliftingError UnliftingError)
(f (EvaluationError UnliftingError UnliftingError))
-> p UnliftingEvaluationError (f UnliftingEvaluationError)
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso
UnliftingEvaluationError
UnliftingEvaluationError
(EvaluationError UnliftingError UnliftingError)
(EvaluationError UnliftingError UnliftingError)
coerced
{-# INLINE _EvaluationError #-}
instance (AsUnliftingError structural, AsUnliftingError operational) =>
AsUnliftingEvaluationError (EvaluationError structural operational) where
_UnliftingEvaluationError :: Prism'
(EvaluationError structural operational) UnliftingEvaluationError
_UnliftingEvaluationError = p (EvaluationError UnliftingError UnliftingError)
(f (EvaluationError UnliftingError UnliftingError))
-> p (EvaluationError structural operational)
(f (EvaluationError structural operational))
go (p (EvaluationError UnliftingError UnliftingError)
(f (EvaluationError UnliftingError UnliftingError))
-> p (EvaluationError structural operational)
(f (EvaluationError structural operational)))
-> (p UnliftingEvaluationError (f UnliftingEvaluationError)
-> p (EvaluationError UnliftingError UnliftingError)
(f (EvaluationError UnliftingError UnliftingError)))
-> p UnliftingEvaluationError (f UnliftingEvaluationError)
-> p (EvaluationError structural operational)
(f (EvaluationError structural operational))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p UnliftingEvaluationError (f UnliftingEvaluationError)
-> p (EvaluationError UnliftingError UnliftingError)
(f (EvaluationError UnliftingError UnliftingError))
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso
(EvaluationError UnliftingError UnliftingError)
(EvaluationError UnliftingError UnliftingError)
UnliftingEvaluationError
UnliftingEvaluationError
coerced where
go :: p (EvaluationError UnliftingError UnliftingError)
(f (EvaluationError UnliftingError UnliftingError))
-> p (EvaluationError structural operational)
(f (EvaluationError structural operational))
go =
(EvaluationError UnliftingError UnliftingError
-> EvaluationError structural operational)
-> (EvaluationError structural operational
-> Maybe (EvaluationError UnliftingError UnliftingError))
-> Prism'
(EvaluationError structural operational)
(EvaluationError UnliftingError UnliftingError)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
((UnliftingError -> structural)
-> (UnliftingError -> operational)
-> EvaluationError UnliftingError UnliftingError
-> EvaluationError structural operational
forall a b c d.
(a -> b) -> (c -> d) -> EvaluationError a c -> EvaluationError b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
(AReview structural UnliftingError -> UnliftingError -> structural
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview structural UnliftingError
forall r. AsUnliftingError r => Prism' r UnliftingError
Prism' structural UnliftingError
_UnliftingError)
(AReview operational UnliftingError -> UnliftingError -> operational
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview operational UnliftingError
forall r. AsUnliftingError r => Prism' r UnliftingError
Prism' operational UnliftingError
_UnliftingError))
((structural -> Maybe UnliftingError)
-> (operational -> Maybe UnliftingError)
-> EvaluationError structural operational
-> Maybe (EvaluationError UnliftingError UnliftingError)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> EvaluationError a b -> f (EvaluationError c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse
(Either structural UnliftingError -> Maybe UnliftingError
forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Alternative g) =>
f a -> g a
reoption (Either structural UnliftingError -> Maybe UnliftingError)
-> (structural -> Either structural UnliftingError)
-> structural
-> Maybe UnliftingError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrism structural structural UnliftingError UnliftingError
-> structural -> Either structural UnliftingError
forall s t a b. APrism s t a b -> s -> Either t a
matching APrism structural structural UnliftingError UnliftingError
forall r. AsUnliftingError r => Prism' r UnliftingError
Prism' structural UnliftingError
_UnliftingError)
(Either operational UnliftingError -> Maybe UnliftingError
forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Alternative g) =>
f a -> g a
reoption (Either operational UnliftingError -> Maybe UnliftingError)
-> (operational -> Either operational UnliftingError)
-> operational
-> Maybe UnliftingError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrism operational operational UnliftingError UnliftingError
-> operational -> Either operational UnliftingError
forall s t a b. APrism s t a b -> s -> Either t a
matching APrism operational operational UnliftingError UnliftingError
forall r. AsUnliftingError r => Prism' r UnliftingError
Prism' operational UnliftingError
_UnliftingError))
{-# INLINE _UnliftingEvaluationError #-}
instance AsUnliftingEvaluationError BuiltinError where
_UnliftingEvaluationError :: Prism' BuiltinError UnliftingEvaluationError
_UnliftingEvaluationError = p UnliftingEvaluationError (f UnliftingEvaluationError)
-> p BuiltinError (f BuiltinError)
forall r. AsBuiltinError r => Prism' r UnliftingEvaluationError
Prism' BuiltinError UnliftingEvaluationError
_BuiltinUnliftingEvaluationError (p UnliftingEvaluationError (f UnliftingEvaluationError)
-> p BuiltinError (f BuiltinError))
-> (p UnliftingEvaluationError (f UnliftingEvaluationError)
-> p UnliftingEvaluationError (f UnliftingEvaluationError))
-> p UnliftingEvaluationError (f UnliftingEvaluationError)
-> p BuiltinError (f BuiltinError)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p UnliftingEvaluationError (f UnliftingEvaluationError)
-> p UnliftingEvaluationError (f UnliftingEvaluationError)
forall r.
AsUnliftingEvaluationError r =>
Prism' r UnliftingEvaluationError
Prism' UnliftingEvaluationError UnliftingEvaluationError
_UnliftingEvaluationError
{-# INLINE _UnliftingEvaluationError #-}
instance AsEvaluationFailure BuiltinError where
_EvaluationFailure :: Prism' BuiltinError ()
_EvaluationFailure = BuiltinError -> Prism' BuiltinError ()
forall err. Eq err => err -> Prism' err ()
_EvaluationFailureVia BuiltinError
BuiltinEvaluationFailure
{-# INLINE _EvaluationFailure #-}
instance AsEvaluationFailure (BuiltinResult a) where
_EvaluationFailure :: Prism' (BuiltinResult a) ()
_EvaluationFailure = p (DList Text, BuiltinError) (f (DList Text, BuiltinError))
-> p (BuiltinResult a) (f (BuiltinResult a))
forall r a.
AsBuiltinResult r a =>
Prism' r (DList Text, BuiltinError)
Prism' (BuiltinResult a) (DList Text, BuiltinError)
_BuiltinFailure (p (DList Text, BuiltinError) (f (DList Text, BuiltinError))
-> p (BuiltinResult a) (f (BuiltinResult a)))
-> (p () (f ())
-> p (DList Text, BuiltinError) (f (DList Text, BuiltinError)))
-> p () (f ())
-> p (BuiltinResult a) (f (BuiltinResult a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DList Text, BuiltinError) -> ())
-> (() -> (DList Text, BuiltinError))
-> Iso (DList Text, BuiltinError) (DList Text, BuiltinError) () ()
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(DList Text, BuiltinError)
_ -> ()) (\()
_ -> BuiltinError -> (DList Text, BuiltinError)
forall a. a -> (DList Text, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure BuiltinError
forall err. AsEvaluationFailure err => err
evaluationFailure)
{-# INLINE _EvaluationFailure #-}
instance MonadFail BuiltinResult where
fail :: forall a. String -> BuiltinResult a
fail String
err = DList Text -> BuiltinError -> BuiltinResult a
forall a. DList Text -> BuiltinError -> BuiltinResult a
BuiltinFailure (Text -> DList Text
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> DList Text) -> Text -> DList Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
err) BuiltinError
BuiltinEvaluationFailure
{-# INLINE fail #-}
instance Pretty UnliftingError where
pretty :: forall ann. UnliftingError -> Doc ann
pretty (MkUnliftingError Text
err) = [Doc ann] -> Doc ann
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
[ Doc ann
"Could not unlift a value:", Doc ann
forall ann. Doc ann
hardline
, Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
err
]
deriving newtype instance Pretty UnliftingEvaluationError
instance Pretty BuiltinError where
pretty :: forall ann. BuiltinError -> Doc ann
pretty (BuiltinUnliftingEvaluationError UnliftingEvaluationError
err) = Doc ann
"Builtin evaluation failure:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> UnliftingEvaluationError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. UnliftingEvaluationError -> Doc ann
pretty UnliftingEvaluationError
err
pretty BuiltinError
BuiltinEvaluationFailure = Doc ann
"Builtin evaluation failure"
_UnliftingErrorVia :: Pretty err => err -> Prism' err UnliftingError
_UnliftingErrorVia :: forall err. Pretty err => err -> Prism' err UnliftingError
_UnliftingErrorVia err
err = (err -> UnliftingError)
-> (UnliftingError -> err)
-> Iso err err UnliftingError UnliftingError
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (Text -> UnliftingError
MkUnliftingError (Text -> UnliftingError) -> (err -> Text) -> err -> UnliftingError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> Text
forall str a. (Pretty a, Render str) => a -> str
display) (err -> UnliftingError -> err
forall a b. a -> b -> a
const err
err)
{-# INLINE _UnliftingErrorVia #-}
_StructuralUnliftingError :: AsBuiltinError err => Prism' err UnliftingError
_StructuralUnliftingError :: forall err. AsBuiltinError err => Prism' err UnliftingError
_StructuralUnliftingError = p UnliftingEvaluationError (f UnliftingEvaluationError)
-> p err (f err)
forall r. AsBuiltinError r => Prism' r UnliftingEvaluationError
Prism' err UnliftingEvaluationError
_BuiltinUnliftingEvaluationError (p UnliftingEvaluationError (f UnliftingEvaluationError)
-> p err (f err))
-> (p UnliftingError (f UnliftingError)
-> p UnliftingEvaluationError (f UnliftingEvaluationError))
-> p UnliftingError (f UnliftingError)
-> p err (f err)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p UnliftingError (f UnliftingError)
-> p UnliftingEvaluationError (f UnliftingEvaluationError)
forall r structural operational.
AsEvaluationError r structural operational =>
Prism' r structural
Prism' UnliftingEvaluationError UnliftingError
_StructuralEvaluationError
{-# INLINE _StructuralUnliftingError #-}
_OperationalUnliftingError :: AsBuiltinError err => Prism' err UnliftingError
_OperationalUnliftingError :: forall err. AsBuiltinError err => Prism' err UnliftingError
_OperationalUnliftingError = p UnliftingEvaluationError (f UnliftingEvaluationError)
-> p err (f err)
forall r. AsBuiltinError r => Prism' r UnliftingEvaluationError
Prism' err UnliftingEvaluationError
_BuiltinUnliftingEvaluationError (p UnliftingEvaluationError (f UnliftingEvaluationError)
-> p err (f err))
-> (p UnliftingError (f UnliftingError)
-> p UnliftingEvaluationError (f UnliftingEvaluationError))
-> p UnliftingError (f UnliftingError)
-> p err (f err)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p UnliftingError (f UnliftingError)
-> p UnliftingEvaluationError (f UnliftingEvaluationError)
forall r structural operational.
AsEvaluationError r structural operational =>
Prism' r operational
Prism' UnliftingEvaluationError UnliftingError
_OperationalEvaluationError
{-# INLINE _OperationalUnliftingError #-}
throwNotAConstant :: MonadError BuiltinError m => m void
throwNotAConstant :: forall (m :: * -> *) void. MonadError BuiltinError m => m void
throwNotAConstant = AReview BuiltinError UnliftingError -> UnliftingError -> m void
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview BuiltinError UnliftingError
forall err. AsBuiltinError err => Prism' err UnliftingError
Prism' BuiltinError UnliftingError
_StructuralUnliftingError UnliftingError
"Not a constant"
{-# INLINE throwNotAConstant #-}
throwUnderTypeError :: MonadError BuiltinError m => m void
throwUnderTypeError :: forall (m :: * -> *) void. MonadError BuiltinError m => m void
throwUnderTypeError = AReview BuiltinError UnliftingError -> UnliftingError -> m void
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview BuiltinError UnliftingError
forall err. AsBuiltinError err => Prism' err UnliftingError
Prism' BuiltinError UnliftingError
_StructuralUnliftingError UnliftingError
"Panic: 'TypeError' was bypassed"
{-# INLINE throwUnderTypeError #-}
emit :: Text -> BuiltinResult ()
emit :: Text -> BuiltinResult ()
emit Text
txt = DList Text -> () -> BuiltinResult ()
forall a. DList Text -> a -> BuiltinResult a
BuiltinSuccessWithLogs (Text -> DList Text
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
txt) ()
{-# INLINE emit #-}
withLogs :: DList Text -> BuiltinResult a -> BuiltinResult a
withLogs :: forall a. DList Text -> BuiltinResult a -> BuiltinResult a
withLogs DList Text
logs1 = \case
BuiltinSuccess a
x -> DList Text -> a -> BuiltinResult a
forall a. DList Text -> a -> BuiltinResult a
BuiltinSuccessWithLogs DList Text
logs1 a
x
BuiltinSuccessWithLogs DList Text
logs2 a
x -> DList Text -> a -> BuiltinResult a
forall a. DList Text -> a -> BuiltinResult a
BuiltinSuccessWithLogs (DList Text
logs1 DList Text -> DList Text -> DList Text
forall a. Semigroup a => a -> a -> a
<> DList Text
logs2) a
x
BuiltinFailure DList Text
logs2 BuiltinError
err -> DList Text -> BuiltinError -> BuiltinResult a
forall a. DList Text -> BuiltinError -> BuiltinResult a
BuiltinFailure (DList Text
logs1 DList Text -> DList Text -> DList Text
forall a. Semigroup a => a -> a -> a
<> DList Text
logs2) BuiltinError
err
{-# INLINE withLogs #-}
instance Functor BuiltinResult where
fmap :: forall a b. (a -> b) -> BuiltinResult a -> BuiltinResult b
fmap a -> b
f (BuiltinSuccess a
x) = b -> BuiltinResult b
forall a. a -> BuiltinResult a
BuiltinSuccess (a -> b
f a
x)
fmap a -> b
f (BuiltinSuccessWithLogs DList Text
logs a
x) = DList Text -> b -> BuiltinResult b
forall a. DList Text -> a -> BuiltinResult a
BuiltinSuccessWithLogs DList Text
logs (a -> b
f a
x)
fmap a -> b
_ (BuiltinFailure DList Text
logs BuiltinError
err) = DList Text -> BuiltinError -> BuiltinResult b
forall a. DList Text -> BuiltinError -> BuiltinResult a
BuiltinFailure DList Text
logs BuiltinError
err
{-# INLINE fmap #-}
a
x <$ :: forall a b. a -> BuiltinResult b -> BuiltinResult a
<$ BuiltinSuccess b
_ = a -> BuiltinResult a
forall a. a -> BuiltinResult a
BuiltinSuccess a
x
a
x <$ BuiltinSuccessWithLogs DList Text
logs b
_ = DList Text -> a -> BuiltinResult a
forall a. DList Text -> a -> BuiltinResult a
BuiltinSuccessWithLogs DList Text
logs a
x
a
_ <$ BuiltinFailure DList Text
logs BuiltinError
err = DList Text -> BuiltinError -> BuiltinResult a
forall a. DList Text -> BuiltinError -> BuiltinResult a
BuiltinFailure DList Text
logs BuiltinError
err
{-# INLINE (<$) #-}
instance Applicative BuiltinResult where
pure :: forall a. a -> BuiltinResult a
pure = a -> BuiltinResult a
forall a. a -> BuiltinResult a
BuiltinSuccess
{-# INLINE pure #-}
BuiltinSuccess a -> b
f <*> :: forall a b.
BuiltinResult (a -> b) -> BuiltinResult a -> BuiltinResult b
<*> BuiltinResult a
a = (a -> b) -> BuiltinResult a -> BuiltinResult b
forall a b. (a -> b) -> BuiltinResult a -> BuiltinResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BuiltinResult a
a
BuiltinSuccessWithLogs DList Text
logs a -> b
f <*> BuiltinResult a
a = DList Text -> BuiltinResult b -> BuiltinResult b
forall a. DList Text -> BuiltinResult a -> BuiltinResult a
withLogs DList Text
logs (BuiltinResult b -> BuiltinResult b)
-> BuiltinResult b -> BuiltinResult b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> BuiltinResult a -> BuiltinResult b
forall a b. (a -> b) -> BuiltinResult a -> BuiltinResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BuiltinResult a
a
BuiltinFailure DList Text
logs BuiltinError
err <*> BuiltinResult a
_ = DList Text -> BuiltinError -> BuiltinResult b
forall a. DList Text -> BuiltinError -> BuiltinResult a
BuiltinFailure DList Text
logs BuiltinError
err
{-# INLINE (<*>) #-}
BuiltinSuccess a
_ *> :: forall a b. BuiltinResult a -> BuiltinResult b -> BuiltinResult b
*> BuiltinResult b
b = BuiltinResult b
b
BuiltinSuccessWithLogs DList Text
logs a
_ *> BuiltinResult b
b = DList Text -> BuiltinResult b -> BuiltinResult b
forall a. DList Text -> BuiltinResult a -> BuiltinResult a
withLogs DList Text
logs BuiltinResult b
b
BuiltinFailure DList Text
logs BuiltinError
err *> BuiltinResult b
_ = DList Text -> BuiltinError -> BuiltinResult b
forall a. DList Text -> BuiltinError -> BuiltinResult a
BuiltinFailure DList Text
logs BuiltinError
err
{-# INLINE (*>) #-}
instance Monad BuiltinResult where
BuiltinSuccess a
x >>= :: forall a b.
BuiltinResult a -> (a -> BuiltinResult b) -> BuiltinResult b
>>= a -> BuiltinResult b
f = a -> BuiltinResult b
f a
x
BuiltinSuccessWithLogs DList Text
logs a
x >>= a -> BuiltinResult b
f = DList Text -> BuiltinResult b -> BuiltinResult b
forall a. DList Text -> BuiltinResult a -> BuiltinResult a
withLogs DList Text
logs (BuiltinResult b -> BuiltinResult b)
-> BuiltinResult b -> BuiltinResult b
forall a b. (a -> b) -> a -> b
$ a -> BuiltinResult b
f a
x
BuiltinFailure DList Text
logs BuiltinError
err >>= a -> BuiltinResult b
_ = DList Text -> BuiltinError -> BuiltinResult b
forall a. DList Text -> BuiltinError -> BuiltinResult a
BuiltinFailure DList Text
logs BuiltinError
err
{-# INLINE (>>=) #-}
>> :: forall a b. BuiltinResult a -> BuiltinResult b -> BuiltinResult b
(>>) = BuiltinResult a -> BuiltinResult b -> BuiltinResult b
forall a b. BuiltinResult a -> BuiltinResult b -> BuiltinResult b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
{-# INLINE (>>) #-}
instance MonadError BuiltinError BuiltinResult where
throwError :: forall a. BuiltinError -> BuiltinResult a
throwError BuiltinError
builtinErr = DList Text -> BuiltinError -> BuiltinResult a
forall a. DList Text -> BuiltinError -> BuiltinResult a
BuiltinFailure DList Text
operationalLogs BuiltinError
builtinErr where
operationalLogs :: DList Text
operationalLogs = case BuiltinError
builtinErr of
BuiltinUnliftingEvaluationError
(MkUnliftingEvaluationError
(OperationalEvaluationError
(MkUnliftingError Text
operationalErr))) -> Text -> DList Text
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
operationalErr
BuiltinError
_ -> DList Text
forall a. Monoid a => a
mempty
{-# INLINE throwError #-}
BuiltinFailure DList Text
_ BuiltinError
err catchError :: forall a.
BuiltinResult a
-> (BuiltinError -> BuiltinResult a) -> BuiltinResult a
`catchError` BuiltinError -> BuiltinResult a
f = BuiltinError -> BuiltinResult a
f BuiltinError
err
BuiltinResult a
res `catchError` BuiltinError -> BuiltinResult a
_ = BuiltinResult a
res
{-# INLINE catchError #-}