module Cooked.MockChain.GenerateTx.Common
( GenerateTxError (..),
TxGen,
Transform (..),
throwOnLookup,
throwOnString,
throwOnToCardanoErrorOrApply,
throwOnToCardanoError,
liftTxGen,
)
where
import Cardano.Api.Shelley qualified as Cardano
import Control.Monad.Reader
import Data.Bifunctor
import Data.Map (Map)
import Data.Map qualified as Map
import Ledger.Tx qualified as Ledger
data GenerateTxError
= ToCardanoError String Ledger.ToCardanoError
| TxBodyError String Cardano.TxBodyError
| GenerateTxErrorGeneral String
deriving (Int -> GenerateTxError -> ShowS
[GenerateTxError] -> ShowS
GenerateTxError -> String
(Int -> GenerateTxError -> ShowS)
-> (GenerateTxError -> String)
-> ([GenerateTxError] -> ShowS)
-> Show GenerateTxError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenerateTxError -> ShowS
showsPrec :: Int -> GenerateTxError -> ShowS
$cshow :: GenerateTxError -> String
show :: GenerateTxError -> String
$cshowList :: [GenerateTxError] -> ShowS
showList :: [GenerateTxError] -> ShowS
Show, GenerateTxError -> GenerateTxError -> Bool
(GenerateTxError -> GenerateTxError -> Bool)
-> (GenerateTxError -> GenerateTxError -> Bool)
-> Eq GenerateTxError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenerateTxError -> GenerateTxError -> Bool
== :: GenerateTxError -> GenerateTxError -> Bool
$c/= :: GenerateTxError -> GenerateTxError -> Bool
/= :: GenerateTxError -> GenerateTxError -> Bool
Eq)
type TxGen context a = ReaderT context (Either GenerateTxError) a
class Transform a b where
transform :: a -> b
instance Transform (a, b) b where
transform :: (a, b) -> b
transform = (a, b) -> b
forall a b. (a, b) -> b
snd
instance Transform (a, b) a where
transform :: (a, b) -> a
transform = (a, b) -> a
forall a b. (a, b) -> a
fst
liftTxGen :: (Transform context' context) => TxGen context a -> TxGen context' a
liftTxGen :: forall context' context a.
Transform context' context =>
TxGen context a -> TxGen context' a
liftTxGen TxGen context a
comp = (Either GenerateTxError a
-> ReaderT context' (Either GenerateTxError) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT context' m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either GenerateTxError a
-> ReaderT context' (Either GenerateTxError) a)
-> (context -> Either GenerateTxError a)
-> context
-> ReaderT context' (Either GenerateTxError) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxGen context a -> context -> Either GenerateTxError a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT TxGen context a
comp) (context -> ReaderT context' (Either GenerateTxError) a)
-> ReaderT context' (Either GenerateTxError) context
-> ReaderT context' (Either GenerateTxError) a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (context' -> context)
-> ReaderT context' (Either GenerateTxError) context
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks context' -> context
forall a b. Transform a b => a -> b
transform
throwOnLookup :: (Ord k) => String -> k -> Map k a -> TxGen context a
throwOnLookup :: forall k a context.
Ord k =>
String -> k -> Map k a -> TxGen context a
throwOnLookup String
errorMsg k
key = TxGen context a
-> (a -> TxGen context a) -> Maybe a -> TxGen context a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> TxGen context a
forall context a. String -> TxGen context a
throwOnString String
errorMsg) a -> TxGen context a
forall a. a -> ReaderT context (Either GenerateTxError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> TxGen context a)
-> (Map k a -> Maybe a) -> Map k a -> TxGen context a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key
throwOnString :: String -> TxGen context a
throwOnString :: forall context a. String -> TxGen context a
throwOnString = Either GenerateTxError a
-> ReaderT context (Either GenerateTxError) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT context m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either GenerateTxError a
-> ReaderT context (Either GenerateTxError) a)
-> (String -> Either GenerateTxError a)
-> String
-> ReaderT context (Either GenerateTxError) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenerateTxError -> Either GenerateTxError a
forall a b. a -> Either a b
Left (GenerateTxError -> Either GenerateTxError a)
-> (String -> GenerateTxError)
-> String
-> Either GenerateTxError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GenerateTxError
GenerateTxErrorGeneral
throwOnToCardanoErrorOrApply :: String -> (a -> b) -> Either Ledger.ToCardanoError a -> TxGen context b
throwOnToCardanoErrorOrApply :: forall a b context.
String -> (a -> b) -> Either ToCardanoError a -> TxGen context b
throwOnToCardanoErrorOrApply String
errorMsg a -> b
f = Either GenerateTxError b
-> ReaderT context (Either GenerateTxError) b
forall (m :: * -> *) a. Monad m => m a -> ReaderT context m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either GenerateTxError b
-> ReaderT context (Either GenerateTxError) b)
-> (Either ToCardanoError a -> Either GenerateTxError b)
-> Either ToCardanoError a
-> ReaderT context (Either GenerateTxError) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ToCardanoError -> GenerateTxError)
-> (a -> b) -> Either ToCardanoError a -> Either GenerateTxError b
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (String -> ToCardanoError -> GenerateTxError
ToCardanoError String
errorMsg) a -> b
f
throwOnToCardanoError :: String -> Either Ledger.ToCardanoError a -> TxGen context a
throwOnToCardanoError :: forall a context.
String -> Either ToCardanoError a -> TxGen context a
throwOnToCardanoError = (String -> (a -> a) -> Either ToCardanoError a -> TxGen context a)
-> (a -> a) -> String -> Either ToCardanoError a -> TxGen context a
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> (a -> a) -> Either ToCardanoError a -> TxGen context a
forall a b context.
String -> (a -> b) -> Either ToCardanoError a -> TxGen context b
throwOnToCardanoErrorOrApply a -> a
forall a. a -> a
id