packages feed

javascript-extras 0.1.0.1 → 0.2.0.0

raw patch · 6 files changed

+375/−66 lines, 6 filesdep +deepseqdep +ghcjs-base-stubdep +parallel

Dependencies added: deepseq, ghcjs-base-stub, parallel, text

Files

javascript-extras.cabal view
@@ -1,5 +1,5 @@ name:                javascript-extras-version:             0.1.0.1+version:             0.2.0.0 synopsis:            Extra javascript functions when using GHCJS description:         Extra javascript functions when using GHCJS homepage:            https://github.com/louispan/javascript-extras#readme@@ -15,12 +15,21 @@  library   hs-source-dirs:      src+  js-sources:          jsbits/extras.js   exposed-modules:     JavaScript.Extras+                       JavaScript.Extras.String+                       JavaScript.Extras.Recast+                       JavaScript.Extras.Property   build-depends:       base >= 4.7 && < 5+                     , deepseq >= 1.4 && < 2+                     , parallel >= 3.2 && < 4+                     , text >= 1.2 && < 1.3   default-language:    Haskell2010   ghc-options:         -Wall   if impl(ghcjs)     build-depends: ghcjs-base+  if !impl(ghcjs)+    build-depends: ghcjs-base-stub >= 0.1.0.1 && < 1  source-repository head   type:     git
+ jsbits/extras.js view
@@ -0,0 +1,13 @@+#include <ghcjs/rts.h>++// zip list of string and JSVal to object, lists must have been completely forced first+// Using the idea from JavaScript.Array.Internal.fromList h$fromHsListJSVal+function hje$fromHsZipListJSVal(names, xs) {+    var obj = {};+    while(IS_CONS(names) && IS_CONS(xs)) {+        obj[JSVAL_VAL(CONS_HEAD(names))] = JSVAL_VAL(CONS_HEAD(xs));+        names = CONS_TAIL(names);+        xs = CONS_TAIL(xs);+    }+    return obj;+}
src/JavaScript/Extras.hs view
@@ -1,68 +1,9 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}- module JavaScript.Extras-    ( strval-    , Property-    , getProperty-    , setProperty-    , PureJSVal(..)-    , toMaybeJSObject-    , toJSObject+    ( module JavaScript.Extras.String+    , module JavaScript.Extras.Property+    , module JavaScript.Extras.Recast     ) where -import Data.Foldable-import qualified Data.JSString as J-import qualified GHCJS.Marshal.Pure as J-import qualified GHCJS.Types as J-import qualified JavaScript.Object as JO---- | This makes it easier to use OverloadedStrings with inputs that accept a JSVal that could be a JSString-strval :: J.JSString -> J.JSVal-strval = J.jsval--type Property = (J.JSString, J.JSVal)---- | throws an exception if undefined or null-foreign import javascript unsafe-  "$2[$1]"-  js_unsafeGetProperty :: J.JSString -> J.JSVal -> IO J.JSVal---- | throws an exception if undefined or null-foreign import javascript unsafe-  "$3[$1] = $2;"-  js_unsafeSetProperty :: J.JSString -> J.JSVal -> J.JSVal -> IO ()---- | get a property of any JSVal. If a null or undefined is queried, the result will also be null-getProperty :: J.JSString -> J.JSVal -> IO J.JSVal-getProperty k x = let k' = J.pToJSVal k-                  in if J.isUndefined x || J.isNull x-                         || J.isUndefined k' || J.isNull k'-                     then pure J.nullRef-                     else js_unsafeGetProperty k x---- | set a property of any JSVal-setProperty :: Property -> J.JSVal -> IO ()-setProperty (k, v) x = let k' = J.pToJSVal k-                    in if J.isUndefined x || J.isNull x-                          || J.isUndefined k' || J.isNull k'-                       then pure ()-                       else js_unsafeSetProperty k v x---- | This is to enable conversion between equivalent classes 'IsJSVal' and 'PToJSVal'--- So you can convert ((PureJSVal Object) to JSVal with pToJSVal without requiring IO)-newtype PureJSVal a = PureJSVal a-    deriving J.IsJSVal--instance J.IsJSVal a => J.PToJSVal (PureJSVal a) where-    pToJSVal (PureJSVal a) = J.jsval a--toMaybeJSObject :: [Property] -> IO (Maybe JO.Object)-toMaybeJSObject [] = pure Nothing-toMaybeJSObject xs = Just <$> toJSObject xs--toJSObject :: [Property] -> IO JO.Object-toJSObject [] = JO.create-toJSObject xs = do-    obj <- JO.create-    traverse_ (\(k, v) -> JO.unsafeSetProp k v obj) xs-    pure obj+import JavaScript.Extras.String+import JavaScript.Extras.Property+import JavaScript.Extras.Recast
+ src/JavaScript/Extras/Property.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GHCForeignImportPrim #-}++module JavaScript.Extras.Property+    ( Property+    , getProperty+    , setProperty+    , fromProperties+    , toProperties+    ) where++import Control.DeepSeq+import Control.Parallel+import qualified GHC.Exts as Exts+import qualified GHCJS.Marshal.Pure as J+import qualified GHCJS.Types as J+import qualified JavaScript.Object as JO+import qualified JavaScript.Object.Internal as JOI+import Unsafe.Coerce++type Property = (J.JSString, J.JSVal)++-- | get a property of any JSVal. If a null or undefined is queried, the result will also be null+getProperty :: J.JSString -> J.JSVal -> IO J.JSVal+getProperty k x = let k' = J.pToJSVal k+                  in if J.isUndefined x || J.isNull x+                         || J.isUndefined k' || J.isNull k'+                     then pure J.nullRef+                     else js_unsafeGetProperty k x++-- | set a property of any JSVal+setProperty :: Property -> J.JSVal -> IO ()+setProperty (k, v) x = let k' = J.pToJSVal k+                    in if J.isUndefined x || J.isNull x+                          || J.isUndefined k' || J.isNull k'+                       then pure ()+                       else js_unsafeSetProperty k v x++fromProperties :: [Property] -> JO.Object+fromProperties xs =+    let (names, props) = unzip xs+    in (rnf names `seq` rnf props) `pseq` js_toJSObjectPure (unsafeCoerce names) (unsafeCoerce props)+++toProperties :: JO.Object -> IO [Property]+toProperties obj = do+   props <- JO.listProps obj+   traverse (\k -> (\v -> (k, v)) <$> JO.unsafeGetProp k obj) props++#ifdef __GHCJS__++-- | throws an exception if undefined or null+foreign import javascript unsafe+  "$2[$1]"+  js_unsafeGetProperty :: J.JSString -> J.JSVal -> IO J.JSVal++-- | throws an exception if undefined or null+foreign import javascript unsafe+  "$3[$1] = $2;"+  js_unsafeSetProperty :: J.JSString -> J.JSVal -> J.JSVal -> IO ()++-- | zip list of string and JSVal to object, lists must have been completely forced first+-- Using the idea from JavaScript.Array.Internal.fromList h$fromHsListJSVal+foreign import javascript unsafe "hje$fromHsZipListJSVal($1, $2)"+  js_toJSObjectPure :: Exts.Any -> Exts.Any -> JO.Object++#else++-- | throws an exception if undefined or null+js_unsafeGetProperty :: J.JSString -> J.JSVal -> IO J.JSVal+js_unsafeGetProperty _ _ = pure J.nullRef++-- | throws an exception if undefined or null+js_unsafeSetProperty :: J.JSString -> J.JSVal -> J.JSVal -> IO ()+js_unsafeSetProperty _ _ _ = pure ()++-- | zip list of string and JSVal to object, lists must have been completely forced first+-- Using the idea from JavaScript.Array.Internal.fromList h$fromHsListJSVal+js_toJSObjectPure :: Exts.Any -> Exts.Any -> JO.Object+js_toJSObjectPure _ _ = JOI.Object J.nullRef++#endif
+ src/JavaScript/Extras/Recast.hs view
@@ -0,0 +1,244 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleInstances #-}++module JavaScript.Extras.Recast+    ( ToJS(..)+    , FromJS(..)+    ) where++import qualified Data.JSString as JS+import qualified Data.Text as T+import GHC.Int+import GHC.Word+import qualified GHCJS.Foreign.Callback as J+import qualified GHCJS.Foreign.Export as J+import qualified GHCJS.Foreign.Internal as JFI+import qualified GHCJS.Marshal as J+import qualified GHCJS.Marshal.Pure as J+import qualified GHCJS.Nullable as J+import qualified GHCJS.Types as J+import qualified JavaScript.Array.Internal as JAI+import qualified JavaScript.Object.Internal as JOI++-- | This provides a consistent way to convert to JSVal, with different semantics for Char.+-- In the Char's instance of ToJS, it converts to a string instead of integer - IMHO this is less surprising.+--+-- The other reason for this class is while GHCJS base provide both IsJSVal and PToJSVal to convert to jsval,+-- some types are instances of one or the other class.+-- This means you can't use the "Maybe a" instance of PToJSVal if it contains IsISJVal but not pToJSVal.+class ToJS a where+    -- | This is a pure conversion, so instances must be able to convert+    -- the same or equivalent JSVal each time.+    toJS :: a -> J.JSVal+    default toJS :: J.IsJSVal a => a -> J.JSVal+    toJS = J.jsval++instance ToJS J.JSVal where+    toJS = id+instance ToJS (J.Callback a)+instance ToJS (J.Export a)+instance ToJS (J.Nullable a) where+    toJS (J.Nullable a) = a+instance ToJS (JAI.SomeJSArray m)+instance ToJS JOI.Object+instance ToJS Bool where+    toJS = J.pToJSVal+-- | Char instance converts to string+instance ToJS Char where+    toJS a = J.pToJSVal [a]+instance ToJS Double where+    toJS = J.pToJSVal+instance ToJS Float where+    toJS = J.pToJSVal+instance ToJS Int where+    toJS = J.pToJSVal+instance ToJS Int8 where+    toJS = J.pToJSVal+instance ToJS Int16 where+    toJS = J.pToJSVal+instance ToJS Int32 where+    toJS = J.pToJSVal+instance ToJS Word where+    toJS = J.pToJSVal+instance ToJS Word8 where+    toJS = J.pToJSVal+instance ToJS Word16 where+    toJS = J.pToJSVal+instance ToJS Word32 where+    toJS = J.pToJSVal+instance ToJS T.Text where+    toJS = J.pToJSVal+instance ToJS [Char] where+    toJS = J.pToJSVal+instance ToJS J.JSString+instance ToJS a => ToJS (Maybe a) where+    toJS Nothing  = J.nullRef+    toJS (Just a) = toJS a++-- | This provides a consistent way to safely convert from JSVal.+-- The semantics is that if the return value is a Just, then the JSVal is not a null value.+-- Also, Nothing is also returned for values out of range. They are not silently truncated.+-- (Except for Float where there may be loss of precision) during conversion.+--+-- The reason for this class is because GHCJS.Marshal.fromJSVal and GHCJS.Marshal.pFromJSVal+-- are not safe to use as it assumes that the JSVal are of the correct type and not null.+-- (https://github.com/ghcjs/ghcjs-base/issues/87).+-- The safe way to convert from JSVal is to use JavaScript.Cast or to use the 'Maybe a' instance of FromJSVal,+-- ie @fromJSVal :: JSVal -> IO (Maybe (Maybe a))@, which is a bit more awkward to use.+-- Also, Javascript.Cast doesn't have much instances, and it hardcodes the instance detection method+-- to javascript `isinstance` which is not sufficient for complex+-- types (https://github.com/ghcjs/ghcjs-base/issues/86).+class FromJS a where+    -- | This is an IO because since JSVal is mutable, this function may different results+    -- for the same JSVal at later points in time.+    fromJS :: J.JSVal -> IO (Maybe a)++instance FromJS J.JSVal where+    fromJS a | J.isUndefined a || J.isNull a = pure Nothing+    fromJS a = pure $ Just a++instance FromJS (JAI.SomeJSArray m) where+    fromJS a | JFI.jsonTypeOf a == JFI.JSONArray = pure . Just $ JAI.SomeJSArray a+    fromJS _ = pure Nothing++instance FromJS JOI.Object where+    fromJS a | JFI.jsonTypeOf a == JFI.JSONObject = pure . Just $ JOI.Object a+    fromJS _ = pure Nothing++instance FromJS Bool where+    fromJS a | JFI.jsonTypeOf a == JFI.JSONBool = J.fromJSVal a+    fromJS _ = pure Nothing++-- | This will only succeed on a single character string+instance FromJS Char where+    fromJS a =+        case JFI.jsonTypeOf a of+            JFI.JSONString ->+                let a' = J.pFromJSVal a -- convert to JSString+                    mb = JS.uncons a'+                in case mb of+                       Nothing -> pure Nothing+                       Just (h, t) ->+                           if JS.null t+                               then pure $ Just h+                               else pure Nothing+            _ -> pure Nothing++instance FromJS Double where+    fromJS a = let t = JFI.jsonTypeOf a+               in if t == JFI.JSONInteger || t == JFI.JSONFloat+                      then J.fromJSVal a+                      else pure Nothing++instance FromJS Float where+    fromJS a = let t = JFI.jsonTypeOf a+               in if t == JFI.JSONInteger || t == JFI.JSONFloat+                      then J.fromJSVal a+                      else pure Nothing++instance FromJS Int where+    fromJS a | JFI.jsonTypeOf a == JFI.JSONInteger && js_withinIntBounds a minBound maxBound = J.fromJSVal a+    fromJS _ = pure Nothing++instance FromJS Int8 where+    fromJS a | JFI.jsonTypeOf a == JFI.JSONInteger && js_withinInt8Bounds a minBound maxBound = J.fromJSVal a+    fromJS _ = pure Nothing++instance FromJS Int16 where+    fromJS a | JFI.jsonTypeOf a == JFI.JSONInteger && js_withinInt16Bounds a minBound maxBound = J.fromJSVal a+    fromJS _ = pure Nothing++instance FromJS Int32 where+    fromJS a | JFI.jsonTypeOf a == JFI.JSONInteger && js_withinInt32Bounds a minBound maxBound = J.fromJSVal a+    fromJS _ = pure Nothing++instance FromJS Word where+    fromJS a | JFI.jsonTypeOf a == JFI.JSONInteger && js_withinWordBounds a minBound maxBound = J.fromJSVal a+    fromJS _ = pure Nothing++instance FromJS Word8 where+    fromJS a | JFI.jsonTypeOf a == JFI.JSONInteger && js_withinWord8Bounds a minBound maxBound = J.fromJSVal a+    fromJS _ = pure Nothing++instance FromJS Word16 where+    fromJS a | JFI.jsonTypeOf a == JFI.JSONInteger && js_withinWord16Bounds a minBound maxBound = J.fromJSVal a+    fromJS _ = pure Nothing++instance FromJS Word32 where+    fromJS a | JFI.jsonTypeOf a == JFI.JSONInteger && js_withinWord32Bounds a minBound maxBound = J.fromJSVal a+    fromJS _ = pure Nothing++instance FromJS T.Text where+    fromJS a | JFI.jsonTypeOf a == JFI.JSONString = J.fromJSVal a+    fromJS _ = pure Nothing++instance FromJS [Char] where+    fromJS a | JFI.jsonTypeOf a == JFI.JSONString = J.fromJSVal a+    fromJS _ = pure Nothing++instance FromJS J.JSString where+    fromJS a | JFI.jsonTypeOf a == JFI.JSONString = J.fromJSVal a+    fromJS _ = pure Nothing++#ifdef __GHCJS__++foreign import javascript unsafe+  "($1 >= $2) || ($1 <= $3)"+  js_withinIntBounds :: J.JSVal -> Int -> Int -> Bool++foreign import javascript unsafe+  "($1 >= $2) || ($1 <= $3)"+  js_withinInt8Bounds :: J.JSVal -> Int8 -> Int8 -> Bool++foreign import javascript unsafe+  "($1 >= $2) || ($1 <= $3)"+  js_withinInt16Bounds :: J.JSVal -> Int16 -> Int16 -> Bool++foreign import javascript unsafe+  "($1 >= $2) || ($1 <= $3)"+  js_withinInt32Bounds :: J.JSVal -> Int32 -> Int32 -> Bool++foreign import javascript unsafe+  "($1 >= $2) || ($1 <= $3)"+  js_withinWordBounds :: J.JSVal -> Word -> Word -> Bool++foreign import javascript unsafe+  "($1 >= $2) || ($1 <= $3)"+  js_withinWord8Bounds :: J.JSVal -> Word8 -> Word8 -> Bool++foreign import javascript unsafe+  "($1 >= $2) || ($1 <= $3)"+  js_withinWord16Bounds :: J.JSVal -> Word16 -> Word16 -> Bool++foreign import javascript unsafe+  "($1 >= $2) || ($1 <= $3)"+  js_withinWord32Bounds :: J.JSVal -> Word32 -> Word32 -> Bool++#else++js_withinIntBounds :: J.JSVal -> Int -> Int -> Bool+js_withinIntBounds _ _ _ = False++js_withinInt8Bounds :: J.JSVal -> Int8 -> Int8 -> Bool+js_withinInt8Bounds _ _ _ = False++js_withinInt16Bounds :: J.JSVal -> Int8 -> Int8 -> Bool+js_withinInt16Bounds _ _ _ = False++js_withinInt32Bounds :: J.JSVal -> Int8 -> Int8 -> Bool+js_withinInt32Bounds _ _ _ = False++js_withinWordBounds :: J.JSVal -> Word -> Word -> Bool+js_withinWordBounds _ _ _ = False++js_withinWord8Bounds :: J.JSVal -> Word8 -> Word8 -> Bool+js_withinWord8Bounds _ _ _ = False++js_withinWord16Bounds :: J.JSVal -> Word16 -> Word16 -> Bool+js_withinWord16Bounds _ _ _ = False++js_withinWord32Bounds :: J.JSVal -> Word32 -> Word32 -> Bool+js_withinWord32Bounds _ _ _ = False++#endif
+ src/JavaScript/Extras/String.hs view
@@ -0,0 +1,20 @@+module JavaScript.Extras.String where++import JavaScript.Extras.Recast as JE+import Data.Text as T+import qualified GHCJS.Types as J++-- | This makes it easier to use OverloadedStrings with inputs that accept a JSVal that could be a JSString+-- Less verbose version of'toJS @JSString'+strJS :: J.JSString -> J.JSVal+strJS = JE.toJS++-- | This makes it easier to use OverloadedStrings with inputs that accept a JSVal that could be a Data.Text+-- Less verbose version of'toJS @Text'+txtJS :: T.Text -> J.JSVal+txtJS = JE.toJS++-- | This makes it easier to use OverloadedStrings with inputs that accept a JSVal that could be a [String]+-- Less verbose version of'toJS @Jtring'+strJS' :: [Char] -> J.JSVal+strJS' = JE.toJS