plutus/plutus-tx-plugin/test/TH/Spec.hs at 28abdf4b5e9b45b3113fc6bad05b89010d67a365 · IntersectMBO/plutus · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -fplugin-opt Plinth.Plugin:context-level=3 #-}
{-# OPTIONS_GHC -fplugin-opt Plinth.Plugin:datatypes=BuiltinCasing #-}
{-# OPTIONS_GHC -fplugin-opt Plinth.Plugin:defer-errors #-}
{-# OPTIONS_GHC -fplugin-opt Plinth.Plugin:max-cse-iterations=0 #-}
{-# OPTIONS_GHC -fplugin-opt Plinth.Plugin:max-simplifier-iterations-pir=0 #-}
{-# OPTIONS_GHC -fplugin-opt Plinth.Plugin:max-simplifier-iterations-uplc=0 #-}

module TH.Spec (tests) where

import Test.Tasty.Extras

import PlutusCore.Pretty

import PlutusTx
import PlutusTx.Builtins qualified as Builtins
import PlutusTx.List qualified as List
import PlutusTx.Prelude
import PlutusTx.Show (show)
import PlutusTx.Test

import Prelude qualified as Haskell

import TH.TestTH

data SomeType = One Integer | Two | Three ()

makeIsDataIndexed ''SomeType [('Two, 0), ('One, 1), ('Three, 2)]

someData :: (BuiltinData, BuiltinData, BuiltinData)
someData = (toBuiltinData (One 1), toBuiltinData Two, toBuiltinData (Three ()))

tests :: TestNested
tests =
  testNested "TH"
    . pure
    $ testNestedGhc
      [ goldenPir "simple" simple
      , goldenPir "power" powerPlc
      , goldenPir "and" andPlc
      , goldenEvalCek "all" allPlc
      , goldenEvalCek "convertString" convertString
      , goldenEvalCekLog "traceDirect" traceDirect
      , goldenEvalCekLog "tracePrelude" tracePrelude
      , goldenEvalCekLog "traceRepeatedly" traceRepeatedly
      , goldenPir "ignoredUntypedLambdaArguments" ignoredUntypedLambdaArguments
      , goldenPir "ignoredUntypedThreeLambdaArguments" ignoredUntypedThreeLambdaArguments
      , -- want to see the raw structure, so using Show
        nestedGoldenVsDoc "someData" "" (pretty $ Haskell.show someData)
      ]

simple :: CompiledCode (Bool -> Integer)
simple = $$(compile [||\(x :: Bool) -> if x then (1 :: Integer) else (2 :: Integer)||])

-- similar to the power example for Feldspar - should be completely unrolled at compile time
powerPlc :: CompiledCode (Integer -> Integer)
powerPlc = $$(compile [||$$(power (4 :: Integer))||])

andPlc :: CompiledCode Bool
andPlc = $$(compile [||$$(andTH) True False||])

allPlc :: CompiledCode Bool
allPlc = $$(compile [||List.all (\(x :: Integer) -> x > 5) [7, 6]||])

convertString :: CompiledCode Builtins.BuiltinString
convertString = $$(compile [||"test"||])

traceDirect :: CompiledCode ()
traceDirect = $$(compile [||Builtins.trace "test" ()||])

tracePrelude :: CompiledCode Integer
tracePrelude = $$(compile [||trace "test" (1 :: Integer)||])

traceRepeatedly :: CompiledCode Integer
traceRepeatedly =
  $$( compile
        [||
        let i1 = trace "Making my first int" (1 :: Integer)
            i2 = trace "Making my second int" (2 :: Integer)
            i3 = trace ("Adding them up: " <> show (i1 + i2)) (i1 + i2)
         in i3
        ||]
    )

ignoredUntypedLambdaArguments :: CompiledCode (BuiltinData -> BuiltinData -> ())
ignoredUntypedLambdaArguments = $$(compile [||\_ _ -> ()||])

ignoredUntypedThreeLambdaArguments :: CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> ())
ignoredUntypedThreeLambdaArguments = $$(compile [||\_ _ _ -> ()||])