Un-roll other general types: [], Maybe, (,), BuiltinUnit, BuiltinPair

IntersectMBO · Jun 5, 2024 · aab3f66 · aab3f66
1 parent 54d6f27
commit aab3f66
Show file tree

Hide file tree

Showing 2 changed files with 26 additions and 10 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,9 +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 ()
 
 ----------------------------------------------------------------------------------------------------
@@ -71,12 +71,6 @@ $( PlutusTx.asData
 testUnrollNop :: Unroll Nop :~: '[Nop]
 testUnrollNop = Refl
 
-testUnrollListNop :: Unroll [Nop] :~: '[Nop]
-testUnrollListNop = Refl
-
-testUnrollListsNop :: Unroll [[[Nop]]] :~: '[Nop]
-testUnrollListsNop = Refl
-
 testUnrollBaz :: Unroll Baz :~: [Baz, Integer]
 testUnrollBaz = Refl
 
@@ -100,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