|
| 1 | +{-# LANGUAGE BlockArguments #-} |
| 2 | +{-# LANGUAGE DataKinds #-} |
| 3 | +{-# LANGUAGE OverloadedStrings #-} |
| 4 | +{-# LANGUAGE TemplateHaskell #-} |
| 5 | +{-# LANGUAGE NoImplicitPrelude #-} |
| 6 | +{-# LANGUAGE TypeApplications #-} |
| 7 | +{-# OPTIONS_GHC -fplugin PlutusTx.Plugin #-} |
| 8 | +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:max-cse-iterations=0 #-} |
| 9 | +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:max-simplifier-iterations-pir=0 #-} |
| 10 | +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:max-simplifier-iterations-uplc=0 #-} |
| 11 | +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:no-optimize #-} |
| 12 | +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:no-simplifier-beta #-} |
| 13 | +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:no-simplifier-evaluate-builtins #-} |
| 14 | + |
| 15 | +module Bounded.Spec where |
| 16 | + |
| 17 | +import PlutusTx |
| 18 | +import PlutusTx.Test (goldenPirReadable) |
| 19 | +import Test.Tasty.Extras |
| 20 | +import PlutusTx.Bounded |
| 21 | +import PlutusTx.Prelude |
| 22 | +import PlutusTx.Plugin (plc) |
| 23 | +import Data.Proxy (Proxy (..)) |
| 24 | + |
| 25 | +data SomeVeryLargeEnum |
| 26 | + = E1 |
| 27 | + | E2 |
| 28 | + | E3 |
| 29 | + | E4 |
| 30 | + | E5 |
| 31 | + | E6 |
| 32 | + | E7 |
| 33 | + | E8 |
| 34 | + | E9 |
| 35 | + | E10 |
| 36 | +deriveBounded ''SomeVeryLargeEnum |
| 37 | + |
| 38 | +data SingleConstructor a = SingleConstructor Bool a () |
| 39 | +deriveBounded ''SingleConstructor |
| 40 | + |
| 41 | +newtype PhantomADT e = PhantomADT () |
| 42 | +deriveBounded ''PhantomADT |
| 43 | + |
| 44 | +minAndMax :: Bounded a => (a, a) |
| 45 | +minAndMax = (minBound,maxBound) |
| 46 | + |
| 47 | +compiledSomeVeryLargeEnum :: CompiledCode (SomeVeryLargeEnum, SomeVeryLargeEnum) |
| 48 | +compiledSomeVeryLargeEnum = plc (Proxy @"compiledSomeVeryLargeEnum") minAndMax |
| 49 | + |
| 50 | +compiledSingleConstructor :: CompiledCode (SingleConstructor Ordering, SingleConstructor Ordering) |
| 51 | +compiledSingleConstructor = plc (Proxy @"compiledSingleConstructor") minAndMax |
| 52 | + |
| 53 | +{- here cannot use Ordering or Either as the phantom type because of |
| 54 | +pir compile error (unrelated to Bounded): |
| 55 | +GHC Core to PLC plugin: Error: Error from the PIR compiler: |
| 56 | +Error during compilation: Type bindings cannot appear in recursive let, use datatypebind instead |
| 57 | +See https://github.com/IntersectMBO/plutus/issues/7498 |
| 58 | +-} |
| 59 | +compiledPhantomADT :: CompiledCode (PhantomADT Bool, PhantomADT Bool) |
| 60 | +compiledPhantomADT = plc (Proxy @"compiledPhantomADT") minAndMax |
| 61 | + |
| 62 | +tests :: TestNested |
| 63 | +tests = |
| 64 | + testNested |
| 65 | + "Bounded" |
| 66 | + [ testNestedGhc |
| 67 | + [ goldenPirReadable "SomeVeryLargeEnum" compiledSomeVeryLargeEnum |
| 68 | + , goldenPirReadable "SingleConstructor" compiledSingleConstructor |
| 69 | + , goldenPirReadable "PhantomADT" compiledPhantomADT |
| 70 | + ] |
| 71 | + ] |
0 commit comments