diff --git a/plutus-extra/plutus-extra.cabal b/plutus-extra/plutus-extra.cabal index 78952373..b8ac2301 100644 --- a/plutus-extra/plutus-extra.cabal +++ b/plutus-extra/plutus-extra.cabal @@ -70,6 +70,7 @@ library Plutus.V1.Ledger.Interval.Extra Plutus.V1.Ledger.Time.Extra Plutus.V1.Ledger.Value.Extra + Plutus.V1.Ledger.Value.Norm PlutusTx.AssocMap.Extra PlutusTx.Bifunctor PlutusTx.Bimap diff --git a/plutus-extra/src/Plutus/V1/Ledger/Value/Norm.hs b/plutus-extra/src/Plutus/V1/Ledger/Value/Norm.hs new file mode 100644 index 00000000..9092bbf3 --- /dev/null +++ b/plutus-extra/src/Plutus/V1/Ledger/Value/Norm.hs @@ -0,0 +1,86 @@ +module Plutus.V1.Ledger.Value.Norm ( + NormValue, + toNormValue, + fromNormValue, + mapNormValue, + unsafeMapNormValue, +) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Kind (Type) +import Plutus.V1.Ledger.Api qualified as Ledger +import Plutus.V1.Ledger.Value qualified as Value +import PlutusTx (FromData, ToData, UnsafeFromData) +import PlutusTx.AssocMap qualified as AssocMap +import PlutusTx.Prelude +import Prettyprinter (Pretty) +import Prettyprinter.Extras (PrettyShow (PrettyShow)) +import Prelude qualified + +newtype NormValue = NormValue Ledger.Value + deriving stock (Prelude.Show) + deriving (Pretty) via (PrettyShow NormValue) + deriving + ( ToJSON + , FromJSON + , ToData + , FromData + , UnsafeFromData + , Prelude.Eq + , Eq + , Prelude.Semigroup + , Semigroup + , Prelude.Monoid + , Monoid + , Group + , AdditiveSemigroup + , AdditiveMonoid + , AdditiveGroup + , JoinSemiLattice + , MeetSemiLattice + ) + via Ledger.Value + +deriving via Ledger.Value instance Module Integer NormValue + +instance MultiplicativeSemigroup NormValue where + {-# INLINEABLE (*) #-} + NormValue (Ledger.Value val1) * NormValue (Ledger.Value val2) = + NormValue $ Ledger.Value $ mapZipWith (mapZipWith (*)) val1 val2 + +{-# INLINEABLE mapZipWith #-} +mapZipWith :: + forall (k :: Type) (a :: Type) (b :: Type) (c :: Type). + Eq k => + (a -> b -> c) -> + AssocMap.Map k a -> + AssocMap.Map k b -> + AssocMap.Map k c +mapZipWith f map0 map1 = + AssocMap.mapMaybeWithKey (\k v -> f v <$> AssocMap.lookup k map1) map0 + +{-# INLINEABLE toNormValue #-} +toNormValue :: Ledger.Value -> NormValue +toNormValue = NormValue . normalizeValue + +{-# INLINEABLE fromNormValue #-} +fromNormValue :: NormValue -> Ledger.Value +fromNormValue (NormValue v) = v + +{-# INLINEABLE mapNormValue #-} +mapNormValue :: (Ledger.Value -> Ledger.Value) -> NormValue -> NormValue +mapNormValue f = toNormValue . f . fromNormValue + +{-# INLINEABLE unsafeMapNormValue #-} +unsafeMapNormValue :: (Ledger.Value -> Ledger.Value) -> NormValue -> NormValue +unsafeMapNormValue f = NormValue . f . fromNormValue + +{-# INLINEABLE normalizeValue #-} +normalizeValue :: Ledger.Value -> Ledger.Value +normalizeValue (Ledger.Value v) = + fold + . concatMap + ( \(sym, xs) -> + map (uncurry $ Value.singleton sym) $ AssocMap.toList xs + ) + $ AssocMap.toList v \ No newline at end of file