From 6fb1804cfd669ebfeb5c0a6224be8d6b67b0ae0e Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 9 Jul 2009 20:25:50 +0000 Subject: [PATCH] refactor IOArgs -> FilterSpec and make haddock happy --- Ledger/IO.hs | 44 +++++++++++++++++++++++--------------------- Ledger/Ledger.hs | 6 +++--- Ledger/Types.hs | 11 +++++++++++ Options.hs | 28 +++++++++++++++------------- Utils.hs | 6 +++--- 5 files changed, 55 insertions(+), 40 deletions(-) diff --git a/Ledger/IO.hs b/Ledger/IO.hs index 59f9cdddf..6e314ae09 100644 --- a/Ledger/IO.hs +++ b/Ledger/IO.hs @@ -8,7 +8,7 @@ import Control.Monad.Error import Ledger.Ledger (cacheLedger) import Ledger.Parse (parseLedger) import Ledger.RawLedger (canonicaliseAmounts,filterRawLedger,rawLedgerSelectingDate) -import Ledger.Types (WhichDate(..),DateSpan(..),RawLedger(..),Ledger(..)) +import Ledger.Types (FilterSpec(..),WhichDate(..),DateSpan(..),RawLedger(..),Ledger(..)) import Ledger.Utils (getCurrentLocalTime) import System.Directory (getHomeDirectory) import System.Environment (getEnv) @@ -21,17 +21,15 @@ timelogenvvar = "TIMELOG" ledgerdefaultfilename = ".ledger" timelogdefaultfilename = ".timelog" --- | A tuple of arguments specifying how to filter a raw ledger file. -type IOArgs = (DateSpan -- ^ only include transactions in this date span - ,Maybe Bool -- ^ only include if cleared\/uncleared\/don't care - ,Bool -- ^ only include if real\/don't care - ,Bool -- ^ convert all amounts to cost basis - ,[String] -- ^ only include if matching these account patterns - ,[String] -- ^ only include if matching these description patterns - ,WhichDate -- ^ which dates to use (transaction or effective) - ) - -noioargs = (DateSpan Nothing Nothing, Nothing, False, False, [], [], ActualDate) +nullfilterspec = FilterSpec { + datespan=DateSpan Nothing Nothing + ,cleared=Nothing + ,real=False + ,costbasis=False + ,acctpats=[] + ,descpats=[] + ,whichdate=ActualDate + } -- | Get the user's default ledger file path. myLedgerPath :: IO String @@ -59,15 +57,15 @@ myTimelog = myTimelogPath >>= readLedger -- | Read a ledger from this file, with no filtering, or give an error. readLedger :: FilePath -> IO Ledger -readLedger = readLedgerWithIOArgs noioargs +readLedger = readLedgerWithFilterSpec nullfilterspec --- | Read a ledger from this file, filtering according to the io args, +-- | Read a ledger from this file, filtering according to the filter spec., -- | or give an error. -readLedgerWithIOArgs :: IOArgs -> FilePath -> IO Ledger -readLedgerWithIOArgs ioargs f = do +readLedgerWithFilterSpec :: FilterSpec -> FilePath -> IO Ledger +readLedgerWithFilterSpec fspec f = do s <- readFile f rl <- rawLedgerFromString s - return $ filterAndCacheLedger ioargs s rl + return $ filterAndCacheLedger fspec s rl -- | Read a RawLedger from the given string, using the current time as -- reference time, or give a parse error. @@ -77,10 +75,14 @@ rawLedgerFromString s = do liftM (either error id) $ runErrorT $ parseLedger t "(string)" s -- | Convert a RawLedger to a canonicalised, cached and filtered Ledger. -filterAndCacheLedger :: IOArgs -> String -> RawLedger -> Ledger -filterAndCacheLedger (span,cleared,real,costbasis,apats,dpats,whichdate) rawtext rl = - (cacheLedger apats - $ filterRawLedger span dpats cleared real +filterAndCacheLedger :: FilterSpec -> String -> RawLedger -> Ledger +filterAndCacheLedger (FilterSpec{datespan=datespan,cleared=cleared,real=real, + costbasis=costbasis,acctpats=acctpats, + descpats=descpats,whichdate=whichdate}) + rawtext + rl = + (cacheLedger acctpats + $ filterRawLedger datespan descpats cleared real $ rawLedgerSelectingDate whichdate $ canonicaliseAmounts costbasis rl ){rawledgertext=rawtext} diff --git a/Ledger/Ledger.hs b/Ledger/Ledger.hs index e0b2076a3..980138455 100644 --- a/Ledger/Ledger.hs +++ b/Ledger/Ledger.hs @@ -39,7 +39,7 @@ aliases for easier interaction. Here's an example: > Node {rootLabel = Account top with 0 txns and 0 balance, subForest = [... > > accounttreeat l (account l "assets") > Just (Node {rootLabel = Account assets with 0 txns and $-1 balance, ... -> > datespan l +> > datespan l -- disabled > DateSpan (Just 2008-01-01) (Just 2009-01-01) > > rawdatespan l > DateSpan (Just 2008-01-01) (Just 2009-01-01) @@ -206,8 +206,8 @@ accounttree = ledgerAccountTree accounttreeat :: Ledger -> Account -> Maybe (Tree Account) accounttreeat = ledgerAccountTreeAt -datespan :: Ledger -> DateSpan -datespan = ledgerDateSpan +-- datespan :: Ledger -> DateSpan +-- datespan = ledgerDateSpan rawdatespan :: Ledger -> DateSpan rawdatespan = rawLedgerDateSpan . rawledger diff --git a/Ledger/Types.hs b/Ledger/Types.hs index 15e98bb28..08459d2a7 100644 --- a/Ledger/Types.hs +++ b/Ledger/Types.hs @@ -115,6 +115,17 @@ data RawLedger = RawLedger { filepath :: FilePath } deriving (Eq) +-- | A generic, pure specification of how to filter raw ledger transactions. +data FilterSpec = FilterSpec { + datespan :: DateSpan -- ^ only include transactions in this date span + ,cleared :: Maybe Bool -- ^ only include if cleared\/uncleared\/don't care + ,real :: Bool -- ^ only include if real\/don't care + ,costbasis :: Bool -- ^ convert all amounts to cost basis + ,acctpats :: [String] -- ^ only include if matching these account patterns + ,descpats :: [String] -- ^ only include if matching these description patterns + ,whichdate :: WhichDate -- ^ which dates to use (transaction or effective) + } + data Transaction = Transaction { tnum :: Int, tstatus :: Bool, -- ^ posting status diff --git a/Options.hs b/Options.hs index 1b19fe219..d6530d613 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) +import Ledger.IO (myLedgerPath,myTimelogPath) import Ledger.Utils import Ledger.Types import Ledger.Dates @@ -229,16 +229,18 @@ parsePatternArgs args = (as, ds') (ds, as) = partition (descprefix `isPrefixOf`) args ds' = map (drop (length descprefix)) ds --- | Convert application options to more generic types for the library. -optsToIOArgs :: [Opt] -> [String] -> LocalTime -> IOArgs -optsToIOArgs opts args t = (dateSpanFromOpts (localDay t) opts - ,clearedValueFromOpts opts - ,Real `elem` opts - ,CostBasis `elem` opts - ,apats - ,dpats - ,case Effective `elem` opts of - True -> EffectiveDate - _ -> ActualDate - ) where (apats,dpats) = parsePatternArgs args +-- | Convert application options to the library's generic filter specification. +optsToFilterSpec :: [Opt] -> [String] -> LocalTime -> FilterSpec +optsToFilterSpec opts args t = FilterSpec { + datespan=dateSpanFromOpts (localDay t) opts + ,cleared=clearedValueFromOpts opts + ,real=Real `elem` opts + ,costbasis=CostBasis `elem` opts + ,acctpats=apats + ,descpats=dpats + ,whichdate=case Effective `elem` opts of + True -> EffectiveDate + _ -> ActualDate + } + where (apats,dpats) = parsePatternArgs args diff --git a/Utils.hs b/Utils.hs index f974bca1b..d77cf0f49 100644 --- a/Utils.hs +++ b/Utils.hs @@ -9,7 +9,7 @@ module Utils where import Control.Monad.Error import Ledger -import Options (Opt,ledgerFilePathFromOpts,optsToIOArgs) +import Options (Opt,ledgerFilePathFromOpts,optsToFilterSpec) import System.Directory (doesFileExist) import System.IO @@ -42,10 +42,10 @@ ledgerFromStringWithOpts opts args reftime s = readLedgerWithOpts :: [Opt] -> [String] -> FilePath -> IO Ledger readLedgerWithOpts opts args f = do t <- getCurrentLocalTime - readLedgerWithIOArgs (optsToIOArgs opts args t) f + readLedgerWithFilterSpec (optsToFilterSpec opts args t) f -- | Convert a RawLedger to a canonicalised, cached and filtered Ledger -- based on the command-line options/arguments and a reference time. filterAndCacheLedgerWithOpts :: [Opt] -> [String] -> LocalTime -> String -> RawLedger -> Ledger -filterAndCacheLedgerWithOpts opts args t = filterAndCacheLedger (optsToIOArgs opts args t) +filterAndCacheLedgerWithOpts opts args t = filterAndCacheLedger (optsToFilterSpec opts args t)