ttask 0.0.0.2 → 0.0.1.0

raw patch · 20 files changed

+746/−484 lines, 20 filesdep +eitherdep +filepathdep +lensPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: either, filepath, lens, strict

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• src/Data/TTask/Analysis.hs +4/−7
• src/Data/TTask/Command/Add.hs +33/−32
• src/Data/TTask/Command/Delete.hs +8/−8
• src/Data/TTask/Command/Move.hs +20/−19
• src/Data/TTask/Command/Update.hs +5/−49
• src/Data/TTask/File.hs +3/−105
• src/Data/TTask/File/Compatibility.hs +42/−0
• src/Data/TTask/File/Compatibility/V0_0_1_0.hs +84/−0
• src/Data/TTask/File/File.hs +123/−0
• src/Data/TTask/Pretty/Contents.hs +27/−26
• src/Data/TTask/Pretty/Status.hs +17/−16
• src/Data/TTask/Types.hs +4/−4
• src/Data/TTask/Types/Class.hs +91/−0
• src/Data/TTask/Types/Contents.hs +0/−81
• src/Data/TTask/Types/Lens.hs +179/−0
• src/Data/TTask/Types/Part.hs +47/−0
• src/Data/TTask/Types/Status.hs +0/−113
• src/Data/TTask/Types/Types.hs +45/−17
• ttask.cabal +13/−6

@@ -1,4 +1,4 @@-Copyright Author name here (c) 2016+Copyright Author Tokiwo Ousaka (c) 2016  All rights reserved. 

@@ -3,6 +3,7 @@   , dailyGroup   , summaryPointBy    ) where+import Control.Lens import Data.List import Data.Maybe import Data.Time@@ -34,7 +35,7 @@   where     isFinishedTask :: StatusLogRec -> Bool     isFinishedTask r -      = (stFinished $ stRecToStatus r) && (isTask $ stRecToContents r)+      = r^.getLogStatus.isFinished && r^.getLogContents.isTask  dailyGrouping :: [StatusLogRec] -> [[StatusLogRec]] dailyGrouping = groupBy (\l r -> getDay l == getDay r) . sortRecord@@ -51,13 +52,9 @@ getDay = localDay . getTime  getTime :: StatusLogRec -> LocalTime-getTime = getStatusTime . stRecToStatus+getTime = (^.getLogStatus.getStatusTime)  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 +getPoint = (^.getLogContents.point)  

@@ -14,6 +14,7 @@   , projectStoryMaxId    , projectSprintMaxId    ) where+import Control.Lens (over, (^.)) import Data.Time import Data.List.Extra import Data.Maybe@@ -27,41 +28,41 @@ newProject name = do   lt <- getLocalTime   return $ Project-    { projectName = name-    , projectBacklog = []-    , projectSprints = []-    , projectStatus = TStatusOne $ StatusWait lt+    { _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+    { _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 = []+    { _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+    { _sprintId = id+    , _sprintDescription = description+    , _sprintStorys = []+    , _sprintStatus = TStatusOne $ StatusWait lt     }  ------@@ -71,7 +72,7 @@ addNewStoryToPbl description pj = do   let nid = projectStoryMaxId pj + 1   us <- newStory description nid-  return $ pj { projectBacklog = snoc (projectBacklog pj) us }+  return . over projectBacklog (flip snoc us) $ pj  addNewStoryToSprints :: Id -> String -> Project -> IO Project addNewStoryToSprints spid description pj = do@@ -95,60 +96,60 @@ -- Add existing contents   addSprintToProject :: Sprint -> Project -> Project-addSprintToProject sp pj  = pj { projectSprints = snoc (projectSprints pj) sp }+addSprintToProject sp pj  = pj { _projectSprints = snoc (_projectSprints pj) sp }  addStoryToPbl :: UserStory -> Project -> Project-addStoryToPbl us pj = pj { projectBacklog = snoc (projectBacklog pj) us }+addStoryToPbl us pj = pj { _projectBacklog = snoc (_projectBacklog pj) us }  addStoryToPblFirst :: UserStory -> Project -> Project-addStoryToPblFirst us pj = pj { projectBacklog = us : projectBacklog pj }+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 }+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+      { _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+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  }+  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+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+projectsTaskMaxIdMay = maximumMay . map _taskId . (^.allTasks)  projectsTaskMaxId :: Project -> Id projectsTaskMaxId = fromMaybe 0 . projectsTaskMaxIdMay  projectStoryMaxIdMay :: Project -> Maybe Id-projectStoryMaxIdMay = maximumMay . map storyId . projectsAllStory+projectStoryMaxIdMay = maximumMay . map _storyId . (^.allStory)  projectStoryMaxId :: Project -> Id projectStoryMaxId = fromMaybe 0 . projectStoryMaxIdMay  projectSprintMaxIdMay :: Project -> Maybe Id-projectSprintMaxIdMay = maximumMay . map sprintId . projectSprints+projectSprintMaxIdMay = maximumMay . map _sprintId . _projectSprints  projectSprintMaxId :: Project -> Id projectSprintMaxId = fromMaybe 0 . projectSprintMaxIdMay

@@ -7,32 +7,32 @@  deleteTask :: Id -> Project -> Project deleteTask i pj = pj-  { projectBacklog  = map (deleteTaskFromStory i) $ projectBacklog pj -  , projectSprints = map (deleteTaskFromSprint i) $ projectSprints 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 +  { _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 }+  = 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 }+  = s { _storyTasks = filter (\t -> _taskId t /= i) $ _storyTasks s }  deleteTaskFromSprint :: Id -> Sprint -> Sprint deleteTaskFromSprint i s -  = s { sprintStorys = map (deleteTaskFromStory i) $ sprintStorys s }+  = s { _sprintStorys = map (deleteTaskFromStory i) $ _sprintStorys s }  deleteStoryFromSprint :: Id -> Sprint -> Sprint deleteStoryFromSprint i s -  = s { sprintStorys = filter (\u -> storyId u /= i) $ sprintStorys s }+  = s { _sprintStorys = filter (\u -> _storyId u /= i) $ _sprintStorys s }  

@@ -8,6 +8,7 @@   , swapTask    ) where import Control.Applicative+import Control.Lens import Control.Monad import Data.Maybe import Data.TTask.Types@@ -19,19 +20,19 @@  moveStoryToPbl :: Id -> Project -> Maybe Project moveStoryToPbl uid pj = do-  us <- getUserStoryById pj uid+  us <- pj^?story 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+  us <- pj^?story uid+  _ <- pj^?sprint 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+  task <- pj^?task tid+  _ <- pj^?story uid   return . addTaskToProject uid task . deleteTask tid $ pj  ------@@ -39,41 +40,41 @@  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 }+  let (f2t, t2f) = swapFuncs pj _sprintId (\p i -> p^?sprint i) 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+  let (f2t, t2f) = swapFuncs pj _storyId (\p i -> p^?story i) fid tid   in pj-    { projectBacklog = swapBy f2t t2f $ projectBacklog pj-    , projectSprints = map (swapSprintsStory fid tid pj) $ projectSprints 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+  let (f2t, t2f) = swapFuncs pj _taskId (\p i -> p^?task i) fid tid   in pj-    { projectBacklog = map (swapStorysTask fid tid pj) $ projectBacklog pj-    , projectSprints = map (swapSprintsTask fid tid pj) $ projectSprints 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 }+  let (f2t, t2f) = swapFuncs pj _taskId (\p i -> p^?task i) 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 } +  let (f2t, t2f) = swapFuncs pj _taskId (\p i -> p^?task i) 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 }+  let (f2t, t2f) = swapFuncs pj _storyId (\p i -> p^?story i) 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)

@@ -2,66 +2,22 @@   ( updateTaskStatus    , updateStoryStatus    , updateSprintStatus -  , updateTask -  , updateStory -  , updateSprint    )  where+import Control.Lens 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+updateTaskStatus i r pj +  = pj&task i%~ (\t -> t { _taskStatus = r `TStatusCons` _taskStatus t })  updateStoryStatus :: Id -> TStatusRecord -> Project -> Project updateStoryStatus i r pj  -  = updateStory i (\s -> s { storyStatus = r `TStatusCons` storyStatus s }) pj+  = pj&story i%~ (\s -> s { _storyStatus = r `TStatusCons` _storyStatus s })  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+  = pj&sprint i%~ (\s -> s { _sprintStatus = r `TStatusCons` _sprintStatus s }) 

@@ -1,106 +1,4 @@-module Data.TTask.File -  ( Success(..)-  , readActiveProject-  , writeActiveProject-  , activeProjectName-  , setActiveProject-  , initDirectory -  , initProjectFile -  , findProjects +module Data.TTask.File+  ( module Data.TTask.File.File   ) 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-+import Data.TTask.File.File

@@ -0,0 +1,42 @@+module Data.TTask.File.Compatibility +  ( resolution +  ) where+import Control.Monad.Trans.Either+import Control.Monad.IO.Class+import Data.TTask.Types.Types +import qualified Data.TTask.File.Compatibility.V0_0_1_0 as V0_0_1_0++resolution' :: String -> TryConvert ()+resolution' s = do+  liftIO $ putStrLn "That is not latest ttask project file."+  tryRead "0.0.1.0" s $ V0_0_1_0.readProject+  liftIO $ putStrLn "... convert failure"++tryRead :: String -> String -> (String -> Maybe Project) -> TryConvert ()+tryRead v s f = tryFromMaybe (successMsg v) $ f s++--------++type TryConvert a = EitherT Project IO a++runConvert :: TryConvert a -> IO (Either Project a)+runConvert = runEitherT++--------++resolution :: String -> IO (Maybe Project)+resolution s = do+  e <- runConvert $ resolution' s+  case e of+    Right () -> return Nothing+    Left pj -> return $ Just pj+  +tryFromMaybe :: String -> Maybe Project -> TryConvert ()+tryFromMaybe msg (Just x) = do+  liftIO $ putStrLn msg+  left x+tryFromMaybe _ Nothing = return ()++successMsg :: String -> String+successMsg s = concat +  [ "Success convert from old ttask project file (less than ", s, ")" ]

@@ -0,0 +1,84 @@+module Data.TTask.File.Compatibility.V0_0_1_0 +  ( readProject+  ) where+import Data.Functor+import Safe+import Data.Time+import Control.Lens+import qualified Data.TTask.Types.Types as T++data Task = Task +  { taskId :: T.Id+  , taskDescription :: String+  , taskPoint :: Int+  , taskStatus :: T.TStatus+  , taskWorkTimes :: [T.WorkTime]+  } deriving (Show, Read, Eq)+data UserStory = UserStory +  { storyId :: T.Id+  , storyDescription :: String+  , storyTasks :: [Task]+  , storyStatus :: T.TStatus+  } deriving (Show, Read, Eq)+data Sprint = Sprint +  { sprintId :: T.Id+  , sprintDescription :: String+  , sprintStorys :: [UserStory]+  , sprintStatus :: T.TStatus+  } deriving (Show, Read, Eq)+data Project = Project+  { projectName :: String+  , projectBacklog :: [UserStory]+  , projectSprints :: [Sprint]+  , projectStatus :: T.TStatus+  } deriving (Show, Read, Eq)++data TTaskContents+  = TTaskProject Project+  | TTaskSprint Sprint+  | TTaskStory UserStory+  | TTaskTask Task++-------++readProject :: String -> Maybe T.Project+readProject = (convert <$>) . readOldProject ++readOldProject :: String -> Maybe Project+readOldProject s = readMay s++convert :: Project -> T.Project+convert p = T.Project+  { T._projectName = projectName p+  , T._projectBacklog = map convertStory $ projectBacklog p+  , T._projectSprints = map convertSprint $ projectSprints p+  , T._projectStatus = projectStatus p+  } ++-------++convertTask :: Task -> T.Task+convertTask t = T.Task+  { T._taskId = taskId t+  , T._taskDescription = taskDescription t+  , T._taskPoint = taskPoint t+  , T._taskStatus = taskStatus t+  , T._taskWorkTimes = taskWorkTimes t+  }++convertStory :: UserStory -> T.UserStory+convertStory u = T.UserStory+  { T._storyId = storyId u+  , T._storyDescription = storyDescription u+  , T._storyTasks = map convertTask $ storyTasks u+  , T._storyStatus = storyStatus u+  } ++convertSprint :: Sprint -> T.Sprint+convertSprint s = T.Sprint+  { T._sprintId = sprintId s+  , T._sprintDescription = sprintDescription s+  , T._sprintStorys = map convertStory $ sprintStorys s+  , T._sprintStatus = sprintStatus s+  } +

@@ -0,0 +1,123 @@+module Data.TTask.File.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 qualified Data.TTask.File.Compatibility as C+import Safe+import qualified System.IO.Strict as S+import System.Directory+import System.FilePath++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 <- S.readFile fn+  return $ readMay d++readActiveProject :: IO (Maybe Project)+readActiveProject = do+  dir <- projectsDirectory+  mfn <- activeProjectName +  mpj <- readProject . (dir </>) >$< mfn+  case mpj of+    Just _ -> return mpj+    Nothing -> do+      s <- fmap return . S.readFile . (dir </>) >$< mfn+      C.resolution >$< s++writeActiveProject :: Project -> IO Success+writeActiveProject pj = do+  dir <- 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 = do+  workDir <- workDirectory+  return $ workDir </> "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++----+-- util++infixl 8 >$<+(>$<) :: (Monad m, Monad t, Traversable t) => (a -> m (t b)) -> t a -> m (t b)+f >$< x = join <$> sequence (f <$> x)+

@@ -15,85 +15,86 @@   , ppStatusRecord   ) where import Control.Applicative+import Control.Lens import Data.TTask.Types import Data.List  ppActive :: String -> Project -> String  ppActive pid pj = let     activeSprints :: Project -> [Sprint]-    activeSprints = filter (isRunning . sprintStatus) . projectSprints+    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 ""+    , 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)+ppTask t = formatRecord "TASK" +  (t^.taskId) (t^.taskPoint) +  (t^.taskStatus) (t^.taskDescription)  ppStoryHeader :: UserStory -> String-ppStoryHeader story = formatRecord "STORY" -  (storyId story) (calcStoryPoint story) -  (storyStatus story) (storyDescription story)+ppStoryHeader s = formatRecord "STORY" +  (s^.storyId) (s^.point) +  (s^.storyStatus) (s^.storyDescription)  ppStory :: UserStory -> String ppStory story = ppStoryI 1 story  ppStoryI :: Int -> UserStory -> String-ppStoryI r story = formatFamily r story ppStoryHeader storyTasks ppTask+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)+ppSprintHeader s = formatRecord "SPRINT" +  (s^.sprintId) (s^.point) +  (s^.sprintStatus) (s^.sprintDescription)  ppSprint :: Sprint -> String-ppSprint sprint = formatFamily 1 sprint ppSprintHeader sprintStorys ppStoryHeader+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)+  formatRecordShowedId "PROJECT" pid (pj^.point) (pj^.projectStatus) (pj^.projectName)  ----  ppSprintDetail :: Sprint -> String ppSprintDetail s -    = formatFamily 1 s ppSprintHeaderDetail sprintStorys $ \s -> ppStoryI 2 s+    = formatFamily 1 s ppSprintHeaderDetail _sprintStorys $ \s -> ppStoryI 2 s  ppSprintHeaderDetail :: Sprint -> String-ppSprintHeaderDetail s = ppSprintHeader s ++ "\n" ++ ppStatus (sprintStatus s)+ppSprintHeaderDetail s = ppSprintHeader s ++ "\n" ++ ppStatus (_sprintStatus s)  ----  ppProjectPbl :: Project -> String-ppProjectPbl = ppStoryList . projectBacklog+ppProjectPbl = ppStoryList . _projectBacklog  ppProjectSprintList :: Project -> String-ppProjectSprintList = ppSprintList . projectSprints+ppProjectSprintList = ppSprintList . _projectSprints -ppProjectSprint :: Id -> Project -> Maybe String-ppProjectSprint i pj = ppSprint <$> getSprintById pj i+ppProjectSprint :: Id -> Project -> Maybe String +ppProjectSprint i pj = ppSprint <$> pj^?sprint i  ppProjectSprintDetail :: Id -> Project -> Maybe String-ppProjectSprintDetail i pj = ppSprintDetail <$> getSprintById pj i+ppProjectSprintDetail i pj = ppSprintDetail <$> pj^?sprint i  ppProjectStory :: Id -> Project -> Maybe String-ppProjectStory i pj = ppStory <$> getUserStoryById pj i+ppProjectStory i pj = ppStory <$> pj^?story i  ppProjectTask :: Id -> Project -> Maybe String-ppProjectTask i pj = ppTask <$> getTaskById pj i+ppProjectTask i pj = ppTask <$> pj^?task i  ---- @@ -104,7 +105,7 @@ formatRecordShowedId :: String -> String -> Point -> TStatus -> String -> String formatRecordShowedId htype i point st description = concat   [ htype ++ " - " , i , " : " , show $ point -  , "pt [ " , ppStatusRecord . getLastStatus $ st , " ] " , description+  , "pt [ " , ppStatusRecord $ st^.getLastStatus , " ] " , description   ]  formatFamily :: Eq b => Int -> a -> (a -> String) -> (a -> [b]) -> (b -> String) -> String@@ -122,10 +123,10 @@ ppStatusRecord (StatusReject _) = "Reject"  ppStatus :: TStatus -> String-ppStatus s = intercalate "\n" . map pps . reverse $ statusToList s+ppStatus s = intercalate "\n" . map pps . reverse $ s^.statusToList   where     pps :: TStatusRecord -> String     pps r =        let st = take 15 $ ppStatusRecord r ++ concat (replicate 16 " ")-      in "To " ++ st ++ " at " ++ show (getStatusTime r)+      in "To " ++ st ++ " at " ++ show (r^.getStatusTime)   

@@ -2,6 +2,7 @@   ( ppProjectSprintLog    ) where import Control.Applicative+import Control.Lens import Data.List import Data.Time import Data.TTask.Types@@ -9,24 +10,24 @@ import Data.TTask.Pretty.Contents  ppProjectSprintLog :: Id -> Project -> Maybe String-ppProjectSprintLog i pj = ppDailySprintLog <$> getSprintById pj i+ppProjectSprintLog i pj = ppDailySprintLog <$> pj^?sprint i  ppDailySprintLog :: Sprint -> String ppDailySprintLog s =    let -    sx = getSprintLastStatuses s-    cond f r = (f $ stRecToStatus r) && (isTask $ stRecToContents r)+    sx = s^.lastStatuses+    cond f r = (r^.getLogStatus.f) && (r^.getLogContents.isTask)     summary f = show (summaryPointBy (cond f) sx)   in concat       [ ppSprintHeaderDetail s       , "\n\n" -      , intercalate "\n" . map ppDailyStatuses . dailyGroup $ getSprintStatuses s+      , intercalate "\n" . map ppDailyStatuses . dailyGroup $ s^.statuses       , "\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"+      , "Wait : " ++ summary isWait ++ "pt\n"+      , "Running : " ++ summary isRunning ++ "pt\n"+      , "Finished : " ++ summary isFinished ++ "pt\n"+      , "Not Achieved : " ++ summary isNotAchieved ++ "pt\n"+      , "Rejected : " ++ summary isRejected ++ "pt"       ]  ----@@ -38,15 +39,15 @@   ]  ppStatusLog :: StatusLogRec -> String-ppStatusLog s = case stRecToContents s of+ppStatusLog s = case s^.getLogContents of   TTaskProject v -> -    fmtStatusRec "PROJECT" 0 (calcProjectPoint v) s (projectName v)+    fmtStatusRec "PROJECT" 0 (v^.point) s (_projectName v)   TTaskSprint  v -> -    fmtStatusRec "SPRINT" (sprintId v) (calcSprintPoint v) s (sprintDescription v)+    fmtStatusRec "SPRINT" (v^.sprintId) (v^.point) s (_sprintDescription v)   TTaskStory   v -> -    fmtStatusRec "STORY" (storyId v) (calcStoryPoint v) s (storyDescription v)+    fmtStatusRec "STORY" (v^.storyId) (v^.point) s (_storyDescription v)   TTaskTask    v -> -    fmtStatusRec "TASK" (taskId v) (taskPoint v) s (taskDescription v)+    fmtStatusRec "TASK" (v^.taskId) (v^.point) s (_taskDescription v)  fmtStatusRec    :: String -> Id -> Point -> StatusLogRec -> String -> String@@ -55,6 +56,6 @@     where       stAndLt :: String       stAndLt = concat -        [ ppStatusRecord (stRecToStatus r)-        , " at ", show . localTimeOfDay . getStatusTime $ stRecToStatus r+        [ ppStatusRecord (r^.getLogStatus)+        , " at ", show . localTimeOfDay $ r^.getLogStatus.getStatusTime         ]

@@ -1,8 +1,8 @@ module Data.TTask.Types   ( module Data.TTask.Types.Types-  , module Data.TTask.Types.Contents-  , module Data.TTask.Types.Status+  , module Data.TTask.Types.Lens+  , module Data.TTask.Types.Class   )  where import Data.TTask.Types.Types-import Data.TTask.Types.Contents-import Data.TTask.Types.Status+import Data.TTask.Types.Lens+import Data.TTask.Types.Class

@@ -0,0 +1,91 @@+module Data.TTask.Types.Class+  ( HasPoint(..)+  , HasTask(..)+  , HasStatuses(..)+  , IsStatus(..)+  ) where+import Control.Lens+import Data.TTask.Types.Types+import Data.TTask.Types.Part++------------+-- Point++class HasPoint p where+  calcPoint :: p -> Point+instance HasPoint Task where+  calcPoint = _taskPoint+instance HasPoint UserStory where+  calcPoint = summaryContents _storyTasks _taskPoint+instance HasPoint Sprint where+  calcPoint = summaryContents _sprintStorys calcPoint+instance HasPoint Project where+  calcPoint pj+    = summaryContents _projectSprints calcPoint pj +    + summaryContents _projectBacklog calcPoint pj+instance HasPoint TTaskContents where+  calcPoint (TTaskProject v) = calcPoint v+  calcPoint (TTaskSprint v) = calcPoint v+  calcPoint (TTaskStory v) = calcPoint v+  calcPoint (TTaskTask v) = calcPoint v++summaryContents :: (a -> [b]) -> (b -> Point) -> a -> Point+summaryContents f g = foldr (+) 0 . map g . f ++---------+-- Task++class HasTask t where+  getTask :: t -> [Task]+instance HasTask UserStory where+  getTask = _storyTasks+instance HasTask Sprint where+  getTask = concatMap _storyTasks . _sprintStorys+instance HasTask Project where+  getTask p = concat +    [ concatMap getTask $ _projectSprints p +    , concatMap _storyTasks $ _projectBacklog p +    ]++---------+-- Statuses++class HasStatuses s where+  getStatuses :: s -> [StatusLogRec]+  getLastStatuses :: s -> [StatusLogRec]+instance HasStatuses Task where+  getStatuses t = map (\x -> (TTaskTask t, x)) . statusToList' $ _taskStatus t+  getLastStatuses t = (:[]) . (\x -> (TTaskTask t, x)) . getLastStatus' $ _taskStatus t+instance HasStatuses UserStory where+  getStatuses u = +    let uStatus = map (\x -> (TTaskStory u, x)) . statusToList' $ _storyStatus u+    in uStatus ++ concatMap getStatuses (u^.storyTasks)+  getLastStatuses u = +    let uStatus = (\x -> (TTaskStory u, x)) . getLastStatus' $ _storyStatus u+    in uStatus : concatMap getLastStatuses (u^.storyTasks)+instance HasStatuses Sprint where+  getStatuses s = +    let sStatus = map (\x -> (TTaskSprint s, x)) . statusToList' $ _sprintStatus s+    in sStatus ++ concatMap getStatuses (s^.sprintStorys)+  getLastStatuses s =+    let sStatus = (\x -> (TTaskSprint s, x)) . getLastStatus' $ _sprintStatus s+    in sStatus : concatMap getLastStatuses (s^.sprintStorys)++class IsStatus s where+  status2Wait :: s -> Bool+  status2Running :: s -> Bool+  status2Finished :: s -> Bool+  status2NotAchieved :: s -> Bool+  status2Rejected :: s -> Bool+instance IsStatus TStatusRecord  where+  status2Wait = stWait+  status2Running = stRunning+  status2Finished = stFinished+  status2NotAchieved = stNotAchieved+  status2Rejected = stRejected+instance IsStatus TStatus where+  status2Wait = stWait . getLastStatus'+  status2Running = stRunning . getLastStatus'+  status2Finished = stFinished . getLastStatus'+  status2NotAchieved = stNotAchieved . getLastStatus'+  status2Rejected = stRejected . getLastStatus'

@@ -1,81 +0,0 @@-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 

@@ -0,0 +1,179 @@+{-# LANGUAGE RankNTypes #-} +module Data.TTask.Types.Lens+  ( LensPrism+  , LensPrism'+  , task +  , story +  , sprint +  , taskInSprint +  , storyInSprint +  , taskInStroy +  , allTasks +  , allStory+  , point +  , statuses +  , lastStatuses +  , getLastStatus+  , statusToList+  , isWait +  , isRunning +  , isFinished +  , isNotAchieved +  , isRejected +  , getStatusTime +  , getLogContents +  , getLogStatus +  , isProject +  , isSprint +  , isStory +  , isTask +  -----+  , bundle+  , finding+  ) where+import Data.List+import Data.Maybe+import Data.Time+import Control.Lens+import Data.TTask.Types.Types+import Data.TTask.Types.Class+import Data.TTask.Types.Part++type LensPrism s t a b = forall f.(Functor f, Applicative f) => Optic (->) f s t a b+type LensPrism' s a = LensPrism s s a a++task :: Id -> LensPrism' Project Task+task i = +  (projectSprints.finding (sprintHasThatTask i)._Just.taskInSprint i)+  `bundle`+  (projectBacklog.finding (storyHasThatTask i)._Just.taskInStroy i)++story :: Id -> LensPrism' Project UserStory+story i = +  (projectSprints.finding (sprintHasThatStory i)._Just.storyInSprint i)+  `bundle`+  (projectBacklog.finding ( (==i)._storyId)._Just)++sprint :: Id -> LensPrism' Project Sprint+sprint i = projectSprints.finding ( (==i)._sprintId )._Just++-----++taskInSprint :: Id -> LensPrism' Sprint Task+taskInSprint i = sprintStorys.finding (storyHasThatTask i)._Just.taskInStroy i++storyInSprint :: Id -> LensPrism' Sprint UserStory+storyInSprint i = sprintStorys.finding ( (==i)._storyId )._Just++taskInStroy :: Id -> LensPrism' UserStory Task+taskInStroy i = storyTasks.finding ( (==i)._taskId )._Just++-----++allTasks :: HasTask t => Getter t [Task]+allTasks = to getTask ++allStory :: Getter Project [UserStory]+allStory = to projectsAllStory++point :: HasPoint p => Getter p Point+point = to calcPoint++statuses :: HasStatuses s => Getter s [StatusLogRec]+statuses = to getStatuses ++lastStatuses :: HasStatuses s => Getter s [StatusLogRec]+lastStatuses = to getLastStatuses ++getLastStatus :: Getter TStatus TStatusRecord+getLastStatus = to getLastStatus'++statusToList :: Getter TStatus [TStatusRecord]+statusToList = to statusToList'++-----++isWait :: IsStatus s => Getter s Bool+isWait = to $ status2Wait++isRunning :: IsStatus s => Getter s Bool+isRunning = to $ status2Running++isFinished :: IsStatus s => Getter s Bool+isFinished = to $ status2Finished++isNotAchieved :: IsStatus s => Getter s Bool+isNotAchieved = to $ status2NotAchieved++isRejected :: IsStatus s => Getter s Bool+isRejected = to $ status2Rejected++getStatusTime :: Getter TStatusRecord LocalTime+getStatusTime = to f+  where+    f (StatusWait t) = t+    f (StatusRunning t) = t+    f (StatusFinished t) = t+    f (StatusNotAchieved t) = t+    f (StatusReject t) = t++-----++getLogContents :: Lens' StatusLogRec TTaskContents+getLogContents = _1++getLogStatus :: Lens' StatusLogRec TStatusRecord+getLogStatus = _2++-----++isProject :: Getter TTaskContents Bool+isProject = to f+  where +    f (TTaskProject _) = True+    f _ = False++isSprint :: Getter TTaskContents Bool+isSprint = to f+  where+    f (TTaskSprint _) = True+    f _ = False++isStory :: Getter TTaskContents Bool+isStory = to f+  where+    f (TTaskStory _) = True+    f _ = False++isTask :: Getter TTaskContents Bool+isTask = to f+  where+    f (TTaskTask _) = True+    f _ = False++------+-- util++bundle :: LensPrism' a b -> LensPrism' a b -> LensPrism' a b+bundle l r f s = if isJust $ s^?l then l f s else r f s++finding :: (a -> Bool) -> Lens' [a] (Maybe a)+finding f = lens (find f) $ setToList f+  where+    setToList :: (a -> Bool) -> [a] -> (Maybe a) -> [a]+    setToList _ xs Nothing = xs+    setToList _ [] (Just y) = []+    setToList f (x:xs) m@(Just y) =+      if f x then y : xs else x : setToList f xs m++------+-- part++sprintHasThatStory :: Id -> Sprint -> Bool+sprintHasThatStory i s = isJust $ s^?storyInSprint i++sprintHasThatTask :: Id -> Sprint -> Bool+sprintHasThatTask i s = isJust $ s^?taskInSprint i++storyHasThatTask :: Id -> UserStory -> Bool+storyHasThatTask i s = isJust $ s^?taskInStroy i 

@@ -0,0 +1,47 @@+module Data.TTask.Types.Part+  ( projectsAllStory +  , stWait +  , stRunning +  , stFinished +  , stNotAchieved +  , stRejected +  , getLastStatus' +  , statusToList'+  ) where +import Control.Lens+import Data.Maybe+import Data.TTask.Types.Types++projectsAllStory :: Project -> [UserStory]+projectsAllStory p = concat +  [ concatMap _sprintStorys $ _projectSprints p , _projectBacklog $ p ]++----++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++getLastStatus' :: TStatus -> TStatusRecord+getLastStatus' (TStatusOne x) = x+getLastStatus' (TStatusCons x _) = x++statusToList' :: TStatus -> [TStatusRecord]+statusToList' (TStatusOne x) = [x]+statusToList' (TStatusCons x xs) = x : statusToList' xs

@@ -1,113 +0,0 @@-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)

@@ -1,3 +1,5 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-} module Data.TTask.Types.Types   ( Point(..)   , Id(..)@@ -10,8 +12,28 @@   , Sprint(..)    , Project(..)    , TTaskContents(..)+  -- Lens accessers+  , taskId +  , taskDescription +  , taskPoint +  , taskStatus +  , taskWorkTimes +  , storyId +  , storyDescription +  , storyTasks +  , storyStatus +  , sprintId +  , sprintDescription +  , sprintStorys +  , sprintStatus +  , projectName +  , projectBacklog +  , projectSprints+  , projectStatus   ) where import Data.Time+import Data.List+import Control.Lens  type Point = Int type Id = Int@@ -31,29 +53,29 @@   deriving (Show, Read, Eq)  data Task = Task -  { taskId :: Id-  , taskDescription :: String-  , taskPoint :: Int-  , taskStatus :: TStatus-  , taskWorkTimes :: [WorkTime]+  { _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+  { _storyId :: Id+  , _storyDescription :: String+  , _storyTasks :: [Task]+  , _storyStatus :: TStatus   } deriving (Show, Read, Eq) data Sprint = Sprint -  { sprintId :: Id-  , sprintDescription :: String-  , sprintStorys :: [UserStory]-  , sprintStatus :: TStatus+  { _sprintId :: Id+  , _sprintDescription :: String+  , _sprintStorys :: [UserStory]+  , _sprintStatus :: TStatus   } deriving (Show, Read, Eq) data Project = Project-  { projectName :: String-  , projectBacklog :: [UserStory]-  , projectSprints :: [Sprint]-  , projectStatus :: TStatus+  { _projectName :: String+  , _projectBacklog :: [UserStory]+  , _projectSprints :: [Sprint]+  , _projectStatus :: TStatus   } deriving (Show, Read, Eq)  data TTaskContents@@ -61,3 +83,9 @@   | TTaskSprint Sprint   | TTaskStory UserStory   | TTaskTask Task++makeLenses ''Task+makeLenses ''UserStory+makeLenses ''Sprint+makeLenses ''Project+

@@ -1,5 +1,5 @@ name:                ttask-version:             0.0.0.2+version:             0.0.1.0 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@@ -10,7 +10,6 @@ copyright:           2016 Tokiwo Ousaka category:            Data build-type:          Simple--- extra-source-files: cabal-version:       >=1.10  library@@ -23,18 +22,26 @@                      , Data.TTask.Command.Delete                      , Data.TTask.Types                      , Data.TTask.Types.Types-                     , Data.TTask.Types.Contents-                     , Data.TTask.Types.Status-                     , Data.TTask.Pretty+                     , Data.TTask.Types.Lens+                     , Data.TTask.Types.Class+                     , Data.TTask.Types.Part , Data.TTask.Pretty                      , Data.TTask.Pretty.Contents                      , Data.TTask.Pretty.Status                      , Data.TTask.File+                     , Data.TTask.File.File+                     , Data.TTask.File.Compatibility+                     , Data.TTask.File.Compatibility.V0_0_1_0                      , Data.TTask.Analysis   build-depends:       base >= 4.7 && < 5                      , time                      , extra                      , safe                      , directory+                     , filepath+                     , lens+                     , either+                     , transformers+                     , strict   default-language:    Haskell2010  executable ttask@@ -59,4 +66,4 @@  source-repository head   type:     git-  location: https://github.com/githubuser/ttask+  location: https://github.com/tokiwoousaka/ttask