]> git.netwichtig.de Git - user/henk/code/haskell/diddohs.git/blobdiff - diddohs.hs
On branch master
[user/henk/code/haskell/diddohs.git] / diddohs.hs
index 21bae077a49ed1008ba6827183398b91f9cb19e6..0444e22aaec24fdc98ea57636160933adf4e7329 100644 (file)
-import Control.Applicative( (<$>), (<*>) )
-import Data.DateTime( diffSeconds )
-import Data.List.Split( splitOn )
-import Data.List( zipWith4, transpose )
+import Control.Applicative( (<$>) )
+import Control.Monad( unless )
 import qualified Data.Map as Map
-import Data.Maybe( fromJust, fromMaybe )
-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 Data.Time.Clock( UTCTime(..) )
+import Diddo( DiddoEntry(..), LogEntry(..), parseDiddoLogline, formatDiddoEntry, timestamp, logToDiddoEntry )
 import System.Console.GetOpt
 import System.Environment( getArgs )
-import System.Exit
-import System.IO( stderr, hPutStr, hPutStrLn )
-import System.Locale
+import System.Exit( exitSuccess, exitFailure )
+import System.IO( stderr, hPutStr )
+
+data Opt = Opt
+    { optVerbose        :: Bool
+    , optVersion        :: Bool
+    , optHelp           :: Bool
+    , optInputFiles     :: [String]
+    , optOutputFile     :: String
+    , optInputFormat    :: String
+    , optOutputFormat   :: String
+    , optStartDate      :: String
+    , optEndDate        :: String
+    }
+
+defaultOpts :: Opt
+defaultOpts = Opt
+    { optVerbose = False
+    , optVersion = False
+    , optHelp = False
+    , optInputFiles = []
+    , optOutputFile = ""
+    , optInputFormat = "%FT%T%z"
+    , optOutputFormat = "%FT%T%z"
+    , optStartDate = ""
+    , optEndDate = ""
+    }
+
+availableOptions :: [OptDescr (Opt -> IO Opt)]
+availableOptions =
+    [ Option ['h']    ["help"]
+        (NoArg (\_ -> putStrLn (usageInfo "Usage: diddohs [OPTION...]" availableOptions) >> exitSuccess))
+        "Display program help"
+    , Option ['v']    ["verbose"]
+        (NoArg (\opts -> return opts { optVerbose = True }))
+        "More detailed output"
+    , Option ['V']    ["version"]
+        (NoArg (\opts -> return opts { optVersion = True }))
+        "Display program version"
+    , Option ['f']    ["file"]
+        (ReqArg (\arg opts -> return opts { optInputFiles = optInputFiles opts ++ [arg]}) "FILE" )
+        "Read from FILE"
+    , Option ['w']    ["output"]
+        (ReqArg (\arg opts -> return opts { optOutputFile = arg }) "FILE")
+        "Write to FILE"
+    , Option ['i']    ["informat"]
+        (ReqArg (\arg opts -> return opts { optInputFormat = arg }) "FORMAT")
+        "Timeformat used in input"
+    , Option ['o']    ["outformat"]
+        (ReqArg (\arg opts -> return opts { optOutputFormat = arg }) "FORMAT")
+        "Timeformat used in output"
+    , Option ['s']    ["start"]
+        (ReqArg (\arg opts -> return opts { optStartDate = arg }) "DATE")
+        "Start of reporting period"
+    , Option ['e']    ["end"]
+        (ReqArg (\arg opts -> return opts { optEndDate = arg }) "DATE")
+        "End of reporting period"
+    ]
+
+-- SECTION: Map of logentries to Map of DiddoEntries
+mapToDiddoEntries :: Map.Map UTCTime Diddo.LogEntry -> Map.Map UTCTime Diddo.DiddoEntry
+mapToDiddoEntries logmap = Map.mapWithKey toDddEntry logmap
+    where
+        toDddEntry key value = Diddo.logToDiddoEntry (preceedingTimestamp key) value
+        preceedingTimestamp x = case Map.lookupLT x logmap of
+            Just y          -> fst y
+            Nothing         -> fst $ Map.findMin logmap
+-- SECTION: Map of logentries to Map of DiddoEntries
 
-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
+main :: IO ()
+main = do
+    -- SECTION: option processing
+    (givenOptions,args,errs) <- getArgs >>= return . getOpt Permute availableOptions
 
-startOfDay :: ZonedTime -> ZonedTime
-startOfDay time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time
-  where
-    day = localDay $ zonedTimeToLocalTime time
+    unless (null errs) $ do
+        mapM_ (hPutStr stderr) errs
+        exitFailure
 
-parseToUTCFromZonedString :: String -> String -> UTCTime
-parseToUTCFromZonedString fmt time = zonedTimeToUTC $ parseToZonedTime fmt time
+    effectiveOptions <- foldl (>>=) (return defaultOpts) givenOptions
+    -- SECTION: option processing
 
-splitToMapOn :: String -> [String] -> Map.Map String [String]
-splitToMapOn sep lines = Map.fromList $ map (listToTuple . splitOn sep) lines
-  where listToTuple (x:xs) = (x, xs)
+    dddLogEntries <-
+        map Diddo.parseDiddoLogline <$> case optInputFiles effectiveOptions of
+            files@(_:_)         -> lines . concat <$> mapM readFile files
+            []                  -> lines <$> getContents
 
-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
+        dddLogEntryMap      = Map.fromList $ map (\diddo -> (Diddo.timestamp diddo, diddo)) dddLogEntries
+        diddoEntriesMap     = mapToDiddoEntries dddLogEntryMap
+        inDateFmt           = optInputFormat effectiveOptions
+        outDateFmt          = optOutputFormat effectiveOptions
 
-      mapM_ print $ logLinesToDiddohs inDateFmt logLines
+    -- DEBUG
+    mapM_ putStrLn args
+    -- DEBUG
 
-    (_,_,errs)        -> do
-      hPutStr stderr $ usageInfo header options
-      ioError (userError ('\n' : concat errs))
-        where header = "Usage: diddohs [OPTION...]"
+    mapM_ (putStrLn . snd) $ Map.toAscList $ Map.map (Diddo.formatDiddoEntry outDateFmt) diddoEntriesMap