have discovered the liftIO function

2 files changed, 32 insertions, 16 deletions

diff --git a/sariulclocks.cabal b/sariulclocks.cabal
index 23d2888..49a7f76 100644
--- a/sariulclocks.cabal
+++ b/sariulclocks.cabal
@@ -20,6 +20,7 @@ executable sariulclocks.cgi
   main-is:             sariulclocks.hs
   -- other-modules:       
   -- other-extensions:    
+  -- build-depends:       base, cgi, xhtml, time, directory, filepath, split, old-time, mtl
   build-depends:       base, cgi, xhtml, time, directory, filepath, split, old-time
   hs-source-dirs:      src
   default-language:    Haskell2010
diff --git a/src/sariulclocks.hs b/src/sariulclocks.hs
index 523a540..ee8dba9 100644
--- a/src/sariulclocks.hs
+++ b/src/sariulclocks.hs
@@ -1,4 +1,5 @@
 import Network.CGI
+-- import Network.CGI.Monad
 import Text.XHtml
 import Utils.ScoresFile (readScoresFile,writeScoresFile)
 import Types.Classes
@@ -6,6 +7,26 @@ import Types.Scores
 import Data.Classes
 import Data.List.Split (splitOn)
 import System.Time (getClockTime, CalendarTime, toCalendarTime)
+-- import Control.Monad.Reader
+-- import Control.Monad.State
+-- import System.IO (stdin, stdout)
+
+-- Monad stack: scores list state -> CGI -> IO.  This is mostly black
+-- magic to me at this point, from
+-- <https://wiki.haskell.org/Web/Literature/Practical_web_programming_in_Haskell#The_CGI_Monad>.
+
+-- newtype AppT m a = App (StateT ScoresList (CGIT m) a)
+--                  deriving (Monad, MonadIO, MonadState ScoresList)
+-- type App a       = AppT IO a
+
+-- instance MonadCGI (AppT IO) where
+--     cgiAddHeader n v = App . lift $ cgiAddHeader n v
+--     cgiGet x         = App . lift $ cgiGet x
+
+-- -- runApp         :: App CGIResult -> IO ()
+-- -- runApp (App a) = runCGIT (evalStateT a zeroScores)
+
+-- End the black magic.
 
 templateInject               :: String -> Html -> String
 templateInject template body = templateBefore ++ (prettyHtmlFragment body) ++ templateAfter
@@ -15,24 +36,18 @@ templateInject template body = templateBefore ++ (prettyHtmlFragment body) ++ te
 page        :: ScoresList -> Html
 page scores = (h1 << "Hello World!") +++ rankings (Just $ lookupSariulClass 5 3) scores
 
-cgiMain                              :: CalendarTime -> String -> ScoresList -> (ScoresList, CGI CGIResult)
-cgiMain calendarTime template scores = (scores, output $ templateInject template (page scores))
-
-main :: IO ()
-main = do
-    htmlTemplate <- readFile "html/main.html"
+cgiMain :: CGI CGIResult
+cgiMain = do
+    htmlTemplate <- (liftIO . readFile) "html/main.html"
+    maybeScores <- liftIO readScoresFile
 
-    -- handle scores file
-    scores <- readScoresFile
-    let scores' = case scores of
+    let scores = case maybeScores of
             Just s -> s
             _      -> zeroScores
 
-    clockTime <- getClockTime
-    calendarTime <- toCalendarTime clockTime
+    clockTime <- liftIO getClockTime
+    calendarTime <- liftIO . toCalendarTime $ clockTime
+
+    output $ templateInject htmlTemplate (page scores)
 
-    let (newScores, cgi) = cgiMain calendarTime htmlTemplate scores'
-    if scores' /= newScores
-        then writeScoresFile newScores
-        else return ()
-    runCGI . handleErrors $ cgi
+main = runCGI . handleErrors $ cgiMain