X-Git-Url: https://git.netwichtig.de/gitweb/?a=blobdiff_plain;f=diddohs.hs;h=21bae077a49ed1008ba6827183398b91f9cb19e6;hb=9d103749a11f458b8e6834faf37b955fc2818c2b;hp=6baa5e9951e7f11fc0199dbf2c26624e6c9cbe74;hpb=7bc2168552de76fa7c985b65608199296b6ff55f;p=user%2Fhenk%2Fcode%2Fhaskell%2Fdiddohs.git

diff --git a/diddohs.hs b/diddohs.hs
index 6baa5e9..21bae07 100644
--- a/diddohs.hs
+++ b/diddohs.hs
@@ -1,52 +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 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 Text.Printf( printf )
-
-data HMSTime = HMSTime { hours :: Integer, minutes :: Integer, seconds :: Integer }
-instance Show HMSTime where
-  show (HMSTime h m s) = printf "%d:%02d:%02d" h m s
-
-secondsToHMS :: Integer -> HMSTime
-secondsToHMS seconds =  HMSTime h m s where
-                          (mLeft, s) = seconds `divMod` 60
-                          (h, m)     = mLeft `divMod` 60
-
-data DiddoEntry = DiddoEntry {  start :: String
-                                , finish :: String
-                                , delta :: HMSTime
-                                , entry :: String
-                             }
-instance Show DiddoEntry where
-  show (DiddoEntry start finish delta entry) = printf "%s;%s;%s;%s" start finish (show delta) entry
-
-data DiddoOpts = DiddoOpts
-  { inDateFmt :: String
-  , inFile :: String
-  }
-
-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
-
-  mapM_ print diddos_summarized
+import System.Exit
+import System.IO( stderr, hPutStr, hPutStrLn )
+import System.Locale
 
-main :: IO ()
-main = execParser opts >>= mainWithOpts
+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
+
+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...]"