-- 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