From d0d77dca70f57cd79d4ecc51e719991a6dc38068 Mon Sep 17 00:00:00 2001
From: Yura Lazarev <1009751+Unisay@users.noreply.github.com>
Date: Fri, 28 Jun 2024 11:08:02 +0200
Subject: [PATCH] Fix "un-rolling" a list type. (#6165)

* Fix "un-rolling" a list type.

* Un-roll other general types: [], Maybe, (,), BuiltinUnit, BuiltinPair
---
 .../PlutusTx/Blueprint/Definition/Unroll.hs   | 10 +++++---
 plutus-tx/test/Blueprint/Spec.hs              | 24 ++++++++++++++++++-
 2 files changed, 30 insertions(+), 4 deletions(-)

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