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

-- | Errors that can arise during transaction generation
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)

-- | The domain in which transaction parts are generated.
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

-- | Lifts a computation from a smaller context
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

-- | Looks up a key in a map. Throws a 'GenerateTxErrorGeneral' error with a given
-- message when the key is absent, returns the associated value otherwise.
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

-- | Throws a general error from a String.
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

-- | Lifts a 'ToCardanoError' with an associated error message, or apply a
-- function if a value exists.
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

-- | Lifts a 'ToCardanoError' with an associated error message, or leaves the
-- value unchanged if it exists.
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