Permalink
Browse files

Add task scheduled-for-ness and postponing

  • Loading branch information...
1 parent 63fb010 commit 41ef2f14796a7aeef1740d662a208c418cc3032d @samstokes committed Sep 22, 2011
Showing with 106 additions and 21 deletions.
  1. +37 −6 Handler/Root.hs
  2. +46 −9 Model.hs
  3. +1 −0 config/models
  4. +2 −0 config/routes
  5. +14 −6 hamlet/tasks.hamlet
  6. +6 −0 hamlet/tasks/task-tr.hamlet
View
43 Handler/Root.hs
@@ -47,20 +47,26 @@ getTasksR = authed (\userId -> do
let tasksEstimates :: [(TaskId, (Task, [(EstimateId, Estimate)]))]
tasksEstimates = (map fst tasks) `zip` ((map snd tasks) `zip` estimates)
- let (unsortedDone, unsortedPending) = partition (taskDone . fst . snd) tasksEstimates
+ timeZone <- liftIO getCurrentTimeZone
+ now <- liftIO getCurrentTime
+ let taskTodoToday :: Task -> Bool
+ taskTodoToday = taskTodo timeZone now
+
+ let (unsortedDone, pending) = partition (taskDone . fst . snd) tasksEstimates
let done = reverse $ sortBy (compareBy $ taskDoneAt . fst . snd) unsortedDone
- let pending = sortBy (compareBy $ taskOrder . fst . snd) unsortedPending
+ let (unsortedTodo, unsortedLater) = partition (taskTodoToday . fst . snd) pending
+ let todo = sortBy (compareBy $ taskOrder . fst . snd) unsortedTodo
+ let later = sortBy (compareBy $ taskOrder . fst . snd) unsortedLater
- timeZone <- liftIO getCurrentTimeZone
let doneByDay = groupByEq (fromJust . taskDoneDay timeZone . fst . snd) done
((_, taskWidget), enctype) <- generateFormPost taskForm
defaultLayout $ do
setTitle "tasks"
addWidget $(widgetFile "tasks")) where
- userTasks userId = selectList [TaskUser ==. userId] [Desc TaskDoneAt]
+ userTasks userId = selectList [TaskUser ==. userId] [Asc TaskScheduledFor, Desc TaskDoneAt] -- must specify sorts backwards...
taskEstimates taskId = selectList [EstimateTask ==. taskId] []
- taskTr (taskId, (task, estimates)) = $(widgetFile "tasks/task-tr")
+ taskTr taskTodoToday (taskId, (task, estimates)) = $(widgetFile "tasks/task-tr")
estimatedRemaining :: (Task, [(EstimateId, Estimate)]) -> Int
estimatedRemaining (_, []) = 0
estimatedRemaining (task, ((_, estimate) : _)) = (estimatePomos estimate - taskPomos task) `max` 0
@@ -163,5 +169,30 @@ postLowerTaskR = reorderTaskR Down
reorderTaskR :: Direction -> TaskId -> Handler RepHtml
reorderTaskR direction taskId = authed (\userId -> do
- runDB $ reorderTask direction [TaskUser ==. userId, TaskId ==. taskId]
+ utcNow <- liftIO getCurrentTime
+ tz <- liftIO getCurrentTimeZone
+ let endOfToday = locally tz localEndOfDay utcNow
+
+ runDB $ reorderTask direction endOfToday [TaskUser ==. userId, TaskId ==. taskId]
+ redirectTemporary TasksR)
+
+
+postPostponeTaskR :: TaskId -> Handler RepHtml
+postPostponeTaskR taskId = authed (\userId -> do
+ runDB $ do
+ task <- myTask userId taskId
+ case task of
+ Nothing -> return ()
+ Just task -> postponeTask task
+ redirectTemporary TasksR)
+
+
+postActivateTaskR :: TaskId -> Handler RepHtml
+postActivateTaskR taskId = authed (\userId -> do
+ now <- liftIO getCurrentTime
+ runDB $ do
+ task <- myTask userId taskId
+ case task of
+ Nothing -> return ()
+ Just (taskId, _) -> activateTask now taskId
redirectTemporary TasksR)
View
55 Model.hs
@@ -27,37 +27,41 @@ newtype TaskState = TaskState Text
data NewTask = NewTask { newTaskTitle :: Text } deriving (Show)
-newTask :: UserId -> Int -> NewTask -> Task
-newTask uid order (NewTask title) = Task uid title 0 Nothing order
+newTask :: UserId -> UTCTime -> Int -> NewTask -> Task
+newTask uid scheduledFor order (NewTask title) = Task uid title 0 scheduledFor Nothing order
createTaskAtBottom :: PersistBackend SqlPersist m => UserId -> NewTask -> SqlPersist m TaskId
createTaskAtBottom userId task = do
+ now <- liftIO getCurrentTime
maybeLastTask <- selectFirst [TaskUser ==. userId] [Desc TaskOrder]
let lastOrder = maybe 0 (taskOrder . snd) maybeLastTask
- insert $ newTask userId (succ lastOrder) task
+ insert $ newTask userId now (succ lastOrder) task
data Direction = Up | Down deriving (Show, Enum, Bounded)
-nextTask :: PersistBackend SqlPersist m => Direction -> Task -> SqlPersist m (Maybe (TaskId, Task))
-nextTask direction task = selectFirst
+nextTask :: PersistBackend SqlPersist m => Direction -> UTCTime -> Task -> SqlPersist m (Maybe (TaskId, Task))
+nextTask direction endOfToday task = selectFirst
[ TaskUser ==. (taskUser task)
, (orderConstraint direction) TaskOrder (taskOrder task)
, TaskDoneAt ==. Nothing
+ , scheduledForConstraint TaskScheduledFor
] [(order direction) TaskOrder]
where
orderConstraint Up = (<.)
orderConstraint Down = (>.)
order Up = Desc
order Down = Asc
+ scheduledForConstraint | taskScheduledFor task <= endOfToday = (<=. endOfToday)
+ | otherwise = (>. endOfToday)
-reorderTask :: PersistBackend SqlPersist m => Direction -> [Filter Task] -> SqlPersist m ()
-reorderTask direction filters = do
+reorderTask :: PersistBackend SqlPersist m => Direction -> UTCTime -> [Filter Task] -> SqlPersist m ()
+reorderTask direction endOfToday filters = do
maybeTask <- selectFirst filters []
case maybeTask of
Nothing -> return ()
Just (taskId, task) -> do
- maybeNext <- nextTask direction task
+ maybeNext <- nextTask direction endOfToday task
case maybeNext of
Nothing -> return ()
Just (nextId, next) -> do
@@ -69,8 +73,29 @@ reorderTask direction filters = do
taskDone :: Task -> Bool
taskDone = isJust . taskDoneAt
+
+taskTodo :: TimeZone -> UTCTime -> Task -> Bool
+taskTodo tz now = (<= today) . taskScheduledForDay tz
+ where today = utcToLocalDay tz now
+
+utcToLocalDay :: TimeZone -> UTCTime -> Day
+utcToLocalDay tz = localDay . utcToLocalTime tz
+
+localEndOfDay :: LocalTime -> LocalTime
+localEndOfDay time = time { localTimeOfDay = TimeOfDay 23 59 59 }
+
+locally :: TimeZone -> (LocalTime -> LocalTime) -> UTCTime -> UTCTime
+locally tz f = localTimeToUTC tz . f . utcToLocalTime tz
+
+tomorrow :: UTCTime -> UTCTime
+tomorrow = addUTCTime oneDay
+ where oneDay = 24 * 60 * 60
+
taskDoneDay :: TimeZone -> Task -> Maybe Day
-taskDoneDay tz = fmap (localDay . utcToLocalTime tz) . taskDoneAt
+taskDoneDay tz = fmap (utcToLocalDay tz) . taskDoneAt
+
+taskScheduledForDay :: TimeZone -> Task -> Day
+taskScheduledForDay tz = utcToLocalDay tz . taskScheduledFor
instance ToHtml Day where
toHtml = toHtml . show
@@ -84,3 +109,15 @@ taskActionName task | taskDone task = "Restart"
estimateOptions :: [Int]
estimateOptions = [2 ^ x | x <- [0 .. 4]]
+
+
+myTask :: PersistBackend SqlPersist m => UserId -> TaskId -> SqlPersist m (Maybe (TaskId, Task))
+myTask userId taskId = selectFirst [TaskUser ==. userId, TaskId ==. taskId] []
+
+
+postponeTask :: PersistBackend SqlPersist m => (TaskId, Task) -> SqlPersist m ()
+postponeTask (taskId, task) = update taskId [TaskScheduledFor =. tomorrow (taskScheduledFor task)]
+
+
+activateTask :: PersistBackend SqlPersist m => UTCTime -> TaskId -> SqlPersist m ()
+activateTask now taskId = update taskId [TaskScheduledFor =. now]
View
1 config/models
@@ -11,6 +11,7 @@ Task
user UserId
title Text
pomos Int default=0
+ scheduledFor UTCTime default=now()
doneAt UTCTime Maybe
order Int
View
2 config/routes
@@ -14,3 +14,5 @@
/tasks/#TaskId/estimates TaskAddEstimateR POST
/tasks/#TaskId/raise RaiseTaskR POST
/tasks/#TaskId/lower LowerTaskR POST
+/tasks/#TaskId/postpone PostponeTaskR POST
+/tasks/#TaskId/activate ActivateTaskR POST
View
20 hamlet/tasks.hamlet
@@ -2,16 +2,16 @@
<h2>TODO
-$if null pending
+$if null todo
<p>Nothing to do. Congratulations! Why not take the day off?
$else
<table><tbody>
- $forall idAndTaskEstimates <- pending
- ^{taskTr idAndTaskEstimates}
+ $forall idAndTaskEstimates <- todo
+ ^{taskTr taskTodoToday idAndTaskEstimates}
<h3
- Remaining: #{sum $ map estimatedRemaining $ map snd pending} of
- $with idsAndEstimates <- map snd $ map snd pending
+ Remaining: #{sum $ map estimatedRemaining $ map snd todo} of
+ $with idsAndEstimates <- map snd $ map snd todo
$with firstEstimates <- map snd $ concatMap (take 1) idsAndEstimates
$with totalEstimated <- sum $ map estimatePomos firstEstimates
\ #{totalEstimated} estimated
@@ -20,6 +20,14 @@ $else
^{taskWidget}
<input type=submit value=Add
+
+$if not (null later)
+ <h2>Later
+ <table><tbody>
+ $forall idAndTaskEstimates <- later
+ ^{taskTr taskTodoToday idAndTaskEstimates}
+
+
$if not (null doneByDay)
<h2>Done
$forall dayAndTasksEstimates <- doneByDay
@@ -29,4 +37,4 @@ $if not (null doneByDay)
\ (#{sum $ map taskPomos tasks})
<table><tbody>
$forall idAndTaskEstimates <- snd dayAndTasksEstimates
- ^{taskTr idAndTaskEstimates}
+ ^{taskTr taskTodoToday idAndTaskEstimates}
View
6 hamlet/tasks/task-tr.hamlet
@@ -5,6 +5,12 @@
^{oneButton "v" (LowerTaskR taskId)}
<th .title rowspan=2>#{taskTitle task}
<td rowspan=2>^{setTaskDonenessButton taskId task}
+ <td rowspan=2
+ $if not (taskDone task)
+ $if taskTodoToday task
+ ^{oneButton "Postpone" (PostponeTaskR taskId)}
+ $else
+ ^{oneButton "Reactivate" (ActivateTaskR taskId)}
<td rowspan=2>^{oneButton "Delete" (DeleteTaskR taskId)}
<td .estimate
$if null estimates

0 comments on commit 41ef2f1

Please sign in to comment.