Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
-- don't do it like this, especially the json!
import Network.WebSockets (shakeHands, getFrame, putFrame)
import Network (listenOn, PortID(PortNumber), accept, withSocketsDo)
import System.IO (Handle, hClose)
import qualified Data.ByteString as B (append, null)
import Data.ByteString.UTF8 (fromString) -- this is from utf8-string
import Control.Monad (forever)
import Control.Concurrent (forkIO, threadDelay)
import Data.List (intercalate)
import System.Random
-- Accepts clients, spawns a single handler for each one.
main :: IO ()
main = withSocketsDo $ do
socket <- listenOn (PortNumber 12345)
putStrLn "Listening on port 12345."
forever $ do
(h, _, _) <- accept socket
forkIO (talkTo h)
-- Shakes hands with client. If no error, starts talking.
talkTo :: Handle -> IO ()
talkTo h = do
request <- shakeHands h
case request of
Left err -> print err
Right _ -> do
putFrame h (fromString "{\"welcome\":\"hello from my websocket server\"}")
putStrLn $ "Shook hands with "++show h ++" sent welcome message."
talkLoop h
-- -----------------------------------------------------------
-- handler
-- -----------------------------------------------------------
-- Talks to client without listening. Just sends continually.
spraff :: Handle -> IO ()
spraff h = do
ds <- makeDatapoints
putFrame h $ fromString $ datapointsToJSONString ds
threadDelay $ 3 * 1000000 -- don't do this
putStrLn $ "sent json to "++show h
spraff h
-- Talks to the client (by echoing messages back) until EOF.
talkLoop :: Handle -> IO ()
talkLoop h = do
msg <- getFrame h
if B.null msg
then do
putStrLn "EOF encountered. Closing handle."
hClose h
else do
ds <- makeDatapoints
putStrLn $ "got message " ++ show msg
putFrame h $ fromString $ datapointsToJSONString ds
threadDelay $ 3 * 1000000 -- don't do this
talkLoop h
-- -----------------------------------------------------------
-- json stuff
-- -----------------------------------------------------------
-- timestamp then value
type DataPoint = (Integer, Int)
-- hardcoded json sample
sampleJSON :: String
sampleJSON = "{\"timedata\":[[21963682872000,3640],[21963682872000,2185],[21963682904000,2165],[21963682969000,5731]]}"
makeDatapoints :: IO [DataPoint]
makeDatapoints = mapM makeD [1..20]
where
makeD :: Int -> IO DataPoint
makeD i = do r <- randomRIO (0,20)
return $ (fromIntegral i, r::Int)
datapointsToJSONString :: [DataPoint] -> String
datapointsToJSONString ds = header ++ body ++ footer
where
header = "{\"timedata\":["
footer = "]}"
body = intercalate "," $ map (\(i,v) -> "[" ++ show i++ "," ++ show v ++"]") ds
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.