diddohs.hs

   1 import Control.Applicative( (<$>), (<*>) )
   2 import Data.DateTime( DateTime(..), parseDateTime, formatDateTime, startOfTime, diffSeconds )
   3 import Data.List.Split( splitOn )
   4 import Data.List( zipWith4, transpose )
   5 import Data.Maybe( fromJust, fromMaybe )
   6 import Data.Monoid( mempty )
   7 import Data.Time.Clock( secondsToDiffTime )
   8 import Data.Time.Format( parseTime, formatTime )
   9 import Data.Time.LocalTime( LocalTime(..), ZonedTime(..), zonedTimeToUTC, midnight, localDay )
  10 import Diddo.Entry( DiddoEntry(..) )
  11 import HMSTime( HMSTime(..), secondsToHMS )
  12 import Options.Applicative( execParser, info, strOption, long, help, helper, briefDesc, fullDesc, progDesc, header, (<>) )
  13 import System.Environment( getArgs )
  14 import System.Locale
  15
  16 data DiddoOpts = DiddoOpts
  17   { inDateFmt :: String
  18   , inFile :: String
  19   }
  20
  21 parseToZonedTime :: String -> String -> ZonedTime
  22 parseToZonedTime format = fromMaybe (error "Input data broken.") . parseTime defaultTimeLocale format
  23
  24 parseISOsecondsTime :: String -> ZonedTime
  25 parseISOsecondsTime = parseToZonedTime $ iso8601DateFormat $ Just "%T%z"
  26
  27 parseRFC822Time :: String -> ZonedTime
  28 parseRFC822Time = parseToZonedTime rfc822DateFormat
  29
  30 formatZonedTime :: String -> ZonedTime -> String
  31 formatZonedTime format = formatTime defaultTimeLocale format
  32
  33 zonedTimesDeltas :: ZonedTime -> [ZonedTime] -> [Integer]
  34 zonedTimesDeltas startTime timestamps =
  35   let
  36     startTimeUTC        = zonedTimeToUTC startTime
  37     relevantTimestamps  = dropWhile (< startTimeUTC) $ map zonedTimeToUTC timestamps
  38   in
  39     zipWith diffSeconds relevantTimestamps $ startTimeUTC : init relevantTimestamps
  40
  41 startOfZonedDay :: ZonedTime -> ZonedTime
  42 startOfZonedDay time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time
  43   where
  44     day = localDay $ zonedTimeToLocalTime time
  45
  46 mainWithOpts :: DiddoOpts -> IO ()
  47 mainWithOpts opts =
  48   do
  49     [
  50       timeStamps
  51       , entryText
  52       ]                     <- transpose . map (splitOn ";") . lines <$> readFile (inFile opts)
  53
  54     let
  55       parseCustomTime       = parseToZonedTime $ inDateFmt opts
  56 --      parsedTimes           = map (parseToZonedTime $ inDateFmt opts) timeStamps
  57       parsedTimes           = map parseCustomTime timeStamps
  58       deltasHMS             = map secondsToHMS $ zonedTimesDeltas (startOfZonedDay $ head parsedTimes) parsedTimes
  59       diddos_summarized     = zipWith4 DiddoEntry
  60                                 ((formatZonedTime (inDateFmt opts) $ startOfZonedDay $ head parsedTimes) : init timeStamps)
  61                                 timeStamps deltasHMS entryText
  62
  63     mapM_ print diddos_summarized
  64
  65 main :: IO ()
  66 main = execParser opts >>= mainWithOpts
  67   where
  68     opts = info (helper <*> parser)
  69       ( header "diddohs - A Time/Task Tracker"
  70      <> progDesc "Diddoh Desc"
  71 --     <> briefDesc
  72      <> fullDesc
  73      )
  74     parser = DiddoOpts
  75       <$> strOption ( long "indateform"
  76                    <> help "Input date format, see date(1)"
  77                    )
  78       <*> strOption ( long "infile" )
  79