X-Git-Url: https://git.netwichtig.de/gitweb/?a=blobdiff_plain;f=diddohs.hs;h=0444e22aaec24fdc98ea57636160933adf4e7329;hb=62ba998ef05a79c1fd60386f7ec8dbef49f8a78f;hp=21bae077a49ed1008ba6827183398b91f9cb19e6;hpb=9d103749a11f458b8e6834faf37b955fc2818c2b;p=user%2Fhenk%2Fcode%2Fhaskell%2Fdiddohs.git diff --git a/diddohs.hs b/diddohs.hs index 21bae07..0444e22 100644 --- a/diddohs.hs +++ b/diddohs.hs @@ -1,106 +1,105 @@ -import Control.Applicative( (<$>), (<*>) ) -import Data.DateTime( diffSeconds ) -import Data.List.Split( splitOn ) -import Data.List( zipWith4, transpose ) +import Control.Applicative( (<$>) ) +import Control.Monad( unless ) import qualified Data.Map as Map -import Data.Maybe( fromJust, fromMaybe ) -import Data.Time.Clock( UTCTime(..), secondsToDiffTime ) -import Data.Time.Format( parseTime, formatTime ) -import Data.Time.LocalTime( LocalTime(..), ZonedTime(..), zonedTimeToUTC, midnight, localDay ) -import Diddo.Entry( DiddoEntry(..) ) -import Diddo.Log( DiddoLogline(..) ) -import HMSTime( HMSTime(..), secondsToHMS ) +import Data.Time.Clock( UTCTime(..) ) +import Diddo( DiddoEntry(..), LogEntry(..), parseDiddoLogline, formatDiddoEntry, timestamp, logToDiddoEntry ) import System.Console.GetOpt import System.Environment( getArgs ) -import System.Exit -import System.IO( stderr, hPutStr, hPutStrLn ) -import System.Locale +import System.Exit( exitSuccess, exitFailure ) +import System.IO( stderr, hPutStr ) + +data Opt = Opt + { optVerbose :: Bool + , optVersion :: Bool + , optHelp :: Bool + , optInputFiles :: [String] + , optOutputFile :: String + , optInputFormat :: String + , optOutputFormat :: String + , optStartDate :: String + , optEndDate :: String + } + +defaultOpts :: Opt +defaultOpts = Opt + { optVerbose = False + , optVersion = False + , optHelp = False + , optInputFiles = [] + , optOutputFile = "" + , optInputFormat = "%FT%T%z" + , optOutputFormat = "%FT%T%z" + , optStartDate = "" + , optEndDate = "" + } + +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 DiddoEntries +mapToDiddoEntries :: Map.Map UTCTime Diddo.LogEntry -> Map.Map UTCTime Diddo.DiddoEntry +mapToDiddoEntries logmap = Map.mapWithKey toDddEntry logmap + where + toDddEntry key value = Diddo.logToDiddoEntry (preceedingTimestamp key) value + preceedingTimestamp x = case Map.lookupLT x logmap of + Just y -> fst y + Nothing -> fst $ Map.findMin logmap +-- SECTION: Map of logentries to Map of DiddoEntries -data Flag - = Verbose | Version - | Help - | InputFile String | OutputFile String - | InputFormat String | OutputFormat String - deriving Show - -options :: [OptDescr Flag] -options = - [ Option "v" ["verbose"] (NoArg Verbose) "More detailed output" - , Option "V" ["version"] (NoArg Version) "Display program version" - , Option "h" ["help"] (NoArg Help) "Display program version" - , Option "f" ["file"] (ReqArg InputFile "FILE") "Read from FILE" - , Option "w" ["output"] (ReqArg OutputFile "FILE") "Write to FILE" - , Option "i" ["informat"] (ReqArg InputFormat "FORMAT") "Parse dates in the given FORMAT" - , Option "o" ["outformat"] (ReqArg OutputFormat "FORMAT") "Output dates in the given FORMAT" - ] - -parseToZonedTime :: String -> String -> ZonedTime -parseToZonedTime format = fromMaybe (error "Input data broken.") . parseTime defaultTimeLocale format - -parseISOsecondsTime :: String -> ZonedTime -parseISOsecondsTime = parseToZonedTime $ iso8601DateFormat $ Just "%T%z" - -parseRFC822Time :: String -> ZonedTime -parseRFC822Time = parseToZonedTime rfc822DateFormat - -formatZonedTime :: String -> ZonedTime -> String -formatZonedTime = formatTime defaultTimeLocale - -utcTimesDeltas :: ZonedTime -> [UTCTime] -> [Integer] -utcTimesDeltas startTime timestamps = - let - startTimeUTC = zonedTimeToUTC startTime - relevantTimestamps = dropWhile (< startTimeUTC) timestamps - in - zipWith diffSeconds relevantTimestamps $ startTimeUTC : init relevantTimestamps +main :: IO () +main = do + -- SECTION: option processing + (givenOptions,args,errs) <- getArgs >>= return . getOpt Permute availableOptions -startOfDay :: ZonedTime -> ZonedTime -startOfDay time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time - where - day = localDay $ zonedTimeToLocalTime time + unless (null errs) $ do + mapM_ (hPutStr stderr) errs + exitFailure -parseToUTCFromZonedString :: String -> String -> UTCTime -parseToUTCFromZonedString fmt time = zonedTimeToUTC $ parseToZonedTime fmt time + effectiveOptions <- foldl (>>=) (return defaultOpts) givenOptions + -- SECTION: option processing -splitToMapOn :: String -> [String] -> Map.Map String [String] -splitToMapOn sep lines = Map.fromList $ map (listToTuple . splitOn sep) lines - where listToTuple (x:xs) = (x, xs) + dddLogEntries <- + map Diddo.parseDiddoLogline <$> case optInputFiles effectiveOptions of + files@(_:_) -> lines . concat <$> mapM readFile files + [] -> lines <$> getContents -logLinesToDiddohs :: String -> [String] -> [DiddoEntry] -logLinesToDiddohs inDateFmt logLines = let - loglineMap = splitToMapOn ";" logLines - zonedtimeEntryMap = Map.mapKeysMonotonic (parseToZonedTime inDateFmt) loglineMap - utctimeEntryMap = Map.mapKeys zonedTimeToUTC zonedtimeEntryMap - - timeStamps = Map.keys loglineMap - entryTexts = map head $ Map.elems loglineMap - parsedTimes = Map.keys zonedtimeEntryMap - - deltasHMS = map secondsToHMS $ utcTimesDeltas (startOfDay $ head parsedTimes) $ Map.keys utctimeEntryMap - in - zipWith4 DiddoEntry (formatZonedTime inDateFmt (startOfDay $ head parsedTimes) : init timeStamps) - timeStamps deltasHMS entryTexts - -readFilesToLines :: [String] -> IO [String] -readFilesToLines filenames = lines . concat <$> mapM readFile filenames - -main :: IO () -main = do - argv <- getArgs - - case getOpt Permute options argv of - (opts,args,[]) -> do - let - logFileNames = [file | InputFile file <- opts] - inDateFmt = head [fmt | InputFormat fmt <- opts] - - logLines <- readFilesToLines logFileNames + dddLogEntryMap = Map.fromList $ map (\diddo -> (Diddo.timestamp diddo, diddo)) dddLogEntries + diddoEntriesMap = mapToDiddoEntries dddLogEntryMap + inDateFmt = optInputFormat effectiveOptions + outDateFmt = optOutputFormat effectiveOptions - mapM_ print $ logLinesToDiddohs inDateFmt logLines + -- DEBUG + mapM_ putStrLn args + -- DEBUG - (_,_,errs) -> do - hPutStr stderr $ usageInfo header options - ioError (userError ('\n' : concat errs)) - where header = "Usage: diddohs [OPTION...]" + mapM_ (putStrLn . snd) $ Map.toAscList $ Map.map (Diddo.formatDiddoEntry outDateFmt) diddoEntriesMap