-import Control.Applicative( (<$>), (<*>) )
-import Data.DateTime( diffSeconds )
-import Data.List.Split( splitOn )
-import Data.List( zipWith4, transpose )
-import qualified Data.Map as Map
-import Data.Maybe( fromJust, fromMaybe )
-import Data.Time.Clock( UTCTime(..), secondsToDiffTime )
-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 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
-import System.IO( stderr, hPutStr, hPutStrLn )
-import System.Locale
-
-data Flag
- = Verbose | Version
- | Help
- | InputFile String | OutputFile String
- | InputFormat String | OutputFormat String
- deriving Show
-
-options :: [OptDescr Flag]
-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"
- ]
-
-parseToZonedTime :: String -> String -> ZonedTime
-parseToZonedTime format = fromMaybe (error "Input data broken.") . parseTime defaultTimeLocale format
-
-parseISOsecondsTime :: String -> ZonedTime
-parseISOsecondsTime = parseToZonedTime $ iso8601DateFormat $ Just "%T%z"
-
-parseRFC822Time :: String -> ZonedTime
-parseRFC822Time = parseToZonedTime rfc822DateFormat
-
-formatZonedTime :: String -> ZonedTime -> String
-formatZonedTime = formatTime defaultTimeLocale
-
-utcTimesDeltas :: ZonedTime -> [UTCTime] -> [Integer]
-utcTimesDeltas startTime timestamps =
- let
- startTimeUTC = zonedTimeToUTC startTime
- relevantTimestamps = dropWhile (< startTimeUTC) timestamps
- in
- zipWith diffSeconds relevantTimestamps $ startTimeUTC : init relevantTimestamps
+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
-startOfDay :: ZonedTime -> ZonedTime
-startOfDay time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time
- where
- day = localDay $ zonedTimeToLocalTime time
+main :: IO ()
+main = do
+ -- SECTION: option processing
+ (givenOptions,args,errs) <- getArgs >>= return . getOpt Permute availableOptions
-parseToUTCFromZonedString :: String -> String -> UTCTime
-parseToUTCFromZonedString fmt time = zonedTimeToUTC $ parseToZonedTime fmt time
+ unless (null errs) $ do
+ mapM_ (hPutStr stderr) errs
+ exitFailure
-splitToMapOn :: String -> [String] -> Map.Map String [String]
-splitToMapOn sep lines = Map.fromList $ map (listToTuple . splitOn sep) lines
- where listToTuple (x:xs) = (x, xs)
+ effectiveOptions <- foldl (>>=) (return defaultOpts) givenOptions
-logLinesToDiddohs :: String -> [String] -> [DiddoEntry]
-logLinesToDiddohs inDateFmt logLines =
let
- 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
-
- deltasHMS = map secondsToHMS $ utcTimesDeltas (startOfDay $ head parsedTimes) $ Map.keys utctimeEntryMap
- in
- zipWith4 DiddoEntry (formatZonedTime inDateFmt (startOfDay $ head parsedTimes) : init timeStamps)
- timeStamps deltasHMS entryTexts
+ inDateFmt = optInputFormat effectiveOptions
+ outDateFmt = optOutputFormat effectiveOptions
-readFilesToLines :: [String] -> IO [String]
-readFilesToLines filenames = lines . concat <$> mapM readFile filenames
+ startDate = parseToZonedTime inDateFmt $ optStartDate effectiveOptions
+ endDate = parseToZonedTime inDateFmt $ optEndDate effectiveOptions
+ -- SECTION: option processing
-main :: IO ()
-main = do
- argv <- getArgs
+ loglines <- case optInputFiles effectiveOptions of
+ files@(_:_) -> T.lines . T.concat <$> mapM TIO.readFile files
+ [] -> T.lines <$> TIO.getContents
- case getOpt Permute options argv of
- (opts,args,[]) -> do
- let
- logFileNames = [file | InputFile file <- opts]
- inDateFmt = head [fmt | InputFormat fmt <- opts]
-
- logLines <- readFilesToLines logFileNames
+ let
+ timestampLogentryMap = Map.fromList $ map Diddo.parseDiddoLogline loglines
+ (_, _, startedTimestampLogentryMap) = Map.splitLookup (zonedTimeToUTC startDate) timestampLogentryMap
+ (endedTimestampLogentryMap, lastEntry, _) = Map.splitLookup (zonedTimeToUTC endDate) startedTimestampLogentryMap
+ timestampDiddoMap = logentryMapToDiddoMap timestampLogentryMap
- mapM_ print $ logLinesToDiddohs inDateFmt logLines
+ -- DEBUG
+ mapM_ putStrLn args
+ -- DEBUG
- (_,_,errs) -> do
- hPutStr stderr $ usageInfo header options
- ioError (userError ('\n' : concat errs))
- where header = "Usage: diddohs [OPTION...]"
+ mapM_ (TIO.putStrLn . snd) $ Map.toAscList $ Map.map (Diddo.formatDiddo outDateFmt) timestampDiddoMap
projects / user / henk / code / haskell / diddohs.git / blobdiff