]> git.netwichtig.de Git - user/henk/code/haskell/diddohs.git/commitdiff
On branch master
authorHendrik Jaeger <henk@frustcomp>
Sun, 30 Mar 2014 21:25:26 +0000 (23:25 +0200)
committerHendrik Jaeger <henk@frustcomp>
Sun, 30 Mar 2014 21:25:26 +0000 (23:25 +0200)
      modified:   Diddo.hs
      modified:   diddohs.hs

Diddo.hs
diddohs.hs

index 745d036ab993aba20871bb7b30e741122370c378..2100b257dba6a14dc503ebc83f6d15580e53b5a7 100644 (file)
--- a/Diddo.hs
+++ b/Diddo.hs
@@ -1,19 +1,21 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Diddo
 ( LogEntry(LogEntry)
-, DiddoEntry(DiddoEntry)
+, Diddo(Diddo)
+, formatDiddo
 , parseDiddoLogline
-, formatDiddoEntry
-, timestamp
-, logToDiddoEntry
+, logToDiddo
+, parseToZonedTime
 ) where
 
-import Data.DateTime( diffSeconds )
 import Data.Maybe( fromMaybe )
 import Data.Time.Clock( UTCTime(), NominalDiffTime(), diffUTCTime )
-import Data.Time.Format( parseTime, formatTime )
-import Data.Time.LocalTime( TimeZone() )
-import Data.Time.LocalTime( ZonedTime(..), zonedTimeToUTC, utcToZonedTime )
+import Data.Time.Format( FormatTime(), parseTime, formatTime )
+import Data.Time.LocalTime( TimeZone(), ZonedTime(..), zonedTimeToUTC, utcToZonedTime )
+import Text.Parsec
 import System.Locale
+import Text.Printf( printf )
 import qualified Data.Text as T
 
 data LogEntry = LogEntry
@@ -22,42 +24,56 @@ data LogEntry = LogEntry
     , text          :: T.Text
     }
 
-data DiddoEntry = DiddoEntry
+data Diddo = Diddo
     { startTime     :: ZonedTime
     , endTime       :: ZonedTime
     , comment       :: T.Text
     }
 
-formatDiddoEntry :: String -> DiddoEntry -> T.Text
-formatDiddoEntry format entry = T.intercalate (T.pack ";")
-    [ T.pack $ formatTime defaultTimeLocale format (startTime entry)
-    , T.pack $ formatTime defaultTimeLocale format (endTime entry)
-    , T.pack $ diffTimeToHMSString $ diffUTCTime (zonedTimeToUTC (endTime entry)) (zonedTimeToUTC (startTime entry))
-    , comment entry
-    ]
+getTimestamp :: Diddo -> UTCTime
+getTimestamp = zonedTimeToUTC . endTime
+
+formatDiddo :: String -> Diddo -> T.Text
+formatDiddo format (Diddo start end text) = T.intercalate ";" diddoline
+    where
+        diddoline           = [startZonedString, endZonedString, delta, text]
+        startZonedString    = timeToText format start
+        endZonedString      = timeToText format end
+        startUTC            = zonedTimeToUTC start
+        endUTC              = zonedTimeToUTC end
+        delta               = diffTimeToHMSString $ diffUTCTime endUTC startUTC
+
+timeToText :: FormatTime a => String -> a -> T.Text
+timeToText format = T.pack . formatTime defaultTimeLocale format
 
-logToDiddoEntry :: UTCTime -> LogEntry -> DiddoEntry
-logToDiddoEntry startutc logentry = DiddoEntry startZoned endZoned $ text logentry
+logToDiddo :: UTCTime -> LogEntry -> Diddo
+logToDiddo startutc logentry = Diddo startZoned endZoned $ text logentry
     where
         startZoned = utcToZonedTime (timezone logentry) startutc
         endZoned = utcToZonedTime (timezone logentry) $ timestamp logentry
 
-parseDiddoLogline :: T.Text -> LogEntry
-parseDiddoLogline line = LogEntry ts tz string
+-- parseDiddoLogline' :: T.Text -> (UTCTime, LogEntry)
+-- parseDiddoLogline' line = (ts, LogEntry ts tz string)
+
+parseDiddoLogline :: T.Text -> (UTCTime, LogEntry)
+parseDiddoLogline line = (ts, LogEntry ts tz string)
     where
-        splitLine           = T.splitOn (T.pack ";") line
-        string              = T.intercalate (T.pack ";") $ tail splitLine
-        time                = parseISOsecondsTime $ head splitLine
-        (ts,tz)             = (zonedTimeToUTC time, zonedTimeZone time)
+        (timestring:strings)    = T.splitOn ";" line
+        string                  = T.intercalate ";" strings
+        time                    = parseISOsecondsTime timestring
+        (ts,tz)                 = (zonedTimeToUTC time, zonedTimeZone time)
 
 parseToZonedTime :: String -> String -> ZonedTime
-parseToZonedTime format string = fromMaybe (error $ "Input data broken: " ++ string) $ parseTime defaultTimeLocale format string
+parseToZonedTime format string = zt
+    where
+        zt = fromMaybe (error $ "Input data broken: " ++ string) parsedTime
+        parsedTime = parseTime defaultTimeLocale format string
 
 parseISOsecondsTime :: T.Text -> ZonedTime
 parseISOsecondsTime timestring = parseToZonedTime (iso8601DateFormat $ Just "%T%z") $ T.unpack timestring
 
-diffTimeToHMSString :: NominalDiffTime -> String
-diffTimeToHMSString delta = printf "%d:%02d:%02d" h m s
+diffTimeToHMSString :: NominalDiffTime -> T.Text
+diffTimeToHMSString delta = T.pack $ printf "%d:%02d:%02d" h m s
     where
         (mLeft, s) = floor delta `divMod` 60 :: (Int, Int)
         (h, m)     = mLeft `divMod` 60
index 026ce1666bcce4691f11a556c81930e01b3510e6..6884d1462cd52cb50d96fb6fc36c7b7dbf42fba4 100644 (file)
@@ -1,7 +1,8 @@
 import Control.Applicative( (<$>) )
 import Control.Monad( unless )
 import Data.Time.Clock( UTCTime(..) )
-import Diddo( DiddoEntry(..), LogEntry(..), parseDiddoLogline, formatDiddoEntry, timestamp, logToDiddoEntry )
+import Data.Time.LocalTime( TimeZone(), ZonedTime(..), zonedTimeToUTC, utcToZonedTime )
+import Diddo( Diddo(..), LogEntry(..), parseDiddoLogline, formatDiddo, logToDiddo, parseToZonedTime )
 import System.Console.GetOpt
 import System.Environment( getArgs )
 import System.Exit( exitSuccess, exitFailure )
@@ -24,56 +25,56 @@ data Opt = Opt
 
 defaultOpts :: Opt
 defaultOpts = Opt
-    { optVerbose = False
-    , optVersion = False
-    , optHelp = False
-    , optInputFiles = []
-    , optOutputFile = ""
-    , optInputFormat = "%FT%T%z"
-    , optOutputFormat = "%FT%T%z"
-    , optStartDate = ""
-    , optEndDate = ""
+    { 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))
+        (NoArg (\ _ -> putStrLn (usageInfo "Usage: diddohs [OPTION...]" availableOptions) >> exitSuccess))
         "Display program help"
     , Option ['v']    ["verbose"]
-        (NoArg (\opts -> return opts { optVerbose = True }))
+        (NoArg (\ opts -> return opts { optVerbose = True }))
         "More detailed output"
     , Option ['V']    ["version"]
-        (NoArg (\opts -> return opts { optVersion = True }))
+        (NoArg (\ opts -> return opts { optVersion = True }))
         "Display program version"
     , Option ['f']    ["file"]
-        (ReqArg (\arg opts -> return opts { optInputFiles = optInputFiles opts ++ [arg]}) "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")
+        (ReqArg (\ arg opts -> return opts { optOutputFile = arg }) "FILE")
         "Write to FILE"
     , Option ['i']    ["informat"]
-        (ReqArg (\arg opts -> return opts { optInputFormat = arg }) "FORMAT")
+        (ReqArg (\ arg opts -> return opts { optInputFormat = arg }) "FORMAT")
         "Timeformat used in input"
     , Option ['o']    ["outformat"]
-        (ReqArg (\arg opts -> return opts { optOutputFormat = arg }) "FORMAT")
+        (ReqArg (\ arg opts -> return opts { optOutputFormat = arg }) "FORMAT")
         "Timeformat used in output"
     , Option ['s']    ["start"]
-        (ReqArg (\arg opts -> return opts { optStartDate = arg }) "DATE")
+        (ReqArg (\ arg opts -> return opts { optStartDate = arg }) "DATE")
         "Start of reporting period"
     , Option ['e']    ["end"]
-        (ReqArg (\arg opts -> return opts { optEndDate = arg }) "DATE")
+        (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
+-- SECTION: Map of logentries to Map of Diddos
+logentryMapToDiddoMap :: Map.Map UTCTime Diddo.LogEntry -> Map.Map UTCTime Diddo.Diddo
+logentryMapToDiddoMap 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
+        toDddEntry key value    = Diddo.logToDiddo (precedingTimestamp key) value
+        precedingTimestamp x    = case Map.lookupLT x logmap of
+            Just (y,_)          -> y
+            Nothing             -> fst $ Map.findMin logmap
 -- SECTION: Map of logentries to Map of DiddoEntries
 
 main :: IO ()
@@ -86,22 +87,28 @@ main = do
         exitFailure
 
     effectiveOptions <- foldl (>>=) (return defaultOpts) givenOptions
+
+    let
+        inDateFmt               = optInputFormat effectiveOptions
+        outDateFmt              = optOutputFormat effectiveOptions
+
+        startDate               = parseToZonedTime inDateFmt $ optStartDate effectiveOptions
+        endDate                 = parseToZonedTime inDateFmt $ optEndDate effectiveOptions
     -- SECTION: option processing
 
-    dddLogEntries <-
-        map Diddo.parseDiddoLogline <$> case optInputFiles effectiveOptions of
-            files@(_:_)         -> T.lines . T.concat <$> mapM TIO.readFile files
-            []                  -> T.lines <$> TIO.getContents
+    loglines <- case optInputFiles effectiveOptions of
+            files@(_:_)     -> T.lines . T.concat <$> mapM TIO.readFile files
+            []              -> T.lines <$> TIO.getContents
 
     let
-        dddLogEntryMap      = Map.fromList $ map (\diddo -> (Diddo.timestamp diddo, diddo)) dddLogEntries
-        diddoEntriesMap     = mapToDiddoEntries dddLogEntryMap
-        inDateFmt           = optInputFormat effectiveOptions
-        outDateFmt          = optOutputFormat effectiveOptions
+        timestampLogentryMap                        = Map.fromList $ map Diddo.parseDiddoLogline loglines
+        (_, _, startedTimestampLogentryMap)         = Map.splitLookup (zonedTimeToUTC startDate) timestampLogentryMap
+        (endedTimestampLogentryMap, lastEntry, _)   = Map.splitLookup (zonedTimeToUTC endDate) startedTimestampLogentryMap
+        timestampDiddoMap                           = logentryMapToDiddoMap timestampLogentryMap
 
     -- DEBUG
     mapM_ putStrLn args
     -- DEBUG
 
-    mapM_ (TIO.putStrLn . snd) $ Map.toAscList $ Map.map (Diddo.formatDiddoEntry outDateFmt) diddoEntriesMap
+    mapM_ (TIO.putStrLn . snd) $ Map.toAscList $ Map.map (Diddo.formatDiddo outDateFmt) timestampDiddoMap