From: Hendrik Jaeger Date: Sun, 31 Aug 2014 00:57:05 +0000 (+0200) Subject: deleted: Diddo/Entry.hs X-Git-Tag: v0.1~2 X-Git-Url: https://git.netwichtig.de/gitweb/?a=commitdiff_plain;h=b094c1ea9aa6fab77ab74ecac4bea17e915c7544;p=user%2Fhenk%2Fcode%2Fhaskell%2Fdiddohs.git deleted: Diddo/Entry.hs renamed: Diddo.hs -> src/Diddo.hs renamed: diddohs.hs -> src/Main.hs cleanup, I guess, it’s been a while … basic functionality works it seems --- diff --git a/Diddo.hs b/Diddo.hs deleted file mode 100644 index 2100b25..0000000 --- a/Diddo.hs +++ /dev/null @@ -1,80 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Diddo -( LogEntry(LogEntry) -, Diddo(Diddo) -, formatDiddo -, parseDiddoLogline -, logToDiddo -, parseToZonedTime -) where - -import Data.Maybe( fromMaybe ) -import Data.Time.Clock( UTCTime(), NominalDiffTime(), diffUTCTime ) -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 - { timestamp :: UTCTime - , timezone :: TimeZone - , text :: T.Text - } - -data Diddo = Diddo - { startTime :: ZonedTime - , endTime :: ZonedTime - , comment :: T.Text - } - -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 - -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 -> (UTCTime, LogEntry) --- parseDiddoLogline' line = (ts, LogEntry ts tz string) - -parseDiddoLogline :: T.Text -> (UTCTime, LogEntry) -parseDiddoLogline line = (ts, LogEntry ts tz string) - where - (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 = 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 -> 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/Diddo/Entry.hs b/Diddo/Entry.hs deleted file mode 100644 index be9d13c..0000000 --- a/Diddo/Entry.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Diddo.Entry -( DiddoEntry(DiddoEntry) -) where - -import HMSTime( HMSTime ) -import Data.List( intercalate ) - -data DiddoEntry = DiddoEntry String String HMSTime String - -instance Show DiddoEntry where - show (DiddoEntry start finish delta entry) = intercalate ";" [start,finish,(show delta),entry] - diff --git a/diddohs.hs b/diddohs.hs deleted file mode 100644 index 6884d14..0000000 --- a/diddohs.hs +++ /dev/null @@ -1,114 +0,0 @@ -import Control.Applicative( (<$>) ) -import Control.Monad( unless ) -import Data.Time.Clock( UTCTime(..) ) -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( 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 - , 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 Diddos -logentryMapToDiddoMap :: Map.Map UTCTime Diddo.LogEntry -> Map.Map UTCTime Diddo.Diddo -logentryMapToDiddoMap logmap = Map.mapWithKey toDddEntry logmap - where - 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 - -- SECTION: option processing - (givenOptions,args,errs) <- getArgs >>= return . getOpt Permute availableOptions - - unless (null errs) $ do - mapM_ (hPutStr stderr) errs - 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 - - loglines <- case optInputFiles effectiveOptions of - files@(_:_) -> T.lines . T.concat <$> mapM TIO.readFile files - [] -> T.lines <$> TIO.getContents - - let - 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.formatDiddo outDateFmt) timestampDiddoMap - diff --git a/src/Diddo.hs b/src/Diddo.hs new file mode 100644 index 0000000..2100b25 --- /dev/null +++ b/src/Diddo.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Diddo +( LogEntry(LogEntry) +, Diddo(Diddo) +, formatDiddo +, parseDiddoLogline +, logToDiddo +, parseToZonedTime +) where + +import Data.Maybe( fromMaybe ) +import Data.Time.Clock( UTCTime(), NominalDiffTime(), diffUTCTime ) +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 + { timestamp :: UTCTime + , timezone :: TimeZone + , text :: T.Text + } + +data Diddo = Diddo + { startTime :: ZonedTime + , endTime :: ZonedTime + , comment :: T.Text + } + +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 + +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 -> (UTCTime, LogEntry) +-- parseDiddoLogline' line = (ts, LogEntry ts tz string) + +parseDiddoLogline :: T.Text -> (UTCTime, LogEntry) +parseDiddoLogline line = (ts, LogEntry ts tz string) + where + (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 = 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 -> 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/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..6884d14 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,114 @@ +import Control.Applicative( (<$>) ) +import Control.Monad( unless ) +import Data.Time.Clock( UTCTime(..) ) +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( 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 + , 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 Diddos +logentryMapToDiddoMap :: Map.Map UTCTime Diddo.LogEntry -> Map.Map UTCTime Diddo.Diddo +logentryMapToDiddoMap logmap = Map.mapWithKey toDddEntry logmap + where + 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 + -- SECTION: option processing + (givenOptions,args,errs) <- getArgs >>= return . getOpt Permute availableOptions + + unless (null errs) $ do + mapM_ (hPutStr stderr) errs + 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 + + loglines <- case optInputFiles effectiveOptions of + files@(_:_) -> T.lines . T.concat <$> mapM TIO.readFile files + [] -> T.lines <$> TIO.getContents + + let + 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.formatDiddo outDateFmt) timestampDiddoMap +