#if __GLASGOW_HASKELL__ < 710
#endif
module Haste.Prim.Foreign (
module Haste.Prim.Any,
FFI, JSFunc,
ffi, constant, export
#if __GLASGOW_HASKELL__ >= 710
, safe_ffi, StaticPtr
#endif
) where
import Haste.Prim
import Haste.Prim.Any
#if __GLASGOW_HASKELL__ >= 710
import GHC.StaticPtr (StaticPtr, deRefStaticPtr)
#endif
type JSFun = JSAny
#ifdef __HASTE__
foreign import ccall "eval" __eval :: JSString -> JSFun
foreign import ccall __apply :: JSFun -> Ptr [JSAny] -> IO JSAny
foreign import ccall __app0 :: JSFun -> IO JSAny
foreign import ccall __app1 :: JSFun -> JSAny -> IO JSAny
foreign import ccall __app2 :: JSFun -> JSAny -> JSAny -> IO JSAny
foreign import ccall __app3 :: JSFun -> JSAny -> JSAny -> JSAny -> IO JSAny
foreign import ccall __app4 :: JSFun
-> JSAny -> JSAny -> JSAny -> JSAny -> IO JSAny
foreign import ccall __app5 :: JSFun
-> JSAny -> JSAny -> JSAny -> JSAny -> JSAny
-> IO JSAny
foreign import ccall __createJSFunc :: Int -> JSAny -> IO JSAny
#else
__eval :: JSString -> JSFun
__eval _ = undefined
__apply :: JSFun -> Ptr [JSAny] -> IO JSAny
__apply _ _ = return undefined
__app0 :: JSFun -> IO JSAny
__app0 _ = return undefined
__app1 :: JSFun -> JSAny -> IO JSAny
__app1 _ _ = return undefined
__app2 :: JSFun -> JSAny -> JSAny -> IO JSAny
__app2 _ _ _ = return undefined
__app3 :: JSFun -> JSAny -> JSAny -> JSAny -> IO JSAny
__app3 _ _ _ _ = return undefined
__app4 :: JSFun -> JSAny -> JSAny -> JSAny -> JSAny -> IO JSAny
__app4 _ _ _ _ _ = return undefined
__app5 :: JSFun -> JSAny -> JSAny -> JSAny -> JSAny -> JSAny -> IO JSAny
__app5 _ _ _ _ _ _ = return undefined
__createJSFunc :: Int -> JSAny -> IO JSAny
__createJSFunc _ = return undefined
#endif
class FFI a where
__ffi :: JSFun -> [JSAny] -> a
instance FromAny a => FFI (IO a) where
__ffi = ffiio
instance (ToAny a, FFI b) => FFI (a -> b) where
__ffi f !as !a = __ffi f (a' : as)
where !a' = toAny a
ffiio :: FromAny a => JSFun -> [JSAny] -> IO a
ffiio !f !as = __apply f (toPtr as) >>= fromAny
ffi :: FFI a => JSString -> a
ffi s = __ffi f []
where
f = __eval s
#if __GLASGOW_HASKELL__ >= 710
safe_ffi :: FFI a => StaticPtr JSString -> a
safe_ffi = ffi . deRefStaticPtr
#endif
constant :: FromAny a => JSString -> a
constant = veryUnsafePerformIO . fromAny . __eval
export :: ToAny a => JSString -> a -> IO ()
export = ffi "(function(s,f){Haste[s] = f;})"
type family JS a where
JS (a -> b) = JSAny -> JS b
JS (IO a) = IO JSAny
JS a = JSAny
class JSFunc a where
mkJSFunc :: a -> JS a
arity :: a -> Int
#if __GLASGOW_HASKELL__ < 710
instance (ToAny a, JS a ~ JSAny) => JSFunc a where
#else
instance (ToAny a, JS a ~ JSAny) => JSFunc a where
#endif
mkJSFunc = toAny
arity _ = 0
instance ToAny a => JSFunc (IO a) where
mkJSFunc = fmap toAny
arity _ = 1
instance (FromAny a, JSFunc b) => JSFunc (a -> b) where
mkJSFunc f = mkJSFunc . f . veryUnsafePerformIO . fromAny
arity f = 1 + arity (f undefined)
instance (FromAny a, JSFunc b) => ToAny (a -> b) where
toAny f =
veryUnsafePerformIO . __createJSFunc (arity f) . toAny . toOpaque $ mkJSFunc f
instance ToAny a => ToAny (IO a) where
toAny = veryUnsafePerformIO . __createJSFunc 0 . toAny . toOpaque . mkJSFunc
#if __GLASGOW_HASKELL__ < 710
instance FFI a => FromAny a where
#else
instance FFI a => FromAny a where
#endif
fromAny f = return $ __ffi f []