aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorSean Whitton <spwhitton@spwhitton.name>2015-03-23 06:27:11 +0000
committerSean Whitton <spwhitton@spwhitton.name>2015-03-23 06:27:18 +0000
commit5301858c1772debf4eff3f70ba589a9435b1516c (patch)
treed67e440efbf6c24166ee0eb234a827e84d7613a9
parent72f2d4cb2a296887c74bb49b364f8df3adf43bf7 (diff)
downloadsariulclocks-5301858c1772debf4eff3f70ba589a9435b1516c.tar.gz
fix form processing
-rw-r--r--src/sariulccgi.hs44
1 files changed, 15 insertions, 29 deletions
diff --git a/src/sariulccgi.hs b/src/sariulccgi.hs
index 072c232..e89a940 100644
--- a/src/sariulccgi.hs
+++ b/src/sariulccgi.hs
@@ -22,6 +22,8 @@ import Utils.Xhtml
import Network.URI
import System.FilePath (takeDirectory)
+--- functions making HTML
+
navBar :: SariulClocksCGI Html
navBar = do
currentClass <- liftM (currentClass) getSession
@@ -127,6 +129,8 @@ theDate = thediv # "container" << thediv # "row"
, strAttr "class" "text-center"]
<< noHtml) +++ hr)
+--- main functions
+
makePage :: SariulClocksCGI Html
makePage = do
theNavBar <- navBar
@@ -156,42 +160,24 @@ cgiMain = do
case cookieClock of
0 -> CountDownClock
1 -> CountUpClock }
-
when passwordPasses $ modifyScores (updateScore (fromJust cookieClass) points timeWasted)
- selfURL <- liftM (takeDirectory . uriPath) requestURI
- if passwordPasses
- then do
- -- TODO: use POST,REDIRECT,GET https://stackoverflow.com/questions/570015/how-do-i-reload-a-page-without-a-postdata-warning-in-javascript/570069#570069
- redirect selfURL
- else do
- page <- makePage
-
- setCookie =<< liftM (makeClassCookie clockTime selfURL) getSession
- setCookie =<< liftM (makeClockCookie clockTime selfURL) getSession
- setCookie =<< liftM (makeSsCookie clockTime selfURL) getSession
+ -- TODO: use POST,REDIRECT,GET https://stackoverflow.com/questions/570015/how-do-i-reload-a-page-without-a-postdata-warning-in-javascript/570069#570069
+ selfURL <- liftM uriPath requestURI
+ page <- makePage
- shouldModify <- liftM (((/=) scores) . Just) getScores
- when shouldModify writeScoresFile
+ setCookie =<< liftM (makeClassCookie clockTime (takeDirectory selfURL)) getSession
+ setCookie =<< liftM (makeClockCookie clockTime (takeDirectory selfURL)) getSession
+ setCookie =<< liftM (makeSsCookie clockTime (takeDirectory selfURL)) getSession
+ shouldModify <- liftM (((/=) scores) . Just) getScores
+ when shouldModify writeScoresFile
- output $ templateInject htmlTemplate page
-
- -- when (newScores /= scores) $ liftIO $ writeScoresFile newScores
-
--- main = runCGI . handleErrors $ cgiMain
-
--- tempMain :: New.SariulClocksCGI CGIResult
--- tempMain = do
--- readScoresFile
--- session <- New.getSession
--- let session' = session { currentClass = lookupSariulClass 5 1}
--- New.putSession session'
--- page <- rankings
--- htmlTemplate <- (liftIO . readFile) "html/main.html"
--- output $ templateInject htmlTemplate page
+ output $ templateInject htmlTemplate page
main = runSariulClocksCGI cgiMain
+--- utility functions
+
templateInject :: String -> Html -> String
templateInject template body = templateBefore ++ (renderHtmlFragment body) ++ templateAfter
where