From: Hendrik Jaeger Date: Sat, 8 Mar 2014 03:29:01 +0000 (+0100) Subject: On branch master X-Git-Tag: v0.1~7 X-Git-Url: https://git.netwichtig.de/gitweb/?a=commitdiff_plain;h=08ebc81f4c3f63d809b9dce93a5e2f6ee5acc695;p=user%2Fhenk%2Fcode%2Fhaskell%2Fdiddohs.git On branch master new file: Diddo.hs * ADDED: module for handling diddohs modified: diddohs.hs * CHANGED: another major rewrite of the core functionality --- diff --git a/Diddo.hs b/Diddo.hs new file mode 100644 index 0000000..cbbbce0 --- /dev/null +++ b/Diddo.hs @@ -0,0 +1,87 @@ +module Diddo +( LogLine(LogLine) +, LogEntry(LogEntry) +, DiddoEntry(DiddoEntry) +, DiddoEntry2(DiddoEntry2) +, parseDiddoLogline +, formatDiddoEntry +, timestamp +, logToDiddoEntry +) where + +import HMSTime( HMSTime, secondsToHMS ) +import Data.List( intercalate ) +import Data.DateTime( diffSeconds ) +import Data.Time.LocalTime( TimeZone() ) +import Data.Time.Clock( UTCTime() ) +import Data.Maybe( fromMaybe, fromJust ) +import Data.Time.Format( parseTime, formatTime ) +import Data.Time.LocalTime( LocalTime(..), ZonedTime(..), TimeZone(..), zonedTimeToUTC, utcToZonedTime, midnight, localDay ) +import Data.List.Split( splitOn ) +import System.Locale + +data LogLine + = LogLine String + +instance Show LogLine where + show (LogLine x) = x + +data LogEntry + = LogEntry + { timestamp :: UTCTime + , timezone :: TimeZone + , text :: String + } + +instance Show LogEntry where + show x = (show $ timestamp x) ++ (show $ timezone x) ++ text x + +data DiddoEntry = DiddoEntry String String HMSTime String + +data DiddoEntry2 = DiddoEntry2 + { startTime :: ZonedTime + , endTime :: ZonedTime + , comment :: String + } + +instance Show DiddoEntry where + show (DiddoEntry start finish delta entry) = intercalate ";" [start,finish,(show delta),entry] + +instance Show DiddoEntry2 where + show (DiddoEntry2 start finish entry) = intercalate ";" [show start,show finish,show $ diffSeconds (zonedTimeToUTC finish) (zonedTimeToUTC start),entry] + +formatDiddoEntry :: String -> DiddoEntry2 -> String +formatDiddoEntry format (DiddoEntry2 start end comment) = (formatTime defaultTimeLocale format start) ++ ";" ++ (formatTime defaultTimeLocale format end) ++ ";" ++ (show $ secondsToHMS $ diffSeconds (zonedTimeToUTC end) (zonedTimeToUTC start)) ++ ";" ++ comment + +logToDiddoEntry :: UTCTime -> LogEntry -> DiddoEntry2 +logToDiddoEntry startutc logentry = DiddoEntry2 startZoned endZoned $ text logentry + where + startZoned = utcToZonedTime (timezone logentry) startutc + endZoned = utcToZonedTime (timezone logentry) $ timestamp logentry + + +lineToEntry :: LogLine -> LogEntry +lineToEntry (LogLine line) = LogEntry ts tz text + where + splitLine = splitOn ";" line + text = intercalate ";" $ tail splitLine + time = parseISOsecondsTime $ head splitLine + (ts,tz) = (zonedTimeToUTC time, zonedTimeZone time) + +parseDiddoLogline :: String -> LogEntry +parseDiddoLogline line = LogEntry ts tz text + where + splitLine = splitOn ";" line + text = intercalate ";" $ tail splitLine + time = parseISOsecondsTime $ head splitLine + (ts,tz) = (zonedTimeToUTC time, zonedTimeZone time) + + + + +parseToZonedTime :: String -> String -> ZonedTime +parseToZonedTime format string = fromMaybe (error $ "Input data broken: " ++ string) $ parseTime defaultTimeLocale format string + +parseISOsecondsTime :: String -> ZonedTime +parseISOsecondsTime = parseToZonedTime $ iso8601DateFormat $ Just "%T%z" + diff --git a/diddohs.hs b/diddohs.hs index 3f92359..f6a8c8a 100644 --- a/diddohs.hs +++ b/diddohs.hs @@ -1,71 +1,92 @@ -import Control.Applicative( (<$>) ) -import Control.Monad( when ) +import Control.Applicative( (<$>), (<*>) ) +import Control.Monad( when, unless ) import Data.DateTime( diffSeconds ) import Data.List.Split( splitOn ) -import Data.List( zipWith4 ) +import Data.List( zipWith4, intercalate ) import qualified Data.Map as Map import Data.Maybe( fromMaybe, fromJust ) import Data.Time.Clock( UTCTime(..) ) import Data.Time.Format( parseTime, formatTime ) -import Data.Time.LocalTime( LocalTime(..), ZonedTime(..), TimeZone(..), zonedTimeToUTC, midnight, localDay ) -import Diddo( DiddoEntry(..), DiddoLogline(..), DiddoParsed(..) ) +import Data.Time.LocalTime( LocalTime(..), ZonedTime(..), TimeZone(..), zonedTimeToUTC, utcToZonedTime, midnight, localDay ) +import Diddo( DiddoEntry(..), DiddoEntry2(..), LogEntry(..), LogLine(..), parseDiddoLogline, formatDiddoEntry, timestamp, logToDiddoEntry ) import HMSTime( secondsToHMS ) import System.Console.GetOpt import System.Environment( getArgs ) -import System.Exit( exitSuccess ) -import System.IO( stderr, hPutStr, hPutStrLn ) +import System.Exit( exitSuccess, exitFailure ) +import System.IO( stdin, stdout, stderr, hPutStr, hPutStrLn ) import System.Locale -data Opt - = Verbose | Version - | Help - | InputFile String | OutputFile String - | InputFormat String | OutputFormat String - | StartDate String | EndDate String - deriving (Show, Eq) - -options :: [OptDescr Opt] -options = - [ Option "v" ["verbose"] (NoArg Verbose) "More detailed output" - , Option "V" ["version"] (NoArg Version) "Display program version" - , Option "h" ["help"] (NoArg Help) "Display program help" - , Option "f" ["file"] (ReqArg InputFile "FILE") "Read from FILE" - , Option "w" ["output"] (ReqArg OutputFile "FILE") "Write to FILE" - , Option "i" ["informat"] (ReqArg InputFormat "FORMAT") "Timeformat used in input" - , Option "o" ["outformat"] (ReqArg OutputFormat "FORMAT") "Timeformat used in output" - , Option "s" ["start"] (ReqArg StartDate "DATE") "Start of reporting period" - , Option "e" ["end"] (ReqArg EndDate "DATE") "End of reporting period" +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: parsing to ZonedTime parseToZonedTime :: String -> String -> ZonedTime parseToZonedTime format string = fromMaybe (error $ "Input data broken: " ++ string) $ parseTime defaultTimeLocale format string parseISOsecondsTime :: String -> ZonedTime parseISOsecondsTime = parseToZonedTime $ iso8601DateFormat $ Just "%T%z" -zonedToUTCandTZ :: ZonedTime -> (UTCTime, TimeZone) -zonedToUTCandTZ zt = (zonedTimeToUTC zt, zonedTimeZone zt) - parseRFC822Time :: String -> ZonedTime parseRFC822Time = parseToZonedTime rfc822DateFormat +-- SECTION: parsing to ZonedTime +-- SECTION: handling ZonedTime formatZonedTime :: String -> ZonedTime -> String formatZonedTime = formatTime defaultTimeLocale -utcTimesDeltas' :: [UTCTime] -> [Integer] -utcTimesDeltas' [] = error "Function utcTimesDeltas' called with no argument" -utcTimesDeltas' [_] = error "Function utcTimesDeltas' called with bougus argument" -utcTimesDeltas' (x:y:[]) = [diffSeconds y x] -utcTimesDeltas' (x:y:xs) = diffSeconds y x : utcTimesDeltas' (y:xs) - -utcTimesDeltas :: ZonedTime -> [UTCTime] -> [Integer] -utcTimesDeltas startTime timestamps = - let - startTimeUTC = zonedTimeToUTC startTime - relevantTimestamps = dropWhile (< startTimeUTC) timestamps - in - zipWith diffSeconds relevantTimestamps $ startTimeUTC : init relevantTimestamps - startOfDay :: ZonedTime -> ZonedTime startOfDay time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time where @@ -75,13 +96,38 @@ startOfMonth :: ZonedTime -> ZonedTime startOfMonth time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time where day = localDay $ zonedTimeToLocalTime time +-- SECTION: handling ZonedTime + +-- SECTION: handling UTCTime +utcTimesDeltas :: [UTCTime] -> [Integer] +utcTimesDeltas [] = error "Function utcTimesDeltas called with no argument" +utcTimesDeltas [_] = error "Function utcTimesDeltas called with bougus argument" +utcTimesDeltas (x:y:[]) = [diffSeconds y x] +utcTimesDeltas (x:y:xs) = diffSeconds y x : utcTimesDeltas (y:xs) + +--deltaAndEntry :: Map UTCTime Diddo.LogLine -> DiddoEntry2 +--deltaAndEntry dddLoglineMap = Map.mapWithKey findDeltaEntry dddLoglineMap +-- where +-- precEntry = case Map.lookupLT (Diddo.timestamp logentry) dddLoglineMap of +-- Just x -> x +-- Nothing -> Diddo.timestamp logentry +-- end = utcToZonedTime (Diddo.timezone logentry) (Diddo.timestamp logentry) +-- start = utcToZonedTime (Diddo.timezone logentry) (fst precEntry) +-- delta = diffSeconds end start +-- comment = Diddo.text logentry +-- +--findDeltaEntry timestamp logentry = Diddo.DiddoEntry2 start end delta comment + +mapToDiddoEntries :: Map.Map UTCTime Diddo.LogEntry -> Map.Map UTCTime Diddo.DiddoEntry2 +mapToDiddoEntries logmap = Map.mapWithKey toDddEntry logmap + where + toDddEntry timestamp logentry = Diddo.logToDiddoEntry (preceedingTimestamp timestamp) logentry + preceedingTimestamp x = case Map.lookupLT x logmap of + Just y -> fst y + Nothing -> fst $ Map.findMin logmap +-- SECTION: handling UTCTime -parseToUTCFromZonedString :: String -> String -> UTCTime -parseToUTCFromZonedString fmt time = zonedTimeToUTC $ parseToZonedTime fmt time - -linesFromFiles :: [String] -> IO [String] -linesFromFiles filenames = lines . concat <$> mapM readFile filenames - +-- SECTION: handling rawinput splitToMapOn :: String -> [String] -> Map.Map String [String] splitToMapOn sep loglines = Map.fromList $ map (listToTuple . splitOn sep) loglines where listToTuple (x:xs) = (x, xs) @@ -95,62 +141,50 @@ logLinesToDiddohs inDateFmt logLines = utctimeEntryMap = Map.mapKeys zonedTimeToUTC zonedtimeEntryMap timeStamps = Map.keys loglineMap - entryTexts = map head $ Map.elems loglineMap + entryTexts = map (intercalate ";") $ Map.elems loglineMap parsedTimes = Map.keys zonedtimeEntryMap - deltasHMS = map secondsToHMS $ utcTimesDeltas (startOfDay $ head parsedTimes) $ Map.keys utctimeEntryMap + deltasHMS = map secondsToHMS $ utcTimesDeltas ((zonedTimeToUTC $ startOfDay $ head parsedTimes) : Map.keys utctimeEntryMap) in zipWith4 DiddoEntry (formatZonedTime inDateFmt (startOfDay $ head parsedTimes) : init timeStamps) timeStamps deltasHMS entryTexts - ---parsedLinesToDiddohs :: String -> Map.Map UTCTime DiddoParsed -> [DiddoEntry] ---parsedLinesToDiddohs inDateFmt parsedLines = --- Map.foldrWithKey (\t e ts -> ) - -parseDddLog :: String -> Map.Map UTCTime DiddoParsed -parseDddLog line = - Map.singleton timestamp $ DiddoParsed timestamp zt entry - where - (timestring:entry:_) = splitOn ";" line - (timestamp,zt) = zonedToUTCandTZ $ parseISOsecondsTime timestring +-- SECTION: handling rawinput main :: IO () main = do - argv <- getArgs - - case getOpt Permute options argv of - (opts,args,[]) -> do - when (Help `elem` opts) $ - (putStrLn $ usageInfo "Usage: diddohs [OPTION...]" options) >> exitSuccess - - let - logFileNames = [file | InputFile file <- opts] + -- SECTION: option processing + (givenOptions,args,errs) <- getArgs >>= return . getOpt Permute availableOptions - logLines <- linesFromFiles logFileNames + unless (null errs) $ do + mapM_ (hPutStr stderr) errs + exitFailure - let - inDateFmt = head [fmt | InputFormat fmt <- opts] --- reportPeriod = ( head [time | StartDate time <- opts] --- , head [time | EndDate time <- opts] --- ) + effectiveOptions <- foldl (>>=) (return defaultOpts) givenOptions + -- SECTION: option processing - -- DEBUG - mapM_ putStrLn args --- putStrLn $ show reportPeriod + dddLines <- + map Diddo.LogLine <$> case optInputFiles effectiveOptions of + files@(_:_) -> lines . concat <$> mapM readFile files + [] -> lines <$> getContents + dddLogEntries <- + map Diddo.parseDiddoLogline <$> case optInputFiles effectiveOptions of + files@(_:_) -> lines . concat <$> mapM readFile files + [] -> lines <$> getContents - let - loglineMap = Map.unions $ map parseDddLog logLines - deltasHMS = map secondsToHMS $ utcTimesDeltas' $ fst (Map.findMin loglineMap) : Map.keys loglineMap - - -- loglineMapReduced = Map.filterWithKey (\t _ -> t > startDay) loglineMap - -- diddoEntries = Map.foldrWithKey - - mapM_ print $ logLinesToDiddohs inDateFmt logLines --- mapM_ print deltasHMS - - (_,_,errs) -> do - hPutStr stderr $ usageInfo header options - ioError (userError ('\n' : concat errs)) - where header = "Usage: diddohs [OPTION...]" + let + dddLogEntryMap = Map.fromList $ map (\diddo -> (Diddo.timestamp diddo, diddo)) dddLogEntries + diddoEntriesMap = mapToDiddoEntries dddLogEntryMap + inDateFmt = optInputFormat effectiveOptions + outDateFmt = optOutputFormat effectiveOptions + + -- DEBUG + mapM_ putStrLn args + -- DEBUG + + mapM_ print $ logLinesToDiddohs inDateFmt (map show dddLines) +-- putStrLn "new code output following" +-- mapM_ (print . snd) $ Map.toAscList diddoEntriesMap + putStrLn "new code output following" + mapM_ (putStrLn . snd) $ Map.toAscList $ Map.map (Diddo.formatDiddoEntry outDateFmt) diddoEntriesMap