On branch master

[user/henk/code/haskell/diddohs.git] / diddohs.hs

diff --git a/diddohs.hs b/diddohs.hs
index c9ec4059c161c3178f0bcd6e8f1e25e0d7973780..21bae077a49ed1008ba6827183398b91f9cb19e6 100644 (file)
--- a/diddohs.hs
+++ b/diddohs.hs
@@ -1,36 +1,106 @@
-import Control.Applicative( (<$>), (<*>), liftA, liftA2 )
-import Data.DateTime( parseDateTime, startOfTime, diffSeconds, formatDateTime )
-import Data.List( zip4, zipWith4, transpose )
+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.Monoid( mempty )
-import Data.Time.Clock( secondsToDiffTime )
-import Options.Applicative( execParser, info, strOption, long )
-import System.Environment( getArgs )
-import HMSTime( HMSTime(..), secondsToHMS )
+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 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
 
-mainWithOpts :: DiddoOpts -> IO ()
-mainWithOpts opts = do
-  [timestrings_finish
-        , entries
-        ]                  <- transpose . map (splitOn ";") . lines <$> readFile (inFile opts)
-  let utcTimes_finish      = map (fromMaybe (error "Input data broken.") . parseDateTime (inDateFmt opts)) timestrings_finish
-      entry_deltas_HMMSS   = zipWith (\x y -> secondsToHMS $ diffSeconds x y) utcTimes_finish (startOfTime : init utcTimes_finish)
-      diddos_summarized    = zipWith4 DiddoEntry ("" : init timestrings_finish) timestrings_finish entry_deltas_HMMSS entries
+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"
+  ]
 
-  mapM_ print diddos_summarized
+parseToZonedTime :: String -> String -> ZonedTime
+parseToZonedTime format = fromMaybe (error "Input data broken.") . parseTime defaultTimeLocale format
 
-main :: IO ()
-main = execParser opts >>= mainWithOpts
+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
+
+startOfDay :: ZonedTime -> ZonedTime
+startOfDay time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time
   where
-    opts = info parser mempty
-    parser = DiddoOpts
-      <$> strOption ( long "indateform" )
-      <*> strOption ( long "infile" )
+    day = localDay $ zonedTimeToLocalTime time
+
+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
+      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
+
+readFilesToLines :: [String] -> IO [String]
+readFilesToLines filenames = lines . concat <$> mapM readFile filenames
+
+main :: IO ()
+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...]"