]> git.netwichtig.de Git - user/henk/code/haskell/diddohs.git/commitdiff
On branch master
authorHendrik Jaeger <henk@frustcomp>
Sun, 12 Jan 2014 02:58:58 +0000 (03:58 +0100)
committerHendrik Jaeger <henk@frustcomp>
Sun, 12 Jan 2014 02:58:58 +0000 (03:58 +0100)
      modified:   diddohs.hs
        CHANGED: getopt instead of optparse-applicative
        CHANGED: use Maps to store log info

diddohs.hs

index d2a796bc05d4e3a010cd6f6b969228ca322cab55..21bae077a49ed1008ba6827183398b91f9cb19e6 100644 (file)
@@ -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...]"