import Control.Applicative( (<$>), (<*>) ) import Control.Monad( when, unless ) import Data.DateTime( diffSeconds ) import Data.List.Split( splitOn ) 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, 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, exitFailure ) import System.IO( stdin, stdout, stderr, hPutStr, hPutStrLn ) import System.Locale 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" parseRFC822Time :: String -> ZonedTime parseRFC822Time = parseToZonedTime rfc822DateFormat -- SECTION: parsing to ZonedTime -- SECTION: handling ZonedTime formatZonedTime :: String -> ZonedTime -> String formatZonedTime = formatTime defaultTimeLocale startOfDay :: ZonedTime -> ZonedTime startOfDay time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time where day = localDay $ zonedTimeToLocalTime time startOfMonth :: ZonedTime -> ZonedTime 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 -- 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) listToTuple [] = ("",[""]) 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 (intercalate ";") $ Map.elems loglineMap parsedTimes = Map.keys zonedtimeEntryMap deltasHMS = map secondsToHMS $ utcTimesDeltas ((zonedTimeToUTC $ startOfDay $ head parsedTimes) : Map.keys utctimeEntryMap) in zipWith4 DiddoEntry (formatZonedTime inDateFmt (startOfDay $ head parsedTimes) : init timeStamps) timeStamps deltasHMS entryTexts -- SECTION: handling rawinput 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 -- SECTION: option processing 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 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