From 94d21f64b927cbf4fab676881efa2c4cfb203926 Mon Sep 17 00:00:00 2001
From: Gregory Gerasev <uhbif19@gmail.com>
Date: Fri, 31 May 2024 18:04:15 +0700
Subject: [PATCH 1/3] Add deriving utils and separate `CEMScriptTypes`

---
 cem-script.cabal                        |  1 +
 src/Cardano/CEM.hs                      | 38 +++++-----
 src/Cardano/CEM/Examples/Auction.hs     | 22 ++----
 src/Cardano/CEM/Examples/Compilation.hs | 20 +----
 src/Cardano/CEM/Examples/Voting.hs      | 16 ++--
 src/Cardano/CEM/Monads/L1.hs            |  1 -
 src/Cardano/CEM/TH.hs                   | 98 +++++++++++++++++++++++++
 7 files changed, 134 insertions(+), 62 deletions(-)
 create mode 100644 src/Cardano/CEM/TH.hs

diff --git a/cem-script.cabal b/cem-script.cabal
index 27864f6..aea46f5 100644
--- a/cem-script.cabal
+++ b/cem-script.cabal
@@ -171,6 +171,7 @@ library
     Cardano.CEM.OnChain
     Cardano.CEM.Stages
     Cardano.CEM.Testing.StateMachine
+    Cardano.CEM.TH
 
   other-modules:   Cardano.CEM.Monads.L1Commons
   build-depends:
diff --git a/src/Cardano/CEM.hs b/src/Cardano/CEM.hs
index adcc858..b294a6b 100644
--- a/src/Cardano/CEM.hs
+++ b/src/Cardano/CEM.hs
@@ -13,10 +13,7 @@ import Data.Map qualified as Map
 -- Plutus imports
 import PlutusLedgerApi.V1.Address (Address, pubKeyHashAddress)
 import PlutusLedgerApi.V1.Crypto (PubKeyHash)
-import PlutusLedgerApi.V2 (
-  ToData (..),
-  Value,
- )
+import PlutusLedgerApi.V2 (ToData (..), Value)
 import PlutusTx.Show.TH (deriveShow)
 
 -- Project imports
@@ -81,20 +78,12 @@ type DefaultConstraints datatype =
   , Prelude.Show datatype
   )
 
-class
-  ( HasSpine (Transition script)
-  , HasSpine (State script)
-  , Stages (Stage script)
-  , DefaultConstraints (Stage script)
-  , DefaultConstraints (Transition script)
-  , DefaultConstraints (State script)
-  , DefaultConstraints (Params script)
-  , DefaultConstraints (StageParams (Stage script))
-  ) =>
-  CEMScript script
-  where
-  -- | `Params` is immutable part of script Datum,
-  -- | it should be used to encode all
+{- | All associated types for `CEMScript`
+They are separated to simplify TH deriving
+-}
+class CEMScriptTypes script where
+  -- \| `Params` is immutable part of script Datum,
+  -- \| it should be used to encode all
   type Params script = params | params -> script
 
   -- | `Stage` is datatype encoding all `Interval`s specified by script.
@@ -110,6 +99,19 @@ class
   -- | Transitions for deterministic CEM-machine
   type Transition script = transition | transition -> script
 
+class
+  ( HasSpine (Transition script)
+  , HasSpine (State script)
+  , Stages (Stage script)
+  , DefaultConstraints (Stage script)
+  , DefaultConstraints (Transition script)
+  , DefaultConstraints (State script)
+  , DefaultConstraints (Params script)
+  , DefaultConstraints (StageParams (Stage script))
+  , CEMScriptTypes script
+  ) =>
+  CEMScript script
+  where
   -- | Each kind of Transition has statically associated Stage
   -- from/to `State`s spines
   transitionStage ::
diff --git a/src/Cardano/CEM/Examples/Auction.hs b/src/Cardano/CEM/Examples/Auction.hs
index 53eb001..3e69e04 100644
--- a/src/Cardano/CEM/Examples/Auction.hs
+++ b/src/Cardano/CEM/Examples/Auction.hs
@@ -14,11 +14,10 @@ import PlutusLedgerApi.V1.Time (POSIXTime)
 import PlutusLedgerApi.V1.Value (CurrencySymbol (..), TokenName (..), singleton)
 import PlutusLedgerApi.V2 (Value)
 import PlutusTx qualified
-import PlutusTx.Show.TH (deriveShow)
 
 import Cardano.CEM
-import Cardano.CEM.Stages
-import Data.Spine
+import Cardano.CEM.Stages (Stages (..))
+import Cardano.CEM.TH (deriveCEMAssociatedTypes, deriveStageAssociatedTypes)
 
 -- Simple no-deposit auction
 
@@ -66,24 +65,17 @@ data SimpleAuctionTransition
   deriving stock (Prelude.Eq, Prelude.Show)
 
 PlutusTx.unstableMakeIsData ''Bid
-PlutusTx.unstableMakeIsData 'MkAuctionParams
-PlutusTx.unstableMakeIsData 'NotStarted
-PlutusTx.unstableMakeIsData 'MakeBid
-PlutusTx.unstableMakeIsData ''SimpleAuctionStage
-PlutusTx.unstableMakeIsData ''SimpleAuctionStageParams
-deriveShow ''SimpleAuction
 
-deriveSpine ''SimpleAuctionTransition
-deriveSpine ''SimpleAuctionState
-
-instance CEMScript SimpleAuction where
+instance CEMScriptTypes SimpleAuction where
   type Stage SimpleAuction = SimpleAuctionStage
   type Params SimpleAuction = SimpleAuctionParams
-
   type State SimpleAuction = SimpleAuctionState
-
   type Transition SimpleAuction = SimpleAuctionTransition
 
+$(deriveStageAssociatedTypes ''SimpleAuctionStage)
+$(deriveCEMAssociatedTypes False ''SimpleAuction)
+
+instance CEMScript SimpleAuction where
   transitionStage Proxy =
     Map.fromList
       [ (CreateSpine, (Open, Nothing, Just NotStartedSpine))
diff --git a/src/Cardano/CEM/Examples/Compilation.hs b/src/Cardano/CEM/Examples/Compilation.hs
index 8fe02c2..ffcac47 100644
--- a/src/Cardano/CEM/Examples/Compilation.hs
+++ b/src/Cardano/CEM/Examples/Compilation.hs
@@ -6,25 +6,11 @@
 
 module Cardano.CEM.Examples.Compilation where
 
-import PlutusTx qualified
-
-import Data.Proxy (Proxy (..))
-
 import PlutusLedgerApi.V2 (serialiseCompiledCode)
 
 import Cardano.CEM.Examples.Auction
 import Cardano.CEM.Examples.Voting
-import Cardano.CEM.OnChain (CEMScriptCompiled (..), genericCEMScript)
-import Cardano.CEM.Stages (SingleStage)
-
-instance CEMScriptCompiled SimpleAuction where
-  {-# INLINEABLE cemScriptCompiled #-}
-  cemScriptCompiled Proxy =
-    serialiseCompiledCode
-      $(PlutusTx.compileUntyped (genericCEMScript ''SimpleAuction ''SimpleAuctionStage))
+import Cardano.CEM.TH
 
-instance CEMScriptCompiled SimpleVoting where
-  {-# INLINEABLE cemScriptCompiled #-}
-  cemScriptCompiled Proxy =
-    serialiseCompiledCode
-      $(PlutusTx.compileUntyped (genericCEMScript ''SimpleVoting ''SingleStage))
+$(compileCEM ''SimpleAuction)
+$(compileCEM ''SimpleVoting)
diff --git a/src/Cardano/CEM/Examples/Voting.hs b/src/Cardano/CEM/Examples/Voting.hs
index 9fd5cf6..bad584f 100644
--- a/src/Cardano/CEM/Examples/Voting.hs
+++ b/src/Cardano/CEM/Examples/Voting.hs
@@ -13,11 +13,10 @@ import PlutusLedgerApi.V1.Crypto (PubKeyHash)
 import PlutusLedgerApi.V2 (Value)
 import PlutusTx qualified
 import PlutusTx.AssocMap qualified as PMap
-import PlutusTx.Show.TH (deriveShow)
 
 import Cardano.CEM
 import Cardano.CEM.Stages
-import Data.Spine (deriveSpine)
+import Cardano.CEM.TH (deriveCEMAssociatedTypes)
 
 -- Voting
 
@@ -88,21 +87,16 @@ data SimpleVotingTransition
 
 PlutusTx.unstableMakeIsData ''VoteValue
 PlutusTx.unstableMakeIsData ''JuryPolicy
-PlutusTx.unstableMakeIsData ''SimpleVotingState
-PlutusTx.unstableMakeIsData ''SimpleVotingParams
-PlutusTx.unstableMakeIsData ''SimpleVotingTransition
 
-deriveShow ''SimpleVoting
-
-deriveSpine ''SimpleVotingTransition
-deriveSpine ''SimpleVotingState
-
-instance CEMScript SimpleVoting where
+instance CEMScriptTypes SimpleVoting where
   type Stage SimpleVoting = SingleStage
   type Params SimpleVoting = SimpleVotingParams
   type State SimpleVoting = SimpleVotingState
   type Transition SimpleVoting = SimpleVotingTransition
 
+$(deriveCEMAssociatedTypes ''SimpleVoting)
+
+instance CEMScript SimpleVoting where
   transitionStage _ =
     Map.fromList
       [ (CreateSpine, (Always, Nothing, Just NotStartedSpine))
diff --git a/src/Cardano/CEM/Monads/L1.hs b/src/Cardano/CEM/Monads/L1.hs
index f24aa6b..a42076a 100644
--- a/src/Cardano/CEM/Monads/L1.hs
+++ b/src/Cardano/CEM/Monads/L1.hs
@@ -5,7 +5,6 @@ module Cardano.CEM.Monads.L1 where
 import Prelude
 
 import Control.Monad.Reader (MonadReader (..), ReaderT (..))
-import Control.Monad.Trans (MonadIO (..))
 import Data.ByteString qualified as BS
 import Data.Set qualified as Set
 
diff --git a/src/Cardano/CEM/TH.hs b/src/Cardano/CEM/TH.hs
new file mode 100644
index 0000000..efe23f1
--- /dev/null
+++ b/src/Cardano/CEM/TH.hs
@@ -0,0 +1,98 @@
+module Cardano.CEM.TH (
+  deriveCEMAssociatedTypes,
+  compileCEM,
+  unstableMakeIsDataSchema,
+  deriveStageAssociatedTypes,
+  defaultIndex,
+  unstableMakeHasSchemaInstance,
+) where
+
+import Prelude
+
+import Data.Data (Proxy (..))
+import GHC.Num.Natural (Natural)
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax (sequenceQ)
+
+import PlutusTx qualified
+import PlutusTx.Blueprint.TH
+
+import Language.Haskell.TH.Datatype (
+  ConstructorInfo (..),
+  DatatypeInfo (..),
+  reifyDatatype,
+ )
+
+import Cardano.CEM (CEMScriptTypes (..))
+import Cardano.CEM.OnChain (CEMScriptCompiled (..), genericCEMScript)
+import Cardano.CEM.Stages (Stages (..))
+import Data.Spine (deriveSpine)
+import PlutusTx.Show (deriveShow)
+
+defaultIndex :: Name -> Q [(Name, Natural)]
+defaultIndex name = do
+  info <- reifyDatatype name
+  pure $ zip (constructorName <$> datatypeCons info) [0 ..]
+
+unstableMakeIsDataSchema :: Name -> Q [InstanceDec]
+unstableMakeIsDataSchema name = do
+  index <- defaultIndex name
+  PlutusTx.makeIsDataSchemaIndexed name index
+
+unstableMakeHasSchemaInstance :: Name -> Q [InstanceDec]
+unstableMakeHasSchemaInstance name = do
+  index <- defaultIndex name
+  dec <- makeHasSchemaInstance name index
+  return [dec]
+
+-- | Get `TypeFamily Datatype` result as TH Name
+resolveFamily :: Name -> Name -> Q Name
+resolveFamily familyName argName = do
+  argType <- conT argName
+  [TySynInstD (TySynEqn _ _ (ConT name))] <-
+    reifyInstances familyName [argType]
+  return name
+
+deriveStageAssociatedTypes :: Name -> Q [Dec]
+deriveStageAssociatedTypes stageName = do
+  stageParamsName <- resolveFamily ''StageParams stageName
+  declss <-
+    sequenceQ
+      [ PlutusTx.unstableMakeIsData stageName
+      , PlutusTx.unstableMakeIsData stageParamsName
+      ]
+  return $ concat declss
+
+deriveCEMAssociatedTypes :: Bool -> Name -> Q [Dec]
+deriveCEMAssociatedTypes deriveBlueprint scriptName = do
+  declss <-
+    sequenceQ
+      [ -- Data
+        deriveFamily isDataDeriver ''Params
+      , deriveFamily isDataDeriver ''State
+      , deriveFamily isDataDeriver ''Transition
+      , -- Spines
+        deriveFamily deriveSpine ''State
+      , deriveFamily deriveSpine ''Transition
+      , -- Other
+        deriveShow scriptName
+      ]
+  return $ concat declss
+  where
+    isDataDeriver =
+      if deriveBlueprint
+        then unstableMakeIsDataSchema
+        else PlutusTx.unstableMakeIsData
+    deriveFamily deriver family = do
+      name <- resolveFamily family scriptName
+      deriver name
+
+compileCEM :: Name -> Q [Dec]
+compileCEM name = do
+  stageName <- resolveFamily ''Stage name
+  let compiled = PlutusTx.compileUntyped $ genericCEMScript name stageName
+  [d|
+    instance CEMScriptCompiled $(conT name) where
+      {-# INLINEABLE cemScriptCompiled #-}
+      cemScriptCompiled Proxy = serialiseCompiledCode $(compiled)
+    |]

From 5b99ba40db77af904674d6a8945328c405eaf0f2 Mon Sep 17 00:00:00 2001
From: Gregory Gerasev <uhbif19@gmail.com>
Date: Fri, 31 May 2024 19:50:44 +0700
Subject: [PATCH 2/3] Defaulting `Stage` to `SingleStage`

---
 src/Cardano/CEM.hs                 | 2 ++
 src/Cardano/CEM/Examples/Voting.hs | 1 -
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/Cardano/CEM.hs b/src/Cardano/CEM.hs
index b294a6b..7bcc618 100644
--- a/src/Cardano/CEM.hs
+++ b/src/Cardano/CEM.hs
@@ -92,6 +92,8 @@ class CEMScriptTypes script where
   -- | which is stored immutable in script Datum as well.
   type Stage script
 
+  type Stage script = SingleStage
+
   -- | `State` is changing part of script Datum.
   -- | It is in
   type State script = params | params -> script
diff --git a/src/Cardano/CEM/Examples/Voting.hs b/src/Cardano/CEM/Examples/Voting.hs
index bad584f..7c61a2d 100644
--- a/src/Cardano/CEM/Examples/Voting.hs
+++ b/src/Cardano/CEM/Examples/Voting.hs
@@ -89,7 +89,6 @@ PlutusTx.unstableMakeIsData ''VoteValue
 PlutusTx.unstableMakeIsData ''JuryPolicy
 
 instance CEMScriptTypes SimpleVoting where
-  type Stage SimpleVoting = SingleStage
   type Params SimpleVoting = SimpleVotingParams
   type State SimpleVoting = SimpleVotingState
   type Transition SimpleVoting = SimpleVotingTransition

From 2a09bcbea410decb38b62cc4a5375de5e86810ef Mon Sep 17 00:00:00 2001
From: Gregory Gerasev <uhbif19@gmail.com>
Date: Tue, 11 Jun 2024 02:47:47 +0700
Subject: [PATCH 3/3] WIP Blueprint example

---
 src/Cardano/CEM/Examples/Compilation.hs | 54 +++++++++++++-
 src/Cardano/CEM/Examples/Voting.hs      | 96 +++++++++++++++++++++----
 test/Voting.hs                          |  6 +-
 3 files changed, 140 insertions(+), 16 deletions(-)

diff --git a/src/Cardano/CEM/Examples/Compilation.hs b/src/Cardano/CEM/Examples/Compilation.hs
index ffcac47..7c0f471 100644
--- a/src/Cardano/CEM/Examples/Compilation.hs
+++ b/src/Cardano/CEM/Examples/Compilation.hs
@@ -6,11 +6,63 @@
 
 module Cardano.CEM.Examples.Compilation where
 
-import PlutusLedgerApi.V2 (serialiseCompiledCode)
+import Prelude
+
+import Data.Set qualified as Set
+
+import PlutusLedgerApi.V2 (BuiltinByteString, CurrencySymbol (CurrencySymbol), PubKeyHash, serialiseCompiledCode)
 
 import Cardano.CEM.Examples.Auction
 import Cardano.CEM.Examples.Voting
 import Cardano.CEM.TH
+import PlutusTx.Blueprint
 
 $(compileCEM ''SimpleAuction)
 $(compileCEM ''SimpleVoting)
+
+-- definitions :: Definitions (Unroll Value)
+-- definitions = error "TODO"
+-- deriveDefinitions @'[[CurrencySymbol]]
+
+type RefTypes = '[BuiltinByteString, PubKeyHash]
+
+votingBlueprint :: ContractBlueprint
+votingBlueprint =
+  MkContractBlueprint
+    { contractId = Just "voting"
+    , contractPreamble = votingPreamble
+    , contractValidators = Set.fromList [votingValidator]
+    , -- cemScriptCompiled $ Proxy @SimpleVoting
+      contractDefinitions = deriveDefinitions @'[SimpleVotingTransition]
+    }
+  where
+    votingPreamble =
+      MkPreamble
+        { preambleTitle = "Voting DApp"
+        , preambleDescription = Nothing
+        , preambleVersion = "0.1"
+        , preamblePlutusVersion = PlutusV2
+        , preambleLicense = Nothing
+        }
+    votingValidator =
+      MkValidatorBlueprint
+        { validatorTitle = "My Validator"
+        , validatorDescription = Nothing
+        , validatorParameters = []
+        , validatorRedeemer =
+            MkArgumentBlueprint
+              { argumentTitle = Nothing
+              , argumentDescription = Nothing
+              , argumentPurpose = Set.singleton Spend
+              , argumentSchema = definitionRef @SimpleVotingTransition
+              }
+        , validatorDatum =
+            Just
+              MkArgumentBlueprint
+                { argumentTitle = Nothing
+                , argumentDescription = Nothing
+                , argumentPurpose = Set.singleton Spend
+                , argumentSchema = definitionRef @SimpleVotingState
+                }
+        , validatorCompiledCode = Nothing
+        }
diff --git a/src/Cardano/CEM/Examples/Voting.hs b/src/Cardano/CEM/Examples/Voting.hs
index 7c61a2d..058cb81 100644
--- a/src/Cardano/CEM/Examples/Voting.hs
+++ b/src/Cardano/CEM/Examples/Voting.hs
@@ -1,6 +1,6 @@
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
 {-# HLINT ignore "Use when" #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 
 module Cardano.CEM.Examples.Voting where
 
@@ -9,21 +9,24 @@ import Prelude qualified
 
 import Data.Map qualified as Map
 
-import PlutusLedgerApi.V1.Crypto (PubKeyHash)
+import PlutusLedgerApi.V1.Crypto (PubKeyHash (..))
 import PlutusLedgerApi.V2 (Value)
-import PlutusTx qualified
 import PlutusTx.AssocMap qualified as PMap
 
 import Cardano.CEM
 import Cardano.CEM.Stages
-import Cardano.CEM.TH (deriveCEMAssociatedTypes)
+import Cardano.CEM.TH
+import Data.Typeable (Typeable)
+import GHC.Generics (Generic)
+import PlutusLedgerApi.V1.Value (CurrencySymbol, TokenName)
+import PlutusTx.Blueprint
 
 -- Voting
 
 data SimpleVoting
 
 data VoteValue = Yes | No | Abstain
-  deriving stock (Prelude.Show, Prelude.Eq)
+  deriving stock (Prelude.Show, Prelude.Eq, Generic)
 
 instance Eq VoteValue where
   Yes == Yes = True
@@ -31,9 +34,9 @@ instance Eq VoteValue where
   Abstain == Abstain = True
   _ == _ = False
 
--- | Policy determinig who can vote
+-- | Policy determining who can vote
 data JuryPolicy = Anyone | FixedJuryList [PubKeyHash] | WithToken Value
-  deriving stock (Prelude.Show, Prelude.Eq)
+  deriving stock (Prelude.Show, Prelude.Eq, Generic)
 
 -- Votes storage
 
@@ -70,30 +73,95 @@ data SimpleVotingParams = MkVotingParams
   , abstainAllowed :: Bool
   , drawDecision :: VoteValue
   }
-  deriving stock (Prelude.Show, Prelude.Eq)
+  deriving stock (Prelude.Show, Prelude.Eq, Generic)
 
 data SimpleVotingState
   = NotStarted
   | InProgress VoteStorage
   | Finalized VoteValue
-  deriving stock (Prelude.Show, Prelude.Eq)
+  deriving stock (Prelude.Show, Prelude.Eq, Generic)
 
 data SimpleVotingTransition
   = Create
   | Start
   | Vote PubKeyHash VoteValue
   | Finalize
-  deriving stock (Prelude.Show, Prelude.Eq)
+  deriving stock (Prelude.Show, Prelude.Eq, Generic)
+
+-- Orphans
+
+unstableMakeHasSchemaInstance ''PubKeyHash
+
+deriving anyclass instance (AsDefinitionId PubKeyHash)
+deriving anyclass instance (AsDefinitionId [PubKeyHash])
 
-PlutusTx.unstableMakeIsData ''VoteValue
-PlutusTx.unstableMakeIsData ''JuryPolicy
+unstableMakeHasSchemaInstance ''CurrencySymbol
+unstableMakeHasSchemaInstance ''TokenName
+deriving anyclass instance (AsDefinitionId CurrencySymbol)
+deriving anyclass instance (AsDefinitionId TokenName)
+
+-- deriving anyclass instance (AsDefinitionId [CurrencySymbol])
+
+deriving anyclass instance (Typeable k, Typeable v) => AsDefinitionId [(k, v)]
+deriving anyclass instance (Typeable k, Typeable v) => AsDefinitionId (PMap.Map k v)
+
+instance
+  ( Typeable k
+  , Typeable v
+  , HasSchemaDefinition [(k, v)] referencedTypes
+  ) =>
+  HasSchema (PMap.Map k v) referencedTypes
+  where
+  {-# INLINEABLE schema #-}
+  schema =
+    SchemaConstructor
+      (MkSchemaInfo Nothing Nothing Nothing)
+      ( MkConstructorSchema
+          0
+          [definitionRef @[(k, v)] @referencedTypes]
+      )
+
+{-
+instance
+  ( Typeable k
+  , Typeable v
+  , AsDefinitionId k
+  , AsDefinitionId v
+  , HasSchemaDefinition k referencedTypes
+  , HasSchemaDefinition v referencedTypes
+  ) =>
+  HasSchema (PMap.Map k v) referencedTypes
+  where
+  {-# INLINEABLE schema #-}
+  schema =
+    SchemaConstructor
+      (MkSchemaInfo Nothing Nothing Nothing)
+      ( MkConstructorSchema
+          0
+          [definitionRef @k @referencedTypes,
+          definitionRef @v @referencedTypes]
+      )
+-}
+
+unstableMakeHasSchemaInstance ''Value
+deriving anyclass instance (AsDefinitionId Value)
+
+--
+
+unstableMakeIsDataSchema ''VoteValue
+deriving anyclass instance (AsDefinitionId VoteValue)
+
+unstableMakeIsDataSchema ''JuryPolicy
+deriving anyclass instance (AsDefinitionId JuryPolicy)
+deriving anyclass instance (AsDefinitionId SimpleVotingParams)
+deriving anyclass instance (AsDefinitionId SimpleVotingState)
 
 instance CEMScriptTypes SimpleVoting where
   type Params SimpleVoting = SimpleVotingParams
   type State SimpleVoting = SimpleVotingState
   type Transition SimpleVoting = SimpleVotingTransition
 
-$(deriveCEMAssociatedTypes ''SimpleVoting)
+$(deriveCEMAssociatedTypes True ''SimpleVoting)
 
 instance CEMScript SimpleVoting where
   transitionStage _ =
diff --git a/test/Voting.hs b/test/Voting.hs
index 2c3b84b..37c227b 100644
--- a/test/Voting.hs
+++ b/test/Voting.hs
@@ -4,10 +4,12 @@ import Prelude hiding (readFile)
 
 import Control.Monad.IO.Class (MonadIO (..))
 
+import PlutusTx.Blueprint
+
 import Test.Hspec (describe, it, shouldBe)
 
 import Cardano.CEM
-import Cardano.CEM.Examples.Compilation ()
+import Cardano.CEM.Examples.Compilation (votingBlueprint)
 import Cardano.CEM.Examples.Voting
 import Cardano.CEM.Monads (MonadTest (..))
 import Cardano.CEM.OffChain
@@ -19,6 +21,8 @@ import Utils
 votingSpec = describe "Voting" $ do
   let ignoreTest (_name :: String) = const (return ())
 
+  it "Compile blueprint" $
+    writeBlueprint "/tmp/blueprint.json" votingBlueprint
   -- FIXME: fix Voting budget
   ignoreTest "Successfull flow" $
     execClb $ do