diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Diddo.hs | 80 | ||||
| -rw-r--r-- | src/Main.hs | 114 |
2 files changed, 194 insertions, 0 deletions
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 + |