Fix "un-rolling" a list type. (#6165)

* Fix "un-rolling" a list type. * Un-roll other general types: [], Maybe, (,), BuiltinUnit, BuiltinPair
IntersectMBO · Jun 28, 2024 · d0d77dc · d0d77dc
1 parent e3c3fd2
commit d0d77dc
Show file tree

Hide file tree

Showing 2 changed files with 30 additions and 4 deletions.
diff --git 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
@@ -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