diff --git a/cem-script.cabal b/cem-script.cabal index ebcb8d0..9c36e6d 100644 --- a/cem-script.cabal +++ b/cem-script.cabal @@ -157,7 +157,6 @@ library Cardano.CEM.Compile Cardano.CEM.Documentation Cardano.CEM.DSL - Cardano.CEM.DSLSmart Cardano.CEM.Indexing.Event Cardano.CEM.Indexing.Oura Cardano.CEM.Indexing.Tx @@ -166,6 +165,7 @@ library Cardano.CEM.Monads.L1Commons Cardano.CEM.OffChain Cardano.CEM.OnChain + Cardano.CEM.Smart Cardano.CEM.TH build-depends: diff --git a/lib/cardano-extras/Cardano/Extras.hs b/lib/cardano-extras/Cardano/Extras.hs index 1826335..a5ce7e6 100644 --- a/lib/cardano-extras/Cardano/Extras.hs +++ b/lib/cardano-extras/Cardano/Extras.hs @@ -1,8 +1,6 @@ {-# OPTIONS_GHC -Wno-orphans #-} -{- | Various utils to cope with `cardano-api` types -Mainly stolen from `hydra-cardano-api` and some from `atlas` --} +-- | Various utils to cope with `cardano-api` types. module Cardano.Extras where import Prelude diff --git a/lib/cardano-extras/Plutarch/Extras.hs b/lib/cardano-extras/Plutarch/Extras.hs index b2c61af..7963b73 100644 --- a/lib/cardano-extras/Plutarch/Extras.hs +++ b/lib/cardano-extras/Plutarch/Extras.hs @@ -2,8 +2,6 @@ module Plutarch.Extras where -import Prelude - import Plutarch import Plutarch.Builtin import Plutarch.LedgerApi @@ -11,6 +9,7 @@ import Plutarch.LedgerApi.Value import Plutarch.Maybe (pfromJust) import Plutarch.Monadic qualified as P import Plutarch.Prelude +import Prelude pMkAdaOnlyValue :: Term s (PInteger :--> PValue Unsorted NonZero) pMkAdaOnlyValue = phoistAcyclic $ plam $ \lovelaces -> diff --git a/lib/cardano-extras/Plutus/Extras.hs b/lib/cardano-extras/Plutus/Extras.hs index b445d08..6f3ac0f 100644 --- a/lib/cardano-extras/Plutus/Extras.hs +++ b/lib/cardano-extras/Plutus/Extras.hs @@ -1,18 +1,16 @@ module Plutus.Extras where -import PlutusTx.Prelude - import Cardano.Api ( Script (..), SerialiseAsRawBytes (serialiseToRawBytes), hashScript, ) import Cardano.Api.Shelley (PlutusScript (..)) -import PlutusLedgerApi.Common (SerialisedScript) -import PlutusLedgerApi.V2 (ScriptHash (..), UnsafeFromData (..)) - import Cardano.Extras +import PlutusLedgerApi.Common (SerialisedScript) import PlutusLedgerApi.V1.Value (CurrencySymbol (..)) +import PlutusLedgerApi.V2 (ScriptHash (..), UnsafeFromData (..)) +import PlutusTx.Prelude -- | Signature of an untyped validator script. type ValidatorType = BuiltinData -> BuiltinData -> BuiltinData -> () diff --git a/lib/data-spine/Data/Spine.hs b/lib/data-spine/Data/Spine.hs index 09768cc..9974048 100644 --- a/lib/data-spine/Data/Spine.hs +++ b/lib/data-spine/Data/Spine.hs @@ -3,15 +3,38 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE PolyKinds #-} -{- | -Note about design decision on nested spines. -`getSpine (Just Value) = JustSpine ValueSpine` - looks more usable, -than `getSpine (Just Value) = JustSpine`. -But it seem to break deriving for parametised types like `Maybe a`, -and can be done with `fmap getSpine mValue`. Probably it actually -works exaclty for functorial parameters. +{- | Spine is datatype, which tags only constructors of ADT skipping their content. + TH deriving utility generates Spines which are Enums but one could introduce + more complex Spine datatypes manually. + + Initially this module didn't depend on any cardano code, and this state of + things can be restored if needed. For Plutus version we attach some additional + information to spines. + + A note on design decision on nested spines. + + `getSpine (Just Value) = JustSpine ValueSpine` + + seems to be more sensible than: + + `getSpine (Just Value) = JustSpine`. + + But it seem to break deriving for parametised types like `Maybe a`, + and can be done with `fmap getSpine mValue`. Probably it actually + works exaclty for functorial parameters. -} -module Data.Spine where +module Data.Spine ( + -- * Common spines + HasSpine (..), + deriveSpine, + allSpines, + + -- * Plutus Spines + HasPlutusSpine (..), + derivePlutusSpine, + spineFieldsNum, + fieldNum, +) where import Data.Data (Proxy) import Data.List (elemIndex) @@ -25,11 +48,6 @@ import PlutusTx (FromData, ToData, UnsafeFromData, unstableMakeIsData) import Prelude -- | Definitions - -{- | Spine is datatype, which tags only constructors of ADT skipping their content. - TH deriving utility generates Spines which are Enums but one could introduce - more complex Spine datatypes manually. --} class ( Ord (Spine sop) , Show (Spine sop) @@ -41,7 +59,9 @@ class type Spine sop = spine | spine -> sop getSpine :: sop -> Spine sop --- | Version of `HasSpine` knowing its Plutus Data encoding +{- | Version of `HasSpine` that knows its Plutus Data encoding and keeps +names of fields for every constructor. +-} class ( HasSpine sop , UnsafeFromData sop @@ -59,7 +79,6 @@ spineFieldsNum :: forall sop. (HasPlutusSpine sop) => Spine sop -> Natural spineFieldsNum spine = toNat $ length $ (fieldsMap @sop) Map.! spine --- FIXME: use spine do discriminate fieldNum :: forall sop label. (HasPlutusSpine sop, KnownSymbol label) => @@ -72,7 +91,7 @@ fieldNum proxyLabel = fieldName = symbolVal proxyLabel fieldIndex dict = toNat <$> elemIndex fieldName dict -allSpines :: forall sop. (HasPlutusSpine sop) => [Spine sop] +allSpines :: forall sop. (HasSpine sop) => [Spine sop] allSpines = [Prelude.minBound .. Prelude.maxBound] -- | Phantom type param is required for `HasSpine` injectivity @@ -91,7 +110,6 @@ addSuffix :: Name -> String -> Name addSuffix (Name (OccName name) flavour) suffix = Name (OccName $ name <> suffix) flavour --- FIXME: cleaner return type reifyDatatype :: Name -> Q (Name, [Name], [[Name]]) reifyDatatype ty = do (TyConI tyCon) <- reify ty diff --git a/src/Cardano/CEM.hs b/src/Cardano/CEM.hs index 0b8c942..08cbce8 100644 --- a/src/Cardano/CEM.hs +++ b/src/Cardano/CEM.hs @@ -2,8 +2,6 @@ module Cardano.CEM ( module X, ) where --- TODO: review - import Cardano.CEM.Address as X ( cemScriptAddress, cemScriptPlutusAddress, @@ -18,13 +16,16 @@ import Cardano.CEM.DSL as X ( RecordSetter ((::=)), TxConstraint, ) -import Cardano.CEM.DSLSmart as X import Cardano.CEM.Monads as X import Cardano.CEM.Monads.CLB as X import Cardano.CEM.OffChain as X import Cardano.CEM.OnChain as X +import Cardano.CEM.Smart as X import Cardano.CEM.TH as X ( compileCEMOnchain, deriveCEMAssociatedTypes, ) -import Data.Spine as X (derivePlutusSpine) +import Data.Spine as X ( + derivePlutusSpine, + deriveSpine, + ) diff --git a/src/Cardano/CEM/Monads/CLB.hs b/src/Cardano/CEM/Monads/CLB.hs index 5c73f28..88a90b8 100644 --- a/src/Cardano/CEM/Monads/CLB.hs +++ b/src/Cardano/CEM/Monads/CLB.hs @@ -2,18 +2,12 @@ module Cardano.CEM.Monads.CLB where -import Prelude - -import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar) -import Control.Monad.State (StateT (..), gets) -import Data.Map qualified as Map -import Data.Set qualified as Set - --- Cardano imports import Cardano.Api hiding (queryUtxo) import Cardano.Api.Query (fromLedgerUTxO) - --- Lib imports +import Cardano.CEM.Monads +import Cardano.CEM.Monads.L1Commons +import Cardano.CEM.OffChain (fromPlutusAddressInMonad) +import Cardano.Extras (Era) import Clb ( ClbState (mockConfig), ClbT (..), @@ -29,16 +23,13 @@ import Clb ( ) import Clb.MockConfig (defaultBabbage) import Clb.TimeSlot (posixTimeToUTCTime) - --- CEM imports - -import Cardano.CEM.Monads -import Cardano.CEM.Monads.L1Commons -import Cardano.CEM.OffChain (fromPlutusAddressInMonad) +import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar) import Control.Monad.Reader (MonadReader (..), ReaderT (..)) - -import Cardano.Extras (Era) +import Control.Monad.State (StateT (..), gets) import Data.Either.Extra (mapRight) +import Data.Map qualified as Map +import Data.Set qualified as Set +import Prelude instance (MonadReader r m) => MonadReader r (ClbT m) where ask = lift ask @@ -80,7 +71,7 @@ instance instance (Monad m, MonadBlockchainParams (ClbT m)) => MonadQueryUtxo (ClbT m) where queryUtxo query = do - utxos <- fromLedgerUTxO shelleyBasedEra <$> gets getUtxosAtState + utxos <- gets (fromLedgerUTxO shelleyBasedEra . getUtxosAtState) predicate <- mkPredicate return $ UTxO $ Map.filterWithKey predicate $ unUTxO utxos where diff --git a/src/Cardano/CEM/DSLSmart.hs b/src/Cardano/CEM/Smart.hs similarity index 98% rename from src/Cardano/CEM/DSLSmart.hs rename to src/Cardano/CEM/Smart.hs index 9b81d5e..3017065 100644 --- a/src/Cardano/CEM/DSLSmart.hs +++ b/src/Cardano/CEM/Smart.hs @@ -1,6 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -module Cardano.CEM.DSLSmart where +-- | Smart constructors fir DSL/constraints +module Cardano.CEM.Smart where import Cardano.CEM.DSL import Data.Map (Map) diff --git a/test/CEM/Test/Auction.hs b/test/CEM/Test/Auction.hs index 4693779..40b8d74 100644 --- a/test/CEM/Test/Auction.hs +++ b/test/CEM/Test/Auction.hs @@ -8,7 +8,6 @@ import CEM.Test.TestNFT (testNftAssetClass) import CEM.Test.Utils ( execClb, mintTestTokens, - -- perTransitionStats, submitAndCheck, submitCheckReturn, ) diff --git a/test/CEM/Test/OuraFilters/Auction.hs b/test/CEM/Test/OuraFilters/Auction.hs index 9ade880..e21d964 100644 --- a/test/CEM/Test/OuraFilters/Auction.hs +++ b/test/CEM/Test/OuraFilters/Auction.hs @@ -8,7 +8,7 @@ import CEM.Example.Compiled () import CEM.Test.Oura.Communication qualified as Oura import CEM.Test.OuraFilters.Mock qualified as Mock import CEM.Test.Utils (SpotGarbage, withTimeout) -import Cardano.CEM hiding (error) -- FIXME: +import Cardano.CEM hiding (error) import Cardano.CEM.Indexing import Cardano.Ledger.BaseTypes qualified as Ledger import Control.Lens ((%~), (.~)) diff --git a/test/CEM/Test/Utils.hs b/test/CEM/Test/Utils.hs index 226f607..1006368 100644 --- a/test/CEM/Test/Utils.hs +++ b/test/CEM/Test/Utils.hs @@ -115,7 +115,6 @@ mintTestTokens userSk numMint = do checkTxCreated :: (MonadQueryUtxo m, MonadIO m) => TxId -> m () checkTxCreated txId = do - -- FIXME: better checks for tests awaitTx txId let txIn = TxIn txId (TxIx 0)