diff options
| -rw-r--r-- | Diddo/Entry.hs | 9 | ||||
| -rw-r--r-- | HMSTime.hs | 7 | ||||
| -rw-r--r-- | diddohs.hs | 162 |
3 files changed, 110 insertions, 68 deletions
diff --git a/Diddo/Entry.hs b/Diddo/Entry.hs index f6eda25..be9d13c 100644 --- a/Diddo/Entry.hs +++ b/Diddo/Entry.hs @@ -1,16 +1,11 @@ module Diddo.Entry -( DiddoEntry(DiddoEntry, start, finish, delta, entry) +( DiddoEntry(DiddoEntry) ) where import HMSTime( HMSTime ) import Data.List( intercalate ) -data DiddoEntry = DiddoEntry - { start :: String - , finish :: String - , delta :: HMSTime - , entry :: String - } +data DiddoEntry = DiddoEntry String String HMSTime String instance Show DiddoEntry where show (DiddoEntry start finish delta entry) = intercalate ";" [start,finish,(show delta),entry] @@ -14,8 +14,8 @@ instance Show HMSTime where show (HMSTime h m s) = printf "%d:%02d:%02d" h m s secondsToHMS :: Integer -> HMSTime -secondsToHMS seconds = HMSTime h m s where - (mLeft, s) = seconds `divMod` 60 +secondsToHMS numSeconds = HMSTime h m s where + (mLeft, s) = numSeconds `divMod` 60 (h, m) = mLeft `divMod` 60 hmsTimeStringToHMSTime :: String -> HMSTime @@ -28,9 +28,6 @@ hmsTimeToSeconds (HMSTime {hours = h, minutes = m, seconds = s}) = h*3600 + m*60 hmsTimeStringToSeconds :: String -> Integer hmsTimeStringToSeconds = hmsTimeToSeconds . hmsTimeStringToHMSTime -hmsIntsToSeconds :: [Int] -> Int -hmsIntsToSeconds (h:m:s:_) = (3600*h + 60*m + s) - readInteger :: String -> Integer readInteger x = read x :: Integer @@ -1,106 +1,156 @@ -import Control.Applicative( (<$>), (<*>) ) +import Control.Applicative( (<$>) ) +import Control.Monad( when ) import Data.DateTime( diffSeconds ) import Data.List.Split( splitOn ) -import Data.List( zipWith4, transpose ) +import Data.List( zipWith4 ) import qualified Data.Map as Map -import Data.Maybe( fromJust, fromMaybe ) -import Data.Time.Clock( UTCTime(..), secondsToDiffTime ) +import Data.Maybe( fromMaybe, fromJust ) +import Data.Time.Clock( UTCTime(..) ) 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.LocalTime( LocalTime(..), ZonedTime(..), TimeZone(..), zonedTimeToUTC, midnight, localDay ) +import Diddo( DiddoEntry(..), DiddoLogline(..), DiddoParsed(..) ) +import HMSTime( secondsToHMS ) import System.Console.GetOpt import System.Environment( getArgs ) -import System.Exit +import System.Exit( exitSuccess ) import System.IO( stderr, hPutStr, hPutStrLn ) import System.Locale -data Flag - = Verbose | Version - | Help - | InputFile String | OutputFile String - | InputFormat String | OutputFormat String - deriving Show +data Opt + = Verbose | Version + | Help + | InputFile String | OutputFile String + | InputFormat String | OutputFormat String + | StartDate String | EndDate String + deriving (Show, Eq) -options :: [OptDescr Flag] +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 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" - ] + [ 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" + ] parseToZonedTime :: String -> String -> ZonedTime -parseToZonedTime format = fromMaybe (error "Input data broken.") . parseTime defaultTimeLocale format +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 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 + 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 - day = localDay $ zonedTimeToLocalTime time + where + day = localDay $ zonedTimeToLocalTime time + +startOfMonth :: ZonedTime -> ZonedTime +startOfMonth time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time + where + day = localDay $ zonedTimeToLocalTime time parseToUTCFromZonedString :: String -> String -> UTCTime parseToUTCFromZonedString fmt time = zonedTimeToUTC $ parseToZonedTime fmt time +linesFromFiles :: [String] -> IO [String] +linesFromFiles filenames = lines . concat <$> mapM readFile filenames + splitToMapOn :: String -> [String] -> Map.Map String [String] -splitToMapOn sep lines = Map.fromList $ map (listToTuple . splitOn sep) lines - where listToTuple (x:xs) = (x, xs) +splitToMapOn sep loglines = Map.fromList $ map (listToTuple . splitOn sep) loglines + where listToTuple (x:xs) = (x, xs) + listToTuple [] = ("",[""]) logLinesToDiddohs :: String -> [String] -> [DiddoEntry] logLinesToDiddohs inDateFmt logLines = let - loglineMap = splitToMapOn ";" logLines - zonedtimeEntryMap = Map.mapKeysMonotonic (parseToZonedTime inDateFmt) loglineMap - utctimeEntryMap = Map.mapKeys zonedTimeToUTC zonedtimeEntryMap + 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 + timeStamps = Map.keys loglineMap + entryTexts = map head $ Map.elems loglineMap + parsedTimes = Map.keys zonedtimeEntryMap - deltasHMS = map secondsToHMS $ utcTimesDeltas (startOfDay $ head parsedTimes) $ Map.keys utctimeEntryMap + deltasHMS = map secondsToHMS $ utcTimesDeltas (startOfDay $ head parsedTimes) $ Map.keys utctimeEntryMap in - zipWith4 DiddoEntry (formatZonedTime inDateFmt (startOfDay $ head parsedTimes) : init timeStamps) + zipWith4 DiddoEntry (formatZonedTime inDateFmt (startOfDay $ head parsedTimes) : init timeStamps) timeStamps deltasHMS entryTexts -readFilesToLines :: [String] -> IO [String] -readFilesToLines filenames = lines . concat <$> mapM readFile filenames +--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 main :: IO () main = do - argv <- getArgs + 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] + + logLines <- linesFromFiles logFileNames + + let + inDateFmt = head [fmt | InputFormat fmt <- opts] +-- reportPeriod = ( head [time | StartDate time <- opts] +-- , head [time | EndDate time <- opts] +-- ) + + -- DEBUG + mapM_ putStrLn args +-- putStrLn $ show reportPeriod + - case getOpt Permute options argv of - (opts,args,[]) -> do - let - logFileNames = [file | InputFile file <- opts] - inDateFmt = head [fmt | InputFormat fmt <- opts] + let + loglineMap = Map.unions $ map parseDddLog logLines + deltasHMS = map secondsToHMS $ utcTimesDeltas' $ fst (Map.findMin loglineMap) : Map.keys loglineMap - logLines <- readFilesToLines logFileNames + -- loglineMapReduced = Map.filterWithKey (\t _ -> t > startDay) loglineMap + -- diddoEntries = Map.foldrWithKey - mapM_ print $ logLinesToDiddohs inDateFmt logLines + 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...]" + (_,_,errs) -> do + hPutStr stderr $ usageInfo header options + ioError (userError ('\n' : concat errs)) + where header = "Usage: diddohs [OPTION...]" |