{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} module Plutus.PAB.Effects.UUID where import Control.Monad.Freer import Control.Monad.Freer.TH (makeEffect) import Control.Monad.IO.Class (MonadIO (..)) import Data.UUID (UUID) import Data.UUID.V4 (nextRandom) data UUIDEffect r where UuidNextRandom :: UUIDEffect UUID makeEffect ''UUIDEffect handleUUIDEffect :: ( LastMember m effs , MonadIO m) => Eff (UUIDEffect ': effs) ~> Eff effs handleUUIDEffect :: Eff (UUIDEffect : effs) ~> Eff effs handleUUIDEffect = (UUIDEffect ~> Eff effs) -> Eff (UUIDEffect : effs) ~> Eff effs forall (eff :: * -> *) (effs :: [* -> *]). (eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs interpret ((UUIDEffect ~> Eff effs) -> Eff (UUIDEffect : effs) ~> Eff effs) -> (UUIDEffect ~> Eff effs) -> Eff (UUIDEffect : effs) ~> Eff effs forall a b. (a -> b) -> a -> b $ \case UUIDEffect x UuidNextRandom -> m UUID -> Eff effs UUID forall (m :: * -> *) (effs :: [* -> *]) a. (Monad m, LastMember m effs) => m a -> Eff effs a sendM (m UUID -> Eff effs UUID) -> m UUID -> Eff effs UUID forall a b. (a -> b) -> a -> b $ IO UUID -> m UUID forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO UUID nextRandom