{-# LANGUAGE LambdaCase #-}
module Lib ( appMain ) where
import Data.Hourglass
import Data.List
import Data.List.Split
import Text.Read
import Time.System
data Work
= Work
{ workName :: String
, workTime :: Seconds
}
deriving (Eq, Ord, Read, Show)
appMain :: IO ()
appMain = do
contents <- getContents
date <- dtDate <$> dateCurrent
works <- mapM (\case Left msg -> fail msg
Right work -> pure work
) $ parseWork date <$> wordsBy (\c -> c == ',' || c == '\n') contents
putStr $ workgroupPrettyStr $ collectWorkGroup works
parseWork :: Date -> String -> Either String Work
parseWork date str
= case words str of
startStr : endStr : tl ->
let parse source = case splitOn ":" source of
[hs, ss] -> do
h <- readMaybe hs
s <- readMaybe ss
pure $ DateTime date $ TimeOfDay{todHour = Hours h, todMin = Minutes s, todSec = 0, todNSec = 0}
_ -> Nothing
leftParse s = Left $ "次の時刻表記が認識できませんでした: " <> s
in case (parse startStr, parse endStr) of
(Just workStart, Just workEnd) -> Right $ Work{workName = concat tl, workTime = workEnd `timeDiff` workStart}
(Nothing, Just _) -> leftParse startStr
(Just _, Nothing) -> leftParse endStr
(Nothing, Nothing) -> leftParse $ startStr <> " && " <> endStr
_ -> Left $ "文字列を認識できませんでした: " <> str
collectWorkGroup :: [Work] -> [Work]
collectWorkGroup = foldr addWork []
addWork :: Work -> [Work] -> [Work]
addWork work works = case find (\w -> workName w == workName work) works of
Nothing -> work : works
Just progressWork
-> Work{workName = workName work, workTime = workTime progressWork + workTime work} :
progressWork `delete` works
workgroupPrettyStr :: [Work] -> String
workgroupPrettyStr works = unlines (workPrettyStr <$> works)
workPrettyStr :: Work -> String
workPrettyStr work
= case fromSeconds (workTime work) of
(d, 0) ->
concatMap (++ "\t")
[ workName work
, show (toInteger $ durationHours d) <> ":" <> show (toInteger $ durationMinutes d)
, show (fromIntegral (toInteger (durationHours d)) + (fromIntegral (toInteger (durationMinutes d)) / (60 :: Double)))
]
o -> error $ "出力がヘンになりました: " <> show o