On branch master

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

diff --git a/Diddo.hs b/Diddo.hs
index e90e6503456d6898bd2262513721f1872d0e1ade..2100b257dba6a14dc503ebc83f6d15580e53b5a7 100644 (file)
--- a/Diddo.hs
+++ b/Diddo.hs
@@ -1,61 +1,80 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Diddo
 ( LogEntry(LogEntry)
-, DiddoEntry(DiddoEntry)
+, Diddo(Diddo)
+, formatDiddo
 , parseDiddoLogline
-, formatDiddoEntry
-, timestamp
-, logToDiddoEntry
+, logToDiddo
+, parseToZonedTime
 ) where
 
-import HMSTime( secondsToHMS )
-import Data.List( intercalate )
-import Data.DateTime( diffSeconds )
-import Data.Time.LocalTime( TimeZone() )
-import Data.Time.Clock( UTCTime() )
 import Data.Maybe( fromMaybe )
-import Data.Time.Format( parseTime, formatTime )
-import Data.Time.LocalTime( ZonedTime(..), zonedTimeToUTC, utcToZonedTime )
-import Data.List.Split( splitOn )
+import Data.Time.Clock( UTCTime(), NominalDiffTime(), diffUTCTime )
+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
     { timestamp     :: UTCTime
     , timezone      :: TimeZone
-    , text          :: String
+    , text          :: T.Text
     }
 
-instance Show LogEntry where
-    show x = (show $ timestamp x) ++ (show $ timezone x) ++ text x
-
-data DiddoEntry = DiddoEntry
-    { startTime         :: ZonedTime
-    , endTime           :: ZonedTime
-    , comment           :: String
+data Diddo = Diddo
+    { startTime     :: ZonedTime
+    , endTime       :: ZonedTime
+    , comment       :: T.Text
     }
 
-instance Show DiddoEntry where
-  show (DiddoEntry start finish entry) = intercalate ";" [show start,show finish,show $ diffSeconds (zonedTimeToUTC finish) (zonedTimeToUTC start),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
 
-formatDiddoEntry :: String -> DiddoEntry -> String
-formatDiddoEntry format entry = (formatTime defaultTimeLocale format (startTime entry)) ++ ";" ++ (formatTime defaultTimeLocale format (endTime entry)) ++ ";" ++ (show $ secondsToHMS $ diffSeconds (zonedTimeToUTC (endTime entry)) (zonedTimeToUTC (startTime entry))) ++ ";" ++ comment entry
+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 :: String -> 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           = splitOn ";" line
-        string              = intercalate ";" $ 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 :: String -> ZonedTime
-parseISOsecondsTime = parseToZonedTime $ iso8601DateFormat $ Just "%T%z"
+parseISOsecondsTime :: T.Text -> ZonedTime
+parseISOsecondsTime timestring = parseToZonedTime (iso8601DateFormat $ Just "%T%z") $ T.unpack timestring
+
+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