diddohs.hs

   1 import Control.Applicative( (<$>), (<*>) )
   2 import Data.DateTime( diffSeconds )
   3 import Data.List.Split( splitOn )
   4 import Data.List( zipWith4, transpose )
   5 import qualified Data.Map as Map
   6 import Data.Maybe( fromJust, fromMaybe )
   7 import Data.Time.Clock( UTCTime(..), 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 Diddo.Log( DiddoLogline(..) )
  12 import HMSTime( HMSTime(..), secondsToHMS )
  13 import System.Console.GetOpt
  14 import System.Environment( getArgs )
  15 import System.Exit
  16 import System.IO( stderr, hPutStr, hPutStrLn )
  17 import System.Locale
  18
  19 data Flag
  20   = Verbose         | Version
  21   | Help
  22   | InputFile String   | OutputFile String
  23   | InputFormat String | OutputFormat String
  24     deriving Show
  25
  26 options :: [OptDescr Flag]
  27 options =
  28   [ Option "v"      ["verbose"]     (NoArg Verbose)                           "More detailed output"
  29   , Option "V"      ["version"]     (NoArg Version)                           "Display program version"
  30   , Option "h"      ["help"]        (NoArg Help)                              "Display program version"
  31   , Option "f"      ["file"]        (ReqArg InputFile "FILE")                 "Read from FILE"
  32   , Option "w"      ["output"]      (ReqArg OutputFile "FILE")                "Write to FILE"
  33   , Option "i"      ["informat"]    (ReqArg InputFormat "FORMAT")             "Parse dates in the given FORMAT"
  34   , Option "o"      ["outformat"]   (ReqArg OutputFormat "FORMAT")            "Output dates in the given FORMAT"
  35   ]
  36
  37 parseToZonedTime :: String -> String -> ZonedTime
  38 parseToZonedTime format = fromMaybe (error "Input data broken.") . parseTime defaultTimeLocale format
  39
  40 parseISOsecondsTime :: String -> ZonedTime
  41 parseISOsecondsTime = parseToZonedTime $ iso8601DateFormat $ Just "%T%z"
  42
  43 parseRFC822Time :: String -> ZonedTime
  44 parseRFC822Time = parseToZonedTime rfc822DateFormat
  45
  46 formatZonedTime :: String -> ZonedTime -> String
  47 formatZonedTime = formatTime defaultTimeLocale
  48
  49 utcTimesDeltas :: ZonedTime -> [UTCTime] -> [Integer]
  50 utcTimesDeltas startTime timestamps =
  51   let
  52     startTimeUTC        = zonedTimeToUTC startTime
  53     relevantTimestamps  = dropWhile (< startTimeUTC) timestamps
  54   in
  55     zipWith diffSeconds relevantTimestamps $ startTimeUTC : init relevantTimestamps
  56
  57 startOfDay :: ZonedTime -> ZonedTime
  58 startOfDay time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time
  59   where
  60     day = localDay $ zonedTimeToLocalTime time
  61
  62 parseToUTCFromZonedString :: String -> String -> UTCTime
  63 parseToUTCFromZonedString fmt time = zonedTimeToUTC $ parseToZonedTime fmt time
  64
  65 splitToMapOn :: String -> [String] -> Map.Map String [String]
  66 splitToMapOn sep lines = Map.fromList $ map (listToTuple . splitOn sep) lines
  67   where listToTuple (x:xs) = (x, xs)
  68
  69 logLinesToDiddohs :: String -> [String] -> [DiddoEntry]
  70 logLinesToDiddohs inDateFmt logLines =
  71     let
  72       loglineMap            = splitToMapOn ";" logLines
  73       zonedtimeEntryMap     = Map.mapKeysMonotonic (parseToZonedTime inDateFmt) loglineMap
  74       utctimeEntryMap       = Map.mapKeys zonedTimeToUTC zonedtimeEntryMap
  75
  76       timeStamps            = Map.keys loglineMap
  77       entryTexts            = map head $ Map.elems loglineMap
  78       parsedTimes           = Map.keys zonedtimeEntryMap
  79
  80       deltasHMS             = map secondsToHMS $ utcTimesDeltas (startOfDay $ head parsedTimes) $ Map.keys utctimeEntryMap
  81     in
  82       zipWith4 DiddoEntry (formatZonedTime inDateFmt (startOfDay $ head parsedTimes) : init timeStamps)
  83                           timeStamps deltasHMS entryTexts
  84
  85 readFilesToLines :: [String] -> IO [String]
  86 readFilesToLines filenames = lines . concat <$> mapM readFile filenames
  87
  88 main :: IO ()
  89 main = do
  90   argv <- getArgs
  91
  92   case getOpt Permute options argv of
  93     (opts,args,[])    -> do
  94       let
  95         logFileNames          = [file | InputFile file <- opts]
  96         inDateFmt             = head [fmt | InputFormat fmt <- opts]
  97
  98       logLines                <- readFilesToLines logFileNames
  99
 100       mapM_ print $ logLinesToDiddohs inDateFmt logLines
 101
 102     (_,_,errs)        -> do
 103       hPutStr stderr $ usageInfo header options
 104       ioError (userError ('\n' : concat errs))
 105         where header = "Usage: diddohs [OPTION...]"
 106