first version of saving scores works!

2 files changed, 51 insertions, 10 deletions

diff --git a/src/Utils/ScoresFile.hs b/src/Utils/ScoresFile.hs
index 4028efa..2f496bf 100644
--- a/src/Utils/ScoresFile.hs
+++ b/src/Utils/ScoresFile.hs
@@ -13,6 +13,7 @@ import System.FilePath (takeExtension)
 import Control.Monad (liftM)
 import Data.List.Split (splitOn)
 import Data.Maybe (fromJust)
+import System.FilePath ((</>))
 
 scoresToCSV :: ScoresList -> String
 scoresToCSV = unlines . foldr step []
@@ -21,27 +22,31 @@ scoresToCSV = unlines . foldr step []
                           (show theClass ++ "," ++ show x ++ "," ++ show y) : theLines
 
 -- no malformed CSV handling here yet!
+-- this function currently doesn't work
 scoresFromCSV     :: String -> ScoresList
 scoresFromCSV csv = foldr step [] (lines csv)
   where
      step line scores = (theClass, Score (read scoreString) (read timeString)) : scores
       where
         classString:scoreString:timeString:[] = splitOn "," line
-        theClass = fromJust $ lookupSariulClass ((head . read) classString) ((last . read) classString)
+        theClass = fromJust $ lookupSariulClass ((read . (:[]) . head) classString) ((read . (:[]) . last) classString)
 
--- read to scores-XX.csv where XX is largest timestamp
+-- read from scores-XX.csv where XX is largest timestamp
 readScoresFile :: IO (Maybe ScoresList)
 readScoresFile = do
     curDir <- getCurrentDirectory
-    filenames <- liftM (reverse . sort . filter isCSV) $ getDirectoryContents curDir
+    let dataDir = curDir </> "data"
+    filenames <- liftM (reverse . sort . filter isCSV) $ getDirectoryContents dataDir
     case filenames of
         [] -> return Nothing
-        _  -> Just . scoresFromCSV <$> readFile (head filenames)
+        _  -> Just . scoresFromCSV <$> readFile (dataDir </> head filenames)
   where isCSV path = takeExtension path == ".csv"
 
 -- writes to score-XX.csv where XX is unix timestamp: a simple-minded logging
 writeScoresFile :: ScoresList -> IO ()
 writeScoresFile scores = do
+    curDir <- getCurrentDirectory
+    let dataDir = curDir </> "data"
     timestamp <- round <$> getPOSIXTime
-    let filename = "scores-" ++ show timestamp ++ ".csv"
+    let filename = dataDir </> ("scores-" ++ show timestamp ++ ".csv")
     writeFile filename (scoresToCSV scores)
diff --git a/src/sariulclocks.hs b/src/sariulclocks.hs
index 3bc55a2..6514b6c 100644
--- a/src/sariulclocks.hs
+++ b/src/sariulclocks.hs
@@ -7,7 +7,7 @@ import Types.Scores
 import Data.Classes
 import Data.List.Split (splitOn)
 import System.Time (getClockTime, CalendarTime, toCalendarTime)
-import Control.Monad (liftM)
+import Control.Monad (liftM, when)
 import Control.Monad.Trans (lift)
 import Data.Maybe (fromMaybe)
 import Types.Session
@@ -15,6 +15,9 @@ import Types.Clocks
 import Control.Monad.Page
 import Utils.Classes
 import Text.XHtml.Bootstrap
+import Control.Exception (onException)
+import Data.Char (isDigit)
+import Data.Maybe (fromJust)
 
 navBar :: Page Html
 navBar = do
@@ -41,7 +44,7 @@ navBar = do
 
 lessonButtons          :: Maybe Class -> Html
 lessonButtons Nothing  = bsButton "start-lesson" "btn btn-info" "Start lesson"
-                         +++ bsButton "end-of-week" "btn btn-info" "End of week"
+                         +++ bsButton "end-of-week" "btn btn-default" "End of week"
 lessonButtons (Just _) = bsButton "end-lesson" "btn btn-info" "End lesson"
                          +++ bsButton "lucky-number" "btn btn-danger" "Lucky number"
 
@@ -111,12 +114,18 @@ theDate = thediv # "container" << thediv # "row"
                         , strAttr "class" "text-center"]
                    << noHtml) +++ hr)
 
+forms :: Page Html
+forms = do
+    let html = form #= "end_of_class_form" ! [strAttr "method" "POST"] << (input #= "class_points" ! [strAttr "name" "class_points", strAttr "type" "hidden", strAttr "value" ""] +++ input #= "class_time_wasted" ! [strAttr "name" "class_time_wasted", strAttr "type" "hidden", strAttr "value" ""])
+    return html
+
 makePage :: Page Html
 makePage = do
     theNavBar <- navBar
     theClocks <- clocks
     theRankings <- rankings
-    return (theNavBar +++ theClocks +++ theDate +++ theRankings)
+    theForms <- forms
+    return (theNavBar +++ theClocks +++ theDate +++ theRankings +++ theForms)
 
 cgiMain :: CGI CGIResult
 cgiMain = do
@@ -130,9 +139,15 @@ cgiMain = do
 
     clockTime <- liftIO getClockTime
 
+    points <- liftM (fromMaybe "0") $ getInput "class_points"
+    timeWasted <- liftM (fromMaybe "0") $ getInput "class_time_wasted"
+    let points' = readInt points
+    let timeWasted' = readInt timeWasted
+
     cookieClock <- liftM (fromMaybe 0) $ readCookie "clock_cookie"
     cookieClass <- liftM (parseClassCookie) $ getCookie "class_cookie"
-    let session = Session { currentClass = cookieClass
+
+    let session = Session { currentClass = if points' /= 0 then Nothing else cookieClass
                           , currentClock =
                               case cookieClock of
                                   0 -> CountDownClock
@@ -140,11 +155,25 @@ cgiMain = do
 
     -- now do our CGI work
 
-    let (newScores, newSession, html) = runPage makePage scores session
+    -- TODO: password!  read it from a file
+
+    -- TODO: so that can input password without it being echoed,
+    -- unhide the form
+
+    let scores' =
+            if   points' /= 0
+            then updateScore scores (fromJust cookieClass) points' timeWasted'
+            else scores
+
+    let (newScores, newSession, html) = runPage makePage scores' session
 
     setCookie $ makeClassCookie clockTime newSession
     setCookie $ makeClockCookie clockTime newSession
 
+    -- let html' = html +++ show points' +++ show timeWasted'
+
+    when (newScores /= scores) $ liftIO $ writeScoresFile newScores
+
     output $ templateInject htmlTemplate html
 
 main = runCGI . handleErrors $ cgiMain
@@ -153,3 +182,10 @@ templateInject               :: String -> Html -> String
 templateInject template body = templateBefore ++ (renderHtmlFragment body) ++ templateAfter
   where
     (templateBefore:templateAfter:_) = splitOn "BODY_HERE" template
+
+readInt        :: String -> Int
+readInt string = if null string'
+                 then 0
+                 else read string'
+  where
+    string' = filter isDigit string