parent
72cf6a8219
commit
9501b43471
@ -20,6 +20,7 @@ module Hledger.Data.Journal (
|
|||||||
commodityStylesFromAmounts,
|
commodityStylesFromAmounts,
|
||||||
journalConvertAmountsToCost,
|
journalConvertAmountsToCost,
|
||||||
journalFinalise,
|
journalFinalise,
|
||||||
|
journalPivot,
|
||||||
-- * Filtering
|
-- * Filtering
|
||||||
filterJournalTransactions,
|
filterJournalTransactions,
|
||||||
filterJournalPostings,
|
filterJournalPostings,
|
||||||
@ -885,6 +886,32 @@ test_journalDateSpan = do
|
|||||||
]}
|
]}
|
||||||
-- #endif
|
-- #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
|
-- Misc helpers
|
||||||
|
|
||||||
-- | Check if a set of hledger account/description filter patterns matches the
|
-- | Check if a set of hledger account/description filter patterns matches the
|
||||||
|
|||||||
@ -25,7 +25,6 @@ module Hledger.Data.Posting (
|
|||||||
hasAmount,
|
hasAmount,
|
||||||
postingAllTags,
|
postingAllTags,
|
||||||
transactionAllTags,
|
transactionAllTags,
|
||||||
postingAllImplicitTags,
|
|
||||||
relatedPostings,
|
relatedPostings,
|
||||||
removePrices,
|
removePrices,
|
||||||
-- * date operations
|
-- * date operations
|
||||||
@ -175,14 +174,6 @@ postingStatus Posting{pstatus=s, ptransaction=mt}
|
|||||||
Nothing -> Unmarked
|
Nothing -> Unmarked
|
||||||
| otherwise = s
|
| 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 :: Transaction -> Text
|
||||||
transactionPayee = fst . payeeAndNoteFromDescription . tdescription
|
transactionPayee = fst . payeeAndNoteFromDescription . tdescription
|
||||||
|
|
||||||
@ -200,11 +191,6 @@ payeeAndNoteFromDescription t
|
|||||||
where
|
where
|
||||||
(p, n) = T.span (/= '|') t
|
(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.
|
-- | Tags for this posting including any inherited from its parent transaction.
|
||||||
postingAllTags :: Posting -> [Tag]
|
postingAllTags :: Posting -> [Tag]
|
||||||
postingAllTags p = ptags p ++ maybe [] ttags (ptransaction p)
|
postingAllTags p = ptags p ++ maybe [] ttags (ptransaction p)
|
||||||
|
|||||||
@ -29,7 +29,6 @@ import Control.Monad ((<=<))
|
|||||||
import Data.Hashable (hash)
|
import Data.Hashable (hash)
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Text (Text)
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import Data.Time (Day)
|
import Data.Time (Day)
|
||||||
@ -47,6 +46,7 @@ import Test.HUnit
|
|||||||
import Text.Printf
|
import Text.Printf
|
||||||
import Text.Regex.TDFA ((=~))
|
import Text.Regex.TDFA ((=~))
|
||||||
|
|
||||||
|
import Hledger.Data.Journal (journalPivot)
|
||||||
|
|
||||||
-- kludge - adapt to whichever directory version is installed, or when
|
-- kludge - adapt to whichever directory version is installed, or when
|
||||||
-- cabal macros aren't available, assume the new directory
|
-- cabal macros aren't available, assume the new directory
|
||||||
@ -91,19 +91,9 @@ withJournalDo opts cmd = do
|
|||||||
pivotByOpts :: CliOpts -> Journal -> Journal
|
pivotByOpts :: CliOpts -> Journal -> Journal
|
||||||
pivotByOpts opts =
|
pivotByOpts opts =
|
||||||
case maybestringopt "pivot" . rawopts_ $ opts of
|
case maybestringopt "pivot" . rawopts_ $ opts of
|
||||||
Just tag -> pivot $ T.pack tag
|
Just tag -> journalPivot $ T.pack tag
|
||||||
Nothing -> id
|
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
|
-- | Apply the anonymisation transformation on a journal, if option is present
|
||||||
anonymiseByOpts :: CliOpts -> Journal -> Journal
|
anonymiseByOpts :: CliOpts -> Journal -> Journal
|
||||||
anonymiseByOpts opts =
|
anonymiseByOpts opts =
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user