@@ -45,6 +45,7 @@ module Language.Javascript.JSaddle.Value (
4545 , showJSValue
4646
4747 -- * Converting JavaScript values
48+ , isTruthyIO
4849 , valToBool
4950 , valToNumber
5051 , valToStr
@@ -54,15 +55,24 @@ module Language.Javascript.JSaddle.Value (
5455
5556 -- * Make JavaScript values from Haskell ones
5657 , val
58+ , jsNull
5759 , valNull
60+ , isNullIO
5861 , valIsNull
62+ , jsUndefined
5963 , valUndefined
64+ , isUndefinedIO
6065 , valIsUndefined
6166 , maybeNullOrUndefined
6267 , maybeNullOrUndefined'
68+ , toJSBool
69+ , jsTrue
70+ , jsFalse
6371 , valBool
6472 , valMakeNumber
6573 , valMakeString
74+ , valMakeText
75+ , valMakeJSON
6676
6777 -- * Convert to and from JSValue
6878 , deRefVal
@@ -71,33 +81,35 @@ module Language.Javascript.JSaddle.Value (
7181 , instanceOf
7282) where
7383
84+import Data.Text (Text)
85+import qualified Data.Text as T (pack, unpack)
86+import Data.Aeson (Value)
87+
88+#ifdef ghcjs_HOST_OS
7489import Language.Javascript.JSaddle.Types
7590 (Object(..), JSString(..), JSVal(..))
76−#ifdef ghcjs_HOST_OS
77−import Control.Monad.IO.Class (MonadIO(..))
78−import GHCJS.Types (isNull, isUndefined)
79−import GHCJS.Foreign (toJSBool, isTruthy, jsNull, jsUndefined)
80−import qualified GHCJS.Marshal as GHCJS (toJSVal)
91+import GHCJS.Marshal (ToJSVal(..))
8192import GHCJS.Marshal.Pure (pToJSVal)
8293import Data.JSString.Text (textToJSString)
83−import qualified Data.Text as T (pack)
8494#else
85−import qualified Data.Text as T (pack, unpack)
95+import Data.Char (chr, ord)
96+import Data.Word (Word, Word8, Word16, Word32)
97+import Data.Int (Int8, Int16, Int32)
98+import GHCJS.Marshal.Internal (ToJSVal(..), FromJSVal(..))
99+import Language.Javascript.JSaddle.Types
100+ (Object(..), JSString(..), JSVal(..), JSValueForSend(..))
86101import Language.Javascript.JSaddle.Native
87− (wrapJSString, withJSVal, withObject, withJSString,
88− withToJSVal)
102+ (wrapJSString, withJSVal, withObject, withJSString, withToJSVal)
89103import Language.Javascript.JSaddle.Run
90104 (Command(..), AsyncCommand(..), Result(..), sendCommand,
91105 sendLazyCommand)
92106#endif
93107import Language.Javascript.JSaddle.Monad (JSM)
94−import Data.Text (Text)
95108import Language.Javascript.JSaddle.Classes
96− (MakeObject(..), ToJSString(..), ToJSVal(..))
109+ (MakeObject(..), MakeArgs(..))
110+import Language.Javascript.JSaddle.Marshal.String (ToJSString(..), FromJSString(..))
97111import Language.Javascript.JSaddle.String (strToText, textToStr)
98−import Language.Javascript.JSaddle.Arguments (MakeArgs(..))
99−import Data.Word (Word32, Word, Word64)
100−import Data.Int (Int32, Int64)
112+import Language.Javascript.JSaddle.Foreign (jsTrue, jsFalse, jsNull, toJSBool, jsUndefined, isTruthyIO, isNullIO, isUndefinedIO)
101113
102114-- $setup
103115-- >>> import Language.Javascript.JSaddle.Test (testJSaddle)
@@ -154,20 +166,7 @@ showJSValue (ValObject _) = "object"
154166-- >>> testJSaddle $ valToBool "1"
155167-- true
156168valToBool :: ToJSVal value => value -> JSM Bool
157−#ifdef ghcjs_HOST_OS
158−valToBool value = isTruthy <$> toJSVal value
159−#else
160−valToBool value =
161− toJSVal value >>= \case
162− (JSVal 0) -> return False -- null
163− (JSVal 1) -> return False -- undefined
164− (JSVal 2) -> return False -- false
165− (JSVal 3) -> return True -- true
166− v ->
167− withJSVal v $ \rval -> do
168− ValueToBoolResult result <- sendCommand (ValueToBool rval)
169− return result
170−#endif
169+valToBool value = toJSVal value >>= isTruthyIO
171170
172171-- | Given a JavaScript value get its numeric value.
173172-- May throw JSException.
@@ -308,15 +307,21 @@ valToObject value = Object <$> toJSVal value
308307instance MakeObject JSVal where
309308 makeObject = valToObject
310309
310+instance ToJSVal Object where
311+ toJSVal (Object r) = return r
312+
311313-- | Convert to a JavaScript value (just an alias for 'toJSVal')
312314val :: ToJSVal value
313315 => value -- ^ value to convert to a JavaScript value
314316 -> JSM JSVal
315317val = toJSVal
316318
319+#ifndef ghcjs_HOST_OS
317320-- | If we already have a JSVal we are fine
318321instance ToJSVal JSVal where
319322 toJSVal = return
323+ {-# INLINE toJSVal #-}
324+#endif
320325
321326-- | A single JSVal can be used as the argument list
322327instance MakeArgs JSVal where
@@ -326,55 +331,68 @@ instance MakeArgs JSVal where
326331-- as it returns something we can make into a JSVal.
327332instance ToJSVal v => ToJSVal (JSM v) where
328333 toJSVal v = v >>= toJSVal
334+ {-# INLINE toJSVal #-}
329335
330336----------- null ---------------
331337-- | A @null@ JavaScript value
332338valNull :: JSVal
333−#ifdef ghcjs_HOST_OS
334339valNull = jsNull
335−#else
336−valNull = JSVal 0
337−#endif
340+{-# INLINE valNull #-}
338341
339342-- | Makes a @null@ JavaScript value
340343instance ToJSVal JSNull where
341− toJSVal = const (return valNull)
344+ toJSVal = const (return jsNull)
345+ {-# INLINE toJSVal #-}
342346
343347-- | Makes an argument list with just a single @null@ JavaScript value
344348instance MakeArgs JSNull where
345− makeArgs _ = return [valNull]
349+ makeArgs _ = return [jsNull]
346350
351+#ifndef ghcjs_HOST_OS
347352-- | Makes a JSVal or @null@ JavaScript value
348353instance ToJSVal a => ToJSVal (Maybe a) where
349− toJSVal Nothing = return valNull
354+ toJSVal Nothing = return jsNull
350355 toJSVal (Just a) = toJSVal a
356+ {-# INLINE toJSVal #-}
357+instance FromJSVal a => FromJSVal (Maybe a) where
358+ fromJSValUnchecked x =
359+ isUndefinedIO x >>= \case
360+ True -> return Nothing
361+ False -> isNullIO x >>= \case
362+ True -> return Nothing
363+ False -> fromJSVal x
364+ {-# INLINE fromJSValUnchecked #-}
365+ fromJSVal x =
366+ isUndefinedIO x >>= \case
367+ True -> return (Just Nothing)
368+ False -> isNullIO x >>= \case
369+ True -> return (Just Nothing)
370+ False -> fmap (fmap Just) fromJSVal x
371+ {-# INLINE fromJSVal #-}
372+
373+-- Make an array out of various lists
374+instance ToJSVal a => ToJSVal [a] where
375+ toJSVal = toJSValListOf
376+ {-# INLINE toJSVal #-}
377+
378+instance FromJSVal a => FromJSVal [a] where
379+ fromJSVal = fromJSValListOf
380+ {-# INLINE fromJSVal #-}
381+#endif
351382
352383-- | Test a JavaScript value to see if it is @null@
353384valIsNull :: ToJSVal value => value -> JSM Bool
354−#ifdef ghcjs_HOST_OS
355−valIsNull value = isNull <$> toJSVal value
356−#else
357−valIsNull value =
358− toJSVal value >>= \case
359− JSVal 0 -> return True
360− v ->
361− withJSVal v $ \rval -> do
362− IsNullResult result <- sendCommand $ IsNull rval
363− return result
364−#endif
385+valIsNull value = toJSVal value >>= isNullIO
365386
366387----------- undefined ---------------
367388-- | An @undefined@ JavaScript value
368389valUndefined :: JSVal
369−#ifdef ghcjs_HOST_OS
370390valUndefined = jsUndefined
371−#else
372−valUndefined = JSVal 1
373−#endif
391+{-# INLINE valUndefined #-}
374392
375393-- | Makes an @undefined@ JavaScript value
376394instance ToJSVal JSUndefined where
377− toJSVal = const (return valUndefined)
395+ toJSVal = const (return jsUndefined)
378396
379397--We can't allow this if JSUndefined is () as () is no args not "(null)".
380398--Use [()] instead.
@@ -387,16 +405,7 @@ instance MakeArgs () where
387405
388406-- | Test a JavaScript value to see if it is @undefined@
389407valIsUndefined :: ToJSVal value => value -> JSM Bool
390−#ifdef ghcjs_HOST_OS
391−valIsUndefined value = isUndefined <$> toJSVal value
392−#else
393−valIsUndefined value = toJSVal value >>= \case
394− JSVal 1 -> return True
395− v ->
396− withJSVal v $ \rval -> do
397− IsUndefinedResult result <- sendCommand $ IsUndefined rval
398− return result
399−#endif
408+valIsUndefined value = toJSVal value >>= isUndefinedIO
400409
401410-- | Convert a JSVal to a Maybe JSVal (converting null and undefined to Nothing)
402411maybeNullOrUndefined :: ToJSVal value => value -> JSM (Maybe JSVal)
@@ -422,15 +431,15 @@ maybeNullOrUndefined' f value = do
422431----------- booleans ---------------
423432-- | A JavaScript boolean value
424433valBool :: Bool -> JSVal
425−#ifdef ghcjs_HOST_OS
426−valBool b = toJSBool b
427−#else
428−valBool b = JSVal $ if b then 3 else 2
429−#endif
434+valBool = toJSBool
435+{-# INLINE valBool #-}
430436
437+#ifndef ghcjs_HOST_OS
431438-- | Make a JavaScript boolean value
432439instance ToJSVal Bool where
433440 toJSVal = return . valBool
441+ {-# INLINE toJSVal #-}
442+#endif
434443
435444-- | Makes an argument list with just a single JavaScript boolean value
436445instance MakeArgs Bool where
@@ -440,35 +449,53 @@ instance MakeArgs Bool where
440449-- | Make a JavaScript number
441450valMakeNumber :: Double -> JSM JSVal
442451#ifdef ghcjs_HOST_OS
443−valMakeNumber n = liftIO $ GHCJS.toJSVal n
452+valMakeNumber n = toJSVal n
444453#else
445454valMakeNumber = sendLazyCommand . NumberToValue
446455#endif
447456
457+#ifndef ghcjs_HOST_OS
448458-- | Makes a JavaScript number
449459instance ToJSVal Double where
450460 toJSVal = valMakeNumber
461+ {-# INLINE toJSVal #-}
451462
452463instance ToJSVal Float where
453464 toJSVal = valMakeNumber . realToFrac
465+ {-# INLINE toJSVal #-}
454466
455467instance ToJSVal Word where
456468 toJSVal = valMakeNumber . fromIntegral
469+ {-# INLINE toJSVal #-}
457470
458−instance ToJSVal Word32 where
471+instance ToJSVal Word8 where
472+ toJSVal = valMakeNumber . fromIntegral
473+ {-# INLINE toJSVal #-}
474+
475+instance ToJSVal Word16 where
459476 toJSVal = valMakeNumber . fromIntegral
477+ {-# INLINE toJSVal #-}
460478
461−instance ToJSVal Word64 where
479+instance ToJSVal Word32 where
462480 toJSVal = valMakeNumber . fromIntegral
481+ {-# INLINE toJSVal #-}
463482
464483instance ToJSVal Int where
465484 toJSVal = valMakeNumber . fromIntegral
485+ {-# INLINE toJSVal #-}
466486
467−instance ToJSVal Int32 where
487+instance ToJSVal Int8 where
468488 toJSVal = valMakeNumber . fromIntegral
489+ {-# INLINE toJSVal #-}
469490
470−instance ToJSVal Int64 where
491+instance ToJSVal Int16 where
471492 toJSVal = valMakeNumber . fromIntegral
493+ {-# INLINE toJSVal #-}
494+
495+instance ToJSVal Int32 where
496+ toJSVal = valMakeNumber . fromIntegral
497+ {-# INLINE toJSVal #-}
498+#endif
472499
473500-- | Makes an argument list with just a single JavaScript number
474501instance MakeArgs Double where
@@ -491,21 +518,33 @@ valMakeString s =
491518 withJSString s $ sendLazyCommand . StringToValue
492519#endif
493520
521+#ifndef ghcjs_HOST_OS
494522-- | Makes a JavaScript string
495523instance ToJSVal Text where
496524 toJSVal = valMakeText
525+ {-# INLINE toJSVal #-}
526+instance FromJSVal Text where
527+ fromJSValUnchecked = valToText
528+ {-# INLINE fromJSValUnchecked #-}
529+ fromJSVal = fmap Just . valToText
530+ {-# INLINE fromJSVal #-}
531+#endif
497532
498533-- | Makes an argument list with just a single JavaScript string
499534instance MakeArgs Text where
500535 makeArgs t = valMakeText t >>= (\ref -> return [ref])
501536
502−-- | Makes a JavaScript string
503−instance ToJSVal String where
504− toJSVal = valMakeText . T.pack
505−
537+#ifndef ghcjs_HOST_OS
506538-- | Makes a JavaScript string
507539instance ToJSVal JSString where
508540 toJSVal = valMakeString
541+ {-# INLINE toJSVal #-}
542+instance FromJSVal JSString where
543+ fromJSValUnchecked = valToStr
544+ {-# INLINE fromJSValUnchecked #-}
545+ fromJSVal = fmap Just . valToStr
546+ {-# INLINE fromJSVal #-}
547+#endif
509548
510549-- | If we already have a JSString we are fine
511550instance ToJSString JSString where
@@ -517,6 +556,51 @@ instance ToJSString Text where
517556instance ToJSString String where
518557 toJSString = textToStr . T.pack
519558
559+instance FromJSString Text where
560+ fromJSString = strToText
561+
562+instance FromJSString String where
563+ fromJSString v = T.unpack $ strToText v
564+
565+instance FromJSString JSString where
566+ fromJSString = id
567+
568+#ifndef ghcjs_HOST_OS
569+instance ToJSVal Char where
570+ toJSVal = valMakeNumber . fromIntegral . ord
571+ {-# INLINE toJSVal #-}
572+ toJSValListOf = valMakeText . T.pack
573+ {-# INLINE toJSValListOf #-}
574+instance FromJSVal Char where
575+ fromJSValUnchecked = fmap (chr . round) . valToNumber
576+ {-# INLINE fromJSValUnchecked #-}
577+ fromJSVal = fmap (Just . chr . round) . valToNumber
578+ {-# INLINE fromJSVal #-}
579+ fromJSValUncheckedListOf = fmap (T.unpack . strToText) . valToStr
580+ {-# INLINE fromJSValListOf #-}
581+ fromJSValListOf = fmap (Just . T.unpack . strToText) . valToStr
582+ {-# INLINE fromJSValUncheckedListOf #-}
583+#endif
584+
585+-- | Make a JavaScript string from AESON `Value`
586+valMakeJSON :: Value -> JSM JSVal
587+#ifdef ghcjs_HOST_OS
588+valMakeJSON = toJSVal
589+#else
590+valMakeJSON = sendLazyCommand . JSONValueToValue
591+#endif
592+
593+#ifndef ghcjs_HOST_OS
594+-- | Makes a JSON value
595+instance ToJSVal Value where
596+ toJSVal = valMakeJSON
597+ {-# INLINE toJSVal #-}
598+#endif
599+
600+-- | Makes an argument list with just a single JSON value
601+instance MakeArgs Value where
602+ makeArgs t = valMakeJSON t >>= (\ref -> return [ref])
603+
520604-- | Derefernce a value reference.
521605--
522606-- >>> testJSaddle $ showJSValue <$> deRefVal JSNull
@@ -597,6 +681,7 @@ valMakeRef value =
597681-- | Makes a JavaScript value from a 'JSValue' ADT.
598682instance ToJSVal JSValue where
599683 toJSVal = valMakeRef
684+ {-# INLINE toJSVal #-}
600685
601686-- | Makes an argument list with just a single JavaScript value from a 'JSValue' ADT.
602687instance MakeArgs JSValue where
@@ -664,4 +749,3 @@ instanceOf value constructor = do
664749
665750
666751
667−