First working iteration of interpreter integration

UU-ComputerScience · Apr 1, 2012 · 571f58c · 571f58c
1 parent ba454cf
commit 571f58c
Show file tree

Hide file tree

Showing 3 changed files with 12 additions and 8 deletions.
diff --git a/resources/static/hjs/jcu.hs b/resources/static/hjs/jcu.hs
@@ -96,14 +96,18 @@ main = do
   onDocumentReady init
 
 initInterpreter :: IO ()
-initInterpreter = do
+initInterpreter = registerEvents [("#submitquery", Click, submitQuery)]
-  obj <- mkAnonObj
+  where submitQuery _ = do  obj <- mkAnonObj
-  ajaxQ GET ("/interpreter/" ++ encodeURIComponent "TODO") obj showInterpRes noop
+                            qryFld <- jQuery "#query"
-  return () -- TODO: Implement
+                            qry <- valJSString qryFld
-
+                            ajaxQ GET ("/interpreter/" ++ fromJS (_encodeURIComponent qry)) obj showInterpRes noop
+                            return True
 
 showInterpRes :: AjaxCallback JSString
-showInterpRes res str obj = return () -- TODO
+showInterpRes res str obj = do
+  op <- jQuery "#output"
+  _setHTML op res
+  return ()
 
 initProofTree :: IO ()
 initProofTree = do -- Rendering

diff --git a/src/Application.hs b/src/Application.hs
@@ -185,7 +185,7 @@ runInterpreterH = restrict forbiddenH $ do
                         let rules = [r |(DBRule _ _ r) <- rs]
                         let result = solve rules emptyEnv [("0", goal)]
                             shpref env (prefix, pr) = prefix ++ " " ++ show (subst env pr)
-                        writeBS . BS.pack $ show $ concat [concatMap (show . shpref env) (reverse proof) ++ "\nsubstitution: " ++ show env | (proof, env) <- enumerateDepthFirst [] result]
+                        writeBS . BS.pack $ show $ concat [concatMap (shpref env) (reverse proof) ++ "<br/>\nsubstitution: " ++ show env | (proof, env) <- enumerateDepthFirst [] result]
                       else writeBS . BS.pack $ "There has been an error" -- show $ concat errs
 
 readStoredRulesH :: AppHandler ()

diff --git a/src/JCU/Templates.hs b/src/JCU/Templates.hs
@@ -95,7 +95,7 @@ loginHTML loginFailed frm = return $
 interpreterHTML :: Reader AuthState Html
 interpreterHTML = return $ do
   H.input ! A.type_ "text" ! A.id "query"
-  H.input ! A.type_ "button" ! A.id "submitquery"
+  H.input ! A.type_ "button" ! A.id "submitquery" ! A.value "Submit Query"
   H.div (H.toHtml ("Please enter a query" :: Text)) ! A.id "output"
 
 showForm :: AttributeValue -> FormHtml (HtmlM a) -> Html