group worktime cmd by ids #11

CHANGELOG.md

@@ -7,6 +7,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ## [Unreleased]
 
+## [0.4.0] - 2020-01-11
+
 ### Added
 
 - Upgrade command [#10]
@@ -17,7 +19,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 - Shorter aliases
 - Show command (UI) [#17]
-- Commands names + aliases
+- `worktime` command (group by ids) [#11]
+- **[BREAKING]** Commands names + aliases
 
 ## [0.3.3] - 2020-01-01
 
@@ -131,7 +134,8 @@ First release :tada:
 
 - Linux binaries
 
-[unreleased]: https://github.com/unfog-io/unfog-cli/compare/v0.3.3...HEAD
+[unreleased]: https://github.com/unfog-io/unfog-cli/compare/v0.4.0...HEAD
+[0.4.0]: https://github.com/unfog-io/unfog-cli/compare/v0.3.3...v0.4.0
 [0.3.3]: https://github.com/unfog-io/unfog-cli/compare/v0.3.2...v0.3.3
 [0.3.2]: https://github.com/unfog-io/unfog-cli/compare/v0.3.1...v0.3.2
 [0.3.1]: https://github.com/unfog-io/unfog-cli/compare/v0.3.0...v0.3.1
@@ -154,6 +158,7 @@ First release :tada:
 [#8]: https://github.com/unfog-io/unfog-cli/issues/8
 [#9]: https://github.com/unfog-io/unfog-cli/issues/9
 [#10]: https://github.com/unfog-io/unfog-cli/issues/10
+[#11]: https://github.com/unfog-io/unfog-cli/issues/11
 [#12]: https://github.com/unfog-io/unfog-cli/issues/12
 [#13]: https://github.com/unfog-io/unfog-cli/issues/13
 [#15]: https://github.com/unfog-io/unfog-cli/issues/15

README.md

@@ -197,7 +197,7 @@ date by `]`. The date range should follow the due time format (see [#create]).
 unfog worktime|w (+tags) ([min:range) (]max:range)
 ```
 
-![image](https://user-images.githubusercontent.com/10437171/71660308-eae61b00-2d4a-11ea-866c-e0bdf19b84be.png)
+![image](https://user-images.githubusercontent.com/10437171/72210877-2c509600-34c2-11ea-8052-37f684ba4e8e.png)
 
 *Note: the `+` is optional.*
 

package.yaml

@@ -1,5 +1,5 @@
 name: unfog
-version: 0.3.3
+version: 0.4.0
 github: "unfog-io/unfog-cli"
 license: BSD3
 author: "Clément DOUIN"

src/DailyWtime.hs

@@ -0,0 +1,11 @@
+module DailyWtime where
+
+import Task
+
+type TasksWithTotalWtime = ([Task], Duration)
+
+data DailyWtime =
+ DailyWtime { _day :: String
+ , _tasks :: TasksWithTotalWtime
+ , _total :: Duration
+ } deriving (Show, Read, Eq)

src/Query.hs

@@ -96,7 +96,7 @@ execute args state events query = do
  "curl -sSL https://raw.githubusercontent.com/unfog-io/unfog-cli/master/install.sh | sh"
  >> return ()
 
- Version -> printVersion rtype "0.3.3"
+ Version -> printVersion rtype "0.4.0"
 
  Help -> do
  putStrLn "Usage: unfog cmd (args)"

src/Response.hs

@@ -74,9 +74,7 @@ instance ToJSON Response where
  toJSON (ResponseWtime wtime) = object
  [ "ok" .= (1 :: Int)
  , "data" .= object
- [ "wtimes" .= map DailyWtimeRecord wtime
- , "total" .= DurationRecord (foldl (\t (_, w) -> t + w) 0 wtime)
- ]
+ ["wtimes" .= map DailyWtimeRecord wtime, "total" .= DurationRecord 0]
  ]
  toJSON (ResponseStatus task) = object
  [ "ok" .= (1 :: Int)

src/Table.hs

@@ -34,7 +34,7 @@ join :: [String] -> String
 join = foldr (++) ""
 
 sep :: String
-sep = renderCell 0 (ext 238 . cell $ "|")
+sep = renderCell 0 (ext 8 . cell $ "|")
 
 cell :: Value -> Cell
 cell val = Cell [] val

src/Task.hs

@@ -20,21 +20,35 @@ type Active = Bool
 type Done = Bool
 type Duration = Micro
 
-data Task =
- Task { _id :: Id
- , _ref :: Ref
- , _pos :: Pos
- , _desc :: Desc
- , _tags :: [Tag]
- , _due :: Maybe Duration
- , _active :: Duration
- , _done :: Done
- , _wtime :: Duration
- , _starts :: [UTCTime]
- , _stops :: [UTCTime]
- } deriving (Show, Read, Eq)
-
-type DailyWtime = (String, Duration)
+data Task = Task { _id :: Id
+ , _ref :: Ref
+ , _pos :: Pos
+ , _desc :: Desc
+ , _tags :: [Tag]
+ , _due :: Maybe Duration
+ , _active :: Duration
+ , _done :: Done
+ , _wtime :: Duration
+ , _starts :: [UTCTime]
+ , _stops :: [UTCTime]
+ } deriving (Show, Read, Eq)
+
+emptyTask :: Task
+emptyTask = Task { _id = 0
+ , _ref = 0
+ , _pos = -1
+ , _desc = ""
+ , _tags = []
+ , _due = Nothing
+ , _active = 0
+ , _done = False
+ , _wtime = 0
+ , _starts = []
+ , _stops = []
+ }
+
+data WtimeTask = WtimeTask Ref Desc Duration deriving (Show, Read, Eq)
+type DailyWtime = (String, [WtimeTask])
 newtype DailyWtimeRecord = DailyWtimeRecord {toDailyWtimeRecord :: DailyWtime}
 newtype DailyWtimeTotalRecord = DailyWtimeTotalRecord {toDailyWtimeTotalRecord :: Duration}
 
@@ -68,22 +82,8 @@ instance ToJSON Task where
  ]
 
 instance ToJSON DailyWtimeRecord where
- toJSON (DailyWtimeRecord (date, wtime)) =
- object ["date" .= date, "wtime" .= DurationRecord wtime]
-
-emptyTask :: Task
-emptyTask = Task { _id = 0
- , _ref = 0
- , _pos = -1
- , _desc = ""
- , _tags = []
- , _due = Nothing
- , _active = 0
- , _done = False
- , _wtime = 0
- , _starts = []
- , _stops = []
- }
+ toJSON (DailyWtimeRecord (date, _)) =
+ object ["date" .= date, "wtime" .= DurationRecord 0]
 
 generateId :: [Task] -> Id
 generateId tasks = generateId' (sort $ map _id tasks) [1 ..]
@@ -129,40 +129,60 @@ getTotalWtime now task = realToFrac $ sum $ zipWith diffUTCTime stops starts
  starts = _starts task
  stops = _stops task ++ [ now | _active task > 0 ]
 
-getWtimePerDay
- :: UTCTime -> Maybe UTCTime -> Maybe UTCTime -> [Task] -> [DailyWtime]
-getWtimePerDay now min max tasks = withoutEmpty $ wtime
- where
- wtime = foldl fWtimePerDay [] $ zip starts stops
- withoutEmpty = filter $ (\(_, d) -> d > 0)
- (starts, stops) = foldl byStartsAndStops ([], []) tasks
- byStartsAndStops (starts, stops) t =
- ( starts ++ withMinMax min max (_starts t)
- , stops ++ withMinMax min max (_stops t ++ [ now | _active t > 0 ])
- )
-
 withMinMax :: Maybe UTCTime -> Maybe UTCTime -> [UTCTime] -> [UTCTime]
 withMinMax maybeMin maybeMax = map withMinMax'
  where
  withMinMax' date =
  let max = minimum $ [fromMaybe date maybeMax, date]
  in maximum $ [fromMaybe max maybeMin, max]
 
-fWtimePerDay :: [DailyWtime] -> (UTCTime, UTCTime) -> [DailyWtime]
-fWtimePerDay acc (start, stop) = case lookup key acc of
- Nothing -> (key, nextSecs) : nextAcc
- Just prevSecs -> (key, prevSecs + nextSecs) : filter ((/=) key . fst) nextAcc
+mergeWtimes :: [DailyWtime] -> [DailyWtime] -> [DailyWtime]
+mergeWtimes = foldl mergeWtimes'
+ where
+ mergeWtimes' a (bday, bvals) = case lookup bday a of
+ Nothing -> (bday, bvals) : a
+ Just avals ->
+ (bday, foldl mergeWtimesVals avals bvals) : filter ((/=) bday . fst) a
+
+mergeWtimesVals :: [WtimeTask] -> WtimeTask -> [WtimeTask]
+mergeWtimesVals avals (WtimeTask bid bdesc bwtime) =
+ case find ((==) bid . getId) avals of
+ Nothing -> (WtimeTask bid bdesc bwtime) : avals
+ Just aval ->
+ (WtimeTask bid bdesc (getWtime aval + bwtime)) : without bid avals
+ where
+ getId (WtimeTask id desc wtime) = id
+ getWtime (WtimeTask id desc wtime) = wtime
+ without val = filter ((/=) val . getId)
+
+getWtimePerDay
+ :: UTCTime -> Maybe UTCTime -> Maybe UTCTime -> [Task] -> [DailyWtime]
+getWtimePerDay now min max = foldl (getWtimePerDay' now min max) []
  where
- key = show currDay
- currDay = utctDay start
- endOfDay = read $ show currDay ++ " 23:59:59.999999999" :: UTCTime
- nextDay = read $ show (addDays 1 currDay) ++ " 00:00:00" :: UTCTime
- (nextSecs, nextAcc) = if stop < endOfDay
- then (realToFrac $ diffUTCTime stop start, acc)
+ getWtimePerDay' now min max wtimes task = nextWtimes
+ where
+ wtimeTask = WtimeTask (_id task) (_desc task) 0
+ starts = withMinMax min max $ _starts task
+ stops = withMinMax min max $ _stops task ++ [ now | _active task > 0 ]
+ getWtime (WtimeTask _ _ w) = w
+ nextWtimes =
+ filter (\(_, wtimes) -> (sum $ map getWtime wtimes) > 0)
+ $ mergeWtimes wtimes
+ $ concatMap (wtimePerDay wtimeTask)
+ $ zip starts stops
+
+wtimePerDay :: WtimeTask -> (UTCTime, UTCTime) -> [DailyWtime]
+wtimePerDay (WtimeTask id desc _) (start, stop) = nextWtimes
+ where
+ day = show currDay
+ currDay = utctDay start
+ endOfDay = read $ show currDay ++ " 23:59:59.999999999" :: UTCTime
+ nextDay = read $ show (addDays 1 currDay) ++ " 00:00:00" :: UTCTime
+ nextWtimes = if stop < endOfDay
+ then [(day, [WtimeTask id desc $ realToFrac $ diffUTCTime stop start])]
  else
- ( realToFrac $ diffUTCTime endOfDay start
- , fWtimePerDay acc (nextDay, stop)
- )
+ (day, [WtimeTask id desc $ realToFrac $ diffUTCTime endOfDay start])
+ : wtimePerDay (WtimeTask id desc 0) (nextDay, stop)
 
 printActive :: Micro -> String
 printActive active | active > 0 = approximativeDuration active ++ " ago"
@@ -268,21 +288,30 @@ tableWtime wtime = head : body ++ foot
  where
  prettyPrint (date, wtime) = [date, humanReadableDuration $ realToFrac wtime]
  head = tableWtimeHead
- body = map tableWtimeRow wtime
- foot = [tableWtimeFoot $ foldl (\acc (_, x) -> acc + x) 0 wtime]
+ body = concatMap tableWtimeRow wtime
+ getWtime (WtimeTask _ _ w) = w
+ foot = [tableWtimeFoot $ sum $ map getWtime $ concatMap snd wtime]
 
 tableWtimeHead :: [Cell]
-tableWtimeHead = map (underline . bold . cell) ["DATE", "WORKTIME"]
+tableWtimeHead =
+ map (underline . bold . cell) ["DATE", "ID", "DESC", "WORKTIME"]
 
-tableWtimeRow :: DailyWtime -> [Cell]
-tableWtimeRow wtime = cells
+tableWtimeRow :: DailyWtime -> [[Cell]]
+tableWtimeRow wtime = map toCell (wtimeToStrings wtime) ++ [foot]
  where
- [date, total] = wtimeToStrings wtime
- cells = [cell date, yellow . cell $ total]
+ toCell [date, id, desc, total] =
+ [cell date, red . cell $ id, cell desc, yellow . cell $ total]
+ getWtime (WtimeTask _ _ wtime) = wtime
+ total = humanReadableDuration $ sum $ map getWtime $ snd wtime
+ foot = [ext 8 . cell $ "TOTAL", cell "", cell "", ext 8 . cell $ total]
 
 tableWtimeFoot :: Duration -> [Cell]
-tableWtimeFoot total = [bold . cell $ "TOTAL", bold . cell $ humanTotal]
+tableWtimeFoot total =
+ [bold . cell $ "TOTAL", cell "", cell "", bold . cell $ humanTotal]
  where humanTotal = humanReadableDuration total
 
-wtimeToStrings :: DailyWtime -> [String]
-wtimeToStrings (date, wtime) = [date, humanReadableDuration $ realToFrac wtime]
+wtimeToStrings :: DailyWtime -> [[String]]
+wtimeToStrings (date, tasks) = map wtimeToStrings' tasks
+ where
+ wtimeToStrings' (WtimeTask id desc wtime) =
+ [date, show id, desc, humanReadableDuration $ realToFrac wtime]

test/TaskSpec.hs

@@ -10,7 +10,8 @@ import Task
 
 spec :: Spec
 spec = parallel $ do
- let emptyActiveTask = emptyTask { _active = 1 }
+ let emptyActiveTask = emptyTask { _id = 1, _desc = "desc", _active = 1 }
+ let emptyTask' = emptyActiveTask { _active = 0 }
  describe "getWtimePerDay" $ do
  let d10 = read "2019-12-22 10:00:00" :: UTCTime
  let d12 = read "2019-12-22 12:00:00" :: UTCTime
@@ -19,34 +20,34 @@ spec = parallel $ do
  let d18 = read "2019-12-22 18:00:00" :: UTCTime
 
  it "start" $ do
- let tasks = [emptyActiveTask { _starts = [d10, d14], _stops = [d12] }]
+ let tasks = [emptyActiveTask { _starts = [d10, d16], _stops = [d12] }]
  getWtimePerDay d18 Nothing Nothing tasks
- `shouldBe` [("2019-12-22", 60 * 60 * 2 + 60 * 60 * 4)]
+ `shouldBe` [("2019-12-22", ([WtimeTask 1 "desc" $ 60 * 60 * 4]))]
 
  it "start stop" $ do
- let tasks = [emptyTask { _starts = [d10, d14], _stops = [d12, d16] }]
+ let tasks = [emptyTask' { _starts = [d10, d14], _stops = [d12, d16] }]
  getWtimePerDay d18 Nothing Nothing tasks
- `shouldBe` [("2019-12-22", 60 * 60 * 4)]
+ `shouldBe` [("2019-12-22", ([WtimeTask 1 "desc" $ 60 * 60 * 4]))]
 
  it "[ start" $ do
  let tasks = [emptyActiveTask { _starts = [d16] }]
  getWtimePerDay d18 (Just d10) Nothing tasks
- `shouldBe` [("2019-12-22", 60 * 60 * 2)]
+ `shouldBe` [("2019-12-22", ([WtimeTask 1 "desc" $ 60 * 60 * 2]))]
 
  it "start [" $ do
  let tasks = [emptyActiveTask { _starts = [d10] }]
  getWtimePerDay d18 (Just d14) Nothing tasks
- `shouldBe` [("2019-12-22", 60 * 60 * 4)]
+ `shouldBe` [("2019-12-22", ([WtimeTask 1 "desc" $ 60 * 60 * 4]))]
 
  it "[ start stop" $ do
  let tasks = [emptyActiveTask { _starts = [d14], _stops = [d16] }]
  getWtimePerDay d18 (Just d10) Nothing tasks
- `shouldBe` [("2019-12-22", 60 * 60 * 2)]
+ `shouldBe` [("2019-12-22", ([WtimeTask 1 "desc" $ 60 * 60 * 2]))]
 
  it "start [ stop" $ do
  let tasks = [emptyActiveTask { _starts = [d12], _stops = [d16] }]
  getWtimePerDay d18 (Just d14) Nothing tasks
- `shouldBe` [("2019-12-22", 60 * 60 * 2)]
+ `shouldBe` [("2019-12-22", ([WtimeTask 1 "desc" $ 60 * 60 * 2]))]
 
  it "start stop [" $ do
  let tasks = [emptyActiveTask { _starts = [d14], _stops = [d16] }]
@@ -59,7 +60,7 @@ spec = parallel $ do
  it "start ]" $ do
  let tasks = [emptyActiveTask { _starts = [d10] }]
  getWtimePerDay d18 Nothing (Just d12) tasks
- `shouldBe` [("2019-12-22", 60 * 60 * 2)]
+ `shouldBe` [("2019-12-22", ([WtimeTask 1 "desc" $ 60 * 60 * 2]))]
 
  it "] start stop" $ do
  let tasks = [emptyActiveTask { _starts = [d14], _stops = [d16] }]
@@ -68,27 +69,27 @@ spec = parallel $ do
  it "start ] stop" $ do
  let tasks = [emptyActiveTask { _starts = [d12], _stops = [d16] }]
  getWtimePerDay d18 Nothing (Just d14) tasks
- `shouldBe` [("2019-12-22", 60 * 60 * 2)]
+ `shouldBe` [("2019-12-22", ([WtimeTask 1 "desc" $ 60 * 60 * 2]))]
 
  it "start stop ]" $ do
  let tasks = [emptyActiveTask { _starts = [d14], _stops = [d16] }]
  getWtimePerDay d18 Nothing (Just d18) tasks
- `shouldBe` [("2019-12-22", 60 * 60 * 2)]
+ `shouldBe` [("2019-12-22", ([WtimeTask 1 "desc" $ 60 * 60 * 2]))]
 
  it "[ start stop ]" $ do
  let tasks = [emptyActiveTask { _starts = [d12], _stops = [d16] }]
  getWtimePerDay d18 (Just d10) (Just d18) tasks
- `shouldBe` [("2019-12-22", 60 * 60 * 4)]
+ `shouldBe` [("2019-12-22", ([WtimeTask 1 "desc" $ 60 * 60 * 4]))]
 
  it "start [ stop ]" $ do
  let tasks = [emptyActiveTask { _starts = [d12], _stops = [d16] }]
  getWtimePerDay d18 (Just d14) (Just d18) tasks
- `shouldBe` [("2019-12-22", 60 * 60 * 2)]
+ `shouldBe` [("2019-12-22", ([WtimeTask 1 "desc" $ 60 * 60 * 2]))]
 
  it "[ start ] stop" $ do
  let tasks = [emptyActiveTask { _starts = [d12], _stops = [d18] }]
  getWtimePerDay d18 (Just d10) (Just d16) tasks
- `shouldBe` [("2019-12-22", 60 * 60 * 4)]
+ `shouldBe` [("2019-12-22", ([WtimeTask 1 "desc" $ 60 * 60 * 4]))]
 
  it "start stop []" $ do
  let tasks = [emptyActiveTask { _starts = [d10], _stops = [d14] }]
@@ -101,4 +102,4 @@ spec = parallel $ do
  it "start [] stop" $ do
  let tasks = [emptyActiveTask { _starts = [d10], _stops = [d18] }]
  getWtimePerDay d18 (Just d14) (Just d16) tasks
- `shouldBe` [("2019-12-22", 60 * 60 * 2)]
+ `shouldBe` [("2019-12-22", ([WtimeTask 1 "desc" $ 60 * 60 * 2]))]