refactor effective date support, fix warnings

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

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"
+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)}
+    

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

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,

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]

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 

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