From a8bfb06da41985c134258660a6a08fe05b5c217e Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 9 Jul 2009 19:22:27 +0000 Subject: [PATCH] refactor effective date support, fix warnings --- Ledger/IO.hs | 19 ++++--------------- Ledger/LedgerTransaction.hs | 9 ++++++++- Ledger/RawLedger.hs | 8 ++++++++ Ledger/TimeLog.hs | 1 + Ledger/Transaction.hs | 2 +- Ledger/Types.hs | 2 ++ Options.hs | 4 ++-- 7 files changed, 26 insertions(+), 19 deletions(-) diff --git a/Ledger/IO.hs b/Ledger/IO.hs index 04112ddbf..59f9cdddf 100644 --- a/Ledger/IO.hs +++ b/Ledger/IO.hs @@ -5,11 +5,10 @@ Utilities for doing I/O with ledger files. module Ledger.IO where import Control.Monad.Error -import Data.Maybe (fromMaybe) import Ledger.Ledger (cacheLedger) import Ledger.Parse (parseLedger) -import Ledger.RawLedger (canonicaliseAmounts,filterRawLedger) -import Ledger.Types (DateSpan(..),LedgerTransaction(..),RawLedger(..),Ledger(..)) +import Ledger.RawLedger (canonicaliseAmounts,filterRawLedger,rawLedgerSelectingDate) +import Ledger.Types (WhichDate(..),DateSpan(..),RawLedger(..),Ledger(..)) import Ledger.Utils (getCurrentLocalTime) import System.Directory (getHomeDirectory) import System.Environment (getEnv) @@ -32,9 +31,7 @@ type IOArgs = (DateSpan -- ^ only include transactions in this date span ,WhichDate -- ^ which dates to use (transaction or effective) ) -data WhichDate = TransactionDate | EffectiveDate - -noioargs = (DateSpan Nothing Nothing, Nothing, False, False, [], [], TransactionDate) +noioargs = (DateSpan Nothing Nothing, Nothing, False, False, [], [], ActualDate) -- | Get the user's default ledger file path. myLedgerPath :: IO String @@ -84,18 +81,10 @@ filterAndCacheLedger :: IOArgs -> String -> RawLedger -> Ledger filterAndCacheLedger (span,cleared,real,costbasis,apats,dpats,whichdate) rawtext rl = (cacheLedger apats $ filterRawLedger span dpats cleared real - $ selectDates whichdate + $ rawLedgerSelectingDate whichdate $ canonicaliseAmounts costbasis rl ){rawledgertext=rawtext} -selectDates :: WhichDate -> RawLedger -> RawLedger -selectDates TransactionDate rl = rl -selectDates EffectiveDate rl = rl{ledger_txns=ts} - where - ts = map selectdate $ ledger_txns rl - selectdate (t@LedgerTransaction{ltdate=d,lteffectivedate=e}) = - t{ltdate=fromMaybe d e} - -- -- | Expand ~ in a file path (does not handle ~name). -- tildeExpand :: FilePath -> IO FilePath -- tildeExpand ('~':[]) = getHomeDirectory diff --git a/Ledger/LedgerTransaction.hs b/Ledger/LedgerTransaction.hs index 48afd532b..a73e9b0f3 100644 --- a/Ledger/LedgerTransaction.hs +++ b/Ledger/LedgerTransaction.hs @@ -25,6 +25,7 @@ instance Show PeriodicTransaction where nullledgertxn :: LedgerTransaction nullledgertxn = LedgerTransaction { ltdate=parsedate "1900/1/1", + lteffectivedate=Nothing, ltstatus=False, ltcode="", ltdescription="", @@ -115,4 +116,10 @@ balanceLedgerTransaction t@LedgerTransaction{ltpostings=ps} where otherstotal = sum $ map pamount withamounts printerr s = printf "%s:\n%s" s (showLedgerTransactionUnelided t) -nonzerobalanceerror = "could not balance this transaction, amounts do not add up to zero" \ No newline at end of file +nonzerobalanceerror = "could not balance this transaction, amounts do not add up to zero" + +-- | Convert the primary date to either the actual or effective date. +ledgerTransactionWithDate :: WhichDate -> LedgerTransaction -> LedgerTransaction +ledgerTransactionWithDate ActualDate t = t +ledgerTransactionWithDate EffectiveDate t = t{ltdate=fromMaybe (ltdate t) (lteffectivedate t)} + diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs index 94da39867..a5c93b7a8 100644 --- a/Ledger/RawLedger.hs +++ b/Ledger/RawLedger.hs @@ -13,6 +13,7 @@ import Ledger.Utils import Ledger.Types import Ledger.AccountName import Ledger.Amount +import Ledger.LedgerTransaction (ledgerTransactionWithDate) import Ledger.Transaction import Ledger.Posting import Ledger.TimeLog @@ -119,6 +120,13 @@ filterRawLedgerTransactionsByAccount :: [String] -> RawLedger -> RawLedger filterRawLedgerTransactionsByAccount apats (RawLedger ms ps ts tls hs f fp) = RawLedger ms ps (filter (any (matchpats apats . paccount) . ltpostings) ts) tls hs f fp +-- | Convert this ledger's transactions' primary date to either their +-- actual or effective date. +rawLedgerSelectingDate :: WhichDate -> RawLedger -> RawLedger +rawLedgerSelectingDate ActualDate rl = rl +rawLedgerSelectingDate EffectiveDate rl = + rl{ledger_txns=map (ledgerTransactionWithDate EffectiveDate) $ ledger_txns rl} + -- | Give all a ledger's amounts their canonical display settings. That -- is, in each commodity, amounts will use the display settings of the -- first amount detected, and the greatest precision of the amounts diff --git a/Ledger/TimeLog.hs b/Ledger/TimeLog.hs index 03bd5a91a..2e14de292 100644 --- a/Ledger/TimeLog.hs +++ b/Ledger/TimeLog.hs @@ -67,6 +67,7 @@ entryFromTimeLogInOut i o where t = LedgerTransaction { ltdate = idate, + lteffectivedate = Nothing, ltstatus = True, ltcode = "", ltdescription = showtime itod ++ "-" ++ showtime otod, diff --git a/Ledger/Transaction.hs b/Ledger/Transaction.hs index 0bde34dbf..708533316 100644 --- a/Ledger/Transaction.hs +++ b/Ledger/Transaction.hs @@ -30,7 +30,7 @@ showTransaction (Transaction _ stat d desc a amt ttype) = -- is attached to the transactions to preserve their grouping - it should -- be unique per entry. flattenLedgerTransaction :: (LedgerTransaction, Int) -> [Transaction] -flattenLedgerTransaction (LedgerTransaction d ed s _ desc _ ps _, n) = +flattenLedgerTransaction (LedgerTransaction d _ s _ desc _ ps _, n) = [Transaction n s d desc (paccount p) (pamount p) (ptype p) | p <- ps] accountNamesFromTransactions :: [Transaction] -> [AccountName] diff --git a/Ledger/Types.hs b/Ledger/Types.hs index 3a9aab91f..15e98bb28 100644 --- a/Ledger/Types.hs +++ b/Ledger/Types.hs @@ -30,6 +30,8 @@ import qualified Data.Map as Map type SmartDate = (String,String,String) +data WhichDate = ActualDate | EffectiveDate + data DateSpan = DateSpan (Maybe Day) (Maybe Day) deriving (Eq,Show,Ord) data Interval = NoInterval | Daily | Weekly | Monthly | Quarterly | Yearly diff --git a/Options.hs b/Options.hs index e7e959373..1b19fe219 100644 --- a/Options.hs +++ b/Options.hs @@ -7,7 +7,7 @@ module Options where import System.Console.GetOpt import System.Environment -import Ledger.IO (IOArgs,myLedgerPath,myTimelogPath,WhichDate(..)) +import Ledger.IO (IOArgs,myLedgerPath,myTimelogPath) import Ledger.Utils import Ledger.Types import Ledger.Dates @@ -239,6 +239,6 @@ optsToIOArgs opts args t = (dateSpanFromOpts (localDay t) opts ,dpats ,case Effective `elem` opts of True -> EffectiveDate - _ -> TransactionDate + _ -> ActualDate ) where (apats,dpats) = parsePatternArgs args