X-Git-Url: https://git.netwichtig.de/gitweb/?a=blobdiff_plain;f=diddohs.hs;h=6884d1462cd52cb50d96fb6fc36c7b7dbf42fba4;hb=95d1857e437aa09e1161be075c654c50afd91dd8;hp=f6a8c8af0c7d5d7c224f0b0e30be2f24751fd820;hpb=08ebc81f4c3f63d809b9dce93a5e2f6ee5acc695;p=user%2Fhenk%2Fcode%2Fhaskell%2Fdiddohs.git diff --git a/diddohs.hs b/diddohs.hs index f6a8c8a..6884d14 100644 --- a/diddohs.hs +++ b/diddohs.hs @@ -1,20 +1,15 @@ -import Control.Applicative( (<$>), (<*>) ) -import Control.Monad( when, unless ) -import Data.DateTime( diffSeconds ) -import Data.List.Split( splitOn ) -import Data.List( zipWith4, intercalate ) -import qualified Data.Map as Map -import Data.Maybe( fromMaybe, fromJust ) +import Control.Applicative( (<$>) ) +import Control.Monad( unless ) import Data.Time.Clock( UTCTime(..) ) -import Data.Time.Format( parseTime, formatTime ) -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 Data.Time.LocalTime( TimeZone(), ZonedTime(..), zonedTimeToUTC, utcToZonedTime ) +import Diddo( Diddo(..), LogEntry(..), parseDiddoLogline, formatDiddo, logToDiddo, parseToZonedTime ) import System.Console.GetOpt import System.Environment( getArgs ) import System.Exit( exitSuccess, exitFailure ) -import System.IO( stdin, stdout, stderr, hPutStr, hPutStrLn ) -import System.Locale +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 Opt = Opt { optVerbose :: Bool @@ -30,125 +25,57 @@ data Opt = Opt defaultOpts :: Opt defaultOpts = Opt - { optVerbose = False - , optVersion = False - , optHelp = False - , optInputFiles = [] - , optOutputFile = "" - , optInputFormat = "%FT%T%z" - , optOutputFormat = "%FT%T%z" - , optStartDate = "" - , optEndDate = "" + { 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)) + (NoArg (\ _ -> putStrLn (usageInfo "Usage: diddohs [OPTION...]" availableOptions) >> exitSuccess)) "Display program help" , Option ['v'] ["verbose"] - (NoArg (\opts -> return opts { optVerbose = True })) + (NoArg (\ opts -> return opts { optVerbose = True })) "More detailed output" , Option ['V'] ["version"] - (NoArg (\opts -> return opts { optVersion = True })) + (NoArg (\ opts -> return opts { optVersion = True })) "Display program version" , Option ['f'] ["file"] - (ReqArg (\arg opts -> return opts { optInputFiles = optInputFiles opts ++ [arg]}) "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") + (ReqArg (\ arg opts -> return opts { optOutputFile = arg }) "FILE") "Write to FILE" , Option ['i'] ["informat"] - (ReqArg (\arg opts -> return opts { optInputFormat = arg }) "FORMAT") + (ReqArg (\ arg opts -> return opts { optInputFormat = arg }) "FORMAT") "Timeformat used in input" , Option ['o'] ["outformat"] - (ReqArg (\arg opts -> return opts { optOutputFormat = arg }) "FORMAT") + (ReqArg (\ arg opts -> return opts { optOutputFormat = arg }) "FORMAT") "Timeformat used in output" , Option ['s'] ["start"] - (ReqArg (\arg opts -> return opts { optStartDate = arg }) "DATE") + (ReqArg (\ arg opts -> return opts { optStartDate = arg }) "DATE") "Start of reporting period" , Option ['e'] ["end"] - (ReqArg (\arg opts -> return opts { optEndDate = arg }) "DATE") + (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" - -parseRFC822Time :: String -> ZonedTime -parseRFC822Time = parseToZonedTime rfc822DateFormat --- SECTION: parsing to ZonedTime - --- SECTION: handling ZonedTime -formatZonedTime :: String -> ZonedTime -> String -formatZonedTime = formatTime defaultTimeLocale - -startOfDay :: ZonedTime -> ZonedTime -startOfDay time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time +-- 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 - day = localDay $ zonedTimeToLocalTime time - -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 - --- 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) - listToTuple [] = ("",[""]) - -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 (intercalate ";") $ Map.elems loglineMap - parsedTimes = Map.keys zonedtimeEntryMap - - deltasHMS = map secondsToHMS $ utcTimesDeltas ((zonedTimeToUTC $ startOfDay $ head parsedTimes) : Map.keys utctimeEntryMap) - in - zipWith4 DiddoEntry (formatZonedTime inDateFmt (startOfDay $ head parsedTimes) : init timeStamps) - timeStamps deltasHMS entryTexts --- SECTION: handling rawinput + 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 = do @@ -160,31 +87,28 @@ main = do exitFailure effectiveOptions <- foldl (>>=) (return defaultOpts) givenOptions - -- SECTION: option processing - dddLines <- - map Diddo.LogLine <$> case optInputFiles effectiveOptions of - files@(_:_) -> lines . concat <$> mapM readFile files - [] -> lines <$> getContents + let + inDateFmt = optInputFormat effectiveOptions + outDateFmt = optOutputFormat effectiveOptions + + startDate = parseToZonedTime inDateFmt $ optStartDate effectiveOptions + endDate = parseToZonedTime inDateFmt $ optEndDate effectiveOptions + -- SECTION: option processing - dddLogEntries <- - map Diddo.parseDiddoLogline <$> case optInputFiles effectiveOptions of - files@(_:_) -> lines . concat <$> mapM readFile files - [] -> lines <$> getContents + loglines <- case optInputFiles effectiveOptions of + files@(_:_) -> T.lines . T.concat <$> mapM TIO.readFile files + [] -> T.lines <$> TIO.getContents let - dddLogEntryMap = Map.fromList $ map (\diddo -> (Diddo.timestamp diddo, diddo)) dddLogEntries - diddoEntriesMap = mapToDiddoEntries dddLogEntryMap - inDateFmt = optInputFormat effectiveOptions - outDateFmt = optOutputFormat effectiveOptions + 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_ 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 + mapM_ (TIO.putStrLn . snd) $ Map.toAscList $ Map.map (Diddo.formatDiddo outDateFmt) timestampDiddoMap