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