@@ -0,0 +1,195 @@
1+{-# LANGUAGE ForeignFunctionInterface
2+ , TypeSynonymInstances
3+ , FlexibleInstances
4+ , DeriveDataTypeable #-}
5+-----------------------------------------------------------------------------
6+--
7+-- Module : Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Value
8+-- Copyright : (c) Hamish Mackenzie
9+-- License : MIT
10+--
11+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
12+--
13+-- |
14+--
15+-----------------------------------------------------------------------------
16+
17+module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Value (
18+ JSNull(..)
19+ , JSUndefined
20+ , JSBool
21+ , JSNumber
22+ , JSString
23+ , JSValue(..)
24+
25+ , JSStringRef
26+ , JSObjectRef
27+ , JSValueRef
28+
29+ , valToBool
30+ , valToNumber
31+ , valToStr
32+ , valToObject
33+
34+ , strToText
35+ , textToStr
36+
37+ , MakeValueRef(..)
38+ , MakeStringRef(..)
39+
40+ , valMakeNull
41+ , valMakeUndefined
42+ , valMakeBool
43+ , valMakeNumber
44+ , valMakeString
45+
46+ , deRefVal
47+ , valMakeRef
48+) where
49+
50+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
51+ (JSObjectRef, JSStringRef, JSValueRef)
52+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Monad (rethrow, JSC)
53+import Control.Monad.Trans.Reader (ask)
54+import Control.Monad.IO.Class (MonadIO, MonadIO(..))
55+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef
56+ (JSType(..), jsvaluegettype, jsvaluemakestring, jsvaluemakenumber,
57+ jsvaluemakeboolean, jsvaluemakeundefined, jsvaluemakenull,
58+ jsvaluetoobject, jsvaluetostringcopy, jsvaluetonumber,
59+ jsvaluetoboolean)
60+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef
61+ (jsstringcreatewithcharacters, jsstringgetcharactersptr,
62+ jsstringgetlength)
63+import qualified Data.Text.Foreign as T (fromPtr)
64+import Foreign (castPtr)
65+import Data.Text.Foreign (useAsPtr)
66+import Control.Applicative ((<$>))
67+import Data.Text (Text)
68+import qualified Data.Text as T (pack)
69+
70+data JSNull = JSNull
71+type JSUndefined = ()
72+type JSBool = Bool
73+type JSNumber = Double
74+type JSString = Text
75+
76+data JSValue = ValNull
77+ | ValUndefined
78+ | ValBool JSBool
79+ | ValNumber JSNumber
80+ | ValString JSString
81+ | ValObject JSObjectRef deriving(Show)
82+
83+valToBool :: JSValueRef -> JSC JSBool
84+valToBool jsvar = do
85+ gctxt <- ask
86+ liftIO $ jsvaluetoboolean gctxt jsvar
87+
88+valToNumber :: JSValueRef -> JSC JSNumber
89+valToNumber jsvar = do
90+ gctxt <- ask
91+ rethrow $ liftIO . jsvaluetonumber gctxt jsvar
92+
93+valToStr :: JSValueRef -> JSC JSStringRef
94+valToStr jsvar = do
95+ gctxt <- ask
96+ rethrow $ liftIO . jsvaluetostringcopy gctxt jsvar
97+
98+valToObject :: JSValueRef -> JSC JSObjectRef
99+valToObject jsvar = do
100+ gctxt <- ask
101+ rethrow $ liftIO . jsvaluetoobject gctxt jsvar
102+
103+strToText :: MonadIO m => JSStringRef -> m Text
104+strToText jsstring = liftIO $ do
105+ l <- jsstringgetlength jsstring
106+ p <- jsstringgetcharactersptr jsstring
107+ T.fromPtr (castPtr p) (fromIntegral l)
108+
109+textToStr :: MonadIO m => Text -> m JSStringRef
110+textToStr text = do
111+ liftIO $ useAsPtr text $ \p l -> do
112+ jsstringcreatewithcharacters (castPtr p) (fromIntegral l)
113+
114+class MakeValueRef a where
115+ makeValueRef :: a -> JSC JSValueRef
116+
117+instance MakeValueRef JSValueRef where
118+ makeValueRef = return
119+
120+class MakeStringRef a where
121+ makeStringRef :: MonadIO m => a -> m JSStringRef
122+
123+instance MakeStringRef JSStringRef where
124+ makeStringRef = return
125+
126+instance MakeStringRef Text where
127+ makeStringRef = textToStr
128+
129+instance MakeStringRef String where
130+ makeStringRef = textToStr . T.pack
131+
132+valMakeNull :: JSC JSValueRef
133+valMakeNull = ask >>= (liftIO . jsvaluemakenull)
134+
135+instance MakeValueRef JSNull where
136+ makeValueRef = const valMakeNull
137+
138+valMakeUndefined :: JSC JSValueRef
139+valMakeUndefined = ask >>= (liftIO . jsvaluemakeundefined)
140+
141+instance MakeValueRef JSUndefined where
142+ makeValueRef = const valMakeUndefined
143+
144+valMakeBool :: JSBool -> JSC JSValueRef
145+valMakeBool b = do
146+ gctxt <- ask
147+ liftIO $ jsvaluemakeboolean gctxt b
148+
149+instance MakeValueRef Bool where
150+ makeValueRef = valMakeBool
151+
152+valMakeNumber :: JSNumber -> JSC JSValueRef
153+valMakeNumber n = do
154+ gctxt <- ask
155+ liftIO $ jsvaluemakenumber gctxt n
156+
157+instance MakeValueRef Double where
158+ makeValueRef = valMakeNumber
159+
160+valMakeString :: Text -> JSC JSValueRef
161+valMakeString text = do
162+ gctxt <- ask
163+ s <- textToStr text
164+ liftIO $ jsvaluemakestring gctxt s
165+
166+instance MakeValueRef Text where
167+ makeValueRef = valMakeString
168+
169+instance MakeValueRef String where
170+ makeValueRef = valMakeString . T.pack
171+
172+deRefVal :: JSValueRef -> JSC JSValue
173+deRefVal valref = do
174+ gctxt <- ask
175+ t <- liftIO $ jsvaluegettype gctxt valref
176+ case t of
177+ Kjstypenull -> return ValNull
178+ Kjstypeundefined -> return ValUndefined
179+ Kjstypeboolean -> ValBool <$> valToBool valref
180+ Kjstypenumber -> ValNumber <$> valToNumber valref
181+ Kjstypestring -> ValString <$> (valToStr valref >>= strToText)
182+ Kjstypeobject -> ValObject <$> valToObject valref
183+
184+valMakeRef :: JSValue -> JSC JSValueRef
185+valMakeRef val = do
186+ case val of
187+ ValNull -> valMakeNull
188+ ValUndefined -> valMakeUndefined
189+ ValBool b -> valMakeBool b
190+ ValNumber n -> valMakeNumber n
191+ ValString s -> valMakeString s
192+ ValObject o -> return o
193+
194+instance MakeValueRef JSValue where
195+ makeValueRef = valMakeRef