fix monad with latest GHC. pretty print scores.

3 files changed, 77 insertions, 53 deletions

diff --git a/src/Control/Monad/SariulClocks.hs b/src/Control/Monad/SariulClocks.hs
index fc5a7e5..e25add2 100644
--- a/src/Control/Monad/SariulClocks.hs
+++ b/src/Control/Monad/SariulClocks.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module Control.Monad.SariulClocks ( SariulScoresMonad
@@ -11,15 +12,15 @@ module Control.Monad.SariulClocks ( SariulScoresMonad
                                   , getScores
                                   , modifyScores) where
 
-import Control.Monad (liftM)
-import Control.Monad.Trans (MonadIO, lift)
-import Control.Monad.State (StateT, MonadState, get, put, evalStateT)
-import Types.Session
-import Types.Scores
-import Types.Classes
-import Data.Classes
-import Network.CGI.Monad (CGIT, MonadCGI, cgiAddHeader, cgiGet)
-import Network.CGI (runCGI, handleErrors, CGIResult)
+import           Control.Monad       (liftM)
+import           Control.Monad.State (MonadState, StateT, evalStateT, get, put)
+import           Control.Monad.Trans (MonadIO, lift)
+import           Data.Classes
+import           Network.CGI         (CGIResult, handleErrors, runCGI)
+import           Network.CGI.Monad   (CGIT, MonadCGI, cgiAddHeader, cgiGet)
+import           Types.Classes
+import           Types.Scores
+import           Types.Session
 
 class ( Monad a
       , MonadIO a) => SariulScoresMonad a where
@@ -34,11 +35,11 @@ class ( Monad a
 
 newtype SariulClocksCGI a =
     SCC { getSCC :: StateT (Session, ScoresList) (CGIT IO) a }
-    deriving (Monad, MonadIO, MonadState (Session, ScoresList))
+    deriving (Functor, Applicative, Monad, MonadIO, MonadState (Session, ScoresList))
 
 newtype SariulClocksIO a =
     SCI { getSCI :: StateT ScoresList IO a }
-    deriving (Monad, MonadIO, MonadState ScoresList)
+    deriving (Functor, Applicative, Monad, MonadIO, MonadState ScoresList)
 
 instance MonadCGI SariulClocksCGI where
     cgiAddHeader n v = SCC . lift $ cgiAddHeader n v
diff --git a/src/Utils/ScoresFile.hs b/src/Utils/ScoresFile.hs
index f981a4a..eac386c 100644
--- a/src/Utils/ScoresFile.hs
+++ b/src/Utils/ScoresFile.hs
@@ -14,7 +14,7 @@ import Control.Monad (liftM)
 import Data.List.Split (splitOn)
 import Data.Maybe (fromJust)
 import System.FilePath ((</>))
--- import Control.Monad.SariulClocks
+import Control.Monad.SariulClocks
 import Control.Monad.Trans (liftIO)
 
 scoresToCSV :: ScoresList -> String
@@ -35,30 +35,27 @@ scoresFromCSV csv = foldr step [] (lines csv)
         classString:scoreString:timeString:[] = splitOn "," line
         theClass = fromJust $ lookupSariulClass ((read . (:[]) . head) classString) ((read . (:[]) . last) classString)
 
--- -- try to read from scores-XX.csv where XX is largest timestamp
--- readScoresFile :: SariulScoresMonad a => a (Maybe ScoresList)
--- readScoresFile = do
---     curDir <- liftIO getCurrentDirectory
---     let dataDir = curDir </> "data"
---     filenames <- liftM (reverse . sort . filter isCSV) $ liftIO $ getDirectoryContents dataDir
---     if null filenames
---        then return Nothing
---        else do
---         -- let scores = liftM scoresFromCSV $ liftIO $ readFile (dataDir </> head filenames)
---         scores <- liftIO $ scoresFromCSV <$> readFile (dataDir </> head filenames)
---         putScores scores
---         return $ Just scores
---   where isCSV path = takeExtension path == ".csv"
+-- try to read from scores-XX.csv where XX is largest timestamp
+readScoresFile :: SariulScoresMonad a => a (Maybe ScoresList)
+readScoresFile = do
+    curDir <- liftIO getCurrentDirectory
+    let dataDir = curDir </> "data"
+    filenames <- liftM (reverse . sort . filter isCSV) $ liftIO $ getDirectoryContents dataDir
+    if null filenames
+       then return Nothing
+       else do
+        -- let scores = liftM scoresFromCSV $ liftIO $ readFile (dataDir </> head filenames)
+        scores <- liftIO $ scoresFromCSV <$> readFile (dataDir </> head filenames)
+        putScores scores
+        return $ Just scores
+  where isCSV path = takeExtension path == ".csv"
 
--- -- writes to score-XX.csv where XX is unix timestamp: a simple-minded logging
--- writeScoresFile :: SariulScoresMonad a => a ()
--- writeScoresFile = do
---     scores <- getScores
---     curDir <- liftIO getCurrentDirectory
---     let dataDir = curDir </> "data"
---     timestamp <- liftM round $ liftIO getPOSIXTime
---     let filename = dataDir </> ("scores-" ++ show timestamp ++ ".csv")
---     liftIO $ writeFile filename (scoresToCSV scores)
-
-readScoresFile = undefined
-writeScoresFile = undefined
+-- writes to score-XX.csv where XX is unix timestamp: a simple-minded logging
+writeScoresFile :: SariulScoresMonad a => a ()
+writeScoresFile = do
+    scores <- getScores
+    curDir <- liftIO getCurrentDirectory
+    let dataDir = curDir </> "data"
+    timestamp <- liftM round $ liftIO getPOSIXTime
+    let filename = dataDir </> ("scores-" ++ show timestamp ++ ".csv")
+    liftIO $ writeFile filename (scoresToCSV scores)
diff --git a/src/sariulccron.hs b/src/sariulccron.hs
index 87b5e30..d36258e 100644
--- a/src/sariulccron.hs
+++ b/src/sariulccron.hs
@@ -1,23 +1,49 @@
--- import Control.Monad.SariulClocks
-import Utils.ScoresFile
-import Types.Scores
-import Types.Classes
-import Control.Monad (liftM, when)
-import Text.PrettyPrint.Boxes
+{-# LANGUAGE OverloadedStrings #-}
+import           Control.Monad              (liftM, when)
+import           Control.Monad.SariulClocks
+import           Control.Monad.Trans        (liftIO)
+import           Data.Classes
+import           Data.Maybe                 (fromJust)
+import           Text.PrettyPrint.Boxes
+import           Types.Classes
+import           Types.Scores
+import           Utils.ScoresFile
 
-scoresBox :: ScoresList -> Box
-scoresBox = undefined
+--- meaty functions
 
 weeklyCron        :: ScoresList -> ScoresList
 weeklyCron scores = undefined
 
--- main :: IO ()
--- main = runSariulClocksIO $ do
---     scores <- readScoresFile
---     when (isJust scores) $ do
---         modifyScores weeklyCron
---         shouldModify <- liftM (((/=) scores) . Just) getScores
---         when shouldModify writeScoresFile
+main :: IO ()
+main = runSariulClocksIO $ do
+    scores <- readScoresFile
+    when (isJust scores) $ do
+        modifyScores weeklyCron
+        shouldModify <- liftM (((/=) scores) . Just) getScores
+        liftIO $ putStrLn "Scores before:\n"
+        liftIO $ putStrLn . ppScores $ fromJust scores
+        liftIO $ putStrLn "Scores after:\n"
+        scores' <- getScores
+        liftIO $ putStrLn . ppScores $ scores'
+        when shouldModify writeScoresFile
+
+--- utility functions
+
+ppScores      :: ScoresList -> String
+ppScores x    = render $
+                   hsep 3 center1 [ alignHoriz center2 7  "Class"
+                                  , alignHoriz center1 7  "Points"
+                                  , alignHoriz center1 12 "Time wasted"]
+                // "--------------------------------"
+                // foldr step nullBox x
+  where
+    step b bs = classBox b // bs
+
+classBox               :: (Class, Score) -> Box
+classBox (c, (Score x y)) = hsep 3 left
+                            [ alignHoriz center1 7  $ (text . show) c
+                            , alignHoriz center1 7  $ (text . show) x
+                            , alignHoriz center1 12 $ (text . show) y]
 
 isJust          :: Maybe a -> Bool
 isJust (Just _) = True