summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHendrik Jaeger <henk@frustcomp>2014-01-12 03:58:58 +0100
committerHendrik Jaeger <henk@frustcomp>2014-01-12 03:58:58 +0100
commit9d103749a11f458b8e6834faf37b955fc2818c2b (patch)
tree53692f55cb92e1f13b85512e39c30b68eca79af5
parent79eb0216f15e1a8570cfae7ae5ed83da74ca30b8 (diff)
On branch master
modified: diddohs.hs CHANGED: getopt instead of optparse-applicative CHANGED: use Maps to store log info
-rw-r--r--diddohs.hs111
1 files changed, 69 insertions, 42 deletions
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...]"