JSON-formatted commands

3 files changed, 29 insertions, 14 deletions

diff --git a/Handler/Home.hs b/Handler/Home.hs
index 42dde92..1eff93d 100644
--- a/Handler/Home.hs
+++ b/Handler/Home.hs
@@ -3,7 +3,10 @@ module Handler.Home where
 
 import Import
 
+import Control.Monad (mzero)
 import qualified Data.Text as T
+import Data.Aeson
+import Data.Aeson.Types (Parser)
 import Text.Julius
 import Yesod.WebSockets
 import Turing.Examples
@@ -11,14 +14,27 @@ import Turing.Machine
 
 data Cmd = Beginning | Backward | Forward | Poll deriving Read
 
+data UpdM = UpdTape String | UpdTrans String
+instance FromJSON UpdM where
+  parseJSON (Object v) = cons =<< (v .: "type")
+    where cons :: String -> Parser UpdM
+          cons t = (if t == "tape" then UpdTape else UpdTrans) <$> v .: "value"
+  parseJSON _ = mzero
+instance ToJSON UpdM where
+  toJSON um = object ["type" .= ty, "value" .= v]
+    where (ty, v) = case um of
+                     UpdTape s -> ("tape"::String, s)
+                     UpdTrans s -> ("trans", s)
+
 wsTuring :: WebSocketsT Handler ()
-wsTuring = do sendTextData . T.pack $ showTrans (trans defaultMachine)
+wsTuring = do sendTextData . encode . UpdTrans . showTrans . trans $
+                defaultMachine
               evalLoop defaultMachine [defaultConfig]
     where defaultMachine = mWriteStr "Hello!"
           defaultConfig = mkConfig . map charToSym $  "_"
           evalLoop m [] = evalLoop m [defaultConfig]
           evalLoop m cfgs@(c:cs) = do
-            sendTextData . T.pack . show $ c
+            sendTextData . encode . UpdTape . show $ c
             cmd <- receiveData
             case (read . T.unpack $ cmd) of
               Beginning -> evalLoop defaultMachine [defaultConfig]
@@ -42,11 +58,11 @@ getHomeR = do
     addScriptRemote "https://maxcdn.bootstrapcdn.com/bootstrap/3.2.0/js/bootstrap.min.js"
 
     -- Identifiers used in HTML/JS code
-    results <- newIdent
-    state <- newIdent
     butBeginning <- newIdent
     butBackward <- newIdent
     butTogglePlay <- newIdent
     butForward <- newIdent
+    prTape <- newIdent
+    prTrans <- newIdent
 
     $(widgetFile "home")
diff --git a/templates/home.hamlet b/templates/home.hamlet
index 4155dbb..9b429b5 100644
--- a/templates/home.hamlet
+++ b/templates/home.hamlet
@@ -4,7 +4,7 @@
     <div class="col-sm-12 col-md-12">
        <div class="row">
          <div class="col-sm-12 col-md-12">
-           <pre id="#{results}">
+           <pre id="#{prTape}">
        <div class="row">
          <div class="col-sm-12 col-md-12">
            <button id="#{butBeginning}" class="btn">
@@ -17,4 +17,4 @@
              <span class="glyphicon glyphicon-step-forward">
        <div class="row">
          <div class="col-sm-12 col-md-12">
-           <pre id="#{state}">
+           <pre id="#{prTrans}">
diff --git a/templates/home.julius b/templates/home.julius
index 0c33c09..e679e40 100644
--- a/templates/home.julius
+++ b/templates/home.julius
@@ -4,8 +4,8 @@ $(function() {
     bBackward   : $("##{rawJS butBackward}"),
     bTogglePlay : $("##{rawJS butTogglePlay}"),
     bForward    : $("##{rawJS butForward}"),
-    results     : $("##{rawJS results}"),
-    state       : $("##{rawJS state}")
+    prTape      : $("##{rawJS prTape}"),
+    prTrans     : $("##{rawJS prTrans}")
   };
   var pollInterval = 10000;
   var playing = false;
@@ -65,12 +65,11 @@ $(function() {
     alert("SOCKET CLOSED! D: (" + e.code + ")");
   };
   sock.onmessage = function (e) {
-    // var data = JSON.parse(e.data);
-    var data = e.data;
-    if (data[1] === "+") {
-      ui.state.html(data);
-    } else {
-      ui.results.html(data);
+    var data = JSON.parse(e.data);
+    if (data["type"] === "tape") {
+      ui.prTape.html(data["value"]);
+    } else if (data["type"] === "trans") {
+      ui.prTrans.html(data["value"]);
     }
   };
   sock.onerror = function (e) {