summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHendrik Jaeger <henk@frustcomp>2014-02-02 23:14:41 +0100
committerHendrik Jaeger <henk@frustcomp>2014-02-02 23:14:41 +0100
commit84282f6317c0c1249c009469f75916acc69c1571 (patch)
tree0ab46a64cbf59225c4b00dc1011e5a409cef4202
parent9d103749a11f458b8e6834faf37b955fc2818c2b (diff)
On branch master
modified: Diddo/Entry.hs modified: HMSTime.hs modified: diddohs.hs * CHANGED: mainly cleanup and some experimentation
-rw-r--r--Diddo/Entry.hs9
-rw-r--r--HMSTime.hs7
-rw-r--r--diddohs.hs162
3 files changed, 110 insertions, 68 deletions
diff --git a/Diddo/Entry.hs b/Diddo/Entry.hs
index f6eda25..be9d13c 100644
--- a/Diddo/Entry.hs
+++ b/Diddo/Entry.hs
@@ -1,16 +1,11 @@
module Diddo.Entry
-( DiddoEntry(DiddoEntry, start, finish, delta, entry)
+( DiddoEntry(DiddoEntry)
) where
import HMSTime( HMSTime )
import Data.List( intercalate )
-data DiddoEntry = DiddoEntry
- { start :: String
- , finish :: String
- , delta :: HMSTime
- , entry :: String
- }
+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/HMSTime.hs b/HMSTime.hs
index 6e903d3..cbe9e09 100644
--- a/HMSTime.hs
+++ b/HMSTime.hs
@@ -14,8 +14,8 @@ instance Show HMSTime where
show (HMSTime h m s) = printf "%d:%02d:%02d" h m s
secondsToHMS :: Integer -> HMSTime
-secondsToHMS seconds = HMSTime h m s where
- (mLeft, s) = seconds `divMod` 60
+secondsToHMS numSeconds = HMSTime h m s where
+ (mLeft, s) = numSeconds `divMod` 60
(h, m) = mLeft `divMod` 60
hmsTimeStringToHMSTime :: String -> HMSTime
@@ -28,9 +28,6 @@ hmsTimeToSeconds (HMSTime {hours = h, minutes = m, seconds = s}) = h*3600 + m*60
hmsTimeStringToSeconds :: String -> Integer
hmsTimeStringToSeconds = hmsTimeToSeconds . hmsTimeStringToHMSTime
-hmsIntsToSeconds :: [Int] -> Int
-hmsIntsToSeconds (h:m:s:_) = (3600*h + 60*m + s)
-
readInteger :: String -> Integer
readInteger x = read x :: Integer
diff --git a/diddohs.hs b/diddohs.hs
index 21bae07..3f92359 100644
--- a/diddohs.hs
+++ b/diddohs.hs
@@ -1,106 +1,156 @@
-import Control.Applicative( (<$>), (<*>) )
+import Control.Applicative( (<$>) )
+import Control.Monad( when )
import Data.DateTime( diffSeconds )
import Data.List.Split( splitOn )
-import Data.List( zipWith4, transpose )
+import Data.List( zipWith4 )
import qualified Data.Map as Map
-import Data.Maybe( fromJust, fromMaybe )
-import Data.Time.Clock( UTCTime(..), secondsToDiffTime )
+import Data.Maybe( fromMaybe, fromJust )
+import Data.Time.Clock( UTCTime(..) )
import Data.Time.Format( parseTime, formatTime )
-import Data.Time.LocalTime( LocalTime(..), ZonedTime(..), zonedTimeToUTC, midnight, localDay )
-import Diddo.Entry( DiddoEntry(..) )
-import Diddo.Log( DiddoLogline(..) )
-import HMSTime( HMSTime(..), secondsToHMS )
+import Data.Time.LocalTime( LocalTime(..), ZonedTime(..), TimeZone(..), zonedTimeToUTC, midnight, localDay )
+import Diddo( DiddoEntry(..), DiddoLogline(..), DiddoParsed(..) )
+import HMSTime( secondsToHMS )
import System.Console.GetOpt
import System.Environment( getArgs )
-import System.Exit
+import System.Exit( exitSuccess )
import System.IO( stderr, hPutStr, hPutStrLn )
import System.Locale
-data Flag
- = Verbose | Version
- | Help
- | InputFile String | OutputFile String
- | InputFormat String | OutputFormat String
- deriving Show
+data Opt
+ = Verbose | Version
+ | Help
+ | InputFile String | OutputFile String
+ | InputFormat String | OutputFormat String
+ | StartDate String | EndDate String
+ deriving (Show, Eq)
-options :: [OptDescr Flag]
+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 version"
- , Option "f" ["file"] (ReqArg InputFile "FILE") "Read from FILE"
- , Option "w" ["output"] (ReqArg OutputFile "FILE") "Write to FILE"
- , Option "i" ["informat"] (ReqArg InputFormat "FORMAT") "Parse dates in the given FORMAT"
- , Option "o" ["outformat"] (ReqArg OutputFormat "FORMAT") "Output dates in the given FORMAT"
- ]
+ [ 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"
+ ]
parseToZonedTime :: String -> String -> ZonedTime
-parseToZonedTime format = fromMaybe (error "Input data broken.") . parseTime defaultTimeLocale format
+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
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
+ 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
- day = localDay $ zonedTimeToLocalTime time
+ where
+ day = localDay $ zonedTimeToLocalTime time
+
+startOfMonth :: ZonedTime -> ZonedTime
+startOfMonth time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time
+ where
+ day = localDay $ zonedTimeToLocalTime time
parseToUTCFromZonedString :: String -> String -> UTCTime
parseToUTCFromZonedString fmt time = zonedTimeToUTC $ parseToZonedTime fmt time
+linesFromFiles :: [String] -> IO [String]
+linesFromFiles filenames = lines . concat <$> mapM readFile filenames
+
splitToMapOn :: String -> [String] -> Map.Map String [String]
-splitToMapOn sep lines = Map.fromList $ map (listToTuple . splitOn sep) lines
- where listToTuple (x:xs) = (x, xs)
+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
+ loglineMap = splitToMapOn ";" logLines
+ zonedtimeEntryMap = Map.mapKeysMonotonic (parseToZonedTime inDateFmt) loglineMap
+ utctimeEntryMap = Map.mapKeys zonedTimeToUTC zonedtimeEntryMap
- timeStamps = Map.keys loglineMap
- entryTexts = map head $ Map.elems loglineMap
- parsedTimes = Map.keys zonedtimeEntryMap
+ timeStamps = Map.keys loglineMap
+ entryTexts = map head $ Map.elems loglineMap
+ parsedTimes = Map.keys zonedtimeEntryMap
- deltasHMS = map secondsToHMS $ utcTimesDeltas (startOfDay $ head parsedTimes) $ Map.keys utctimeEntryMap
+ deltasHMS = map secondsToHMS $ utcTimesDeltas (startOfDay $ head parsedTimes) $ Map.keys utctimeEntryMap
in
- zipWith4 DiddoEntry (formatZonedTime inDateFmt (startOfDay $ head parsedTimes) : init timeStamps)
+ zipWith4 DiddoEntry (formatZonedTime inDateFmt (startOfDay $ head parsedTimes) : init timeStamps)
timeStamps deltasHMS entryTexts
-readFilesToLines :: [String] -> IO [String]
-readFilesToLines filenames = lines . concat <$> mapM readFile filenames
+--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
main :: IO ()
main = do
- argv <- getArgs
+ 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]
+
+ logLines <- linesFromFiles logFileNames
+
+ let
+ inDateFmt = head [fmt | InputFormat fmt <- opts]
+-- reportPeriod = ( head [time | StartDate time <- opts]
+-- , head [time | EndDate time <- opts]
+-- )
+
+ -- DEBUG
+ mapM_ putStrLn args
+-- putStrLn $ show reportPeriod
+
- case getOpt Permute options argv of
- (opts,args,[]) -> do
- let
- logFileNames = [file | InputFile file <- opts]
- inDateFmt = head [fmt | InputFormat fmt <- opts]
+ let
+ loglineMap = Map.unions $ map parseDddLog logLines
+ deltasHMS = map secondsToHMS $ utcTimesDeltas' $ fst (Map.findMin loglineMap) : Map.keys loglineMap
- logLines <- readFilesToLines logFileNames
+ -- loglineMapReduced = Map.filterWithKey (\t _ -> t > startDay) loglineMap
+ -- diddoEntries = Map.foldrWithKey
- mapM_ print $ logLinesToDiddohs inDateFmt logLines
+ 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...]"
+ (_,_,errs) -> do
+ hPutStr stderr $ usageInfo header options
+ ioError (userError ('\n' : concat errs))
+ where header = "Usage: diddohs [OPTION...]"