more cleanup, move journal text into Journal
This commit is contained in:
parent
4d5d9214b1
commit
50200e38ed
@ -145,9 +145,9 @@ appendToLedgerFile l s =
|
|||||||
else appendFile f $ sep++s
|
else appendFile f $ sep++s
|
||||||
where
|
where
|
||||||
f = filepath $ journal l
|
f = filepath $ journal l
|
||||||
-- we keep looking at the original raw text from when the ledger
|
-- XXX we are looking at the original raw text from when the ledger
|
||||||
-- was first read, but that's good enough for now
|
-- was first read, but that's good enough for now
|
||||||
t = journaltext l
|
t = jtext $ journal l
|
||||||
sep | null $ strip t = ""
|
sep | null $ strip t = ""
|
||||||
| otherwise = replicate (2 - min 2 (length lastnls)) '\n'
|
| otherwise = replicate (2 - min 2 (length lastnls)) '\n'
|
||||||
where lastnls = takeWhile (=='\n') $ reverse t
|
where lastnls = takeWhile (=='\n') $ reverse t
|
||||||
|
|||||||
@ -110,7 +110,7 @@ reloadIfChanged opts _ l = do
|
|||||||
else return l
|
else return l
|
||||||
|
|
||||||
-- refilter :: [Opt] -> [String] -> Ledger -> LocalTime -> IO Ledger
|
-- refilter :: [Opt] -> [String] -> Ledger -> LocalTime -> IO Ledger
|
||||||
-- refilter opts args l t = return $ filterAndCacheLedgerWithOpts opts args t (journaltext l) (journal l)
|
-- refilter opts args l t = return $ filterAndCacheLedgerWithOpts opts args t (jtext $ journal l) (journal l)
|
||||||
|
|
||||||
server :: [Opt] -> [String] -> Ledger -> IO ()
|
server :: [Opt] -> [String] -> Ledger -> IO ()
|
||||||
server opts args l =
|
server opts args l =
|
||||||
|
|||||||
13
Ledger/IO.hs
13
Ledger/IO.hs
@ -64,7 +64,7 @@ readLedger f = do
|
|||||||
t <- getClockTime
|
t <- getClockTime
|
||||||
s <- readFile f
|
s <- readFile f
|
||||||
j <- journalFromString s
|
j <- journalFromString s
|
||||||
return $ cacheLedger' $ nullledger{journaltext=s,journal=j{filepath=f,filereadtime=t}}
|
return $ cacheLedger' $ nullledger{journal=j{filepath=f,filereadtime=t,jtext=s}}
|
||||||
|
|
||||||
-- -- | Read a ledger from this file, filtering according to the filter spec.,
|
-- -- | Read a ledger from this file, filtering according to the filter spec.,
|
||||||
-- -- | or give an error.
|
-- -- | or give an error.
|
||||||
@ -82,17 +82,6 @@ journalFromString s = do
|
|||||||
t <- getCurrentLocalTime
|
t <- getCurrentLocalTime
|
||||||
liftM (either error id) $ runErrorT $ parseLedger t "(string)" s
|
liftM (either error id) $ runErrorT $ parseLedger t "(string)" s
|
||||||
|
|
||||||
-- -- | Convert a Journal to a canonicalised, cached and filtered Ledger.
|
|
||||||
-- filterAndCacheLedger :: FilterSpec -> String -> Journal -> Ledger
|
|
||||||
-- filterAndCacheLedger _ -- filterspec
|
|
||||||
-- rawtext
|
|
||||||
-- j =
|
|
||||||
-- (cacheLedger $
|
|
||||||
-- -- journalSelectingDate whichdate $
|
|
||||||
-- j
|
|
||||||
-- -- filterJournalPostings filterspec $ filterJournalTransactions filterspec j
|
|
||||||
-- ){journaltext=rawtext}
|
|
||||||
|
|
||||||
-- -- | Expand ~ in a file path (does not handle ~name).
|
-- -- | Expand ~ in a file path (does not handle ~name).
|
||||||
-- tildeExpand :: FilePath -> IO FilePath
|
-- tildeExpand :: FilePath -> IO FilePath
|
||||||
-- tildeExpand ('~':[]) = getHomeDirectory
|
-- tildeExpand ('~':[]) = getHomeDirectory
|
||||||
|
|||||||
@ -39,6 +39,7 @@ nulljournal = Journal { jmodifiertxns = []
|
|||||||
, final_comment_lines = []
|
, final_comment_lines = []
|
||||||
, filepath = ""
|
, filepath = ""
|
||||||
, filereadtime = TOD 0 0
|
, filereadtime = TOD 0 0
|
||||||
|
, jtext = ""
|
||||||
}
|
}
|
||||||
|
|
||||||
addTransaction :: Transaction -> Journal -> Journal
|
addTransaction :: Transaction -> Journal -> Journal
|
||||||
@ -116,25 +117,22 @@ filterJournalPostings FilterSpec{datespan=datespan
|
|||||||
|
|
||||||
-- | Keep only ledger transactions whose description matches the description patterns.
|
-- | Keep only ledger transactions whose description matches the description patterns.
|
||||||
filterJournalTransactionsByDescription :: [String] -> Journal -> Journal
|
filterJournalTransactionsByDescription :: [String] -> Journal -> Journal
|
||||||
filterJournalTransactionsByDescription pats (Journal ms ps ts tls hs f fp ft) =
|
filterJournalTransactionsByDescription pats j@Journal{jtxns=ts} = j{jtxns=filter matchdesc ts}
|
||||||
Journal ms ps (filter matchdesc ts) tls hs f fp ft
|
|
||||||
where matchdesc = matchpats pats . tdescription
|
where matchdesc = matchpats pats . tdescription
|
||||||
|
|
||||||
-- | Keep only ledger transactions which fall between begin and end dates.
|
-- | Keep only ledger transactions which fall between begin and end dates.
|
||||||
-- We include transactions on the begin date and exclude transactions on the end
|
-- We include transactions on the begin date and exclude transactions on the end
|
||||||
-- date, like ledger. An empty date string means no restriction.
|
-- date, like ledger. An empty date string means no restriction.
|
||||||
filterJournalTransactionsByDate :: DateSpan -> Journal -> Journal
|
filterJournalTransactionsByDate :: DateSpan -> Journal -> Journal
|
||||||
filterJournalTransactionsByDate (DateSpan begin end) (Journal ms ps ts tls hs f fp ft) =
|
filterJournalTransactionsByDate (DateSpan begin end) j@Journal{jtxns=ts} = j{jtxns=filter match ts}
|
||||||
Journal ms ps (filter matchdate ts) tls hs f fp ft
|
where match t = maybe True (tdate t>=) begin && maybe True (tdate t<) end
|
||||||
where
|
|
||||||
matchdate t = maybe True (tdate t>=) begin && maybe True (tdate t<) end
|
|
||||||
|
|
||||||
-- | Keep only ledger transactions which have the requested
|
-- | Keep only ledger transactions which have the requested
|
||||||
-- cleared/uncleared status, if there is one.
|
-- cleared/uncleared status, if there is one.
|
||||||
filterJournalTransactionsByClearedStatus :: Maybe Bool -> Journal -> Journal
|
filterJournalTransactionsByClearedStatus :: Maybe Bool -> Journal -> Journal
|
||||||
filterJournalTransactionsByClearedStatus Nothing j = j
|
filterJournalTransactionsByClearedStatus Nothing j = j
|
||||||
filterJournalTransactionsByClearedStatus (Just val) (Journal ms ps ts tls hs f fp ft) =
|
filterJournalTransactionsByClearedStatus (Just val) j@Journal{jtxns=ts} = j{jtxns=filter match ts}
|
||||||
Journal ms ps (filter ((==val).tstatus) ts) tls hs f fp ft
|
where match = (==val).tstatus
|
||||||
|
|
||||||
-- | Keep only postings which have the requested cleared/uncleared status,
|
-- | Keep only postings which have the requested cleared/uncleared status,
|
||||||
-- if there is one.
|
-- if there is one.
|
||||||
@ -147,15 +145,13 @@ filterJournalPostingsByClearedStatus (Just c) j@Journal{jtxns=ts} = j{jtxns=map
|
|||||||
-- no filtering.
|
-- no filtering.
|
||||||
filterJournalPostingsByRealness :: Bool -> Journal -> Journal
|
filterJournalPostingsByRealness :: Bool -> Journal -> Journal
|
||||||
filterJournalPostingsByRealness False l = l
|
filterJournalPostingsByRealness False l = l
|
||||||
filterJournalPostingsByRealness True (Journal mts pts ts tls hs f fp ft) =
|
filterJournalPostingsByRealness True j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
|
||||||
Journal mts pts (map filterpostings ts) tls hs f fp ft
|
|
||||||
where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter isReal ps}
|
where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter isReal ps}
|
||||||
|
|
||||||
-- | Strip out any postings with zero amount, unless the flag is true.
|
-- | Strip out any postings with zero amount, unless the flag is true.
|
||||||
filterJournalPostingsByEmpty :: Bool -> Journal -> Journal
|
filterJournalPostingsByEmpty :: Bool -> Journal -> Journal
|
||||||
filterJournalPostingsByEmpty True l = l
|
filterJournalPostingsByEmpty True l = l
|
||||||
filterJournalPostingsByEmpty False (Journal mts pts ts tls hs f fp ft) =
|
filterJournalPostingsByEmpty False j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
|
||||||
Journal mts pts (map filterpostings ts) tls hs f fp ft
|
|
||||||
where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (not . isEmptyPosting) ps}
|
where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (not . isEmptyPosting) ps}
|
||||||
|
|
||||||
-- | Keep only transactions which affect accounts deeper than the specified depth.
|
-- | Keep only transactions which affect accounts deeper than the specified depth.
|
||||||
@ -168,15 +164,15 @@ filterJournalTransactionsByDepth (Just d) j@Journal{jtxns=ts} =
|
|||||||
-- (and any ledger transactions which have no postings as a result).
|
-- (and any ledger transactions which have no postings as a result).
|
||||||
filterJournalPostingsByDepth :: Maybe Int -> Journal -> Journal
|
filterJournalPostingsByDepth :: Maybe Int -> Journal -> Journal
|
||||||
filterJournalPostingsByDepth Nothing j = j
|
filterJournalPostingsByDepth Nothing j = j
|
||||||
filterJournalPostingsByDepth (Just d) (Journal mts pts ts tls hs f fp ft) =
|
filterJournalPostingsByDepth (Just d) j@Journal{jtxns=ts} =
|
||||||
Journal mts pts (filter (not . null . tpostings) $ map filtertxns ts) tls hs f fp ft
|
j{jtxns=filter (not . null . tpostings) $ map filtertxns ts}
|
||||||
where filtertxns t@Transaction{tpostings=ps} =
|
where filtertxns t@Transaction{tpostings=ps} =
|
||||||
t{tpostings=filter ((<= d) . accountNameLevel . paccount) ps}
|
t{tpostings=filter ((<= d) . accountNameLevel . paccount) ps}
|
||||||
|
|
||||||
-- | Keep only transactions which affect accounts matched by the account patterns.
|
-- | Keep only transactions which affect accounts matched by the account patterns.
|
||||||
filterJournalTransactionsByAccount :: [String] -> Journal -> Journal
|
filterJournalTransactionsByAccount :: [String] -> Journal -> Journal
|
||||||
filterJournalTransactionsByAccount apats (Journal ms ps ts tls hs f fp ft) =
|
filterJournalTransactionsByAccount apats j@Journal{jtxns=ts} = j{jtxns=filter match ts}
|
||||||
Journal ms ps (filter (any (matchpats apats . paccount) . tpostings) ts) tls hs f fp ft
|
where match = any (matchpats apats . paccount) . tpostings
|
||||||
|
|
||||||
-- | Keep only postings which affect accounts matched by the account patterns.
|
-- | Keep only postings which affect accounts matched by the account patterns.
|
||||||
-- This can leave transactions unbalanced.
|
-- This can leave transactions unbalanced.
|
||||||
@ -198,7 +194,7 @@ journalSelectingDate EffectiveDate j =
|
|||||||
-- Also, amounts are converted to cost basis if that flag is active.
|
-- Also, amounts are converted to cost basis if that flag is active.
|
||||||
-- XXX refactor
|
-- XXX refactor
|
||||||
canonicaliseAmounts :: Bool -> Journal -> Journal
|
canonicaliseAmounts :: Bool -> Journal -> Journal
|
||||||
canonicaliseAmounts costbasis j@(Journal ms ps ts tls hs f fp ft) = Journal ms ps (map fixledgertransaction ts) tls hs f fp ft
|
canonicaliseAmounts costbasis j@Journal{jtxns=ts} = j{jtxns=map fixledgertransaction ts}
|
||||||
where
|
where
|
||||||
fixledgertransaction (Transaction d ed s c de co ts pr) = Transaction d ed s c de co (map fixrawposting ts) pr
|
fixledgertransaction (Transaction d ed s c de co ts pr) = Transaction d ed s c de co (map fixrawposting ts) pr
|
||||||
where
|
where
|
||||||
|
|||||||
@ -73,7 +73,6 @@ instance Show Ledger where
|
|||||||
|
|
||||||
nullledger :: Ledger
|
nullledger :: Ledger
|
||||||
nullledger = Ledger{
|
nullledger = Ledger{
|
||||||
journaltext = "",
|
|
||||||
journal = nulljournal,
|
journal = nulljournal,
|
||||||
accountnametree = nullaccountnametree,
|
accountnametree = nullaccountnametree,
|
||||||
accountmap = fromList []
|
accountmap = fromList []
|
||||||
|
|||||||
@ -121,7 +121,8 @@ data Journal = Journal {
|
|||||||
historical_prices :: [HistoricalPrice],
|
historical_prices :: [HistoricalPrice],
|
||||||
final_comment_lines :: String,
|
final_comment_lines :: String,
|
||||||
filepath :: FilePath,
|
filepath :: FilePath,
|
||||||
filereadtime :: ClockTime
|
filereadtime :: ClockTime,
|
||||||
|
jtext :: String
|
||||||
} deriving (Eq)
|
} deriving (Eq)
|
||||||
|
|
||||||
data Account = Account {
|
data Account = Account {
|
||||||
@ -131,7 +132,6 @@ data Account = Account {
|
|||||||
}
|
}
|
||||||
|
|
||||||
data Ledger = Ledger {
|
data Ledger = Ledger {
|
||||||
journaltext :: String,
|
|
||||||
journal :: Journal,
|
journal :: Journal,
|
||||||
accountnametree :: Tree AccountName,
|
accountnametree :: Tree AccountName,
|
||||||
accountmap :: Map.Map AccountName Account
|
accountmap :: Map.Map AccountName Account
|
||||||
|
|||||||
2
Tests.hs
2
Tests.hs
@ -1240,6 +1240,7 @@ journal7 = Journal
|
|||||||
""
|
""
|
||||||
""
|
""
|
||||||
(TOD 0 0)
|
(TOD 0 0)
|
||||||
|
""
|
||||||
|
|
||||||
ledger7 = cacheLedger journal7
|
ledger7 = cacheLedger journal7
|
||||||
|
|
||||||
@ -1274,5 +1275,6 @@ journalWithAmounts as =
|
|||||||
""
|
""
|
||||||
""
|
""
|
||||||
(TOD 0 0)
|
(TOD 0 0)
|
||||||
|
""
|
||||||
where parse = fromparse . parseWithCtx emptyCtx postingamount . (" "++)
|
where parse = fromparse . parseWithCtx emptyCtx postingamount . (" "++)
|
||||||
|
|
||||||
|
|||||||
4
Utils.hs
4
Utils.hs
@ -42,8 +42,8 @@ withLedgerDo opts args cmdname cmd = do
|
|||||||
where parseerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1)
|
where parseerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1)
|
||||||
|
|
||||||
mkLedger :: [Opt] -> FilePath -> ClockTime -> String -> Journal -> Ledger
|
mkLedger :: [Opt] -> FilePath -> ClockTime -> String -> Journal -> Ledger
|
||||||
mkLedger opts f tc txt j = nullledger{journaltext=txt,journal=j'}
|
mkLedger opts f tc txt j = nullledger{journal=j'}
|
||||||
where j' = (canonicaliseAmounts costbasis j){filepath=f,filereadtime=tc}
|
where j' = (canonicaliseAmounts costbasis j){filepath=f,filereadtime=tc,jtext=txt}
|
||||||
costbasis=CostBasis `elem` opts
|
costbasis=CostBasis `elem` opts
|
||||||
|
|
||||||
-- | Get a Ledger from the given string and options, or raise an error.
|
-- | Get a Ledger from the given string and options, or raise an error.
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user