1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative ((<$>))
import Control.Monad (liftM, when)
import Control.Monad.SariulClocks
import Control.Monad.Trans (liftIO)
import Data.Classes
import Data.Function (on)
import Data.List (sortBy)
import Data.Maybe (fromJust)
import Text.PrettyPrint.Boxes
import Types.Classes
import Types.Scores
import Utils.ScoresFile
--- meaty functions
weeklyCron :: ScoresList -> ScoresList
weeklyCron scores = (resetTime . deductPoints 10) <$> take 3 sortedScores
++ drop 3 sortedScores
where
sortedScores = sortBy (compare `on` (scoreTimeWasted . snd)) scores
scoreTimeWasted :: Score -> Int
scoreTimeWasted (Score _ x) = x
deductPoints :: Int -> (Class, Score) -> (Class, Score)
deductPoints n (c, Score x y) = (c, Score (x - n) y)
resetTime :: (Class, Score) -> (Class, Score)
resetTime (c, Score x _) = (c, Score x 0)
main :: IO ()
main = runSariulClocksIO $ do
scores <- readScoresFile
-- Proceed only if we actually read some scores.
when (isJust scores) $ do
modifyScores weeklyCron
shouldModify <- liftM (((/=) scores) . Just) getScores
when shouldModify $ do
writeScoresFile
-- Output what we did to be e-mailed from crond.
liftM (scoresBeforeAfter (fromJust scores)) getScores
>>= printLn
--- 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]
scoresBeforeAfter :: ScoresList -> ScoresList -> String
scoresBeforeAfter x y = "Scores before:\n\n" ++ ppScores x ++ "\nScores after:\n\n" ++ ppScores y
isJust :: Maybe a -> Bool
isJust (Just _) = True
isJust _ = False
|
