nptools-0.1: what-I-have-done-today.hs

{-# LANGUAGE PatternGuards #-}
import System.Locale (defaultTimeLocale)
import Data.Time.Clock (DiffTime, UTCTime(..), getCurrentTime)
import Data.Time.LocalTime
import Data.Time.Format (readTime, formatTime)
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Maybe
import Data.List
import Data.Function
import Data.Ord

readMyTime :: String -> UTCTime
readMyTime = readTime defaultTimeLocale "%T%Q"

splitEvent :: String -> String -> Maybe (String, UTCTime)
splitEvent today event =
   case words event of
     date : time : _ : "tags:" : tags | [tag] <- tags ->
                                          guard (date == today) >> Just (tag, readMyTime time)
                                      | otherwise -> Nothing
     _ -> error ("splitEvent: " ++ event)

formatDiffTime :: DiffTime -> String
formatDiffTime = formatTime defaultTimeLocale "%T%Q" . timeToTimeOfDay

pack :: (Ord a) => [(a, b)] -> [(a, [b])]
pack = map ((fst . head) &&& map snd)
     . groupBy ((==) `on` fst)
     . sortBy (comparing fst)


work :: String -> [String] -> String
work today = unlines . map (uncurry (++) . second ((": "++) . formatDiffTime))
           . sortBy (comparing snd)
           . map (second sum) . pack . uncurry zip
           . second ((map (uncurry (flip (-)))) . (zip`ap`tail) . map utctDayTime)
           . unzip . catMaybes . map (splitEvent today)

main :: IO ()
main =
  do now <- getCurrentTime
     eventsFile <- getEnv "EVENTS_LOG"
     let today = formatTime defaultTimeLocale "%Y-%m-%d" now
     events <- lines <$> readFile eventsFile
     putStr $ work today events