diddohs.hs

   1 import Control.Applicative( (<$>), (<*>) )
   2 import Control.Monad( when, unless )
   3 import Data.DateTime( diffSeconds )
   4 import Data.List.Split( splitOn )
   5 import Data.List( zipWith4, intercalate )
   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, utcToZonedTime, midnight, localDay )
  11 import Diddo( DiddoEntry(..), DiddoEntry2(..), LogEntry(..), LogLine(..), parseDiddoLogline, formatDiddoEntry, timestamp, logToDiddoEntry )
  12 import HMSTime( secondsToHMS )
  13 import System.Console.GetOpt
  14 import System.Environment( getArgs )
  15 import System.Exit( exitSuccess, exitFailure )
  16 import System.IO( stdin, stdout, stderr, hPutStr, hPutStrLn )
  17 import System.Locale
  18
  19 data Opt = Opt
  20     { optVerbose        :: Bool
  21     , optVersion        :: Bool
  22     , optHelp           :: Bool
  23     , optInputFiles     :: [String]
  24     , optOutputFile     :: String
  25     , optInputFormat    :: String
  26     , optOutputFormat   :: String
  27     , optStartDate      :: String
  28     , optEndDate        :: String
  29     }
  30
  31 defaultOpts :: Opt
  32 defaultOpts = Opt
  33     { optVerbose = False
  34     , optVersion = False
  35     , optHelp = False
  36     , optInputFiles = []
  37     , optOutputFile = ""
  38     , optInputFormat = "%FT%T%z"
  39     , optOutputFormat = "%FT%T%z"
  40     , optStartDate = ""
  41     , optEndDate = ""
  42     }
  43
  44 availableOptions :: [OptDescr (Opt -> IO Opt)]
  45 availableOptions =
  46     [ Option ['h']    ["help"]
  47         (NoArg (\_ -> putStrLn (usageInfo "Usage: diddohs [OPTION...]" availableOptions) >> exitSuccess))
  48         "Display program help"
  49     , Option ['v']    ["verbose"]
  50         (NoArg (\opts -> return opts { optVerbose = True }))
  51         "More detailed output"
  52     , Option ['V']    ["version"]
  53         (NoArg (\opts -> return opts { optVersion = True }))
  54         "Display program version"
  55     , Option ['f']    ["file"]
  56         (ReqArg (\arg opts -> return opts { optInputFiles = optInputFiles opts ++ [arg]}) "FILE" )
  57         "Read from FILE"
  58     , Option ['w']    ["output"]
  59         (ReqArg (\arg opts -> return opts { optOutputFile = arg }) "FILE")
  60         "Write to FILE"
  61     , Option ['i']    ["informat"]
  62         (ReqArg (\arg opts -> return opts { optInputFormat = arg }) "FORMAT")
  63         "Timeformat used in input"
  64     , Option ['o']    ["outformat"]
  65         (ReqArg (\arg opts -> return opts { optOutputFormat = arg }) "FORMAT")
  66         "Timeformat used in output"
  67     , Option ['s']    ["start"]
  68         (ReqArg (\arg opts -> return opts { optStartDate = arg }) "DATE")
  69         "Start of reporting period"
  70     , Option ['e']    ["end"]
  71         (ReqArg (\arg opts -> return opts { optEndDate = arg }) "DATE")
  72         "End of reporting period"
  73     ]
  74
  75 -- SECTION: parsing to ZonedTime
  76 parseToZonedTime :: String -> String -> ZonedTime
  77 parseToZonedTime format string = fromMaybe (error $ "Input data broken: " ++ string) $ parseTime defaultTimeLocale format string
  78
  79 parseISOsecondsTime :: String -> ZonedTime
  80 parseISOsecondsTime = parseToZonedTime $ iso8601DateFormat $ Just "%T%z"
  81
  82 parseRFC822Time :: String -> ZonedTime
  83 parseRFC822Time = parseToZonedTime rfc822DateFormat
  84 -- SECTION: parsing to ZonedTime
  85
  86 -- SECTION: handling ZonedTime
  87 formatZonedTime :: String -> ZonedTime -> String
  88 formatZonedTime = formatTime defaultTimeLocale
  89
  90 startOfDay :: ZonedTime -> ZonedTime
  91 startOfDay time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time
  92     where
  93         day = localDay $ zonedTimeToLocalTime time
  94
  95 startOfMonth :: ZonedTime -> ZonedTime
  96 startOfMonth time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time
  97     where
  98         day = localDay $ zonedTimeToLocalTime time
  99 -- SECTION: handling ZonedTime
 100
 101 -- SECTION: handling UTCTime
 102 utcTimesDeltas :: [UTCTime] -> [Integer]
 103 utcTimesDeltas [] = error "Function utcTimesDeltas called with no argument"
 104 utcTimesDeltas [_] = error "Function utcTimesDeltas called with bougus argument"
 105 utcTimesDeltas (x:y:[]) = [diffSeconds y x]
 106 utcTimesDeltas (x:y:xs) = diffSeconds y x : utcTimesDeltas (y:xs)
 107
 108 --deltaAndEntry :: Map UTCTime Diddo.LogLine -> DiddoEntry2
 109 --deltaAndEntry dddLoglineMap = Map.mapWithKey findDeltaEntry dddLoglineMap
 110 --    where
 111 --        precEntry = case Map.lookupLT (Diddo.timestamp logentry) dddLoglineMap of
 112 --            Just x      -> x
 113 --            Nothing     -> Diddo.timestamp logentry
 114 --        end = utcToZonedTime (Diddo.timezone logentry) (Diddo.timestamp logentry)
 115 --        start = utcToZonedTime (Diddo.timezone logentry) (fst precEntry)
 116 --        delta = diffSeconds end start
 117 --        comment = Diddo.text logentry
 118 --
 119 --findDeltaEntry timestamp logentry = Diddo.DiddoEntry2 start end delta comment
 120
 121 mapToDiddoEntries :: Map.Map UTCTime Diddo.LogEntry -> Map.Map UTCTime Diddo.DiddoEntry2
 122 mapToDiddoEntries logmap = Map.mapWithKey toDddEntry logmap
 123     where
 124         toDddEntry timestamp logentry = Diddo.logToDiddoEntry (preceedingTimestamp timestamp) logentry
 125         preceedingTimestamp x = case Map.lookupLT x logmap of
 126             Just y          -> fst y
 127             Nothing         -> fst $ Map.findMin logmap
 128 -- SECTION: handling UTCTime
 129
 130 -- SECTION: handling rawinput
 131 splitToMapOn :: String -> [String] -> Map.Map String [String]
 132 splitToMapOn sep loglines = Map.fromList $ map (listToTuple . splitOn sep) loglines
 133     where listToTuple (x:xs) = (x, xs)
 134           listToTuple [] = ("",[""])
 135
 136 logLinesToDiddohs :: String -> [String] -> [DiddoEntry]
 137 logLinesToDiddohs inDateFmt logLines =
 138     let
 139         loglineMap            = splitToMapOn ";" logLines
 140         zonedtimeEntryMap     = Map.mapKeysMonotonic (parseToZonedTime inDateFmt) loglineMap
 141         utctimeEntryMap       = Map.mapKeys zonedTimeToUTC zonedtimeEntryMap
 142
 143         timeStamps            = Map.keys loglineMap
 144         entryTexts            = map (intercalate ";") $ Map.elems loglineMap
 145         parsedTimes           = Map.keys zonedtimeEntryMap
 146
 147         deltasHMS             = map secondsToHMS $ utcTimesDeltas ((zonedTimeToUTC $ startOfDay $ head parsedTimes) : Map.keys utctimeEntryMap)
 148     in
 149         zipWith4 DiddoEntry (formatZonedTime inDateFmt (startOfDay $ head parsedTimes) : init timeStamps)
 150                           timeStamps deltasHMS entryTexts
 151 -- SECTION: handling rawinput
 152
 153 main :: IO ()
 154 main = do
 155     -- SECTION: option processing
 156     (givenOptions,args,errs) <- getArgs >>= return . getOpt Permute availableOptions
 157
 158     unless (null errs) $ do
 159         mapM_ (hPutStr stderr) errs
 160         exitFailure
 161
 162     effectiveOptions <- foldl (>>=) (return defaultOpts) givenOptions
 163     -- SECTION: option processing
 164
 165     dddLines <-
 166         map Diddo.LogLine <$> case optInputFiles effectiveOptions of
 167             files@(_:_)         -> lines . concat <$> mapM readFile files
 168             []                  -> lines <$> getContents
 169
 170     dddLogEntries <-
 171         map Diddo.parseDiddoLogline <$> case optInputFiles effectiveOptions of
 172             files@(_:_)         -> lines . concat <$> mapM readFile files
 173             []                  -> lines <$> getContents
 174
 175     let
 176         dddLogEntryMap      = Map.fromList $ map (\diddo -> (Diddo.timestamp diddo, diddo)) dddLogEntries
 177         diddoEntriesMap     = mapToDiddoEntries dddLogEntryMap
 178         inDateFmt           = optInputFormat effectiveOptions
 179         outDateFmt          = optOutputFormat effectiveOptions
 180
 181     -- DEBUG
 182     mapM_ putStrLn args
 183     -- DEBUG
 184
 185     mapM_ print $ logLinesToDiddohs inDateFmt (map show dddLines)
 186 --    putStrLn "new code output following"
 187 --    mapM_ (print . snd) $ Map.toAscList diddoEntriesMap
 188     putStrLn "new code output following"
 189     mapM_ (putStrLn . snd) $ Map.toAscList $ Map.map (Diddo.formatDiddoEntry outDateFmt) diddoEntriesMap
 190