diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 56a3c9c55..aa457b5e9 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -13,6 +13,7 @@ where import Data.List import Data.Ord import Data.Time.Calendar +import Safe import Test.HUnit import Text.Printf @@ -66,11 +67,6 @@ isBalancedVirtual p = ptype p == BalancedVirtualPosting hasAmount :: Posting -> Bool hasAmount = (/= missingamt) . pamount -postingTypeFromAccountName a - | head a == '[' && last a == ']' = BalancedVirtualPosting - | head a == '(' && last a == ')' = VirtualPosting - | otherwise = RegularPosting - accountNamesFromPostings :: [Posting] -> [AccountName] accountNamesFromPostings = nub . map paccount @@ -103,6 +99,60 @@ postingsDateSpan [] = DateSpan Nothing Nothing postingsDateSpan ps = DateSpan (Just $ postingDate $ head ps') (Just $ addDays 1 $ postingDate $ last ps') where ps' = sortBy (comparing postingDate) ps +-- balanced/non-balanced posting indicators + +accountNamePostingType :: AccountName -> PostingType +accountNamePostingType a + | null a = RegularPosting + | head a == '[' && last a == ']' = BalancedVirtualPosting + | head a == '(' && last a == ')' = VirtualPosting + | otherwise = RegularPosting + +accountNameWithoutPostingType :: AccountName -> AccountName +accountNameWithoutPostingType a = case accountNamePostingType a of + BalancedVirtualPosting -> init $ tail a + VirtualPosting -> init $ tail a + RegularPosting -> a + +accountNameWithPostingType :: PostingType -> AccountName -> AccountName +accountNameWithPostingType BalancedVirtualPosting a = "["++accountNameWithoutPostingType a++"]" +accountNameWithPostingType VirtualPosting a = "("++accountNameWithoutPostingType a++")" +accountNameWithPostingType RegularPosting a = accountNameWithoutPostingType a + +-- | Prefix one account name to another, preserving posting type +-- indicators like concatAccountNames. +joinAccountNames :: AccountName -> AccountName -> AccountName +joinAccountNames a b = concatAccountNames $ filter (not . null) [a,b] + +-- | Join account names into one. If any of them has () or [] posting type +-- indicators, these (the first type encountered) will also be applied to +-- the resulting account name. +concatAccountNames :: [AccountName] -> AccountName +concatAccountNames as = accountNameWithPostingType t $ intercalate ":" $ map accountNameWithoutPostingType as + where t = headDef RegularPosting $ filter (/= RegularPosting) $ map accountNamePostingType as + tests_Hledger_Data_Posting = TestList [ + + "accountNamePostingType" ~: do + accountNamePostingType "a" `is` RegularPosting + accountNamePostingType "(a)" `is` VirtualPosting + accountNamePostingType "[a]" `is` BalancedVirtualPosting + + ,"accountNameWithoutPostingType" ~: do + accountNameWithoutPostingType "(a)" `is` "a" + + ,"accountNameWithPostingType" ~: do + accountNameWithPostingType VirtualPosting "[a]" `is` "(a)" + + ,"joinAccountNames" ~: do + "a" `joinAccountNames` "b:c" `is` "a:b:c" + "a" `joinAccountNames` "(b:c)" `is` "(a:b:c)" + "[a]" `joinAccountNames` "(b:c)" `is` "[a:b:c]" + "" `joinAccountNames` "a" `is` "a" + + ,"concatAccountNames" ~: do + concatAccountNames [] `is` "" + concatAccountNames ["a","(b)","[c:d]"] `is` "(a:b:c:d)" + ] diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index b88c2f877..20bd4fb34 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -147,7 +147,9 @@ type Year = Integer data JournalContext = Ctx { ctxYear :: !(Maybe Year) -- ^ the default year most recently specified with Y , ctxCommodity :: !(Maybe Commodity) -- ^ the default commodity most recently specified with D - , ctxAccount :: ![AccountName] -- ^ the current stack of parent accounts specified by !account + , ctxAccount :: ![AccountName] -- ^ the current stack of parent accounts/account name components + -- specified with "account" directive(s). Concatenated, these + -- are the account prefix prepended to parsed account names. } deriving (Read, Show, Eq) data Journal = Journal { diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 93ff689b2..2010a96c8 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -448,7 +448,7 @@ ledgerposting = do status <- ledgerstatus many spacenonewline account <- transactionaccountname - let (ptype, account') = (postingTypeFromAccountName account, unbracket account) + let (ptype, account') = (accountNamePostingType account, unbracket account) amount <- postingamount many spacenonewline comment <- ledgercomment <|> return "" @@ -456,9 +456,9 @@ ledgerposting = do md <- ledgermetadata return (Posting status account' amount comment ptype md Nothing) --- qualify with the parent account from parsing context +-- Prepend any parent account currently in effect. transactionaccountname :: GenParser Char JournalContext AccountName -transactionaccountname = liftM2 (++) getParentAccount ledgeraccountname +transactionaccountname = liftM2 joinAccountNames getParentAccount ledgeraccountname -- | Parse an account name. Account names may have single spaces inside -- them, and are terminated by two or more spaces. They should have one or diff --git a/hledger-lib/Hledger/Read/Utils.hs b/hledger-lib/Hledger/Read/Utils.hs index 143abc4a6..532a37c6d 100644 --- a/hledger-lib/Hledger/Read/Utils.hs +++ b/hledger-lib/Hledger/Read/Utils.hs @@ -14,6 +14,7 @@ import Text.ParserCombinators.Parsec import Hledger.Data.Types import Hledger.Utils +import Hledger.Data.Posting import Hledger.Data.Dates (getCurrentYear) import Hledger.Data.Journal (nullctx, nulljournal, journalFinalise) @@ -50,8 +51,7 @@ getCommodity = liftM ctxCommodity getState pushParentAccount :: String -> GenParser tok JournalContext () pushParentAccount parent = updateState addParentAccount - where addParentAccount ctx0 = ctx0 { ctxAccount = normalize parent : ctxAccount ctx0 } - normalize = (++ ":") + where addParentAccount ctx0 = ctx0 { ctxAccount = parent : ctxAccount ctx0 } popParentAccount :: GenParser tok JournalContext () popParentAccount = do ctx0 <- getState @@ -60,7 +60,7 @@ popParentAccount = do ctx0 <- getState (_:rest) -> setState $ ctx0 { ctxAccount = rest } getParentAccount :: GenParser tok JournalContext String -getParentAccount = liftM (concat . reverse . ctxAccount) getState +getParentAccount = liftM (concatAccountNames . reverse . ctxAccount) getState -- | Convert a possibly relative, possibly tilde-containing file path to an absolute one. -- using the current directory from a parsec source position. ~username is not supported. diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index 8b31be962..7c5f5d0b7 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -87,6 +87,13 @@ tests_Hledger_Cli = TestList "2008/12/07 Four\n outer:why $-4\n outer:zed $4\n" ++ "2008/12/07 Five\n foo $-5\n bar $5\n" ) + + ,"account directive should preserve \"virtual\" posting type" ~: do + j <- readJournal Nothing "!account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return + let p = head $ tpostings $ head $ jtxns j + assertBool "" $ (paccount p) == "test:from" + assertBool "" $ (ptype p) == VirtualPosting + ] ,"ledgerAccountNames" ~: