-
-
Notifications
You must be signed in to change notification settings - Fork 28
Expand file tree
/
Copy pathExposable.hs
More file actions
80 lines (72 loc) · 3.03 KB
/
Exposable.hs
File metadata and controls
80 lines (72 loc) · 3.03 KB
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
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module : HsLua.Class.Exposable
Copyright : © 2007–2012 Gracjan Polak,
2012–2016 Ömer Sinan Ağacan,
2017-2021 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
Stability : beta
Portability : FlexibleInstances, ForeignFunctionInterface, ScopedTypeVariables
Call Haskell functions from Lua.
-}
module HsLua.Class.Exposable
( Exposable (..)
, toHaskellFunction
, registerHaskellFunction
) where
import HsLua.Core as Lua
import HsLua.Class.Peekable (Peekable (peek), PeekError (..), inContext)
import HsLua.Class.Pushable (Pushable (push))
-- | Operations and functions that can be pushed to the Lua stack. This
-- is a helper function not intended to be used directly. Use the
-- @'toHaskellFunction'@ wrapper instead.
class PeekError e => Exposable e a where
-- | Helper function, called by @'toHaskellFunction'@. Should do a
-- partial application of the argument at the given index to the
-- underlying function. Recurses if necessary, causing further partial
-- applications until the operation is a easily exposable to Lua.
partialApply :: StackIndex -> a -> LuaE e NumResults
instance {-# OVERLAPPING #-} PeekError e =>
Exposable e (HaskellFunction e) where
partialApply _ = id
instance (PeekError e, Pushable a) => Exposable e (LuaE e a) where
partialApply _narg x = 1 <$ (x >>= push)
instance (Peekable a, Exposable e b) => Exposable e (a -> b) where
partialApply narg f = getArg >>= partialApply (narg + 1) . f
where
getArg = inContext errorPrefix (peek narg)
errorPrefix = "could not read argument " ++
show (fromStackIndex narg) ++ ":"
-- | Convert a Haskell function to a function type directly exposable to
-- Lua. Any Haskell function can be converted provided that:
--
-- * all arguments are instances of @'Peekable'@
-- * return type is @Lua a@, where @a@ is an instance of
-- @'Pushable'@
--
-- Any @'Lua.Exception'@ will be converted to a string and returned
-- as Lua error.
--
-- /Important/: this does __not__ catch exceptions other than
-- @'Lua.Exception'@; exception handling must be done by the converted
-- Haskell function. Failure to do so will cause the program to crash.
--
-- E.g., the following code could be used to handle an Exception
-- of type FooException, if that type is an instance of
-- 'Control.Monad.Catch.MonadCatch' and 'Pushable':
--
-- > toHaskellFunction (myFun `catchM` (\e -> raiseError (e :: FooException)))
--
toHaskellFunction :: forall e a. Exposable e a => a -> HaskellFunction e
toHaskellFunction a = do
inContext "Error during function call:" $ partialApply 1 a
-- | Imports a Haskell function and registers it at global name.
registerHaskellFunction :: Exposable e a
=> Name -> a -> LuaE e ()
registerHaskellFunction n f = do
pushHaskellFunction $ toHaskellFunction f
setglobal n