parent
72cf6a8219
commit
9501b43471
@ -20,6 +20,7 @@ module Hledger.Data.Journal (
|
||||
commodityStylesFromAmounts,
|
||||
journalConvertAmountsToCost,
|
||||
journalFinalise,
|
||||
journalPivot,
|
||||
-- * Filtering
|
||||
filterJournalTransactions,
|
||||
filterJournalPostings,
|
||||
@ -885,6 +886,32 @@ test_journalDateSpan = do
|
||||
]}
|
||||
-- #endif
|
||||
|
||||
-- | Apply the pivot transformation to all postings in a journal,
|
||||
-- replacing their account name by their value for the given field or tag.
|
||||
journalPivot :: Text -> Journal -> Journal
|
||||
journalPivot fieldortagname j = j{jtxns = map (transactionPivot fieldortagname) . jtxns $ j}
|
||||
|
||||
-- | Replace this transaction's postings' account names with the value
|
||||
-- of the given field or tag, if any.
|
||||
transactionPivot :: Text -> Transaction -> Transaction
|
||||
transactionPivot fieldortagname t = t{tpostings = map (postingPivot fieldortagname) . tpostings $ t}
|
||||
|
||||
-- | Replace this posting's account name with the value
|
||||
-- of the given field or tag, if any, otherwise the empty string.
|
||||
postingPivot :: Text -> Posting -> Posting
|
||||
postingPivot fieldortagname p = p{paccount = pivotedacct, porigin = Just $ originalPosting p}
|
||||
where
|
||||
pivotedacct
|
||||
| Just t <- ptransaction p, fieldortagname == "code" = tcode t
|
||||
| Just t <- ptransaction p, fieldortagname == "description" = tdescription t
|
||||
| Just t <- ptransaction p, fieldortagname == "payee" = transactionPayee t
|
||||
| Just t <- ptransaction p, fieldortagname == "note" = transactionNote t
|
||||
| Just (_, value) <- postingFindTag fieldortagname p = value
|
||||
| otherwise = ""
|
||||
|
||||
postingFindTag :: TagName -> Posting -> Maybe (TagName, TagValue)
|
||||
postingFindTag tagname p = find ((tagname==) . fst) $ postingAllTags p
|
||||
|
||||
-- Misc helpers
|
||||
|
||||
-- | Check if a set of hledger account/description filter patterns matches the
|
||||
|
||||
@ -25,7 +25,6 @@ module Hledger.Data.Posting (
|
||||
hasAmount,
|
||||
postingAllTags,
|
||||
transactionAllTags,
|
||||
postingAllImplicitTags,
|
||||
relatedPostings,
|
||||
removePrices,
|
||||
-- * date operations
|
||||
@ -175,14 +174,6 @@ postingStatus Posting{pstatus=s, ptransaction=mt}
|
||||
Nothing -> Unmarked
|
||||
| otherwise = s
|
||||
|
||||
-- | Implicit tags for this transaction.
|
||||
transactionImplicitTags :: Transaction -> [Tag]
|
||||
transactionImplicitTags t = filter (not . T.null . snd) [("code", tcode t)
|
||||
,("description", tdescription t)
|
||||
,("payee", transactionPayee t)
|
||||
,("note", transactionNote t)
|
||||
]
|
||||
|
||||
transactionPayee :: Transaction -> Text
|
||||
transactionPayee = fst . payeeAndNoteFromDescription . tdescription
|
||||
|
||||
@ -200,11 +191,6 @@ payeeAndNoteFromDescription t
|
||||
where
|
||||
(p, n) = T.span (/= '|') t
|
||||
|
||||
-- | Tags for this posting including implicit and any inherited from its parent transaction.
|
||||
postingAllImplicitTags :: Posting -> [Tag]
|
||||
postingAllImplicitTags p = ptags p ++ maybe [] transactionTags (ptransaction p)
|
||||
where transactionTags t = ttags t ++ transactionImplicitTags t
|
||||
|
||||
-- | Tags for this posting including any inherited from its parent transaction.
|
||||
postingAllTags :: Posting -> [Tag]
|
||||
postingAllTags p = ptags p ++ maybe [] ttags (ptransaction p)
|
||||
|
||||
@ -29,7 +29,6 @@ import Control.Monad ((<=<))
|
||||
import Data.Hashable (hash)
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Data.Time (Day)
|
||||
@ -47,6 +46,7 @@ import Test.HUnit
|
||||
import Text.Printf
|
||||
import Text.Regex.TDFA ((=~))
|
||||
|
||||
import Hledger.Data.Journal (journalPivot)
|
||||
|
||||
-- kludge - adapt to whichever directory version is installed, or when
|
||||
-- cabal macros aren't available, assume the new directory
|
||||
@ -91,19 +91,9 @@ withJournalDo opts cmd = do
|
||||
pivotByOpts :: CliOpts -> Journal -> Journal
|
||||
pivotByOpts opts =
|
||||
case maybestringopt "pivot" . rawopts_ $ opts of
|
||||
Just tag -> pivot $ T.pack tag
|
||||
Just tag -> journalPivot $ T.pack tag
|
||||
Nothing -> id
|
||||
|
||||
-- | Apply the pivot transformation by given tag on a journal.
|
||||
pivot :: Text -> Journal -> Journal
|
||||
pivot tag j = j{jtxns = map pivotTrans . jtxns $ j}
|
||||
where
|
||||
pivotTrans t = t{tpostings = map pivotPosting . tpostings $ t}
|
||||
pivotPosting p
|
||||
| Just (_ , value) <- tagTuple = p{paccount = value, porigin = Just $ originalPosting p}
|
||||
| _ <- tagTuple = p{paccount = T.pack "", porigin = Just $ originalPosting p}
|
||||
where tagTuple = find ((tag ==) . fst) . postingAllImplicitTags $ p
|
||||
|
||||
-- | Apply the anonymisation transformation on a journal, if option is present
|
||||
anonymiseByOpts :: CliOpts -> Journal -> Journal
|
||||
anonymiseByOpts opts =
|
||||
|
||||
Loading…
Reference in New Issue
Block a user