jsaddle-warp (empty) → 0.6.0.0
raw patch · 6 files changed
+285/−0 lines, 6 filesdep +QuickCheckdep +aesondep +basesetup-changed
Dependencies added: QuickCheck, aeson, base, bytestring, containers, doctest, filepath, http-types, jsaddle, jsaddle-warp, lens, primitive, process, ref-tf, stm, text, time, transformers, wai, wai-websockets, warp, websockets
Files
- LICENSE +21/−0
- Setup.lhs +6/−0
- jsaddle-warp.cabal +67/−0
- src/Language/Javascript/JSaddle/Warp.hs +43/−0
- src/Language/Javascript/JSaddle/WebSockets.hs +72/−0
- tests/DocTest.hs +76/−0
+ LICENSE view
@@ -0,0 +1,21 @@+Copyright (c) 2010-2012 Hamish Mackenzie, Victor Nazarov, Luite Stegeman++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+
+ Setup.lhs view
@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell +> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMain+
+ jsaddle-warp.cabal view
@@ -0,0 +1,67 @@+name: jsaddle-warp+version: 0.6.0.0+cabal-version: >=1.10+build-type: Simple+license: MIT+license-file: LICENSE+maintainer: Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+synopsis: Interface for JavaScript that works with GHCJS and GHC+description:+ This package provides an EDSL for calling JavaScript that+ can be used both from GHCJS and GHC. When using GHC+ the application is run using Warp and WebSockets to+ drive a small JavaScipt helper.+category: Web, Javascript+author: Hamish Mackenzie++source-repository head+ type: git+ location: https://github.com/ghcjs/jsaddle++library++ if !impl(ghcjs -any)+ exposed-modules:+ Language.Javascript.JSaddle.WebSockets+ build-depends:+ aeson >=0.8.0.2 && <1.1,+ containers >=0.5.6.2 && <0.6,+ http-types >=0.8.6 && <0.10,+ jsaddle >=0.6.0.0 && <0.7,+ stm >=2.4.4 && <2.5,+ text >=1.2.1.3 && <1.3,+ time >=1.5.0.1 && <1.7,+ transformers >=0.4.2.0 && <0.6,+ wai >=3.0.3.0 && <3.3,+ wai-websockets >=3.0.0.6 && <3.1,+ warp >=3.1.2 && <3.3,+ websockets >=0.9.5.0 && <0.10+ exposed-modules:+ Language.Javascript.JSaddle.Warp+ build-depends:+ base <5+ default-language: Haskell2010+ hs-source-dirs: src+ ghc-options: -ferror-spans -Wall++test-suite test-tool++ if !impl(ghcjs -any)+ build-depends:+ QuickCheck -any,+ bytestring -any,+ doctest >=0.10.1 && <0.12,+ filepath >=1.4.0.0 && <1.5,+ jsaddle -any,+ jsaddle-warp -any,+ lens -any,+ ref-tf -any,+ primitive -any,+ process >=1.2.3.0 && <1.5+ type: exitcode-stdio-1.0+ main-is: DocTest.hs+ build-depends:+ base -any+ default-language: Haskell2010+ hs-source-dirs: tests+ ghc-options: -ferror-spans -threaded
+ src/Language/Javascript/JSaddle/Warp.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+--+-- Module : Language.Javascript.JSaddle.WebSockets+-- Copyright : (c) Hamish Mackenzie+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- |+--+-----------------------------------------------------------------------------++module Language.Javascript.JSaddle.Warp (+ -- * Running JSM over WebSockets+ run+#ifndef ghcjs_HOST_OS+ , jsaddleOr+#endif+) where++import Language.Javascript.JSaddle.Types (JSM)+#ifndef ghcjs_HOST_OS+import Network.Wai.Handler.Warp+ (defaultSettings, setTimeout, setPort, runSettings)+import Network.WebSockets (defaultConnectionOptions)++import Language.Javascript.JSaddle.Run (syncPoint)+import Language.Javascript.JSaddle.WebSockets (jsaddleOr, jsaddleApp)+#endif++-- | Run the given 'JSM' action as the main entry point. Either directly+-- in GHCJS or as a Warp server on the given port on GHC.+run :: Int -> JSM () -> IO ()+#ifdef ghcjs_HOST_OS+run _port = id+#else+run port f =+ runSettings (setPort port (setTimeout 3600 defaultSettings)) $+ jsaddleOr defaultConnectionOptions (f >> syncPoint) jsaddleApp+#endif
+ src/Language/Javascript/JSaddle/WebSockets.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+--+-- Module : Language.Javascript.JSaddle.WebSockets+-- Copyright : (c) Hamish Mackenzie+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- |+--+-----------------------------------------------------------------------------++module Language.Javascript.JSaddle.WebSockets (+ -- * Running JSM over WebSockets+ jsaddleOr+ , jsaddleApp+) where++import Control.Monad (forever)+import Control.Concurrent (forkIO)++import Data.Monoid ((<>))+import Data.Aeson (encode, decode)++import Network.Wai (Application)+import Network.WebSockets+ (ConnectionOptions(..), sendTextData, receiveDataMessage,+ acceptRequest, ServerApp)+import qualified Network.WebSockets as WS (DataMessage(..))+import Network.Wai.Handler.WebSockets (websocketsOr)++import Language.Javascript.JSaddle.Types (JSM(..))+import qualified Network.Wai as W+ (responseLBS, requestMethod, Application, pathInfo)+import Data.Text (Text)+import qualified Network.HTTP.Types as H+ (status403, status200, status405)+import Language.Javascript.JSaddle.Run (runJavaScript)+import Language.Javascript.JSaddle.Run.Files (indexHtml, jsaddleJs)++jsaddleOr :: ConnectionOptions -> JSM () -> Application -> Application+jsaddleOr opts entryPoint = websocketsOr opts wsApp+ where+ wsApp :: ServerApp+ wsApp pending_conn = do+ conn <- acceptRequest pending_conn+ (processResult, start) <- runJavaScript (sendTextData conn . encode) entryPoint+ _ <- forkIO . forever $+ receiveDataMessage conn >>= \case+ (WS.Text t) ->+ case decode t of+ Nothing -> error $ "jsaddle WebSocket decode failed : " <> show t+ Just r -> processResult r+ _ -> error "jsaddle WebSocket unexpected binary data"+ start++jsaddleApp :: Application+jsaddleApp req = jsaddleAppPieces (W.pathInfo req) req++jsaddleAppPieces :: [Text] -> W.Application+jsaddleAppPieces _ req sendResponse+ | W.requestMethod req `notElem` ["GET", "HEAD"] = sendResponse $ W.responseLBS+ H.status405+ [("Content-Type", "text/plain")]+ "Only GET or HEAD is supported"+jsaddleAppPieces [] _req sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "text/html")] indexHtml+jsaddleAppPieces ["jsaddle.js"] _req sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "application/javascript")] jsaddleJs+jsaddleAppPieces _rawPieces _req sendResponse = sendResponse $ W.responseLBS H.status403+ [ ("Content-Type", "text/plain")+ ] "Forbidden"
+ tests/DocTest.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE LambdaCase #-}+module Main (+ main+) where++import Test.DocTest+import System.IO (stderr, BufferMode(..), stdout, hSetBuffering)+import System.FilePath ((</>))+import System.Exit (exitFailure, exitWith, ExitCode(..))+import System.Process (readProcess, system)+import Control.Concurrent (forkIO)+import Control.Monad (void)+import Data.Monoid ((<>))+import System.Environment (getArgs)+import Language.Javascript.JSaddle.Run.Files (jsaddleJs)+import qualified Data.ByteString.Lazy.Char8 as BS (unpack)++main :: IO ()+main = do+ jsaddlePath <- getArgs >>= \case+ [arg] -> return arg+ _ -> do+ putStrLn "Please give the path to the jsaddle package source"+ exitFailure+ hSetBuffering stdout LineBuffering+ hSetBuffering stderr LineBuffering+ node <- system "nodejs --version" >>= \case+ ExitSuccess -> return "nodejs"+ _ -> return "node"+ system (node <> " --version") >>= \case+ ExitSuccess -> putStrLn "Node.js found"+ e -> do+ putStrLn "Node.js not found"+ exitWith e+ forkIO . void $ readProcess node ["--harmony"] (BS.unpack jsaddleJs) >>= putStr+ doctest [+ "-hide-all-packages",+ "-package=base-" ++ VERSION_base,+ "-package=lens-" ++ VERSION_lens,+ "-package=text-" ++ VERSION_text,+ "-package=bytestring-" ++ VERSION_bytestring,+ "-package=transformers-" ++ VERSION_transformers,+ "-package=websockets-" ++ VERSION_websockets,+ "-package=primitive-" ++ VERSION_primitive,+ "-package=aeson-" ++ VERSION_aeson,+ "-package=websockets-" ++ VERSION_websockets,+ "-package=wai-" ++ VERSION_wai,+ "-package=wai-websockets-" ++ VERSION_wai_websockets,+ "-package=warp-" ++ VERSION_warp,+ "-package=http-types-" ++ VERSION_http_types,+ "-package=stm-" ++ VERSION_stm,+ "-package=time-" ++ VERSION_time,+ "-package=containers-" ++ VERSION_containers,+ "-package=process-" ++ VERSION_process,+ "-package=filepath-" ++ VERSION_filepath,+ "-package=ref-tf-" ++ VERSION_ref_tf,+ "-i" <> jsaddlePath </> "jsaddle-warp/src",+ jsaddlePath </> "jsaddle-warp/src/Language/Javascript/JSaddle/Test.hs",+ "-i" <> jsaddlePath </> "jsaddle",+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle.hs",+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Arguments.hs",+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Classes.hs",+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Evaluate.hs",+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Exception.hs",+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Monad.hs",+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Native.hs",+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Object.hs",+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Properties.hs",+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Run.hs",+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Run/Files.hs",+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/String.hs",+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Types.hs",+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Value.hs" ]