refactor IOArgs -> FilterSpec and make haddock happy

This commit is contained in:
Simon Michael 2009-07-09 20:25:50 +00:00
parent a8bfb06da4
commit 6fb1804cfd
5 changed files with 55 additions and 40 deletions

View File

@ -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}

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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)