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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-|
Module : HsLua.Packaging.UDTypeTests
Copyright : © 2020-2024 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <tarleb@hslua.org>
Tests for calling exposed Haskell functions.
-}
module HsLua.Packaging.UDTypeTests (tests) where
import HsLua.Core
import HsLua.Packaging.Function
import HsLua.Packaging.UDType
import HsLua.Marshalling
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HsLua ((=:), shouldBeResultOf)
import qualified Data.ByteString.Char8 as Char8
-- | Calling Haskell functions from Lua.
tests :: TestTree
tests = testGroup "DocumentedType"
[ testGroup "Foo type"
[ "show" =:
"Foo 5 \"five\"" `shouldBeResultOf` do
openlibs
pushUD typeFoo $ Foo 5 "five"
setglobal "foo"
_ <- dostring "return foo:show()"
forcePeek $ peekText top
, "pairs iterates over properties" =:
["num", "5", "str", "echo", "show", "function"] `shouldBeResultOf` do
openlibs
pushUD typeFoo $ Foo 5 "echo"
setglobal "echo"
OK <- dostring $ Char8.unlines
[ "local result = {}"
, "for k, v in pairs(echo) do"
, " table.insert(result, k)"
, " table.insert("
, " result,"
, " type(v) == 'function' and 'function' or tostring(v)"
, " )"
, "end"
, "return result"
]
forcePeek $ peekList peekText top
]
, testGroup "Sum type"
[ "tostring Quux" =:
"Quux 11 \"eleven\"" `shouldBeResultOf` do
openlibs
pushUD typeQux $ Quux 11 "eleven"
setglobal "quux"
_ <- dostring "return tostring(quux)"
forcePeek $ peekText top
, "show Quux" =:
"Quux 11 \"eleven\"" `shouldBeResultOf` do
openlibs
pushUD typeQux $ Quux 11 "eleven"
setglobal "quux"
_ <- dostring "return quux:show()"
forcePeek $ peekText top
]
]
--
-- Sample types
--
data Foo = Foo Int String
deriving (Eq, Show)
show' :: LuaError e => DocumentedFunction e
show' = defun "show"
### liftPure (show @Foo)
<#> udparam typeFoo "foo" "Object"
=#> functionResult pushString "string" "stringified foo"
typeFoo :: LuaError e => DocumentedType e Foo
typeFoo = deftype "Foo"
[ operation Tostring show'
]
[ property "num" "some number"
(pushIntegral, \(Foo n _) -> n)
(peekIntegral, \(Foo _ s) n -> Foo n s)
, readonly "str" "some string" (pushString, \(Foo _ s) -> s)
, method show'
]
--
-- Sum Type
--
data Qux
= Quux Int String
| Quuz Point Int
deriving (Eq, Show)
data Point = Point Double Double
deriving (Eq, Show)
pushPoint :: LuaError e => Pusher e Point
pushPoint (Point x y) = do
newtable
pushName "x" *> pushRealFloat x *> rawset (nth 3)
pushName "y" *> pushRealFloat y *> rawset (nth 3)
peekPoint :: LuaError e => Peeker e Point
peekPoint idx = do
x <- peekFieldRaw peekRealFloat "x" idx
y <- peekFieldRaw peekRealFloat "y" idx
return $ x `seq` y `seq` Point x y
showQux :: LuaError e => DocumentedFunction e
showQux = defun "show"
### liftPure (show @Qux)
<#> parameter peekQux "qux" "qux" "Object"
=#> functionResult pushString "string" "stringified Qux"
peekQux :: LuaError e => Peeker e Qux
peekQux = peekUD typeQux
typeQux :: LuaError e => DocumentedType e Qux
typeQux = deftype "Qux"
[ operation Tostring showQux ]
[ method showQux
, property "num" "some number"
(pushIntegral, \case
Quux n _ -> n
Quuz _ n -> n)
(peekIntegral, \case
Quux _ s -> (`Quux` s)
Quuz d _ -> Quuz d)
, possibleProperty "str" "a string in Quux"
(pushString, \case
Quux _ s -> Actual s
Quuz {} -> Absent)
(peekString, \case
Quux n _ -> Actual . Quux n
Quuz {} -> const Absent)
, possibleProperty "point" "a point in Quuz"
(pushPoint, \case
Quuz p _ -> Actual p
Quux {} -> Absent)
(peekPoint, \case
Quuz _ n -> Actual . (`Quuz` n)
Quux {} -> const Absent)
, alias "x" "The x coordinate of a point in Quuz" ["point", "x"]
]
|
