--- /dev/null
+module Diddo
+( LogLine(LogLine)
+, LogEntry(LogEntry)
+, DiddoEntry(DiddoEntry)
+, DiddoEntry2(DiddoEntry2)
+, parseDiddoLogline
+, formatDiddoEntry
+, timestamp
+, logToDiddoEntry
+) where
+
+import HMSTime( HMSTime, secondsToHMS )
+import Data.List( intercalate )
+import Data.DateTime( diffSeconds )
+import Data.Time.LocalTime( TimeZone() )
+import Data.Time.Clock( UTCTime() )
+import Data.Maybe( fromMaybe, fromJust )
+import Data.Time.Format( parseTime, formatTime )
+import Data.Time.LocalTime( LocalTime(..), ZonedTime(..), TimeZone(..), zonedTimeToUTC, utcToZonedTime, midnight, localDay )
+import Data.List.Split( splitOn )
+import System.Locale
+
+data LogLine
+ = LogLine String
+
+instance Show LogLine where
+ show (LogLine x) = x
+
+data LogEntry
+ = LogEntry
+ { timestamp :: UTCTime
+ , timezone :: TimeZone
+ , text :: String
+ }
+
+instance Show LogEntry where
+ show x = (show $ timestamp x) ++ (show $ timezone x) ++ text x
+
+data DiddoEntry = DiddoEntry String String HMSTime String
+
+data DiddoEntry2 = DiddoEntry2
+ { startTime :: ZonedTime
+ , endTime :: ZonedTime
+ , comment :: String
+ }
+
+instance Show DiddoEntry where
+ show (DiddoEntry start finish delta entry) = intercalate ";" [start,finish,(show delta),entry]
+
+instance Show DiddoEntry2 where
+ show (DiddoEntry2 start finish entry) = intercalate ";" [show start,show finish,show $ diffSeconds (zonedTimeToUTC finish) (zonedTimeToUTC start),entry]
+
+formatDiddoEntry :: String -> DiddoEntry2 -> String
+formatDiddoEntry format (DiddoEntry2 start end comment) = (formatTime defaultTimeLocale format start) ++ ";" ++ (formatTime defaultTimeLocale format end) ++ ";" ++ (show $ secondsToHMS $ diffSeconds (zonedTimeToUTC end) (zonedTimeToUTC start)) ++ ";" ++ comment
+
+logToDiddoEntry :: UTCTime -> LogEntry -> DiddoEntry2
+logToDiddoEntry startutc logentry = DiddoEntry2 startZoned endZoned $ text logentry
+ where
+ startZoned = utcToZonedTime (timezone logentry) startutc
+ endZoned = utcToZonedTime (timezone logentry) $ timestamp logentry
+
+
+lineToEntry :: LogLine -> LogEntry
+lineToEntry (LogLine line) = LogEntry ts tz text
+ where
+ splitLine = splitOn ";" line
+ text = intercalate ";" $ tail splitLine
+ time = parseISOsecondsTime $ head splitLine
+ (ts,tz) = (zonedTimeToUTC time, zonedTimeZone time)
+
+parseDiddoLogline :: String -> LogEntry
+parseDiddoLogline line = LogEntry ts tz text
+ where
+ splitLine = splitOn ";" line
+ text = intercalate ";" $ tail splitLine
+ time = parseISOsecondsTime $ head splitLine
+ (ts,tz) = (zonedTimeToUTC time, zonedTimeZone time)
+
+
+
+
+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"
+
-import Control.Applicative( (<$>) )
-import Control.Monad( when )
+import Control.Applicative( (<$>), (<*>) )
+import Control.Monad( when, unless )
import Data.DateTime( diffSeconds )
import Data.List.Split( splitOn )
-import Data.List( zipWith4 )
+import Data.List( zipWith4, intercalate )
import qualified Data.Map as Map
import Data.Maybe( fromMaybe, fromJust )
import Data.Time.Clock( UTCTime(..) )
import Data.Time.Format( parseTime, formatTime )
-import Data.Time.LocalTime( LocalTime(..), ZonedTime(..), TimeZone(..), zonedTimeToUTC, midnight, localDay )
-import Diddo( DiddoEntry(..), DiddoLogline(..), DiddoParsed(..) )
+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 System.Console.GetOpt
import System.Environment( getArgs )
-import System.Exit( exitSuccess )
-import System.IO( stderr, hPutStr, hPutStrLn )
+import System.Exit( exitSuccess, exitFailure )
+import System.IO( stdin, stdout, stderr, hPutStr, hPutStrLn )
import System.Locale
-data Opt
- = Verbose | Version
- | Help
- | InputFile String | OutputFile String
- | InputFormat String | OutputFormat String
- | StartDate String | EndDate String
- deriving (Show, Eq)
-
-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 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"
+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: 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"
-zonedToUTCandTZ :: ZonedTime -> (UTCTime, TimeZone)
-zonedToUTCandTZ zt = (zonedTimeToUTC zt, zonedTimeZone zt)
-
parseRFC822Time :: String -> ZonedTime
parseRFC822Time = parseToZonedTime rfc822DateFormat
+-- SECTION: parsing to ZonedTime
+-- SECTION: handling ZonedTime
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
-
startOfDay :: ZonedTime -> ZonedTime
startOfDay time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time
where
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
-parseToUTCFromZonedString :: String -> String -> UTCTime
-parseToUTCFromZonedString fmt time = zonedTimeToUTC $ parseToZonedTime fmt time
-
-linesFromFiles :: [String] -> IO [String]
-linesFromFiles filenames = lines . concat <$> mapM readFile filenames
-
+-- 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)
utctimeEntryMap = Map.mapKeys zonedTimeToUTC zonedtimeEntryMap
timeStamps = Map.keys loglineMap
- entryTexts = map head $ Map.elems loglineMap
+ entryTexts = map (intercalate ";") $ Map.elems loglineMap
parsedTimes = Map.keys zonedtimeEntryMap
- deltasHMS = map secondsToHMS $ utcTimesDeltas (startOfDay $ head parsedTimes) $ Map.keys utctimeEntryMap
+ deltasHMS = map secondsToHMS $ utcTimesDeltas ((zonedTimeToUTC $ startOfDay $ head parsedTimes) : Map.keys utctimeEntryMap)
in
zipWith4 DiddoEntry (formatZonedTime inDateFmt (startOfDay $ head parsedTimes) : init timeStamps)
timeStamps deltasHMS entryTexts
-
---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
+-- SECTION: handling rawinput
main :: IO ()
main = do
- 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]
+ -- SECTION: option processing
+ (givenOptions,args,errs) <- getArgs >>= return . getOpt Permute availableOptions
- logLines <- linesFromFiles logFileNames
+ unless (null errs) $ do
+ mapM_ (hPutStr stderr) errs
+ exitFailure
- let
- inDateFmt = head [fmt | InputFormat fmt <- opts]
--- reportPeriod = ( head [time | StartDate time <- opts]
--- , head [time | EndDate time <- opts]
--- )
+ effectiveOptions <- foldl (>>=) (return defaultOpts) givenOptions
+ -- SECTION: option processing
- -- DEBUG
- mapM_ putStrLn args
--- putStrLn $ show reportPeriod
+ dddLines <-
+ map Diddo.LogLine <$> case optInputFiles effectiveOptions of
+ files@(_:_) -> lines . concat <$> mapM readFile files
+ [] -> lines <$> getContents
+ dddLogEntries <-
+ map Diddo.parseDiddoLogline <$> case optInputFiles effectiveOptions of
+ files@(_:_) -> lines . concat <$> mapM readFile files
+ [] -> lines <$> getContents
- let
- loglineMap = Map.unions $ map parseDddLog logLines
- deltasHMS = map secondsToHMS $ utcTimesDeltas' $ fst (Map.findMin loglineMap) : Map.keys loglineMap
-
- -- loglineMapReduced = Map.filterWithKey (\t _ -> t > startDay) loglineMap
- -- diddoEntries = Map.foldrWithKey
-
- 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...]"
+ let
+ dddLogEntryMap = Map.fromList $ map (\diddo -> (Diddo.timestamp diddo, diddo)) dddLogEntries
+ diddoEntriesMap = mapToDiddoEntries dddLogEntryMap
+ inDateFmt = optInputFormat effectiveOptions
+ outDateFmt = optOutputFormat effectiveOptions
+
+ -- 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
projects / user / henk / code / haskell / diddohs.git / commitdiff