Lay out some more RESTful infrastructure

JCU.cabal

@@ -38,7 +38,8 @@ Executable jcu
     aeson >= 0.3,
     uu-parsinglib >= 2.7,
     email-validate >= 0.2,
-    containers >= 0.4
+    containers >= 0.4,
+    transformers >= 0.2
 
   extensions: TypeSynonymInstances MultiParamTypeClasses
 

Makefile

@@ -14,3 +14,6 @@ clean:
 
 run:
 	jcu
+
+debug:
+	DEBUG=1 jcu

log/error.log

@@ -1 +1,26 @@
 [16/Apr/2011:19:48:59 +0200] Server.httpServe: START (EventLoopSimple)
+[16/Apr/2011:21:18:16 +0200] Server.httpServe: SHUTDOWN
+[16/Apr/2011:21:18:31 +0200] Server.httpServe: START (EventLoopSimple)
+[16/Apr/2011:21:19:10 +0200] Server.httpServe: START (EventLoopSimple)
+[16/Apr/2011:21:19:10 +0200] Server.httpServe: SHUTDOWN
+[16/Apr/2011:21:19:10 +0200] Server.httpServe: BACKEND STOPPED
+[16/Apr/2011:21:20:42 +0200] Server.httpServe: START (EventLoopSimple)
+[16/Apr/2011:21:21:24 +0200] Server.httpServe: START (EventLoopSimple)
+[16/Apr/2011:21:22:12 +0200] Server.httpServe: START (EventLoopSimple)
+[16/Apr/2011:21:23:56 +0200] Server.httpServe: START (EventLoopSimple)
+[16/Apr/2011:21:48:32 +0200] Server.httpServe: SHUTDOWN
+[16/Apr/2011:21:48:32 +0200] Server.httpServe: BACKEND STOPPED
+[16/Apr/2011:21:51:17 +0200] Server.httpServe: START (EventLoopSimple)
+[17/Apr/2011:00:07:55 +0200] Server.httpServe: SHUTDOWN
+[17/Apr/2011:00:07:55 +0200] Server.httpServe: BACKEND STOPPED
+[17/Apr/2011:09:09:58 +0200] Server.httpServe: START (EventLoopSimple)
+[17/Apr/2011:09:16:44 +0200] [127.0.0.1]: error: recv: resource vanished (Connection reset by peer)
+[17/Apr/2011:10:29:14 +0200] [127.0.0.1]: error: recv: resource vanished (Connection reset by peer)
+[17/Apr/2011:10:29:14 +0200] [127.0.0.1]: error: recv: resource vanished (Connection reset by peer)
+[17/Apr/2011:15:12:58 +0200] Server.httpServe: SHUTDOWN
+[17/Apr/2011:15:14:09 +0200] Server.httpServe: START (EventLoopSimple)
+[17/Apr/2011:15:34:08 +0200] Server.httpServe: SHUTDOWN
+[17/Apr/2011:15:34:12 +0200] Server.httpServe: START (EventLoopSimple)
+[17/Apr/2011:15:35:45 +0200] Server.httpServe: SHUTDOWN
+[17/Apr/2011:15:36:07 +0200] Server.httpServe: START (EventLoopSimple)
+[17/Apr/2011:15:53:55 +0200] [127.0.0.1]: error: recv: resource vanished (Connection reset by peer)

resources/static/brunch/build/web/js/templates.js

@@ -37,7 +37,7 @@
   }
   (function() {
     (function() {
-      __out.push('<div id="doc" class="yui-t5">\n  <div id="hd" role="banner"><h1>JCU: Wiskunde D</h1></div>\n    <div id="bd" role="main">\n      <div id="yui-main">\n    <div class="yui-b">\n    <div class="yui-g" id="rules-tree-div"><!-- TREE GOES HERE --></div>\n  </div>\n  </div>\n    <div class="yui-b" id="rules-list-div"><!-- LIST GOES HERE --></div>\n  </div>\n  <div id="ft" role="contentinfo">\n    <p>Utrecht University, Faculty of Science, Information and Computing Sciences</p>\n  </div>\n</div>\n');
+      __out.push('<div id="doc" class="yui-t5">\n  <div id="hd" role="banner"><h1>JCU: Wiskunde D</h1></div>\n    <div id="bd" role="main">\n      <div id="yui-main">\n    <div class="yui-b">\n    <div class="yui-g" id="rules-tree-div">\n      <div id="rules-tree-div"><!-- TREE GOES HERE --></div>\n      <input type="button" id="btnAdd"   value="Add" />\n      <input type="button" id="btnCheck" value="Check" />\n      <input type="button" id="btnHint"  value="Hint" />\n    </div>\n  </div>\n  </div>\n    <div class="yui-b" id="rules-list-div"><!-- LIST GOES HERE --></div>\n  </div>\n  <div id="ft" role="contentinfo">\n    <p>Utrecht University, Faculty of Science, Information and Computing Sciences</p>\n  </div>\n</div>\n');
     }).call(this);
 
   }).call(__obj);
@@ -86,7 +86,7 @@
       __out.push(__sanitize(this.content.rule.replace(/[^a-zA-Z0-9]+/g, "")));
       __out.push('" class="draggable">\n  <span class="rule-text">');
       __out.push(__sanitize(this.content.rule));
-      __out.push('</span>\n  <input class="btnDelete" type="button" value="x" />\n</div>\n');
+      __out.push('</span>\n  <input class="btnDeleteList" type="button" value="x" />\n</div>\n');
     }).call(this);
 
   }).call(__obj);
@@ -131,7 +131,7 @@
   }
   (function() {
     (function() {
-      __out.push('<input class="btnOK" type="button" value="OK" />\n<input class="btnHint" type="button" value="Hint" />\n<input class="btnDelete" type="button" value="Delete" />\n<input type="text" class="droppable" name="tree_rules" />\n');
+      __out.push('<input class="btnStore" type="button" value="Store" />\n<input class="btnDeleteTree" type="button" value="Delete" />\n<input type="text" class="droppable" name="tree_rules" />\n');
     }).call(this);
 
   }).call(__obj);

resources/static/brunch/src/app/main.coffee

@@ -11,6 +11,8 @@ $(document).ready ->
   app.initialize = ->
     app.collections.rulesList = new RulesList()
     app.collections.rulesTree = new RulesTree()
+    # m = {rule: "foo(bar)." }
+    # app.collections.rulesTree.create m
 
     app.controllers.main = new MainController()
     app.views.home = new HomeView()

resources/static/brunch/src/app/models/rule_model.coffee

@@ -1,4 +1,5 @@
 class Rule extends Backbone.Model
+  rule: ""
 
   clear: ->
     @destroy()

resources/static/brunch/src/app/templates/home.eco

@@ -3,7 +3,12 @@
     <div id="bd" role="main">
       <div id="yui-main">
     <div class="yui-b">
-    <div class="yui-g" id="rules-tree-div"><!-- TREE GOES HERE --></div>
+    <div class="yui-g" id="rules-tree-div">
+      <div id="rules-tree-div"><!-- TREE GOES HERE --></div>
+      <input type="button" id="btnAdd"   value="Add" />
+      <input type="button" id="btnCheck" value="Check" />
+      <input type="button" id="btnHint"  value="Hint" />
+    </div>
   </div>
   </div>
     <div class="yui-b" id="rules-list-div"><!-- LIST GOES HERE --></div>

resources/static/brunch/src/app/templates/rules_list_item.eco

@@ -1,4 +1,4 @@
 <div id="rule_<%= @content.rule.replace /[^a-zA-Z0-9]+/g, "" %>" class="draggable">
   <span class="rule-text"><%= @content.rule %></span>
-  <input class="btnDelete" type="button" value="x" />
+  <input class="btnDeleteList" type="button" value="x" />
 </div>

resources/static/brunch/src/app/templates/rules_tree_item.eco

@@ -1,4 +1,3 @@
-<input class="btnOK" type="button" value="OK" />
-<input class="btnHint" type="button" value="Hint" />
-<input class="btnDelete" type="button" value="Delete" />
+<input class="btnStore" type="button" value="Store" />
+<input class="btnDeleteTree" type="button" value="Delete" />
 <input type="text" class="droppable" name="tree_rules" />

resources/static/brunch/src/app/views/rules_list_item_view.coffee

@@ -1,6 +1,13 @@
 class RulesListItemView extends Backbone.View
   tagName: 'li'
 
+  events:
+    "click .btnDeleteList" : "deleteItem"
+
+  deleteItem: ->
+    @model.destroy()
+    $(@el).remove()
+
   initialize: ->
     @model.view = @
 

resources/static/brunch/src/app/views/rules_list_view.coffee

@@ -5,7 +5,6 @@ class RulesListView extends Backbone.View
 
   initialize: ->
     _.bindAll(@, 'addOne', 'addAll', 'render')
-    console.log app.collections.rulesList
     app.collections.rulesList.bind 'add', @addOne
     app.collections.rulesList.bind 'refresh', @addAll
     app.collections.rulesList.bind 'all', @renderList

resources/static/brunch/src/app/views/rules_tree_item_view.coffee

@@ -2,6 +2,13 @@ class RulesTreeItemView extends Backbone.View
 
   tagName: "li"
 
+  events:
+    "click .btnDeleteTree" : "deleteItem"
+
+  deleteItem: ->
+    @model.destroy()
+    $(@el).remove()
+
   initialize: ->
     @model.view = @
 

resources/static/brunch/src/app/views/rules_tree_view.coffee

@@ -6,7 +6,6 @@ class RulesTreeView extends Backbone.View
 
   initialize: ->
     _.bindAll(@, 'addOne', 'addAll', 'render')
-    console.log app.collections.rulesTree
     app.collections.rulesTree.bind 'add', @addOne
     app.collections.rulesTree.bind 'refresh', @addAll
     app.collections.rulesTree.bind 'all', @renderList

src/JCU/Web/Handlers.hs

@@ -3,10 +3,11 @@
 module JCU.Web.Handlers where
 
 import            Application (Application)
-import            Data.Aeson (encode)
+import            Data.Aeson (encode, fromJSON)
 import            Data.ByteString as B (ByteString, length)
 import            Data.ByteString.Char8 as B (unpack)
-import            Data.Map (Map, member, (!))
+import            Data.Map (Map, member, (!), showTree, fromList)
+import            Debug.Trace (trace) -- TODO: Remove
 import            JCU.Prolog.Parser
 import            JCU.Prolog.Types
 import            JCU.Web.Prolog
@@ -34,7 +35,7 @@ loginRedir :: Application ()
 loginRedir = redirect "/login"
 
 forbiddenH :: Application ()
-forbiddenH = do 
+forbiddenH = do
   modifyResponse $ setResponseStatus 403 "Forbidden"
   writeBS "403 forbidden"
   r <- getResponse
@@ -109,7 +110,7 @@ signupH = do
 
 makeUser :: Maybe ByteString -> Maybe ByteString -> User
 makeUser email pwd = User (emptyAuthUser  { userPassword  = fmap ClearText pwd
-                                          , userEmail     = email }) ""
+                                          , userEmail     = email }) [] []
 
 ------------------------------------------------------------------------------
 -- | Functions for handling reading and saving per-person rules
@@ -121,11 +122,22 @@ testRules = [ Fun "foo" [Var "bar"] :<-: []
 readStoredRulesH :: Application ()
 readStoredRulesH = do-- TODO restrict forbiddenH $ do
   modifyResponse $ setContentType "application/json"
-  writeLBS $ encode testRules
+  trace (show testRules) (writeLBS $ encode testRules)
 
 updateStoredRulesH :: Application ()
 updateStoredRulesH = restrict forbiddenH $ undefined
 
+deleteStoredRuleH :: Application ()
+deleteStoredRuleH = do-- TODO restrict forbiddenH $ do
+  rule <- getParam "id"
+  trace ("Delete stored rule: " ++ show rule) (return ())
+
+deleteInUseRuleH :: Application ()
+deleteInUseRuleH = do-- TODO restrict forbiddenH $ do
+  rule <- getParam "id"
+  trace ("Delete in use rule: " ++ show rule) (return ())
+
+
 hintRulesH :: Application ()
 hintRulesH = restrict forbiddenH $ undefined
 
@@ -142,4 +154,8 @@ readInUseRulesH =  do-- TODO restrict forbiddenH $ do
   writeLBS $ encode testRules
 
 updateInUseRulesH :: Application ()
-updateInUseRulesH = restrict forbiddenH $ undefined
+updateInUseRulesH = do-- TODO restrict forbiddenH $ do
+  models <- getRequestBody
+  let dmods = models -- fromJSON models
+  trace ("Tree: " ++ show dmods) (return ())
+  return ()

src/JCU/Web/Types.hs

@@ -2,49 +2,18 @@
 
 module JCU.Web.Types where
 
-import            Control.Applicative ((<*>), (<$>), (<|>))
-import            Control.Monad (mzero)
-import            Data.Aeson (  ToJSON(..), FromJSON(..), (.=), object,
-                                Value(..), (.:))
+import            Data.Aeson
 import            Data.ByteString (ByteString)
 import            Snap.Auth (AuthUser)
-import            JCU.Prolog.Types (Term(..), Rule(..), Trace(..))
+import            JCU.Prolog.Types (Rule(..))
 
 -- TODO: Get prolog field out of user? Though it can't hurt too much;
 -- there's not a lot of data we want to store anyway.
 data User = User  {  authUser     :: AuthUser
-                  ,  storedRules  :: ByteString }
-
-{- instance ToJSON Term where-}
-{-   toJSON (Con number)       = object  [  "number"  .= number]-}
-{-   toJSON (Var ident)        = object  [  "ident"   .= ident]-}
-{-   toJSON (Fun ident terms)  = object  [  "ident"   .= ident-}
-{-                                       ,  "terms"   .= map toJSON terms ]-}
-
-{- instance ToJSON Rule where-}
-{-   toJSON (term :<-: terms) = object  [  "term"   .= toJSON term-}
-{-                                      ,  "terms"  .= map toJSON terms ]-}
-
-{- instance ToJSON Trace where-}
-{-   toJSON (Trace g u e ts) = object  [  "goal"   .= toJSON g-}
-{-                                     ,  "unif"   .= toJSON u-}
-{-                                     ,  "env"    .= toJSON e-}
-{-                                     ,  "terms"  .= map toJSON ts ]-}
-
-{- instance FromJSON Term where-}
-{-   parseJSON (Object t)  =  Con  <$> t .: "number"-}
-{-                       <|>  Var  <$> t .: "ident"-}
-{-                       <|>  Fun  <$> t .: "ident" <*> t .: "terms"-}
-{-   parseJSON _           = mzero-}
-
-{- instance FromJSON Rule where-}
-{-   parseJSON (Object t)  = (:<-:) <$> t .: "term" <*> t .: "terms"-}
-{-   parseJSON _           = mzero-}
-
-{- instance FromJSON Trace where-}
-{-   parseJSON (Object t)  = Trace  <$>  t .: "goal" <*> t .: "unif"-}
-{-                                  <*>  t .: "env" <*> t .: "terms"-}
-{-   parseJSON _           = mzero-}
+                  ,  storedRules  :: [ByteString]
+                  ,  inuseRules   :: [ByteString] }
 
 instance ToJSON Rule where
-  toJSON t = object [ "rule" .= show t ]
+  toJSON t = let  txt = show t
+             in   object  [  "rule"  .= txt
+                          ,  "id"    .= txt]

src/Site.hs

@@ -29,9 +29,11 @@ site =  route  [  ("/",           siteIndex)
                ,  ("/signup",  method GET   newSignupH)
                ,  ("/signup",  method POST  signupH)
                ,  ("/rules/stored",  method GET   readStoredRulesH)
-               ,  ("/rules/stored",  method POST  updateStoredRulesH)
+               ,  ("/rules/stored",  method PUT   updateStoredRulesH)
+               ,  ("/rules/stored/:id",  method DELETE  deleteStoredRuleH)
                ,  ("/rules/inuse",   method GET   readInUseRulesH)
                ,  ("/rules/inuse",   method POST  updateInUseRulesH)
+               ,  ("/rules/inuse/:id",   method DELETE deleteInUseRuleH)
                ,  ("/rules/hint",    method POST  hintRulesH)
                ,  ("/rules/check",   method POST  checkRulesH)
                ,  ("/rules/check",   method GET   checkH) -- TODO: Remove after done testing