mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
refactor effective date support, fix warnings
This commit is contained in:
parent
06eb2a9aa8
commit
a8bfb06da4
19
Ledger/IO.hs
19
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
|
||||
|
@ -25,6 +25,7 @@ instance Show PeriodicTransaction where
|
||||
nullledgertxn :: LedgerTransaction
|
||||
nullledgertxn = LedgerTransaction {
|
||||
ltdate=parsedate "1900/1/1",
|
||||
lteffectivedate=Nothing,
|
||||
ltstatus=False,
|
||||
ltcode="",
|
||||
ltdescription="",
|
||||
@ -116,3 +117,9 @@ balanceLedgerTransaction t@LedgerTransaction{ltpostings=ps}
|
||||
printerr s = printf "%s:\n%s" s (showLedgerTransactionUnelided t)
|
||||
|
||||
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)}
|
||||
|
||||
|
@ -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
|
||||
|
@ -67,6 +67,7 @@ entryFromTimeLogInOut i o
|
||||
where
|
||||
t = LedgerTransaction {
|
||||
ltdate = idate,
|
||||
lteffectivedate = Nothing,
|
||||
ltstatus = True,
|
||||
ltcode = "",
|
||||
ltdescription = showtime itod ++ "-" ++ showtime otod,
|
||||
|
@ -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]
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user