ghci-websockets 0.0.1 → 0.0.2

raw patch · 12 files changed

+278/−191 lines, 12 filesdep +bytestringdep +waidep +wai-app-staticPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: bytestring, wai, wai-app-static, warp

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−1
• README.md +4/−4
• ghci-websockets.cabal +12/−6
• ghci-websockets.gif binary
• src/Ghci/Server.hs +40/−0
• src/Ghci/Server/Config.hs +34/−0
• src/Ghci/Server/Http/Internal.hs +27/−0
• src/Ghci/Server/Http/Stage0.hs +16/−0
• src/Ghci/Server/Websockets/Internal.hs +66/−0
• src/Ghci/Server/Websockets/Message.hs +72/−0
• src/Ghci/Websockets.hs +0/−106
• src/Ghci/Websockets/Simple.hs +0/−74

@@ -1,5 +1,11 @@ # Changelog -# 2019-07-14+# v0.0.2 (2019-07-16)++* Rename `broadcast` -> `send`+* Better module layout+* Server the index.html page over HTTP++# v0.0.1 (2019-07-14)  * Initial release

@@ -6,15 +6,15 @@  ## 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.+The `Ghci.Server.Websockets` module implements the actual websocket server, sending JSON objects to all clients. `Ghci.Server.Http` servers the index.html page that goes with the messages defined in `Ghci.Websockets.Message`.  ## 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`.+* Run `Ghci.Server.start`+* Open `localhost:3000` in a browser+* In GHCi, run `Ghci.Server.sendText "hello"` (see also `sendHtml` and `sendPlot` from the same module). You may need `:set -XOverloadedStrings`.  ## Warning 

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: ghci-websockets-version: 0.0.1+version: 0.0.2 license: BSD-3-Clause license-file: LICENSE copyright: Copyright (C) 2019 Jann Mueller@@ -26,8 +26,12 @@  library     exposed-modules:-        Ghci.Websockets-        Ghci.Websockets.Simple+        Ghci.Server.Http.Internal+        Ghci.Server.Http.Stage0+        Ghci.Server.Websockets.Internal+        Ghci.Server.Websockets.Message+        Ghci.Server.Config+        Ghci.Server     hs-source-dirs: src     default-language: Haskell2010     ghc-options: -Wall@@ -37,6 +41,8 @@         foreign-store -any,         websockets -any,         text -any,-        containers -any--+        containers -any,+        wai-app-static -any,+        bytestring -any,+        wai -any,+        warp -any

binary file changed (216534 → 89616 bytes)

@@ -0,0 +1,40 @@+module Ghci.Server(+  -- $docs+  -- * Starting the server+    start+  , startConfig+  -- * Sending messages+  , sendText+  , sendHtml+  , sendPlot+  -- * Configuration+  , Config+  , Verbosity(..)+  , defaultConfig+  , cfHTTPPort+  , cfVerbosity+  , cfWSPort+  ) where++import           Ghci.Server.Config              (Config, Verbosity (..),+                                                  cfHTTPPort, cfVerbosity,+                                                  cfWSPort, defaultConfig)+import qualified Ghci.Server.Http.Internal       as HTTP+import qualified Ghci.Server.Websockets.Internal as WS+import           Ghci.Server.Websockets.Message  (sendHtml, sendPlot,+                                                  sendText)++-- $docs+-- This modules implements a websocket server whose state survives GHCi+-- reloads. To use it, run 'start' once  per GHCi session, and then+-- use 'sendText', 'sendHtml' and 'sendPlot' to show the+-- values on all clients that are currently connected.++-- | Start the websocket and HTTP servers using the config+startConfig :: Config -> IO ()+startConfig = (<>) <$> HTTP.startConfig <*> WS.startConfig++-- | Start the server with default settings (HTTP on port 3000, websockets+--   on port 9160)+start :: IO ()+start = startConfig defaultConfig

@@ -0,0 +1,34 @@+module Ghci.Server.Config(+  Config+  , defaultConfig+  , cfWSPort+  , cfHTTPPort+  , cfVerbosity+  , Verbosity(..)+  , logStr+   ) where++-- | 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+  { cfWSPort    :: Int -- ^ Websocket port+  , cfHTTPPort  :: Int -- ^ HTTP port+  , cfVerbosity :: Verbosity -- ^ What to do with log messages+  }++-- | Log a message according to the configured 'Verbosity'+logStr :: Config -> String -> IO ()+logStr c s = case cfVerbosity c of+  Silent  -> pure ()+  Verbose -> putStrLn s++-- | Default config, use ports 9160 (websockets) and 3000 (http) and ignore all+--   log messages.+defaultConfig :: Config+defaultConfig = Config 9160 3000 Silent

@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}+-- | A simple HTTP server that serves the index.html page+module Ghci.Server.Http.Internal where++import           Control.Concurrent             (forkIO)+import           Control.Monad                  (void)+import           Ghci.Server.Http.Stage0        (mkEmbedded)+import           Network.Wai                    (Application)+import           Network.Wai.Application.Static (ssIndices, ssRedirectToIndex,+                                                 staticApp)+import           Network.Wai.Handler.Warp       (run)+import           WaiAppStatic.Storage.Embedded+import           WaiAppStatic.Types             (unsafeToPiece)++import           Ghci.Server.Config             (Config, cfHTTPPort)++theApp :: Application+theApp =+  let st = $(mkSettings mkEmbedded) in+  staticApp $ st { ssRedirectToIndex = True, ssIndices = [unsafeToPiece "index.html"] }++startConfig :: Config -> IO ()+startConfig cf = do+  let p = cfHTTPPort cf+  putStrLn $ "Starting HTTP server on port " ++ show p+  void $ forkIO $ run (cfHTTPPort cf) theApp

@@ -0,0 +1,16 @@+{-# LANGUAGE OverloadedStrings #-}+module Ghci.Server.Http.Stage0 (mkEmbedded) where++import qualified Data.ByteString.Lazy          as BL+import           WaiAppStatic.Storage.Embedded++mkEmbedded :: IO [EmbeddableEntry]+mkEmbedded = do+    file <- BL.readFile "html/index.html"+    let emb = EmbeddableEntry {+                  eLocation = "index.html"+                , eMimeType = "text/html"+                , eContent  = Left (mempty, file)+                }++    return [emb]

@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings #-}+module Ghci.Server.Websockets.Internal 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++import           Ghci.Server.Config (Config, cfWSPort, logStr)++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.+send :: ToJSON a => a -> IO ()+send 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 port specified in the config. Call+--   once per GHCi session.+startConfig :: Config -> IO ()+startConfig c = do+  let p = cfWSPort c+  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,72 @@+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}+module Ghci.Server.Websockets.Message (+  -- $docs+    sendText+  , sendHtml+  , sendPlot+  , Message(..)+  ) where++import           Data.Aeson+import           Data.Text                       (Text)+import qualified Data.Text                       as Text++import           Ghci.Server.Websockets.Internal (send)++-- $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 'sendText', 'sendHtml' and 'sendPlot' 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.+--+-- >>> sendText "hello"+--+sendText :: Text -> IO ()+sendText = send . MsgText++-- | Insert some HTML into the DOM.+--+-- >>> sendHtml "<h1>Hello</h1>"+--+sendHtml :: Text -> IO ()+sendHtml = send . MsgHtml++-- | Show a Plotly 2D line plot of the given points.+--+-- >>> sendPlot [(1, 2), (2, 5), (3, 4), (4, 3)]+--+-- >>> sendPlot $ fmap (\i -> let i' = (fromIntegral i / 10) in (i', sin i')) [1..100]+--+sendPlot :: [(Double, Double)] -> IO ()+sendPlot ns = send (MsgPlotly [dt] ly) where+  ly = object ["margin" .= object ["t" .= (0 :: Int)]]+  dt =+    let (xs, ys) = unzip ns in+    object [ "x" .= xs, "y" .= ys ]

@@ -1,106 +0,0 @@-{-# 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)

@@ -1,74 +0,0 @@-{-# 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 ]