X-Git-Url: https://git.netwichtig.de/gitweb/?a=blobdiff_plain;f=diddohs.hs;h=6884d1462cd52cb50d96fb6fc36c7b7dbf42fba4;hb=95d1857e437aa09e1161be075c654c50afd91dd8;hp=60beb319e6279dc9003c4a6bfe070ac59a6f24d2;hpb=aa7fd5c65535efa95dd0ea0a320aeac679c6dfa7;p=user%2Fhenk%2Fcode%2Fhaskell%2Fdiddohs.git diff --git a/diddohs.hs b/diddohs.hs index 60beb31..6884d14 100644 --- a/diddohs.hs +++ b/diddohs.hs @@ -1,36 +1,114 @@ -import Control.Applicative( (<$>), (<*>) ) -import Data.DateTime( DateTime(..), parseDateTime, formatDateTime, startOfTime, diffSeconds ) -import Data.List.Split( splitOn ) -import Data.List( zipWith4, transpose ) -import Data.Maybe( fromJust, fromMaybe ) -import Data.Monoid( mempty ) -import Data.Time.Clock( secondsToDiffTime ) -import Options.Applicative( execParser, info, strOption, long ) +import Control.Applicative( (<$>) ) +import Control.Monad( unless ) +import Data.Time.Clock( UTCTime(..) ) +import Data.Time.LocalTime( TimeZone(), ZonedTime(..), zonedTimeToUTC, utcToZonedTime ) +import Diddo( Diddo(..), LogEntry(..), parseDiddoLogline, formatDiddo, logToDiddo, parseToZonedTime ) +import System.Console.GetOpt import System.Environment( getArgs ) -import HMSTime( HMSTime(..), secondsToHMS ) -import Diddo.Entry( DiddoEntry(..) ) +import System.Exit( exitSuccess, exitFailure ) +import System.IO( stderr, hPutStr ) +import qualified Data.Map as Map +import qualified Data.Text as T +import qualified Data.Text.IO as TIO -data DiddoOpts = DiddoOpts - { inDateFmt :: String - , inFile :: String - } +data Opt = Opt + { optVerbose :: Bool + , optVersion :: Bool + , optHelp :: Bool + , optInputFiles :: [String] + , optOutputFile :: String + , optInputFormat :: String + , optOutputFormat :: String + , optStartDate :: String + , optEndDate :: String + } -mainWithOpts :: DiddoOpts -> IO () -mainWithOpts opts = do - [timestrings_finish - , entries - ] <- transpose . map (splitOn ";") . lines <$> readFile (inFile opts) - let utcTimes_finish = map (fromMaybe (error "Input data broken.") . parseDateTime (inDateFmt opts)) timestrings_finish - entry_deltas_HMMSS = zipWith (\x y -> secondsToHMS $ diffSeconds x y) utcTimes_finish (startOfTime : init utcTimes_finish) - diddos_summarized = zipWith4 DiddoEntry ("" : init timestrings_finish) timestrings_finish entry_deltas_HMMSS entries +defaultOpts :: Opt +defaultOpts = Opt + { optVerbose = False + , optVersion = False + , optHelp = False + , optInputFiles = [] + , optOutputFile = "" + , optInputFormat = "%FT%T%z" + , optOutputFormat = "%FT%T%z" + , optStartDate = "" + , optEndDate = "" + } - mapM_ print diddos_summarized +availableOptions :: [OptDescr (Opt -> IO Opt)] +availableOptions = + [ Option ['h'] ["help"] + (NoArg (\ _ -> putStrLn (usageInfo "Usage: diddohs [OPTION...]" availableOptions) >> exitSuccess)) + "Display program help" + , Option ['v'] ["verbose"] + (NoArg (\ opts -> return opts { optVerbose = True })) + "More detailed output" + , Option ['V'] ["version"] + (NoArg (\ opts -> return opts { optVersion = True })) + "Display program version" + , Option ['f'] ["file"] + (ReqArg (\ arg opts -> return opts { optInputFiles = optInputFiles opts ++ [arg]}) "FILE" ) + "Read from FILE" + , Option ['w'] ["output"] + (ReqArg (\ arg opts -> return opts { optOutputFile = arg }) "FILE") + "Write to FILE" + , Option ['i'] ["informat"] + (ReqArg (\ arg opts -> return opts { optInputFormat = arg }) "FORMAT") + "Timeformat used in input" + , Option ['o'] ["outformat"] + (ReqArg (\ arg opts -> return opts { optOutputFormat = arg }) "FORMAT") + "Timeformat used in output" + , Option ['s'] ["start"] + (ReqArg (\ arg opts -> return opts { optStartDate = arg }) "DATE") + "Start of reporting period" + , Option ['e'] ["end"] + (ReqArg (\ arg opts -> return opts { optEndDate = arg }) "DATE") + "End of reporting period" + ] + +-- SECTION: Map of logentries to Map of Diddos +logentryMapToDiddoMap :: Map.Map UTCTime Diddo.LogEntry -> Map.Map UTCTime Diddo.Diddo +logentryMapToDiddoMap logmap = Map.mapWithKey toDddEntry logmap + where + toDddEntry key value = Diddo.logToDiddo (precedingTimestamp key) value + precedingTimestamp x = case Map.lookupLT x logmap of + Just (y,_) -> y + Nothing -> fst $ Map.findMin logmap +-- SECTION: Map of logentries to Map of DiddoEntries main :: IO () -main = execParser opts >>= mainWithOpts - where - opts = info parser mempty - parser = DiddoOpts - <$> strOption ( long "indateform" ) - <*> strOption ( long "infile" ) +main = do + -- SECTION: option processing + (givenOptions,args,errs) <- getArgs >>= return . getOpt Permute availableOptions + + unless (null errs) $ do + mapM_ (hPutStr stderr) errs + exitFailure + + effectiveOptions <- foldl (>>=) (return defaultOpts) givenOptions + + let + inDateFmt = optInputFormat effectiveOptions + outDateFmt = optOutputFormat effectiveOptions + + startDate = parseToZonedTime inDateFmt $ optStartDate effectiveOptions + endDate = parseToZonedTime inDateFmt $ optEndDate effectiveOptions + -- SECTION: option processing + + loglines <- case optInputFiles effectiveOptions of + files@(_:_) -> T.lines . T.concat <$> mapM TIO.readFile files + [] -> T.lines <$> TIO.getContents + + let + timestampLogentryMap = Map.fromList $ map Diddo.parseDiddoLogline loglines + (_, _, startedTimestampLogentryMap) = Map.splitLookup (zonedTimeToUTC startDate) timestampLogentryMap + (endedTimestampLogentryMap, lastEntry, _) = Map.splitLookup (zonedTimeToUTC endDate) startedTimestampLogentryMap + timestampDiddoMap = logentryMapToDiddoMap timestampLogentryMap + + -- DEBUG + mapM_ putStrLn args + -- DEBUG + + mapM_ (TIO.putStrLn . snd) $ Map.toAscList $ Map.map (Diddo.formatDiddo outDateFmt) timestampDiddoMap