From b0178b88ccbae6ffa07efcba34c43ae40adc11f5 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Sat, 24 Jan 2009 18:48:28 +0000
Subject: [PATCH] make prepareLedger use current time, not just date

---
 Tests.hs   |  7 ++++---
 Utils.hs   | 19 ++++++++++---------
 hledger.hs |  4 ++--
 3 files changed, 16 insertions(+), 14 deletions(-)

diff --git a/Tests.hs b/Tests.hs
index d6cbba7bd..b50076c68 100644
--- a/Tests.hs
+++ b/Tests.hs
@@ -458,7 +458,7 @@ balancecommand_tests = TestList [
              (showBalanceReport [] [] l)
  ,
   "balance report elides zero-balance root account(s)" ~: do
-    l <- ledgerfromstringwithopts [] [] refdate
+    l <- ledgerfromstringwithopts [] [] reftime
              ("2008/1/1 one\n" ++
               "  test:a  1\n" ++
               "  test:b\n"
@@ -564,8 +564,9 @@ registercommand_tests = TestList [
 -- test data
 
 refdate = parsedate "2008/11/26"
-sampleledger = ledgerfromstringwithopts [] [] refdate sample_ledger_str
-sampleledgerwithopts opts args = ledgerfromstringwithopts opts args refdate sample_ledger_str
+reftime = dayToUTC refdate
+sampleledger = ledgerfromstringwithopts [] [] reftime sample_ledger_str
+sampleledgerwithopts opts args = ledgerfromstringwithopts opts args reftime sample_ledger_str
 --sampleledgerwithoptsanddate opts args date = unsafePerformIO $ ledgerfromstringwithopts opts args date sample_ledger_str
 
 sample_ledger_str = (
diff --git a/Utils.hs b/Utils.hs
index 75457dec8..4e233027e 100644
--- a/Utils.hs
+++ b/Utils.hs
@@ -8,6 +8,7 @@ module Utils
 where
 import Control.Monad.Error
 import qualified Data.Map as Map (lookup)
+import Data.Time.Clock
 import Text.ParserCombinators.Parsec
 import System.IO
 import Options
@@ -15,13 +16,13 @@ import Ledger
 
 
 -- | Convert a RawLedger to a canonicalised, cached and filtered Ledger
--- based on the command-line options/arguments and today's date.
-prepareLedger ::  [Opt] -> [String] -> Day -> String -> RawLedger -> Ledger
-prepareLedger opts args refdate rawtext rl = l{rawledgertext=rawtext}
+-- based on the command-line options/arguments and the current date/time.
+prepareLedger ::  [Opt] -> [String] -> UTCTime -> String -> RawLedger -> Ledger
+prepareLedger opts args reftime rawtext rl = l{rawledgertext=rawtext}
     where
       l = cacheLedger apats $ filterRawLedger span dpats c r $ canonicaliseAmounts cb rl
       (apats,dpats) = parseAccountDescriptionArgs [] args
-      span = dateSpanFromOpts refdate opts
+      span = dateSpanFromOpts (utctDay reftime) opts
       c = Cleared `elem` opts
       r = Real `elem` opts
       cb = CostBasis `elem` opts
@@ -31,17 +32,17 @@ rawledgerfromstring :: String -> IO RawLedger
 rawledgerfromstring = liftM (either error id) . runErrorT . parseLedger "(string)"
 
 -- | Get a Ledger from the given string and options, or raise an error.
-ledgerfromstringwithopts :: [Opt] -> [String] -> Day -> String -> IO Ledger
-ledgerfromstringwithopts opts args refdate s =
-    liftM (prepareLedger opts args refdate s) $ rawledgerfromstring s
+ledgerfromstringwithopts :: [Opt] -> [String] -> UTCTime -> String -> IO Ledger
+ledgerfromstringwithopts opts args reftime s =
+    liftM (prepareLedger opts args reftime s) $ rawledgerfromstring s
 
 -- | Get a Ledger from the given file path and options, or raise an error.
 ledgerfromfilewithopts :: [Opt] -> [String] -> FilePath -> IO Ledger
 ledgerfromfilewithopts opts args f = do
-  refdate <- today
   s <- readFile f 
   rl <- rawledgerfromstring s
-  return $ prepareLedger opts args refdate s rl
+  reftime <- now
+  return $ prepareLedger opts args reftime s rl
            
 -- | Get a Ledger from your default ledger file, or raise an error.
 -- Assumes no options.
diff --git a/hledger.hs b/hledger.hs
index f2e9a6277..03a7cfca6 100644
--- a/hledger.hs
+++ b/hledger.hs
@@ -92,11 +92,11 @@ main = do
 -- (or report a parse error). This function makes the whole thing go.
 parseLedgerAndDo :: [Opt] -> [String] -> ([Opt] -> [String] -> Ledger -> IO ()) -> IO ()
 parseLedgerAndDo opts args cmd = do
-  refdate <- today
   f <- ledgerFilePathFromOpts opts
   -- XXX we read the file twice - inelegant
   -- and, doesn't work with stdin. kludge it, stdin won't work with ui command
   let f' = if f == "-" then "/dev/null" else f
   rawtext <- readFile f'
-  let runcmd = cmd opts args . prepareLedger opts args refdate rawtext
+  reftime <- now
+  let runcmd = cmd opts args . prepareLedger opts args reftime rawtext
   return f >>= runErrorT . parseLedgerFile >>= either (hPutStrLn stderr) runcmd