From 6b57ba33b60fb9aef9b6b3a2553dbb2c2c5c14c0 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 Mar 2015 19:06:08 +0900 Subject: weeklyCron filled out --- src/sariulccron.hs | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/src/sariulccron.hs b/src/sariulccron.hs index 3adaf5a..b58599d 100644 --- a/src/sariulccron.hs +++ b/src/sariulccron.hs @@ -1,8 +1,12 @@ {-# 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 @@ -12,7 +16,19 @@ import Utils.ScoresFile --- meaty functions weeklyCron :: ScoresList -> ScoresList -weeklyCron scores = undefined +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 -- cgit v1.2.3