diff --git a/plutus-tx/src/PlutusTx/Blueprint/Definition/Unroll.hs b/plutus-tx/src/PlutusTx/Blueprint/Definition/Unroll.hs index fe5befb140a..552f17116c5 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Definition/Unroll.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Definition/Unroll.hs @@ -26,8 +26,8 @@ import GHC.TypeLits qualified as GHC import PlutusTx.Blueprint.Class (HasSchema) import PlutusTx.Blueprint.Definition.Id as DefinitionId (AsDefinitionId (..)) import PlutusTx.Blueprint.Definition.Internal (Definitions (..), addDefinition, definition) -import PlutusTx.Builtins.Internal (BuiltinByteString, BuiltinData, BuiltinList, BuiltinString, - BuiltinUnit) +import PlutusTx.Builtins.Internal (BuiltinByteString, BuiltinData, BuiltinList, BuiltinPair, + BuiltinString, BuiltinUnit) ---------------------------------------------------------------------------------------------------- -- Functionality to "unroll" types. -- For more context see Note ["Unrolling" types] ----------- @@ -89,8 +89,12 @@ type family Unroll (p :: Type) :: [Type] where Unroll BuiltinData = '[BuiltinData] Unroll BuiltinUnit = '[BuiltinUnit] Unroll BuiltinString = '[BuiltinString] - Unroll (BuiltinList a) = Prepend (BuiltinList a) (GUnroll (Rep a)) + Unroll (BuiltinList a) = Unroll a + Unroll (BuiltinPair a b) = Unroll a ++ Unroll b Unroll BuiltinByteString = '[BuiltinByteString] + Unroll [a] = Unroll a + Unroll (a, b) = Unroll a ++ Unroll b + Unroll (Maybe a) = Unroll a Unroll p = Prepend p (GUnroll (Break (NoGeneric p) (Rep p))) -- | Detect stuck type family: https://blog.csongor.co.uk/report-stuck-families/#custom-type-errors diff --git a/plutus-tx/test/Blueprint/Spec.hs b/plutus-tx/test/Blueprint/Spec.hs index c81755799f8..37c01f50162 100644 --- a/plutus-tx/test/Blueprint/Spec.hs +++ b/plutus-tx/test/Blueprint/Spec.hs @@ -21,7 +21,7 @@ import PlutusTx.Blueprint.Definition (AsDefinitionId, Definitions, Unroll, Unrol Unrollable (..)) import PlutusTx.Blueprint.Schema (Schema (..)) import PlutusTx.Blueprint.Schema.Annotation (emptySchemaInfo) -import PlutusTx.Builtins (BuiltinData) +import PlutusTx.Builtins.Internal (BuiltinData, BuiltinList, BuiltinPair, BuiltinUnit) import PlutusTx.IsData () ---------------------------------------------------------------------------------------------------- @@ -74,6 +74,9 @@ testUnrollNop = Refl testUnrollBaz :: Unroll Baz :~: [Baz, Integer] testUnrollBaz = Refl +testUnrollListBaz :: Unroll [Baz] :~: [Baz, Integer] +testUnrollListBaz = Refl + testUnrollZap :: Unroll Zap :~: [Zap, Nop, Integer, Bool] testUnrollZap = Refl @@ -91,3 +94,22 @@ definitions = unroll @(UnrollAll '[Foo]) testUnrollDat :: Unroll Dat :~: '[Dat, BuiltinData] testUnrollDat = Refl + +testUnrollList :: Unroll [Bool] :~: '[Bool] +testUnrollList = Refl + +testUnrollNestedLists :: Unroll [[[Bool]]] :~: '[Bool] +testUnrollNestedLists = Refl + +testUnrollPair :: Unroll (Integer, Bool) :~: '[Bool, Integer] +testUnrollPair = Refl + +testUnrollBuiltinPair :: Unroll (BuiltinPair Integer Bool) :~: '[Bool, Integer] +testUnrollBuiltinPair = Refl + +testUnrollBuiltinList + :: Unroll (BuiltinList (BuiltinPair Bool BuiltinUnit)) :~: '[BuiltinUnit, Bool] +testUnrollBuiltinList = Refl + +testUnrollMaybe :: Unroll (Maybe Bool) :~: '[Bool] +testUnrollMaybe = Refl