packages feed

jsaddle-warp 0.9.8.2 → 0.9.8.3

raw patch · 5 files changed

+376/−8 lines, 5 filesdep +directorydep +hspecdep +mtldep ~aesondep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: directory, hspec, mtl

Dependency ranges changed: aeson, base, bytestring, jsaddle, process, text, time, transformers, warp, websockets

API changes (from Hackage documentation)

Files

jsaddle-warp.cabal view
@@ -1,5 +1,5 @@ name: jsaddle-warp-version: 0.9.8.2+version: 0.9.8.3 cabal-version: >=1.10 build-type: Simple license: MIT@@ -27,16 +27,16 @@         other-modules:             Language.Javascript.JSaddle.WebSockets.Compat         build-depends:-            aeson >=0.8.0.2 && <2.1,-            bytestring >=0.10.6.0 && <0.11,+            aeson >=0.8.0.2 && <2.3,+            bytestring >=0.10.6.0 && <0.13,             containers >=0.5.6.2 && <0.7,             foreign-store >=0.2 && <0.3,             http-types >=0.8.6 && <0.13,             jsaddle >=0.9.4.0 && <0.10,             stm >=2.4.4 && <2.6,-            text >=1.2.1.3 && <1.3,-            time >=1.5.0.1 && <1.11,-            transformers >=0.4.2.0 && <0.6,+            text >=1.2.1.3 && <1.3 || >= 2.0 && < 2.2,+            time >=1.5.0.1 && <1.13,+            transformers >=0.4.2.0 && <0.7,             wai >=3.0.3.0 && <3.3,             wai-websockets >=3.0.0.6 && <3.1,             warp >=3.1.2 && <3.4,@@ -50,8 +50,9 @@     ghc-options: -ferror-spans -Wall  test-suite test-tool-    if impl(ghcjs -any) || os(ios)-        buildable: False+    -- Disable doctests as they dont work at the moment and the hspec tests+    -- covers the testing+    buildable: False      build-depends:             QuickCheck -any,@@ -90,3 +91,29 @@     default-language: Haskell2010     hs-source-dirs: tests     ghc-options: -ferror-spans -threaded++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Language.Javascript.JSaddle.ObjectSpec+      Language.Javascript.JSaddle.ValueSpec+      Language.Javascript.JSaddleSpec+  hs-source-dirs:+      tests+  ghc-options: -Wall+  build-depends:+      base+    , bytestring+    , directory+    , hspec == 2.*+    , jsaddle+    , jsaddle-warp+    , lens+    , mtl+    , process+    , text+    , warp+    , websockets+  other-modules:+  default-language: Haskell2010
+ tests/Language/Javascript/JSaddle/ObjectSpec.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE ExtendedDefaultRules #-}+module Language.Javascript.JSaddle.ObjectSpec where++import Prelude hiding ((!!))+import Control.Lens.Operators ((^.))++import qualified Data.Text as T+import Language.Javascript.JSaddle+import Test.Hspec++default ( Int)++spec :: SpecWith JSContextRef+spec = do+  let+    resultShouldBe res m ctx = do+      result <- runJSM (valToText =<< m) ctx+      result `shouldBe` (T.pack res)++  describe "(!)" $ do+    it "Lookup a property based on its name." $+      resultShouldBe "11" $ val "Hello World" ! "length"++  describe "(!!)" $ do+    it "Lookup a property based on its index." $+      resultShouldBe "W" $ val "Hello World" !! 6++  describe "js" $ do+    it "Makes a getter for a particular property name." $+      resultShouldBe "11" $ val "Hello World" ^. js "length"++  describe "jsf" $ do+    it "call a function" $+      resultShouldBe "6" $ val "Hello World" ^. jsf "indexOf" ["World"]++  describe "js0" $ do+    it "call a function that expects no arguments" $+      resultShouldBe "hello world" $ val "Hello World" ^. js0 "toLowerCase"++  describe "js1" $ do+    it "call a function that expects one argument" $+      resultShouldBe "6" $ val "Hello World" ^. js1 "indexOf" "World"++  describe "jsgf" $ do+    it "call a function" $+      resultShouldBe "5" $ (eval "globalFunc = function (x) {return x.length;}") >> jsgf "globalFunc" ["World"]++  describe "(#)" $ do+    it "Call a JavaScript function" $+      resultShouldBe "6" $ val "Hello World" # "indexOf" $ ["World"]++  describe "(##)" $ do+    it "Call a JavaScript function at the given index" $+      resultShouldBe "5" $ (eval "something = {}; something[6]=function (x) {return x.length;}; something[6]('World')") >> (jsg "something" ## 6 $ ["World"])++  describe "(<#)" $ do+    it "Set a JavaScript property" $+      resultShouldBe "1" $ do {j <- obj; (j <# "x") 1; j!"x"}++  describe "(<##)" $ do+    it "Set a JavaScript property at the given index" $+      resultShouldBe "1" $ do {j <- obj; (j <## 6) 1; j!!6}++  describe "new" $ do+    it "create a new JavaScript object" $+      resultShouldBe "2013" $ do { a <- new (jsg "Date") (2013, 1, 1); a ^. js0 "getFullYear" }++  describe "call" $ do+    it "Call function with a given @this@." $+      resultShouldBe "Hello" $ do { test <- eval "(function(){return this;})"; call test (val "Hello") () }++  describe "obj" $ do+    it "Make an empty object using the default constuctor" $+      resultShouldBe "Hello" $ do { a <- obj; (a <# "x") "Hello"; a ^. js "x" }++  describe "array" $ do+    it "Make an JavaScript array from a list of values" $+      resultShouldBe "World" $ array ["Hello", "World"] !! 1++    it "Make an JavaScript array from a list of values 2" $+      resultShouldBe "Hello,,,true,1" $ array ("Hello", JSNull, (), True, 1.0::Double)++  describe "propertyNames" $ do+    it "Get a list containing the property names present on a given object" $+      resultShouldBe "[\"x\",\"y\"]" $ show . map strToText <$> propertyNames (eval "({x:1, y:2})")++  describe "nullObject" $ do+    it "is equal to null" $+      resultShouldBe "true" $ strictEqual nullObject (eval "null")
+ tests/Language/Javascript/JSaddle/ValueSpec.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE ExtendedDefaultRules #-}+module Language.Javascript.JSaddle.ValueSpec where++import Prelude hiding ((!!))+import Control.Lens.Operators ((^.))++import qualified Data.Text as T+import Language.Javascript.JSaddle+import Test.Hspec++default ( Int)++spec :: SpecWith JSContextRef+spec = do+  let+    resultShouldBe res m ctx = do+      result <- runJSM (valToText =<< m) ctx+      result `shouldBe` (T.pack res)++  describe "valToBool" $ do+    it "JSNull" $+      resultShouldBe "false" $ valToBool JSNull++    it "()" $+      resultShouldBe "false" $ valToBool ()++    it "True" $+      resultShouldBe "true" $ valToBool True++    it "False" $+      resultShouldBe "false" $ valToBool False++    it "(1.0 :: Double)" $+      resultShouldBe "true" $ valToBool (1.0 :: Double)++    it "(0.0 :: Double)" $+      resultShouldBe "false" $ valToBool (0.0 :: Double)++    it "<empty-string>" $+      resultShouldBe "false" $ valToBool ""++    it "1" $+      resultShouldBe "true" $ valToBool 1++  describe "valToNumber" $ do+    it "JSNull" $+      resultShouldBe "0" $ valToNumber JSNull++    -- Throws exception+    xit "()" $+      resultShouldBe "NaN" $ valToNumber ()++    it "True" $+      resultShouldBe "1" $ valToNumber True++    it "False" $+      resultShouldBe "0" $ valToNumber False++    it "(1.0 :: Double)" $+      resultShouldBe "1" $ valToNumber (1.0 :: Double)++    it "(0.0 :: Double)" $+      resultShouldBe "0" $ valToNumber (0.0 :: Double)++    it "<empty-string>" $+      resultShouldBe "0" $ valToNumber ""++    it "1" $+      resultShouldBe "1" $ valToNumber 1++  describe "valToStr" $ do+    it "JSNull" $+      resultShouldBe "null" $ strToText <$> valToStr JSNull++    it "()" $+      resultShouldBe "undefined" $ strToText <$> valToStr ()++    it "True" $+      resultShouldBe "true" $ strToText <$> valToStr True++    it "False" $+      resultShouldBe "false" $ strToText <$> valToStr False++    it "(1.0 :: Double)" $+      resultShouldBe "1" $ strToText <$> valToStr (1.0 :: Double)++    it "(0.0 :: Double)" $+      resultShouldBe "0" $ strToText <$> valToStr (0.0 :: Double)++    it "<empty-string>" $+      resultShouldBe "" $ strToText <$> valToStr ""++    it "1" $+      resultShouldBe "1" $ strToText <$> valToStr 1++  describe "valToJSON" $ do+    it "JSNull" $+      resultShouldBe "null" $ strToText <$> valToJSON JSNull++    it "()" $+      resultShouldBe "" $ strToText <$> valToJSON ()++    it "True" $+      resultShouldBe "true" $ strToText <$> valToJSON True++    it "False" $+      resultShouldBe "false" $ strToText <$> valToJSON False++    it "(1.0 :: Double)" $+      resultShouldBe "1" $ strToText <$> valToJSON (1.0 :: Double)++    it "(0.0 :: Double)" $+      resultShouldBe "0" $ strToText <$> valToJSON (0.0 :: Double)++    it "<empty-string>" $+      resultShouldBe "\"\"" $ strToText <$> valToJSON ""++    it "1" $+      resultShouldBe "1" $ strToText <$> valToJSON 1++    it "<empty-object>" $+      resultShouldBe "{}" $ strToText <$> (valToJSON =<< obj)++  describe "valToObject" $ do+    it "JSNull" $+      resultShouldBe "null" $ valToObject JSNull++    it "()" $+      resultShouldBe "undefined" $ valToObject ()++    it "True" $+      resultShouldBe "true" $ valToObject True++    it "False" $+      resultShouldBe "false" $ valToObject False++    it "(1.0 :: Double)" $+      resultShouldBe "1" $ valToObject (1.0 :: Double)++    it "(0.0 :: Double)" $+      resultShouldBe "0" $ valToObject (0.0 :: Double)++    it "<empty-string>" $+      resultShouldBe "" $ valToObject ""++    it "1" $+      resultShouldBe "1" $ valToObject 1++  describe "strictEqual" $ do+    it "strictEqual True False" $+      resultShouldBe "false" $ strictEqual True False++    it "strictEqual False False" $+      resultShouldBe "true" $ strictEqual False False++    it "strictEqual \"Hello\" ()" $+      resultShouldBe "false" $ strictEqual "Hello" ()++    it "strictEqual \"Hello\" \"Hello\" " $+      resultShouldBe "true" $ strictEqual "Hello" "Hello"++  describe "instanceOf" $ do+    it "Determine if two values are equal (JavaScripts ===)" $+      resultShouldBe "true" $ instanceOf obj (Object <$> jsg "Object")
+ tests/Language/Javascript/JSaddleSpec.hs view
@@ -0,0 +1,13 @@+module Language.Javascript.JSaddleSpec where++import Language.Javascript.JSaddle++import qualified Language.Javascript.JSaddle.ObjectSpec as ObjectSpec+import qualified Language.Javascript.JSaddle.ValueSpec as ValueSpec++import Test.Hspec++spec :: SpecWith JSContextRef+spec = do+  describe "ObjectSpec" ObjectSpec.spec+  describe "ValueSpec" ValueSpec.spec
+ tests/Spec.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE LambdaCase #-}+module Main where++import Control.Concurrent+import Control.Exception (bracket)+import Control.Monad (forever, unless, void)+import Control.Monad.IO.Class (MonadIO(..))+import qualified Data.ByteString.Lazy.Char8 as BS++import Language.Javascript.JSaddle (askJSM)+import Language.Javascript.JSaddleSpec (spec)+import Language.Javascript.JSaddle.WebSockets (jsaddleJs', jsaddleAppWithJs, jsaddleOr)++import Network.Wai.Handler.Warp+       (defaultSettings, setTimeout, setPort, runSettings)+import Network.WebSockets (defaultConnectionOptions)++import System.Directory (doesDirectoryExist)+import System.Exit (exitWith, ExitCode(..))+import System.Process (withCreateProcess, proc, system)++import Test.Hspec (hspec, aroundAll)++main :: IO ()+main = do+  nodeClientPath <- setupNodeClient+  context <- newEmptyMVar+  let+    f = do+      _ <- liftIO $ tryTakeMVar context+      liftIO . putMVar context =<< askJSM+      liftIO . forever $ threadDelay maxBound++    port = 13709+    uri = BS.pack $ "http://0.0.0.0:" <> show port+    jsaddleApp = jsaddleAppWithJs (jsaddleJs' (Just uri) False)++  void $ forkIO $ runSettings (setPort port (setTimeout 3600 defaultSettings)) =<<+      jsaddleOr defaultConnectionOptions f jsaddleApp++  withCreateProcess (proc "node" [nodeClientPath, show port]) $ \_ _ _ _ -> do+    hspec $ aroundAll (bracket (takeMVar context) (putMVar context)) spec+++setupNodeClient :: IO (FilePath)+setupNodeClient = do+  system "node --version" >>= \case+    ExitSuccess -> return ()+    e           -> do+      putStrLn "'node' not found"+      exitWith e++  -- The 'cabal test' could be running from root of jsaddle repo, so adjust the path+  ncExist <- doesDirectoryExist "node-client"+  jwExist <- doesDirectoryExist "jsaddle-warp/node-client"+  unless (ncExist || jwExist) $ do+    putStrLn "node-client directory not found"+    exitWith (ExitFailure 1)++  let nodeClientDir = if ncExist then "node-client" else "jsaddle-warp/node-client"++  nmExist <- doesDirectoryExist (nodeClientDir <> "/node_modules")+  unless nmExist $ do+    system "npm --version" >>= \case+      ExitSuccess -> return ()+      e           -> do+        putStrLn "'npm' not found"+        exitWith e++    system ("npm install --prefix " <> nodeClientDir) >>= \case+      ExitSuccess -> return ()+      e           -> do+        putStrLn "'npm install' did not succeed"+        exitWith e+  return nodeClientDir