ghci-websockets (empty) → 0.0.1

raw patch · 8 files changed

+336/−0 lines, 8 filesdep +aesondep +basedep +containersbinary-added

Dependencies added: aeson, base, containers, foreign-store, text, websockets

Files

• CHANGELOG.md +5/−0
• LICENSE +29/−0
• README.md +29/−0
• ghci-websockets.cabal +42/−0
• ghci-websockets.gif binary
• html/index.html +51/−0
• src/Ghci/Websockets.hs +106/−0
• src/Ghci/Websockets/Simple.hs +74/−0

@@ -0,0 +1,5 @@+# Changelog++# 2019-07-14++* Initial release

@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2019, Jann Müller+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,29 @@+# ghci-websockets++With `ghci-websockets` you can send data from GHCi straight to the browser, using a websocket connection that survives GHCi reloads. ++![ghci-websockets.gif](ghci-websockets.gif)++## Contents++The `Ghci.Websockets` module implements the actual websocket server, broadcasting JSON objects to all clients. `Ghci.Websockets.Simple` adds a custom message type for text, HTML, and plots on top of that.++## Quickstart++* Add `ghci-websockets` to the `build-depends` field of your .cabal file+* Run `cabal new-repl`+* Run `Ghci.Websockets.Simple.initialiseDef`+* Open `html/index.html` in a browser+* In GHCi, run `Ghci.Websockets.Simple.broadcastText "hello"` (see also `broadcastHtml` and `broadcastPlot` from the same module). You may need `:set -XOverloadedStrings`.++## Warning++This packages uses the `foreign-store` package internally, which is highly unstable. I wouldn't use `ghci-websockets` for anything other than GHCi.++## License++BSD-3-Clause, see LICENSE++## Contributions++Bug reports, pull requests etc. are welcome!

@@ -0,0 +1,42 @@+cabal-version: 2.2+name: ghci-websockets+version: 0.0.1+license: BSD-3-Clause+license-file: LICENSE+copyright: Copyright (C) 2019 Jann Mueller+maintainer: Jann Müller (j.mueller.11@alumni.ucl.ac.uk)+author: Jann Müller+stability: experimental+homepage: https://github.com/j-mueller/ghci-websockets+bug-reports: https://github.com/j-mueller/ghci-websockets/issues+synopsis: A websocket server that survives GHCi reloads+description: A websocket server that survives GHCi reloads - use your browser to visualise results from the REPL.+category: Language+build-type: Simple+extra-doc-files:+  README.md+  CHANGELOG.md+extra-source-files:+    ghci-websockets.gif+    html/index.html++source-repository head+    type: git+    location: https://github.com/j-mueller/ghci-websockets++library+    exposed-modules:+        Ghci.Websockets+        Ghci.Websockets.Simple+    hs-source-dirs: src+    default-language: Haskell2010+    ghc-options: -Wall+    build-depends:+        base <= 5,+        aeson -any,+        foreign-store -any,+        websockets -any,+        text -any,+        containers -any++

binary file changed (absent → 216534 bytes)

@@ -0,0 +1,51 @@+<!doctype html>+<html class="no-js" lang="">++<head>+  <meta charset="utf-8">+  <title></title>+  <meta name="description" content="">+  <meta name="viewport" content="width=device-width, initial-scale=1">+  <script src="https://cdn.plot.ly/plotly-latest.min.js"></script>+</head>++<body>++  <div id="main" style="top: 2%; left:2%; right: 2%; bottom: 2%; position:absolute;"></div>+  <script>+    var theDiv = document.getElementById("main");++    var ws = new WebSocket("ws://localhost:9160")+    ws.onopen = function (event) {+      console.log("Connection established");+    };+    ws.onclose = function (event) {+      console.log("Connection closed");+    };+    ws.onmessage = function (event) {+      var obj = JSON.parse(event.data);+      console.log(obj);+      switch (obj.tag) {+        case "text":+          console.log("text");+          theDiv.innerHTML = "";+          theDiv.textContent = obj.contents;+          break;+        case "html":+          console.log("html");+          theDiv.innerHTML = obj.contents;+          break;+        case "plot":+          console.log("plot");+          theDiv.innerHTML = "";+          var plotTarget = document.createElement("div");+          plotTarget.style = "width: 100%; height: 100%";+          theDiv.appendChild(plotTarget);+          Plotly.newPlot(plotTarget, obj.contents.data, obj.contents.layout);+          break;+      }+    };+  </script>+</body>++</html>

@@ -0,0 +1,106 @@+{-# LANGUAGE OverloadedStrings #-}+module Ghci.Websockets(+  -- $docs+  --+    initialise+  , initialiseDef+  , broadcast+  -- * Configuration+  , Config(..)+  , Verbosity(..)+  , defaultConfig+  ) where++import           Control.Concurrent (MVar, forkIO, modifyMVar, modifyMVar_,+                                     newMVar, readMVar)+import           Control.Exception  (catch)+import           Control.Monad      (void, (>=>))+import           Data.Aeson         (ToJSON)+import qualified Data.Aeson         as Aeson+import           Data.Foldable      (traverse_)+import qualified Data.Map           as Map+import qualified Data.Text          as Text+import qualified Foreign.Store      as Store+import qualified Network.WebSockets as WS++-- $docs+-- This modules implements a websocket server whose state survives GHCi +-- reloads. To use it, run 'initialiseDef' once  per GHCi session, and then +-- call 'broadcast' to send a JSON value to all clients that are currently +-- connected. All messages from clients are ignored.++-- | What to do with log messages+data Verbosity =+      Verbose -- ^ Write all log messages to stdout+    | Silent -- ^ Ignore all log messages+    deriving (Eq, Ord, Show)++-- | Server configuration+data Config =+  Config+    { port      :: Int -- ^ What port to start the server on+    , verbosity :: Verbosity -- ^ What to do with log messages+    }++logStr :: Config -> String -> IO ()+logStr c s = case verbosity c of+  Silent  -> pure ()+  Verbose -> putStrLn s++-- | Default config, use port 9160 and ignore all log messages.+defaultConfig :: Config+defaultConfig = Config 9160 Silent++newtype ServerState = ServerState { unServerState :: Map.Map ConnectionID WS.Connection }++type ConnectionID = Int++serverState :: ServerState+serverState = ServerState Map.empty++addConnection :: WS.Connection -> ServerState -> (ServerState, ConnectionID)+addConnection c (ServerState mp) = (ServerState (Map.insert k c mp), k) where+  k = maybe 0 (succ . fst) $ Map.lookupMax mp++deleteConnection :: ConnectionID -> ServerState -> ServerState+deleteConnection i (ServerState mp) = ServerState (Map.delete i mp)++theStore :: Store.Store (MVar ServerState)+theStore = Store.Store 0++-- | Send a JSON object to all clients. Throws an exception if 'initialise' has+--   not been run first.+broadcast :: ToJSON a => a -> IO ()+broadcast t = Store.withStore theStore (readMVar >=> go) where+  go s = traverse_ (`WS.sendTextData` msg) (unServerState s)+  msg = Aeson.encode t++-- | Start the websocket server using the default config (port 9160). Call once+--   per GHCi session.+initialiseDef :: IO ()+initialiseDef = initialise defaultConfig++-- | Start the websocket server using the port specified in the config. Call+--   once per GHCi session.+initialise :: Config -> IO ()+initialise c@Config{port=p} = do+  state <- newMVar serverState+  Store.writeStore theStore state+  logStr c ("Starting websocket server on port " ++ show p)+  void $ forkIO (WS.runServer "127.0.0.1" p (application c))++application :: Config -> WS.ServerApp+application conf pending = do+  state <- Store.readStore theStore+  conn <- WS.acceptRequest pending+  WS.forkPingThread conn 30+  connID <- modifyMVar state (pure . addConnection conn)+  logStr conf $ "Accepted connection " ++ show connID+  let go = (WS.receiveData conn >>= logStr conf . Text.unpack) >> go+  catch go (closeConnection conf connID)++closeConnection :: Config -> ConnectionID -> WS.ConnectionException -> IO ()+closeConnection conf connID ex = do+  logStr conf $ "Closing connection " ++ show connID ++ " due to " ++ show ex+  state <- Store.readStore theStore+  modifyMVar_ state (pure . deleteConnection connID)

@@ -0,0 +1,74 @@+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}+module Ghci.Websockets.Simple (+  -- $docs+    broadcastText+  , broadcastHtml+  , broadcastPlot+  -- * Re-exports etc.+  , Message(..)+  , module Websockets+  ) where++import           Data.Aeson+import           Data.Text       (Text)+import qualified Data.Text       as Text++import           Ghci.Websockets as Websockets++-- $docs+-- This module provides the 'Message' data type, and various constructors for+-- it. It is intended to be used together with the 'html/index.html' file.+--+-- = Usage+--+-- 1. Start a GHCi session and run 'Ghci.Websockets.initialiseDef'+-- 2. Open @html/index.html@ in a browser (it's self-contained, no http server+--    required)+-- 3. Use 'broadcastText', 'broadcastHtml' and 'broadcastPlot' to show things+--    in the browser window.++data Message =+  MsgText Text.Text -- ^ A string+  | MsgHtml Text.Text -- ^ An HTML fragment+  | MsgPlotly [Value] Value+  -- ^ The 'data' and 'layout' parameters used for 'Plotly.newPlot'+  --   (see+  --   https://plot.ly/javascript/plotlyjs-function-reference/#plotlynewplot).+  --   The first parameter is a list of Plotly traces (See+  --   https://plot.ly/javascript/reference/,+  --   "Trace types"), the second parameter is a Plotly layout value (see+  --   https://plot.ly/javascript/reference/, "Layout")++instance ToJSON Message where+  toJSON = \case+    MsgText t -> object ["tag" .= ("text" :: String), "contents" .= t]+    MsgHtml t -> object ["tag" .= ("html" :: String), "contents" .= t]+    MsgPlotly dt ly -> object ["tag" .= ("plot" :: String), "contents" .= object ["data" .= dt, "layout" .= ly]]++-- | Show a string.+--+-- >>> broadcastText "hello"+--+broadcastText :: Text -> IO ()+broadcastText = broadcast . MsgText++-- | Insert some HTML into the DOM.+--+-- >>> broadcastHtml "<h1>Hello</h1>"+--+broadcastHtml :: Text -> IO ()+broadcastHtml = broadcast . MsgHtml++-- | Show a Plotly 2D line plot of the given points.+--+-- >>> broadcastPlot [(1, 2), (2, 5), (3, 4), (4, 3)]+--+-- >>> broadcastPlot $ fmap (\i -> let i' = (fromIntegral i / 10) in (i', sin i')) [1..100]+--+broadcastPlot :: [(Double, Double)] -> IO ()+broadcastPlot ns = broadcast (MsgPlotly [dt] ly) where+  ly = object ["margin" .= object ["t" .= (0 :: Int)]]+  dt =+    let (xs, ys) = unzip ns in+    object [ "x" .= xs, "y" .= ys ]