diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 130d00c12..dcd7bbb34 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index cac16538a..f6456347f 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -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) diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index d1caab891..f0d1d51e2 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -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 =