diddohs.hs

   1 import Control.Applicative( (<$>) )
   2 import Control.Monad( when )
   3 import Data.DateTime( diffSeconds )
   4 import Data.List.Split( splitOn )
   5 import Data.List( zipWith4 )
   6 import qualified Data.Map as Map
   7 import Data.Maybe( fromMaybe, fromJust )
   8 import Data.Time.Clock( UTCTime(..) )
   9 import Data.Time.Format( parseTime, formatTime )
  10 import Data.Time.LocalTime( LocalTime(..), ZonedTime(..), TimeZone(..), zonedTimeToUTC, midnight, localDay )
  11 import Diddo( DiddoEntry(..), DiddoLogline(..), DiddoParsed(..) )
  12 import HMSTime( secondsToHMS )
  13 import System.Console.GetOpt
  14 import System.Environment( getArgs )
  15 import System.Exit( exitSuccess )
  16 import System.IO( stderr, hPutStr, hPutStrLn )
  17 import System.Locale
  18
  19 data Opt
  20     = Verbose            | Version
  21     | Help
  22     | InputFile String   | OutputFile String
  23     | InputFormat String | OutputFormat String
  24     | StartDate String   | EndDate String
  25         deriving (Show, Eq)
  26
  27 options :: [OptDescr Opt]
  28 options =
  29     [ Option "v"    ["verbose"]     (NoArg Verbose)                     "More detailed output"
  30     , Option "V"    ["version"]     (NoArg Version)                     "Display program version"
  31     , Option "h"    ["help"]        (NoArg Help)                        "Display program help"
  32     , Option "f"    ["file"]        (ReqArg InputFile "FILE")           "Read from FILE"
  33     , Option "w"    ["output"]      (ReqArg OutputFile "FILE")          "Write to FILE"
  34     , Option "i"    ["informat"]    (ReqArg InputFormat "FORMAT")       "Timeformat used in input"
  35     , Option "o"    ["outformat"]   (ReqArg OutputFormat "FORMAT")      "Timeformat used in output"
  36     , Option "s"    ["start"]       (ReqArg StartDate "DATE")               "Start of reporting period"
  37     , Option "e"    ["end"]         (ReqArg EndDate "DATE")               "End of reporting period"
  38     ]
  39
  40 parseToZonedTime :: String -> String -> ZonedTime
  41 parseToZonedTime format string = fromMaybe (error $ "Input data broken: " ++ string) $ parseTime defaultTimeLocale format string
  42
  43 parseISOsecondsTime :: String -> ZonedTime
  44 parseISOsecondsTime = parseToZonedTime $ iso8601DateFormat $ Just "%T%z"
  45
  46 zonedToUTCandTZ :: ZonedTime -> (UTCTime, TimeZone)
  47 zonedToUTCandTZ zt = (zonedTimeToUTC zt, zonedTimeZone zt)
  48
  49 parseRFC822Time :: String -> ZonedTime
  50 parseRFC822Time = parseToZonedTime rfc822DateFormat
  51
  52 formatZonedTime :: String -> ZonedTime -> String
  53 formatZonedTime = formatTime defaultTimeLocale
  54
  55 utcTimesDeltas' :: [UTCTime] -> [Integer]
  56 utcTimesDeltas' [] = error "Function utcTimesDeltas' called with no argument"
  57 utcTimesDeltas' [_] = error "Function utcTimesDeltas' called with bougus argument"
  58 utcTimesDeltas' (x:y:[]) = [diffSeconds y x]
  59 utcTimesDeltas' (x:y:xs) = diffSeconds y x : utcTimesDeltas' (y:xs)
  60
  61 utcTimesDeltas :: ZonedTime -> [UTCTime] -> [Integer]
  62 utcTimesDeltas startTime timestamps =
  63     let
  64         startTimeUTC        = zonedTimeToUTC startTime
  65         relevantTimestamps  = dropWhile (< startTimeUTC) timestamps
  66     in
  67         zipWith diffSeconds relevantTimestamps $ startTimeUTC : init relevantTimestamps
  68
  69 startOfDay :: ZonedTime -> ZonedTime
  70 startOfDay time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time
  71     where
  72         day = localDay $ zonedTimeToLocalTime time
  73
  74 startOfMonth :: ZonedTime -> ZonedTime
  75 startOfMonth time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time
  76     where
  77         day = localDay $ zonedTimeToLocalTime time
  78
  79 parseToUTCFromZonedString :: String -> String -> UTCTime
  80 parseToUTCFromZonedString fmt time = zonedTimeToUTC $ parseToZonedTime fmt time
  81
  82 linesFromFiles :: [String] -> IO [String]
  83 linesFromFiles filenames = lines . concat <$> mapM readFile filenames
  84
  85 splitToMapOn :: String -> [String] -> Map.Map String [String]
  86 splitToMapOn sep loglines = Map.fromList $ map (listToTuple . splitOn sep) loglines
  87     where listToTuple (x:xs) = (x, xs)
  88           listToTuple [] = ("",[""])
  89
  90 logLinesToDiddohs :: String -> [String] -> [DiddoEntry]
  91 logLinesToDiddohs inDateFmt logLines =
  92     let
  93         loglineMap            = splitToMapOn ";" logLines
  94         zonedtimeEntryMap     = Map.mapKeysMonotonic (parseToZonedTime inDateFmt) loglineMap
  95         utctimeEntryMap       = Map.mapKeys zonedTimeToUTC zonedtimeEntryMap
  96
  97         timeStamps            = Map.keys loglineMap
  98         entryTexts            = map head $ Map.elems loglineMap
  99         parsedTimes           = Map.keys zonedtimeEntryMap
 100
 101         deltasHMS             = map secondsToHMS $ utcTimesDeltas (startOfDay $ head parsedTimes) $ Map.keys utctimeEntryMap
 102     in
 103         zipWith4 DiddoEntry (formatZonedTime inDateFmt (startOfDay $ head parsedTimes) : init timeStamps)
 104                           timeStamps deltasHMS entryTexts
 105
 106 --parsedLinesToDiddohs :: String -> Map.Map UTCTime DiddoParsed -> [DiddoEntry]
 107 --parsedLinesToDiddohs inDateFmt parsedLines =
 108 --  Map.foldrWithKey (\t e ts -> )
 109
 110 parseDddLog :: String -> Map.Map UTCTime DiddoParsed
 111 parseDddLog line =
 112     Map.singleton timestamp $ DiddoParsed timestamp zt entry
 113     where
 114         (timestring:entry:_) = splitOn ";" line
 115         (timestamp,zt) = zonedToUTCandTZ $ parseISOsecondsTime timestring
 116
 117 main :: IO ()
 118 main = do
 119     argv <- getArgs
 120
 121     case getOpt Permute options argv of
 122         (opts,args,[])    -> do
 123             when (Help `elem` opts) $
 124                 (putStrLn $ usageInfo "Usage: diddohs [OPTION...]" options) >> exitSuccess
 125
 126             let
 127                 logFileNames        = [file | InputFile file <- opts]
 128
 129             logLines                <- linesFromFiles logFileNames
 130
 131             let
 132                 inDateFmt           = head [fmt | InputFormat fmt <- opts]
 133 --                reportPeriod        =   ( head [time | StartDate time <- opts]
 134 --                                        , head [time | EndDate time <- opts]
 135 --                                        )
 136
 137             -- DEBUG
 138             mapM_ putStrLn args
 139 --            putStrLn $ show reportPeriod
 140
 141
 142             let
 143                 loglineMap              = Map.unions $ map parseDddLog logLines
 144                 deltasHMS               = map secondsToHMS $ utcTimesDeltas' $ fst (Map.findMin loglineMap) : Map.keys loglineMap
 145
 146         --        loglineMapReduced = Map.filterWithKey (\t _ -> t > startDay) loglineMap
 147         --        diddoEntries          = Map.foldrWithKey
 148
 149             mapM_ print $ logLinesToDiddohs inDateFmt logLines
 150 --            mapM_ print deltasHMS
 151
 152         (_,_,errs)        -> do
 153             hPutStr stderr $ usageInfo header options
 154             ioError (userError ('\n' : concat errs))
 155                 where header = "Usage: diddohs [OPTION...]"
 156