From 95d1857e437aa09e1161be075c654c50afd91dd8 Mon Sep 17 00:00:00 2001 From: Hendrik Jaeger Date: Sun, 30 Mar 2014 23:25:26 +0200 Subject: [PATCH] On branch master modified: Diddo.hs modified: diddohs.hs --- Diddo.hs | 70 ++++++++++++++++++++++++++++++------------------- diddohs.hs | 77 +++++++++++++++++++++++++++++------------------------- 2 files changed, 85 insertions(+), 62 deletions(-) diff --git a/Diddo.hs b/Diddo.hs index 745d036..2100b25 100644 --- a/Diddo.hs +++ b/Diddo.hs @@ -1,19 +1,21 @@ +{-# LANGUAGE OverloadedStrings #-} + module Diddo ( LogEntry(LogEntry) -, DiddoEntry(DiddoEntry) +, Diddo(Diddo) +, formatDiddo , parseDiddoLogline -, formatDiddoEntry -, timestamp -, logToDiddoEntry +, logToDiddo +, parseToZonedTime ) where -import Data.DateTime( diffSeconds ) import Data.Maybe( fromMaybe ) import Data.Time.Clock( UTCTime(), NominalDiffTime(), diffUTCTime ) -import Data.Time.Format( parseTime, formatTime ) -import Data.Time.LocalTime( TimeZone() ) -import Data.Time.LocalTime( ZonedTime(..), zonedTimeToUTC, utcToZonedTime ) +import Data.Time.Format( FormatTime(), parseTime, formatTime ) +import Data.Time.LocalTime( TimeZone(), ZonedTime(..), zonedTimeToUTC, utcToZonedTime ) +import Text.Parsec import System.Locale +import Text.Printf( printf ) import qualified Data.Text as T data LogEntry = LogEntry @@ -22,42 +24,56 @@ data LogEntry = LogEntry , text :: T.Text } -data DiddoEntry = DiddoEntry +data Diddo = Diddo { startTime :: ZonedTime , endTime :: ZonedTime , comment :: T.Text } -formatDiddoEntry :: String -> DiddoEntry -> T.Text -formatDiddoEntry format entry = T.intercalate (T.pack ";") - [ T.pack $ formatTime defaultTimeLocale format (startTime entry) - , T.pack $ formatTime defaultTimeLocale format (endTime entry) - , T.pack $ diffTimeToHMSString $ diffUTCTime (zonedTimeToUTC (endTime entry)) (zonedTimeToUTC (startTime entry)) - , comment entry - ] +getTimestamp :: Diddo -> UTCTime +getTimestamp = zonedTimeToUTC . endTime + +formatDiddo :: String -> Diddo -> T.Text +formatDiddo format (Diddo start end text) = T.intercalate ";" diddoline + where + diddoline = [startZonedString, endZonedString, delta, text] + startZonedString = timeToText format start + endZonedString = timeToText format end + startUTC = zonedTimeToUTC start + endUTC = zonedTimeToUTC end + delta = diffTimeToHMSString $ diffUTCTime endUTC startUTC + +timeToText :: FormatTime a => String -> a -> T.Text +timeToText format = T.pack . formatTime defaultTimeLocale format -logToDiddoEntry :: UTCTime -> LogEntry -> DiddoEntry -logToDiddoEntry startutc logentry = DiddoEntry startZoned endZoned $ text logentry +logToDiddo :: UTCTime -> LogEntry -> Diddo +logToDiddo startutc logentry = Diddo startZoned endZoned $ text logentry where startZoned = utcToZonedTime (timezone logentry) startutc endZoned = utcToZonedTime (timezone logentry) $ timestamp logentry -parseDiddoLogline :: T.Text -> LogEntry -parseDiddoLogline line = LogEntry ts tz string +-- parseDiddoLogline' :: T.Text -> (UTCTime, LogEntry) +-- parseDiddoLogline' line = (ts, LogEntry ts tz string) + +parseDiddoLogline :: T.Text -> (UTCTime, LogEntry) +parseDiddoLogline line = (ts, LogEntry ts tz string) where - splitLine = T.splitOn (T.pack ";") line - string = T.intercalate (T.pack ";") $ tail splitLine - time = parseISOsecondsTime $ head splitLine - (ts,tz) = (zonedTimeToUTC time, zonedTimeZone time) + (timestring:strings) = T.splitOn ";" line + string = T.intercalate ";" strings + time = parseISOsecondsTime timestring + (ts,tz) = (zonedTimeToUTC time, zonedTimeZone time) parseToZonedTime :: String -> String -> ZonedTime -parseToZonedTime format string = fromMaybe (error $ "Input data broken: " ++ string) $ parseTime defaultTimeLocale format string +parseToZonedTime format string = zt + where + zt = fromMaybe (error $ "Input data broken: " ++ string) parsedTime + parsedTime = parseTime defaultTimeLocale format string parseISOsecondsTime :: T.Text -> ZonedTime parseISOsecondsTime timestring = parseToZonedTime (iso8601DateFormat $ Just "%T%z") $ T.unpack timestring -diffTimeToHMSString :: NominalDiffTime -> String -diffTimeToHMSString delta = printf "%d:%02d:%02d" h m s +diffTimeToHMSString :: NominalDiffTime -> T.Text +diffTimeToHMSString delta = T.pack $ printf "%d:%02d:%02d" h m s where (mLeft, s) = floor delta `divMod` 60 :: (Int, Int) (h, m) = mLeft `divMod` 60 diff --git a/diddohs.hs b/diddohs.hs index 026ce16..6884d14 100644 --- a/diddohs.hs +++ b/diddohs.hs @@ -1,7 +1,8 @@ import Control.Applicative( (<$>) ) import Control.Monad( unless ) import Data.Time.Clock( UTCTime(..) ) -import Diddo( DiddoEntry(..), LogEntry(..), parseDiddoLogline, formatDiddoEntry, timestamp, logToDiddoEntry ) +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 ) @@ -24,56 +25,56 @@ 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: Map of logentries to Map of DiddoEntries -mapToDiddoEntries :: Map.Map UTCTime Diddo.LogEntry -> Map.Map UTCTime Diddo.DiddoEntry -mapToDiddoEntries logmap = Map.mapWithKey toDddEntry logmap +-- 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.logToDiddoEntry (preceedingTimestamp key) value - preceedingTimestamp x = case Map.lookupLT x logmap of - Just y -> fst y - Nothing -> fst $ Map.findMin logmap + 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 () @@ -86,22 +87,28 @@ main = do 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 - dddLogEntries <- - map Diddo.parseDiddoLogline <$> case optInputFiles effectiveOptions of - files@(_:_) -> T.lines . T.concat <$> mapM TIO.readFile files - [] -> T.lines <$> TIO.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_ (TIO.putStrLn . snd) $ Map.toAscList $ Map.map (Diddo.formatDiddoEntry outDateFmt) diddoEntriesMap + mapM_ (TIO.putStrLn . snd) $ Map.toAscList $ Map.map (Diddo.formatDiddo outDateFmt) timestampDiddoMap -- 2.39.2