Skip to content

Commit 47ec226

Browse files
bezirgbezirg
committed
Added tests
1 parent 78ef7fd commit 47ec226

File tree

10 files changed

+334
-175
lines changed

10 files changed

+334
-175
lines changed

‎plutus-tx/plutus-tx.cabal‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -211,6 +211,7 @@ test-suite plutus-tx-test
211211
Blueprint.Spec
212212
List.Spec
213213
Bool.Spec
214+
Enum.Spec
214215
Rational.Laws
215216
Rational.Laws.Additive
216217
Rational.Laws.Construction
@@ -240,6 +241,7 @@ test-suite plutus-tx-test
240241
, plutus-core ^>=1.55
241242
, plutus-core:plutus-core-testlib
242243
, plutus-tx ^>=1.55
244+
, plutus-tx:plutus-tx-testlib
243245
, pretty-show
244246
, serialise
245247
, tasty

‎plutus-tx/src/PlutusTx/Enum.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,12 @@
11
{-# LANGUAGE OverloadedStrings #-}
22
{-# LANGUAGE TemplateHaskell #-}
33
{-# OPTIONS_GHC -Wno-orphans #-}
4+
45
module PlutusTx.Enum (Enum (..), deriveEnum) where
56

7+
import PlutusTx.Bool
68
import PlutusTx.Enum.Class
79
import PlutusTx.Enum.TH
8-
import PlutusTx.Bool
910
import PlutusTx.Ord
1011

1112
deriveEnum ''Bool

‎plutus-tx/src/PlutusTx/Enum/Class.hs‎

Lines changed: 17 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -1,26 +1,25 @@
11
module PlutusTx.Enum.Class (Enum (..)) where
22

3-
import PlutusTx.List
4-
import PlutusTx.Builtins
5-
import PlutusTx.Ord
63
import PlutusTx.Bool
4+
import PlutusTx.Builtins
5+
import PlutusTx.List
76
import PlutusTx.Numeric
7+
import PlutusTx.Ord
88

99
-- | Class 'Enum' defines operations on sequentially ordered types.
1010
class Enum a where
1111
{-# MINIMAL toEnum, fromEnum #-}
12+
1213
{-| The successor of a value. For numeric types, 'succ' adds 1.
1314
1415
For types that implement 'Ord', @succ x@ should be the least element
15-
that is greater than @x@, and 'error' if there is none.
16-
-}
16+
that is greater than @x@, and 'error' if there is none. -}
1717
succ :: a -> a
1818

1919
{-| The predecessor of a value. For numeric types, 'pred' subtracts 1.
2020
2121
For types that implement 'Ord', @pred x@ should be the greatest element
22-
that is less than @x@, and 'error' if there is none.
23-
-}
22+
that is less than @x@, and 'error' if there is none. -}
2423
pred :: a -> a
2524

2625
-- | Convert from an 'Integer'.
@@ -34,8 +33,7 @@ class Enum a where
3433

3534
{-| Construct a list from the given range (corresponds to [a,b..c]). This
3635
has the same semantics as the Haskell version,so if a==b and c>=b then you
37-
get an infinite list, which you probably don't want in Plutus Core.
38-
-}
36+
get an infinite list, which you probably don't want in Plutus Core. -}
3937
enumFromThenTo :: a -> a -> a -> [a]
4038

4139
{-# INLINEABLE succ #-}
@@ -72,13 +70,13 @@ instance Enum Integer where
7270
if delta >= 0
7371
then up_list x
7472
else dn_list x
75-
where
76-
delta = subtractInteger y x
77-
up_list x1 =
78-
if x1 > lim
79-
then []
80-
else x1 : up_list (addInteger x1 delta)
81-
dn_list x1 =
82-
if x1 < lim
83-
then []
84-
else x1 : dn_list (addInteger x1 delta)
73+
where
74+
delta = subtractInteger y x
75+
up_list x1 =
76+
if x1 > lim
77+
then []
78+
else x1 : up_list (addInteger x1 delta)
79+
dn_list x1 =
80+
if x1 < lim
81+
then []
82+
else x1 : dn_list (addInteger x1 delta)

‎plutus-tx/src/PlutusTx/Enum/TH.hs‎

Lines changed: 69 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -1,24 +1,25 @@
1-
{-# LANGUAGE TemplateHaskellQuotes #-}
21
{-# LANGUAGE DerivingStrategies #-}
3-
module PlutusTx.Enum.TH (Enum(..), deriveEnum) where
2+
{-# LANGUAGE TemplateHaskellQuotes #-}
43

5-
import PlutusTx.Enum.Class
6-
import PlutusTx.Trace
7-
import Prelude hiding (Eq, (==), (&&), Bool (True), Enum (..))
4+
module PlutusTx.Enum.TH (Enum (..), deriveEnum) where
5+
6+
import Control.Monad
7+
import Data.Deriving.Internal (varTToName)
88
import Data.Foldable
9+
import Data.Tuple
910
import Language.Haskell.TH as TH
1011
import Language.Haskell.TH.Datatype as TH
11-
import Data.Deriving.Internal (varTToName)
12-
import Control.Monad
13-
import Data.Tuple
12+
import PlutusTx.Enum.Class
13+
import PlutusTx.ErrorCodes
14+
import PlutusTx.Trace
15+
import Prelude hiding (Bool (True), Enum (..), Eq, (&&), (==))
1416

1517
data SuccPred = Succ | Pred
16-
deriving stock Show
18+
deriving stock (Show)
1719

1820
{-| Derive PlutusTx.Enum typeclass for datatypes, much like `deriving stock Enum` does for Haskell
1921
20-
Note: requires enabling OverloadedStrings language extension
21-
-}
22+
Note: requires enabling OverloadedStrings language extension -}
2223
deriveEnum :: TH.Name -> TH.Q [TH.Dec]
2324
deriveEnum name = do
2425
TH.DatatypeInfo
@@ -35,60 +36,73 @@ deriveEnum name = do
3536
instanceType :: TH.Type
3637
instanceType = TH.AppT (TH.ConT ''Enum) $ foldl' TH.AppT (TH.ConT tyConName) tyVars
3738

38-
table = zip (fmap IntegerL [0..]) (fmap constructorName cons)
39+
table = zip (fmap IntegerL [0 ..]) (fmap constructorName cons)
3940

4041
when (null cons) $
41-
fail $ "Can't make a derived instance of `Enum "
42-
++ show tyConName
43-
++ "`: "
44-
++ show tyConName
45-
++ " must must be an enumeration type (an enumeration consists of one or more nullary, non-GADT constructors)"
46-
47-
pure <$> instanceD (pure []) (pure instanceType)
48-
[
49-
funD 'succ (fmap (deriveSuccPred Succ) (zip cons (tail (Just <$> cons) ++ [Nothing])))
50-
, TH.pragInlD 'succ TH.Inlinable TH.FunLike TH.AllPhases
51-
52-
, funD 'pred (fmap (deriveSuccPred Pred) (zip cons (Nothing : init (Just <$> cons))))
53-
, TH.pragInlD 'pred TH.Inlinable TH.FunLike TH.AllPhases
54-
55-
, funD 'toEnum $ fmap deriveToEnum table <> [pure toEnumDefaultClause]
56-
, TH.pragInlD 'toEnum TH.Inlinable TH.FunLike TH.AllPhases
57-
58-
, funD 'fromEnum $ fmap (deriveFromEnum . swap) table
59-
, TH.pragInlD 'fromEnum TH.Inlinable TH.FunLike TH.AllPhases
60-
61-
]
42+
fail $
43+
"Can't make a derived instance of `Enum "
44+
++ show tyConName
45+
++ "`: "
46+
++ show tyConName
47+
++ " must must be an enumeration type (an enumeration consists of one or more nullary, non-GADT constructors)"
48+
49+
pure
50+
<$> instanceD
51+
(pure [])
52+
(pure instanceType)
53+
[ funD 'succ (fmap (deriveSuccPred Succ) (zip cons (tail (Just <$> cons) ++ [Nothing])))
54+
, TH.pragInlD 'succ TH.Inlinable TH.FunLike TH.AllPhases
55+
, funD 'pred (fmap (deriveSuccPred Pred) (zip cons (Nothing : init (Just <$> cons))))
56+
, TH.pragInlD 'pred TH.Inlinable TH.FunLike TH.AllPhases
57+
, funD 'toEnum $ fmap deriveToEnum table <> [pure toEnumDefaultClause]
58+
, TH.pragInlD 'toEnum TH.Inlinable TH.FunLike TH.AllPhases
59+
, funD 'fromEnum $ fmap (deriveFromEnum . swap) table
60+
, TH.pragInlD 'fromEnum TH.Inlinable TH.FunLike TH.AllPhases
61+
]
6262

6363
toEnumDefaultClause :: Clause
64-
toEnumDefaultClause = TH.Clause [WildP] (TH.NormalB $
65-
AppE (VarE 'traceError) (LitE $ StringL "tag is outside of enumeration's range")
66-
) []
64+
toEnumDefaultClause =
65+
TH.Clause
66+
[WildP]
67+
( TH.NormalB $
68+
AppE (VarE 'traceError) (VarE 'toEnumBadArgumentError)
69+
)
70+
[]
6771

6872
deriveToEnum :: (Lit, Name) -> Q Clause
69-
deriveToEnum (l,n) = pure (TH.Clause [LitP l] (NormalB $ ConE n) [])
73+
deriveToEnum (l, n) = pure (TH.Clause [LitP l] (NormalB $ ConE n) [])
7074

7175
deriveFromEnum :: (Name, Lit) -> Q Clause
72-
deriveFromEnum (n,l) = pure (TH.Clause [ConP n [] []] (NormalB $ LitE l) [])
76+
deriveFromEnum (n, l) = pure (TH.Clause [ConP n [] []] (NormalB $ LitE l) [])
7377

7478
deriveSuccPred :: SuccPred -> (ConstructorInfo, Maybe ConstructorInfo) -> Q Clause
75-
deriveSuccPred succPred ( ConstructorInfo {constructorName = nameL, constructorFields = [] }
76-
, Nothing)
77-
= pure (TH.Clause [ConP nameL [] []]
78-
(NormalB $ AppE (VarE 'traceError) (LitE $ StringL $ show succPred
79-
++ "{" ++ show nameL ++ "}: tried to take "
80-
++ show succPred
81-
++ " of "
82-
++ case succPred of { Succ -> "last" ; Pred -> "first"}
83-
++ " tag in enumeration" ))
84-
[])
85-
86-
deriveSuccPred _ ( ConstructorInfo {constructorName = nameL, constructorFields = [] }
87-
, Just ConstructorInfo {constructorName = nameR, constructorFields = [] }
88-
)
89-
= pure (TH.Clause [ConP nameL [] []]
79+
deriveSuccPred
80+
succPred
81+
( ConstructorInfo {constructorName = nameL, constructorFields = []}
82+
, Nothing
83+
) =
84+
pure
85+
( TH.Clause
86+
[ConP nameL [] []]
87+
( NormalB $
88+
AppE
89+
(VarE 'traceError)
90+
( VarE $ case succPred of
91+
Succ -> 'succBadArgumentError
92+
Pred -> 'predBadArgumentError
93+
)
94+
)
95+
[]
96+
)
97+
deriveSuccPred
98+
_
99+
( ConstructorInfo {constructorName = nameL, constructorFields = []}
100+
, Just ConstructorInfo {constructorName = nameR, constructorFields = []}
101+
) =
102+
pure
103+
( TH.Clause
104+
[ConP nameL [] []]
90105
(NormalB $ ConE nameR)
91106
[]
92-
)
93-
107+
)
94108
deriveSuccPred _ _ = fail "Can't make a derived instance of Enum when constructor has fields"

‎plutus-tx/src/PlutusTx/ErrorCodes.hs‎

Lines changed: 29 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,18 @@ plutusPreludeErrorCodes =
4646
, ("PT7", "PlutusTx.List.!!: index too large")
4747
, ("PT8", "PlutusTx.List.head: empty list")
4848
, ("PT9", "PlutusTx.List.tail: empty list")
49-
, ("PT10", "PlutusTx.Enum.().succ: bad argument")
49+
, ("PT19", "PlutusTx.List.last: empty list")
50+
, ("PT20", "PlutusTx.Ratio.recip: reciprocal of zero")
51+
, ("PT21", "PlutusTx.BuiltinList.!!: negative index")
52+
, ("PT22", "PlutusTx.BuiltinList.!!: index too large")
53+
, ("PT23", "PlutusTx.BuiltinList.head: empty list")
54+
, ("PT24", "PlutusTx.BuiltinList.tail: empty list")
55+
, ("PT25", "PlutusTx.BuiltinList.last: empty list")
56+
, ("PT26", "PlutusTx.Enum.succ: bad argument")
57+
, ("PT27", "PlutusTx.Enum.pred: bad argument")
58+
, ("PT28", "PlutusTx.Enum.toEnum: bad argument")
59+
, -- the following are retired
60+
("PT10", "PlutusTx.Enum.().succ: bad argument")
5061
, ("PT11", "PlutusTx.Enum.().pred: bad argument")
5162
, ("PT12", "PlutusTx.Enum.().toEnum: bad argument")
5263
, ("PT13", "PlutusTx.Enum.Bool.succ: bad argument")
@@ -55,13 +66,6 @@ plutusPreludeErrorCodes =
5566
, ("PT16", "PlutusTx.Enum.Ordering.succ: bad argument")
5667
, ("PT17", "PlutusTx.Enum.Ordering.pred: bad argument")
5768
, ("PT18", "PlutusTx.Enum.Ordering.toEnum: bad argument")
58-
, ("PT19", "PlutusTx.List.last: empty list")
59-
, ("PT20", "PlutusTx.Ratio.recip: reciprocal of zero")
60-
, ("PT21", "PlutusTx.BuiltinList.!!: negative index")
61-
, ("PT22", "PlutusTx.BuiltinList.!!: index too large")
62-
, ("PT23", "PlutusTx.BuiltinList.head: empty list")
63-
, ("PT24", "PlutusTx.BuiltinList.tail: empty list")
64-
, ("PT25", "PlutusTx.BuiltinList.last: empty list")
6569
]
6670

6771
-- | The error happens in TH generation of indexed data
@@ -104,6 +108,23 @@ tailEmptyListError :: Builtins.BuiltinString
104108
tailEmptyListError = "PT9"
105109
{-# INLINEABLE tailEmptyListError #-}
106110

111+
-- | PlutusTx.Enum.().succ: bad argument
112+
succBadArgumentError :: Builtins.BuiltinString
113+
succBadArgumentError = "PT26"
114+
{-# INLINEABLE succBadArgumentError #-}
115+
116+
-- | PlutusTx.Enum.().pred: bad argument
117+
predBadArgumentError :: Builtins.BuiltinString
118+
predBadArgumentError = "PT27"
119+
{-# INLINEABLE predBadArgumentError #-}
120+
121+
-- | PlutusTx.Enum.().toEnum: bad argument
122+
toEnumBadArgumentError :: Builtins.BuiltinString
123+
toEnumBadArgumentError = "PT28"
124+
{-# INLINEABLE toEnumBadArgumentError #-}
125+
126+
{-# DEPRECATED succVoidBadArgumentError, predVoidBadArgumentError, toEnumVoidBadArgumentError, succBoolBadArgumentError, predBoolBadArgumentError, toEnumBoolBadArgumentError, succOrderingBadArgumentError, predOrderingBadArgumentError, toEnumOrderingBadArgumentError "Use [succ|pred|toEnum]BadArgumentError instead." #-}
127+
107128
-- | PlutusTx.Enum.().succ: bad argument
108129
succVoidBadArgumentError :: Builtins.BuiltinString
109130
succVoidBadArgumentError = "PT10"

‎plutus-tx/test/Enum/Golden/Bool.golden.th‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
instance PlutusTx.Enum.Class.Enum GHC.Types.Bool
2+
where {PlutusTx.Enum.Class.succ (GHC.Types.False) = GHC.Types.True
3+
PlutusTx.Enum.Class.succ (GHC.Types.True) = PlutusTx.Trace.traceError PlutusTx.ErrorCodes.succBadArgumentError;
4+
{-# INLINABLE PlutusTx.Enum.Class.succ #-};
5+
PlutusTx.Enum.Class.pred (GHC.Types.False) = PlutusTx.Trace.traceError PlutusTx.ErrorCodes.predBadArgumentError
6+
PlutusTx.Enum.Class.pred (GHC.Types.True) = GHC.Types.False;
7+
{-# INLINABLE PlutusTx.Enum.Class.pred #-};
8+
PlutusTx.Enum.Class.toEnum 0 = GHC.Types.False
9+
PlutusTx.Enum.Class.toEnum 1 = GHC.Types.True
10+
PlutusTx.Enum.Class.toEnum _ = PlutusTx.Trace.traceError PlutusTx.ErrorCodes.toEnumBadArgumentError;
11+
{-# INLINABLE PlutusTx.Enum.Class.toEnum #-};
12+
PlutusTx.Enum.Class.fromEnum (GHC.Types.False) = 0
13+
PlutusTx.Enum.Class.fromEnum (GHC.Types.True) = 1;
14+
{-# INLINABLE PlutusTx.Enum.Class.fromEnum #-}}

‎plutus-tx/test/Enum/Golden/SomeVeryLargeEnum.golden.th‎

Lines changed: 46 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
1+
instance PlutusTx.Enum.Class.Enum Enum.Spec.SomeVeryLargeEnum
2+
where {PlutusTx.Enum.Class.succ (Enum.Spec.E1) = Enum.Spec.E2
3+
PlutusTx.Enum.Class.succ (Enum.Spec.E2) = Enum.Spec.E3
4+
PlutusTx.Enum.Class.succ (Enum.Spec.E3) = Enum.Spec.E4
5+
PlutusTx.Enum.Class.succ (Enum.Spec.E4) = Enum.Spec.E5
6+
PlutusTx.Enum.Class.succ (Enum.Spec.E5) = Enum.Spec.E6
7+
PlutusTx.Enum.Class.succ (Enum.Spec.E6) = Enum.Spec.E7
8+
PlutusTx.Enum.Class.succ (Enum.Spec.E7) = Enum.Spec.E8
9+
PlutusTx.Enum.Class.succ (Enum.Spec.E8) = Enum.Spec.E9
10+
PlutusTx.Enum.Class.succ (Enum.Spec.E9) = Enum.Spec.E10
11+
PlutusTx.Enum.Class.succ (Enum.Spec.E10) = PlutusTx.Trace.traceError PlutusTx.ErrorCodes.succBadArgumentError;
12+
{-# INLINABLE PlutusTx.Enum.Class.succ #-};
13+
PlutusTx.Enum.Class.pred (Enum.Spec.E1) = PlutusTx.Trace.traceError PlutusTx.ErrorCodes.predBadArgumentError
14+
PlutusTx.Enum.Class.pred (Enum.Spec.E2) = Enum.Spec.E1
15+
PlutusTx.Enum.Class.pred (Enum.Spec.E3) = Enum.Spec.E2
16+
PlutusTx.Enum.Class.pred (Enum.Spec.E4) = Enum.Spec.E3
17+
PlutusTx.Enum.Class.pred (Enum.Spec.E5) = Enum.Spec.E4
18+
PlutusTx.Enum.Class.pred (Enum.Spec.E6) = Enum.Spec.E5
19+
PlutusTx.Enum.Class.pred (Enum.Spec.E7) = Enum.Spec.E6
20+
PlutusTx.Enum.Class.pred (Enum.Spec.E8) = Enum.Spec.E7
21+
PlutusTx.Enum.Class.pred (Enum.Spec.E9) = Enum.Spec.E8
22+
PlutusTx.Enum.Class.pred (Enum.Spec.E10) = Enum.Spec.E9;
23+
{-# INLINABLE PlutusTx.Enum.Class.pred #-};
24+
PlutusTx.Enum.Class.toEnum 0 = Enum.Spec.E1
25+
PlutusTx.Enum.Class.toEnum 1 = Enum.Spec.E2
26+
PlutusTx.Enum.Class.toEnum 2 = Enum.Spec.E3
27+
PlutusTx.Enum.Class.toEnum 3 = Enum.Spec.E4
28+
PlutusTx.Enum.Class.toEnum 4 = Enum.Spec.E5
29+
PlutusTx.Enum.Class.toEnum 5 = Enum.Spec.E6
30+
PlutusTx.Enum.Class.toEnum 6 = Enum.Spec.E7
31+
PlutusTx.Enum.Class.toEnum 7 = Enum.Spec.E8
32+
PlutusTx.Enum.Class.toEnum 8 = Enum.Spec.E9
33+
PlutusTx.Enum.Class.toEnum 9 = Enum.Spec.E10
34+
PlutusTx.Enum.Class.toEnum _ = PlutusTx.Trace.traceError PlutusTx.ErrorCodes.toEnumBadArgumentError;
35+
{-# INLINABLE PlutusTx.Enum.Class.toEnum #-};
36+
PlutusTx.Enum.Class.fromEnum (Enum.Spec.E1) = 0
37+
PlutusTx.Enum.Class.fromEnum (Enum.Spec.E2) = 1
38+
PlutusTx.Enum.Class.fromEnum (Enum.Spec.E3) = 2
39+
PlutusTx.Enum.Class.fromEnum (Enum.Spec.E4) = 3
40+
PlutusTx.Enum.Class.fromEnum (Enum.Spec.E5) = 4
41+
PlutusTx.Enum.Class.fromEnum (Enum.Spec.E6) = 5
42+
PlutusTx.Enum.Class.fromEnum (Enum.Spec.E7) = 6
43+
PlutusTx.Enum.Class.fromEnum (Enum.Spec.E8) = 7
44+
PlutusTx.Enum.Class.fromEnum (Enum.Spec.E9) = 8
45+
PlutusTx.Enum.Class.fromEnum (Enum.Spec.E10) = 9;
46+
{-# INLINABLE PlutusTx.Enum.Class.fromEnum #-}}

‎plutus-tx/test/Enum/Golden/Unit.golden.th‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
instance PlutusTx.Enum.Class.Enum GHC.Tuple.Prim.()
2+
where {PlutusTx.Enum.Class.succ (GHC.Tuple.Prim.()) = PlutusTx.Trace.traceError PlutusTx.ErrorCodes.succBadArgumentError;
3+
{-# INLINABLE PlutusTx.Enum.Class.succ #-};
4+
PlutusTx.Enum.Class.pred (GHC.Tuple.Prim.()) = PlutusTx.Trace.traceError PlutusTx.ErrorCodes.predBadArgumentError;
5+
{-# INLINABLE PlutusTx.Enum.Class.pred #-};
6+
PlutusTx.Enum.Class.toEnum 0 = GHC.Tuple.Prim.()
7+
PlutusTx.Enum.Class.toEnum _ = PlutusTx.Trace.traceError PlutusTx.ErrorCodes.toEnumBadArgumentError;
8+
{-# INLINABLE PlutusTx.Enum.Class.toEnum #-};
9+
PlutusTx.Enum.Class.fromEnum (GHC.Tuple.Prim.()) = 0;
10+
{-# INLINABLE PlutusTx.Enum.Class.fromEnum #-}}

0 commit comments

Comments
 (0)