From a78f5a1f0459a8e357164ba30aa4b8be6beca42b Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Fri, 3 Apr 2009 20:04:51 +0000
Subject: [PATCH] model timelog entry codes precisely

---
 Ledger/Parse.hs   |  2 +-
 Ledger/TimeLog.hs | 17 ++++++++++++++++-
 Ledger/Types.hs   | 17 ++++++++++-------
 Tests.hs          |  8 ++++----
 4 files changed, 31 insertions(+), 13 deletions(-)

diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs
index 250929118..39d3e5a12 100644
--- a/Ledger/Parse.hs
+++ b/Ledger/Parse.hs
@@ -552,7 +552,7 @@ timelogentry = do
   many1 spacenonewline
   datetime <- ledgerdatetime
   comment <- liftM2 (++) getParentAccount restofline
-  return $ TimeLogEntry code datetime comment
+  return $ TimeLogEntry (read [code]) datetime comment
 
 
 -- misc parsing
diff --git a/Ledger/TimeLog.hs b/Ledger/TimeLog.hs
index f4f355f89..272b5c494 100644
--- a/Ledger/TimeLog.hs
+++ b/Ledger/TimeLog.hs
@@ -18,6 +18,21 @@ import Ledger.LedgerTransaction
 instance Show TimeLogEntry where 
     show t = printf "%s %s %s" (show $ tlcode t) (show $ tldatetime t) (tlcomment t)
 
+instance Show TimeLogCode where 
+    show SetBalance = "b"
+    show SetRequiredHours = "h"
+    show In = "i"
+    show Out = "o"
+    show FinalOut = "O"
+
+instance Read TimeLogCode where 
+    readsPrec _ ('b' : xs) = [(SetBalance, xs)]
+    readsPrec _ ('h' : xs) = [(SetRequiredHours, xs)]
+    readsPrec _ ('i' : xs) = [(In, xs)]
+    readsPrec _ ('o' : xs) = [(Out, xs)]
+    readsPrec _ ('O' : xs) = [(FinalOut, xs)]
+    readsPrec _ _ = []
+
 -- | Convert time log entries to ledger transactions. When there is no
 -- clockout, add one with the provided current time. Sessions crossing
 -- midnight are split into days to give accurate per-day totals.
@@ -27,7 +42,7 @@ entriesFromTimeLogEntries now [i]
     | odate > idate = [entryFromTimeLogInOut i o'] ++ entriesFromTimeLogEntries now [i',o]
     | otherwise = [entryFromTimeLogInOut i o]
     where
-      o = TimeLogEntry 'o' end ""
+      o = TimeLogEntry Out end ""
       end = if itime > now then itime else now
       (itime,otime) = (tldatetime i,tldatetime o)
       (idate,odate) = (localDay itime,localDay otime)
diff --git a/Ledger/Types.hs b/Ledger/Types.hs
index d3239816e..a271754c3 100644
--- a/Ledger/Types.hs
+++ b/Ledger/Types.hs
@@ -42,7 +42,6 @@ data Side = L | R deriving (Eq,Show,Ord)
 
 data Commodity = Commodity {
       symbol :: String,  -- ^ the commodity's symbol
-
       -- display preferences for amounts of this commodity
       side :: Side,      -- ^ should the symbol appear on the left or the right
       spaced :: Bool,    -- ^ should there be a space between symbol and quantity
@@ -59,7 +58,7 @@ data Amount = Amount {
 newtype MixedAmount = Mixed [Amount] deriving (Eq)
 
 data PostingType = RegularPosting | VirtualPosting | BalancedVirtualPosting
-                       deriving (Eq,Show)
+                   deriving (Eq,Show)
 
 data Posting = Posting {
       pstatus :: Bool,
@@ -89,6 +88,14 @@ data LedgerTransaction = LedgerTransaction {
       ltpreceding_comment_lines :: String
     } deriving (Eq)
 
+data TimeLogCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord) 
+
+data TimeLogEntry = TimeLogEntry {
+      tlcode :: TimeLogCode,
+      tldatetime :: LocalTime,
+      tlcomment :: String
+    } deriving (Eq,Ord)
+
 data HistoricalPrice = HistoricalPrice {
       hdate :: Day,
       hsymbol1 :: String,
@@ -106,11 +113,7 @@ data RawLedger = RawLedger {
       filepath :: FilePath
     } deriving (Eq)
 
-data TimeLogEntry = TimeLogEntry {
-      tlcode :: Char,
-      tldatetime :: LocalTime,
-      tlcomment :: String
-    } deriving (Eq,Ord)
+-- compound types for efficiency
 
 data Transaction = Transaction {
       tnum :: Int,
diff --git a/Tests.hs b/Tests.hs
index fa124db5a..e66b6aeec 100644
--- a/Tests.hs
+++ b/Tests.hs
@@ -460,8 +460,8 @@ tests = [
      let now = utcToLocalTime tz now'
          nowstr = showtime now
          yesterday = prevday today
-         clockin t a = TimeLogEntry 'i' t a
-         clockout t = TimeLogEntry 'o' t ""
+         clockin t a = TimeLogEntry In t a
+         clockout t = TimeLogEntry Out t ""
          mktime d s = LocalTime d $ fromMaybe midnight $ parseTime defaultTimeLocale "%H:%M:%S" s
          showtime t = formatTime defaultTimeLocale "%H:%M" t
          assertEntriesGiveStrings name es ss = assertEqual name ss (map ltdescription $ entriesFromTimeLogEntries now es)
@@ -1308,10 +1308,10 @@ ledger8_str = unlines
  ]
 
 timelogentry1_str  = "i 2007/03/11 16:19:00 hledger\n"
-timelogentry1 = TimeLogEntry 'i' (parsedatetime "2007/03/11 16:19:00") "hledger"
+timelogentry1 = TimeLogEntry In (parsedatetime "2007/03/11 16:19:00") "hledger"
 
 timelogentry2_str  = "o 2007/03/11 16:30:00\n"
-timelogentry2 = TimeLogEntry 'o' (parsedatetime "2007/03/11 16:30:00") ""
+timelogentry2 = TimeLogEntry Out (parsedatetime "2007/03/11 16:30:00") ""
 
 price1_str = "P 2004/05/01 XYZ $55\n"
 price1 = HistoricalPrice (parsedate "2004/05/01") "XYZ" "$" 55