From: Hendrik Jaeger Date: Sun, 12 Jan 2014 02:58:58 +0000 (+0100) Subject: On branch master X-Git-Tag: v0.1~9 X-Git-Url: https://git.netwichtig.de/gitweb/?a=commitdiff_plain;h=9d103749a11f458b8e6834faf37b955fc2818c2b;p=user%2Fhenk%2Fcode%2Fhaskell%2Fdiddohs.git On branch master modified: diddohs.hs CHANGED: getopt instead of optparse-applicative CHANGED: use Maps to store log info --- diff --git a/diddohs.hs b/diddohs.hs index d2a796b..21bae07 100644 --- a/diddohs.hs +++ b/diddohs.hs @@ -1,22 +1,38 @@ import Control.Applicative( (<$>), (<*>) ) -import Data.DateTime( DateTime(..), parseDateTime, formatDateTime, startOfTime, diffSeconds ) +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.Monoid( mempty ) -import Data.Time.Clock( secondsToDiffTime ) +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 Options.Applicative( execParser, info, strOption, long, help, helper, briefDesc, fullDesc, progDesc, header, (<>) ) +import System.Console.GetOpt import System.Environment( getArgs ) +import System.Exit +import System.IO( stderr, hPutStr, hPutStrLn ) import System.Locale -data DiddoOpts = DiddoOpts - { inDateFmt :: String - , inFile :: String - } +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 @@ -28,52 +44,63 @@ parseRFC822Time :: String -> ZonedTime parseRFC822Time = parseToZonedTime rfc822DateFormat formatZonedTime :: String -> ZonedTime -> String -formatZonedTime format = formatTime defaultTimeLocale format +formatZonedTime = formatTime defaultTimeLocale -zonedTimesDeltas :: ZonedTime -> [ZonedTime] -> [Integer] -zonedTimesDeltas startTime timestamps = +utcTimesDeltas :: ZonedTime -> [UTCTime] -> [Integer] +utcTimesDeltas startTime timestamps = let startTimeUTC = zonedTimeToUTC startTime - relevantTimestamps = dropWhile (< startTimeUTC) $ map zonedTimeToUTC timestamps + relevantTimestamps = dropWhile (< startTimeUTC) timestamps in zipWith diffSeconds relevantTimestamps $ startTimeUTC : init relevantTimestamps -startOfZonedDay :: ZonedTime -> ZonedTime -startOfZonedDay time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time +startOfDay :: ZonedTime -> ZonedTime +startOfDay time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time where day = localDay $ zonedTimeToLocalTime time -mainWithOpts :: DiddoOpts -> IO () -mainWithOpts opts = - do - [ - timeStamps - , entryText - ] <- transpose . map (splitOn ";") . lines <$> readFile (inFile opts) +parseToUTCFromZonedString :: String -> String -> UTCTime +parseToUTCFromZonedString fmt time = zonedTimeToUTC $ parseToZonedTime fmt time + +splitToMapOn :: String -> [String] -> Map.Map String [String] +splitToMapOn sep lines = Map.fromList $ map (listToTuple . splitOn sep) lines + where listToTuple (x:xs) = (x, xs) +logLinesToDiddohs :: String -> [String] -> [DiddoEntry] +logLinesToDiddohs inDateFmt logLines = let - parseCustomTime = parseToZonedTime $ inDateFmt opts --- parsedTimes = map (parseToZonedTime $ inDateFmt opts) timeStamps - parsedTimes = map parseCustomTime timeStamps - deltasHMS = map secondsToHMS $ zonedTimesDeltas (startOfZonedDay $ head parsedTimes) parsedTimes - diddos_summarized = zipWith4 DiddoEntry - ((formatZonedTime (inDateFmt opts) $ startOfZonedDay $ head parsedTimes) : init timeStamps) - timeStamps deltasHMS entryText + 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 - mapM_ print diddos_summarized + deltasHMS = map secondsToHMS $ utcTimesDeltas (startOfDay $ head parsedTimes) $ Map.keys utctimeEntryMap + in + zipWith4 DiddoEntry (formatZonedTime inDateFmt (startOfDay $ head parsedTimes) : init timeStamps) + timeStamps deltasHMS entryTexts + +readFilesToLines :: [String] -> IO [String] +readFilesToLines filenames = lines . concat <$> mapM readFile filenames main :: IO () -main = execParser opts >>= mainWithOpts - where - opts = info (helper <*> parser) - ( header "diddohs - A Time/Task Tracker" - <> progDesc "Diddoh Desc" --- <> briefDesc - <> fullDesc - ) - parser = DiddoOpts - <$> strOption ( long "indateform" - <> help "Input date format, see date(1)" - ) - <*> strOption ( long "infile" ) +main = do + argv <- getArgs + + case getOpt Permute options argv of + (opts,args,[]) -> do + let + logFileNames = [file | InputFile file <- opts] + inDateFmt = head [fmt | InputFormat fmt <- opts] + + logLines <- readFilesToLines logFileNames + + mapM_ print $ logLinesToDiddohs inDateFmt logLines + + (_,_,errs) -> do + hPutStr stderr $ usageInfo header options + ioError (userError ('\n' : concat errs)) + where header = "Usage: diddohs [OPTION...]"