packages feed

ttask (empty) → 0.0.0.2

raw patch · 20 files changed

+1459/−0 lines, 20 filesdep +basedep +directorydep +extrasetup-changed

Dependencies added: base, directory, extra, optparse-declarative, safe, time, transformers, ttask

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,353 @@+{-# LANGUAGE DataKinds #-}+module Main where+import Control.Monad+import Control.Monad.IO.Class+import Data.Maybe+import Data.Time+import Data.TTask+import Options.Declarative++main :: IO ()+main = do+  initDirectory+  run_ $ Group "Task management tool for yourself is inspired by scrum."+    [ subCmd "project" cmdProject+    , subCmd "add" cmdAdd+    , subCmd "delete" cmdDelete+    , subCmd "move" cmdMove+    , subCmd "swap" cmdSwap+    , subCmd "active" cmdActive+    , subCmd "pbl" cmdShowPbl +    , subCmd "sprint" cmdShowSprints+    , subCmd "story" cmdShowStorys+    , subCmd "run" cmdRun+    , subCmd "finish" cmdFinish+    , subCmd "wait" cmdWait+    , subCmd "nota" cmdNotAchieved +    , subCmd "reject" cmdReject+    , subCmd "log" cmdLog+    ]++----+-- project++cmdProject +  :: Flag "i" '["ID"] "Project id" "Switch project id" (Def "" String)+  -> Cmd "Switch other project. Or list all projects when project id is abbreviated." ()+cmdProject i = liftIO $ do+  case get i of +    "" -> listupAllProjects+    j -> do+      res <- setActiveProject j+      when (res == Failure) +        . putStrLn $ failureMsgWithIdS "Set active project" "project" j++listupAllProjects :: IO ()+listupAllProjects = do+    mpn <- activeProjectName+    pjs <- findProjects+    case mpn of+      Just pn -> do+        when (notElem pn pjs) +          $ putStrLn ("Warning : active project `" ++ pn ++ "` is not found. Try `ttask project -i [project name]`")+        listProjects pn pjs+      Nothing -> do+        putStrLn "Warning : Get active project failed. Try `ttask project -i [project name]`"+  where+    listProjects :: String -> [String] -> IO ()+    listProjects pn = mapM_ $ putStrLn . fmtRow pn++    fmtRow :: String -> String -> String+    fmtRow apn lpn = (if apn == lpn then (" ["++).(++"]") else ("  "++)) lpn++----+-- add++cmdAdd :: Group+cmdAdd = Group "Add contents to active project"+  [ subCmd "project" cmdAddProject+  , subCmd "sprint" cmdAddSprint+  , subCmd "story" cmdAddStory+  , subCmd "task" cmdAddTask+  ]++cmdAddProject+  :: Arg "ID" String +  -> Flag "n" '["Name"] "Project name" "New projects explanatory name" String+  -> Cmd "Add new project and switch to it" ()+cmdAddProject j n = liftIO $ do+  initProjectFile (get j) (get n)++cmdAddSprint+  :: Arg "DESCRIPTION" String +  -> Cmd "Add sprint to active project" ()+cmdAddSprint description = liftIO . modifyActivePjSimple+    (addNewSprint $ get description) $ failureMsg "Add sprint"++cmdAddStory +  :: Arg "DESCRIPTION" String +  -> Flag "i" '["ID"] "Sprint id" "Target Sprint Id" (Def "-1" Int) +  -> Cmd "Add story to product backlog, Or designated sprint." ()+cmdAddStory description i = liftIO . modifyActiveProject+    (addStory (get i) $ get description) (failureMsg "Add story") +      $ failureMsgWithId "Add story" "sprint" (get i)+  where+    addStory :: Id -> String -> Project -> IO Project+    addStory i description pj = case i of+      -1 -> addNewStoryToPbl description pj+      _  -> addNewStoryToSprints i description pj++cmdAddTask+  :: Arg "DESCRIPTION" String +  -> Flag "i" '["ID"] "Story id" "Target Story Id" Int+  -> Flag "p" '["POINT"] "Estimated work point" "Estimated work point like 1, 2, 3, 5, 8 ..." Int+  -> Cmd "Add task to active project" ()+cmdAddTask description i point = liftIO . modifyActiveProject +  (addNewTask (get point) (get i) (get description)) (failureMsg "Add task") +    $ failureMsgWithId "Add task" "story" (get i)++----+-- delete++cmdDelete :: Group+cmdDelete = Group "Delete contents from active project"+  [ subCmd "sprint" cmdDeleteSprint+  , subCmd "story" cmdDeleteStory+  , subCmd "task" cmdDeleteTask+  ]++cmdDeleteSprint+  :: Flag "i" '["ID"] "Sprint id" "Target Sprint Id" Int+  -> Cmd "Delete sprint from active project" ()+cmdDeleteSprint i = liftIO . modifyActivePjSimple+  (return . deleteSprint (get i)) $ failureMsg "Delete sprint"++cmdDeleteStory+  :: Flag "i" '["ID"] "Story id" "Target Story Id" Int+  -> Cmd "Delete sprint from active project" ()+cmdDeleteStory i = liftIO . modifyActivePjSimple+  (return . deleteStory (get i)) $ failureMsg "Delete story"++cmdDeleteTask+  :: Flag "i" '["ID"] "Task id" "Target Task Id" Int+  -> Cmd "Delete sprint from active project" ()+cmdDeleteTask i = liftIO . modifyActivePjSimple+  (return . deleteTask (get i)) $ failureMsg "Delete task"++----+-- swap++cmdSwap :: Group+cmdSwap = Group "Swap contents of active project"+  [ subCmd "sprint" cmdSwapSprint+  , subCmd "story" cmdSwapStory+  , subCmd "task" cmdSwapTask+  ]++cmdSwapSprint +  :: Flag "f" '["ID-FROM"] "Sprint id From" "Target Story Id : From" Int+  -> Flag "t" '["ID-TO"] "Sprint id To" "Target Story Id : To" Int+  -> Cmd "Swap sprint of active project" ()+cmdSwapSprint i j = liftIO . modifyActivePjSimple+  (return . swapSprint (get i) (get j)) $ failureMsg "Swap sprint"++cmdSwapStory +  :: Flag "f" '["ID-FROM"] "Story id From" "Target Story Id : From" Int+  -> Flag "t" '["ID-TO"] "Story id To" "Target Story Id : To" Int+  -> Cmd "Swap story of active project" ()+cmdSwapStory i j = liftIO . modifyActivePjSimple+  (return . swapStory (get i) (get j)) $ failureMsg "Swap story"++cmdSwapTask +  :: Flag "f" '["ID-FROM"] "Task id From" "Target Story Id : From" Int+  -> Flag "t" '["ID-TO"] "Task id To" "Target Story Id : To" Int+  -> Cmd "Swap task of active project" ()+cmdSwapTask i j = liftIO . modifyActivePjSimple+  (return . swapTask (get i) (get j)) $ failureMsg "Swap task"++----+-- move++cmdMove :: Group+cmdMove = Group "Move contents of active project"+  [ subCmd "story" cmdMoveStory+  , subCmd "task" cmdMoveTask+  ]++cmdMoveStory+  :: Flag "i" '["ID"] "Story id" "Target Story Id" Int+  -> Flag "t" '["SPRINT-ID"] "Sprint id" "Destination Srint Id" (Def "-1" Int)+  -> Cmd "Move story of active project" ()+cmdMoveStory i s = liftIO . modifyActivePjSimple+    (return . moveStory (get i) (get s)) $ failureMsg "Move story"+  where+    moveStory :: Id -> Id -> Project -> Project+    moveStory i s pj = fromMaybe pj $ case s of+      -1 -> moveStoryToPbl i pj+      _  -> moveStoryToSprints i s pj++cmdMoveTask +  :: Flag "i" '["ID"] "Story id" "Target Story Id" Int+  -> Flag "t" '["STORY-ID"] "Story id" "Destination Story Id" Int+  -> Cmd "Move story of active project" ()+cmdMoveTask i s = liftIO . modifyActivePjSimple+  (\pj -> return . fromMaybe pj $ moveTask (get i) (get s) pj) $ failureMsg "Move task"++----+-- update++cmdRun :: Group+cmdRun = Group "Update contents status to `Running`"+  [ subCmd "sprint" (cmdUpdStatusSprint StatusRunning)+  , subCmd "story" (cmdUpdStatusStory StatusRunning)+  , subCmd "task" (cmdUpdStatusTask StatusRunning)+  ]++cmdFinish :: Group+cmdFinish = Group "Update contents status to `Finish`"+  [ subCmd "sprint" (cmdUpdStatusSprint StatusFinished)+  , subCmd "story" (cmdUpdStatusStory StatusFinished)+  , subCmd "task" (cmdUpdStatusTask StatusFinished)+  ]++cmdWait :: Group+cmdWait = Group "Update contents status to `Wait`"+  [ subCmd "sprint" (cmdUpdStatusSprint StatusWait)+  , subCmd "story" (cmdUpdStatusStory StatusWait)+  , subCmd "task" (cmdUpdStatusTask StatusWait)+  ]++cmdNotAchieved :: Group+cmdNotAchieved = Group "Update contents status to `Not Achieved`"+  [ subCmd "sprint" (cmdUpdStatusSprint StatusNotAchieved)+  , subCmd "story" (cmdUpdStatusStory StatusNotAchieved)+  , subCmd "task" (cmdUpdStatusTask StatusNotAchieved)+  ]++cmdReject :: Group+cmdReject = Group "Update contents status to `Rejected`"+  [ subCmd "sprint" (cmdUpdStatusSprint StatusReject)+  , subCmd "story" (cmdUpdStatusStory StatusReject)+  , subCmd "task" (cmdUpdStatusTask StatusReject)+  ]++cmdUpdStatusSprint :: (LocalTime -> TStatusRecord)+  -> Flag "i" '["ID"] "Sprint id" "Target Sprint Id" Int+  -> Cmd "Update sprint of active project" ()+cmdUpdStatusSprint s i = liftIO $ do+  lt <- getLocalTime+  modifyActivePjSimple+    (return . updateSprintStatus (get i) (s lt)) $ failureMsg "Update sprint"++cmdUpdStatusStory :: (LocalTime -> TStatusRecord)+  -> Flag "i" '["ID"] "Story id" "Target Story Id" Int+  -> Cmd "Update story of active project" ()+cmdUpdStatusStory s i = liftIO $ do+  lt <- getLocalTime+  modifyActivePjSimple+    (return . updateStoryStatus (get i) (s lt)) $ failureMsg "Update story"++cmdUpdStatusTask :: (LocalTime -> TStatusRecord)+  -> Flag "i" '["ID"] "Task id" "Target Task Id" Int+  -> Cmd "Update task of active project" ()+cmdUpdStatusTask s i = liftIO $ do+  lt <- getLocalTime+  modifyActivePjSimple+    (return . updateTaskStatus (get i) (s lt)) $ failureMsg "Update task"++----+-- show++cmdActive +  :: Cmd "Show active projects information" ()+cmdActive = liftIO $ do+    pn <- activeProjectName+    case pn of+      Just n -> +        execToActiveProject (putStrLn . ppActive n) $ failureMsg "Show project"+      Nothing -> putStrLn $ failureMsg "Show project"++cmdShowPbl +  :: Cmd "List all pbl stories" ()+cmdShowPbl  = liftIO $ do+  execToActiveProject (putStrLn . ppProjectPbl) $ failureMsg "Show product backlog"++cmdShowSprints+  :: Flag "i" '["ID"] "Sprint id" "Target Sprint Id" (Def "-1" Int)+  -> Flag "s" '["SIMPLE"] "show simple" "Show simple mode when sprint id is designated." Bool+  -> Cmd "List all sprint, Or show sprints detail when project id is not abbreviated." ()+cmdShowSprints i s = liftIO $ do+    execToActiveProject (showSprint $ get i) $ failureMsg "Show sprint(s)"+  where+    showSprint :: Id -> Project -> IO ()+    showSprint i pj = +      showContnt i pj ppProjectSprintList (if get s then ppProjectSprint else ppProjectSprintDetail)+      ("Error : Show sprint(s) Filure. Check target story (id = " ++ show i ++ ") is exist")++cmdShowStorys+  :: Flag "i" '["ID"] "Story id" "Target Story Id" Int+  -> Cmd "Show target story information and all tasks" ()+cmdShowStorys i = liftIO $ do+    execToActiveProject (showStory $ get i) $ failureMsg "Show story"+  where+    showStory :: Id -> Project -> IO ()+    showStory i pj = showContnt i pj (const "") ppProjectStory+      ("Error : Show story Filure. Check target story (id = " ++ show i ++ ") is exist")++----+-- log++cmdLog +  :: Flag "i" '["ID"] "Sprint id" "Target Sprint Id" Int+  -> Cmd "Analysis sprint log" ()+cmdLog i = liftIO $ do+    execToActiveProject (showSprintLog $ get i) $ failureMsg "Show sprint log"+  where+    showSprintLog :: Id -> Project -> IO ()+    showSprintLog i pj = showContnt i pj (const "") ppProjectSprintLog+      ("Error : Show sprint log Filure. Check target sprint (id = " ++ show i ++ ") is exist")++----+-- util++modifyActivePjSimple :: (Project -> IO Project) -> String -> IO ()+modifyActivePjSimple f err = modifyActiveProject f err err++modifyActiveProject :: (Project -> IO Project) -> String -> String -> IO ()+modifyActiveProject f err1 err2 = do+  mpj <- readActiveProject+  case mpj of+    Just pj -> do+      res <- writeActiveProject =<< f pj+      when (res == Failure) +        $ putStrLn err2+    Nothing -> putStrLn err1++execToActiveProject :: (Project -> IO ()) -> String -> IO ()+execToActiveProject f err = do+  mpj <- readActiveProject+  case mpj of+    Just pj -> f pj+    Nothing -> putStrLn err++showContnt :: Id -> Project -> (Project -> String) -> (Id -> Project -> Maybe String) -> String -> IO ()+showContnt i pj f g err = case i of+  -1 -> putStrLn (f pj)+  _  -> +    let res = g i pj +    in case res of +      Just r -> putStrLn r+      Nothing -> putStrLn err++----++failureMsg :: String -> String+failureMsg s +  = "Error : " ++ s ++ " Failure. Check active project is available as `ttask project`"++failureMsgWithId :: String -> String -> Id -> String+failureMsgWithId s t i = failureMsgWithIdS s t $ show i++failureMsgWithIdS :: String -> String -> String -> String+failureMsgWithIdS s t i +  = "Error : " ++ s ++ " Failure. Check " ++ t ++ " `" ++ show i ++ "` exist"
+ src/Data/TTask.hs view
@@ -0,0 +1,12 @@+module Data.TTask +  ( module Data.TTask.Command +  , module Data.TTask.Types+  , module Data.TTask.Pretty+  , module Data.TTask.File+  , module Data.TTask.Analysis+  ) where+import Data.TTask.Command +import Data.TTask.Types+import Data.TTask.Pretty+import Data.TTask.File+import Data.TTask.Analysis
+ src/Data/TTask/Analysis.hs view
@@ -0,0 +1,63 @@+module Data.TTask.Analysis +  ( DailyStatuses(..)+  , dailyGroup+  , summaryPointBy +  ) where+import Data.List+import Data.Maybe+import Data.Time+import Data.TTask.Types++data DailyStatuses = DailyStatuses+  { dayStDay :: Day+  , dayStPoint :: Point+  , dayStStatuses :: [StatusLogRec]+  }++dailyGroup :: [StatusLogRec] -> [DailyStatuses]+dailyGroup = catMaybes . map sr2ds . dailyGrouping +  where+    sr2ds :: [StatusLogRec] -> Maybe DailyStatuses+    sr2ds srs = do+      (d, p) <- calcDaylyPoint srs+      return $ DailyStatuses+        { dayStDay = d+        , dayStPoint = p+        , dayStStatuses = srs+        }++----++calcDaylyPoint :: [StatusLogRec] -> Maybe (Day, Point)+calcDaylyPoint [] = Nothing+calcDaylyPoint xs@(x:_) = Just . (,) (getDay x) $ summaryPointBy isFinishedTask xs+  where+    isFinishedTask :: StatusLogRec -> Bool+    isFinishedTask r +      = (stFinished $ stRecToStatus r) && (isTask $ stRecToContents r)++dailyGrouping :: [StatusLogRec] -> [[StatusLogRec]]+dailyGrouping = groupBy (\l r -> getDay l == getDay r) . sortRecord+  where+    sortRecord :: [StatusLogRec] -> [StatusLogRec]+    sortRecord = sortBy (\l r -> getTime l `compare` getTime r)++----++summaryPointBy :: (StatusLogRec -> Bool) -> [StatusLogRec] -> Point+summaryPointBy f = foldl (+) 0 . map getPoint . filter f ++getDay :: StatusLogRec -> Day+getDay = localDay . getTime++getTime :: StatusLogRec -> LocalTime+getTime = getStatusTime . stRecToStatus++getPoint :: StatusLogRec -> Point+getPoint r = case stRecToContents r of+  TTaskProject v -> calcProjectPoint v+  TTaskSprint v -> calcSprintPoint v+  TTaskStory v -> calcStoryPoint v+  TTaskTask v -> taskPoint v ++
+ src/Data/TTask/Command.hs view
@@ -0,0 +1,10 @@+module Data.TTask.Command+  ( module Data.TTask.Command.Add +  , module Data.TTask.Command.Update +  , module Data.TTask.Command.Move+  , module Data.TTask.Command.Delete+  )  where+import Data.TTask.Command.Add +import Data.TTask.Command.Update +import Data.TTask.Command.Move+import Data.TTask.Command.Delete
+ src/Data/TTask/Command/Add.hs view
@@ -0,0 +1,161 @@+module Data.TTask.Command.Add +  ( newProject +  , addNewStoryToPbl+  , addNewStoryToSprints+  , addNewSprint+  , addNewTask+  , addSprintToProject +  , addStoryToPbl +  , addStoryToPblFirst +  , addStoryToPjSprints +  , addTaskToProject +  , getLocalTime +  , projectsTaskMaxId +  , projectStoryMaxId +  , projectSprintMaxId +  ) where+import Data.Time+import Data.List.Extra+import Data.Maybe+import Data.TTask.Types+import Safe++------+-- Create new Contents++newProject :: String -> IO Project+newProject name = do+  lt <- getLocalTime+  return $ Project+    { projectName = name+    , projectBacklog = []+    , projectSprints = []+    , projectStatus = TStatusOne $ StatusWait lt+    }++newStory :: String -> Int -> IO UserStory+newStory description id = do+  lt <- getLocalTime+  return $ UserStory+    { storyId = id+    , storyDescription = description+    , storyTasks = []+    , storyStatus = TStatusOne $ StatusWait lt+    }++newTask :: String -> Point -> Id -> IO Task+newTask description point id = do+  lt <- getLocalTime+  return $ Task+    { taskId = id+    , taskDescription = description+    , taskPoint = point+    , taskStatus = TStatusOne $ StatusWait lt+    , taskWorkTimes = []+    }++newSprint :: String -> Id -> IO Sprint+newSprint description id = do+  lt <- getLocalTime+  return $ Sprint+    { sprintId = id+    , sprintDescription = description+    , sprintStorys = []+    , sprintStatus = TStatusOne $ StatusWait lt+    }++------+-- Add new contents to project++addNewStoryToPbl :: String -> Project -> IO Project+addNewStoryToPbl description pj = do+  let nid = projectStoryMaxId pj + 1+  us <- newStory description nid+  return $ pj { projectBacklog = snoc (projectBacklog pj) us }++addNewStoryToSprints :: Id -> String -> Project -> IO Project+addNewStoryToSprints spid description pj = do+    let nid = projectStoryMaxId pj + 1+    us <- newStory description nid+    return $ addStoryToPjSprints spid us pj++addNewSprint :: String -> Project -> IO Project+addNewSprint description pj = do+  let nid = projectSprintMaxId pj + 1+  sp <- newSprint description nid+  return $ addSprintToProject sp pj++addNewTask :: Point -> Id -> String -> Project -> IO Project+addNewTask point usid description pj = do+    let nid = projectsTaskMaxId pj + 1+    task <- newTask description point nid+    return $ addTaskToProject usid task pj++------+-- Add existing contents ++addSprintToProject :: Sprint -> Project -> Project+addSprintToProject sp pj  = pj { projectSprints = snoc (projectSprints pj) sp }++addStoryToPbl :: UserStory -> Project -> Project+addStoryToPbl us pj = pj { projectBacklog = snoc (projectBacklog pj) us }++addStoryToPblFirst :: UserStory -> Project -> Project+addStoryToPblFirst us pj = pj { projectBacklog = us : projectBacklog pj }++addStoryToPjSprints :: Id -> UserStory -> Project -> Project+addStoryToPjSprints i us pj = pj { projectSprints = map (addStoryToSprint i us) $ projectSprints pj }++addTaskToProject :: Id -> Task -> Project -> Project+addTaskToProject i task pj = pj+      { projectBacklog = addTaskToStorys i task $ projectBacklog pj+      , projectSprints = addTaskToSprintList i task $ projectSprints pj+      }++----++addStoryToSprint :: Id -> UserStory -> Sprint -> Sprint+addStoryToSprint id us sp = if sprintId sp == id then+   sp { sprintStorys = snoc (sprintStorys sp) us } else sp++addTaskToSprintList :: Id -> Task -> [Sprint] -> [Sprint]+addTaskToSprintList id task = map $ addTaskToSprint id task++addTaskToSprint :: Id -> Task -> Sprint -> Sprint+addTaskToSprint id task sp = +  sp { sprintStorys = addTaskToStorys id task $ sprintStorys sp  }++addTaskToStorys :: Id -> Task -> [UserStory] -> [UserStory]+addTaskToStorys id task = map $ addTaskToStory id task++addTaskToStory :: Id -> Task -> UserStory -> UserStory+addTaskToStory id task us = if storyId us == id+  then us { storyTasks = snoc (storyTasks us) task } else us++------+-- Id Control++projectsTaskMaxIdMay :: Project -> Maybe Id+projectsTaskMaxIdMay = maximumMay . map taskId . projectsAllTasks++projectsTaskMaxId :: Project -> Id+projectsTaskMaxId = fromMaybe 0 . projectsTaskMaxIdMay++projectStoryMaxIdMay :: Project -> Maybe Id+projectStoryMaxIdMay = maximumMay . map storyId . projectsAllStory++projectStoryMaxId :: Project -> Id+projectStoryMaxId = fromMaybe 0 . projectStoryMaxIdMay++projectSprintMaxIdMay :: Project -> Maybe Id+projectSprintMaxIdMay = maximumMay . map sprintId . projectSprints++projectSprintMaxId :: Project -> Id+projectSprintMaxId = fromMaybe 0 . projectSprintMaxIdMay++---- +-- Util ++getLocalTime :: IO LocalTime+getLocalTime = getZonedTime >>= return . zonedTimeToLocalTime+
+ src/Data/TTask/Command/Delete.hs view
@@ -0,0 +1,38 @@+module Data.TTask.Command.Delete +  ( deleteTask +  , deleteStory +  , deleteSprint +  ) where+import Data.TTask.Types++deleteTask :: Id -> Project -> Project+deleteTask i pj = pj+  { projectBacklog  = map (deleteTaskFromStory i) $ projectBacklog pj +  , projectSprints = map (deleteTaskFromSprint i) $ projectSprints pj +  }++deleteStory :: Id -> Project -> Project+deleteStory i pj = pj+  { projectBacklog  = filter (\u -> storyId u /= i) $ projectBacklog pj+  , projectSprints = map (deleteStoryFromSprint i) $ projectSprints pj +  }++deleteSprint :: Id -> Project -> Project+deleteSprint i pj +  = pj { projectSprints = filter (\s -> sprintId s /= i) $ projectSprints pj }++----++deleteTaskFromStory :: Id -> UserStory -> UserStory+deleteTaskFromStory i s +  = s { storyTasks = filter (\t -> taskId t /= i) $ storyTasks s }++deleteTaskFromSprint :: Id -> Sprint -> Sprint+deleteTaskFromSprint i s +  = s { sprintStorys = map (deleteTaskFromStory i) $ sprintStorys s }++deleteStoryFromSprint :: Id -> Sprint -> Sprint+deleteStoryFromSprint i s +  = s { sprintStorys = filter (\u -> storyId u /= i) $ sprintStorys s }++
+ src/Data/TTask/Command/Move.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Data.TTask.Command.Move +  ( moveStoryToPbl +  , moveStoryToSprints +  , moveTask +  , swapSprint +  , swapStory +  , swapTask +  ) where+import Control.Applicative+import Control.Monad+import Data.Maybe+import Data.TTask.Types+import Data.TTask.Command.Add+import Data.TTask.Command.Delete++------+-- move contents++moveStoryToPbl :: Id -> Project -> Maybe Project+moveStoryToPbl uid pj = do+  us <- getUserStoryById pj uid+  return . addStoryToPblFirst us . deleteStory uid $ pj++moveStoryToSprints :: Id -> Id -> Project -> Maybe Project+moveStoryToSprints uid sid pj = do+  us <- getUserStoryById pj uid+  _ <- getSprintById pj sid+  return . addStoryToPjSprints sid us . deleteStory uid $ pj++moveTask :: Id -> Id -> Project -> Maybe Project+moveTask tid uid pj = do+  task <- getTaskById pj tid+  _ <- getUserStoryById pj uid+  return . addTaskToProject uid task . deleteTask tid $ pj++------+-- swap contents++swapSprint :: Id -> Id -> Project -> Project+swapSprint fid tid pj = +  let (f2t, t2f) = swapFuncs pj sprintId getSprintById fid tid+  in pj { projectSprints = swapBy f2t t2f $ projectSprints pj }++swapStory :: Id -> Id -> Project -> Project+swapStory fid tid pj = +  let (f2t, t2f) = swapFuncs pj storyId getUserStoryById fid tid+  in pj+    { projectBacklog = swapBy f2t t2f $ projectBacklog pj+    , projectSprints = map (swapSprintsStory fid tid pj) $ projectSprints pj+    }++swapTask :: Id -> Id -> Project -> Project+swapTask fid tid pj = +  let (f2t, t2f) = swapFuncs pj taskId getTaskById fid tid+  in pj+    { projectBacklog = map (swapStorysTask fid tid pj) $ projectBacklog pj+    , projectSprints = map (swapSprintsTask fid tid pj) $ projectSprints pj+    }++----++swapSprintsTask :: Id -> Id -> Project -> Sprint -> Sprint+swapSprintsTask fid tid pj sp = +  let (f2t, t2f) = swapFuncs pj taskId getTaskById fid tid+  in sp { sprintStorys = map (swapStorysTask fid tid pj) $ sprintStorys sp }++swapStorysTask :: Id -> Id -> Project -> UserStory -> UserStory+swapStorysTask fid tid pj story = +  let (f2t, t2f) = swapFuncs pj taskId getTaskById fid tid+  in story { storyTasks = swapBy f2t t2f $ storyTasks story } ++swapSprintsStory :: Id -> Id -> Project -> Sprint -> Sprint+swapSprintsStory fid tid pj sp = +  let (f2t, t2f) = swapFuncs pj storyId getUserStoryById fid tid+  in sp { sprintStorys = swapBy f2t t2f $ sprintStorys sp }++swapFuncs :: Project -> (a -> Id) +  -> (Project -> Id -> Maybe a) -> Id -> Id -> (a -> Maybe a, a -> Maybe a)+swapFuncs pj f g fid tid = +  (\v -> guard (f v == fid) >> g pj tid, \v -> guard (f v == tid) >> g pj fid)++----++swapBy :: forall a. (a -> Maybe a) -> (a -> Maybe a) -> [a] -> [a]+swapBy f g = swp+  where+    swp :: [a] -> [a]+    swp [] = []+    swp (x:xs) = fromMaybe x (f x <|> g x) : swp xs+
+ src/Data/TTask/Command/Update.hs view
@@ -0,0 +1,67 @@+module Data.TTask.Command.Update+  ( updateTaskStatus +  , updateStoryStatus +  , updateSprintStatus +  , updateTask +  , updateStory +  , updateSprint +  )  where+import Data.TTask.Types++------+-- Update status++updateTaskStatus :: Id -> TStatusRecord -> Project -> Project+updateTaskStatus i r pj  +  = updateTask i (\t -> t { taskStatus = r `TStatusCons` taskStatus t }) pj++updateStoryStatus :: Id -> TStatusRecord -> Project -> Project+updateStoryStatus i r pj  +  = updateStory i (\s -> s { storyStatus = r `TStatusCons` storyStatus s }) pj++updateSprintStatus :: Id -> TStatusRecord -> Project -> Project+updateSprintStatus i r pj  +  = updateSprint i (\s -> s { sprintStatus = r `TStatusCons` sprintStatus s }) pj++------+-- Update contents++updateTask :: Id -> (Task -> Task) -> Project -> Project+updateTask i f pj = pj+    { projectBacklog = map (updateStorysTask i f) $ projectBacklog pj+    , projectSprints = map (updateSprintsTask i f) $ projectSprints pj+    }++updateStory :: Id -> (UserStory -> UserStory) -> Project -> Project+updateStory i f pj = pj+    { projectBacklog = map (updateStorysStory i f) $ projectBacklog pj+    , projectSprints = map (updateSprintsStory i f) $ projectSprints pj+    }++updateSprint :: Id -> (Sprint -> Sprint) -> Project -> Project+updateSprint i f pj +  = pj { projectSprints = map (updateSprintsSprint i f) $ projectSprints pj } ++----++updateSprintsTask :: Id -> (Task -> Task) -> Sprint -> Sprint+updateSprintsTask i f sp +  = sp { sprintStorys = map (updateStorysTask i f) $ sprintStorys sp}++updateStorysTask :: Id -> (Task -> Task) -> UserStory -> UserStory+updateStorysTask i f story +  = story { storyTasks = map (updateTasksTask i f) $ storyTasks story } ++updateSprintsStory :: Id -> (UserStory -> UserStory) -> Sprint -> Sprint+updateSprintsStory i f sp +  = sp { sprintStorys = map (updateStorysStory i f) $ sprintStorys sp }++updateStorysStory :: Id -> (UserStory -> UserStory) -> UserStory -> UserStory+updateStorysStory i f story = if i == storyId story then f story else story++updateSprintsSprint :: Id -> (Sprint -> Sprint) -> Sprint -> Sprint+updateSprintsSprint i f sp = if i == sprintId sp then f sp else sp++updateTasksTask :: Id -> (Task -> Task) -> Task -> Task+updateTasksTask i f task = if i == taskId task then f task else task+
+ src/Data/TTask/File.hs view
@@ -0,0 +1,106 @@+module Data.TTask.File +  ( Success(..)+  , readActiveProject+  , writeActiveProject+  , activeProjectName+  , setActiveProject+  , initDirectory +  , initProjectFile +  , findProjects +  ) where+import Control.Applicative+import Control.Exception+import Control.Monad+import Data.Maybe+import Data.TTask.Types+import Data.TTask.Command+import Safe+import System.Directory++data Success = Success | Failure deriving (Show, Read, Eq)++writeProject :: String -> Project -> IO ()+writeProject fn pj = writeFile fn $ show pj++readProject :: String -> IO (Maybe Project)+readProject fn = do+  d <- readFile fn+  return $ readMay d++readActiveProject :: IO (Maybe Project)+readActiveProject = do+  dir <- return . (++"/") =<< projectsDirectory+  mfn <- activeProjectName +  join <$> sequence (readProject . (dir++) <$> mfn)++writeActiveProject :: Project -> IO Success+writeActiveProject pj = do+  dir <- return . (++"/") =<< projectsDirectory+  mfn <- activeProjectName +  res <- sequence $ writeProject <$> fmap (dir++) mfn <*> pure pj+  case res of+    Just _ -> return Success+    Nothing -> return Failure++----++workDirectory :: IO String+workDirectory = do+  homeDir <- getHomeDirectory+  return $ homeDir ++ "/.ttask"++projectsDirectory :: IO String+projectsDirectory = do+  homeDir <- getHomeDirectory+  return $ homeDir ++ "/.ttask/projects"++activeMemoryFile :: IO String+activeMemoryFile = workDirectory >>= return . (++"/active")++activeProjectName :: IO (Maybe String)+activeProjectName = do+  fn <- activeMemoryFile+  exist <- doesFileExist fn+  if exist+    then readFile fn >>= return . Just+    else do+      writeFile fn ""+      return Nothing+    +setActiveProject :: String -> IO Success+setActiveProject id = do+  fn <- activeMemoryFile+  files <- findProjects+  if elem id files+    then do+      writeFile fn id+      return Success+    else return Failure++----++initDirectory :: IO ()+initDirectory = do+  workDirectory >>= createDirectoryIfMissing False+  projectsDirectory >>= createDirectoryIfMissing False++initProjectFile :: String -> String -> IO ()+initProjectFile id name = do+  pj <- newProject name+  fn <- projectsDirectory >>= return . (++"/"++id)+  writeProject fn $ pj+  _ <- setActiveProject id --ファイル作成直後なので成功している気持ち……+  return ()++findProjects :: IO [String]+findProjects = do +  files <- getDirectoryContentsMay =<< projectsDirectory+  return . filter (\s -> s /= "." && s /= "..") $ fromMaybe [] files++getDirectoryContentsMay :: String -> IO (Maybe [String])+getDirectoryContentsMay path = +  (return . Just =<< getDirectoryContents path) `catch` through+    where+      through :: SomeException -> IO (Maybe a)+      through _ = return Nothing+
+ src/Data/TTask/Pretty.hs view
@@ -0,0 +1,6 @@+module Data.TTask.Pretty+  ( module Data.TTask.Pretty.Contents+  , module Data.TTask.Pretty.Status+  ) where+import Data.TTask.Pretty.Contents+import Data.TTask.Pretty.Status
+ src/Data/TTask/Pretty/Contents.hs view
@@ -0,0 +1,131 @@+module Data.TTask.Pretty.Contents+  ( ppActive+  , ppStory +  , ppStoryI +  , ppStoryList +  , ppSprint +  , ppSprintList +  , ppProjectPbl +  , ppProjectSprintList +  , ppProjectSprint +  , ppProjectSprintDetail +  , ppSprintHeaderDetail +  , ppProjectStory +  , ppProjectTask +  , ppStatusRecord+  ) where+import Control.Applicative+import Data.TTask.Types+import Data.List++ppActive :: String -> Project -> String +ppActive pid pj = let+    activeSprints :: Project -> [Sprint]+    activeSprints = filter (isRunning . sprintStatus) . projectSprints+  in concat+    [ ppProjectHeader pid pj +    , if activeSprints pj /= [] then "\n\nActive sprint(s) :\n" else "\nRunning sprint is nothing"+    , intercalate "\n" . map ppSprintDetail $ activeSprints pj+    , if projectBacklog pj /= [] then "\n\nProduct backlog :\n" else ""+    , ppProjectPbl pj+    ]++----++ppTask :: Task -> String+ppTask task = formatRecord "TASK" +  (taskId task) (taskPoint task) +  (taskStatus task) (taskDescription task)++ppStoryHeader :: UserStory -> String+ppStoryHeader story = formatRecord "STORY" +  (storyId story) (calcStoryPoint story) +  (storyStatus story) (storyDescription story)++ppStory :: UserStory -> String+ppStory story = ppStoryI 1 story++ppStoryI :: Int -> UserStory -> String+ppStoryI r story = formatFamily r story ppStoryHeader storyTasks ppTask++ppStoryList :: [UserStory] -> String+ppStoryList = intercalate "\n" . map ppStoryHeader++ppSprintHeader :: Sprint -> String+ppSprintHeader sprint = formatRecord "SPRINT" +  (sprintId sprint) (calcSprintPoint sprint) +  (sprintStatus sprint) (sprintDescription sprint)++ppSprint :: Sprint -> String+ppSprint sprint = formatFamily 1 sprint ppSprintHeader sprintStorys ppStoryHeader++ppSprintList :: [Sprint] -> String+ppSprintList = intercalate "\n" . map ppSprintHeader++ppProjectHeader :: String -> Project -> String+ppProjectHeader pid pj = +  formatRecordShowedId "PROJECT" pid (calcProjectPoint pj) (projectStatus pj) (projectName pj)++----++ppSprintDetail :: Sprint -> String+ppSprintDetail s +    = formatFamily 1 s ppSprintHeaderDetail sprintStorys $ \s -> ppStoryI 2 s++ppSprintHeaderDetail :: Sprint -> String+ppSprintHeaderDetail s = ppSprintHeader s ++ "\n" ++ ppStatus (sprintStatus s)++----++ppProjectPbl :: Project -> String+ppProjectPbl = ppStoryList . projectBacklog++ppProjectSprintList :: Project -> String+ppProjectSprintList = ppSprintList . projectSprints++ppProjectSprint :: Id -> Project -> Maybe String+ppProjectSprint i pj = ppSprint <$> getSprintById pj i++ppProjectSprintDetail :: Id -> Project -> Maybe String+ppProjectSprintDetail i pj = ppSprintDetail <$> getSprintById pj i++ppProjectStory :: Id -> Project -> Maybe String+ppProjectStory i pj = ppStory <$> getUserStoryById pj i++ppProjectTask :: Id -> Project -> Maybe String+ppProjectTask i pj = ppTask <$> getTaskById pj i++----++formatRecord :: String -> Id -> Point -> TStatus -> String -> String+formatRecord htype i point st description = +  formatRecordShowedId htype (show i) point st description++formatRecordShowedId :: String -> String -> Point -> TStatus -> String -> String+formatRecordShowedId htype i point st description = concat+  [ htype ++ " - " , i , " : " , show $ point +  , "pt [ " , ppStatusRecord . getLastStatus $ st , " ] " , description+  ]++formatFamily :: Eq b => Int -> a -> (a -> String) -> (a -> [b]) -> (b -> String) -> String+formatFamily r x f g h = concat+  [ f x , if g x /= [] then "\n" else "" , intercalate "\n" . map (indent . h) $ g x ]+    where indent = ((concat $ replicate r "　　")++)++----++ppStatusRecord :: TStatusRecord -> String+ppStatusRecord (StatusWait _) = "Wait"+ppStatusRecord (StatusRunning _) = "Running"+ppStatusRecord (StatusFinished _) = "Finished"+ppStatusRecord (StatusNotAchieved _) = "Not Achieved"+ppStatusRecord (StatusReject _) = "Reject"++ppStatus :: TStatus -> String+ppStatus s = intercalate "\n" . map pps . reverse $ statusToList s+  where+    pps :: TStatusRecord -> String+    pps r = +      let st = take 15 $ ppStatusRecord r ++ concat (replicate 16 " ")+      in "To " ++ st ++ " at " ++ show (getStatusTime r)+
+ src/Data/TTask/Pretty/Status.hs view
@@ -0,0 +1,60 @@+module Data.TTask.Pretty.Status+  ( ppProjectSprintLog +  ) where+import Control.Applicative+import Data.List+import Data.Time+import Data.TTask.Types+import Data.TTask.Analysis +import Data.TTask.Pretty.Contents++ppProjectSprintLog :: Id -> Project -> Maybe String+ppProjectSprintLog i pj = ppDailySprintLog <$> getSprintById pj i++ppDailySprintLog :: Sprint -> String+ppDailySprintLog s = +  let +    sx = getSprintLastStatuses s+    cond f r = (f $ stRecToStatus r) && (isTask $ stRecToContents r)+    summary f = show (summaryPointBy (cond f) sx)+  in concat+      [ ppSprintHeaderDetail s+      , "\n\n" +      , intercalate "\n" . map ppDailyStatuses . dailyGroup $ getSprintStatuses s+      , "\n\n" +      , "Wait : " ++ summary stWait ++ "pt\n"+      , "Running : " ++ summary stRunning ++ "pt\n"+      , "Finished : " ++ summary stFinished ++ "pt\n"+      , "Not Achieved : " ++ summary stNotAchieved ++ "pt\n"+      , "Rejected : " ++ summary stRejected ++ "pt"+      ]++----++ppDailyStatuses :: DailyStatuses -> String+ppDailyStatuses d = concat+  [ show (dayStDay d), " : Total Finished point = ", show (dayStPoint d), "\n"+  , intercalate "\n" . map (("    "++) . ppStatusLog) $ dayStStatuses d+  ]++ppStatusLog :: StatusLogRec -> String+ppStatusLog s = case stRecToContents s of+  TTaskProject v -> +    fmtStatusRec "PROJECT" 0 (calcProjectPoint v) s (projectName v)+  TTaskSprint  v -> +    fmtStatusRec "SPRINT" (sprintId v) (calcSprintPoint v) s (sprintDescription v)+  TTaskStory   v -> +    fmtStatusRec "STORY" (storyId v) (calcStoryPoint v) s (storyDescription v)+  TTaskTask    v -> +    fmtStatusRec "TASK" (taskId v) (taskPoint v) s (taskDescription v)++fmtStatusRec +  :: String -> Id -> Point -> StatusLogRec -> String -> String+fmtStatusRec s i p r d = concat+  [ "[", s, " ", show p, "pt ", stAndLt, "] ", show i, " : ", d ]+    where+      stAndLt :: String+      stAndLt = concat +        [ ppStatusRecord (stRecToStatus r)+        , " at ", show . localTimeOfDay . getStatusTime $ stRecToStatus r+        ]
+ src/Data/TTask/Types.hs view
@@ -0,0 +1,8 @@+module Data.TTask.Types+  ( module Data.TTask.Types.Types+  , module Data.TTask.Types.Contents+  , module Data.TTask.Types.Status+  )  where+import Data.TTask.Types.Types+import Data.TTask.Types.Contents+import Data.TTask.Types.Status
+ src/Data/TTask/Types/Contents.hs view
@@ -0,0 +1,81 @@+module Data.TTask.Types.Contents+  ( isProject +  , isSprint +  , isStory +  , isTask +  , sprintAllTasks +  , projectsAllTasks +  , projectsAllStory +  , calcStoryPoint +  , calcSprintPoint +  , calcProjectPoint +  , getUserStoryById +  , getTaskById +  , getSprintById +  ) where+import Data.TTask.Types.Types+import Data.List++------+-- Screening contents++isProject :: TTaskContents -> Bool+isProject (TTaskProject _) = True+isProject _ = False++isSprint :: TTaskContents -> Bool+isSprint (TTaskSprint _) = True+isSprint _ = False++isStory :: TTaskContents -> Bool+isStory (TTaskStory _) = True+isStory _ = False++isTask :: TTaskContents -> Bool+isTask (TTaskTask _) = True+isTask _ = False++------+-- List up Task/Story++sprintAllTasks :: Sprint -> [Task]+sprintAllTasks = concatMap storyTasks . sprintStorys++projectsAllTasks :: Project -> [Task]+projectsAllTasks p = concat +  [ concatMap sprintAllTasks $ projectSprints p +  , concatMap storyTasks $ projectBacklog p +  ]++projectsAllStory :: Project -> [UserStory]+projectsAllStory p = concat +  [ concatMap sprintStorys $ projectSprints p , projectBacklog $ p ]++------+-- Calclate sum of point++calcStoryPoint :: UserStory -> Point+calcStoryPoint = summaryContents storyTasks taskPoint++calcSprintPoint :: Sprint -> Point+calcSprintPoint = summaryContents sprintStorys calcStoryPoint++calcProjectPoint :: Project -> Point+calcProjectPoint pj +  = summaryContents projectSprints calcSprintPoint pj +  + summaryContents projectBacklog calcStoryPoint pj++summaryContents :: (a -> [b]) -> (b -> Point) -> a -> Point+summaryContents f g = foldr (+) 0 . map g . f ++------+-- Get contents by id++getUserStoryById :: Project -> Id -> Maybe UserStory+getUserStoryById pj i = find ((==i).storyId) $ projectsAllStory pj++getTaskById :: Project -> Id -> Maybe Task+getTaskById pj i = find ((==i).taskId) $ projectsAllTasks pj++getSprintById :: Project -> Id -> Maybe Sprint+getSprintById pj i = find ((==i).sprintId) $ projectSprints pj
+ src/Data/TTask/Types/Status.hs view
@@ -0,0 +1,113 @@+module Data.TTask.Types.Status+  ( getLastStatus +  , getStatusTime+  , statusToList+  , stWait +  , stRunning +  , stFinished +  , stNotAchieved +  , stRejected +  , isWait +  , isRunning +  , isFinished +  , isNotAchieved +  , isRejected +  , stRecToContents +  , stRecToStatus +  , getTaskStatuses +  , getStoryStatuses +  , getSprintStatuses +  , getTaskLastStatus +  , getStoryLastStatuses +  , getSprintLastStatuses +  ) where+import Data.Time+import Data.TTask.Types.Types++getLastStatus :: TStatus -> TStatusRecord+getLastStatus (TStatusOne x) = x+getLastStatus (TStatusCons x _) = x++getStatusTime :: TStatusRecord -> LocalTime+getStatusTime (StatusWait t) = t+getStatusTime (StatusRunning t) = t+getStatusTime (StatusFinished t) = t+getStatusTime (StatusNotAchieved t) = t+getStatusTime (StatusReject t) = t++statusToList :: TStatus -> [TStatusRecord]+statusToList (TStatusOne x) = [x]+statusToList (TStatusCons x xs) = x : statusToList xs++----++stWait :: TStatusRecord -> Bool+stWait (StatusWait _) = True+stWait _ = False++stRunning :: TStatusRecord -> Bool+stRunning (StatusRunning _) = True+stRunning _ = False++stFinished :: TStatusRecord -> Bool+stFinished (StatusFinished _) = True+stFinished _ = False++stNotAchieved :: TStatusRecord -> Bool+stNotAchieved (StatusNotAchieved _) = True+stNotAchieved _ = False++stRejected :: TStatusRecord -> Bool+stRejected (StatusReject _) = True+stRejected _ = False++isWait :: TStatus -> Bool+isWait = stWait . getLastStatus ++isRunning :: TStatus -> Bool+isRunning = stRunning . getLastStatus++isFinished :: TStatus -> Bool+isFinished = stFinished . getLastStatus++isNotAchieved :: TStatus -> Bool+isNotAchieved = stNotAchieved . getLastStatus++isRejected :: TStatus -> Bool+isRejected = stRejected . getLastStatus++----++stRecToContents :: StatusLogRec -> TTaskContents+stRecToContents = fst++stRecToStatus :: StatusLogRec -> TStatusRecord+stRecToStatus = snd++----++getTaskStatuses :: Task -> [StatusLogRec]+getTaskStatuses t = map (\x -> (TTaskTask t, x)) . statusToList $ taskStatus t++getStoryStatuses :: UserStory -> [StatusLogRec]+getStoryStatuses u = +  let uStatus = map (\x -> (TTaskStory u, x)) . statusToList $ storyStatus u+  in uStatus ++ concatMap getTaskStatuses (storyTasks u)+  +getSprintStatuses :: Sprint -> [StatusLogRec]+getSprintStatuses s = +  let sStatus = map (\x -> (TTaskSprint s, x)) . statusToList $ sprintStatus s+  in sStatus ++ concatMap getStoryStatuses (sprintStorys s)++getTaskLastStatus :: Task -> StatusLogRec+getTaskLastStatus t = (\x -> (TTaskTask t, x)) . getLastStatus $ taskStatus t++getStoryLastStatuses :: UserStory -> [StatusLogRec]+getStoryLastStatuses u = +  let uStatus = (\x -> (TTaskStory u, x)) . getLastStatus $ storyStatus u+  in uStatus : map getTaskLastStatus (storyTasks u)++getSprintLastStatuses :: Sprint -> [StatusLogRec]+getSprintLastStatuses s = +  let sStatus = (\x -> (TTaskSprint s, x)) . getLastStatus $ sprintStatus s+  in sStatus : concatMap getStoryLastStatuses (sprintStorys s)
+ src/Data/TTask/Types/Types.hs view
@@ -0,0 +1,63 @@+module Data.TTask.Types.Types+  ( Point(..)+  , Id(..)+  , StatusLogRec+  , WorkTime(..)   +  , TStatusRecord(..) +  , TStatus(..) +  , Task(..) +  , UserStory(..) +  , Sprint(..) +  , Project(..) +  , TTaskContents(..)+  ) where+import Data.Time++type Point = Int+type Id = Int+type StatusLogRec = (TTaskContents, TStatusRecord)++newtype WorkTime = WorkTime Double deriving (Show, Read, Eq)+data TStatusRecord +  = StatusWait LocalTime +  | StatusRunning LocalTime +  | StatusFinished LocalTime +  | StatusNotAchieved LocalTime +  | StatusReject LocalTime +  deriving (Show, Read, Eq)+data TStatus +  = TStatusCons TStatusRecord TStatus +  | TStatusOne TStatusRecord +  deriving (Show, Read, Eq)++data Task = Task +  { taskId :: Id+  , taskDescription :: String+  , taskPoint :: Int+  , taskStatus :: TStatus+  , taskWorkTimes :: [WorkTime]+  } deriving (Show, Read, Eq)+data UserStory = UserStory +  { storyId :: Id+  , storyDescription :: String+  , storyTasks :: [Task]+  , storyStatus :: TStatus+  } deriving (Show, Read, Eq)+data Sprint = Sprint +  { sprintId :: Id+  , sprintDescription :: String+  , sprintStorys :: [UserStory]+  , sprintStatus :: TStatus+  } deriving (Show, Read, Eq)+data Project = Project+  { projectName :: String+  , projectBacklog :: [UserStory]+  , projectSprints :: [Sprint]+  , projectStatus :: TStatus+  } deriving (Show, Read, Eq)++data TTaskContents+  = TTaskProject Project+  | TTaskSprint Sprint+  | TTaskStory UserStory+  | TTaskTask Task
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"
+ ttask.cabal view
@@ -0,0 +1,62 @@+name:                ttask+version:             0.0.0.2+synopsis:            This is task management tool for yourself, that inspired by scrum.+description:         Please see README.md (ja)+homepage:            https://github.com/tokiwoousaka/ttask#readme+license:             BSD3+license-file:        LICENSE+author:              Tokiwo Ousaka+maintainer:          its.out.of.tune.this.my.music@gmail.com+copyright:           2016 Tokiwo Ousaka+category:            Data+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Data.TTask+                     , Data.TTask.Command+                     , Data.TTask.Command.Add+                     , Data.TTask.Command.Update+                     , Data.TTask.Command.Move+                     , Data.TTask.Command.Delete+                     , Data.TTask.Types+                     , Data.TTask.Types.Types+                     , Data.TTask.Types.Contents+                     , Data.TTask.Types.Status+                     , Data.TTask.Pretty+                     , Data.TTask.Pretty.Contents+                     , Data.TTask.Pretty.Status+                     , Data.TTask.File+                     , Data.TTask.Analysis+  build-depends:       base >= 4.7 && < 5+                     , time+                     , extra+                     , safe+                     , directory+  default-language:    Haskell2010++executable ttask+  hs-source-dirs:      app+  main-is:             Main.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base+                     , time+                     , ttask+                     , optparse-declarative+                     , transformers+  default-language:    Haskell2010++test-suite ttask-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , ttask+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/githubuser/ttask