Merge pull request #2 from gnumonik/ctl-cleanup

Ctl cleanup

src/FromData.purs

@@ -33,30 +33,12 @@ import Data.UInt (UInt)
 import Data.Unfoldable (class Unfoldable)
 import Helpers (bigIntToUInt)
 import Prelude
-  ( class EuclideanRing
-  , class Ord
-  , class Show
-  , Unit
-  , Void
-  , bind
-  , discard
-  , one
-  , pure
-  , unit
-  , zero
-  , ($)
-  , (<$>)
-  , (<*>)
-  , (<<<)
-  , (=<<)
-  , (==)
-  )
 import Prim.Row as Row
 import Prim.RowList as RL
 import Prim.TypeError (class Fail, Text)
 import Record as Record
 import Type.Proxy (Proxy(Proxy))
-import TypeLevel.DataSchema (class HasPlutusSchema, class ValidPlutusSchema)
+import Plutus.Types.DataSchema (class HasPlutusSchema, class ValidPlutusSchema)
 import TypeLevel.Nat (class KnownNat, natVal)
 import TypeLevel.RowList.Unordered.Indexed
   ( class GetIndexWithLabel

src/TypeLevel/DataSchema.purs → src/Plutus/Types/DataSchema.purs

@@ -1,4 +1,4 @@
-module TypeLevel.DataSchema
+module Plutus.Types.DataSchema
   ( PSchema
   , class HasPlutusSchema
   , PNil
@@ -14,7 +14,6 @@ module TypeLevel.DataSchema
   , Field
   , MkField
   , MkField_
-  -- , NoRec
   , type (:=)
   , class SchemaToRowList
   , class PlutusSchemaToRowListI

src/ToData.purs

@@ -12,7 +12,7 @@ module ToData
   , toDataWithSchema
   ) where
 
-import Prelude (Unit, Void, absurd, identity, map, one, zero, ($), (<<<), (<>), (>>>))
+import Prelude
 import Data.Array (cons, sortWith)
 import Data.Array as Array
 import Data.NonEmpty (NonEmpty)
@@ -34,7 +34,7 @@ import Prim.TypeError (class Fail, Text)
 import Record as Record
 import Type.RowList as RL
 
-import TypeLevel.DataSchema (class HasPlutusSchema, class ValidPlutusSchema)
+import Plutus.Types.DataSchema (class HasPlutusSchema, class ValidPlutusSchema)
 import TypeLevel.Nat (class KnownNat, natVal)
 import TypeLevel.RowList.Unordered.Indexed
   ( class GetIndexWithLabel

src/TypeLevel/RowList.purs

@@ -1,6 +1,5 @@
 module TypeLevel.RowList
   ( class AllUniqueLabels
-  , tests
   ) where
 
 import Prim.TypeError (class Fail, Text)
@@ -21,41 +20,3 @@ else instance
   ) =>
   AllUniqueLabels (Cons k a (Cons k' a' xs))
 
--- | Poor man's type level tests
-tests ∷ Array String
-tests =
-  [ testNil
-  , testSingleton
-  , testUniques
-  -- , testDupsUnordered
-  -- , testDups
-  ]
-  where
-  testNil :: AllUniqueLabels Nil => String
-  testNil = "Empty list has all unique labels"
-
-  testSingleton
-    :: forall (a :: Type). AllUniqueLabels (Cons "A" a Nil) => String
-  testSingleton = "Singleton list has all unique labels"
-
-  testUniques
-    :: forall (a :: Type)
-     . AllUniqueLabels
-         ( Cons "A" a
-             (Cons "B" a (Cons "C" a Nil))
-         )
-    => String
-  testUniques = "[A, B, C] is all unique and should compile"
-
-  _testDupsUnordered
-    :: forall (a :: Type)
-     . AllUniqueLabels (Cons "A" a (Cons "B" a (Cons "A" a (Cons "B" a Nil))))
-    => String
-  _testDupsUnordered = "[A, B, A, B] has duplicates but should compile"
-
-  _testDups
-    :: forall (a :: Type)
-     . AllUniqueLabels (Cons "A" a (Cons "A" a Nil))
-    => String
-  _testDups = "[A, A] has duplicates and shouldn't compile"
-

src/TypeLevel/RowList/Unordered/Indexed.purs

@@ -10,7 +10,6 @@ module TypeLevel.RowList.Unordered.Indexed
   , class IndexRowList
   , class IndexRowListWithAcc
   , class UniqueIndices
-  , uniqueIndicesTests
   ) where
 
 import TypeLevel.Nat (class KnownNat, Nat, S, Z)
@@ -49,54 +48,6 @@ else instance
   ) =>
   UniqueIndices (ConsI k a n (ConsI k' a' n' xs))
 
-uniqueIndicesTests ∷ Array String
-uniqueIndicesTests =
-  [ testNil
-  , testSingletonZ
-  , testSingletonSSZ
-  , testUniques
-  -- , _testDups
-  -- , _testDups2
-  ]
-  where
-  testNil :: UniqueIndices NilI => String
-  testNil = "Empty list has all unique indices"
-
-  testSingletonZ
-    :: forall (a :: Type). UniqueIndices (ConsI "A" a Z NilI) => String
-  testSingletonZ = "Singleton list has all unique indices"
-
-  testSingletonSSZ
-    :: forall (a :: Type). UniqueIndices (ConsI "A" a (S (S Z)) NilI) => String
-  testSingletonSSZ = "Singleton list has all unique indices"
-
-  testUniques
-    :: forall (a :: Type)
-     . UniqueIndices
-         ( ConsI "A" a Z
-             (ConsI "B" a (S Z) (ConsI "C" a (S (S Z)) NilI))
-         )
-    => String
-  testUniques = "[0, 1, 2] have all unique indices"
-
-  _testDups
-    :: forall (a :: Type)
-     . UniqueIndices
-         ( ConsI "A" a (S Z)
-             (ConsI "B" a (S Z) (ConsI "C" a (S (S Z)) NilI))
-         )
-    => String
-  _testDups = "[1, 1, 2] has dups and shouldn't compile"
-
-  _testDups2
-    :: forall (a :: Type)
-     . UniqueIndices
-         ( ConsI "A" a (S Z)
-             (ConsI "B" a Z (ConsI "C" a (S Z) NilI))
-         )
-    => String
-  _testDups2 = "[1, 0, 1] has dups and shouldn't compile"
-
 -- | Uniqueness constraint on the labels of a RowListI which asserts that all labels are unique.
 -- Again, this is needed so that the lookup functions perform in the expected manner.
 class AllUniqueLabelsI :: forall (k :: Type). RowListI k -> Constraint

src/Types/Interval.purs

@@ -59,7 +59,10 @@ import Helpers (uIntToBigInt, bigIntToUInt)
 import Partial.Unsafe (unsafePartial)
 import Prelude
 import Serialization.Address (Slot(Slot))
-
+import Plutus.Types.DataSchema (class HasPlutusSchema, type (:+), type (:=), type (@@), I, PNil)
+import TypeLevel.Nat (S, Z)
+import ToData (class ToData, genericToData)
+import FromData (class FromData, genericFromData)
 --------------------------------------------------------------------------------
 -- Interval Type and related
 --------------------------------------------------------------------------------
@@ -71,6 +74,20 @@ type Closure = Boolean
 -- | A set extended with a positive and negative infinity.
 data Extended a = NegInf | Finite a | PosInf
 
+instance
+  HasPlutusSchema
+    (Extended a)
+    ("NegInf" := PNil @@ Z
+    :+ "Finite" := PNil @@ (S Z)
+    :+ "PosInf" := PNil @@ (S (S Z))
+    :+ PNil)
+
+instance ToData a => ToData (Extended a) where
+  toData e = genericToData e
+
+instance FromData a => FromData (Extended a) where
+  fromData e = genericFromData e
+
 derive instance Generic (Extended a) _
 derive instance Eq a => Eq (Extended a)
 -- Don't change order of Extended of deriving Ord as below
@@ -83,6 +100,15 @@ instance Show a => Show (Extended a) where
 -- | The lower bound of an interval.
 data LowerBound a = LowerBound (Extended a) Closure
 
+instance HasPlutusSchema (LowerBound a) ("LowerBound" := PNil @@ Z
+                                         :+ PNil)
+
+instance ToData a => ToData (LowerBound a) where
+  toData lb = genericToData lb
+
+instance FromData a => FromData (LowerBound a) where
+  fromData lb = genericFromData lb
+
 derive instance Generic (LowerBound a) _
 derive instance Eq a => Eq (LowerBound a)
 derive instance Functor LowerBound
@@ -101,8 +127,18 @@ instance Ord a => Ord (LowerBound a) where
     EQ -> in2 `compare` in1
 
 -- | The upper bound of an interval.
+data UpperBound :: Type -> Type
 data UpperBound a = UpperBound (Extended a) Closure
 
+instance HasPlutusSchema (UpperBound a) ("UpperBound" := PNil @@ Z
+                                        :+ PNil)
+
+instance ToData a => ToData (UpperBound a) where
+  toData ub = genericToData ub
+
+instance FromData a => FromData (UpperBound a) where
+  fromData ub = genericFromData ub
+
 derive instance Generic (UpperBound a) _
 derive instance Eq a => Eq (UpperBound a)
 -- Ord is safe to derive because a closed (true) upper bound is greater than
@@ -118,8 +154,19 @@ instance Show a => Show (UpperBound a) where
 -- | that the endpoints may or may not be included in the interval.
 -- |
 -- | The interval can also be unbounded on either side.
+newtype Interval :: Type -> Type
 newtype Interval a = Interval { from :: LowerBound a, to :: UpperBound a }
 
+instance
+  HasPlutusSchema (Interval a)
+    ("Interval" :=
+      ("from" := I (LowerBound a)
+      :+ "to" := I (UpperBound a)
+      :+ PNil)
+     @@ Z
+    :+ PNil)
+
+
 derive instance Generic (Interval a) _
 derive newtype instance Eq a => Eq (Interval a)
 derive instance Functor Interval
@@ -139,6 +186,11 @@ instance Ord a => MeetSemilattice (Interval a) where
 instance Ord a => BoundedMeetSemilattice (Interval a) where
   top = always
 
+instance ToData a => ToData (Interval a) where
+  toData i = genericToData i
+
+instance FromData a => FromData (Interval a) where
+  fromData i = genericFromData i
 --------------------------------------------------------------------------------
 -- POSIXTIME Type and related
 --------------------------------------------------------------------------------

test/Data.purs

@@ -1,22 +1,7 @@
 -- | Tests for `ToData`/`FromData`
-module Test.Data (suite) where
+module Test.Data (suite, tests, uniqueIndicesTests) where
 
 import Prelude
-  ( class Eq
-  , class Show
-  , Unit
-  , bind
-  , discard
-  , map
-  , negate
-  , pure
-  , show
-  , unit
-  , ($)
-  , (<<<)
-  , (<>)
-  , (=<<)
-  )
 
 import Contract.PlutusData (PlutusData(Constr, Integer))
 import Control.Lazy (fix)
@@ -40,18 +25,21 @@ import Test.QuickCheck.Gen (Gen)
 import Test.Spec.Assertions (shouldEqual)
 import TestM (TestPlanM)
 import ToData (class ToData, genericToData, toData)
+import Type.RowList (Cons,Nil)
 import Types.ByteArray (hexToByteArrayUnsafe)
 import TypeLevel.Nat (Z, S)
 import Untagged.Union (asOneOf)
 
-import TypeLevel.DataSchema
+import Plutus.Types.DataSchema
   ( class HasPlutusSchema
   , type (:+)
   , type (:=)
   , type (@@)
   , I
   , PNil
   )
+import TypeLevel.RowList (class AllUniqueLabels)
+import TypeLevel.RowList.Unordered.Indexed (NilI, ConsI, class UniqueIndices)
 
 suite :: TestPlanM Unit
 suite = do
@@ -467,3 +455,56 @@ testBinaryFixture value binaryFixture = do
     map (toBytes <<< asOneOf) (PDS.convertPlutusData (toData value))
       `shouldEqual` Just
         (hexToByteArrayUnsafe binaryFixture)
+
+-- | Poor man's type level tests
+tests ∷ Array String
+tests =
+  [ testNil
+  , testSingleton
+  , testUniques
+  ]
+  where
+  testNil :: AllUniqueLabels Nil => String
+  testNil = "Empty list has all unique labels"
+
+  testSingleton
+    :: forall (a :: Type). AllUniqueLabels (Cons "A" a Nil) => String
+  testSingleton = "Singleton list has all unique labels"
+
+  testUniques
+    :: forall (a :: Type)
+     . AllUniqueLabels
+         ( Cons "A" a
+             (Cons "B" a (Cons "C" a Nil))
+         )
+    => String
+  testUniques = "[A, B, C] is all unique and should compile"
+
+
+uniqueIndicesTests ∷ Array String
+uniqueIndicesTests =
+  [ testNil
+  , testSingletonZ
+  , testSingletonSSZ
+  , testUniques
+  ]
+  where
+  testNil :: UniqueIndices NilI => String
+  testNil = "Empty list has all unique indices"
+
+  testSingletonZ
+    :: forall (a :: Type). UniqueIndices (ConsI "A" a Z NilI) => String
+  testSingletonZ = "Singleton list has all unique indices"
+
+  testSingletonSSZ
+    :: forall (a :: Type). UniqueIndices (ConsI "A" a (S (S Z)) NilI) => String
+  testSingletonSSZ = "Singleton list has all unique indices"
+
+  testUniques
+    :: forall (a :: Type)
+     . UniqueIndices
+         ( ConsI "A" a Z
+             (ConsI "B" a (S Z) (ConsI "C" a (S (S Z)) NilI))
+         )
+    => String
+  testUniques = "[0, 1, 2] have all unique indices"