Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

who needs websockets?

  • Loading branch information...
commit abf2d92d52cd472916d1cede5d8871f9422298f9 1 parent dc19e05
@kirel authored
Showing with 0 additions and 159 deletions.
  1. +0 −106 Websockets.hs
  2. +0 −53 Websockets.html
View
106 Websockets.hs
@@ -1,106 +0,0 @@
-import Network
-import qualified Network.Websocket as WS
-
-import Data.Either
-import Data.List (sortBy)
-
-import Text.JSON
-import Strokes
-import Strokes.JSON
-
-import StrokeSample
-import Classifier
-
--- setup classifier
-
-cK = 50
-classifier = newClassifier cK
-
-sanitize :: Strokes -> Strokes
-sanitize = (map (dominant alpha
- .unduplicate
- .redistribute 10
- .aspectrefit (Point (0,0), Point (1,1))
- .smooth
- .unduplicate)
- ).limit 10
-
-process :: Strokes -> Strokes
-process = sanitize
-
--- messages
-data Request = TrainReq String Strokes | ClassifyReq Strokes
-data Response = TrainRes (Maybe String) | ClassifyRes (Either String Results) | FailedRes
-
--- JSON stuff
-instance JSON Request where
- -- readJSON :: JSValue -> Result Point
- readJSON (JSObject j) = case (rtrain, rid, rclassify) of
- -- train case
- (Ok strokes, Ok id, _) -> Ok (TrainReq id strokes)
- -- classify case
- (_, _, Ok strokes) -> Ok (ClassifyReq strokes)
- otherwise -> Error "Unable to read JSRequest"
- where rtrain = valFromObj "train" j
- rid = valFromObj "id" j
- rclassify = valFromObj "classify" j
- readJSON _ = Error "Unable to read JSRequest"
- -- showJSON :: Request -> JSValue
- -- no need... never encode requests
- showJSON _ = showJSON $ JSNull
-
-jerror s = showJSON $ toJSObject [("error", showJSON s)]
-
-showJSOResults = showJSON . (Prelude.map toJSO) . sortBySnd where -- FIXME sorting could be done on the client...
- toJSO (i, score) = makeObj [("id", showJSON i), ("score", showJSON score)]
- sortBySnd = sortBy cmp where
- cmp a b = compare (snd a) (snd b)
-
-instance JSON Response where
- -- readJSON :: JSValue -> Result Point
- -- no need... never decode requests
- readJSON _ = Error "Unable to read JSResponse"
- -- showJSON :: Point -> JSValue
- showJSON (TrainRes (Just e)) = jerror e
- showJSON (TrainRes (Nothing)) = showJSON $ toJSObject [("message", showJSON "ok")]
- showJSON (ClassifyRes (Left e)) = jerror e
- showJSON (ClassifyRes (Right r)) = showJSON $ toJSObject [("results", showJSOResults r)]
- showJSON FailedRes = jerror "Illegal request"
-
--- handling requests
--- TODO reject invalid strokes
-handle (Ok (TrainReq id strokes)) c = do
- let stroke = process strokes
- trainClassifier c (newStrokeSample stroke (Just id))
- return (TrainRes Nothing)
-handle (Ok (ClassifyReq strokes)) c = do
- let stroke = process strokes
- res <- classifyWithClassifier c (newStrokeSample stroke Nothing)
- return (ClassifyRes (Right res))
-handle _ c = do
- return FailedRes
-
--- websockets
-
-onOpen ws = do
- putStrLn "Connection opened"
-
-onClose ws = do
- putStrLn "Connection closed"
-
-onMessage c ws msg = do
- let req = decode msg
- resp <- handle req c
- putStrLn $ "Received message: " ++ msg
- WS.send ws (encode resp)
-
-main = do
- c <- classifier
- withSocketsDo $ WS.startServer $ WS.Config {
- WS.configPort = 9876,
- WS.configOrigins = Nothing,
- WS.configDomains = Nothing,
- WS.configOnOpen = onOpen,
- WS.configOnMessage = onMessage c,
- WS.configOnClose = onClose
- }
View
53 Websockets.html
@@ -1,53 +0,0 @@
-<html>
-<head>
- <title>Web Sockets</title>
-
- <script src="http://www.google.com/jsapi"></script>
- <script>
- google.load('jquery','1.3.2');
- </script>
-
- <script>
- $(document).ready(function() {
-
- if ("WebSocket" in window) {
- var ws = new WebSocket("ws://localhost:9876/");
- ws.onopen = function() {
- $('#connectionStatus').text('Connection opened');
-
- var strokes = [[{x:0,y:0},{x:1,y:0}]];
- var otherstrokes = [[{x:0,y:0},{x:0,y:1}]];
- ws.send(JSON.stringify({train:strokes, id:'foo'}));
- ws.send(JSON.stringify({train:otherstrokes, id:'bar'}));
- ws.send(JSON.stringify({classify:strokes}));
- ws.send(JSON.stringify({train:"Illegal strokes", id:'foo'}));
- ws.send(JSON.stringify({train:"Illegal strokes", id: {illegal:'id'}}));
- ws.send(JSON.stringify({classify:"Illegal strokes"}));
- ws.send("Illegal");
- };
-
- ws.onmessage = function(evt) {
- $('#output').append('<p>' + evt.data + '</p>');
- };
-
- ws.onclose = function() {
- $('#connectionStatus').text('Connection closed');
- };
-
- } else {
- $('#connectionStatus').append('<p>Your browser does not support web sockets</p>');
- }
- });
- </script>
-
-</head>
-<body>
- <h1>Websockets example</h1>
-
- <div id="output">
- </div>
-
- <div id="connectionStatus">
- </div>
-
-</body>

1 comment on commit abf2d92

@kousu

No one needs websockets!

Please sign in to comment.
Something went wrong with that request. Please try again.