Implemented error-checking and displaying

checks that field have the right types of values in them and alerts the
user if they do not

Author: octalsrc

src/Demo/JS.hs

@@ -3,6 +3,9 @@ module Demo.JS ( readInputState
                , writeInputState
                , mkRandomInput
                , sDrawButton
+               , printHighError
+               , printLowError
+               , cullErrors
                , sRandomButton 
                , drawList
                , placeValues
@@ -14,6 +17,7 @@ module Demo.JS ( readInputState
 
 import Control.Monad
 import Control.Applicative
+import Text.Read (readMaybe)
 import JavaScript.JQuery
 import JavaScript.Canvas hiding (Left, Right)
 import GHCJS.Types
@@ -48,10 +52,15 @@ sCellNum i = select (pack (template (cellMkName i)))
                      ++ n 
                      ++ "\" type=\"text\" name=\"a\" /></div>"
 
-getGenInfo :: IO (String, String)
-getGenInfo = do start <- fmap unpack (sStartHead >>= getVal)
-                size <- fmap unpack (sNumCells >>= getVal)
-                return (start, size)
+getGenInfo :: IO (Either String (Int, Int))
+getGenInfo = 
+  do start <- fmap unpack (sStartHead >>= getVal)
+     size <- fmap unpack (sNumCells >>= getVal) 
+     case (readMaybe start, readMaybe size) of
+       (Nothing,_) -> return (Left "\"Starting Index\" requires Integer")
+       (Just _, Nothing) -> 
+         return (Left "\"Number of Memory Cells\" requires Integer")
+       (Just i, Just s) -> return (Right (i,s))
 
 placeValues :: Int -> Int -> IO ()
 placeValues start size = 
@@ -166,9 +175,9 @@ mkCanvas = do
   return ()
 
 displayOutput :: Either String Layout -> IO ()
-displayOutput l = cullError >> case l of
-                                 Left er -> printError er
-                                 Right ls -> drawList ls
+displayOutput l = cullErrors >> case l of
+                                  Left er -> printLowError er
+                                  Right ls -> drawList ls
 
 withPadding :: (Double, Double) -> (Double, Double)
 withPadding (x,y) = (x - (2 * canvasXPadding), y - (2 * canvasYPadding))
@@ -283,8 +292,19 @@ drawElem c scale elem =
 
                         restore c
 
-cullError = return ()
-printError a = return ()
+cullErrors = select "#lowError" >>= remove
+             >> select "#highError" >>= remove
+             >> return ()
+
+printHighError = printError "highError" "#b"
+printLowError = printError "lowError" "#c"
+
+printError a b e = 
+  do err <- select (pack 
+                      ("<p class=\"errors\" id=\"" ++ a ++ "\">Error: (" ++ e ++ ")</p>"))
+     par <- select (pack b)
+     appendJQuery err par
+     return ()
 
 drawTextCenter :: Coord   -- location at which to center the text
                -> Double  -- maximum width of the text

src/LinkedListDemo.hs

@@ -15,15 +15,24 @@ defaultNumCells = 14
 
 main = do initializePage (defaultHeadIndex, defaultNumCells)
           (draw, rando, gener) <- mkSources
-          wireButton draw sDrawButton readInputState
-          wireButton rando sRandomButton mkRandomInput
-          wireButton gener sCellGen generateCells
+          wireButton draw sDrawButton (cullErrors >> readInputState)
+          wireButton rando sRandomButton (cullErrors >> mkRandomInput)
+          wireButton gener sCellGen (cullErrors >> generateCells)
           n <- compile (mkNetwork (draw, rando, gener))
           actuate n
 
 generateCells :: IO ()
-generateCells = do (start,size) <- getGenInfo
-                   initializePage (read start, read size)
+generateCells = 
+  do genInfo <- getGenInfo
+     case checkGenInfo =<< genInfo of
+       Right (start,size) -> initializePage (start,size)
+       Left err -> printHighError err
+
+checkGenInfo :: (Int,Int) -> Either String (Int,Int)
+checkGenInfo (i,s) 
+  | i < 0 = Left "Starting Index cannot be negative"
+  | s < 2 || s > 100 = Left "Number of Cells must be between 2 and 100"
+  | otherwise = Right (i,s)
 
 initializePage (start,size) = 
   placeValues start size

static/linked_list.css

@@ -194,4 +194,15 @@ div.buttons button {
 
 div.break {
   height: 1em;
+}
+
+.errors {
+    color: red;
+    font-weight: bold;
+    display: table !important;
+    padding: 0.3em;
+    border-radius: 0.2em;
+    margin-left: auto;
+    margin-right: auto;
+    background-color: white;
 }