Browse files

Group done tasks by day they were done

  • Loading branch information...
1 parent 55daed3 commit 6f07a348f82b7d16a26bdc28a935efd95193ffa3 @samstokes committed Sep 13, 2011
Showing with 25 additions and 6 deletions.
  1. +12 −1 Handler/Root.hs
  2. +6 −0 Model.hs
  3. +7 −5 hamlet/tasks.hamlet
View
13 Handler/Root.hs
@@ -3,9 +3,10 @@ module Handler.Root where
import Control.Applicative
import Control.Monad
-import Data.List (partition)
+import Data.List (groupBy, partition)
import Data.Monoid
import Data.Map (Map)
+import Data.Maybe (fromJust)
import qualified Data.Map as M
import Data.Text (Text, pack)
import Data.Text.Read
@@ -45,6 +46,7 @@ getTasksR = maybeAuth >>= getTasksR' where
getTasksR' (Just (userId, user)) = do
tasks <- runDB $ userTasks userId
let (done, pending) = partition (taskDone . snd) tasks
+ let doneByDay = groupByEq (fromJust . taskDoneDay . snd) done
estimates <- mapM (runDB . taskEstimates . fst) tasks
let tasksEstimates = M.fromList $ zip (map fst tasks) estimates
((_, taskWidget), enctype) <- generateFormPost taskForm
@@ -146,6 +148,15 @@ maybeToEither msg Nothing = Left msg
maybeToEither _ (Just v) = Right v
+eqUnder :: Eq b => (a -> b) -> a -> a -> Bool
+eqUnder f a b = f a == f b
+
+groupByEq :: Eq g => (a -> g) -> [a] -> [(g, [a])]
+groupByEq f as = zip gs groups where
+ groups = groupBy (eqUnder f) as
+ gs = map (f . head) groups
+
+
postRaiseTaskR :: TaskId -> Handler RepHtml
postRaiseTaskR = reorderTaskR Up
View
6 Model.hs
@@ -65,6 +65,12 @@ reorderTask direction filters = do
taskDone :: Task -> Bool
taskDone = isJust . taskDoneAt
+taskDoneDay :: Task -> Maybe Day
+taskDoneDay = fmap utctDay . taskDoneAt
+
+instance ToHtml Day where
+ toHtml = toHtml . show
+
taskState :: Task -> TaskState
taskState task = if taskDone task then "done" else "pending"
View
12 hamlet/tasks.hamlet
@@ -14,9 +14,11 @@ $else
^{taskWidget}
<input type=submit value=Add
-$if not (null done)
+$if not (null doneByDay)
<h2>Done
- <table><tbody>
- $forall idAndTask <- done
- $with estimates <- M.findWithDefault mempty (fst idAndTask) tasksEstimates
- ^{taskTr idAndTask estimates}
+ $forall dayAndTasks <- doneByDay
+ <h3>#{fst dayAndTasks}
+ <table><tbody>
+ $forall idAndTask <- snd dayAndTasks
+ $with estimates <- M.findWithDefault mempty (fst idAndTask) tasksEstimates
+ ^{taskTr idAndTask estimates}

0 comments on commit 6f07a34

Please sign in to comment.