hledger-lib-1.19.1/Hledger/0000755000000000000000000000000013723502755013532 5ustar0000000000000000hledger-lib-1.19.1/Hledger/Data/0000755000000000000000000000000013725271264014403 5ustar0000000000000000hledger-lib-1.19.1/Hledger/Read/0000755000000000000000000000000013725501202014371 5ustar0000000000000000hledger-lib-1.19.1/Hledger/Reports/0000755000000000000000000000000013725271736015174 5ustar0000000000000000hledger-lib-1.19.1/Hledger/Utils/0000755000000000000000000000000013725504032014622 5ustar0000000000000000hledger-lib-1.19.1/Text/0000755000000000000000000000000013700077722013100 5ustar0000000000000000hledger-lib-1.19.1/Text/Megaparsec/0000755000000000000000000000000013700101030015123 5ustar0000000000000000hledger-lib-1.19.1/Text/Tabular/0000755000000000000000000000000013700101030014446 5ustar0000000000000000hledger-lib-1.19.1/test/0000755000000000000000000000000013722544246013137 5ustar0000000000000000hledger-lib-1.19.1/Hledger.hs0000644000000000000000000000061113700077722014060 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Hledger ( module X ,tests_Hledger ) where import Hledger.Data as X import Hledger.Read as X import Hledger.Reports as X import Hledger.Query as X import Hledger.Utils as X tests_Hledger = tests "Hledger" [ tests_Data ,tests_Query ,tests_Read ,tests_Reports ,tests_Utils ] hledger-lib-1.19.1/Hledger/Data.hs0000644000000000000000000000367313700101030014720 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-| The Hledger.Data library allows parsing and querying of C++ ledger-style journal files. It generally provides a compatible subset of C++ ledger's functionality. This package re-exports all the Hledger.Data.* modules (except UTF8, which requires an explicit import.) -} module Hledger.Data ( module Hledger.Data.Account, module Hledger.Data.AccountName, module Hledger.Data.Amount, module Hledger.Data.Commodity, module Hledger.Data.Dates, module Hledger.Data.Journal, module Hledger.Data.Json, module Hledger.Data.Ledger, module Hledger.Data.Period, module Hledger.Data.PeriodicTransaction, module Hledger.Data.Posting, module Hledger.Data.RawOptions, module Hledger.Data.StringFormat, module Hledger.Data.Timeclock, module Hledger.Data.Transaction, module Hledger.Data.TransactionModifier, module Hledger.Data.Types, module Hledger.Data.Valuation, tests_Data ) where import Hledger.Data.Account import Hledger.Data.AccountName import Hledger.Data.Amount import Hledger.Data.Commodity import Hledger.Data.Dates import Hledger.Data.Journal import Hledger.Data.Json import Hledger.Data.Ledger import Hledger.Data.Period import Hledger.Data.PeriodicTransaction import Hledger.Data.Posting import Hledger.Data.RawOptions import Hledger.Data.StringFormat import Hledger.Data.Timeclock import Hledger.Data.Transaction import Hledger.Data.TransactionModifier import Hledger.Data.Types import Hledger.Data.Valuation import Hledger.Utils.Test tests_Data = tests "Data" [ tests_AccountName ,tests_Amount ,tests_Journal ,tests_Ledger ,tests_Posting ,tests_Valuation ,tests_StringFormat ,tests_Timeclock ,tests_Transaction ] hledger-lib-1.19.1/Hledger/Data/Account.hs0000644000000000000000000002477013723502755016345 0ustar0000000000000000{-# LANGUAGE RecordWildCards, OverloadedStrings #-} {-| An 'Account' has a name, a list of subaccounts, an optional parent account, and subaccounting-excluding and -including balances. -} module Hledger.Data.Account where import Data.List (find, sortOn) import Data.List.Extra (groupSort, groupOn) import Data.Maybe (fromMaybe) import Data.Ord (Down(..)) import qualified Data.Map as M import qualified Data.Text as T import Safe (headMay, lookupJustDef) import Text.Printf import Hledger.Data.AccountName import Hledger.Data.Amount import Hledger.Data.Posting () import Hledger.Data.Types import Hledger.Utils -- deriving instance Show Account instance Show Account where show Account{..} = printf "Account %s (boring:%s, postings:%d, ebalance:%s, ibalance:%s)" (T.map colonToUnderscore aname) -- hide : so pretty-show doesn't break line (if aboring then "y" else "n" :: String) anumpostings (showMixedAmount aebalance) (showMixedAmount aibalance) where colonToUnderscore x = if x == ':' then '_' else x instance Eq Account where (==) a b = aname a == aname b -- quick equality test for speed -- and -- [ aname a == aname b -- -- , aparent a == aparent b -- avoid infinite recursion -- , asubs a == asubs b -- , aebalance a == aebalance b -- , aibalance a == aibalance b -- ] nullacct = Account { aname = "" , adeclarationinfo = Nothing , asubs = [] , aparent = Nothing , aboring = False , anumpostings = 0 , aebalance = nullmixedamt , aibalance = nullmixedamt } -- | Derive 1. an account tree and 2. each account's total exclusive -- and inclusive changes from a list of postings. -- This is the core of the balance command (and of *ledger). -- The accounts are returned as a list in flattened tree order, -- and also reference each other as a tree. -- (The first account is the root of the tree.) accountsFromPostings :: [Posting] -> [Account] accountsFromPostings ps = let grouped = groupSort [(paccount p,pamount p) | p <- ps] counted = [(aname, length amts) | (aname, amts) <- grouped] summed = [(aname, sumStrict amts) | (aname, amts) <- grouped] -- always non-empty acctstree = accountTree "root" $ map fst summed acctswithnumps = mapAccounts setnumps acctstree where setnumps a = a{anumpostings=fromMaybe 0 $ lookup (aname a) counted} acctswithebals = mapAccounts setebalance acctswithnumps where setebalance a = a{aebalance=lookupJustDef nullmixedamt (aname a) summed} acctswithibals = sumAccounts acctswithebals acctswithparents = tieAccountParents acctswithibals acctsflattened = flattenAccounts acctswithparents in acctsflattened -- | Convert a list of account names to a tree of Account objects, -- with just the account names filled in. -- A single root account with the given name is added. accountTree :: AccountName -> [AccountName] -> Account accountTree rootname as = nullacct{aname=rootname, asubs=map (uncurry accountTree') $ M.assocs m } where T m = treeFromPaths $ map expandAccountName as :: FastTree AccountName accountTree' a (T m) = nullacct{ aname=a ,asubs=map (uncurry accountTree') $ M.assocs m } -- | Tie the knot so all subaccounts' parents are set correctly. tieAccountParents :: Account -> Account tieAccountParents = tie Nothing where tie parent a@Account{..} = a' where a' = a{aparent=parent, asubs=map (tie (Just a')) asubs} -- | Get this account's parent accounts, from the nearest up to the root. parentAccounts :: Account -> [Account] parentAccounts Account{aparent=Nothing} = [] parentAccounts Account{aparent=Just a} = a:parentAccounts a -- | List the accounts at each level of the account tree. accountsLevels :: Account -> [[Account]] accountsLevels = takeWhile (not . null) . iterate (concatMap asubs) . (:[]) -- | Map a (non-tree-structure-modifying) function over this and sub accounts. mapAccounts :: (Account -> Account) -> Account -> Account mapAccounts f a = f a{asubs = map (mapAccounts f) $ asubs a} -- | Is the predicate true on any of this account or its subaccounts ? anyAccounts :: (Account -> Bool) -> Account -> Bool anyAccounts p a | p a = True | otherwise = any (anyAccounts p) $ asubs a -- | Add subaccount-inclusive balances to an account tree. sumAccounts :: Account -> Account sumAccounts a | null $ asubs a = a{aibalance=aebalance a} | otherwise = a{aibalance=ibal, asubs=subs} where subs = map sumAccounts $ asubs a ibal = sum $ aebalance a : map aibalance subs -- | Remove all subaccounts below a certain depth. clipAccounts :: Int -> Account -> Account clipAccounts 0 a = a{asubs=[]} clipAccounts d a = a{asubs=subs} where subs = map (clipAccounts (d-1)) $ asubs a -- | Remove subaccounts below the specified depth, aggregating their balance at the depth limit -- (accounts at the depth limit will have any sub-balances merged into their exclusive balance). -- If the depth is Nothing, return the original accounts clipAccountsAndAggregate :: Maybe Int -> [Account] -> [Account] clipAccountsAndAggregate Nothing as = as clipAccountsAndAggregate (Just d) as = combined where clipped = [a{aname=clipOrEllipsifyAccountName (Just d) $ aname a} | a <- as] combined = [a{aebalance=sum $ map aebalance same} | same@(a:_) <- groupOn aname clipped] {- test cases, assuming d=1: assets:cash 1 1 assets:checking 1 1 -> as: [assets:cash 1 1, assets:checking 1 1] clipped: [assets 1 1, assets 1 1] combined: [assets 2 2] assets 0 2 assets:cash 1 1 assets:checking 1 1 -> as: [assets 0 2, assets:cash 1 1, assets:checking 1 1] clipped: [assets 0 2, assets 1 1, assets 1 1] combined: [assets 2 2] assets 0 2 assets:bank 1 2 assets:bank:checking 1 1 -> as: [assets 0 2, assets:bank 1 2, assets:bank:checking 1 1] clipped: [assets 0 2, assets 1 2, assets 1 1] combined: [assets 2 2] -} -- | Remove all leaf accounts and subtrees matching a predicate. pruneAccounts :: (Account -> Bool) -> Account -> Maybe Account pruneAccounts p = headMay . prune where prune a | null prunedsubs = if p a then [] else [a'] | otherwise = [a'] where prunedsubs = concatMap prune $ asubs a a' = a{asubs=prunedsubs} -- | Flatten an account tree into a list, which is sometimes -- convenient. Note since accounts link to their parents/subs, the -- tree's structure remains intact and can still be used. It's a tree/list! flattenAccounts :: Account -> [Account] flattenAccounts a = squish a [] where squish a as = a : Prelude.foldr squish as (asubs a) -- | Filter an account tree (to a list). filterAccounts :: (Account -> Bool) -> Account -> [Account] filterAccounts p a | p a = a : concatMap (filterAccounts p) (asubs a) | otherwise = concatMap (filterAccounts p) (asubs a) -- | Sort each group of siblings in an account tree by inclusive amount, -- so that the accounts with largest normal balances are listed first. -- The provided normal balance sign determines whether normal balances -- are negative or positive, affecting the sort order. Ie, -- if balances are normally negative, then the most negative balances -- sort first, and vice versa. sortAccountTreeByAmount :: NormalSign -> Account -> Account sortAccountTreeByAmount normalsign = mapAccounts $ \a -> a{asubs=sortSubs $ asubs a} where sortSubs = case normalsign of NormallyPositive -> sortOn (Down . normaliseMixedAmountSquashPricesForDisplay . aibalance) NormallyNegative -> sortOn ( normaliseMixedAmountSquashPricesForDisplay . aibalance) -- | Add extra info for this account derived from the Journal's -- account directives, if any (comment, tags, declaration order..). accountSetDeclarationInfo :: Journal -> Account -> Account accountSetDeclarationInfo j a@Account{..} = a{ adeclarationinfo=lookup aname $ jdeclaredaccounts j } -- | Sort account names by the order in which they were declared in -- the journal, at each level of the account tree (ie within each -- group of siblings). Undeclared accounts are sorted last and -- alphabetically. -- This is hledger's default sort for reports organised by account. -- The account list is converted to a tree temporarily, adding any -- missing parents; these can be kept (suitable for a tree-mode report) -- or removed (suitable for a flat-mode report). -- sortAccountNamesByDeclaration :: Journal -> Bool -> [AccountName] -> [AccountName] sortAccountNamesByDeclaration j keepparents as = (if keepparents then id else filter (`elem` as)) $ -- maybe discard missing parents that were added map aname $ -- keep just the names drop 1 $ -- drop the root node that was added flattenAccounts $ -- convert to an account list sortAccountTreeByDeclaration $ -- sort by declaration order (and name) mapAccounts (accountSetDeclarationInfo j) $ -- add declaration order info accountTree "root" -- convert to an account tree as -- | Sort each group of siblings in an account tree by declaration order, then account name. -- So each group will contain first the declared accounts, -- in the same order as their account directives were parsed, -- and then the undeclared accounts, sorted by account name. sortAccountTreeByDeclaration :: Account -> Account sortAccountTreeByDeclaration a | null $ asubs a = a | otherwise = a{asubs= sortOn accountDeclarationOrderAndName $ map sortAccountTreeByDeclaration $ asubs a } accountDeclarationOrderAndName :: Account -> (Int, AccountName) accountDeclarationOrderAndName a = (adeclarationorder', aname a) where adeclarationorder' = maybe maxBound adideclarationorder $ adeclarationinfo a -- | Search an account list by name. lookupAccount :: AccountName -> [Account] -> Maybe Account lookupAccount a = find ((==a).aname) -- debug helpers printAccounts :: Account -> IO () printAccounts = putStrLn . showAccounts showAccounts = unlines . map showAccountDebug . flattenAccounts showAccountsBoringFlag = unlines . map (show . aboring) . flattenAccounts showAccountDebug a = printf "%-25s %4s %4s %s" (aname a) (showMixedAmount $ aebalance a) (showMixedAmount $ aibalance a) (if aboring a then "b" else " " :: String) hledger-lib-1.19.1/Hledger/Data/AccountName.hs0000644000000000000000000002453013724277550017143 0ustar0000000000000000{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-| 'AccountName's are strings like @assets:cash:petty@, with multiple components separated by ':'. From a set of these we derive the account hierarchy. -} module Hledger.Data.AccountName ( accountLeafName ,accountNameComponents ,accountNameDrop ,accountNameFromComponents ,accountNameLevel ,accountNameToAccountOnlyRegex ,accountNameToAccountOnlyRegexCI ,accountNameToAccountRegex ,accountNameToAccountRegexCI ,accountNameTreeFrom ,accountSummarisedName ,acctsep ,acctsepchar ,clipAccountName ,clipOrEllipsifyAccountName ,elideAccountName ,escapeName ,expandAccountName ,expandAccountNames ,isAccountNamePrefixOf -- ,isAccountRegex ,isSubAccountNameOf ,parentAccountName ,parentAccountNames ,subAccountNamesFrom ,topAccountNames ,unbudgetedAccountName ,tests_AccountName ) where import Data.List.Extra (nubSort) import qualified Data.List.NonEmpty as NE #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup ((<>)) #endif import Data.Text (Text) import qualified Data.Text as T import Data.Tree (Tree(..)) import Hledger.Data.Types import Hledger.Utils -- $setup -- >>> :set -XOverloadedStrings acctsepchar :: Char acctsepchar = ':' acctsep :: Text acctsep = T.pack [acctsepchar] -- accountNameComponents :: AccountName -> [String] -- accountNameComponents = splitAtElement acctsepchar accountNameComponents :: AccountName -> [Text] accountNameComponents = T.splitOn acctsep accountNameFromComponents :: [Text] -> AccountName accountNameFromComponents = T.intercalate acctsep accountLeafName :: AccountName -> Text accountLeafName = last . accountNameComponents -- | Truncate all account name components but the last to two characters. accountSummarisedName :: AccountName -> Text accountSummarisedName a -- length cs > 1 = take 2 (head cs) ++ ":" ++ a' | length cs > 1 = T.intercalate ":" (map (T.take 2) $ init cs) <> ":" <> a' | otherwise = a' where cs = accountNameComponents a a' = accountLeafName a accountNameLevel :: AccountName -> Int accountNameLevel "" = 0 accountNameLevel a = T.length (T.filter (==acctsepchar) a) + 1 -- | A top-level account prefixed to some accounts in budget reports. -- Defined here so it can be ignored by accountNameDrop. unbudgetedAccountName :: T.Text unbudgetedAccountName = "" -- | Remove some number of account name components from the front of the account name. -- If the special "" top-level account is present, it is preserved and -- dropping affects the rest of the account name. accountNameDrop :: Int -> AccountName -> AccountName accountNameDrop n a | a == unbudgetedAccountName = a | unbudgetedAccountAndSep `T.isPrefixOf` a = case accountNameDrop n $ T.drop (T.length unbudgetedAccountAndSep) a of "" -> unbudgetedAccountName a' -> unbudgetedAccountAndSep <> a' | otherwise = accountNameFromComponentsOrElide . drop n $ accountNameComponents a where unbudgetedAccountAndSep = unbudgetedAccountName <> acctsep accountNameFromComponentsOrElide [] = "..." accountNameFromComponentsOrElide xs = accountNameFromComponents xs -- | Sorted unique account names implied by these account names, -- ie these plus all their parent accounts up to the root. -- Eg: ["a:b:c","d:e"] -> ["a","a:b","a:b:c","d","d:e"] expandAccountNames :: [AccountName] -> [AccountName] expandAccountNames as = nubSort $ concatMap expandAccountName as -- | "a:b:c" -> ["a","a:b","a:b:c"] expandAccountName :: AccountName -> [AccountName] expandAccountName = map accountNameFromComponents . NE.tail . NE.inits . accountNameComponents -- | ["a:b:c","d:e"] -> ["a","d"] topAccountNames :: [AccountName] -> [AccountName] topAccountNames as = [a | a <- expandAccountNames as, accountNameLevel a == 1] parentAccountName :: AccountName -> AccountName parentAccountName = accountNameFromComponents . init . accountNameComponents parentAccountNames :: AccountName -> [AccountName] parentAccountNames a = parentAccountNames' $ parentAccountName a where parentAccountNames' "" = [] parentAccountNames' a = a : parentAccountNames' (parentAccountName a) -- | Is the first account a parent or other ancestor of (and not the same as) the second ? isAccountNamePrefixOf :: AccountName -> AccountName -> Bool isAccountNamePrefixOf = T.isPrefixOf . (<> acctsep) isSubAccountNameOf :: AccountName -> AccountName -> Bool s `isSubAccountNameOf` p = (p `isAccountNamePrefixOf` s) && (accountNameLevel s == (accountNameLevel p + 1)) -- | From a list of account names, select those which are direct -- subaccounts of the given account name. subAccountNamesFrom :: [AccountName] -> AccountName -> [AccountName] subAccountNamesFrom accts a = filter (`isSubAccountNameOf` a) accts -- | Convert a list of account names to a tree. accountNameTreeFrom :: [AccountName] -> Tree AccountName accountNameTreeFrom accts = Node "root" (accounttreesfrom (topAccountNames accts)) where accounttreesfrom :: [AccountName] -> [Tree AccountName] accounttreesfrom [] = [] accounttreesfrom as = [Node a (accounttreesfrom $ subs a) | a <- as] subs = subAccountNamesFrom (expandAccountNames accts) --nullaccountnametree = Node "root" [] -- | Elide an account name to fit in the specified width. -- From the ledger 2.6 news: -- -- @ -- What Ledger now does is that if an account name is too long, it will -- start abbreviating the first parts of the account name down to two -- letters in length. If this results in a string that is still too -- long, the front will be elided -- not the end. For example: -- -- Expenses:Cash ; OK, not too long -- Ex:Wednesday:Cash ; "Expenses" was abbreviated to fit -- Ex:We:Afternoon:Cash ; "Expenses" and "Wednesday" abbreviated -- ; Expenses:Wednesday:Afternoon:Lunch:Snack:Candy:Chocolate:Cash -- ..:Af:Lu:Sn:Ca:Ch:Cash ; Abbreviated and elided! -- @ elideAccountName :: Int -> AccountName -> AccountName elideAccountName width s -- XXX special case for transactions register's multi-account pseudo-names | " (split)" `T.isSuffixOf` s = let names = T.splitOn ", " $ T.take (T.length s - 8) s widthpername = max 0 (width - 8 - 2 * (max 1 (length names) - 1)) `div` length names in fitText Nothing (Just width) True False $ (<>" (split)") $ T.intercalate ", " [accountNameFromComponents $ elideparts widthpername [] $ accountNameComponents s' | s' <- names] | otherwise = fitText Nothing (Just width) True False $ accountNameFromComponents $ elideparts width [] $ accountNameComponents s where elideparts :: Int -> [Text] -> [Text] -> [Text] elideparts width done ss | textWidth (accountNameFromComponents $ done++ss) <= width = done++ss | length ss > 1 = elideparts width (done++[textTakeWidth 2 $ head ss]) (tail ss) | otherwise = done++ss -- | Keep only the first n components of an account name, where n -- is a positive integer. If n is Just 0, returns the empty string, if n is -- Nothing, return the full name. clipAccountName :: Maybe Int -> AccountName -> AccountName clipAccountName Nothing = id clipAccountName (Just n) = accountNameFromComponents . take n . accountNameComponents -- | Keep only the first n components of an account name, where n -- is a positive integer. If n is Just 0, returns "...", if n is Nothing, return -- the full name. clipOrEllipsifyAccountName :: Maybe Int -> AccountName -> AccountName clipOrEllipsifyAccountName (Just 0) = const "..." clipOrEllipsifyAccountName n = clipAccountName n -- | Escape an AccountName for use within a regular expression. -- >>> putStr $ escapeName "First?!#$*?$(*) !@^#*? %)*!@#" -- First\?!#\$\*\?\$\(\*\) !@\^#\*\? %\)\*!@# escapeName :: AccountName -> String escapeName = T.unpack . T.concatMap escapeChar where escapeChar c = if c `elem` escapedChars then T.snoc "\\" c else T.singleton c escapedChars = ['[', '?', '+', '|', '(', ')', '*', '$', '^', '\\'] -- | Convert an account name to a regular expression matching it and its subaccounts. accountNameToAccountRegex :: AccountName -> Regexp accountNameToAccountRegex a = toRegex' $ '^' : escapeName a ++ "(:|$)" -- PARTIAL: Is this safe after escapeName? -- | Convert an account name to a regular expression matching it and its subaccounts, -- case insensitively. accountNameToAccountRegexCI :: AccountName -> Regexp accountNameToAccountRegexCI a = toRegexCI' $ '^' : escapeName a ++ "(:|$)" -- PARTIAL: Is this safe after escapeName? -- | Convert an account name to a regular expression matching it but not its subaccounts. accountNameToAccountOnlyRegex :: AccountName -> Regexp accountNameToAccountOnlyRegex a = toRegex' $ '^' : escapeName a ++ "$" -- PARTIAL: Is this safe after escapeName? -- | Convert an account name to a regular expression matching it but not its subaccounts, -- case insensitively. accountNameToAccountOnlyRegexCI :: AccountName -> Regexp accountNameToAccountOnlyRegexCI a = toRegexCI' $ '^' : escapeName a ++ "$" -- PARTIAL: Is this safe after escapeName? -- -- | Does this string look like an exact account-matching regular expression ? --isAccountRegex :: String -> Bool --isAccountRegex s = take 1 s == "^" && take 5 (reverse s) == ")$|:(" tests_AccountName = tests "AccountName" [ test "accountNameTreeFrom" $ do accountNameTreeFrom ["a"] @?= Node "root" [Node "a" []] accountNameTreeFrom ["a","b"] @?= Node "root" [Node "a" [], Node "b" []] accountNameTreeFrom ["a","a:b"] @?= Node "root" [Node "a" [Node "a:b" []]] accountNameTreeFrom ["a:b:c"] @?= Node "root" [Node "a" [Node "a:b" [Node "a:b:c" []]]] ,test "expandAccountNames" $ do expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] @?= ["assets","assets:cash","assets:checking","expenses","expenses:vacation"] ,test "isAccountNamePrefixOf" $ do "assets" `isAccountNamePrefixOf` "assets" @?= False "assets" `isAccountNamePrefixOf` "assets:bank" @?= True "assets" `isAccountNamePrefixOf` "assets:bank:checking" @?= True "my assets" `isAccountNamePrefixOf` "assets:bank" @?= False ,test "isSubAccountNameOf" $ do "assets" `isSubAccountNameOf` "assets" @?= False "assets:bank" `isSubAccountNameOf` "assets" @?= True "assets:bank:checking" `isSubAccountNameOf` "assets" @?= False "assets:bank" `isSubAccountNameOf` "my assets" @?= False ] hledger-lib-1.19.1/Hledger/Data/Amount.hs0000644000000000000000000010205513725271264016205 0ustar0000000000000000{-| A simple 'Amount' is some quantity of money, shares, or anything else. It has a (possibly null) 'CommoditySymbol' and a numeric quantity: @ $1 £-50 EUR 3.44 GOOG 500 1.5h 90 apples 0 @ It may also have an assigned 'Price', representing this amount's per-unit or total cost in a different commodity. If present, this is rendered like so: @ EUR 2 \@ $1.50 (unit price) EUR 2 \@\@ $3 (total price) @ A 'MixedAmount' is zero or more simple amounts, so can represent multiple commodities; this is the type most often used: @ 0 $50 + EUR 3 16h + $13.55 + AAPL 500 + 6 oranges @ When a mixed amount has been \"normalised\", it has no more than one amount in each commodity and no zero amounts; or it has just a single zero amount and no others. Limited arithmetic with simple and mixed amounts is supported, best used with similar amounts since it mostly ignores assigned prices and commodity exchange rates. -} {-# LANGUAGE StandaloneDeriving, RecordWildCards, OverloadedStrings #-} module Hledger.Data.Amount ( -- * Amount amount, nullamt, missingamt, num, usd, eur, gbp, per, hrs, at, (@@), amountWithCommodity, -- ** arithmetic amountCost, amountIsZero, amountLooksZero, divideAmount, multiplyAmount, divideAmountAndPrice, multiplyAmountAndPrice, amountTotalPriceToUnitPrice, -- ** rendering amountstyle, styleAmount, styleAmountExceptPrecision, showAmount, cshowAmount, showAmountWithZeroCommodity, showAmountDebug, showAmountWithoutPrice, setAmountPrecision, withPrecision, setFullPrecision, setAmountInternalPrecision, withInternalPrecision, setAmountDecimalPoint, withDecimalPoint, canonicaliseAmount, -- * MixedAmount nullmixedamt, missingmixedamt, mixed, amounts, filterMixedAmount, filterMixedAmountByCommodity, mapMixedAmount, normaliseMixedAmountSquashPricesForDisplay, normaliseMixedAmount, unifyMixedAmount, mixedAmountStripPrices, -- ** arithmetic mixedAmountCost, divideMixedAmount, multiplyMixedAmount, divideMixedAmountAndPrice, multiplyMixedAmountAndPrice, averageMixedAmounts, isNegativeAmount, isNegativeMixedAmount, mixedAmountIsZero, mixedAmountLooksZero, mixedAmountTotalPriceToUnitPrice, -- ** rendering styleMixedAmount, showMixedAmount, showMixedAmountOneLine, showMixedAmountDebug, showMixedAmountWithoutPrice, showMixedAmountOneLineWithoutPrice, showMixedAmountElided, showMixedAmountWithZeroCommodity, showMixedAmountWithPrecision, setMixedAmountPrecision, canonicaliseMixedAmount, -- * misc. ltraceamount, tests_Amount ) where import Control.Monad (foldM) import Data.Char (isDigit) import Data.Decimal (decimalPlaces, normalizeDecimal, roundTo) import Data.Function (on) import Data.List import qualified Data.Map as M import Data.Map (findWithDefault) import Data.Maybe import qualified Data.Text as T import Data.Word (Word8) import Safe (lastDef, maximumMay) import Text.Printf import Hledger.Data.Types import Hledger.Data.Commodity import Hledger.Utils deriving instance Show MarketPrice ------------------------------------------------------------------------------- -- Amount styles -- | Default amount style amountstyle = AmountStyle L False (Precision 0) (Just '.') Nothing ------------------------------------------------------------------------------- -- Amount instance Num Amount where abs a@Amount{aquantity=q} = a{aquantity=abs q} signum a@Amount{aquantity=q} = a{aquantity=signum q} fromInteger i = nullamt{aquantity=fromInteger i} negate a@Amount{aquantity=q} = a{aquantity= -q} (+) = similarAmountsOp (+) (-) = similarAmountsOp (-) (*) = similarAmountsOp (*) -- | The empty simple amount. amount, nullamt :: Amount amount = Amount{acommodity="", aquantity=0, aprice=Nothing, astyle=amountstyle, aismultiplier=False} nullamt = amount -- | A temporary value for parsed transactions which had no amount specified. missingamt :: Amount missingamt = amount{acommodity="AUTO"} -- Handy amount constructors for tests. -- usd/eur/gbp round their argument to a whole number of pennies/cents. num n = amount{acommodity="", aquantity=n} hrs n = amount{acommodity="h", aquantity=n, astyle=amountstyle{asprecision=Precision 2, ascommodityside=R}} usd n = amount{acommodity="$", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}} eur n = amount{acommodity="€", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}} gbp n = amount{acommodity="£", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}} per n = amount{acommodity="%", aquantity=n, astyle=amountstyle{asprecision=Precision 1, ascommodityside=R, ascommodityspaced=True}} amt `at` priceamt = amt{aprice=Just $ UnitPrice priceamt} amt @@ priceamt = amt{aprice=Just $ TotalPrice priceamt} -- | Apply a binary arithmetic operator to two amounts, which should -- be in the same commodity if non-zero (warning, this is not checked). -- A zero result keeps the commodity of the second amount. -- The result's display style is that of the second amount, with -- precision set to the highest of either amount. -- Prices are ignored and discarded. -- Remember: the caller is responsible for ensuring both amounts have the same commodity. similarAmountsOp :: (Quantity -> Quantity -> Quantity) -> Amount -> Amount -> Amount similarAmountsOp op Amount{acommodity=_, aquantity=q1, astyle=AmountStyle{asprecision=p1}} Amount{acommodity=c2, aquantity=q2, astyle=s2@AmountStyle{asprecision=p2}} = -- trace ("a1:"++showAmountDebug a1) $ trace ("a2:"++showAmountDebug a2) $ traceWith (("= :"++).showAmountDebug) amount{acommodity=c2, aquantity=q1 `op` q2, astyle=s2{asprecision=max p1 p2}} -- c1==c2 || q1==0 || q2==0 = -- otherwise = error "tried to do simple arithmetic with amounts in different commodities" -- | Convert an amount to the specified commodity, ignoring and discarding -- any assigned prices and assuming an exchange rate of 1. amountWithCommodity :: CommoditySymbol -> Amount -> Amount amountWithCommodity c a = a{acommodity=c, aprice=Nothing} -- | Convert a amount to its "cost" or "selling price" in another commodity, -- using its attached transaction price if it has one. Notes: -- -- - price amounts must be MixedAmounts with exactly one component Amount -- (or there will be a runtime error XXX) -- -- - price amounts should be positive -- (though this is currently not enforced) amountCost :: Amount -> Amount amountCost a@Amount{aquantity=q, aprice=mp} = case mp of Nothing -> a Just (UnitPrice p@Amount{aquantity=pq}) -> p{aquantity=pq * q} Just (TotalPrice p@Amount{aquantity=pq}) -> p{aquantity=pq * signum q} -- | Replace an amount's TotalPrice, if it has one, with an equivalent UnitPrice. -- Has no effect on amounts without one. -- Also increases the unit price's display precision to show one extra decimal place, -- to help keep transaction amounts balancing. -- Does Decimal division, might be some rounding/irrational number issues. amountTotalPriceToUnitPrice :: Amount -> Amount amountTotalPriceToUnitPrice a@Amount{aquantity=q, aprice=Just (TotalPrice pa@Amount{aquantity=pq, astyle=ps})} = a{aprice = Just $ UnitPrice pa{aquantity=abs (pq/q), astyle=ps{asprecision=pp}}} where -- Increase the precision by 1, capping at the max bound. pp = case asprecision ps of NaturalPrecision -> NaturalPrecision Precision p -> Precision $ if p == maxBound then maxBound else p + 1 amountTotalPriceToUnitPrice a = a -- | Divide an amount's quantity by a constant. divideAmount :: Quantity -> Amount -> Amount divideAmount n a@Amount{aquantity=q} = a{aquantity=q/n} -- | Multiply an amount's quantity by a constant. multiplyAmount :: Quantity -> Amount -> Amount multiplyAmount n a@Amount{aquantity=q} = a{aquantity=q*n} -- | Divide an amount's quantity (and its total price, if it has one) by a constant. -- The total price will be kept positive regardless of the multiplier's sign. divideAmountAndPrice :: Quantity -> Amount -> Amount divideAmountAndPrice n a@Amount{aquantity=q,aprice=p} = a{aquantity=q/n, aprice=f <$> p} where f (TotalPrice a) = TotalPrice $ abs $ n `divideAmount` a f p = p -- | Multiply an amount's quantity (and its total price, if it has one) by a constant. -- The total price will be kept positive regardless of the multiplier's sign. multiplyAmountAndPrice :: Quantity -> Amount -> Amount multiplyAmountAndPrice n a@Amount{aquantity=q,aprice=p} = a{aquantity=q*n, aprice=f <$> p} where f (TotalPrice a) = TotalPrice $ abs $ n `multiplyAmount` a f p = p -- | Is this amount negative ? The price is ignored. isNegativeAmount :: Amount -> Bool isNegativeAmount Amount{aquantity=q} = q < 0 -- | Round an Amount's Quantity to its specified display precision. If that is -- NaturalPrecision, this does nothing. amountRoundedQuantity :: Amount -> Quantity amountRoundedQuantity Amount{aquantity=q, astyle=AmountStyle{asprecision=p}} = case p of NaturalPrecision -> q Precision p' -> roundTo p' q -- | Does mixed amount appear to be zero when rendered with its -- display precision ? amountLooksZero :: Amount -> Bool amountLooksZero = (0==) . amountRoundedQuantity -- | Is this amount exactly zero, ignoring its display precision ? amountIsZero :: Amount -> Bool amountIsZero Amount{aquantity=q} = q == 0 -- | Get the string representation of an amount, based on its commodity's -- display settings except using the specified precision. showAmountWithPrecision :: AmountPrecision -> Amount -> String showAmountWithPrecision p = showAmount . setAmountPrecision p -- | Set an amount's display precision, flipped. withPrecision :: Amount -> AmountPrecision -> Amount withPrecision = flip setAmountPrecision -- | Set an amount's display precision. setAmountPrecision :: AmountPrecision -> Amount -> Amount setAmountPrecision p a@Amount{astyle=s} = a{astyle=s{asprecision=p}} -- | Increase an amount's display precision, if needed, to enough decimal places -- to show it exactly (showing all significant decimal digits, excluding trailing -- zeros). setFullPrecision :: Amount -> Amount setFullPrecision a = setAmountPrecision p a where p = max displayprecision naturalprecision displayprecision = asprecision $ astyle a naturalprecision = Precision . decimalPlaces . normalizeDecimal $ aquantity a -- | Get a string representation of an amount for debugging, -- appropriate to the current debug level. 9 shows maximum detail. showAmountDebug :: Amount -> String showAmountDebug Amount{acommodity="AUTO"} = "(missing)" showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}" (show acommodity) (show aquantity) (showAmountPriceDebug aprice) (show astyle) -- | Get the string representation of an amount, without any \@ price. -- With a True argument, adds ANSI codes to show negative amounts in red. showAmountWithoutPrice :: Bool -> Amount -> String showAmountWithoutPrice c a = showamt a{aprice=Nothing} where showamt = if c then cshowAmount else showAmount -- | Set an amount's internal precision, ie rounds the Decimal representing -- the amount's quantity to some number of decimal places. -- Rounding is done with Data.Decimal's default roundTo function: -- "If the value ends in 5 then it is rounded to the nearest even value (Banker's Rounding)". -- Does not change the amount's display precision. -- Intended only for internal use, eg when comparing amounts in tests. setAmountInternalPrecision :: Word8 -> Amount -> Amount setAmountInternalPrecision p a@Amount{ aquantity=q, astyle=s } = a{ astyle=s{asprecision=Precision p} ,aquantity=roundTo p q } -- | Set an amount's internal precision, flipped. -- Intended only for internal use, eg when comparing amounts in tests. withInternalPrecision :: Amount -> Word8 -> Amount withInternalPrecision = flip setAmountInternalPrecision -- | Set (or clear) an amount's display decimal point. setAmountDecimalPoint :: Maybe Char -> Amount -> Amount setAmountDecimalPoint mc a@Amount{ astyle=s } = a{ astyle=s{asdecimalpoint=mc} } -- | Set (or clear) an amount's display decimal point, flipped. withDecimalPoint :: Amount -> Maybe Char -> Amount withDecimalPoint = flip setAmountDecimalPoint showAmountPrice :: Maybe AmountPrice -> String showAmountPrice Nothing = "" showAmountPrice (Just (UnitPrice pa)) = " @ " ++ showAmount pa showAmountPrice (Just (TotalPrice pa)) = " @@ " ++ showAmount pa showAmountPriceDebug :: Maybe AmountPrice -> String showAmountPriceDebug Nothing = "" showAmountPriceDebug (Just (UnitPrice pa)) = " @ " ++ showAmountDebug pa showAmountPriceDebug (Just (TotalPrice pa)) = " @@ " ++ showAmountDebug pa -- | Given a map of standard commodity display styles, apply the -- appropriate one to this amount. If there's no standard style for -- this amount's commodity, return the amount unchanged. styleAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount styleAmount styles a = case M.lookup (acommodity a) styles of Just s -> a{astyle=s} Nothing -> a -- | Like styleAmount, but keep the number of decimal places unchanged. styleAmountExceptPrecision :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount styleAmountExceptPrecision styles a@Amount{astyle=AmountStyle{asprecision=origp}} = case M.lookup (acommodity a) styles of Just s -> a{astyle=s{asprecision=origp}} Nothing -> a -- | Get the string representation of an amount, based on its -- commodity's display settings. String representations equivalent to -- zero are converted to just \"0\". The special "missing" amount is -- displayed as the empty string. showAmount :: Amount -> String showAmount = showAmountHelper False -- | Colour version. For a negative amount, adds ANSI codes to change the colour, -- currently to hard-coded red. cshowAmount :: Amount -> String cshowAmount a = (if isNegativeAmount a then color Dull Red else id) $ showAmountHelper False a showAmountHelper :: Bool -> Amount -> String showAmountHelper _ Amount{acommodity="AUTO"} = "" showAmountHelper showzerocommodity a@Amount{acommodity=c, aprice=mp, astyle=AmountStyle{..}} = case ascommodityside of L -> printf "%s%s%s%s" (T.unpack c') space quantity' price R -> printf "%s%s%s%s" quantity' space (T.unpack c') price where quantity = showamountquantity a (quantity',c') | amountLooksZero a && not showzerocommodity = ("0","") | otherwise = (quantity, quoteCommoditySymbolIfNeeded c) space = if not (T.null c') && ascommodityspaced then " " else "" :: String price = showAmountPrice mp -- | Like showAmount, but show a zero amount's commodity if it has one. showAmountWithZeroCommodity :: Amount -> String showAmountWithZeroCommodity = showAmountHelper True -- | Get the string representation of the number part of of an amount, -- using the display settings from its commodity. showamountquantity :: Amount -> String showamountquantity amt@Amount{astyle=AmountStyle{asdecimalpoint=mdec, asdigitgroups=mgrps}} = punctuatenumber (fromMaybe '.' mdec) mgrps . show $ amountRoundedQuantity amt -- | Replace a number string's decimal mark with the specified -- character, and add the specified digit group marks. The last digit -- group will be repeated as needed. punctuatenumber :: Char -> Maybe DigitGroupStyle -> String -> String punctuatenumber dec mgrps s = sign ++ reverse (applyDigitGroupStyle mgrps (reverse int)) ++ frac'' where (sign,num) = break isDigit s (int,frac) = break (=='.') num frac' = dropWhile (=='.') frac frac'' | null frac' = "" | otherwise = dec:frac' applyDigitGroupStyle :: Maybe DigitGroupStyle -> String -> String applyDigitGroupStyle Nothing s = s applyDigitGroupStyle (Just (DigitGroups c gs)) s = addseps (repeatLast gs) s where addseps [] s = s addseps (g:gs) s | toInteger (length s) <= toInteger g = s | otherwise = let (part,rest) = genericSplitAt g s in part ++ c : addseps gs rest repeatLast [] = [] repeatLast gs = init gs ++ repeat (last gs) -- like journalCanonicaliseAmounts -- | Canonicalise an amount's display style using the provided commodity style map. canonicaliseAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount canonicaliseAmount styles a@Amount{acommodity=c, astyle=s} = a{astyle=s'} where s' = findWithDefault s c styles ------------------------------------------------------------------------------- -- MixedAmount instance Num MixedAmount where fromInteger i = Mixed [fromInteger i] negate (Mixed as) = Mixed $ map negate as (+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ as ++ bs (*) = error' "error, mixed amounts do not support multiplication" -- PARTIAL: abs = error' "error, mixed amounts do not support abs" signum = error' "error, mixed amounts do not support signum" -- | The empty mixed amount. nullmixedamt :: MixedAmount nullmixedamt = Mixed [] -- | A temporary value for parsed transactions which had no amount specified. missingmixedamt :: MixedAmount missingmixedamt = Mixed [missingamt] -- | Convert amounts in various commodities into a normalised MixedAmount. mixed :: [Amount] -> MixedAmount mixed = normaliseMixedAmount . Mixed -- | Simplify a mixed amount's component amounts: -- -- * amounts in the same commodity are combined unless they have different prices or total prices -- -- * multiple zero amounts, all with the same non-null commodity, are replaced by just the last of them, preserving the commodity and amount style (all but the last zero amount are discarded) -- -- * multiple zero amounts with multiple commodities, or no commodities, are replaced by one commodity-less zero amount -- -- * an empty amount list is replaced by one commodity-less zero amount -- -- * the special "missing" mixed amount remains unchanged -- normaliseMixedAmount :: MixedAmount -> MixedAmount normaliseMixedAmount = normaliseHelper False normaliseHelper :: Bool -> MixedAmount -> MixedAmount normaliseHelper squashprices (Mixed as) | missingamt `elem` as = missingmixedamt -- missingamt should always be alone, but detect it even if not | null nonzeros = Mixed [newzero] | otherwise = Mixed nonzeros where newzero = lastDef nullamt $ filter (not . T.null . acommodity) zeros (zeros, nonzeros) = partition amountIsZero $ map sumSimilarAmountsUsingFirstPrice $ groupBy groupfn $ sortBy sortfn as sortfn | squashprices = compare `on` acommodity | otherwise = compare `on` \a -> (acommodity a, aprice a) groupfn | squashprices = (==) `on` acommodity | otherwise = \a1 a2 -> acommodity a1 == acommodity a2 && combinableprices a1 a2 combinableprices Amount{aprice=Nothing} Amount{aprice=Nothing} = True combinableprices Amount{aprice=Just (UnitPrice p1)} Amount{aprice=Just (UnitPrice p2)} = p1 == p2 combinableprices _ _ = False -- | Like normaliseMixedAmount, but combine each commodity's amounts -- into just one by throwing away all prices except the first. This is -- only used as a rendering helper, and could show a misleading price. normaliseMixedAmountSquashPricesForDisplay :: MixedAmount -> MixedAmount normaliseMixedAmountSquashPricesForDisplay = normaliseHelper True -- | Unify a MixedAmount to a single commodity value if possible. -- Like normaliseMixedAmount, this consolidates amounts of the same commodity -- and discards zero amounts; but this one insists on simplifying to -- a single commodity, and will return Nothing if this is not possible. unifyMixedAmount :: MixedAmount -> Maybe Amount unifyMixedAmount = foldM combine 0 . amounts where combine amount result | amountIsZero amount = Just result | amountIsZero result = Just amount | acommodity amount == acommodity result = Just $ amount + result | otherwise = Nothing -- | Sum same-commodity amounts in a lossy way, applying the first -- price to the result and discarding any other prices. Only used as a -- rendering helper. sumSimilarAmountsUsingFirstPrice :: [Amount] -> Amount sumSimilarAmountsUsingFirstPrice [] = nullamt sumSimilarAmountsUsingFirstPrice as = (sumStrict as){aprice=aprice $ head as} -- -- | Sum same-commodity amounts. If there were different prices, set -- -- the price to a special marker indicating "various". Only used as a -- -- rendering helper. -- sumSimilarAmountsNotingPriceDifference :: [Amount] -> Amount -- sumSimilarAmountsNotingPriceDifference [] = nullamt -- sumSimilarAmountsNotingPriceDifference as = undefined -- | Get a mixed amount's component amounts. amounts :: MixedAmount -> [Amount] amounts (Mixed as) = as -- | Filter a mixed amount's component amounts by a predicate. filterMixedAmount :: (Amount -> Bool) -> MixedAmount -> MixedAmount filterMixedAmount p (Mixed as) = Mixed $ filter p as -- | Return an unnormalised MixedAmount containing exactly one Amount -- with the specified commodity and the quantity of that commodity -- found in the original. NB if Amount's quantity is zero it will be -- discarded next time the MixedAmount gets normalised. filterMixedAmountByCommodity :: CommoditySymbol -> MixedAmount -> MixedAmount filterMixedAmountByCommodity c (Mixed as) = Mixed as' where as' = case filter ((==c) . acommodity) as of [] -> [nullamt{acommodity=c}] as'' -> [sum as''] -- | Apply a transform to a mixed amount's component 'Amount's. mapMixedAmount :: (Amount -> Amount) -> MixedAmount -> MixedAmount mapMixedAmount f (Mixed as) = Mixed $ map f as -- | Convert all component amounts to cost/selling price where -- possible (see amountCost). mixedAmountCost :: MixedAmount -> MixedAmount mixedAmountCost (Mixed as) = Mixed $ map amountCost as -- | Divide a mixed amount's quantities by a constant. divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount divideMixedAmount n = mapMixedAmount (divideAmount n) -- | Multiply a mixed amount's quantities by a constant. multiplyMixedAmount :: Quantity -> MixedAmount -> MixedAmount multiplyMixedAmount n = mapMixedAmount (multiplyAmount n) -- | Divide a mixed amount's quantities (and total prices, if any) by a constant. -- The total prices will be kept positive regardless of the multiplier's sign. divideMixedAmountAndPrice :: Quantity -> MixedAmount -> MixedAmount divideMixedAmountAndPrice n = mapMixedAmount (divideAmountAndPrice n) -- | Multiply a mixed amount's quantities (and total prices, if any) by a constant. -- The total prices will be kept positive regardless of the multiplier's sign. multiplyMixedAmountAndPrice :: Quantity -> MixedAmount -> MixedAmount multiplyMixedAmountAndPrice n = mapMixedAmount (multiplyAmountAndPrice n) -- | Calculate the average of some mixed amounts. averageMixedAmounts :: [MixedAmount] -> MixedAmount averageMixedAmounts [] = 0 averageMixedAmounts as = fromIntegral (length as) `divideMixedAmount` sum as -- | Is this mixed amount negative, if we can tell that unambiguously? -- Ie when normalised, are all individual commodity amounts negative ? isNegativeMixedAmount :: MixedAmount -> Maybe Bool isNegativeMixedAmount m = case amounts $ normaliseMixedAmountSquashPricesForDisplay m of [] -> Just False [a] -> Just $ isNegativeAmount a as | all isNegativeAmount as -> Just True as | not (any isNegativeAmount as) -> Just False _ -> Nothing -- multiple amounts with different signs -- | Does this mixed amount appear to be zero when rendered with its -- display precision ? mixedAmountLooksZero :: MixedAmount -> Bool mixedAmountLooksZero = all amountLooksZero . amounts . normaliseMixedAmountSquashPricesForDisplay -- | Is this mixed amount exactly zero, ignoring display precisions ? mixedAmountIsZero :: MixedAmount -> Bool mixedAmountIsZero = all amountIsZero . amounts . normaliseMixedAmountSquashPricesForDisplay -- -- | MixedAmount derived Eq instance in Types.hs doesn't know that we -- -- want $0 = EUR0 = 0. Yet we don't want to drag all this code over there. -- -- For now, use this when cross-commodity zero equality is important. -- mixedAmountEquals :: MixedAmount -> MixedAmount -> Bool -- mixedAmountEquals a b = amounts a' == amounts b' || (mixedAmountLooksZero a' && mixedAmountLooksZero b') -- where a' = normaliseMixedAmountSquashPricesForDisplay a -- b' = normaliseMixedAmountSquashPricesForDisplay b -- | Given a map of standard commodity display styles, apply the -- appropriate one to each individual amount. styleMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount styleMixedAmount styles (Mixed as) = Mixed $ map (styleAmount styles) as -- | Get the string representation of a mixed amount, after -- normalising it to one amount per commodity. Assumes amounts have -- no or similar prices, otherwise this can show misleading prices. showMixedAmount :: MixedAmount -> String showMixedAmount = showMixedAmountHelper False False -- | Like showMixedAmount, but zero amounts are shown with their -- commodity if they have one. showMixedAmountWithZeroCommodity :: MixedAmount -> String showMixedAmountWithZeroCommodity = showMixedAmountHelper True False -- | Get the one-line string representation of a mixed amount. showMixedAmountOneLine :: MixedAmount -> String showMixedAmountOneLine = showMixedAmountHelper False True showMixedAmountHelper :: Bool -> Bool -> MixedAmount -> String showMixedAmountHelper showzerocommodity useoneline m = join $ map showamt $ amounts $ normaliseMixedAmountSquashPricesForDisplay m where join | useoneline = intercalate ", " | otherwise = vConcatRightAligned showamt | showzerocommodity = showAmountWithZeroCommodity | otherwise = showAmount -- | Compact labelled trace of a mixed amount, for debugging. ltraceamount :: String -> MixedAmount -> MixedAmount ltraceamount s = traceWith (((s ++ ": ") ++).showMixedAmount) -- | Set the display precision in the amount's commodities. setMixedAmountPrecision :: AmountPrecision -> MixedAmount -> MixedAmount setMixedAmountPrecision p (Mixed as) = Mixed $ map (setAmountPrecision p) as -- | Get the string representation of a mixed amount, showing each of its -- component amounts with the specified precision, ignoring their -- commoditys' display precision settings. showMixedAmountWithPrecision :: AmountPrecision -> MixedAmount -> String showMixedAmountWithPrecision p m = vConcatRightAligned $ map (showAmountWithPrecision p) $ amounts $ normaliseMixedAmountSquashPricesForDisplay m -- | Get an unambiguous string representation of a mixed amount for debugging. showMixedAmountDebug :: MixedAmount -> String showMixedAmountDebug m | m == missingmixedamt = "(missing)" | otherwise = printf "Mixed [%s]" as where as = intercalate "\n " $ map showAmountDebug $ amounts m -- TODO these and related fns are comically complicated: -- | Get the string representation of a mixed amount, without showing any transaction prices. -- With a True argument, adds ANSI codes to show negative amounts in red. showMixedAmountWithoutPrice :: Bool -> MixedAmount -> String showMixedAmountWithoutPrice c m = intercalate "\n" $ map showamt as where Mixed as = normaliseMixedAmountSquashPricesForDisplay $ mixedAmountStripPrices m showamt a = (if c && isNegativeAmount a then color Dull Red else id) $ printf (printf "%%%ds" width) $ showAmountWithoutPrice c a where width = fromMaybe 0 . maximumMay $ map (length . showAmount) as mixedAmountStripPrices :: MixedAmount -> MixedAmount mixedAmountStripPrices (Mixed as) = Mixed $ map (\a -> a{aprice=Nothing}) as -- | Get the one-line string representation of a mixed amount, but without -- any \@ prices. -- With a True argument, adds ANSI codes to show negative amounts in red. showMixedAmountOneLineWithoutPrice :: Bool -> MixedAmount -> String showMixedAmountOneLineWithoutPrice c m = intercalate ", " $ map (showAmountWithoutPrice c) as where (Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=Nothing} -- | Like showMixedAmountOneLineWithoutPrice, but show at most two commodities, -- with a elision indicator if there are more. -- With a True argument, adds ANSI codes to show negative amounts in red. showMixedAmountElided :: Bool -> MixedAmount -> String showMixedAmountElided c m = intercalate ", " $ take 2 astrs ++ elisionstr where astrs = map (showAmountWithoutPrice c) as where (Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m where stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=Nothing} elisionstr | n > 2 = [show (n - 2) ++ " more.."] | otherwise = [] where n = length astrs -- | Canonicalise a mixed amount's display styles using the provided commodity style map. canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styles) as -- | Replace each component amount's TotalPrice, if it has one, with an equivalent UnitPrice. -- Has no effect on amounts without one. -- Does Decimal division, might be some rounding/irrational number issues. mixedAmountTotalPriceToUnitPrice :: MixedAmount -> MixedAmount mixedAmountTotalPriceToUnitPrice (Mixed as) = Mixed $ map amountTotalPriceToUnitPrice as ------------------------------------------------------------------------------- -- tests tests_Amount = tests "Amount" [ tests "Amount" [ test "amountCost" $ do amountCost (eur 1) @?= eur 1 amountCost (eur 2){aprice=Just $ UnitPrice $ usd 2} @?= usd 4 amountCost (eur 1){aprice=Just $ TotalPrice $ usd 2} @?= usd 2 amountCost (eur (-1)){aprice=Just $ TotalPrice $ usd 2} @?= usd (-2) ,test "amountLooksZero" $ do assertBool "" $ amountLooksZero amount assertBool "" $ amountLooksZero $ usd 0 ,test "negating amounts" $ do negate (usd 1) @?= (usd 1){aquantity= -1} let b = (usd 1){aprice=Just $ UnitPrice $ eur 2} in negate b @?= b{aquantity= -1} ,test "adding amounts without prices" $ do (usd 1.23 + usd (-1.23)) @?= usd 0 (usd 1.23 + usd (-1.23)) @?= usd 0 (usd (-1.23) + usd (-1.23)) @?= usd (-2.46) sum [usd 1.23,usd (-1.23),usd (-1.23),-(usd (-1.23))] @?= usd 0 -- highest precision is preserved asprecision (astyle $ sum [usd 1 `withPrecision` Precision 1, usd 1 `withPrecision` Precision 3]) @?= Precision 3 asprecision (astyle $ sum [usd 1 `withPrecision` Precision 3, usd 1 `withPrecision` Precision 1]) @?= Precision 3 -- adding different commodities assumes conversion rate 1 assertBool "" $ amountLooksZero (usd 1.23 - eur 1.23) ,test "showAmount" $ do showAmount (usd 0 + gbp 0) @?= "0" ] ,tests "MixedAmount" [ test "adding mixed amounts to zero, the commodity and amount style are preserved" $ sum (map (Mixed . (:[])) [usd 1.25 ,usd (-1) `withPrecision` Precision 3 ,usd (-0.25) ]) @?= Mixed [usd 0 `withPrecision` Precision 3] ,test "adding mixed amounts with total prices" $ do sum (map (Mixed . (:[])) [usd 1 @@ eur 1 ,usd (-2) @@ eur 1 ]) @?= Mixed [usd 1 @@ eur 1 ,usd (-2) @@ eur 1 ] ,test "showMixedAmount" $ do showMixedAmount (Mixed [usd 1]) @?= "$1.00" showMixedAmount (Mixed [usd 1 `at` eur 2]) @?= "$1.00 @ €2.00" showMixedAmount (Mixed [usd 0]) @?= "0" showMixedAmount (Mixed []) @?= "0" showMixedAmount missingmixedamt @?= "" ,test "showMixedAmountWithoutPrice" $ do let a = usd 1 `at` eur 2 showMixedAmountWithoutPrice False (Mixed [a]) @?= "$1.00" showMixedAmountWithoutPrice False (Mixed [a, -a]) @?= "0" ,tests "normaliseMixedAmount" [ test "a missing amount overrides any other amounts" $ normaliseMixedAmount (Mixed [usd 1, missingamt]) @?= missingmixedamt ,test "unpriced same-commodity amounts are combined" $ normaliseMixedAmount (Mixed [usd 0, usd 2]) @?= Mixed [usd 2] ,test "amounts with same unit price are combined" $ normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) @?= Mixed [usd 2 `at` eur 1] ,test "amounts with different unit prices are not combined" $ normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]) @?= Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2] ,test "amounts with total prices are not combined" $ normaliseMixedAmount (Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1] ] ,test "normaliseMixedAmountSquashPricesForDisplay" $ do normaliseMixedAmountSquashPricesForDisplay (Mixed []) @?= Mixed [nullamt] assertBool "" $ mixedAmountLooksZero $ normaliseMixedAmountSquashPricesForDisplay (Mixed [usd 10 ,usd 10 @@ eur 7 ,usd (-10) ,usd (-10) @@ eur 7 ]) ] ] hledger-lib-1.19.1/Hledger/Data/Commodity.hs0000644000000000000000000000466113722544246016712 0ustar0000000000000000{-| A 'Commodity' is a symbol representing a currency or some other kind of thing we are tracking, and some display preferences that tell how to display 'Amount's of the commodity - is the symbol on the left or right, are thousands separated by comma, significant decimal places and so on. -} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Hledger.Data.Commodity where import Control.Applicative (liftA2) import Data.Char (isDigit) import Data.List import Data.Maybe (fromMaybe) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif import qualified Data.Text as T -- import qualified Data.Map as M import Hledger.Data.Types import Hledger.Utils -- characters that may not be used in a non-quoted commodity symbol isNonsimpleCommodityChar :: Char -> Bool isNonsimpleCommodityChar = liftA2 (||) isDigit isOther where otherChars = "-+.@*;\t\n \"{}=" :: T.Text isOther c = T.any (==c) otherChars quoteCommoditySymbolIfNeeded :: T.Text -> T.Text quoteCommoditySymbolIfNeeded s | T.any isNonsimpleCommodityChar s = "\"" <> s <> "\"" | otherwise = s commodity = "" -- handy constructors for tests -- unknown = commodity -- usd = "$" -- eur = "€" -- gbp = "£" -- hour = "h" -- Some sample commodity' names and symbols, for use in tests.. commoditysymbols = [("unknown","") ,("usd","$") ,("eur","€") ,("gbp","£") ,("hour","h") ] -- | Look up one of the sample commodities' symbol by name. comm :: String -> CommoditySymbol comm name = snd $ fromMaybe (error' "commodity lookup failed") -- PARTIAL: (find (\n -> fst n == name) commoditysymbols) -- | Find the conversion rate between two commodities. Currently returns 1. conversionRate :: CommoditySymbol -> CommoditySymbol -> Double conversionRate _ _ = 1 -- -- | Convert a list of commodities to a map from commodity symbols to -- -- unique, display-preference-canonicalised commodities. -- canonicaliseCommodities :: [CommoditySymbol] -> Map.Map String CommoditySymbol -- canonicaliseCommodities cs = -- Map.fromList [(s,firstc{precision=maxp}) | s <- symbols, -- let cs = commoditymap ! s, -- let firstc = head cs, -- let maxp = maximum $ map precision cs -- ] -- where -- commoditymap = Map.fromList [(s, commoditieswithsymbol s) | s <- symbols] -- commoditieswithsymbol s = filter ((s==) . symbol) cs -- symbols = nub $ map symbol cs hledger-lib-1.19.1/Hledger/Data/Dates.hs0000644000000000000000000011547113723606465016013 0ustar0000000000000000{-# LANGUAGE NoMonoLocalBinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE PackageImports #-} {-| Date parsing and utilities for hledger. For date and time values, we use the standard Day and UTCTime types. A 'SmartDate' is a date which may be partially-specified or relative. Eg 2008\/12\/31, but also 2008\/12, 12\/31, tomorrow, last week, next year. We represent these as a triple of strings like (\"2008\",\"12\",\"\"), (\"\",\"\",\"tomorrow\"), (\"\",\"last\",\"week\"). A 'DateSpan' is the span of time between two specific calendar dates, or an open-ended span where one or both dates are unspecified. (A date span with both ends unspecified matches all dates.) An 'Interval' is ledger's \"reporting interval\" - weekly, monthly, quarterly, etc. 'Period' will probably replace DateSpan in due course. -} -- XXX fromGregorian silently clips bad dates, use fromGregorianValid instead ? module Hledger.Data.Dates ( -- * Misc date handling utilities getCurrentDay, getCurrentMonth, getCurrentYear, nulldate, spanContainsDate, periodContainsDate, parsedateM, showDate, showDateSpan, showDateSpanMonthAbbrev, elapsedSeconds, prevday, periodexprp, parsePeriodExpr, parsePeriodExpr', nulldatespan, emptydatespan, datesepchar, datesepchars, isDateSepChar, spanStart, spanEnd, spanStartYear, spanEndYear, spanYears, spansSpan, spanIntersect, spansIntersect, spanDefaultsFrom, spanUnion, spansUnion, daysSpan, latestSpanContaining, smartdate, splitSpan, fixSmartDate, fixSmartDateStr, fixSmartDateStrEither, fixSmartDateStrEither', yearp, daysInSpan, maybePeriod, ) where import Prelude () import "base-compat-batteries" Prelude.Compat hiding (fail) import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (MonadFail, fail) import Control.Applicative (liftA2) import Control.Applicative.Permutations import Control.Monad (guard, unless) import "base-compat-batteries" Data.List.Compat import Data.Char (digitToInt, isDigit, ord) import Data.Default import Data.Foldable (asum) import Data.Function (on) import Data.Maybe import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import Data.Time.Format hiding (months) import Data.Time.Calendar import Data.Time.Calendar.OrdinalDate import Data.Time.Clock import Data.Time.LocalTime import Safe (headMay, lastMay, maximumMay, minimumMay) import Text.Megaparsec import Text.Megaparsec.Char import Text.Megaparsec.Char.Lexer (decimal) import Text.Megaparsec.Custom import Text.Printf import Hledger.Data.Types import Hledger.Data.Period import Hledger.Utils -- Help ppShow parse and line-wrap DateSpans better in debug output. instance Show DateSpan where show s = "DateSpan " ++ showDateSpan s -- show s = "DateSpan \"" ++ showDateSpan s ++ "\"" -- quotes to help pretty-show showDate :: Day -> String showDate = show -- | Render a datespan as a display string, abbreviating into a -- compact form if possible. showDateSpan :: DateSpan -> String showDateSpan = showPeriod . dateSpanAsPeriod -- | Like showDateSpan, but show month spans as just the abbreviated month name -- in the current locale. showDateSpanMonthAbbrev :: DateSpan -> String showDateSpanMonthAbbrev = showPeriodMonthAbbrev . dateSpanAsPeriod -- | Get the current local date. getCurrentDay :: IO Day getCurrentDay = localDay . zonedTimeToLocalTime <$> getZonedTime -- | Get the current local month number. getCurrentMonth :: IO Int getCurrentMonth = second3 . toGregorian <$> getCurrentDay -- | Get the current local year. getCurrentYear :: IO Integer getCurrentYear = first3 . toGregorian <$> getCurrentDay elapsedSeconds :: Fractional a => UTCTime -> UTCTime -> a elapsedSeconds t1 = realToFrac . diffUTCTime t1 spanStart :: DateSpan -> Maybe Day spanStart (DateSpan d _) = d spanEnd :: DateSpan -> Maybe Day spanEnd (DateSpan _ d) = d spanStartYear :: DateSpan -> Maybe Year spanStartYear (DateSpan d _) = fmap (first3 . toGregorian) d spanEndYear :: DateSpan -> Maybe Year spanEndYear (DateSpan d _) = fmap (first3 . toGregorian) d -- | Get the 0-2 years mentioned explicitly in a DateSpan. spanYears :: DateSpan -> [Year] spanYears (DateSpan ma mb) = mapMaybe (fmap (first3 . toGregorian)) [ma,mb] -- might be useful later: http://en.wikipedia.org/wiki/Allen%27s_interval_algebra -- | Get overall span enclosing multiple sequentially ordered spans. spansSpan :: [DateSpan] -> DateSpan spansSpan spans = DateSpan (maybe Nothing spanStart $ headMay spans) (maybe Nothing spanEnd $ lastMay spans) -- | Split a DateSpan into consecutive whole spans of the specified interval -- which fully encompass the original span (and a little more when necessary). -- If no interval is specified, the original span is returned. -- If the original span is the null date span, ie unbounded, the null date span is returned. -- If the original span is empty, eg if the end date is <= the start date, no spans are returned. -- -- -- ==== Examples: -- >>> let t i y1 m1 d1 y2 m2 d2 = splitSpan i $ DateSpan (Just $ fromGregorian y1 m1 d1) (Just $ fromGregorian y2 m2 d2) -- >>> t NoInterval 2008 01 01 2009 01 01 -- [DateSpan 2008] -- >>> t (Quarters 1) 2008 01 01 2009 01 01 -- [DateSpan 2008Q1,DateSpan 2008Q2,DateSpan 2008Q3,DateSpan 2008Q4] -- >>> splitSpan (Quarters 1) nulldatespan -- [DateSpan ..] -- >>> t (Days 1) 2008 01 01 2008 01 01 -- an empty datespan -- [] -- >>> t (Quarters 1) 2008 01 01 2008 01 01 -- [] -- >>> t (Months 1) 2008 01 01 2008 04 01 -- [DateSpan 2008-01,DateSpan 2008-02,DateSpan 2008-03] -- >>> t (Months 2) 2008 01 01 2008 04 01 -- [DateSpan 2008-01-01..2008-02-29,DateSpan 2008-03-01..2008-04-30] -- >>> t (Weeks 1) 2008 01 01 2008 01 15 -- [DateSpan 2007-12-31W01,DateSpan 2008-01-07W02,DateSpan 2008-01-14W03] -- >>> t (Weeks 2) 2008 01 01 2008 01 15 -- [DateSpan 2007-12-31..2008-01-13,DateSpan 2008-01-14..2008-01-27] -- >>> t (DayOfMonth 2) 2008 01 01 2008 04 01 -- [DateSpan 2007-12-02..2008-01-01,DateSpan 2008-01-02..2008-02-01,DateSpan 2008-02-02..2008-03-01,DateSpan 2008-03-02..2008-04-01] -- >>> t (WeekdayOfMonth 2 4) 2011 01 01 2011 02 15 -- [DateSpan 2010-12-09..2011-01-12,DateSpan 2011-01-13..2011-02-09,DateSpan 2011-02-10..2011-03-09] -- >>> t (DayOfWeek 2) 2011 01 01 2011 01 15 -- [DateSpan 2010-12-28..2011-01-03,DateSpan 2011-01-04..2011-01-10,DateSpan 2011-01-11..2011-01-17] -- >>> t (DayOfYear 11 29) 2011 10 01 2011 10 15 -- [DateSpan 2010-11-29..2011-11-28] -- >>> t (DayOfYear 11 29) 2011 12 01 2012 12 15 -- [DateSpan 2011-11-29..2012-11-28,DateSpan 2012-11-29..2013-11-28] -- splitSpan :: Interval -> DateSpan -> [DateSpan] splitSpan _ (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing] splitSpan _ s | isEmptySpan s = [] splitSpan NoInterval s = [s] splitSpan (Days n) s = splitspan startofday (applyN n nextday) s splitSpan (Weeks n) s = splitspan startofweek (applyN n nextweek) s splitSpan (Months n) s = splitspan startofmonth (applyN n nextmonth) s splitSpan (Quarters n) s = splitspan startofquarter (applyN n nextquarter) s splitSpan (Years n) s = splitspan startofyear (applyN n nextyear) s splitSpan (DayOfMonth n) s = splitspan (nthdayofmonthcontaining n) (nthdayofmonth n . nextmonth) s splitSpan (WeekdayOfMonth n wd) s = splitspan (nthweekdayofmonthcontaining n wd) (advancetonthweekday n wd . nextmonth) s splitSpan (DayOfWeek n) s = splitspan (nthdayofweekcontaining n) (applyN (n-1) nextday . nextweek) s splitSpan (DayOfYear m n) s = splitspan (nthdayofyearcontaining m n) (applyN (n-1) nextday . applyN (m-1) nextmonth . nextyear) s -- splitSpan (WeekOfYear n) s = splitspan startofweek (applyN n nextweek) s -- splitSpan (MonthOfYear n) s = splitspan startofmonth (applyN n nextmonth) s -- splitSpan (QuarterOfYear n) s = splitspan startofquarter (applyN n nextquarter) s -- Split the given span using the provided helper functions: -- start is applied to the span's start date to get the first sub-span's start date -- next is applied to a sub-span's start date to get the next sub-span's start date splitspan :: (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan] splitspan _ _ (DateSpan Nothing Nothing) = [] splitspan start next (DateSpan Nothing (Just e)) = splitspan start next (DateSpan (Just $ start e) (Just $ next $ start e)) splitspan start next (DateSpan (Just s) Nothing) = splitspan start next (DateSpan (Just $ start s) (Just $ next $ start s)) splitspan start next span@(DateSpan (Just s) (Just e)) | s == e = [span] | otherwise = splitspan' start next span where splitspan' start next (DateSpan (Just s) (Just e)) | s >= e = [] | otherwise = DateSpan (Just subs) (Just sube) : splitspan' start next (DateSpan (Just sube) (Just e)) where subs = start s sube = next subs splitspan' _ _ _ = error' "won't happen, avoids warnings" -- PARTIAL: -- | Count the days in a DateSpan, or if it is open-ended return Nothing. daysInSpan :: DateSpan -> Maybe Integer daysInSpan (DateSpan (Just d1) (Just d2)) = Just $ diffDays d2 d1 daysInSpan _ = Nothing -- | Is this an empty span, ie closed with the end date on or before the start date ? isEmptySpan :: DateSpan -> Bool isEmptySpan (DateSpan (Just s) (Just e)) = e <= s isEmptySpan _ = False -- | Does the span include the given date ? spanContainsDate :: DateSpan -> Day -> Bool spanContainsDate (DateSpan Nothing Nothing) _ = True spanContainsDate (DateSpan Nothing (Just e)) d = d < e spanContainsDate (DateSpan (Just b) Nothing) d = d >= b spanContainsDate (DateSpan (Just b) (Just e)) d = d >= b && d < e -- | Does the period include the given date ? -- (Here to avoid import cycle). periodContainsDate :: Period -> Day -> Bool periodContainsDate p = spanContainsDate (periodAsDateSpan p) -- | Calculate the intersection of a number of datespans. spansIntersect [] = nulldatespan spansIntersect [d] = d spansIntersect (d:ds) = d `spanIntersect` (spansIntersect ds) -- | Calculate the intersection of two datespans. -- -- For non-intersecting spans, gives an empty span beginning on the second's start date: -- >>> DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 01 03) `spanIntersect` DateSpan (Just $ fromGregorian 2018 01 03) (Just $ fromGregorian 2018 01 05) -- DateSpan 2018-01-03..2018-01-02 spanIntersect (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan b e where b = latest b1 b2 e = earliest e1 e2 -- | Fill any unspecified dates in the first span with the dates from -- the second one. Sort of a one-way spanIntersect. spanDefaultsFrom (DateSpan a1 b1) (DateSpan a2 b2) = DateSpan a b where a = if isJust a1 then a1 else a2 b = if isJust b1 then b1 else b2 -- | Calculate the union of a number of datespans. spansUnion [] = nulldatespan spansUnion [d] = d spansUnion (d:ds) = d `spanUnion` (spansUnion ds) -- | Calculate the union of two datespans. spanUnion (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan b e where b = earliest b1 b2 e = latest e1 e2 latest d Nothing = d latest Nothing d = d latest (Just d1) (Just d2) = Just $ max d1 d2 earliest d Nothing = d earliest Nothing d = d earliest (Just d1) (Just d2) = Just $ min d1 d2 -- | Calculate the minimal DateSpan containing all of the given Days (in the -- usual exclusive-end-date sense: beginning on the earliest, and ending on -- the day after the latest). daysSpan :: [Day] -> DateSpan daysSpan ds = DateSpan (minimumMay ds) (addDays 1 <$> maximumMay ds) -- | Select the DateSpan containing a given Day, if any, from a given list of -- DateSpans. -- -- If the DateSpans are non-overlapping, this returns the unique containing -- DateSpan, if it exists. If the DateSpans are overlapping, it will return the -- containing DateSpan with the latest start date, and then latest end date. -- Note: This will currently return `DateSpan (Just s) (Just e)` before it will -- return `DateSpan (Just s) Nothing`. It's unclear which behaviour is desired. -- This is irrelevant at the moment as it's never applied to any list with -- overlapping DateSpans. latestSpanContaining :: [DateSpan] -> Day -> Maybe DateSpan latestSpanContaining datespans = go where go day = do span <- Set.lookupLT supSpan spanSet guard $ spanContainsDate span day return span where -- The smallest DateSpan larger than any DateSpan containing day. supSpan = DateSpan (Just $ addDays 1 day) Nothing spanSet = Set.fromList $ filter (not . isEmptySpan) datespans -- | Parse a period expression to an Interval and overall DateSpan using -- the provided reference date, or return a parse error. parsePeriodExpr :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan) parsePeriodExpr refdate s = parsewith (periodexprp refdate <* eof) (T.toLower s) -- | Like parsePeriodExpr, but call error' on failure. parsePeriodExpr' :: Day -> Text -> (Interval, DateSpan) parsePeriodExpr' refdate s = either (error' . ("failed to parse:" ++) . customErrorBundlePretty) id $ -- PARTIAL: parsePeriodExpr refdate s maybePeriod :: Day -> Text -> Maybe (Interval,DateSpan) maybePeriod refdate = either (const Nothing) Just . parsePeriodExpr refdate -- | Show a DateSpan as a human-readable pseudo-period-expression string. -- dateSpanAsText :: DateSpan -> String -- dateSpanAsText (DateSpan Nothing Nothing) = "all" -- dateSpanAsText (DateSpan Nothing (Just e)) = printf "to %s" (show e) -- dateSpanAsText (DateSpan (Just b) Nothing) = printf "from %s" (show b) -- dateSpanAsText (DateSpan (Just b) (Just e)) = printf "%s to %s" (show b) (show e) -- | Convert a single smart date string to a date span using the provided -- reference date, or raise an error. -- spanFromSmartDateString :: Day -> String -> DateSpan -- spanFromSmartDateString refdate s = spanFromSmartDate refdate sdate -- where -- sdate = fromparse $ parsewith smartdateonly s spanFromSmartDate :: Day -> SmartDate -> DateSpan spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e) where (ry,rm,_) = toGregorian refdate (b,e) = span sdate span :: SmartDate -> (Day,Day) span (SmartRelative This Day) = (refdate, nextday refdate) span (SmartRelative Last Day) = (prevday refdate, refdate) span (SmartRelative Next Day) = (nextday refdate, addDays 2 refdate) span (SmartRelative This Week) = (thisweek refdate, nextweek refdate) span (SmartRelative Last Week) = (prevweek refdate, thisweek refdate) span (SmartRelative Next Week) = (nextweek refdate, startofweek $ addDays 14 refdate) span (SmartRelative This Month) = (thismonth refdate, nextmonth refdate) span (SmartRelative Last Month) = (prevmonth refdate, thismonth refdate) span (SmartRelative Next Month) = (nextmonth refdate, startofmonth $ addGregorianMonthsClip 2 refdate) span (SmartRelative This Quarter) = (thisquarter refdate, nextquarter refdate) span (SmartRelative Last Quarter) = (prevquarter refdate, thisquarter refdate) span (SmartRelative Next Quarter) = (nextquarter refdate, startofquarter $ addGregorianMonthsClip 6 refdate) span (SmartRelative This Year) = (thisyear refdate, nextyear refdate) span (SmartRelative Last Year) = (prevyear refdate, thisyear refdate) span (SmartRelative Next Year) = (nextyear refdate, startofyear $ addGregorianYearsClip 2 refdate) span (SmartAssumeStart y Nothing) = (startofyear day, nextyear day) where day = fromGregorian y 1 1 span (SmartAssumeStart y (Just (m, Nothing))) = (startofmonth day, nextmonth day) where day = fromGregorian y m 1 span (SmartAssumeStart y (Just (m, Just d))) = (day, nextday day) where day = fromGregorian y m d span (SmartFromReference m d) = (day, nextday day) where day = fromGregorian ry (fromMaybe rm m) d span (SmartMonth m) = (startofmonth day, nextmonth day) where day = fromGregorian ry m 1 -- showDay :: Day -> String -- showDay day = printf "%04d/%02d/%02d" y m d where (y,m,d) = toGregorian day -- | Convert a smart date string to an explicit yyyy\/mm\/dd string using -- the provided reference date, or raise an error. fixSmartDateStr :: Day -> Text -> String fixSmartDateStr d s = either (error' . printf "could not parse date %s %s" (show s) . show) id $ -- PARTIAL: (fixSmartDateStrEither d s :: Either (ParseErrorBundle Text CustomErr) String) -- | A safe version of fixSmartDateStr. fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) String fixSmartDateStrEither d = fmap showDate . fixSmartDateStrEither' d fixSmartDateStrEither' :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) Day fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of Right sd -> Right $ fixSmartDate d sd Left e -> Left e -- | Convert a SmartDate to an absolute date using the provided reference date. -- -- ==== Examples: -- >>> :set -XOverloadedStrings -- >>> let t = fixSmartDateStr (fromGregorian 2008 11 26) -- >>> t "0000-01-01" -- "0000-01-01" -- >>> t "1999-12-02" -- "1999-12-02" -- >>> t "1999.12.02" -- "1999-12-02" -- >>> t "1999/3/2" -- "1999-03-02" -- >>> t "19990302" -- "1999-03-02" -- >>> t "2008/2" -- "2008-02-01" -- >>> t "0020/2" -- "0020-02-01" -- >>> t "1000" -- "1000-01-01" -- >>> t "4/2" -- "2008-04-02" -- >>> t "2" -- "2008-11-02" -- >>> t "January" -- "2008-01-01" -- >>> t "feb" -- "2008-02-01" -- >>> t "today" -- "2008-11-26" -- >>> t "yesterday" -- "2008-11-25" -- >>> t "tomorrow" -- "2008-11-27" -- >>> t "this day" -- "2008-11-26" -- >>> t "last day" -- "2008-11-25" -- >>> t "next day" -- "2008-11-27" -- >>> t "this week" -- last monday -- "2008-11-24" -- >>> t "last week" -- previous monday -- "2008-11-17" -- >>> t "next week" -- next monday -- "2008-12-01" -- >>> t "this month" -- "2008-11-01" -- >>> t "last month" -- "2008-10-01" -- >>> t "next month" -- "2008-12-01" -- >>> t "this quarter" -- "2008-10-01" -- >>> t "last quarter" -- "2008-07-01" -- >>> t "next quarter" -- "2009-01-01" -- >>> t "this year" -- "2008-01-01" -- >>> t "last year" -- "2007-01-01" -- >>> t "next year" -- "2009-01-01" -- -- t "last wed" -- "2008-11-19" -- t "next friday" -- "2008-11-28" -- t "next january" -- "2009-01-01" -- fixSmartDate :: Day -> SmartDate -> Day fixSmartDate refdate = fix where fix :: SmartDate -> Day fix (SmartRelative This Day) = refdate fix (SmartRelative Last Day) = prevday refdate fix (SmartRelative Next Day) = nextday refdate fix (SmartRelative This Week) = thisweek refdate fix (SmartRelative Last Week) = prevweek refdate fix (SmartRelative Next Week) = nextweek refdate fix (SmartRelative This Month) = thismonth refdate fix (SmartRelative Last Month) = prevmonth refdate fix (SmartRelative Next Month) = nextmonth refdate fix (SmartRelative This Quarter) = thisquarter refdate fix (SmartRelative Last Quarter) = prevquarter refdate fix (SmartRelative Next Quarter) = nextquarter refdate fix (SmartRelative This Year) = thisyear refdate fix (SmartRelative Last Year) = prevyear refdate fix (SmartRelative Next Year) = nextyear refdate fix (SmartAssumeStart y md) = fromGregorian y (maybe 1 fst md) (fromMaybe 1 $ snd =<< md) fix (SmartFromReference m d) = fromGregorian ry (fromMaybe rm m) d fix (SmartMonth m) = fromGregorian ry m 1 (ry, rm, _) = toGregorian refdate prevday :: Day -> Day prevday = addDays (-1) nextday = addDays 1 startofday = id thisweek = startofweek prevweek = startofweek . addDays (-7) nextweek = startofweek . addDays 7 startofweek day = fromMondayStartWeek y w 1 where (y,_,_) = toGregorian day (w,_) = mondayStartWeek day thismonth = startofmonth prevmonth = startofmonth . addGregorianMonthsClip (-1) nextmonth = startofmonth . addGregorianMonthsClip 1 startofmonth day = fromGregorian y m 1 where (y,m,_) = toGregorian day nthdayofmonth d day = fromGregorian y m d where (y,m,_) = toGregorian day thisquarter = startofquarter prevquarter = startofquarter . addGregorianMonthsClip (-3) nextquarter = startofquarter . addGregorianMonthsClip 3 startofquarter day = fromGregorian y (firstmonthofquarter m) 1 where (y,m,_) = toGregorian day firstmonthofquarter m = ((m-1) `div` 3) * 3 + 1 thisyear = startofyear prevyear = startofyear . addGregorianYearsClip (-1) nextyear = startofyear . addGregorianYearsClip 1 startofyear day = fromGregorian y 1 1 where (y,_,_) = toGregorian day -- | For given date d find year-long interval that starts on given -- MM/DD of year and covers it. -- The given MM and DD should be basically valid (1-12 & 1-31), -- or an error is raised. -- -- Examples: lets take 2017-11-22. Year-long intervals covering it that -- starts before Nov 22 will start in 2017. However -- intervals that start after Nov 23rd should start in 2016: -- >>> let wed22nd = fromGregorian 2017 11 22 -- >>> nthdayofyearcontaining 11 21 wed22nd -- 2017-11-21 -- >>> nthdayofyearcontaining 11 22 wed22nd -- 2017-11-22 -- >>> nthdayofyearcontaining 11 23 wed22nd -- 2016-11-23 -- >>> nthdayofyearcontaining 12 02 wed22nd -- 2016-12-02 -- >>> nthdayofyearcontaining 12 31 wed22nd -- 2016-12-31 -- >>> nthdayofyearcontaining 1 1 wed22nd -- 2017-01-01 nthdayofyearcontaining :: Month -> MonthDay -> Day -> Day nthdayofyearcontaining m md date -- PARTIAL: | not (validMonth m) = error' $ "nthdayofyearcontaining: invalid month "++show m | not (validDay md) = error' $ "nthdayofyearcontaining: invalid day " ++show md | mmddOfSameYear <= date = mmddOfSameYear | otherwise = mmddOfPrevYear where mmddOfSameYear = addDays (toInteger md-1) $ applyN (m-1) nextmonth s mmddOfPrevYear = addDays (toInteger md-1) $ applyN (m-1) nextmonth $ prevyear s s = startofyear date -- | For given date d find month-long interval that starts on nth day of month -- and covers it. -- The given day of month should be basically valid (1-31), or an error is raised. -- -- Examples: lets take 2017-11-22. Month-long intervals covering it that -- start on 1st-22nd of month will start in Nov. However -- intervals that start on 23rd-30th of month should start in Oct: -- >>> let wed22nd = fromGregorian 2017 11 22 -- >>> nthdayofmonthcontaining 1 wed22nd -- 2017-11-01 -- >>> nthdayofmonthcontaining 12 wed22nd -- 2017-11-12 -- >>> nthdayofmonthcontaining 22 wed22nd -- 2017-11-22 -- >>> nthdayofmonthcontaining 23 wed22nd -- 2017-10-23 -- >>> nthdayofmonthcontaining 30 wed22nd -- 2017-10-30 nthdayofmonthcontaining :: MonthDay -> Day -> Day nthdayofmonthcontaining md date -- PARTIAL: | not (validDay md) = error' $ "nthdayofmonthcontaining: invalid day " ++show md | nthOfSameMonth <= date = nthOfSameMonth | otherwise = nthOfPrevMonth where nthOfSameMonth = nthdayofmonth md s nthOfPrevMonth = nthdayofmonth md $ prevmonth s s = startofmonth date -- | For given date d find week-long interval that starts on nth day of week -- and covers it. -- -- Examples: 2017-11-22 is Wed. Week-long intervals that cover it and -- start on Mon, Tue or Wed will start in the same week. However -- intervals that start on Thu or Fri should start in prev week: -- >>> let wed22nd = fromGregorian 2017 11 22 -- >>> nthdayofweekcontaining 1 wed22nd -- 2017-11-20 -- >>> nthdayofweekcontaining 2 wed22nd -- 2017-11-21 -- >>> nthdayofweekcontaining 3 wed22nd -- 2017-11-22 -- >>> nthdayofweekcontaining 4 wed22nd -- 2017-11-16 -- >>> nthdayofweekcontaining 5 wed22nd -- 2017-11-17 nthdayofweekcontaining :: WeekDay -> Day -> Day nthdayofweekcontaining n d | nthOfSameWeek <= d = nthOfSameWeek | otherwise = nthOfPrevWeek where nthOfSameWeek = addDays (toInteger n-1) s nthOfPrevWeek = addDays (toInteger n-1) $ prevweek s s = startofweek d -- | For given date d find month-long interval that starts on nth weekday of month -- and covers it. -- -- Examples: 2017-11-22 is 3rd Wed of Nov. Month-long intervals that cover it and -- start on 1st-4th Wed will start in Nov. However -- intervals that start on 4th Thu or Fri or later should start in Oct: -- >>> let wed22nd = fromGregorian 2017 11 22 -- >>> nthweekdayofmonthcontaining 1 3 wed22nd -- 2017-11-01 -- >>> nthweekdayofmonthcontaining 3 2 wed22nd -- 2017-11-21 -- >>> nthweekdayofmonthcontaining 4 3 wed22nd -- 2017-11-22 -- >>> nthweekdayofmonthcontaining 4 4 wed22nd -- 2017-10-26 -- >>> nthweekdayofmonthcontaining 4 5 wed22nd -- 2017-10-27 nthweekdayofmonthcontaining :: Int -> WeekDay -> Day -> Day nthweekdayofmonthcontaining n wd d | nthWeekdaySameMonth <= d = nthWeekdaySameMonth | otherwise = nthWeekdayPrevMonth where nthWeekdaySameMonth = advancetonthweekday n wd $ startofmonth d nthWeekdayPrevMonth = advancetonthweekday n wd $ prevmonth d -- | Advance to nth weekday wd after given start day s -- Can call error. advancetonthweekday :: Int -> WeekDay -> Day -> Day advancetonthweekday n wd s = -- PARTIAL: maybe err (addWeeks (n-1)) $ firstMatch (>=s) $ iterate (addWeeks 1) $ firstweekday s where err = error' "advancetonthweekday: should not happen" addWeeks k = addDays (7 * toInteger k) firstMatch p = headMay . dropWhile (not . p) firstweekday = addDays (toInteger wd-1) . startofweek ---------------------------------------------------------------------- -- parsing -- -- | Parse a couple of date-time string formats to a time type. -- parsedatetimeM :: String -> Maybe LocalTime -- parsedatetimeM s = asum [ -- parseTime defaultTimeLocale "%Y/%m/%d %H:%M:%S" s, -- parseTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" s -- ] -- | Try to parse a couple of date string formats: -- `YYYY-MM-DD`, `YYYY/MM/DD` or `YYYY.MM.DD`, with leading zeros required. -- For internal use, not quite the same as the journal's "simple dates". -- >>> parsedateM "2008/02/03" -- Just 2008-02-03 -- >>> parsedateM "2008/02/03/" -- Nothing -- >>> parsedateM "2008/02/30" -- Nothing parsedateM :: String -> Maybe Day parsedateM s = asum [ parseTimeM True defaultTimeLocale "%Y-%m-%d" s, parseTimeM True defaultTimeLocale "%Y/%m/%d" s, parseTimeM True defaultTimeLocale "%Y.%m.%d" s ] {-| Parse a date in any of the formats allowed in Ledger's period expressions, and some others. Assumes any text in the parse stream has been lowercased. Returns a SmartDate, to be converted to a full date later (see fixSmartDate). Examples: > 2004 (start of year, which must have 4+ digits) > 2004/10 (start of month, which must be 1-12) > 2004/10/1 (exact date, day must be 1-31) > 10/1 (month and day in current year) > 21 (day in current month) > october, oct (start of month in current year) > yesterday, today, tomorrow (-1, 0, 1 days from today) > last/this/next day/week/month/quarter/year (-1, 0, 1 periods from the current period) > 20181201 (8 digit YYYYMMDD with valid year month and day) > 201812 (6 digit YYYYMM with valid year and month) Note malformed digit sequences might give surprising results: > 201813 (6 digits with an invalid month is parsed as start of 6-digit year) > 20181301 (8 digits with an invalid month is parsed as start of 8-digit year) > 20181232 (8 digits with an invalid day gives an error) > 201801012 (9+ digits beginning with a valid YYYYMMDD gives an error) Eg: YYYYMMDD is parsed as year-month-date if those parts are valid (>=4 digits, 1-12, and 1-31 respectively): >>> parsewith (smartdate <* eof) "20181201" Right (SmartAssumeStart 2018 (Just (12,Just 1))) YYYYMM is parsed as year-month-01 if year and month are valid: >>> parsewith (smartdate <* eof) "201804" Right (SmartAssumeStart 2018 (Just (4,Nothing))) With an invalid month, it's parsed as a year: >>> parsewith (smartdate <* eof) "201813" Right (SmartAssumeStart 201813 Nothing) A 9+ digit number beginning with valid YYYYMMDD gives an error: >>> parsewith (smartdate <* eof) "201801012" Left (...) Big numbers not beginning with a valid YYYYMMDD are parsed as a year: >>> parsewith (smartdate <* eof) "201813012" Right (SmartAssumeStart 201813012 Nothing) -} smartdate :: TextParser m SmartDate smartdate = choice' -- XXX maybe obscures date errors ? see ledgerdate [ yyyymmdd, ymd , (\(m,d) -> SmartFromReference (Just m) d) <$> md , (SmartFromReference Nothing <$> decimal) >>= failIfInvalidDate , SmartMonth <$> (month <|> mon) , SmartRelative This Day <$ string' "today" , SmartRelative Last Day <$ string' "yesterday" , SmartRelative Next Day <$ string' "tomorrow" , liftA2 SmartRelative (seqP <* skipNonNewlineSpaces) intervalP ] where seqP = choice [This <$ string' "this", Last <$ string' "last", Next <$ string' "next"] intervalP = choice [Day <$ string' "day", Week <$ string' "week", Month <$ string' "month", Quarter <$ string' "quarter", Year <$ string' "year"] -- | Like smartdate, but there must be nothing other than whitespace after the date. smartdateonly :: TextParser m SmartDate smartdateonly = smartdate <* skipNonNewlineSpaces <* eof datesepchars :: String datesepchars = "/-." datesepchar :: TextParser m Char datesepchar = satisfy isDateSepChar isDateSepChar :: Char -> Bool isDateSepChar c = c == '-' || c == '/' || c == '.' validMonth, validDay :: Int -> Bool validMonth n = n >= 1 && n <= 12 validDay n = n >= 1 && n <= 31 failIfInvalidDate :: Fail.MonadFail m => SmartDate -> m SmartDate failIfInvalidDate s = unless isValid (Fail.fail $ "bad smart date: " ++ show s) *> return s where isValid = case s of SmartAssumeStart y (Just (m, md)) -> isJust $ fromGregorianValid y m (fromMaybe 1 md) SmartFromReference mm d -> isJust $ fromGregorianValid 2004 (fromMaybe 1 mm) d SmartMonth m -> validMonth m _ -> True yyyymmdd :: TextParser m SmartDate yyyymmdd = do y <- read <$> count 4 digitChar m <- read <$> count 2 digitChar d <- optional $ read <$> count 2 digitChar let date = SmartAssumeStart y $ Just (m, d) failIfInvalidDate date ymd :: TextParser m SmartDate ymd = liftA2 SmartAssumeStart yearp (optional $ try monthday) >>= failIfInvalidDate where monthday = do sep <- datesepchar liftA2 (,) decimal . optional $ char sep *> decimal md :: TextParser m (Month, MonthDay) md = do m <- decimal datesepchar d <- decimal _ <- failIfInvalidDate $ SmartFromReference (Just m) d return (m, d) -- | Parse a year number from a Text, making sure that at least four digits are -- used. yearp :: TextParser m Integer yearp = do year <- takeWhile1P (Just "year") isDigit unless (T.length year >= 4) . Fail.fail $ "Year must contain at least 4 digits: " <> T.unpack year return $ readDecimal year -- These are compared case insensitively, and should all be kept lower case. months = ["january","february","march","april","may","june", "july","august","september","october","november","december"] monthabbrevs = ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"] weekdays = ["monday","tuesday","wednesday","thursday","friday","saturday","sunday"] weekdayabbrevs = ["mon","tue","wed","thu","fri","sat","sun"] month, mon :: TextParser m Month month = choice $ zipWith (\i m -> i <$ string' m) [1..12] months mon = choice $ zipWith (\i m -> i <$ string' m) [1..12] monthabbrevs weekday :: TextParser m Int weekday = do wday <- T.toLower <$> (choice . map string' $ weekdays ++ weekdayabbrevs) case catMaybes $ [wday `elemIndex` weekdays, wday `elemIndex` weekdayabbrevs] of (i:_) -> return (i+1) [] -> Fail.fail $ "weekday: should not happen: attempted to find " <> show wday <> " in " <> show (weekdays ++ weekdayabbrevs) -- | Parse a period expression, specifying a date span and optionally -- a reporting interval. Requires a reference "today" date for -- resolving any relative start/end dates (only; it is not needed for -- parsing the reporting interval). -- -- >>> let p = parsePeriodExpr (fromGregorian 2008 11 26) -- >>> p "from Aug to Oct" -- Right (NoInterval,DateSpan 2008-08-01..2008-09-30) -- >>> p "aug to oct" -- Right (NoInterval,DateSpan 2008-08-01..2008-09-30) -- >>> p "2009q2" -- Right (NoInterval,DateSpan 2009Q2) -- >>> p "Q3" -- Right (NoInterval,DateSpan 2008Q3) -- >>> p "every 3 days in Aug" -- Right (Days 3,DateSpan 2008-08) -- >>> p "daily from aug" -- Right (Days 1,DateSpan 2008-08-01..) -- >>> p "every week to 2009" -- Right (Weeks 1,DateSpan ..2008-12-31) -- >>> p "every 2nd day of month" -- Right (DayOfMonth 2,DateSpan ..) -- >>> p "every 2nd day" -- Right (DayOfMonth 2,DateSpan ..) -- >>> p "every 2nd day 2009.." -- Right (DayOfMonth 2,DateSpan 2009-01-01..) -- >>> p "every 2nd day 2009-" -- Right (DayOfMonth 2,DateSpan 2009-01-01..) -- >>> p "every 29th Nov" -- Right (DayOfYear 11 29,DateSpan ..) -- >>> p "every 29th nov ..2009" -- Right (DayOfYear 11 29,DateSpan ..2008-12-31) -- >>> p "every nov 29th" -- Right (DayOfYear 11 29,DateSpan ..) -- >>> p "every Nov 29th 2009.." -- Right (DayOfYear 11 29,DateSpan 2009-01-01..) -- >>> p "every 11/29 from 2009" -- Right (DayOfYear 11 29,DateSpan 2009-01-01..) -- >>> p "every 2nd Thursday of month to 2009" -- Right (WeekdayOfMonth 2 4,DateSpan ..2008-12-31) -- >>> p "every 1st monday of month to 2009" -- Right (WeekdayOfMonth 1 1,DateSpan ..2008-12-31) -- >>> p "every tue" -- Right (DayOfWeek 2,DateSpan ..) -- >>> p "every 2nd day of week" -- Right (DayOfWeek 2,DateSpan ..) -- >>> p "every 2nd day of month" -- Right (DayOfMonth 2,DateSpan ..) -- >>> p "every 2nd day" -- Right (DayOfMonth 2,DateSpan ..) -- >>> p "every 2nd day 2009.." -- Right (DayOfMonth 2,DateSpan 2009-01-01..) -- >>> p "every 2nd day of month 2009.." -- Right (DayOfMonth 2,DateSpan 2009-01-01..) periodexprp :: Day -> TextParser m (Interval, DateSpan) periodexprp rdate = do skipNonNewlineSpaces choice' [ intervalanddateperiodexprp rdate , (,) NoInterval <$> periodexprdatespanp rdate ] -- Parse a reporting interval and a date span. intervalanddateperiodexprp :: Day -> TextParser m (Interval, DateSpan) intervalanddateperiodexprp rdate = do i <- reportingintervalp s <- option def . try $ do skipNonNewlineSpaces periodexprdatespanp rdate return (i,s) -- Parse a reporting interval. reportingintervalp :: TextParser m Interval reportingintervalp = choice' [ tryinterval "day" "daily" Days , tryinterval "week" "weekly" Weeks , tryinterval "month" "monthly" Months , tryinterval "quarter" "quarterly" Quarters , tryinterval "year" "yearly" Years , Weeks 2 <$ string' "biweekly" , Weeks 2 <$ string' "fortnightly" , Months 2 <$ string' "bimonthly" , string' "every" *> skipNonNewlineSpaces *> choice' [ DayOfWeek <$> (nth <* skipNonNewlineSpaces <* string' "day" <* of_ "week") , DayOfMonth <$> (nth <* skipNonNewlineSpaces <* string' "day" <* optOf_ "month") , liftA2 WeekdayOfMonth nth $ skipNonNewlineSpaces *> weekday <* optOf_ "month" , uncurry DayOfYear <$> (md <* optOf_ "year") , DayOfWeek <$> weekday , d_o_y <* optOf_ "year" ] ] where of_ period = skipNonNewlineSpaces *> string' "of" *> skipNonNewlineSpaces *> string' period optOf_ period = optional . try $ of_ period nth = decimal <* choice (map string' ["st","nd","rd","th"]) d_o_y = runPermutation $ liftA2 DayOfYear (toPermutation $ (month <|> mon) <* skipNonNewlineSpaces) (toPermutation $ nth <* skipNonNewlineSpaces) -- Parse any of several variants of a basic interval, eg "daily", "every day", "every N days". tryinterval :: String -> String -> (Int -> Interval) -> TextParser m Interval tryinterval singular compact intcons = intcons <$> choice' [ 1 <$ string' compact' , string' "every" *> skipNonNewlineSpaces *> choice [ 1 <$ string' singular' , decimal <* skipNonNewlineSpaces <* string' plural' ] ] where compact' = T.pack compact singular' = T.pack singular plural' = T.pack $ singular ++ "s" periodexprdatespanp :: Day -> TextParser m DateSpan periodexprdatespanp rdate = choice $ map try [ doubledatespanp rdate, quarterdatespanp rdate, fromdatespanp rdate, todatespanp rdate, justdatespanp rdate ] -- | -- >>> parsewith (doubledatespanp (fromGregorian 2018 01 01) <* eof) "20180101-201804" -- Right DateSpan 2018Q1 doubledatespanp :: Day -> TextParser m DateSpan doubledatespanp rdate = liftA2 fromToSpan (optional (string' "from" *> skipNonNewlineSpaces) *> smartdate) (skipNonNewlineSpaces *> choice [string' "to", string "..", string "-"] *> skipNonNewlineSpaces *> smartdate) where fromToSpan = DateSpan `on` (Just . fixSmartDate rdate) -- | -- >>> parsewith (quarterdatespanp (fromGregorian 2018 01 01) <* eof) "q1" -- Right DateSpan 2018Q1 -- >>> parsewith (quarterdatespanp (fromGregorian 2018 01 01) <* eof) "Q1" -- Right DateSpan 2018Q1 -- >>> parsewith (quarterdatespanp (fromGregorian 2018 01 01) <* eof) "2020q4" -- Right DateSpan 2020Q4 quarterdatespanp :: Day -> TextParser m DateSpan quarterdatespanp rdate = do y <- yearp <|> pure (first3 $ toGregorian rdate) q <- char' 'q' *> satisfy is4Digit return . periodAsDateSpan $ QuarterPeriod y (digitToInt q) where is4Digit c = (fromIntegral (ord c - ord '1') :: Word) <= 3 fromdatespanp :: Day -> TextParser m DateSpan fromdatespanp rdate = fromSpan <$> choice [ string' "from" *> skipNonNewlineSpaces *> smartdate , smartdate <* choice [string "..", string "-"] ] where fromSpan b = DateSpan (Just $ fixSmartDate rdate b) Nothing todatespanp :: Day -> TextParser m DateSpan todatespanp rdate = choice [string' "to", string' "until", string "..", string "-"] *> skipNonNewlineSpaces *> (DateSpan Nothing . Just . fixSmartDate rdate <$> smartdate) justdatespanp :: Day -> TextParser m DateSpan justdatespanp rdate = optional (string' "in" *> skipNonNewlineSpaces) *> (spanFromSmartDate rdate <$> smartdate) nulldatespan :: DateSpan nulldatespan = DateSpan Nothing Nothing -- | A datespan of zero length, that matches no date. emptydatespan :: DateSpan emptydatespan = DateSpan (Just $ addDays 1 nulldate) (Just nulldate) nulldate :: Day nulldate = fromGregorian 0 1 1 hledger-lib-1.19.1/Hledger/Data/Journal.hs0000644000000000000000000020501113724277550016353 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-| A 'Journal' is a set of transactions, plus optional related data. This is hledger's primary data object. It is usually parsed from a journal file or other data format (see "Hledger.Read"). -} module Hledger.Data.Journal ( -- * Parsing helpers addPriceDirective, addTransactionModifier, addPeriodicTransaction, addTransaction, journalBalanceTransactions, journalInferMarketPricesFromTransactions, journalApplyCommodityStyles, commodityStylesFromAmounts, journalCommodityStyles, journalToCost, journalReverse, journalSetLastReadTime, journalPivot, -- * Filtering filterJournalTransactions, filterJournalPostings, filterJournalAmounts, filterTransactionAmounts, filterTransactionPostings, filterPostingAmount, -- * Mapping mapJournalTransactions, mapJournalPostings, mapTransactionPostings, -- * Querying journalAccountNamesUsed, journalAccountNamesImplied, journalAccountNamesDeclared, journalAccountNamesDeclaredOrUsed, journalAccountNamesDeclaredOrImplied, journalAccountNames, -- journalAmountAndPriceCommodities, -- journalAmountStyles, -- overJournalAmounts, -- traverseJournalAmounts, -- journalCanonicalCommodities, journalDateSpan, journalStartDate, journalEndDate, journalDescriptions, journalFilePath, journalFilePaths, journalTransactionAt, journalNextTransaction, journalPrevTransaction, journalPostings, -- journalPrices, -- * Standard account types journalBalanceSheetAccountQuery, journalProfitAndLossAccountQuery, journalRevenueAccountQuery, journalExpenseAccountQuery, journalAssetAccountQuery, journalLiabilityAccountQuery, journalEquityAccountQuery, journalCashAccountQuery, -- * Misc canonicalStyleFrom, nulljournal, journalCheckBalanceAssertions, journalNumberAndTieTransactions, journalUntieTransactions, journalModifyTransactions, -- * Tests samplejournal, tests_Journal, ) where import Control.Monad import Control.Monad.Except import Control.Monad.Extra import Control.Monad.Reader as R import Control.Monad.ST import Data.Array.ST import Data.Default (Default(..)) import Data.Function ((&)) import qualified Data.HashTable.Class as H (toList) import qualified Data.HashTable.ST.Cuckoo as H import Data.List import Data.List.Extra (groupSort, nubSort) import qualified Data.Map as M import Data.Maybe #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup(..)) #endif import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import Safe (headMay, headDef) import Data.Time.Calendar import Data.Tree import System.Time (ClockTime(TOD)) import Text.Printf import Hledger.Utils import Hledger.Data.Types import Hledger.Data.AccountName import Hledger.Data.Amount import Hledger.Data.Dates import Hledger.Data.Transaction import Hledger.Data.TransactionModifier import Hledger.Data.Posting import Hledger.Query -- try to make Journal ppShow-compatible -- instance Show ClockTime where -- show t = "" -- deriving instance Show Journal instance Show Journal where show j | debugLevel < 3 = printf "Journal %s with %d transactions, %d accounts" (journalFilePath j) (length $ jtxns j) (length accounts) | debugLevel < 6 = printf "Journal %s with %d transactions, %d accounts: %s" (journalFilePath j) (length $ jtxns j) (length accounts) (show accounts) | otherwise = printf "Journal %s with %d transactions, %d accounts: %s, commodity styles: %s" (journalFilePath j) (length $ jtxns j) (length accounts) (show accounts) (show $ jinferredcommodities j) -- ++ (show $ journalTransactions l) where accounts = filter (/= "root") $ flatten $ journalAccountNameTree j -- showJournalDebug j = unlines [ -- show j -- ,show (jtxns j) -- ,show (jtxnmodifiers j) -- ,show (jperiodictxns j) -- ,show $ jparsetimeclockentries j -- ,show $ jpricedirectives j -- ,show $ jfinalcommentlines j -- ,show $ jparsestate j -- ,show $ map fst $ jfiles j -- ] -- The semigroup instance for Journal is useful for two situations. -- -- 1. concatenating finalised journals, eg with multiple -f options: -- FIRST <> SECOND. The second's list fields are appended to the -- first's, map fields are combined, transaction counts are summed, -- the parse state of the second is kept. -- -- 2. merging a child parsed journal, eg with the include directive: -- CHILD <> PARENT. A parsed journal's data is in reverse order, so -- this gives what we want. -- -- Note that (<>) is right-biased, so nulljournal is only a left identity. -- In particular, this prevents Journal from being a monoid. instance Semigroup Journal where j1 <> j2 = Journal { jparsedefaultyear = jparsedefaultyear j2 ,jparsedefaultcommodity = jparsedefaultcommodity j2 ,jparseparentaccounts = jparseparentaccounts j2 ,jparsealiases = jparsealiases j2 -- ,jparsetransactioncount = jparsetransactioncount j1 + jparsetransactioncount j2 ,jparsetimeclockentries = jparsetimeclockentries j1 <> jparsetimeclockentries j2 ,jincludefilestack = jincludefilestack j2 ,jdeclaredaccounts = jdeclaredaccounts j1 <> jdeclaredaccounts j2 ,jdeclaredaccounttypes = jdeclaredaccounttypes j1 <> jdeclaredaccounttypes j2 ,jcommodities = jcommodities j1 <> jcommodities j2 ,jinferredcommodities = jinferredcommodities j1 <> jinferredcommodities j2 ,jpricedirectives = jpricedirectives j1 <> jpricedirectives j2 ,jinferredmarketprices = jinferredmarketprices j1 <> jinferredmarketprices j2 ,jtxnmodifiers = jtxnmodifiers j1 <> jtxnmodifiers j2 ,jperiodictxns = jperiodictxns j1 <> jperiodictxns j2 ,jtxns = jtxns j1 <> jtxns j2 ,jfinalcommentlines = jfinalcommentlines j2 -- XXX discards j1's ? ,jfiles = jfiles j1 <> jfiles j2 ,jlastreadtime = max (jlastreadtime j1) (jlastreadtime j2) } instance Default Journal where def = nulljournal nulljournal :: Journal nulljournal = Journal { jparsedefaultyear = Nothing ,jparsedefaultcommodity = Nothing ,jparseparentaccounts = [] ,jparsealiases = [] -- ,jparsetransactioncount = 0 ,jparsetimeclockentries = [] ,jincludefilestack = [] ,jdeclaredaccounts = [] ,jdeclaredaccounttypes = M.empty ,jcommodities = M.empty ,jinferredcommodities = M.empty ,jpricedirectives = [] ,jinferredmarketprices = [] ,jtxnmodifiers = [] ,jperiodictxns = [] ,jtxns = [] ,jfinalcommentlines = "" ,jfiles = [] ,jlastreadtime = TOD 0 0 } journalFilePath :: Journal -> FilePath journalFilePath = fst . mainfile journalFilePaths :: Journal -> [FilePath] journalFilePaths = map fst . jfiles mainfile :: Journal -> (FilePath, Text) mainfile = headDef ("", "") . jfiles addTransaction :: Transaction -> Journal -> Journal addTransaction t j = j { jtxns = t : jtxns j } addTransactionModifier :: TransactionModifier -> Journal -> Journal addTransactionModifier mt j = j { jtxnmodifiers = mt : jtxnmodifiers j } addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal addPeriodicTransaction pt j = j { jperiodictxns = pt : jperiodictxns j } addPriceDirective :: PriceDirective -> Journal -> Journal addPriceDirective h j = j { jpricedirectives = h : jpricedirectives j } -- XXX #999 keep sorted -- | Get the transaction with this index (its 1-based position in the input stream), if any. journalTransactionAt :: Journal -> Integer -> Maybe Transaction journalTransactionAt Journal{jtxns=ts} i = -- it's probably ts !! (i+1), but we won't assume headMay [t | t <- ts, tindex t == i] -- | Get the transaction that appeared immediately after this one in the input stream, if any. journalNextTransaction :: Journal -> Transaction -> Maybe Transaction journalNextTransaction j t = journalTransactionAt j (tindex t + 1) -- | Get the transaction that appeared immediately before this one in the input stream, if any. journalPrevTransaction :: Journal -> Transaction -> Maybe Transaction journalPrevTransaction j t = journalTransactionAt j (tindex t - 1) -- | Unique transaction descriptions used in this journal. journalDescriptions :: Journal -> [Text] journalDescriptions = nubSort . map tdescription . jtxns -- | All postings from this journal's transactions, in order. journalPostings :: Journal -> [Posting] journalPostings = concatMap tpostings . jtxns -- | Sorted unique account names posted to by this journal's transactions. journalAccountNamesUsed :: Journal -> [AccountName] journalAccountNamesUsed = accountNamesFromPostings . journalPostings -- | Sorted unique account names implied by this journal's transactions - -- accounts posted to and all their implied parent accounts. journalAccountNamesImplied :: Journal -> [AccountName] journalAccountNamesImplied = expandAccountNames . journalAccountNamesUsed -- | Sorted unique account names declared by account directives in this journal. journalAccountNamesDeclared :: Journal -> [AccountName] journalAccountNamesDeclared = nubSort . map fst . jdeclaredaccounts -- | Sorted unique account names declared by account directives or posted to -- by transactions in this journal. journalAccountNamesDeclaredOrUsed :: Journal -> [AccountName] journalAccountNamesDeclaredOrUsed j = nubSort $ journalAccountNamesDeclared j ++ journalAccountNamesUsed j -- | Sorted unique account names declared by account directives, or posted to -- or implied as parents by transactions in this journal. journalAccountNamesDeclaredOrImplied :: Journal -> [AccountName] journalAccountNamesDeclaredOrImplied j = nubSort $ journalAccountNamesDeclared j ++ journalAccountNamesImplied j -- | Convenience/compatibility alias for journalAccountNamesDeclaredOrImplied. journalAccountNames :: Journal -> [AccountName] journalAccountNames = journalAccountNamesDeclaredOrImplied journalAccountNameTree :: Journal -> Tree AccountName journalAccountNameTree = accountNameTreeFrom . journalAccountNames -- queries for standard account types -- | A query for accounts in this journal which have been -- declared as Asset (or Cash, a subtype of Asset) by account directives, -- or otherwise for accounts with names matched by the case-insensitive -- regular expression @^assets?(:|$)@. journalAssetAccountQuery :: Journal -> Query journalAssetAccountQuery = journalAccountTypeQuery [Asset,Cash] (toRegexCI' "^assets?(:|$)") -- | A query for "Cash" (liquid asset) accounts in this journal, ie accounts -- declared as Cash by account directives, or otherwise with names matched by the -- case-insensitive regular expression @^assets?(:|$)@. and not including -- the case-insensitive regular expression @(investment|receivable|:A/R|:fixed)@. journalCashAccountQuery :: Journal -> Query journalCashAccountQuery j = case M.lookup Cash (jdeclaredaccounttypes j) of Nothing -> And [ journalAssetAccountQuery j, Not . Acct $ toRegexCI' "(investment|receivable|:A/R|:fixed)" ] Just _ -> journalAccountTypeQuery [Cash] notused j where notused = error' "journalCashAccountQuery: this should not have happened!" -- PARTIAL: -- | A query for accounts in this journal which have been -- declared as Liability by account directives, or otherwise for -- accounts with names matched by the case-insensitive regular expression -- @^(debts?|liabilit(y|ies))(:|$)@. journalLiabilityAccountQuery :: Journal -> Query journalLiabilityAccountQuery = journalAccountTypeQuery [Liability] (toRegexCI' "^(debts?|liabilit(y|ies))(:|$)") -- | A query for accounts in this journal which have been -- declared as Equity by account directives, or otherwise for -- accounts with names matched by the case-insensitive regular expression -- @^equity(:|$)@. journalEquityAccountQuery :: Journal -> Query journalEquityAccountQuery = journalAccountTypeQuery [Equity] (toRegexCI' "^equity(:|$)") -- | A query for accounts in this journal which have been -- declared as Revenue by account directives, or otherwise for -- accounts with names matched by the case-insensitive regular expression -- @^(income|revenue)s?(:|$)@. journalRevenueAccountQuery :: Journal -> Query journalRevenueAccountQuery = journalAccountTypeQuery [Revenue] (toRegexCI' "^(income|revenue)s?(:|$)") -- | A query for accounts in this journal which have been -- declared as Expense by account directives, or otherwise for -- accounts with names matched by the case-insensitive regular expression -- @^expenses?(:|$)@. journalExpenseAccountQuery :: Journal -> Query journalExpenseAccountQuery = journalAccountTypeQuery [Expense] (toRegexCI' "^expenses?(:|$)") -- | A query for Asset, Liability & Equity accounts in this journal. -- Cf . journalBalanceSheetAccountQuery :: Journal -> Query journalBalanceSheetAccountQuery j = Or [journalAssetAccountQuery j ,journalLiabilityAccountQuery j ,journalEquityAccountQuery j ] -- | A query for Profit & Loss accounts in this journal. -- Cf . journalProfitAndLossAccountQuery :: Journal -> Query journalProfitAndLossAccountQuery j = Or [journalRevenueAccountQuery j ,journalExpenseAccountQuery j ] -- | Get a query for accounts of the specified types (Asset, Liability..) in this journal. -- The query will match all accounts which were declared as one of -- these types by account directives, plus all their subaccounts which -- have not been declared as some other type. -- Or if no accounts were declared with these types, the query will -- instead match accounts with names matched by the provided -- case-insensitive regular expression. journalAccountTypeQuery :: [AccountType] -> Regexp -> Journal -> Query journalAccountTypeQuery atypes fallbackregex Journal{jdeclaredaccounttypes} = let declaredacctsoftype :: [AccountName] = concat $ mapMaybe (`M.lookup` jdeclaredaccounttypes) atypes in case declaredacctsoftype of [] -> Acct fallbackregex as -> And [ Or acctnameRegexes, Not $ Or differentlyTypedRegexes ] where -- XXX Query isn't able to match account type since that requires extra info from the journal. -- So we do a hacky search by name instead. acctnameRegexes = map (Acct . accountNameToAccountRegex) as differentlyTypedRegexes = map (Acct . accountNameToAccountRegex) differentlytypedsubs differentlytypedsubs = concat [subs | (t,bs) <- M.toList jdeclaredaccounttypes , not $ t `elem` atypes , let subs = [b | b <- bs, any (`isAccountNamePrefixOf` b) as] ] -- Various kinds of filtering on journals. We do it differently depending -- on the command. ------------------------------------------------------------------------------- -- filtering V2 -- | Keep only transactions matching the query expression. filterJournalTransactions :: Query -> Journal -> Journal filterJournalTransactions q j@Journal{jtxns=ts} = j{jtxns=filter (q `matchesTransaction`) ts} -- | Keep only postings matching the query expression. -- This can leave unbalanced transactions. filterJournalPostings :: Query -> Journal -> Journal filterJournalPostings q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionPostings q) ts} -- | Within each posting's amount, keep only the parts matching the query. -- This can leave unbalanced transactions. filterJournalAmounts :: Query -> Journal -> Journal filterJournalAmounts q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionAmounts q) ts} -- | Filter out all parts of this transaction's amounts which do not match the query. -- This can leave the transaction unbalanced. filterTransactionAmounts :: Query -> Transaction -> Transaction filterTransactionAmounts q t@Transaction{tpostings=ps} = t{tpostings=map (filterPostingAmount q) ps} -- | Filter out all parts of this posting's amount which do not match the query. filterPostingAmount :: Query -> Posting -> Posting filterPostingAmount q p@Posting{pamount=Mixed as} = p{pamount=Mixed $ filter (q `matchesAmount`) as} filterTransactionPostings :: Query -> Transaction -> Transaction filterTransactionPostings q t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps} -- | Apply a transformation to a journal's transactions. mapJournalTransactions :: (Transaction -> Transaction) -> Journal -> Journal mapJournalTransactions f j@Journal{jtxns=ts} = j{jtxns=map f ts} -- | Apply a transformation to a journal's postings. mapJournalPostings :: (Posting -> Posting) -> Journal -> Journal mapJournalPostings f j@Journal{jtxns=ts} = j{jtxns=map (mapTransactionPostings f) ts} -- | Apply a transformation to a transaction's postings. mapTransactionPostings :: (Posting -> Posting) -> Transaction -> Transaction mapTransactionPostings f t@Transaction{tpostings=ps} = t{tpostings=map f ps} {- ------------------------------------------------------------------------------- -- filtering V1 -- | Keep only transactions we are interested in, as described by the -- filter specification. filterJournalTransactions :: FilterSpec -> Journal -> Journal filterJournalTransactions FilterSpec{datespan=datespan ,cleared=cleared -- ,real=real -- ,empty=empty ,acctpats=apats ,descpats=dpats ,depth=depth ,fMetadata=md } = filterJournalTransactionsByStatus cleared . filterJournalPostingsByDepth depth . filterJournalTransactionsByAccount apats . filterJournalTransactionsByMetadata md . filterJournalTransactionsByDescription dpats . filterJournalTransactionsByDate datespan -- | Keep only postings we are interested in, as described by the filter -- specification. This can leave unbalanced transactions. filterJournalPostings :: FilterSpec -> Journal -> Journal filterJournalPostings FilterSpec{datespan=datespan ,cleared=cleared ,real=real ,empty=empty ,acctpats=apats ,descpats=dpats ,depth=depth ,fMetadata=md } = filterJournalPostingsByRealness real . filterJournalPostingsByStatus cleared . filterJournalPostingsByEmpty empty . filterJournalPostingsByDepth depth . filterJournalPostingsByAccount apats . filterJournalTransactionsByMetadata md . filterJournalTransactionsByDescription dpats . filterJournalTransactionsByDate datespan -- | Keep only transactions whose metadata matches all metadata specifications. filterJournalTransactionsByMetadata :: [(String,String)] -> Journal -> Journal filterJournalTransactionsByMetadata pats j@Journal{jtxns=ts} = j{jtxns=filter matchmd ts} where matchmd t = all (`elem` tmetadata t) pats -- | Keep only transactions whose description matches the description patterns. filterJournalTransactionsByDescription :: [String] -> Journal -> Journal filterJournalTransactionsByDescription pats j@Journal{jtxns=ts} = j{jtxns=filter matchdesc ts} where matchdesc = matchpats pats . tdescription -- | Keep only transactions which fall between begin and end dates. -- We include transactions on the begin date and exclude transactions on the end -- date, like ledger. An empty date string means no restriction. filterJournalTransactionsByDate :: DateSpan -> Journal -> Journal filterJournalTransactionsByDate (DateSpan begin end) j@Journal{jtxns=ts} = j{jtxns=filter match ts} where match t = maybe True (tdate t>=) begin && maybe True (tdate t<) end -- | Keep only transactions which have the requested cleared/uncleared -- status, if there is one. filterJournalTransactionsByStatus :: Maybe Bool -> Journal -> Journal filterJournalTransactionsByStatus Nothing j = j filterJournalTransactionsByStatus (Just val) j@Journal{jtxns=ts} = j{jtxns=filter match ts} where match = (==val).tstatus -- | Keep only postings which have the requested cleared/uncleared status, -- if there is one. filterJournalPostingsByStatus :: Maybe Bool -> Journal -> Journal filterJournalPostingsByStatus Nothing j = j filterJournalPostingsByStatus (Just c) j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts} where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter ((==c) . postingCleared) ps} -- | Strip out any virtual postings, if the flag is true, otherwise do -- no filtering. filterJournalPostingsByRealness :: Bool -> Journal -> Journal filterJournalPostingsByRealness False j = j filterJournalPostingsByRealness True j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts} where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter isReal ps} -- | Strip out any postings with zero amount, unless the flag is true. filterJournalPostingsByEmpty :: Bool -> Journal -> Journal filterJournalPostingsByEmpty True j = j filterJournalPostingsByEmpty False j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts} where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (not . isEmptyPosting) ps} -- -- | Keep only transactions which affect accounts deeper than the specified depth. -- filterJournalTransactionsByDepth :: Maybe Int -> Journal -> Journal -- filterJournalTransactionsByDepth Nothing j = j -- filterJournalTransactionsByDepth (Just d) j@Journal{jtxns=ts} = -- j{jtxns=(filter (any ((<= d+1) . accountNameLevel . paccount) . tpostings) ts)} -- | Strip out any postings to accounts deeper than the specified depth -- (and any transactions which have no postings as a result). filterJournalPostingsByDepth :: Maybe Int -> Journal -> Journal filterJournalPostingsByDepth Nothing j = j filterJournalPostingsByDepth (Just d) j@Journal{jtxns=ts} = j{jtxns=filter (not . null . tpostings) $ map filtertxns ts} where filtertxns t@Transaction{tpostings=ps} = t{tpostings=filter ((<= d) . accountNameLevel . paccount) ps} -- | Keep only postings which affect accounts matched by the account patterns. -- This can leave transactions unbalanced. filterJournalPostingsByAccount :: [String] -> Journal -> Journal filterJournalPostingsByAccount apats j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts} where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (matchpats apats . paccount) ps} -- | Keep only transactions which affect accounts matched by the account patterns. -- More precisely: each positive account pattern excludes transactions -- which do not contain a posting to a matched account, and each negative -- account pattern excludes transactions containing a posting to a matched -- account. filterJournalTransactionsByAccount :: [String] -> Journal -> Journal filterJournalTransactionsByAccount apats j@Journal{jtxns=ts} = j{jtxns=filter tmatch ts} where tmatch t = (null positives || any positivepmatch ps) && (null negatives || not (any negativepmatch ps)) where ps = tpostings t positivepmatch p = any (`amatch` a) positives where a = paccount p negativepmatch p = any (`amatch` a) negatives where a = paccount p amatch pat a = regexMatchesCI (abspat pat) a (negatives,positives) = partition isnegativepat apats -} -- | Reverse all lists of parsed items, which during parsing were -- prepended to, so that the items are in parse order. Part of -- post-parse finalisation. journalReverse :: Journal -> Journal journalReverse j = j {jfiles = reverse $ jfiles j ,jdeclaredaccounts = reverse $ jdeclaredaccounts j ,jtxns = reverse $ jtxns j ,jtxnmodifiers = reverse $ jtxnmodifiers j ,jperiodictxns = reverse $ jperiodictxns j ,jpricedirectives = reverse $ jpricedirectives j } -- | Set this journal's last read time, ie when its files were last read. journalSetLastReadTime :: ClockTime -> Journal -> Journal journalSetLastReadTime t j = j{ jlastreadtime = t } journalNumberAndTieTransactions = journalTieTransactions . journalNumberTransactions -- | Number (set the tindex field) this journal's transactions, counting upward from 1. journalNumberTransactions :: Journal -> Journal journalNumberTransactions j@Journal{jtxns=ts} = j{jtxns=map (\(i,t) -> t{tindex=i}) $ zip [1..] ts} -- | Tie the knot in all of this journal's transactions, ensuring their postings -- refer to them. This should be done last, after any other transaction-modifying operations. journalTieTransactions :: Journal -> Journal journalTieTransactions j@Journal{jtxns=ts} = j{jtxns=map txnTieKnot ts} -- | Untie all transaction-posting knots in this journal, so that eg -- recursiveSize and GHCI's :sprint can work on it. journalUntieTransactions :: Transaction -> Transaction journalUntieTransactions t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ptransaction=Nothing}) ps} -- | Apply any transaction modifier rules in the journal (adding automated -- postings to transactions, eg). Or if a modifier rule fails to parse, -- return the error message. A reference date is provided to help interpret -- relative dates in transaction modifier queries. journalModifyTransactions :: Day -> Journal -> Either String Journal journalModifyTransactions d j = case modifyTransactions d (jtxnmodifiers j) (jtxns j) of Right ts -> Right j{jtxns=ts} Left err -> Left err -- | Check any balance assertions in the journal and return an error message -- if any of them fail (or if the transaction balancing they require fails). journalCheckBalanceAssertions :: Journal -> Maybe String journalCheckBalanceAssertions = either Just (const Nothing) . journalBalanceTransactions True -- "Transaction balancing", including: inferring missing amounts, -- applying balance assignments, checking transaction balancedness, -- checking balance assertions, respecting posting dates. These things -- are all interdependent. -- WARN tricky algorithm and code ahead. -- -- Code overview as of 20190219, this could/should be simplified/documented more: -- parseAndFinaliseJournal['] (Cli/Utils.hs), journalAddForecast (Common.hs), budgetJournal (BudgetReport.hs), tests (BalanceReport.hs) -- journalBalanceTransactions -- runST -- runExceptT -- balanceTransaction (Transaction.hs) -- balanceTransactionHelper -- runReaderT -- balanceTransactionAndCheckAssertionsB -- addAmountAndCheckAssertionB -- addOrAssignAmountAndCheckAssertionB -- balanceTransactionHelper (Transaction.hs) -- uiCheckBalanceAssertions d ui@UIState{aopts=UIOpts{cliopts_=copts}, ajournal=j} (ErrorScreen.hs) -- journalCheckBalanceAssertions -- journalBalanceTransactions -- transactionWizard, postingsBalanced (Add.hs), tests (Transaction.hs) -- balanceTransaction (Transaction.hs) XXX hledger add won't allow balance assignments + missing amount ? -- | Monad used for statefully balancing/amount-inferring/assertion-checking -- a sequence of transactions. -- Perhaps can be simplified, or would a different ordering of layers make sense ? -- If you see a way, let us know. type Balancing s = ReaderT (BalancingState s) (ExceptT String (ST s)) -- | The state used while balancing a sequence of transactions. data BalancingState s = BalancingState { -- read only bsStyles :: Maybe (M.Map CommoditySymbol AmountStyle) -- ^ commodity display styles ,bsUnassignable :: S.Set AccountName -- ^ accounts in which balance assignments may not be used ,bsAssrt :: Bool -- ^ whether to check balance assertions -- mutable ,bsBalances :: H.HashTable s AccountName MixedAmount -- ^ running account balances, initially empty ,bsTransactions :: STArray s Integer Transaction -- ^ a mutable array of the transactions being balanced -- (for efficiency ? journalBalanceTransactions says: not strictly necessary but avoids a sort at the end I think) } -- | Access the current balancing state, and possibly modify the mutable bits, -- lifting through the Except and Reader layers into the Balancing monad. withRunningBalance :: (BalancingState s -> ST s a) -> Balancing s a withRunningBalance f = ask >>= lift . lift . f -- | Get this account's current exclusive running balance. getRunningBalanceB :: AccountName -> Balancing s MixedAmount getRunningBalanceB acc = withRunningBalance $ \BalancingState{bsBalances} -> do fromMaybe 0 <$> H.lookup bsBalances acc -- | Add this amount to this account's exclusive running balance. -- Returns the new running balance. addToRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount addToRunningBalanceB acc amt = withRunningBalance $ \BalancingState{bsBalances} -> do old <- fromMaybe 0 <$> H.lookup bsBalances acc let new = old + amt H.insert bsBalances acc new return new -- | Set this account's exclusive running balance to this amount. -- Returns the change in exclusive running balance. setRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount setRunningBalanceB acc amt = withRunningBalance $ \BalancingState{bsBalances} -> do old <- fromMaybe 0 <$> H.lookup bsBalances acc H.insert bsBalances acc amt return $ amt - old -- | Set this account's exclusive running balance to whatever amount -- makes its *inclusive* running balance (the sum of exclusive running -- balances of this account and any subaccounts) be the given amount. -- Returns the change in exclusive running balance. setInclusiveRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount setInclusiveRunningBalanceB acc newibal = withRunningBalance $ \BalancingState{bsBalances} -> do oldebal <- fromMaybe 0 <$> H.lookup bsBalances acc allebals <- H.toList bsBalances let subsibal = -- sum of any subaccounts' running balances sum $ map snd $ filter ((acc `isAccountNamePrefixOf`).fst) allebals let newebal = newibal - subsibal H.insert bsBalances acc newebal return $ newebal - oldebal -- | Update (overwrite) this transaction in the balancing state. updateTransactionB :: Transaction -> Balancing s () updateTransactionB t = withRunningBalance $ \BalancingState{bsTransactions} -> void $ writeArray bsTransactions (tindex t) t -- | Infer any missing amounts (to satisfy balance assignments and -- to balance transactions) and check that all transactions balance -- and (optional) all balance assertions pass. Or return an error message -- (just the first error encountered). -- -- Assumes journalInferCommodityStyles has been called, since those -- affect transaction balancing. -- -- This does multiple things at once because amount inferring, balance -- assignments, balance assertions and posting dates are interdependent. journalBalanceTransactions :: Bool -> Journal -> Either String Journal journalBalanceTransactions assrt j' = let -- ensure transactions are numbered, so we can store them by number j@Journal{jtxns=ts} = journalNumberTransactions j' -- display precisions used in balanced checking styles = Just $ journalCommodityStyles j -- balance assignments will not be allowed on these txnmodifieraccts = S.fromList $ map paccount $ concatMap tmpostingrules $ jtxnmodifiers j in runST $ do -- We'll update a mutable array of transactions as we balance them, -- not strictly necessary but avoids a sort at the end I think. balancedtxns <- newListArray (1, toInteger $ length ts) ts -- Infer missing posting amounts, check transactions are balanced, -- and check balance assertions. This is done in two passes: runExceptT $ do -- 1. Step through the transactions, balancing the ones which don't have balance assignments -- and leaving the others for later. The balanced ones are split into their postings. -- The postings and not-yet-balanced transactions remain in the same relative order. psandts :: [Either Posting Transaction] <- fmap concat $ forM ts $ \case t | null $ assignmentPostings t -> case balanceTransaction styles t of Left e -> throwError e Right t' -> do lift $ writeArray balancedtxns (tindex t') t' return $ map Left $ tpostings t' t -> return [Right t] -- 2. Sort these items by date, preserving the order of same-day items, -- and step through them while keeping running account balances, runningbals <- lift $ H.newSized (length $ journalAccountNamesUsed j) flip runReaderT (BalancingState styles txnmodifieraccts assrt runningbals balancedtxns) $ do -- performing balance assignments in, and balancing, the remaining transactions, -- and checking balance assertions as each posting is processed. void $ mapM' balanceTransactionAndCheckAssertionsB $ sortOn (either postingDate tdate) psandts ts' <- lift $ getElems balancedtxns return j{jtxns=ts'} -- | This function is called statefully on each of a date-ordered sequence of -- 1. fully explicit postings from already-balanced transactions and -- 2. not-yet-balanced transactions containing balance assignments. -- It executes balance assignments and finishes balancing the transactions, -- and checks balance assertions on each posting as it goes. -- An error will be thrown if a transaction can't be balanced -- or if an illegal balance assignment is found (cf checkIllegalBalanceAssignment). -- Transaction prices are removed, which helps eg balance-assertions.test: 15. Mix different commodities and assignments. -- This stores the balanced transactions in case 2 but not in case 1. balanceTransactionAndCheckAssertionsB :: Either Posting Transaction -> Balancing s () balanceTransactionAndCheckAssertionsB (Left p@Posting{}) = -- update the account's running balance and check the balance assertion if any void $ addAmountAndCheckAssertionB $ removePrices p balanceTransactionAndCheckAssertionsB (Right t@Transaction{tpostings=ps}) = do -- make sure we can handle the balance assignments mapM_ checkIllegalBalanceAssignmentB ps -- for each posting, infer its amount from the balance assignment if applicable, -- update the account's running balance and check the balance assertion if any ps' <- forM ps $ \p -> pure (removePrices p) >>= addOrAssignAmountAndCheckAssertionB -- infer any remaining missing amounts, and make sure the transaction is now fully balanced styles <- R.reader bsStyles case balanceTransactionHelper styles t{tpostings=ps'} of Left err -> throwError err Right (t', inferredacctsandamts) -> do -- for each amount just inferred, update the running balance mapM_ (uncurry addToRunningBalanceB) inferredacctsandamts -- and save the balanced transaction. updateTransactionB t' -- | If this posting has an explicit amount, add it to the account's running balance. -- If it has a missing amount and a balance assignment, infer the amount from, and -- reset the running balance to, the assigned balance. -- If it has a missing amount and no balance assignment, leave it for later. -- Then test the balance assertion if any. addOrAssignAmountAndCheckAssertionB :: Posting -> Balancing s Posting addOrAssignAmountAndCheckAssertionB p@Posting{paccount=acc, pamount=amt, pbalanceassertion=mba} -- an explicit posting amount | hasAmount p = do newbal <- addToRunningBalanceB acc amt whenM (R.reader bsAssrt) $ checkBalanceAssertionB p newbal return p -- no explicit posting amount, but there is a balance assignment -- TODO this doesn't yet handle inclusive assignments right, #1207 | Just BalanceAssertion{baamount,batotal,bainclusive} <- mba = do (diff,newbal) <- case batotal of -- a total balance assignment (==, all commodities) True -> do let newbal = Mixed [baamount] diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal return (diff,newbal) -- a partial balance assignment (=, one commodity) False -> do oldbalothercommodities <- filterMixedAmount ((acommodity baamount /=) . acommodity) <$> getRunningBalanceB acc let assignedbalthiscommodity = Mixed [baamount] newbal = oldbalothercommodities + assignedbalthiscommodity diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal return (diff,newbal) let p' = p{pamount=diff, poriginal=Just $ originalPosting p} whenM (R.reader bsAssrt) $ checkBalanceAssertionB p' newbal return p' -- no explicit posting amount, no balance assignment | otherwise = return p -- | Add the posting's amount to its account's running balance, and -- optionally check the posting's balance assertion if any. -- The posting is expected to have an explicit amount (otherwise this does nothing). -- Adding and checking balance assertions are tightly paired because we -- need to see the balance as it stands after each individual posting. addAmountAndCheckAssertionB :: Posting -> Balancing s Posting addAmountAndCheckAssertionB p | hasAmount p = do newbal <- addToRunningBalanceB (paccount p) (pamount p) whenM (R.reader bsAssrt) $ checkBalanceAssertionB p newbal return p addAmountAndCheckAssertionB p = return p -- | Check a posting's balance assertion against the given actual balance, and -- return an error if the assertion is not satisfied. -- If the assertion is partial, unasserted commodities in the actual balance -- are ignored; if it is total, they will cause the assertion to fail. checkBalanceAssertionB :: Posting -> MixedAmount -> Balancing s () checkBalanceAssertionB p@Posting{pbalanceassertion=Just (BalanceAssertion{baamount,batotal})} actualbal = forM_ assertedamts $ \amt -> checkBalanceAssertionOneCommodityB p amt actualbal where assertedamts = baamount : otheramts where assertedcomm = acommodity baamount otheramts | batotal = map (\a -> a{aquantity=0}) $ amounts $ filterMixedAmount ((/=assertedcomm).acommodity) actualbal | otherwise = [] checkBalanceAssertionB _ _ = return () -- | Does this (single commodity) expected balance match the amount of that -- commodity in the given (multicommodity) actual balance ? If not, returns a -- balance assertion failure message based on the provided posting. To match, -- the amounts must be exactly equal (display precision is ignored here). -- If the assertion is inclusive, the expected amount is compared with the account's -- subaccount-inclusive balance; otherwise, with the subaccount-exclusive balance. checkBalanceAssertionOneCommodityB :: Posting -> Amount -> MixedAmount -> Balancing s () checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt actualbal = do let isinclusive = maybe False bainclusive $ pbalanceassertion p actualbal' <- if isinclusive then -- sum the running balances of this account and any of its subaccounts seen so far withRunningBalance $ \BalancingState{bsBalances} -> H.foldM (\ibal (acc, amt) -> return $ ibal + if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc then amt else 0) 0 bsBalances else return actualbal let assertedcomm = acommodity assertedamt actualbalincomm = headDef 0 $ amounts $ filterMixedAmountByCommodity assertedcomm $ actualbal' pass = aquantity -- traceWith (("asserted:"++).showAmountDebug) assertedamt == aquantity -- traceWith (("actual:"++).showAmountDebug) actualbalincomm errmsg = printf (unlines [ "balance assertion: %s", "\nassertion details:", "date: %s", "account: %s%s", "commodity: %s", -- "display precision: %d", "calculated: %s", -- (at display precision: %s)", "asserted: %s", -- (at display precision: %s)", "difference: %s" ]) (case ptransaction p of Nothing -> "?" -- shouldn't happen Just t -> printf "%s\ntransaction:\n%s" (showGenericSourcePos pos) (chomp $ showTransaction t) :: String where pos = baposition $ fromJust $ pbalanceassertion p ) (showDate $ postingDate p) (T.unpack $ paccount p) -- XXX pack (if isinclusive then " (and subs)" else "" :: String) assertedcomm -- (asprecision $ astyle actualbalincommodity) -- should be the standard display precision I think (show $ aquantity actualbalincomm) -- (showAmount actualbalincommodity) (show $ aquantity assertedamt) -- (showAmount assertedamt) (show $ aquantity assertedamt - aquantity actualbalincomm) when (not pass) $ throwError errmsg -- | Throw an error if this posting is trying to do an illegal balance assignment. checkIllegalBalanceAssignmentB :: Posting -> Balancing s () checkIllegalBalanceAssignmentB p = do checkBalanceAssignmentPostingDateB p checkBalanceAssignmentUnassignableAccountB p -- XXX these should show position. annotateErrorWithTransaction t ? -- | Throw an error if this posting is trying to do a balance assignment and -- has a custom posting date (which makes amount inference too hard/impossible). checkBalanceAssignmentPostingDateB :: Posting -> Balancing s () checkBalanceAssignmentPostingDateB p = when (hasBalanceAssignment p && isJust (pdate p)) $ throwError $ unlines $ ["postings which are balance assignments may not have a custom date." ,"Please write the posting amount explicitly, or remove the posting date:" ,"" ,maybe (unlines $ showPostingLines p) showTransaction $ ptransaction p ] -- | Throw an error if this posting is trying to do a balance assignment and -- the account does not allow balance assignments (eg because it is referenced -- by a transaction modifier, which might generate additional postings to it). checkBalanceAssignmentUnassignableAccountB :: Posting -> Balancing s () checkBalanceAssignmentUnassignableAccountB p = do unassignable <- R.asks bsUnassignable when (hasBalanceAssignment p && paccount p `S.member` unassignable) $ throwError $ unlines $ ["balance assignments cannot be used with accounts which are" ,"posted to by transaction modifier rules (auto postings)." ,"Please write the posting amount explicitly, or remove the rule." ,"" ,"account: "++T.unpack (paccount p) ,"" ,"transaction:" ,"" ,maybe (unlines $ showPostingLines p) showTransaction $ ptransaction p ] -- -- | Choose and apply a consistent display style to the posting -- amounts in each commodity. Each commodity's style is specified by a -- commodity (or D) directive, or otherwise inferred from posting -- amounts. Can return an error message eg if inconsistent number -- formats are found. journalApplyCommodityStyles :: Journal -> Either String Journal journalApplyCommodityStyles j@Journal{jtxns=ts, jpricedirectives=pds} = case journalInferCommodityStyles j of Left e -> Left e Right j' -> Right j'' where styles = journalCommodityStyles j' j'' = j'{jtxns=map fixtransaction ts ,jpricedirectives=map fixpricedirective pds } fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps} fixposting p = p{pamount=styleMixedAmount styles $ pamount p ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p} fixbalanceassertion ba = ba{baamount=styleAmount styles $ baamount ba} fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmountExceptPrecision styles a} -- | Get the canonical amount styles for this journal, whether -- declared by commodity directives, by the last default commodity (D) -- directive, or inferred from posting amounts, as a map from symbol -- to style. Styles declared by directives take precedence (and -- commodity takes precedence over D). Styles from directives are -- guaranteed to specify the decimal mark character. journalCommodityStyles :: Journal -> M.Map CommoditySymbol AmountStyle journalCommodityStyles j = -- XXX could be some redundancy here, cf journalStyleInfluencingAmounts commoditystyles <> defaultcommoditystyle <> inferredstyles where commoditystyles = M.mapMaybe cformat $ jcommodities j defaultcommoditystyle = M.fromList $ catMaybes [jparsedefaultcommodity j] inferredstyles = jinferredcommodities j -- | Collect and save inferred amount styles for each commodity based on -- the posting amounts in that commodity (excluding price amounts), ie: -- "the format of the first amount, adjusted to the highest precision of all amounts". -- Can return an error message eg if inconsistent number formats are found. journalInferCommodityStyles :: Journal -> Either String Journal journalInferCommodityStyles j = case commodityStylesFromAmounts $ dbg7 "journalInferCommodityStyles using amounts" $ journalStyleInfluencingAmounts j of Left e -> Left e Right cs -> Right j{jinferredcommodities = cs} -- | Given a list of amounts, in parse order (roughly speaking; see journalStyleInfluencingAmounts), -- build a map from their commodity names to standard commodity -- display formats. Can return an error message eg if inconsistent -- number formats are found. -- -- Though, these amounts may have come from multiple files, so we -- shouldn't assume they use consistent number formats. -- Currently we don't enforce that even within a single file, -- and this function never reports an error. -- commodityStylesFromAmounts :: [Amount] -> Either String (M.Map CommoditySymbol AmountStyle) commodityStylesFromAmounts amts = Right $ M.fromList commstyles where commamts = groupSort [(acommodity as, as) | as <- amts] commstyles = [(c, canonicalStyleFrom $ map astyle as) | (c,as) <- commamts] -- TODO: should probably detect and report inconsistencies here -- | Given a list of amount styles (assumed to be from parsed amounts -- in a single commodity), in parse order, choose a canonical style. -- Traditionally it's "the style of the first, with the maximum precision of all". -- canonicalStyleFrom :: [AmountStyle] -> AmountStyle canonicalStyleFrom [] = amountstyle canonicalStyleFrom ss@(s:_) = s{asprecision=prec, asdecimalpoint=Just decmark, asdigitgroups=mgrps} where -- precision is maximum of all precisions prec = maximumStrict $ map asprecision ss -- identify the digit group mark (& group sizes) mgrps = headMay $ mapMaybe asdigitgroups ss -- if a digit group mark was identified above, we can rely on that; -- make sure the decimal mark is different. If not, default to period. defdecmark = case mgrps of Just (DigitGroups '.' _) -> ',' _ -> '.' -- identify the decimal mark: the first one used, or the above default, -- but never the same character as the digit group mark. -- urgh.. refactor.. decmark = case mgrps of Just _ -> defdecmark _ -> headDef defdecmark $ mapMaybe asdecimalpoint ss -- -- | Apply this journal's historical price records to unpriced amounts where possible. -- journalApplyPriceDirectives :: Journal -> Journal -- journalApplyPriceDirectives j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts} -- where -- fixtransaction t@Transaction{tdate=d, tpostings=ps} = t{tpostings=map fixposting ps} -- where -- fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a} -- fixmixedamount (Mixed as) = Mixed $ map fixamount as -- fixamount = fixprice -- fixprice a@Amount{price=Just _} = a -- fixprice a@Amount{commodity=c} = a{price=maybe Nothing (Just . UnitPrice) $ journalPriceDirectiveFor j d c} -- -- | Get the price for a commodity on the specified day from the price database, if known. -- -- Does only one lookup step, ie will not look up the price of a price. -- journalPriceDirectiveFor :: Journal -> Day -> CommoditySymbol -> Maybe MixedAmount -- journalPriceDirectiveFor j d CommoditySymbol{symbol=s} = do -- let ps = reverse $ filter ((<= d).pddate) $ filter ((s==).hsymbol) $ sortBy (comparing pddate) $ jpricedirectives j -- case ps of (PriceDirective{pdamount=a}:_) -> Just a -- _ -> Nothing -- | Infer transaction-implied market prices from commodity-exchanging -- transactions, if any. It's best to call this after transactions have -- been balanced and posting amounts have appropriate prices attached. journalInferMarketPricesFromTransactions :: Journal -> Journal journalInferMarketPricesFromTransactions j = j{jinferredmarketprices = dbg4 "jinferredmarketprices" $ mapMaybe postingInferredmarketPrice $ journalPostings j } -- | Make a market price equivalent to this posting's amount's unit -- price, if any. If the posting amount is multicommodity, only the -- first commodity amount is considered. postingInferredmarketPrice :: Posting -> Maybe MarketPrice postingInferredmarketPrice p@Posting{pamount} = -- convert any total prices to unit prices case mixedAmountTotalPriceToUnitPrice pamount of Mixed ( Amount{acommodity=fromcomm, aprice = Just (UnitPrice Amount{acommodity=tocomm, aquantity=rate})} : _) -> Just MarketPrice { mpdate = postingDate p ,mpfrom = fromcomm ,mpto = tocomm ,mprate = rate } _ -> Nothing -- | Convert all this journal's amounts to cost using the transaction prices, if any. -- The journal's commodity styles are applied to the resulting amounts. journalToCost :: Journal -> Journal journalToCost j@Journal{jtxns=ts} = j{jtxns=map (transactionToCost styles) ts} where styles = journalCommodityStyles j -- -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol. -- journalCanonicalCommodities :: Journal -> M.Map String CommoditySymbol -- journalCanonicalCommodities j = canonicaliseCommodities $ journalAmountCommodities j -- -- | Get all this journal's amounts' commodities, in the order parsed. -- journalAmountCommodities :: Journal -> [CommoditySymbol] -- journalAmountCommodities = map acommodity . concatMap amounts . journalAmounts -- -- | Get all this journal's amount and price commodities, in the order parsed. -- journalAmountAndPriceCommodities :: Journal -> [CommoditySymbol] -- journalAmountAndPriceCommodities = concatMap amountCommodities . concatMap amounts . journalAmounts -- -- | Get this amount's commodity and any commodities referenced in its price. -- amountCommodities :: Amount -> [CommoditySymbol] -- amountCommodities Amount{acommodity=c,aprice=p} = -- case p of Nothing -> [c] -- Just (UnitPrice ma) -> c:(concatMap amountCommodities $ amounts ma) -- Just (TotalPrice ma) -> c:(concatMap amountCommodities $ amounts ma) -- | Get an ordered list of amounts in this journal which can -- influence canonical amount display styles. Those amounts are, in -- the following order: -- -- * amounts in market price (P) directives (in parse order) -- * posting amounts in transactions (in parse order) -- * the amount in the final default commodity (D) directive -- -- Transaction price amounts (posting amounts' aprice field) are not included. -- journalStyleInfluencingAmounts :: Journal -> [Amount] journalStyleInfluencingAmounts j = catMaybes $ concat [ [mdefaultcommodityamt] ,map (Just . pdamount) $ jpricedirectives j ,map Just $ concatMap amounts $ map pamount $ journalPostings j ] where -- D's amount style isn't actually stored as an amount, make it into one mdefaultcommodityamt = case jparsedefaultcommodity j of Just (symbol,style) -> Just nullamt{acommodity=symbol,astyle=style} Nothing -> Nothing -- overcomplicated/unused amount traversal stuff -- -- | Get an ordered list of 'AmountStyle's from the amounts in this -- journal which influence canonical amount display styles. See -- traverseJournalAmounts. -- journalAmounts :: Journal -> [Amount] -- journalAmounts = getConst . traverseJournalAmounts (Const . (:[])) -- -- | Apply a transformation to the journal amounts traversed by traverseJournalAmounts. -- overJournalAmounts :: (Amount -> Amount) -> Journal -> Journal -- overJournalAmounts f = runIdentity . traverseJournalAmounts (Identity . f) -- -- | A helper that traverses over most amounts in the journal, -- in particular the ones which influence canonical amount display styles, -- processing them with the given applicative function. -- -- These include, in the following order: -- -- * the amount in the final default commodity (D) directive -- * amounts in market price (P) directives (in parse order) -- * posting amounts in transactions (in parse order) -- -- Transaction price amounts, which may be embedded in posting amounts -- (the aprice field), are left intact but not traversed/processed. -- -- traverseJournalAmounts :: Applicative f => (Amount -> f Amount) -> Journal -> f Journal -- traverseJournalAmounts f j = -- recombine <$> (traverse . dcamt) f (jparsedefaultcommodity j) -- <*> (traverse . pdamt) f (jpricedirectives j) -- <*> (traverse . tps . traverse . pamt . amts . traverse) f (jtxns j) -- where -- recombine pds txns = j { jpricedirectives = pds, jtxns = txns } -- -- a bunch of traversals -- dcamt g pd = (\mdc -> case mdc of Nothing -> Nothing -- Just ((c,stpd{pdamount =amt} -- ) <$> g (pdamount pd) -- pdamt g pd = (\amt -> pd{pdamount =amt}) <$> g (pdamount pd) -- tps g t = (\ps -> t {tpostings=ps }) <$> g (tpostings t) -- pamt g p = (\amt -> p {pamount =amt}) <$> g (pamount p) -- amts g (Mixed as) = Mixed <$> g as -- | The fully specified date span enclosing the dates (primary or secondary) -- of all this journal's transactions and postings, or DateSpan Nothing Nothing -- if there are none. journalDateSpan :: Bool -> Journal -> DateSpan journalDateSpan secondary j | null ts = DateSpan Nothing Nothing | otherwise = DateSpan (Just earliest) (Just $ addDays 1 latest) where earliest = minimumStrict dates latest = maximumStrict dates dates = pdates ++ tdates tdates = map (if secondary then transactionDate2 else tdate) ts pdates = concatMap (mapMaybe (if secondary then (Just . postingDate2) else pdate) . tpostings) ts ts = jtxns j -- | The earliest of this journal's transaction and posting dates, or -- Nothing if there are none. journalStartDate :: Bool -> Journal -> Maybe Day journalStartDate secondary j = b where DateSpan b _ = journalDateSpan secondary j -- | The latest of this journal's transaction and posting dates, or -- Nothing if there are none. journalEndDate :: Bool -> Journal -> Maybe Day journalEndDate secondary j = e where DateSpan _ e = journalDateSpan secondary j -- | 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, poriginal = 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 -- -- | Build a database of market prices in effect on the given date, -- -- from the journal's price directives. -- journalPrices :: Day -> Journal -> Prices -- journalPrices d = toPrices d . jpricedirectives -- -- | Render a market price as a P directive. -- showPriceDirectiveDirective :: PriceDirective -> String -- showPriceDirectiveDirective pd = unwords -- [ "P" -- , showDate (pddate pd) -- , T.unpack (pdcommodity pd) -- , (showAmount . setAmountPrecision maxprecision) (pdamount pd -- ) -- ] -- debug helpers -- traceAmountPrecision a = trace (show $ map (precision . acommodity) $ amounts a) a -- tracePostingsCommodities ps = trace (show $ map ((map (precision . acommodity) . amounts) . pamount) ps) ps -- tests -- A sample journal for testing, similar to examples/sample.journal: -- -- 2008/01/01 income -- assets:bank:checking $1 -- income:salary -- -- 2008/06/01 gift -- assets:bank:checking $1 -- income:gifts -- -- 2008/06/02 save -- assets:bank:saving $1 -- assets:bank:checking -- -- 2008/06/03 * eat & shop -- expenses:food $1 -- expenses:supplies $1 -- assets:cash -- -- 2008/10/01 take a loan -- assets:bank:checking $1 -- liabilities:debts $-1 -- -- 2008/12/31 * pay off -- liabilities:debts $1 -- assets:bank:checking -- Right samplejournal = journalBalanceTransactions False $ nulljournal {jtxns = [ txnTieKnot $ Transaction { tindex=0, tsourcepos=nullsourcepos, tdate=fromGregorian 2008 01 01, tdate2=Nothing, tstatus=Unmarked, tcode="", tdescription="income", tcomment="", ttags=[], tpostings= ["assets:bank:checking" `post` usd 1 ,"income:salary" `post` missingamt ], tprecedingcomment="" } , txnTieKnot $ Transaction { tindex=0, tsourcepos=nullsourcepos, tdate=fromGregorian 2008 06 01, tdate2=Nothing, tstatus=Unmarked, tcode="", tdescription="gift", tcomment="", ttags=[], tpostings= ["assets:bank:checking" `post` usd 1 ,"income:gifts" `post` missingamt ], tprecedingcomment="" } , txnTieKnot $ Transaction { tindex=0, tsourcepos=nullsourcepos, tdate=fromGregorian 2008 06 02, tdate2=Nothing, tstatus=Unmarked, tcode="", tdescription="save", tcomment="", ttags=[], tpostings= ["assets:bank:saving" `post` usd 1 ,"assets:bank:checking" `post` usd (-1) ], tprecedingcomment="" } , txnTieKnot $ Transaction { tindex=0, tsourcepos=nullsourcepos, tdate=fromGregorian 2008 06 03, tdate2=Nothing, tstatus=Cleared, tcode="", tdescription="eat & shop", tcomment="", ttags=[], tpostings=["expenses:food" `post` usd 1 ,"expenses:supplies" `post` usd 1 ,"assets:cash" `post` missingamt ], tprecedingcomment="" } , txnTieKnot $ Transaction { tindex=0, tsourcepos=nullsourcepos, tdate=fromGregorian 2008 10 01, tdate2=Nothing, tstatus=Unmarked, tcode="", tdescription="take a loan", tcomment="", ttags=[], tpostings=["assets:bank:checking" `post` usd 1 ,"liabilities:debts" `post` usd (-1) ], tprecedingcomment="" } , txnTieKnot $ Transaction { tindex=0, tsourcepos=nullsourcepos, tdate=fromGregorian 2008 12 31, tdate2=Nothing, tstatus=Unmarked, tcode="", tdescription="pay off", tcomment="", ttags=[], tpostings=["liabilities:debts" `post` usd 1 ,"assets:bank:checking" `post` usd (-1) ], tprecedingcomment="" } ] } tests_Journal = tests "Journal" [ test "journalDateSpan" $ journalDateSpan True nulljournal{ jtxns = [nulltransaction{tdate = fromGregorian 2014 02 01 ,tpostings = [posting{pdate=Just (fromGregorian 2014 01 10)}] } ,nulltransaction{tdate = fromGregorian 2014 09 01 ,tpostings = [posting{pdate2=Just (fromGregorian 2014 10 10)}] } ] } @?= (DateSpan (Just $ fromGregorian 2014 1 10) (Just $ fromGregorian 2014 10 11)) ,tests "standard account type queries" $ let j = samplejournal journalAccountNamesMatching :: Query -> Journal -> [AccountName] journalAccountNamesMatching q = filter (q `matchesAccount`) . journalAccountNames namesfrom qfunc = journalAccountNamesMatching (qfunc j) j in [ test "assets" $ assertEqual "" ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"] (namesfrom journalAssetAccountQuery) ,test "cash" $ assertEqual "" ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"] (namesfrom journalCashAccountQuery) ,test "liabilities" $ assertEqual "" ["liabilities","liabilities:debts"] (namesfrom journalLiabilityAccountQuery) ,test "equity" $ assertEqual "" [] (namesfrom journalEquityAccountQuery) ,test "income" $ assertEqual "" ["income","income:gifts","income:salary"] (namesfrom journalRevenueAccountQuery) ,test "expenses" $ assertEqual "" ["expenses","expenses:food","expenses:supplies"] (namesfrom journalExpenseAccountQuery) ] ,tests "journalBalanceTransactions" [ test "balance-assignment" $ do let ej = journalBalanceTransactions True $ --2019/01/01 -- (a) = 1 nulljournal{ jtxns = [ transaction (fromGregorian 2019 01 01) [ vpost' "a" missingamt (balassert (num 1)) ] ]} assertRight ej let Right j = ej (jtxns j & head & tpostings & head & pamount) @?= Mixed [num 1] ,test "same-day-1" $ do assertRight $ journalBalanceTransactions True $ --2019/01/01 -- (a) = 1 --2019/01/01 -- (a) 1 = 2 nulljournal{ jtxns = [ transaction (fromGregorian 2019 01 01) [ vpost' "a" missingamt (balassert (num 1)) ] ,transaction (fromGregorian 2019 01 01) [ vpost' "a" (num 1) (balassert (num 2)) ] ]} ,test "same-day-2" $ do assertRight $ journalBalanceTransactions True $ --2019/01/01 -- (a) 2 = 2 --2019/01/01 -- b 1 -- a --2019/01/01 -- a 0 = 1 nulljournal{ jtxns = [ transaction (fromGregorian 2019 01 01) [ vpost' "a" (num 2) (balassert (num 2)) ] ,transaction (fromGregorian 2019 01 01) [ post' "b" (num 1) Nothing ,post' "a" missingamt Nothing ] ,transaction (fromGregorian 2019 01 01) [ post' "a" (num 0) (balassert (num 1)) ] ]} ,test "out-of-order" $ do assertRight $ journalBalanceTransactions True $ --2019/1/2 -- (a) 1 = 2 --2019/1/1 -- (a) 1 = 1 nulljournal{ jtxns = [ transaction (fromGregorian 2019 01 02) [ vpost' "a" (num 1) (balassert (num 2)) ] ,transaction (fromGregorian 2019 01 01) [ vpost' "a" (num 1) (balassert (num 1)) ] ]} ] ,tests "commodityStylesFromAmounts" $ [ -- Journal similar to the one on #1091: -- 2019/09/24 -- (a) 1,000.00 -- -- 2019/09/26 -- (a) 1000,000 -- test "1091a" $ do commodityStylesFromAmounts [ nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 3) (Just ',') Nothing} ,nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 2) (Just '.') (Just (DigitGroups ',' [3]))} ] @?= -- The commodity style should have period as decimal mark -- and comma as digit group mark. Right (M.fromList [ ("", AmountStyle L False (Precision 3) (Just '.') (Just (DigitGroups ',' [3]))) ]) -- same journal, entries in reverse order ,test "1091b" $ do commodityStylesFromAmounts [ nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 2) (Just '.') (Just (DigitGroups ',' [3]))} ,nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 3) (Just ',') Nothing} ] @?= -- The commodity style should have period as decimal mark -- and comma as digit group mark. Right (M.fromList [ ("", AmountStyle L False (Precision 3) (Just '.') (Just (DigitGroups ',' [3]))) ]) ] ] hledger-lib-1.19.1/Hledger/Data/Json.hs0000644000000000000000000002315013724214736015651 0ustar0000000000000000{- JSON instances. Should they be in Types.hs ? -} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE CPP #-} --{-# LANGUAGE DataKinds #-} --{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} --{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} --{-# LANGUAGE NamedFieldPuns #-} --{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-} --{-# LANGUAGE PolyKinds #-} --{-# LANGUAGE QuasiQuotes #-} --{-# LANGUAGE QuasiQuotes #-} --{-# LANGUAGE Rank2Types #-} --{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} --{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} --{-# LANGUAGE TemplateHaskell #-} --{-# LANGUAGE TypeFamilies #-} --{-# LANGUAGE TypeOperators #-} module Hledger.Data.Json ( -- * Instances -- * Utilities toJsonText ,writeJsonFile ,readJsonFile ) where #if !(MIN_VERSION_base(4,13,0)) import Data.Semigroup ((<>)) #endif import Data.Aeson import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder) --import Data.Aeson.TH import qualified Data.ByteString.Lazy as BL import Data.Decimal import Data.Maybe import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL import Data.Text.Lazy.Builder (toLazyText) import GHC.Generics (Generic) import System.Time (ClockTime) import Hledger.Data.Types -- To JSON instance ToJSON Status instance ToJSON GenericSourcePos -- https://github.com/simonmichael/hledger/issues/1195 -- The default JSON output for Decimal can contain 255-digit integers -- (for repeating decimals caused by implicit transaction prices). -- JSON output is intended to be consumed by diverse apps and -- programming languages, which can't handle numbers like that. -- From #1195: -- -- > - JavaScript uses 64-bit IEEE754 numbers which can only accurately -- > represent integers up to 9007199254740991 (i.e. a maximum of 15 digits). -- > - Java’s largest integers are limited to 18 digits. -- > - Python 3 integers are unbounded. -- > - Python 2 integers are limited to 18 digits like Java. -- > - C and C++ number limits depend on platform — most platforms should -- > be able to represent unsigned integers up to 64 bits, i.e. 19 digits. -- -- What is the best compromise for both accuracy and practicality ? -- For now, we provide both the maximum precision representation -- (decimalPlaces & decimalMantissa), and a floating point representation -- with up to 10 decimal places (and an unbounded number of integer digits). -- We hope the mere presence of the large number in JSON won't break things, -- and that the overall number of significant digits in the floating point -- remains manageable in practice. (I'm not sure how to limit the number -- of significant digits in a Decimal right now.) instance ToJSON Decimal where toJSON d = object ["decimalPlaces" .= toJSON decimalPlaces ,"decimalMantissa" .= toJSON decimalMantissa ,"floatingPoint" .= toJSON (fromRational $ toRational d' :: Double) ] where d'@Decimal{..} = roundTo 10 d instance ToJSON Amount instance ToJSON AmountStyle instance ToJSON AmountPrecision instance ToJSON Side instance ToJSON DigitGroupStyle instance ToJSON MixedAmount instance ToJSON BalanceAssertion instance ToJSON AmountPrice instance ToJSON MarketPrice instance ToJSON PostingType instance ToJSON Posting where toJSON Posting{..} = object ["pdate" .= pdate ,"pdate2" .= pdate2 ,"pstatus" .= pstatus ,"paccount" .= paccount ,"pamount" .= pamount ,"pcomment" .= pcomment ,"ptype" .= ptype ,"ptags" .= ptags ,"pbalanceassertion" .= pbalanceassertion -- To avoid a cycle, show just the parent transaction's index number -- in a dummy field. When re-parsed, there will be no parent. ,"ptransaction_" .= maybe "" (show.tindex) ptransaction -- This is probably not wanted in json, we discard it. ,"poriginal" .= (Nothing :: Maybe Posting) ] instance ToJSON Transaction instance ToJSON TransactionModifier instance ToJSON PeriodicTransaction instance ToJSON PriceDirective instance ToJSON DateSpan instance ToJSON Interval instance ToJSON AccountAlias instance ToJSON AccountType instance ToJSONKey AccountType instance ToJSON AccountDeclarationInfo instance ToJSON Commodity instance ToJSON TimeclockCode instance ToJSON TimeclockEntry instance ToJSON ClockTime instance ToJSON Journal instance ToJSON Account where toJSON a = object ["aname" .= aname a ,"aebalance" .= aebalance a ,"aibalance" .= aibalance a ,"anumpostings" .= anumpostings a ,"aboring" .= aboring a -- To avoid a cycle, show just the parent account's name -- in a dummy field. When re-parsed, there will be no parent. ,"aparent_" .= maybe "" aname (aparent a) -- Just the names of subaccounts, as a dummy field, ignored when parsed. ,"asubs_" .= map aname (asubs a) -- The actual subaccounts (and their subs..), making a (probably highly redundant) tree -- ,"asubs" .= asubs a -- Omit the actual subaccounts ,"asubs" .= ([]::[Account]) ] deriving instance Generic (Ledger) instance ToJSON Ledger -- From JSON instance FromJSON Status instance FromJSON GenericSourcePos instance FromJSON Amount instance FromJSON AmountStyle instance FromJSON AmountPrecision instance FromJSON Side instance FromJSON DigitGroupStyle instance FromJSON MixedAmount instance FromJSON BalanceAssertion instance FromJSON AmountPrice instance FromJSON MarketPrice instance FromJSON PostingType instance FromJSON Posting instance FromJSON Transaction instance FromJSON AccountDeclarationInfo -- XXX The ToJSON instance replaces subaccounts with just names. -- Here we should try to make use of those to reconstruct the -- parent-child relationships. instance FromJSON Account -- Decimal, various attempts -- -- https://stackoverflow.com/questions/40331851/haskell-data-decimal-as-aeson-type ----instance FromJSON Decimal where parseJSON = ---- A.withScientific "Decimal" (return . right . eitherFromRational . toRational) -- -- https://github.com/bos/aeson/issues/474 -- http://hackage.haskell.org/package/aeson-1.4.2.0/docs/Data-Aeson-TH.html -- $(deriveFromJSON defaultOptions ''Decimal) -- doesn't work -- $(deriveFromJSON defaultOptions ''DecimalRaw) -- works; requires TH, but gives better parse error messages -- -- https://github.com/PaulJohnson/Haskell-Decimal/issues/6 --deriving instance Generic Decimal --instance FromJSON Decimal deriving instance Generic (DecimalRaw a) instance FromJSON (DecimalRaw Integer) -- -- @simonmichael, I think the code in your first comment should work if it compiles—though “work” doesn’t mean you can parse a JSON number directly into a `Decimal` using the generic instance, as you’ve discovered. -- --Error messages with these extensions are always rather cryptic, but I’d prefer them to Template Haskell. Typically you’ll want to start by getting a generic `ToJSON` instance working, then use that to figure out what the `FromJSON` instance expects to parse: for a correct instance, `encode` and `decode` should give you an isomorphism between your type and a subset of `Bytestring` (up to the `Maybe` wrapper that `decode` returns). -- --I don’t have time to test it right now, but I think it will also work without `DeriveAnyClass`, just using `DeriveGeneric` and `StandAloneDeriving`. It should also work to use the [`genericParseJSON`](http://hackage.haskell.org/package/aeson/docs/Data-Aeson.html#v:genericParseJSON) function to implement the class explicitly, something like this: -- --{-# LANGUAGE DeriveGeneric #-} --{-# LANGUAGE StandAloneDeriving #-} --import GHC.Generics --import Data.Aeson --deriving instance Generic Decimal --instance FromJSON Decimal where -- parseJSON = genericParseJSON defaultOptions -- --And of course you can avoid `StandAloneDeriving` entirely if you’re willing to wrap `Decimal` in your own `newtype`. -- XXX these will allow reading a Journal, but currently the -- jdeclaredaccounttypes Map gets serialised as a JSON list, which -- can't be read back. -- -- instance FromJSON AccountAlias -- instance FromJSONKey AccountType where fromJSONKey = genericFromJSONKey defaultJSONKeyOptions -- instance FromJSON AccountType -- instance FromJSON ClockTime -- instance FromJSON Commodity -- instance FromJSON DateSpan -- instance FromJSON Interval -- instance FromJSON PeriodicTransaction -- instance FromJSON PriceDirective -- instance FromJSON TimeclockCode -- instance FromJSON TimeclockEntry -- instance FromJSON TransactionModifier -- instance FromJSON Journal -- Utilities -- | Show a JSON-convertible haskell value as pretty-printed JSON text. toJsonText :: ToJSON a => a -> TL.Text toJsonText = (<>"\n") . toLazyText . encodePrettyToTextBuilder -- | Write a JSON-convertible haskell value to a pretty-printed JSON file. -- Eg: writeJsonFile "a.json" nulltransaction writeJsonFile :: ToJSON a => FilePath -> a -> IO () writeJsonFile f = TL.writeFile f . toJsonText -- we write with Text and read with ByteString, is that fine ? -- | Read a JSON file and decode it to the target type, or raise an error if we can't. -- Eg: readJsonFile "a.json" :: IO Transaction readJsonFile :: FromJSON a => FilePath -> IO a readJsonFile f = do bl <- BL.readFile f -- PARTIAL: let v = fromMaybe (error $ "could not decode JSON in "++show f++" to target value") (decode bl :: Maybe Value) case fromJSON v :: FromJSON a => Result a of Error e -> error e Success t -> return t hledger-lib-1.19.1/Hledger/Data/Ledger.hs0000644000000000000000000000734013723502755016145 0ustar0000000000000000{-| A 'Ledger' is derived from a 'Journal' by applying a filter specification to select 'Transaction's and 'Posting's of interest. It contains the filtered journal and knows the resulting chart of accounts, account balances, and postings in each account. -} {-# LANGUAGE OverloadedStrings #-} module Hledger.Data.Ledger ( nullledger ,ledgerFromJournal ,ledgerAccountNames ,ledgerAccount ,ledgerRootAccount ,ledgerTopAccounts ,ledgerLeafAccounts ,ledgerPostings ,ledgerDateSpan ,ledgerCommodities ,tests_Ledger ) where import qualified Data.Map as M import Safe (headDef) import Text.Printf import Hledger.Utils.Test import Hledger.Data.Types import Hledger.Data.Account import Hledger.Data.Dates (daysSpan) import Hledger.Data.Journal import Hledger.Data.Posting (postingDate) import Hledger.Query instance Show Ledger where show l = printf "Ledger with %d transactions, %d accounts\n" --"%s" (length (jtxns $ ljournal l) + length (jtxnmodifiers $ ljournal l) + length (jperiodictxns $ ljournal l)) (length $ ledgerAccountNames l) -- (showtree $ ledgerAccountNameTree l) nullledger :: Ledger nullledger = Ledger { ljournal = nulljournal, laccounts = [] } -- | Filter a journal's transactions with the given query, then build -- a "Ledger", containing the journal plus the tree of all its -- accounts with their subaccount-inclusive and subaccount-exclusive -- balances. If the query includes a depth limit, the ledger's journal -- will be depth limited, but the ledger's account tree will not. ledgerFromJournal :: Query -> Journal -> Ledger ledgerFromJournal q j = nullledger{ljournal=j'', laccounts=as} where (q',depthq) = (filterQuery (not . queryIsDepth) q, filterQuery queryIsDepth q) j' = filterJournalAmounts (filterQuery queryIsSym q) $ -- remove amount parts which the query's sym: terms would exclude filterJournalPostings q' j as = accountsFromPostings $ journalPostings j' j'' = filterJournalPostings depthq j' -- | List a ledger's account names. ledgerAccountNames :: Ledger -> [AccountName] ledgerAccountNames = drop 1 . map aname . laccounts -- | Get the named account from a ledger. ledgerAccount :: Ledger -> AccountName -> Maybe Account ledgerAccount l a = lookupAccount a $ laccounts l -- | Get this ledger's root account, which is a dummy "root" account -- above all others. This should always be first in the account list, -- if somehow not this returns a null account. ledgerRootAccount :: Ledger -> Account ledgerRootAccount = headDef nullacct . laccounts -- | List a ledger's top-level accounts (the ones below the root), in tree order. ledgerTopAccounts :: Ledger -> [Account] ledgerTopAccounts = asubs . head . laccounts -- | List a ledger's bottom-level (subaccount-less) accounts, in tree order. ledgerLeafAccounts :: Ledger -> [Account] ledgerLeafAccounts = filter (null.asubs) . laccounts -- | List a ledger's postings, in the order parsed. ledgerPostings :: Ledger -> [Posting] ledgerPostings = journalPostings . ljournal -- | The (fully specified) date span containing all the ledger's (filtered) transactions, -- or DateSpan Nothing Nothing if there are none. ledgerDateSpan :: Ledger -> DateSpan ledgerDateSpan = daysSpan . map postingDate . ledgerPostings -- | All commodities used in this ledger. ledgerCommodities :: Ledger -> [CommoditySymbol] ledgerCommodities = M.keys . jinferredcommodities . ljournal -- tests tests_Ledger = tests "Ledger" [ test "ledgerFromJournal" $ do length (ledgerPostings $ ledgerFromJournal Any nulljournal) @?= 0 length (ledgerPostings $ ledgerFromJournal Any samplejournal) @?= 13 length (ledgerPostings $ ledgerFromJournal (Depth 2) samplejournal) @?= 7 ] hledger-lib-1.19.1/Hledger/Data/Period.hs0000644000000000000000000003110213723300774016153 0ustar0000000000000000{-| Manipulate the time periods typically used for reports with Period, a richer abstraction than DateSpan. See also Types and Dates. -} module Hledger.Data.Period ( periodAsDateSpan ,dateSpanAsPeriod ,simplifyPeriod ,isLastDayOfMonth ,isStandardPeriod ,showPeriod ,showPeriodMonthAbbrev ,periodStart ,periodEnd ,periodNext ,periodPrevious ,periodNextIn ,periodPreviousIn ,periodMoveTo ,periodGrow ,periodShrink ,mondayBefore ,yearMonthContainingWeekStarting ,quarterContainingMonth ,firstMonthOfQuarter ,startOfFirstWeekInMonth ) where import Data.Time.Calendar import Data.Time.Calendar.MonthDay import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.WeekDate import Data.Time.Format import Text.Printf import Hledger.Data.Types -- | Convert Periods to DateSpans. -- -- >>> periodAsDateSpan (MonthPeriod 2000 1) == DateSpan (Just $ fromGregorian 2000 1 1) (Just $ fromGregorian 2000 2 1) -- True periodAsDateSpan :: Period -> DateSpan periodAsDateSpan (DayPeriod d) = DateSpan (Just d) (Just $ addDays 1 d) periodAsDateSpan (WeekPeriod b) = DateSpan (Just b) (Just $ addDays 7 b) periodAsDateSpan (MonthPeriod y m) = DateSpan (Just $ fromGregorian y m 1) (Just $ fromGregorian y' m' 1) where (y',m') | m==12 = (y+1,1) | otherwise = (y,m+1) periodAsDateSpan (QuarterPeriod y q) = DateSpan (Just $ fromGregorian y m 1) (Just $ fromGregorian y' m' 1) where (y', q') | q==4 = (y+1,1) | otherwise = (y,q+1) quarterAsMonth q = (q-1) * 3 + 1 m = quarterAsMonth q m' = quarterAsMonth q' periodAsDateSpan (YearPeriod y) = DateSpan (Just $ fromGregorian y 1 1) (Just $ fromGregorian (y+1) 1 1) periodAsDateSpan (PeriodBetween b e) = DateSpan (Just b) (Just e) periodAsDateSpan (PeriodFrom b) = DateSpan (Just b) Nothing periodAsDateSpan (PeriodTo e) = DateSpan Nothing (Just e) periodAsDateSpan (PeriodAll) = DateSpan Nothing Nothing -- | Convert DateSpans to Periods. -- -- >>> dateSpanAsPeriod $ DateSpan (Just $ fromGregorian 2000 1 1) (Just $ fromGregorian 2000 2 1) -- MonthPeriod 2000 1 dateSpanAsPeriod :: DateSpan -> Period dateSpanAsPeriod (DateSpan (Just b) (Just e)) = simplifyPeriod $ PeriodBetween b e dateSpanAsPeriod (DateSpan (Just b) Nothing) = PeriodFrom b dateSpanAsPeriod (DateSpan Nothing (Just e)) = PeriodTo e dateSpanAsPeriod (DateSpan Nothing Nothing) = PeriodAll -- | Convert PeriodBetweens to a more abstract period where possible. -- -- >>> simplifyPeriod $ PeriodBetween (fromGregorian 1 1 1) (fromGregorian 2 1 1) -- YearPeriod 1 -- >>> simplifyPeriod $ PeriodBetween (fromGregorian 2000 10 1) (fromGregorian 2001 1 1) -- QuarterPeriod 2000 4 -- >>> simplifyPeriod $ PeriodBetween (fromGregorian 2000 2 1) (fromGregorian 2000 3 1) -- MonthPeriod 2000 2 -- >>> simplifyPeriod $ PeriodBetween (fromGregorian 2016 7 25) (fromGregorian 2016 8 1) -- WeekPeriod 2016-07-25 -- >>> simplifyPeriod $ PeriodBetween (fromGregorian 2000 1 1) (fromGregorian 2000 1 2) -- DayPeriod 2000-01-01 -- >>> simplifyPeriod $ PeriodBetween (fromGregorian 2000 2 28) (fromGregorian 2000 3 1) -- PeriodBetween 2000-02-28 2000-03-01 -- >>> simplifyPeriod $ PeriodBetween (fromGregorian 2000 2 29) (fromGregorian 2000 3 1) -- DayPeriod 2000-02-29 -- >>> simplifyPeriod $ PeriodBetween (fromGregorian 2000 12 31) (fromGregorian 2001 1 1) -- DayPeriod 2000-12-31 -- simplifyPeriod :: Period -> Period simplifyPeriod (PeriodBetween b e) = case (toGregorian b, toGregorian e) of -- a year ((by,1,1), (ey,1,1)) | by+1==ey -> YearPeriod by -- a half-year -- ((by,1,1), (ey,7,1)) | by==ey -> -- ((by,7,1), (ey,1,1)) | by+1==ey -> -- a quarter ((by,1,1), (ey,4,1)) | by==ey -> QuarterPeriod by 1 ((by,4,1), (ey,7,1)) | by==ey -> QuarterPeriod by 2 ((by,7,1), (ey,10,1)) | by==ey -> QuarterPeriod by 3 ((by,10,1), (ey,1,1)) | by+1==ey -> QuarterPeriod by 4 -- a month ((by,bm,1), (ey,em,1)) | by==ey && bm+1==em -> MonthPeriod by bm ((by,12,1), (ey,1,1)) | by+1==ey -> MonthPeriod by 12 -- a week (two successive mondays), -- YYYYwN ("week N of year YYYY") -- _ | let ((by,bw,bd), (ey,ew,ed)) = (toWeekDate from, toWeekDate to) in by==ey && fw+1==tw && bd==1 && ed==1 -> -- a week starting on a monday _ | let ((by,bw,bd), (ey,ew,ed)) = (toWeekDate b, toWeekDate (addDays (-1) e)) in by==ey && bw==ew && bd==1 && ed==7 -> WeekPeriod b -- a day ((by,bm,bd), (ey,em,ed)) | (by==ey && bm==em && bd+1==ed) || (by+1==ey && bm==12 && em==1 && bd==31 && ed==1) || -- crossing a year boundary (by==ey && bm+1==em && isLastDayOfMonth by bm bd && ed==1) -- crossing a month boundary -> DayPeriod b _ -> PeriodBetween b e simplifyPeriod p = p isLastDayOfMonth y m d = case m of 1 -> d==31 2 | isLeapYear y -> d==29 | otherwise -> d==28 3 -> d==31 4 -> d==30 5 -> d==31 6 -> d==30 7 -> d==31 8 -> d==31 9 -> d==30 10 -> d==31 11 -> d==30 12 -> d==31 _ -> False -- | Is this period a "standard" period, referencing a particular day, week, month, quarter, or year ? -- Periods of other durations, or infinite duration, or not starting on a standard period boundary, are not. isStandardPeriod = isStandardPeriod' . simplifyPeriod where isStandardPeriod' (DayPeriod _) = True isStandardPeriod' (WeekPeriod _) = True isStandardPeriod' (MonthPeriod _ _) = True isStandardPeriod' (QuarterPeriod _ _) = True isStandardPeriod' (YearPeriod _) = True isStandardPeriod' _ = False -- | Render a period as a compact display string suitable for user output. -- -- >>> showPeriod (WeekPeriod (fromGregorian 2016 7 25)) -- "2016-07-25W30" showPeriod (DayPeriod b) = formatTime defaultTimeLocale "%F" b -- DATE showPeriod (WeekPeriod b) = formatTime defaultTimeLocale "%FW%V" b -- STARTDATEWYEARWEEK showPeriod (MonthPeriod y m) = printf "%04d-%02d" y m -- YYYY-MM showPeriod (QuarterPeriod y q) = printf "%04dQ%d" y q -- YYYYQN showPeriod (YearPeriod y) = printf "%04d" y -- YYYY showPeriod (PeriodBetween b e) = formatTime defaultTimeLocale "%F" b ++ formatTime defaultTimeLocale "..%F" (addDays (-1) e) -- STARTDATE..INCLUSIVEENDDATE showPeriod (PeriodFrom b) = formatTime defaultTimeLocale "%F.." b -- STARTDATE.. showPeriod (PeriodTo e) = formatTime defaultTimeLocale "..%F" (addDays (-1) e) -- ..INCLUSIVEENDDATE showPeriod PeriodAll = ".." -- | Like showPeriod, but if it's a month period show just -- the 3 letter month name abbreviation for the current locale. showPeriodMonthAbbrev (MonthPeriod _ m) -- Jan | m > 0 && m <= length monthnames = snd $ monthnames !! (m-1) where monthnames = months defaultTimeLocale showPeriodMonthAbbrev p = showPeriod p periodStart :: Period -> Maybe Day periodStart p = mb where DateSpan mb _ = periodAsDateSpan p periodEnd :: Period -> Maybe Day periodEnd p = me where DateSpan _ me = periodAsDateSpan p -- | Move a standard period to the following period of same duration. -- Non-standard periods are unaffected. periodNext :: Period -> Period periodNext (DayPeriod b) = DayPeriod (addDays 1 b) periodNext (WeekPeriod b) = WeekPeriod (addDays 7 b) periodNext (MonthPeriod y 12) = MonthPeriod (y+1) 1 periodNext (MonthPeriod y m) = MonthPeriod y (m+1) periodNext (QuarterPeriod y 4) = QuarterPeriod (y+1) 1 periodNext (QuarterPeriod y q) = QuarterPeriod y (q+1) periodNext (YearPeriod y) = YearPeriod (y+1) periodNext p = p -- | Move a standard period to the preceding period of same duration. -- Non-standard periods are unaffected. periodPrevious :: Period -> Period periodPrevious (DayPeriod b) = DayPeriod (addDays (-1) b) periodPrevious (WeekPeriod b) = WeekPeriod (addDays (-7) b) periodPrevious (MonthPeriod y 1) = MonthPeriod (y-1) 12 periodPrevious (MonthPeriod y m) = MonthPeriod y (m-1) periodPrevious (QuarterPeriod y 1) = QuarterPeriod (y-1) 4 periodPrevious (QuarterPeriod y q) = QuarterPeriod y (q-1) periodPrevious (YearPeriod y) = YearPeriod (y-1) periodPrevious p = p -- | Move a standard period to the following period of same duration, staying within enclosing dates. -- Non-standard periods are unaffected. periodNextIn :: DateSpan -> Period -> Period periodNextIn (DateSpan _ (Just e)) p = case mb of Just b -> if b < e then p' else p _ -> p where p' = periodNext p mb = periodStart p' periodNextIn _ p = periodNext p -- | Move a standard period to the preceding period of same duration, staying within enclosing dates. -- Non-standard periods are unaffected. periodPreviousIn :: DateSpan -> Period -> Period periodPreviousIn (DateSpan (Just b) _) p = case me of Just e -> if e > b then p' else p _ -> p where p' = periodPrevious p me = periodEnd p' periodPreviousIn _ p = periodPrevious p -- | Move a standard period stepwise so that it encloses the given date. -- Non-standard periods are unaffected. periodMoveTo :: Day -> Period -> Period periodMoveTo d (DayPeriod _) = DayPeriod d periodMoveTo d (WeekPeriod _) = WeekPeriod $ mondayBefore d periodMoveTo d (MonthPeriod _ _) = MonthPeriod y m where (y,m,_) = toGregorian d periodMoveTo d (QuarterPeriod _ _) = QuarterPeriod y q where (y,m,_) = toGregorian d q = quarterContainingMonth m periodMoveTo d (YearPeriod _) = YearPeriod y where (y,_,_) = toGregorian d periodMoveTo _ p = p -- | Enlarge a standard period to the next larger enclosing standard period, if there is one. -- Eg, a day becomes the enclosing week. -- A week becomes whichever month the week's thursday falls into. -- A year becomes all (unlimited). -- Non-standard periods (arbitrary dates, or open-ended) are unaffected. periodGrow :: Period -> Period periodGrow (DayPeriod b) = WeekPeriod $ mondayBefore b periodGrow (WeekPeriod b) = MonthPeriod y m where (y,m) = yearMonthContainingWeekStarting b periodGrow (MonthPeriod y m) = QuarterPeriod y (quarterContainingMonth m) periodGrow (QuarterPeriod y _) = YearPeriod y periodGrow (YearPeriod _) = PeriodAll periodGrow p = p -- | Shrink a period to the next smaller standard period inside it, -- choosing the subperiod which contains today's date if possible, -- otherwise the first subperiod. It goes like this: -- unbounded periods and nonstandard periods (between two arbitrary dates) -> -- current year -> -- current quarter if it's in selected year, otherwise first quarter of selected year -> -- current month if it's in selected quarter, otherwise first month of selected quarter -> -- current week if it's in selected month, otherwise first week of selected month -> -- today if it's in selected week, otherwise first day of selected week, -- unless that's in previous month, in which case first day of month containing selected week. -- Shrinking a day has no effect. periodShrink :: Day -> Period -> Period periodShrink _ p@(DayPeriod _) = p periodShrink today (WeekPeriod b) | today >= b && diffDays today b < 7 = DayPeriod today | m /= weekmonth = DayPeriod $ fromGregorian weekyear weekmonth 1 | otherwise = DayPeriod b where (_,m,_) = toGregorian b (weekyear,weekmonth) = yearMonthContainingWeekStarting b periodShrink today (MonthPeriod y m) | (y',m') == (y,m) = WeekPeriod $ mondayBefore today | otherwise = WeekPeriod $ startOfFirstWeekInMonth y m where (y',m',_) = toGregorian today periodShrink today (QuarterPeriod y q) | quarterContainingMonth thismonth == q = MonthPeriod y thismonth | otherwise = MonthPeriod y (firstMonthOfQuarter q) where (_,thismonth,_) = toGregorian today periodShrink today (YearPeriod y) | y == thisyear = QuarterPeriod y thisquarter | otherwise = QuarterPeriod y 1 where (thisyear,thismonth,_) = toGregorian today thisquarter = quarterContainingMonth thismonth periodShrink today _ = YearPeriod y where (y,_,_) = toGregorian today mondayBefore d = addDays (1 - toInteger wd) d where (_,_,wd) = toWeekDate d yearMonthContainingWeekStarting weekstart = (y,m) where thu = addDays 3 weekstart (y,yd) = toOrdinalDate thu (m,_) = dayOfYearToMonthAndDay (isLeapYear y) yd quarterContainingMonth m = (m-1) `div` 3 + 1 firstMonthOfQuarter q = (q-1)*3 + 1 startOfFirstWeekInMonth y m | monthstartday <= 4 = mon | otherwise = addDays 7 mon -- month starts with a fri/sat/sun where monthstart = fromGregorian y m 1 mon = mondayBefore monthstart (_,_,monthstartday) = toWeekDate monthstart hledger-lib-1.19.1/Hledger/Data/PeriodicTransaction.hs0000644000000000000000000002461113723300774020704 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-| A 'PeriodicTransaction' is a rule describing recurring transactions. -} module Hledger.Data.PeriodicTransaction ( runPeriodicTransaction , checkPeriodicTransactionStartDate ) where #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup ((<>)) #endif import qualified Data.Text as T import Text.Printf import Hledger.Data.Types import Hledger.Data.Dates import Hledger.Data.Amount import Hledger.Data.Posting (post, commentAddTagNextLine) import Hledger.Data.Transaction import Hledger.Utils.UTF8IOCompat (error') import Hledger.Utils.Debug -- $setup -- >>> :set -XOverloadedStrings -- >>> import Hledger.Data.Posting -- >>> import Hledger.Data.Journal -- doctest helper, too much hassle to define in the comment -- XXX duplicates some logic in periodictransactionp _ptgen str = do let t = T.pack str (i,s) = parsePeriodExpr' nulldate t case checkPeriodicTransactionStartDate i s t of Just e -> error' e -- PARTIAL: Nothing -> mapM_ (putStr . showTransaction) $ runPeriodicTransaction nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] } nulldatespan _ptgenspan str span = do let t = T.pack str (i,s) = parsePeriodExpr' nulldate t case checkPeriodicTransactionStartDate i s t of Just e -> error' e -- PARTIAL: Nothing -> mapM_ (putStr . showTransaction) $ runPeriodicTransaction nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] } span --deriving instance Show PeriodicTransaction -- for better pretty-printing: instance Show PeriodicTransaction where show PeriodicTransaction{..} = printf "PeriodicTransactionPP {%s, %s, %s, %s, %s, %s, %s, %s, %s}" ("ptperiodexpr=" ++ show ptperiodexpr) ("ptinterval=" ++ show ptinterval) ("ptspan=" ++ show (show ptspan)) ("ptstatus=" ++ show (show ptstatus)) ("ptcode=" ++ show ptcode) ("ptdescription=" ++ show ptdescription) ("ptcomment=" ++ show ptcomment) ("pttags=" ++ show pttags) ("ptpostings=" ++ show ptpostings) -- A basic human-readable rendering. --showPeriodicTransaction t = "~ " ++ T.unpack (ptperiodexpr t) ++ "\n" ++ unlines (map show (ptpostings t)) --nullperiodictransaction is defined in Types.hs -- | Generate transactions from 'PeriodicTransaction' within a 'DateSpan' -- -- Note that new transactions require 'txnTieKnot' post-processing. -- The new transactions will have three tags added: -- - a recur:PERIODICEXPR tag whose value is the generating periodic expression -- - a generated-transaction: tag -- - a hidden _generated-transaction: tag which does not appear in the comment. -- -- >>> import Data.Time (fromGregorian) -- >>> _ptgen "monthly from 2017/1 to 2017/4" -- 2017-01-01 -- ; generated-transaction: ~ monthly from 2017/1 to 2017/4 -- a $1.00 -- -- 2017-02-01 -- ; generated-transaction: ~ monthly from 2017/1 to 2017/4 -- a $1.00 -- -- 2017-03-01 -- ; generated-transaction: ~ monthly from 2017/1 to 2017/4 -- a $1.00 -- -- -- >>> _ptgen "monthly from 2017/1 to 2017/5" -- 2017-01-01 -- ; generated-transaction: ~ monthly from 2017/1 to 2017/5 -- a $1.00 -- -- 2017-02-01 -- ; generated-transaction: ~ monthly from 2017/1 to 2017/5 -- a $1.00 -- -- 2017-03-01 -- ; generated-transaction: ~ monthly from 2017/1 to 2017/5 -- a $1.00 -- -- 2017-04-01 -- ; generated-transaction: ~ monthly from 2017/1 to 2017/5 -- a $1.00 -- -- -- >>> _ptgen "every 2nd day of month from 2017/02 to 2017/04" -- 2017-01-02 -- ; generated-transaction: ~ every 2nd day of month from 2017/02 to 2017/04 -- a $1.00 -- -- 2017-02-02 -- ; generated-transaction: ~ every 2nd day of month from 2017/02 to 2017/04 -- a $1.00 -- -- 2017-03-02 -- ; generated-transaction: ~ every 2nd day of month from 2017/02 to 2017/04 -- a $1.00 -- -- -- >>> _ptgen "every 30th day of month from 2017/1 to 2017/5" -- 2016-12-30 -- ; generated-transaction: ~ every 30th day of month from 2017/1 to 2017/5 -- a $1.00 -- -- 2017-01-30 -- ; generated-transaction: ~ every 30th day of month from 2017/1 to 2017/5 -- a $1.00 -- -- 2017-02-28 -- ; generated-transaction: ~ every 30th day of month from 2017/1 to 2017/5 -- a $1.00 -- -- 2017-03-30 -- ; generated-transaction: ~ every 30th day of month from 2017/1 to 2017/5 -- a $1.00 -- -- 2017-04-30 -- ; generated-transaction: ~ every 30th day of month from 2017/1 to 2017/5 -- a $1.00 -- -- -- >>> _ptgen "every 2nd Thursday of month from 2017/1 to 2017/4" -- 2016-12-08 -- ; generated-transaction: ~ every 2nd Thursday of month from 2017/1 to 2017/4 -- a $1.00 -- -- 2017-01-12 -- ; generated-transaction: ~ every 2nd Thursday of month from 2017/1 to 2017/4 -- a $1.00 -- -- 2017-02-09 -- ; generated-transaction: ~ every 2nd Thursday of month from 2017/1 to 2017/4 -- a $1.00 -- -- 2017-03-09 -- ; generated-transaction: ~ every 2nd Thursday of month from 2017/1 to 2017/4 -- a $1.00 -- -- -- >>> _ptgen "every nov 29th from 2017 to 2019" -- 2016-11-29 -- ; generated-transaction: ~ every nov 29th from 2017 to 2019 -- a $1.00 -- -- 2017-11-29 -- ; generated-transaction: ~ every nov 29th from 2017 to 2019 -- a $1.00 -- -- 2018-11-29 -- ; generated-transaction: ~ every nov 29th from 2017 to 2019 -- a $1.00 -- -- -- >>> _ptgen "2017/1" -- 2017-01-01 -- ; generated-transaction: ~ 2017/1 -- a $1.00 -- -- -- >>> _ptgen "" -- *** Exception: failed to parse... -- ... -- -- >>> _ptgen "weekly from 2017" -- *** Exception: Unable to generate transactions according to "weekly from 2017" because 2017-01-01 is not a first day of the Week -- -- >>> _ptgen "monthly from 2017/5/4" -- *** Exception: Unable to generate transactions according to "monthly from 2017/5/4" because 2017-05-04 is not a first day of the Month -- -- >>> _ptgen "every quarter from 2017/1/2" -- *** Exception: Unable to generate transactions according to "every quarter from 2017/1/2" because 2017-01-02 is not a first day of the Quarter -- -- >>> _ptgen "yearly from 2017/1/14" -- *** Exception: Unable to generate transactions according to "yearly from 2017/1/14" because 2017-01-14 is not a first day of the Year -- -- >>> let reportperiod="daily from 2018/01/03" in let (i,s) = parsePeriodExpr' nulldate reportperiod in runPeriodicTransaction (nullperiodictransaction{ptperiodexpr=reportperiod, ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1]}) (DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 01 03)) -- [] -- -- >>> _ptgenspan "every 3 months from 2019-05" (DateSpan (Just $ fromGregorian 2020 01 01) (Just $ fromGregorian 2020 02 01)) -- -- >>> _ptgenspan "every 3 months from 2019-05" (DateSpan (Just $ fromGregorian 2020 02 01) (Just $ fromGregorian 2020 03 01)) -- 2020-02-01 -- ; generated-transaction: ~ every 3 months from 2019-05 -- a $1.00 -- -- >>> _ptgenspan "every 3 days from 2018" (DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 01 05)) -- 2018-01-01 -- ; generated-transaction: ~ every 3 days from 2018 -- a $1.00 -- -- 2018-01-04 -- ; generated-transaction: ~ every 3 days from 2018 -- a $1.00 -- -- >>> _ptgenspan "every 3 days from 2018" (DateSpan (Just $ fromGregorian 2018 01 02) (Just $ fromGregorian 2018 01 05)) -- 2018-01-04 -- ; generated-transaction: ~ every 3 days from 2018 -- a $1.00 -- runPeriodicTransaction :: PeriodicTransaction -> DateSpan -> [Transaction] runPeriodicTransaction PeriodicTransaction{..} requestedspan = [ t{tdate=d} | (DateSpan (Just d) _) <- alltxnspans, spanContainsDate requestedspan d ] where t = nulltransaction{ tstatus = ptstatus ,tcode = ptcode ,tdescription = ptdescription ,tcomment = ptcomment `commentAddTagNextLine` ("generated-transaction",period) ,ttags = ("_generated-transaction",period) : ("generated-transaction" ,period) : pttags ,tpostings = ptpostings } period = "~ " <> ptperiodexpr -- All spans described by this periodic transaction, where spanStart is event date. -- If transaction does not have start/end date, we set them to start/end of requested span, -- to avoid generating (infinitely) many events. alltxnspans = dbg3 "alltxnspans" $ ptinterval `splitSpan` (spanDefaultsFrom ptspan requestedspan) -- | Check that this date span begins at a boundary of this interval, -- or return an explanatory error message including the provided period expression -- (from which the span and interval are derived). checkPeriodicTransactionStartDate :: Interval -> DateSpan -> T.Text -> Maybe String checkPeriodicTransactionStartDate i s periodexpr = case (i, spanStart s) of (Weeks _, Just d) -> checkStart d Week (Months _, Just d) -> checkStart d Month (Quarters _, Just d) -> checkStart d Quarter (Years _, Just d) -> checkStart d Year _ -> Nothing where checkStart d x = let firstDate = fixSmartDate d $ SmartRelative This x in if d == firstDate then Nothing else Just $ "Unable to generate transactions according to "++show (T.unpack periodexpr) ++" because "++show d++" is not a first day of the "++show x ---- | What is the interval of this 'PeriodicTransaction's period expression, if it can be parsed ? --periodTransactionInterval :: PeriodicTransaction -> Maybe Interval --periodTransactionInterval pt = -- let -- expr = ptperiodexpr pt -- err = error' $ "Current date cannot be referenced in " ++ show (T.unpack expr) -- in -- case parsePeriodExpr err expr of -- Left _ -> Nothing -- Right (i,_) -> Just i hledger-lib-1.19.1/Hledger/Data/StringFormat.hs0000644000000000000000000002140013700101030017323 0ustar0000000000000000-- | Parse format strings provided by --format, with awareness of -- hledger's report item fields. The formats are used by -- report-specific renderers like renderBalanceReportItem. {-# LANGUAGE FlexibleContexts, OverloadedStrings, TypeFamilies, PackageImports #-} module Hledger.Data.StringFormat ( parseStringFormat , defaultStringFormatStyle , StringFormat(..) , StringFormatComponent(..) , ReportItemField(..) , tests_StringFormat ) where import Prelude () import "base-compat-batteries" Prelude.Compat import Numeric import Data.Char (isPrint) import Data.Maybe -- import qualified Data.Text as T import Text.Megaparsec import Text.Megaparsec.Char import Hledger.Utils.Parse import Hledger.Utils.String (formatString) import Hledger.Utils.Test -- | A format specification/template to use when rendering a report line item as text. -- -- A format is a sequence of components; each is either a literal -- string, or a hledger report item field with specified width and -- justification whose value will be interpolated at render time. -- -- A component's value may be a multi-line string (or a -- multi-commodity amount), in which case the final string will be -- either single-line or a top or bottom-aligned multi-line string -- depending on the StringFormat variant used. -- -- Currently this is only used in the balance command's single-column -- mode, which provides a limited StringFormat renderer. -- data StringFormat = OneLine [StringFormatComponent] -- ^ multi-line values will be rendered on one line, comma-separated | TopAligned [StringFormatComponent] -- ^ values will be top-aligned (and bottom-padded to the same height) | BottomAligned [StringFormatComponent] -- ^ values will be bottom-aligned (and top-padded) deriving (Show, Eq) data StringFormatComponent = FormatLiteral String -- ^ Literal text to be rendered as-is | FormatField Bool (Maybe Int) (Maybe Int) ReportItemField -- ^ A data field to be formatted and interpolated. Parameters: -- -- - Left justify ? Right justified if false -- - Minimum width ? Will be space-padded if narrower than this -- - Maximum width ? Will be clipped if wider than this -- - Which of the standard hledger report item fields to interpolate deriving (Show, Eq) -- | An id identifying which report item field to interpolate. These -- are drawn from several hledger report types, so are not all -- applicable for a given report. data ReportItemField = AccountField -- ^ A posting or balance report item's account name | DefaultDateField -- ^ A posting or register or entry report item's date | DescriptionField -- ^ A posting or register or entry report item's description | TotalField -- ^ A balance or posting report item's balance or running total. -- Always rendered right-justified. | DepthSpacerField -- ^ A balance report item's indent level (which may be different from the account name depth). -- Rendered as this number of spaces, multiplied by the minimum width spec if any. | FieldNo Int -- ^ A report item's nth field. May be unimplemented. deriving (Show, Eq) ---------------------------------------------------------------------- -- renderStringFormat :: StringFormat -> Map String String -> String -- renderStringFormat fmt params = ---------------------------------------------------------------------- -- | Parse a string format specification, or return a parse error. parseStringFormat :: String -> Either String StringFormat parseStringFormat input = case (runParser (stringformatp <* eof) "(unknown)") input of Left y -> Left $ show y Right x -> Right x defaultStringFormatStyle = BottomAligned stringformatp :: SimpleStringParser StringFormat stringformatp = do alignspec <- optional (try $ char '%' >> oneOf ("^_,"::String)) let constructor = case alignspec of Just '^' -> TopAligned Just '_' -> BottomAligned Just ',' -> OneLine _ -> defaultStringFormatStyle constructor <$> many componentp componentp :: SimpleStringParser StringFormatComponent componentp = formatliteralp <|> formatfieldp formatliteralp :: SimpleStringParser StringFormatComponent formatliteralp = do s <- some c return $ FormatLiteral s where isPrintableButNotPercentage x = isPrint x && x /= '%' c = (satisfy isPrintableButNotPercentage "printable character") <|> try (string "%%" >> return '%') formatfieldp :: SimpleStringParser StringFormatComponent formatfieldp = do char '%' leftJustified <- optional (char '-') minWidth <- optional (some $ digitChar) maxWidth <- optional (do char '.'; some $ digitChar) -- TODO: Can this be (char '1') *> (some digitChar) char '(' f <- fieldp char ')' return $ FormatField (isJust leftJustified) (parseDec minWidth) (parseDec maxWidth) f where parseDec s = case s of Just text -> Just m where ((m,_):_) = readDec text _ -> Nothing fieldp :: SimpleStringParser ReportItemField fieldp = do try (string "account" >> return AccountField) <|> try (string "depth_spacer" >> return DepthSpacerField) <|> try (string "date" >> return DescriptionField) <|> try (string "description" >> return DescriptionField) <|> try (string "total" >> return TotalField) <|> try ((FieldNo . read) <$> some digitChar) ---------------------------------------------------------------------- formatStringTester fs value expected = actual @?= expected where actual = case fs of FormatLiteral l -> formatString False Nothing Nothing l FormatField leftJustify min max _ -> formatString leftJustify min max value tests_StringFormat = tests "StringFormat" [ test "formatStringHelper" $ do formatStringTester (FormatLiteral " ") "" " " formatStringTester (FormatField False Nothing Nothing DescriptionField) "description" "description" formatStringTester (FormatField False (Just 20) Nothing DescriptionField) "description" " description" formatStringTester (FormatField False Nothing (Just 20) DescriptionField) "description" "description" formatStringTester (FormatField True Nothing (Just 20) DescriptionField) "description" "description" formatStringTester (FormatField True (Just 20) Nothing DescriptionField) "description" "description " formatStringTester (FormatField True (Just 20) (Just 20) DescriptionField) "description" "description " formatStringTester (FormatField True Nothing (Just 3) DescriptionField) "description" "des" ,let s `gives` expected = test s $ parseStringFormat s @?= Right expected in tests "parseStringFormat" [ "" `gives` (defaultStringFormatStyle []) , "D" `gives` (defaultStringFormatStyle [FormatLiteral "D"]) , "%(date)" `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing DescriptionField]) , "%(total)" `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing TotalField]) -- TODO -- , "^%(total)" `gives` (TopAligned [FormatField False Nothing Nothing TotalField]) -- , "_%(total)" `gives` (BottomAligned [FormatField False Nothing Nothing TotalField]) -- , ",%(total)" `gives` (OneLine [FormatField False Nothing Nothing TotalField]) , "Hello %(date)!" `gives` (defaultStringFormatStyle [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"]) , "%-(date)" `gives` (defaultStringFormatStyle [FormatField True Nothing Nothing DescriptionField]) , "%20(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 20) Nothing DescriptionField]) , "%.10(date)" `gives` (defaultStringFormatStyle [FormatField False Nothing (Just 10) DescriptionField]) , "%20.10(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 20) (Just 10) DescriptionField]) , "%20(account) %.10(total)" `gives` (defaultStringFormatStyle [FormatField False (Just 20) Nothing AccountField ,FormatLiteral " " ,FormatField False Nothing (Just 10) TotalField ]) , test "newline not parsed" $ assertLeft $ parseStringFormat "\n" ] ] hledger-lib-1.19.1/Hledger/Data/Posting.hs0000644000000000000000000003650513723502755016373 0ustar0000000000000000{-| A 'Posting' represents a change (by some 'MixedAmount') of the balance in some 'Account'. Each 'Transaction' contains two or more postings which should add up to 0. Postings reference their parent transaction, so we can look up the date or description there. -} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Hledger.Data.Posting ( -- * Posting nullposting, posting, post, vpost, post', vpost', nullsourcepos, nullassertion, balassert, balassertTot, balassertParInc, balassertTotInc, -- * operations originalPosting, postingStatus, isReal, isVirtual, isBalancedVirtual, isEmptyPosting, hasBalanceAssignment, hasAmount, postingAllTags, transactionAllTags, relatedPostings, removePrices, -- * date operations postingDate, postingDate2, isPostingInDateSpan, isPostingInDateSpan', -- * account name operations accountNamesFromPostings, accountNamePostingType, accountNameWithoutPostingType, accountNameWithPostingType, joinAccountNames, concatAccountNames, accountNameApplyAliases, accountNameApplyAliasesMemo, -- * comment/tag operations commentJoin, commentAddTag, commentAddTagNextLine, -- * arithmetic sumPostings, -- * rendering showPosting, -- * misc. showComment, postingTransformAmount, postingApplyValuation, postingToCost, tests_Posting ) where import Control.Monad (foldM) import Data.Foldable (asum) import Data.List.Extra (nubSort) import qualified Data.Map as M import Data.Maybe import Data.MemoUgly (memo) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar import Safe import Hledger.Utils import Hledger.Data.Types import Hledger.Data.Amount import Hledger.Data.AccountName import Hledger.Data.Dates (nulldate, spanContainsDate) import Hledger.Data.Valuation nullposting, posting :: Posting nullposting = Posting {pdate=Nothing ,pdate2=Nothing ,pstatus=Unmarked ,paccount="" ,pamount=nullmixedamt ,pcomment="" ,ptype=RegularPosting ,ptags=[] ,pbalanceassertion=Nothing ,ptransaction=Nothing ,poriginal=Nothing } posting = nullposting -- constructors -- | Make a posting to an account. post :: AccountName -> Amount -> Posting post acc amt = posting {paccount=acc, pamount=Mixed [amt]} -- | Make a virtual (unbalanced) posting to an account. vpost :: AccountName -> Amount -> Posting vpost acc amt = (post acc amt){ptype=VirtualPosting} -- | Make a posting to an account, maybe with a balance assertion. post' :: AccountName -> Amount -> Maybe BalanceAssertion -> Posting post' acc amt ass = posting {paccount=acc, pamount=Mixed [amt], pbalanceassertion=ass} -- | Make a virtual (unbalanced) posting to an account, maybe with a balance assertion. vpost' :: AccountName -> Amount -> Maybe BalanceAssertion -> Posting vpost' acc amt ass = (post' acc amt ass){ptype=VirtualPosting, pbalanceassertion=ass} nullsourcepos :: GenericSourcePos nullsourcepos = JournalSourcePos "" (1,1) nullassertion :: BalanceAssertion nullassertion = BalanceAssertion {baamount=nullamt ,batotal=False ,bainclusive=False ,baposition=nullsourcepos } -- | Make a partial, exclusive balance assertion. balassert :: Amount -> Maybe BalanceAssertion balassert amt = Just $ nullassertion{baamount=amt} -- | Make a total, exclusive balance assertion. balassertTot :: Amount -> Maybe BalanceAssertion balassertTot amt = Just $ nullassertion{baamount=amt, batotal=True} -- | Make a partial, inclusive balance assertion. balassertParInc :: Amount -> Maybe BalanceAssertion balassertParInc amt = Just $ nullassertion{baamount=amt, bainclusive=True} -- | Make a total, inclusive balance assertion. balassertTotInc :: Amount -> Maybe BalanceAssertion balassertTotInc amt = Just $ nullassertion{baamount=amt, batotal=True, bainclusive=True} -- Get the original posting, if any. originalPosting :: Posting -> Posting originalPosting p = fromMaybe p $ poriginal p -- XXX once rendered user output, but just for debugging now; clean up showPosting :: Posting -> String showPosting p@Posting{paccount=a,pamount=amt,ptype=t} = unlines $ [concatTopPadded [show (postingDate p) ++ " ", showaccountname a ++ " ", showamount amt, showComment (pcomment p)]] where ledger3ishlayout = False acctnamewidth = if ledger3ishlayout then 25 else 22 showaccountname = fitString (Just acctnamewidth) Nothing False False . bracket . T.unpack . elideAccountName width (bracket,width) = case t of BalancedVirtualPosting -> (\s -> "["++s++"]", acctnamewidth-2) VirtualPosting -> (\s -> "("++s++")", acctnamewidth-2) _ -> (id,acctnamewidth) showamount = padLeftWide 12 . showMixedAmount showComment :: Text -> String showComment t = if T.null t then "" else " ;" ++ T.unpack t isReal :: Posting -> Bool isReal p = ptype p == RegularPosting isVirtual :: Posting -> Bool isVirtual p = ptype p == VirtualPosting isBalancedVirtual :: Posting -> Bool isBalancedVirtual p = ptype p == BalancedVirtualPosting hasAmount :: Posting -> Bool hasAmount = (/= missingmixedamt) . pamount hasBalanceAssignment :: Posting -> Bool hasBalanceAssignment p = not (hasAmount p) && isJust (pbalanceassertion p) -- | Sorted unique account names referenced by these postings. accountNamesFromPostings :: [Posting] -> [AccountName] accountNamesFromPostings = nubSort . map paccount sumPostings :: [Posting] -> MixedAmount sumPostings = sumStrict . map pamount -- | Remove all prices of a posting removePrices :: Posting -> Posting removePrices p = p{ pamount = Mixed $ remove <$> amounts (pamount p) } where remove a = a { aprice = Nothing } -- | Get a posting's (primary) date - it's own primary date if specified, -- otherwise the parent transaction's primary date, or the null date if -- there is no parent transaction. postingDate :: Posting -> Day postingDate p = fromMaybe nulldate $ asum dates where dates = [ pdate p, tdate <$> ptransaction p ] -- | Get a posting's secondary (secondary) date, which is the first of: -- posting's secondary date, transaction's secondary date, posting's -- primary date, transaction's primary date, or the null date if there is -- no parent transaction. postingDate2 :: Posting -> Day postingDate2 p = fromMaybe nulldate $ asum dates where dates = [ pdate2 p , tdate2 =<< ptransaction p , pdate p , tdate <$> ptransaction p ] -- | Get a posting's status. This is cleared or pending if those are -- explicitly set on the posting, otherwise the status of its parent -- transaction, or unmarked if there is no parent transaction. (Note -- the ambiguity, unmarked can mean "posting and transaction are both -- unmarked" or "posting is unmarked and don't know about the transaction". postingStatus :: Posting -> Status postingStatus Posting{pstatus=s, ptransaction=mt} | s == Unmarked = case mt of Just t -> tstatus t Nothing -> Unmarked | otherwise = s -- | Tags for this posting including any inherited from its parent transaction. postingAllTags :: Posting -> [Tag] postingAllTags p = ptags p ++ maybe [] ttags (ptransaction p) -- | Tags for this transaction including any from its postings. transactionAllTags :: Transaction -> [Tag] transactionAllTags t = ttags t ++ concatMap ptags (tpostings t) -- Get the other postings from this posting's transaction. relatedPostings :: Posting -> [Posting] relatedPostings p@Posting{ptransaction=Just t} = filter (/= p) $ tpostings t relatedPostings _ = [] -- | Does this posting fall within the given date span ? isPostingInDateSpan :: DateSpan -> Posting -> Bool isPostingInDateSpan = isPostingInDateSpan' PrimaryDate -- --date2-sensitive version, separate for now to avoid disturbing multiBalanceReport. isPostingInDateSpan' :: WhichDate -> DateSpan -> Posting -> Bool isPostingInDateSpan' PrimaryDate s = spanContainsDate s . postingDate isPostingInDateSpan' SecondaryDate s = spanContainsDate s . postingDate2 isEmptyPosting :: Posting -> Bool isEmptyPosting = mixedAmountLooksZero . pamount -- AccountName stuff that depends on PostingType accountNamePostingType :: AccountName -> PostingType accountNamePostingType a | T.null a = RegularPosting | T.head a == '[' && T.last a == ']' = BalancedVirtualPosting | T.head a == '(' && T.last a == ')' = VirtualPosting | otherwise = RegularPosting accountNameWithoutPostingType :: AccountName -> AccountName accountNameWithoutPostingType a = case accountNamePostingType a of BalancedVirtualPosting -> T.init $ T.tail a VirtualPosting -> T.init $ T.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 . T.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 $ T.intercalate ":" $ map accountNameWithoutPostingType as where t = headDef RegularPosting $ filter (/= RegularPosting) $ map accountNamePostingType as -- | Rewrite an account name using all matching aliases from the given list, in sequence. -- Each alias sees the result of applying the previous aliases. -- Or, return any error arising from a bad regular expression in the aliases. accountNameApplyAliases :: [AccountAlias] -> AccountName -> Either RegexError AccountName accountNameApplyAliases aliases a = let (aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a) in foldM (\acct alias -> dbg6 "result" $ aliasReplace (dbg6 "alias" alias) (dbg6 "account" acct)) aname aliases >>= Right . accountNameWithPostingType atype -- | Memoising version of accountNameApplyAliases, maybe overkill. accountNameApplyAliasesMemo :: [AccountAlias] -> AccountName -> Either RegexError AccountName accountNameApplyAliasesMemo aliases = memo (accountNameApplyAliases aliases) -- XXX re-test this memoisation -- aliasMatches :: AccountAlias -> AccountName -> Bool -- aliasMatches (BasicAlias old _) a = old `isAccountNamePrefixOf` a -- aliasMatches (RegexAlias re _) a = regexMatchesCI re a aliasReplace :: AccountAlias -> AccountName -> Either RegexError AccountName aliasReplace (BasicAlias old new) a | old `isAccountNamePrefixOf` a || old == a = Right $ new <> T.drop (T.length old) a | otherwise = Right a aliasReplace (RegexAlias re repl) a = fmap T.pack . regexReplace re repl $ T.unpack a -- XXX -- | Apply a specified valuation to this posting's amount, using the -- provided price oracle, commodity styles, reference dates, and -- whether this is for a multiperiod report or not. See -- amountApplyValuation. postingApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Maybe Day -> Day -> Bool -> Posting -> ValuationType -> Posting postingApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod p v = case v of AtCost Nothing -> postingToCost styles p AtCost mc -> postingValueAtDate priceoracle styles mc periodlast $ postingToCost styles p AtThen mc -> postingValueAtDate priceoracle styles mc (postingDate p) p AtEnd mc -> postingValueAtDate priceoracle styles mc periodlast p AtNow mc -> postingValueAtDate priceoracle styles mc today p AtDefault mc | ismultiperiod -> postingValueAtDate priceoracle styles mc periodlast p AtDefault mc -> postingValueAtDate priceoracle styles mc (fromMaybe today mreportlast) p AtDate d mc -> postingValueAtDate priceoracle styles mc d p -- | Convert this posting's amount to cost, and apply the appropriate amount styles. postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting postingToCost styles p@Posting{pamount=a} = p{pamount=styleMixedAmount styles $ mixedAmountCost a} -- | Convert this posting's amount to market value in the given commodity, -- or the default valuation commodity, at the given valuation date, -- using the given market price oracle. -- When market prices available on that date are not sufficient to -- calculate the value, amounts are left unchanged. postingValueAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> Posting -> Posting postingValueAtDate priceoracle styles mc d p = postingTransformAmount (mixedAmountValueAtDate priceoracle styles mc d) p -- | Apply a transform function to this posting's amount. postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting postingTransformAmount f p@Posting{pamount=a} = p{pamount=f a} -- | Join two parts of a comment, eg a tag and another tag, or a tag -- and a non-tag, on a single line. Interpolates a comma and space -- unless one of the parts is empty. commentJoin :: Text -> Text -> Text commentJoin c1 c2 | T.null c1 = c2 | T.null c2 = c1 | otherwise = c1 <> ", " <> c2 -- | Add a tag to a comment, comma-separated from any prior content. -- A space is inserted following the colon, before the value. commentAddTag :: Text -> Tag -> Text commentAddTag c (t,v) | T.null c' = tag | otherwise = c' `commentJoin` tag where c' = T.stripEnd c tag = t <> ": " <> v -- | Add a tag on its own line to a comment, preserving any prior content. -- A space is inserted following the colon, before the value. commentAddTagNextLine :: Text -> Tag -> Text commentAddTagNextLine cmt (t,v) = cmt <> if "\n" `T.isSuffixOf` cmt then "" else "\n" <> t <> ": " <> v -- tests tests_Posting = tests "Posting" [ test "accountNamePostingType" $ do accountNamePostingType "a" @?= RegularPosting accountNamePostingType "(a)" @?= VirtualPosting accountNamePostingType "[a]" @?= BalancedVirtualPosting ,test "accountNameWithoutPostingType" $ do accountNameWithoutPostingType "(a)" @?= "a" ,test "accountNameWithPostingType" $ do accountNameWithPostingType VirtualPosting "[a]" @?= "(a)" ,test "joinAccountNames" $ do "a" `joinAccountNames` "b:c" @?= "a:b:c" "a" `joinAccountNames` "(b:c)" @?= "(a:b:c)" "[a]" `joinAccountNames` "(b:c)" @?= "[a:b:c]" "" `joinAccountNames` "a" @?= "a" ,test "concatAccountNames" $ do concatAccountNames [] @?= "" concatAccountNames ["a","(b)","[c:d]"] @?= "(a:b:c:d)" ,test "commentAddTag" $ do commentAddTag "" ("a","") @?= "a: " commentAddTag "[1/2]" ("a","") @?= "[1/2], a: " ,test "commentAddTagNextLine" $ do commentAddTagNextLine "" ("a","") @?= "\na: " commentAddTagNextLine "[1/2]" ("a","") @?= "[1/2]\na: " ] hledger-lib-1.19.1/Hledger/Data/RawOptions.hs0000644000000000000000000001073313723502755017050 0ustar0000000000000000{-| hledger's cmdargs modes parse command-line arguments to an intermediate format, RawOpts (an association list), rather than a fixed ADT like CliOpts. This allows the modes and flags to be reused more easily by hledger commands/scripts in this and other packages. -} module Hledger.Data.RawOptions ( RawOpts, setopt, setboolopt, inRawOpts, boolopt, choiceopt, collectopts, stringopt, maybestringopt, listofstringopt, intopt, posintopt, maybeintopt, maybeposintopt, maybecharopt ) where import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Default (Default(..)) import Safe (headMay, lastMay, readDef) import Hledger.Utils -- | The result of running cmdargs: an association list of option names to string values. newtype RawOpts = RawOpts { unRawOpts :: [(String,String)] } deriving (Show) instance Default RawOpts where def = RawOpts [] overRawOpts f = RawOpts . f . unRawOpts setopt :: String -> String -> RawOpts -> RawOpts setopt name val = overRawOpts (++ [(name, val)]) setboolopt :: String -> RawOpts -> RawOpts setboolopt name = overRawOpts (++ [(name,"")]) -- | Is the named option present ? inRawOpts :: String -> RawOpts -> Bool inRawOpts name = isJust . lookup name . unRawOpts boolopt :: String -> RawOpts -> Bool boolopt = inRawOpts -- | From a list of RawOpts, get the last one (ie the right-most on the command line) -- for which the given predicate returns a Just value. -- Useful for exclusive choice flags like --daily|--weekly|--quarterly... -- -- >>> import Safe (readMay) -- >>> choiceopt Just (RawOpts [("a",""), ("b",""), ("c","")]) -- Just "c" -- >>> choiceopt (const Nothing) (RawOpts [("a","")]) -- Nothing -- >>> choiceopt readMay (RawOpts [("LT",""),("EQ",""),("Neither","")]) :: Maybe Ordering -- Just EQ choiceopt :: (String -> Maybe a) -- ^ "parser" that returns 'Just' value for valid choice -> RawOpts -- ^ actual options where to look for flag -> Maybe a -- ^ exclusive choice among those returned as 'Just' from "parser" choiceopt f = lastMay . collectopts (f . fst) -- | Collects processed and filtered list of options preserving their order -- -- >>> collectopts (const Nothing) (RawOpts [("x","")]) -- [] -- >>> collectopts Just (RawOpts [("a",""),("b","")]) -- [("a",""),("b","")] collectopts :: ((String, String) -> Maybe a) -> RawOpts -> [a] collectopts f = mapMaybe f . unRawOpts maybestringopt :: String -> RawOpts -> Maybe String maybestringopt name = lookup name . reverse . unRawOpts stringopt :: String -> RawOpts -> String stringopt name = fromMaybe "" . maybestringopt name maybecharopt :: String -> RawOpts -> Maybe Char maybecharopt name (RawOpts rawopts) = lookup name rawopts >>= headMay listofstringopt :: String -> RawOpts -> [String] listofstringopt name (RawOpts rawopts) = [v | (k,v) <- rawopts, k==name] -- | Reads the named option's Int argument, if it is present. -- An argument that is too small or too large will raise an error. maybeintopt :: String -> RawOpts -> Maybe Int maybeintopt = maybeclippedintopt minBound maxBound -- | Reads the named option's natural-number argument, if it is present. -- An argument that is negative or too large will raise an error. maybeposintopt :: String -> RawOpts -> Maybe Int maybeposintopt = maybeclippedintopt 0 maxBound -- | Reads the named option's Int argument. If not present it will -- return 0. An argument that is too small or too large will raise an error. intopt :: String -> RawOpts -> Int intopt name = fromMaybe 0 . maybeintopt name -- | Reads the named option's natural-number argument. If not present it will -- return 0. An argument that is negative or too large will raise an error. posintopt :: String -> RawOpts -> Int posintopt name = fromMaybe 0 . maybeposintopt name -- | Reads the named option's Int argument, if it is present. An argument -- that does not fit within the given bounds will raise an error. maybeclippedintopt :: Int -> Int -> String -> RawOpts -> Maybe Int maybeclippedintopt minVal maxVal name = fmap (intOrError . readOrError) . maybestringopt name where readOrError s = readDef (usageError $ "could not parse " ++ name ++ " number: " ++ s) s intOrError n | n >= toInteger minVal && n <= toInteger maxVal = fromInteger n | otherwise = usageError $ "argument to " ++ name ++ " must lie in the range " ++ show minVal ++ " to " ++ show maxVal ++ ", but is " ++ show n hledger-lib-1.19.1/Hledger/Data/Timeclock.hs0000644000000000000000000001400413723300774016645 0ustar0000000000000000{-| A 'TimeclockEntry' is a clock-in, clock-out, or other directive in a timeclock file (see timeclock.el or the command-line version). These can be converted to 'Transactions' and queried like a ledger. -} {-# LANGUAGE OverloadedStrings #-} module Hledger.Data.Timeclock ( timeclockEntriesToTransactions ,tests_Timeclock ) where import Data.Maybe -- import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar import Data.Time.Clock import Data.Time.Format import Data.Time.LocalTime import Text.Printf import Hledger.Utils import Hledger.Data.Types import Hledger.Data.Dates import Hledger.Data.Amount import Hledger.Data.Posting import Hledger.Data.Transaction instance Show TimeclockEntry where show t = printf "%s %s %s %s" (show $ tlcode t) (show $ tldatetime t) (tlaccount t) (tldescription t) instance Show TimeclockCode where show SetBalance = "b" show SetRequiredHours = "h" show In = "i" show Out = "o" show FinalOut = "O" instance Read TimeclockCode where readsPrec _ ('b' : xs) = [(SetBalance, xs)] readsPrec _ ('h' : xs) = [(SetRequiredHours, xs)] readsPrec _ ('i' : xs) = [(In, xs)] readsPrec _ ('o' : xs) = [(Out, xs)] readsPrec _ ('O' : xs) = [(FinalOut, xs)] readsPrec _ _ = [] -- | Convert time log entries to journal transactions. When there is no -- clockout, add one with the provided current time. Sessions crossing -- midnight are split into days to give accurate per-day totals. timeclockEntriesToTransactions :: LocalTime -> [TimeclockEntry] -> [Transaction] timeclockEntriesToTransactions _ [] = [] timeclockEntriesToTransactions now [i] | tlcode i /= In = errorExpectedCodeButGot In i | odate > idate = entryFromTimeclockInOut i o' : timeclockEntriesToTransactions now [i',o] | otherwise = [entryFromTimeclockInOut i o] where o = TimeclockEntry (tlsourcepos i) Out end "" "" end = if itime > now then itime else now (itime,otime) = (tldatetime i,tldatetime o) (idate,odate) = (localDay itime,localDay otime) o' = o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}} i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}} timeclockEntriesToTransactions now (i:o:rest) | tlcode i /= In = errorExpectedCodeButGot In i | tlcode o /= Out =errorExpectedCodeButGot Out o | odate > idate = entryFromTimeclockInOut i o' : timeclockEntriesToTransactions now (i':o:rest) | otherwise = entryFromTimeclockInOut i o : timeclockEntriesToTransactions now rest where (itime,otime) = (tldatetime i,tldatetime o) (idate,odate) = (localDay itime,localDay otime) o' = o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}} i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}} {- HLINT ignore timeclockEntriesToTransactions -} errorExpectedCodeButGot expected actual = errorWithSourceLine line $ "expected timeclock code " ++ (show expected) ++ " but got " ++ show (tlcode actual) where line = case tlsourcepos actual of GenericSourcePos _ l _ -> l JournalSourcePos _ (l, _) -> l errorWithSourceLine line msg = error $ "line " ++ show line ++ ": " ++ msg -- | Convert a timeclock clockin and clockout entry to an equivalent journal -- transaction, representing the time expenditure. Note this entry is not balanced, -- since we omit the \"assets:time\" transaction for simpler output. entryFromTimeclockInOut :: TimeclockEntry -> TimeclockEntry -> Transaction entryFromTimeclockInOut i o | otime >= itime = t | otherwise = error' $ "clock-out time less than clock-in time in:\n" ++ showTransaction t -- PARTIAL: where t = Transaction { tindex = 0, tsourcepos = tlsourcepos i, tdate = idate, tdate2 = Nothing, tstatus = Cleared, tcode = "", tdescription = desc, tcomment = "", ttags = [], tpostings = ps, tprecedingcomment="" } itime = tldatetime i otime = tldatetime o itod = localTimeOfDay itime otod = localTimeOfDay otime idate = localDay itime desc | T.null (tldescription i) = T.pack $ showtime itod ++ "-" ++ showtime otod | otherwise = tldescription i showtime = take 5 . show hours = elapsedSeconds (toutc otime) (toutc itime) / 3600 where toutc = localTimeToUTC utc acctname = tlaccount i amount = Mixed [hrs hours] ps = [posting{paccount=acctname, pamount=amount, ptype=VirtualPosting, ptransaction=Just t}] -- tests tests_Timeclock = tests "Timeclock" [ testCaseSteps "timeclockEntriesToTransactions tests" $ \step -> do step "gathering data" today <- getCurrentDay now' <- getCurrentTime tz <- getCurrentTimeZone let now = utcToLocalTime tz now' nowstr = showtime now yesterday = prevday today clockin = TimeclockEntry nullsourcepos In mktime d = LocalTime d . fromMaybe midnight . parseTimeM True defaultTimeLocale "%H:%M:%S" showtime = formatTime defaultTimeLocale "%H:%M" txndescs = map (T.unpack . tdescription) . timeclockEntriesToTransactions now future = utcToLocalTime tz $ addUTCTime 100 now' futurestr = showtime future step "started yesterday, split session at midnight" txndescs [clockin (mktime yesterday "23:00:00") "" ""] @?= ["23:00-23:59","00:00-"++nowstr] step "split multi-day sessions at each midnight" txndescs [clockin (mktime (addDays (-2) today) "23:00:00") "" ""] @?= ["23:00-23:59","00:00-23:59","00:00-"++nowstr] step "auto-clock-out if needed" txndescs [clockin (mktime today "00:00:00") "" ""] @?= ["00:00-"++nowstr] step "use the clockin time for auto-clockout if it's in the future" txndescs [clockin future "" ""] @?= [printf "%s-%s" futurestr futurestr] ] hledger-lib-1.19.1/Hledger/Data/Transaction.hs0000644000000000000000000012303313723300774017223 0ustar0000000000000000{-| A 'Transaction' represents a movement of some commodity(ies) between two or more accounts. It consists of multiple account 'Posting's which balance to zero, a date, and optional extras like description, cleared status, and tags. -} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE RecordWildCards #-} module Hledger.Data.Transaction ( -- * Transaction nulltransaction, transaction, txnTieKnot, txnUntieKnot, -- * operations showAccountName, hasRealPostings, realPostings, assignmentPostings, virtualPostings, balancedVirtualPostings, transactionsPostings, isTransactionBalanced, balanceTransaction, balanceTransactionHelper, transactionTransformPostings, transactionApplyValuation, transactionToCost, -- nonzerobalanceerror, -- * date operations transactionDate2, -- * transaction description parts transactionPayee, transactionNote, -- payeeAndNoteFromDescription, -- * rendering showTransaction, showTransactionOneLineAmounts, showTransactionUnelided, showTransactionUnelidedOneLineAmounts, -- showPostingLine, showPostingLines, -- * GenericSourcePos sourceFilePath, sourceFirstLine, showGenericSourcePos, annotateErrorWithTransaction, -- * tests tests_Transaction ) where import Data.List import Data.List.Extra (nubSort) import Data.Maybe import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar import Text.Printf import qualified Data.Map as M import Hledger.Utils import Hledger.Data.Types import Hledger.Data.Dates import Hledger.Data.Posting import Hledger.Data.Amount import Hledger.Data.Valuation sourceFilePath :: GenericSourcePos -> FilePath sourceFilePath = \case GenericSourcePos fp _ _ -> fp JournalSourcePos fp _ -> fp sourceFirstLine :: GenericSourcePos -> Int sourceFirstLine = \case GenericSourcePos _ line _ -> line JournalSourcePos _ (line, _) -> line -- | Render source position in human-readable form. -- Keep in sync with Hledger.UI.ErrorScreen.hledgerparseerrorpositionp (temporary). XXX showGenericSourcePos :: GenericSourcePos -> String showGenericSourcePos = \case GenericSourcePos fp line column -> show fp ++ " (line " ++ show line ++ ", column " ++ show column ++ ")" JournalSourcePos fp (line, line') -> show fp ++ " (lines " ++ show line ++ "-" ++ show line' ++ ")" nulltransaction :: Transaction nulltransaction = Transaction { tindex=0, tsourcepos=nullsourcepos, tdate=nulldate, tdate2=Nothing, tstatus=Unmarked, tcode="", tdescription="", tcomment="", ttags=[], tpostings=[], tprecedingcomment="" } -- | Make a simple transaction with the given date and postings. transaction :: Day -> [Posting] -> Transaction transaction day ps = txnTieKnot $ nulltransaction{tdate=day, tpostings=ps} transactionPayee :: Transaction -> Text transactionPayee = fst . payeeAndNoteFromDescription . tdescription transactionNote :: Transaction -> Text transactionNote = snd . payeeAndNoteFromDescription . tdescription -- | Parse a transaction's description into payee and note (aka narration) fields, -- assuming a convention of separating these with | (like Beancount). -- Ie, everything up to the first | is the payee, everything after it is the note. -- When there's no |, payee == note == description. payeeAndNoteFromDescription :: Text -> (Text,Text) payeeAndNoteFromDescription t | T.null n = (t, t) | otherwise = (T.strip p, T.strip $ T.drop 1 n) where (p, n) = T.span (/= '|') t {-| Render a journal transaction as text similar to the style of Ledger's print command. Adapted from Ledger 2.x and 3.x standard format: @ yyyy-mm-dd[ *][ CODE] description......... [ ; comment...............] account name 1..................... ...$amount1[ ; comment...............] account name 2..................... ..$-amount1[ ; comment...............] pcodewidth = no limit -- 10 -- mimicking ledger layout. pdescwidth = no limit -- 20 -- I don't remember what these mean, pacctwidth = 35 minimum, no maximum -- they were important at the time. pamtwidth = 11 pcommentwidth = no limit -- 22 @ The output will be parseable journal syntax. To facilitate this, postings with explicit multi-commodity amounts are displayed as multiple similar postings, one per commodity. (Normally does not happen with this function). -} showTransaction :: Transaction -> String showTransaction = showTransactionHelper False -- | Deprecated alias for 'showTransaction' showTransactionUnelided :: Transaction -> String showTransactionUnelided = showTransaction -- TODO: drop it -- | Like showTransaction, but explicit multi-commodity amounts -- are shown on one line, comma-separated. In this case the output will -- not be parseable journal syntax. showTransactionOneLineAmounts :: Transaction -> String showTransactionOneLineAmounts = showTransactionHelper True -- | Deprecated alias for 'showTransactionOneLineAmounts' showTransactionUnelidedOneLineAmounts :: Transaction -> String showTransactionUnelidedOneLineAmounts = showTransactionOneLineAmounts -- TODO: drop it -- | Helper for showTransaction*. showTransactionHelper :: Bool -> Transaction -> String showTransactionHelper onelineamounts t = unlines $ [descriptionline] ++ newlinecomments ++ (postingsAsLines onelineamounts (tpostings t)) ++ [""] where descriptionline = rstrip $ concat [date, status, code, desc, samelinecomment] date = showDate (tdate t) ++ maybe "" (("="++) . showDate) (tdate2 t) status | tstatus t == Cleared = " *" | tstatus t == Pending = " !" | otherwise = "" code = if T.length (tcode t) > 0 then printf " (%s)" $ T.unpack $ tcode t else "" desc = if null d then "" else " " ++ d where d = T.unpack $ tdescription t (samelinecomment, newlinecomments) = case renderCommentLines (tcomment t) of [] -> ("",[]) c:cs -> (c,cs) -- | Render a transaction or posting's comment as indented, semicolon-prefixed comment lines. -- The first line (unless empty) will have leading space, subsequent lines will have a larger indent. renderCommentLines :: Text -> [String] renderCommentLines t = case lines $ T.unpack t of [] -> [] [l] -> [(commentSpace . comment) l] -- single-line comment ("":ls) -> "" : map (lineIndent . comment) ls -- multi-line comment with empty first line (l:ls) -> (commentSpace . comment) l : map (lineIndent . comment) ls where comment = ("; "++) -- | Given a transaction and its postings, render the postings, suitable -- for `print` output. Normally this output will be valid journal syntax which -- hledger can reparse (though it may include no-longer-valid balance assertions). -- -- Explicit amounts are shown, any implicit amounts are not. -- -- Postings with multicommodity explicit amounts are handled as follows: -- if onelineamounts is true, these amounts are shown on one line, -- comma-separated, and the output will not be valid journal syntax. -- Otherwise, they are shown as several similar postings, one per commodity. -- -- The output will appear to be a balanced transaction. -- Amounts' display precisions, which may have been limited by commodity -- directives, will be increased if necessary to ensure this. -- -- Posting amounts will be aligned with each other, starting about 4 columns -- beyond the widest account name (see postingAsLines for details). -- postingsAsLines :: Bool -> [Posting] -> [String] postingsAsLines onelineamounts ps = concatMap (postingAsLines False onelineamounts ps) ps -- | Render one posting, on one or more lines, suitable for `print` output. -- There will be an indented account name, plus one or more of status flag, -- posting amount, balance assertion, same-line comment, next-line comments. -- -- If the posting's amount is implicit or if elideamount is true, no amount is shown. -- -- If the posting's amount is explicit and multi-commodity, multiple similar -- postings are shown, one for each commodity, to help produce parseable journal syntax. -- Or if onelineamounts is true, such amounts are shown on one line, comma-separated -- (and the output will not be valid journal syntax). -- -- By default, 4 spaces (2 if there's a status flag) are shown between -- account name and start of amount area, which is typically 12 chars wide -- and contains a right-aligned amount (so 10-12 visible spaces between -- account name and amount is typical). -- When given a list of postings to be aligned with, the whitespace will be -- increased if needed to match the posting with the longest account name. -- This is used to align the amounts of a transaction's postings. -- postingAsLines :: Bool -> Bool -> [Posting] -> Posting -> [String] postingAsLines elideamount onelineamounts pstoalignwith p = concat [ postingblock ++ newlinecomments | postingblock <- postingblocks] where postingblocks = [map rstrip $ lines $ concatTopPadded [statusandaccount, " ", amt, assertion, samelinecomment] | amt <- shownAmounts] assertion = maybe "" ((' ':).showBalanceAssertion) $ pbalanceassertion p statusandaccount = lineIndent $ fitString (Just $ minwidth) Nothing False True $ pstatusandacct p where -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned minwidth = maximum $ map ((2+) . textWidth . T.pack . pacctstr) pstoalignwith pstatusandacct p' = pstatusprefix p' ++ pacctstr p' pstatusprefix p' | null s = "" | otherwise = s ++ " " where s = show $ pstatus p' pacctstr p' = showAccountName Nothing (ptype p') (paccount p') -- currently prices are considered part of the amount string when right-aligning amounts shownAmounts | elideamount = [""] | onelineamounts = [fitString (Just amtwidth) Nothing False False $ showMixedAmountOneLine $ pamount p] | null (amounts $ pamount p) = [""] | otherwise = map (fitStringMulti (Just amtwidth) Nothing False False . showAmount ) . amounts $ pamount p where amtwidth = maximum $ 12 : map (strWidth . showMixedAmount . pamount) pstoalignwith -- min. 12 for backwards compatibility (samelinecomment, newlinecomments) = case renderCommentLines (pcomment p) of [] -> ("",[]) c:cs -> (c,cs) -- | Render a balance assertion, as the =[=][*] symbol and expected amount. showBalanceAssertion :: BalanceAssertion -> [Char] showBalanceAssertion BalanceAssertion{..} = "=" ++ ['=' | batotal] ++ ['*' | bainclusive] ++ " " ++ showAmountWithZeroCommodity baamount -- | Render a posting, simply. Used in balance assertion errors. -- showPostingLine p = -- lineIndent $ -- if pstatus p == Cleared then "* " else "" ++ -- XXX show ! -- showAccountName Nothing (ptype p) (paccount p) ++ -- " " ++ -- showMixedAmountOneLine (pamount p) ++ -- assertion -- where -- -- XXX extract, handle == -- assertion = maybe "" ((" = " ++) . showAmountWithZeroCommodity . baamount) $ pbalanceassertion p -- | Render a posting, at the appropriate width for aligning with -- its siblings if any. Used by the rewrite command. showPostingLines :: Posting -> [String] showPostingLines p = postingAsLines False False ps p where ps | Just t <- ptransaction p = tpostings t | otherwise = [p] -- | Prepend a suitable indent for a posting (or transaction/posting comment) line. lineIndent :: String -> String lineIndent = (" "++) -- | Prepend the space required before a same-line comment. commentSpace :: String -> String commentSpace = (" "++) -- | Show an account name, clipped to the given width if any, and -- appropriately bracketed/parenthesised for the given posting type. showAccountName :: Maybe Int -> PostingType -> AccountName -> String showAccountName w = fmt where fmt RegularPosting = maybe id take w . T.unpack fmt VirtualPosting = parenthesise . maybe id (takeEnd . subtract 2) w . T.unpack fmt BalancedVirtualPosting = bracket . maybe id (takeEnd . subtract 2) w . T.unpack parenthesise :: String -> String parenthesise s = "("++s++")" bracket :: String -> String bracket s = "["++s++"]" hasRealPostings :: Transaction -> Bool hasRealPostings = not . null . realPostings realPostings :: Transaction -> [Posting] realPostings = filter isReal . tpostings assignmentPostings :: Transaction -> [Posting] assignmentPostings = filter hasBalanceAssignment . tpostings virtualPostings :: Transaction -> [Posting] virtualPostings = filter isVirtual . tpostings balancedVirtualPostings :: Transaction -> [Posting] balancedVirtualPostings = filter isBalancedVirtual . tpostings transactionsPostings :: [Transaction] -> [Posting] transactionsPostings = concatMap tpostings -- | Check that this transaction would appear balanced to a human when displayed. -- On success, returns the empty list, otherwise one or more error messages. -- -- In more detail: -- For the real postings, and separately for the balanced virtual postings: -- -- 1. Convert amounts to cost where possible -- -- 2. When there are two or more non-zero amounts -- (appearing non-zero when displayed, using the given display styles if provided), -- are they a mix of positives and negatives ? -- This is checked separately to give a clearer error message. -- (Best effort; could be confused by postings with multicommodity amounts.) -- -- 3. Does the amounts' sum appear non-zero when displayed ? -- (using the given display styles if provided) -- transactionCheckBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transaction -> [String] transactionCheckBalanced mstyles t = errs where (rps, bvps) = (realPostings t, balancedVirtualPostings t) -- check for mixed signs, detecting nonzeros at display precision canonicalise = maybe id canonicaliseMixedAmount mstyles signsOk ps = case filter (not.mixedAmountLooksZero) $ map (canonicalise.mixedAmountCost.pamount) ps of nonzeros | length nonzeros >= 2 -> length (nubSort $ mapMaybe isNegativeMixedAmount nonzeros) > 1 _ -> True (rsignsok, bvsignsok) = (signsOk rps, signsOk bvps) -- check for zero sum, at display precision (rsum, bvsum) = (sumPostings rps, sumPostings bvps) (rsumcost, bvsumcost) = (mixedAmountCost rsum, mixedAmountCost bvsum) (rsumdisplay, bvsumdisplay) = (canonicalise rsumcost, canonicalise bvsumcost) (rsumok, bvsumok) = (mixedAmountLooksZero rsumdisplay, mixedAmountLooksZero bvsumdisplay) -- generate error messages, showing amounts with their original precision errs = filter (not.null) [rmsg, bvmsg] where rmsg | not rsignsok = "real postings all have the same sign" | not rsumok = "real postings' sum should be 0 but is: " ++ showMixedAmount rsumcost | otherwise = "" bvmsg | not bvsignsok = "balanced virtual postings all have the same sign" | not bvsumok = "balanced virtual postings' sum should be 0 but is: " ++ showMixedAmount bvsumcost | otherwise = "" -- | Legacy form of transactionCheckBalanced. isTransactionBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transaction -> Bool isTransactionBalanced mstyles = null . transactionCheckBalanced mstyles -- | Balance this transaction, ensuring that its postings -- (and its balanced virtual postings) sum to 0, -- by inferring a missing amount or conversion price(s) if needed. -- Or if balancing is not possible, because the amounts don't sum to 0 or -- because there's more than one missing amount, return an error message. -- -- Transactions with balance assignments can have more than one -- missing amount; to balance those you should use the more powerful -- journalBalanceTransactions. -- -- The "sum to 0" test is done using commodity display precisions, -- if provided, so that the result agrees with the numbers users can see. -- balanceTransaction :: Maybe (M.Map CommoditySymbol AmountStyle) -- ^ commodity display styles -> Transaction -> Either String Transaction balanceTransaction mstyles = fmap fst . balanceTransactionHelper mstyles -- | Helper used by balanceTransaction and balanceTransactionWithBalanceAssignmentAndCheckAssertionsB; -- use one of those instead. It also returns a list of accounts -- and amounts that were inferred. balanceTransactionHelper :: Maybe (M.Map CommoditySymbol AmountStyle) -- ^ commodity display styles -> Transaction -> Either String (Transaction, [(AccountName, MixedAmount)]) balanceTransactionHelper mstyles t = do (t', inferredamtsandaccts) <- inferBalancingAmount (fromMaybe M.empty mstyles) $ inferBalancingPrices t case transactionCheckBalanced mstyles t' of [] -> Right (txnTieKnot t', inferredamtsandaccts) errs -> Left $ transactionBalanceError t' errs -- | Generate a transaction balancing error message, given the transaction -- and one or more suberror messages. transactionBalanceError :: Transaction -> [String] -> String transactionBalanceError t errs = annotateErrorWithTransaction t $ intercalate "\n" $ "could not balance this transaction:" : errs annotateErrorWithTransaction :: Transaction -> String -> String annotateErrorWithTransaction t s = unlines [showGenericSourcePos $ tsourcepos t, s, rstrip $ showTransaction t] -- | Infer up to one missing amount for this transactions's real postings, and -- likewise for its balanced virtual postings, if needed; or return an error -- message if we can't. Returns the updated transaction and any inferred posting amounts, -- with the corresponding accounts, in order). -- -- We can infer a missing amount when there are multiple postings and exactly -- one of them is amountless. If the amounts had price(s) the inferred amount -- have the same price(s), and will be converted to the price commodity. inferBalancingAmount :: M.Map CommoditySymbol AmountStyle -- ^ commodity display styles -> Transaction -> Either String (Transaction, [(AccountName, MixedAmount)]) inferBalancingAmount styles t@Transaction{tpostings=ps} | length amountlessrealps > 1 = Left $ transactionBalanceError t ["can't have more than one real posting with no amount" ,"(remember to put two or more spaces between account and amount)"] | length amountlessbvps > 1 = Left $ transactionBalanceError t ["can't have more than one balanced virtual posting with no amount" ,"(remember to put two or more spaces between account and amount)"] | otherwise = let psandinferredamts = map inferamount ps inferredacctsandamts = [(paccount p, amt) | (p, Just amt) <- psandinferredamts] in Right (t{tpostings=map fst psandinferredamts}, inferredacctsandamts) where (amountfulrealps, amountlessrealps) = partition hasAmount (realPostings t) realsum = sumStrict $ map pamount amountfulrealps (amountfulbvps, amountlessbvps) = partition hasAmount (balancedVirtualPostings t) bvsum = sumStrict $ map pamount amountfulbvps inferamount :: Posting -> (Posting, Maybe MixedAmount) inferamount p = let minferredamt = case ptype p of RegularPosting | not (hasAmount p) -> Just realsum BalancedVirtualPosting | not (hasAmount p) -> Just bvsum _ -> Nothing in case minferredamt of Nothing -> (p, Nothing) Just a -> (p{pamount=a', poriginal=Just $ originalPosting p}, Just a') where -- Inferred amounts are converted to cost. -- Also ensure the new amount has the standard style for its commodity -- (since the main amount styling pass happened before this balancing pass); a' = styleMixedAmount styles $ normaliseMixedAmount $ mixedAmountCost (-a) -- | Infer prices for this transaction's posting amounts, if needed to make -- the postings balance, and if possible. This is done once for the real -- postings and again (separately) for the balanced virtual postings. When -- it's not possible, the transaction is left unchanged. -- -- The simplest example is a transaction with two postings, each in a -- different commodity, with no prices specified. In this case we'll add a -- price to the first posting such that it can be converted to the commodity -- of the second posting (with -B), and such that the postings balance. -- -- In general, we can infer a conversion price when the sum of posting amounts -- contains exactly two different commodities and no explicit prices. Also -- all postings are expected to contain an explicit amount (no missing -- amounts) in a single commodity. Otherwise no price inferring is attempted. -- -- The transaction itself could contain more than two commodities, and/or -- prices, if they cancel out; what matters is that the sum of posting amounts -- contains exactly two commodities and zero prices. -- -- There can also be more than two postings in either of the commodities. -- -- We want to avoid excessive display of digits when the calculated price is -- an irrational number, while hopefully also ensuring the displayed numbers -- make sense if the user does a manual calculation. This is (mostly) achieved -- in two ways: -- -- - when there is only one posting in the "from" commodity, a total price -- (@@) is used, and all available decimal digits are shown -- -- - otherwise, a suitable averaged unit price (@) is applied to the relevant -- postings, with display precision equal to the summed display precisions -- of the two commodities being converted between, or 2, whichever is larger. -- -- (We don't always calculate a good-looking display precision for unit prices -- when the commodity display precisions are low, eg when a journal doesn't -- use any decimal places. The minimum of 2 helps make the prices shown by the -- print command a bit less surprising in this case. Could do better.) -- inferBalancingPrices :: Transaction -> Transaction inferBalancingPrices t@Transaction{tpostings=ps} = t{tpostings=ps'} where ps' = map (priceInferrerFor t BalancedVirtualPosting . priceInferrerFor t RegularPosting) ps -- | Generate a posting update function which assigns a suitable balancing -- price to the posting, if and as appropriate for the given transaction and -- posting type (real or balanced virtual). priceInferrerFor :: Transaction -> PostingType -> (Posting -> Posting) priceInferrerFor t pt = inferprice where postings = filter ((==pt).ptype) $ tpostings t pmixedamounts = map pamount postings pamounts = concatMap amounts pmixedamounts pcommodities = map acommodity pamounts sumamounts = amounts $ sumStrict pmixedamounts -- sum normalises to one amount per commodity & price sumcommodities = map acommodity sumamounts sumprices = filter (/=Nothing) $ map aprice sumamounts caninferprices = length sumcommodities == 2 && null sumprices inferprice p@Posting{pamount=Mixed [a]} | caninferprices && ptype p == pt && acommodity a == fromcommodity = p{pamount=Mixed [a{aprice=Just conversionprice}], poriginal=Just $ originalPosting p} where fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe conversionprice | fromcount==1 = TotalPrice $ abs toamount `withPrecision` NaturalPrecision | otherwise = UnitPrice $ abs unitprice `withPrecision` unitprecision where fromcount = length $ filter ((==fromcommodity).acommodity) pamounts fromamount = head $ filter ((==fromcommodity).acommodity) sumamounts fromprecision = asprecision $ astyle fromamount tocommodity = head $ filter (/=fromcommodity) sumcommodities toamount = head $ filter ((==tocommodity).acommodity) sumamounts toprecision = asprecision $ astyle toamount unitprice = (aquantity fromamount) `divideAmount` toamount -- Sum two display precisions, capping the result at the maximum bound unitprecision = case (fromprecision, toprecision) of (Precision a, Precision b) -> Precision $ if maxBound - a < b then maxBound else max 2 (a + b) _ -> NaturalPrecision inferprice p = p -- Get a transaction's secondary date, defaulting to the primary date. transactionDate2 :: Transaction -> Day transactionDate2 t = fromMaybe (tdate t) $ tdate2 t -- | Ensure a transaction's postings refer back to it, so that eg -- relatedPostings works right. txnTieKnot :: Transaction -> Transaction txnTieKnot t@Transaction{tpostings=ps} = t' where t' = t{tpostings=map (postingSetTransaction t') ps} -- | Ensure a transaction's postings do not refer back to it, so that eg -- recursiveSize and GHCI's :sprint work right. txnUntieKnot :: Transaction -> Transaction txnUntieKnot t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ptransaction=Nothing}) ps} -- | Set a posting's parent transaction. postingSetTransaction :: Transaction -> Posting -> Posting postingSetTransaction t p = p{ptransaction=Just t} -- | Apply a transform function to this transaction's amounts. transactionTransformPostings :: (Posting -> Posting) -> Transaction -> Transaction transactionTransformPostings f t@Transaction{tpostings=ps} = t{tpostings=map f ps} -- | Apply a specified valuation to this transaction's amounts, using -- the provided price oracle, commodity styles, reference dates, and -- whether this is for a multiperiod report or not. See -- amountApplyValuation. transactionApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Maybe Day -> Day -> Bool -> Transaction -> ValuationType -> Transaction transactionApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod t v = transactionTransformPostings (\p -> postingApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod p v) t -- | Convert this transaction's amounts to cost, and apply the appropriate amount styles. transactionToCost :: M.Map CommoditySymbol AmountStyle -> Transaction -> Transaction transactionToCost styles t@Transaction{tpostings=ps} = t{tpostings=map (postingToCost styles) ps} -- tests tests_Transaction :: TestTree tests_Transaction = tests "Transaction" [ tests "postingAsLines" [ test "null posting" $ postingAsLines False False [posting] posting @?= [""] , test "non-null posting" $ let p = posting { pstatus = Cleared , paccount = "a" , pamount = Mixed [usd 1, hrs 2] , pcomment = "pcomment1\npcomment2\n tag3: val3 \n" , ptype = RegularPosting , ptags = [("ptag1", "val1"), ("ptag2", "val2")] } in postingAsLines False False [p] p @?= [ " * a $1.00 ; pcomment1" , " ; pcomment2" , " ; tag3: val3 " , " * a 2.00h ; pcomment1" , " ; pcomment2" , " ; tag3: val3 " ] ] , let -- one implicit amount timp = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt]} -- explicit amounts, balanced texp = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` usd (-1)]} -- explicit amount, only one posting texp1 = nulltransaction {tpostings = ["(a)" `post` usd 1]} -- explicit amounts, two commodities, explicit balancing price texp2 = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` (hrs (-1) `at` usd 1)]} -- explicit amounts, two commodities, implicit balancing price texp2b = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` hrs (-1)]} -- one missing amount, not the last one t3 = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt, "c" `post` usd (-1)]} -- unbalanced amounts when precision is limited (#931) -- t4 = nulltransaction {tpostings = ["a" `post` usd (-0.01), "b" `post` usd (0.005), "c" `post` usd (0.005)]} in tests "postingsAsLines" [ test "null-transaction" $ postingsAsLines False (tpostings nulltransaction) @?= [] , test "implicit-amount" $ postingsAsLines False (tpostings timp) @?= [ " a $1.00" , " b" -- implicit amount remains implicit ] , test "explicit-amounts" $ postingsAsLines False (tpostings texp) @?= [ " a $1.00" , " b $-1.00" ] , test "one-explicit-amount" $ postingsAsLines False (tpostings texp1) @?= [ " (a) $1.00" ] , test "explicit-amounts-two-commodities" $ postingsAsLines False (tpostings texp2) @?= [ " a $1.00" , " b -1.00h @ $1.00" ] , test "explicit-amounts-not-explicitly-balanced" $ postingsAsLines False (tpostings texp2b) @?= [ " a $1.00" , " b -1.00h" ] , test "implicit-amount-not-last" $ postingsAsLines False (tpostings t3) @?= [" a $1.00", " b", " c $-1.00"] -- , test "ensure-visibly-balanced" $ -- in postingsAsLines False (tpostings t4) @?= -- [" a $-0.01", " b $0.005", " c $0.005"] ] , test "inferBalancingAmount" $ do (fst <$> inferBalancingAmount M.empty nulltransaction) @?= Right nulltransaction (fst <$> inferBalancingAmount M.empty nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` missingamt]}) @?= Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` usd 5]} (fst <$> inferBalancingAmount M.empty nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` missingamt]}) @?= Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` usd 1]} , tests "showTransaction" [ test "null transaction" $ showTransaction nulltransaction @?= "0000-01-01\n\n" , test "non-null transaction" $ showTransaction nulltransaction { tdate = fromGregorian 2012 05 14 , tdate2 = Just $ fromGregorian 2012 05 15 , tstatus = Unmarked , tcode = "code" , tdescription = "desc" , tcomment = "tcomment1\ntcomment2\n" , ttags = [("ttag1", "val1")] , tpostings = [ nullposting { pstatus = Cleared , paccount = "a" , pamount = Mixed [usd 1, hrs 2] , pcomment = "\npcomment2\n" , ptype = RegularPosting , ptags = [("ptag1", "val1"), ("ptag2", "val2")] } ] } @?= unlines [ "2012-05-14=2012-05-15 (code) desc ; tcomment1" , " ; tcomment2" , " * a $1.00" , " ; pcomment2" , " * a 2.00h" , " ; pcomment2" , "" ] , test "show a balanced transaction" $ (let t = Transaction 0 "" nullsourcepos (fromGregorian 2007 01 28) Nothing Unmarked "" "coopportunity" "" [] [ posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18], ptransaction = Just t} , posting {paccount = "assets:checking", pamount = Mixed [usd (-47.18)], ptransaction = Just t} ] in showTransaction t) @?= (unlines [ "2007-01-28 coopportunity" , " expenses:food:groceries $47.18" , " assets:checking $-47.18" , "" ]) , test "show an unbalanced transaction, should not elide" $ (showTransaction (txnTieKnot $ Transaction 0 "" nullsourcepos (fromGregorian 2007 01 28) Nothing Unmarked "" "coopportunity" "" [] [ posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18]} , posting {paccount = "assets:checking", pamount = Mixed [usd (-47.19)]} ])) @?= (unlines [ "2007-01-28 coopportunity" , " expenses:food:groceries $47.18" , " assets:checking $-47.19" , "" ]) , test "show a transaction with one posting and a missing amount" $ (showTransaction (txnTieKnot $ Transaction 0 "" nullsourcepos (fromGregorian 2007 01 28) Nothing Unmarked "" "coopportunity" "" [] [posting {paccount = "expenses:food:groceries", pamount = missingmixedamt}])) @?= (unlines ["2007-01-28 coopportunity", " expenses:food:groceries", ""]) , test "show a transaction with a priced commodityless amount" $ (showTransaction (txnTieKnot $ Transaction 0 "" nullsourcepos (fromGregorian 2010 01 01) Nothing Unmarked "" "x" "" [] [ posting {paccount = "a", pamount = Mixed [num 1 `at` (usd 2 `withPrecision` Precision 0)]} , posting {paccount = "b", pamount = missingmixedamt} ])) @?= (unlines ["2010-01-01 x", " a 1 @ $2", " b", ""]) ] , tests "balanceTransaction" [ test "detect unbalanced entry, sign error" $ assertLeft (balanceTransaction Nothing (Transaction 0 "" nullsourcepos (fromGregorian 2007 01 28) Nothing Unmarked "" "test" "" [] [posting {paccount = "a", pamount = Mixed [usd 1]}, posting {paccount = "b", pamount = Mixed [usd 1]}])) ,test "detect unbalanced entry, multiple missing amounts" $ assertLeft $ balanceTransaction Nothing (Transaction 0 "" nullsourcepos (fromGregorian 2007 01 28) Nothing Unmarked "" "test" "" [] [ posting {paccount = "a", pamount = missingmixedamt} , posting {paccount = "b", pamount = missingmixedamt} ]) ,test "one missing amount is inferred" $ (pamount . last . tpostings <$> balanceTransaction Nothing (Transaction 0 "" nullsourcepos (fromGregorian 2007 01 28) Nothing Unmarked "" "" "" [] [posting {paccount = "a", pamount = Mixed [usd 1]}, posting {paccount = "b", pamount = missingmixedamt}])) @?= Right (Mixed [usd (-1)]) ,test "conversion price is inferred" $ (pamount . head . tpostings <$> balanceTransaction Nothing (Transaction 0 "" nullsourcepos (fromGregorian 2007 01 28) Nothing Unmarked "" "" "" [] [ posting {paccount = "a", pamount = Mixed [usd 1.35]} , posting {paccount = "b", pamount = Mixed [eur (-1)]} ])) @?= Right (Mixed [usd 1.35 @@ (eur 1 `withPrecision` NaturalPrecision)]) ,test "balanceTransaction balances based on cost if there are unit prices" $ assertRight $ balanceTransaction Nothing (Transaction 0 "" nullsourcepos (fromGregorian 2011 01 01) Nothing Unmarked "" "" "" [] [ posting {paccount = "a", pamount = Mixed [usd 1 `at` eur 2]} , posting {paccount = "a", pamount = Mixed [usd (-2) `at` eur 1]} ]) ,test "balanceTransaction balances based on cost if there are total prices" $ assertRight $ balanceTransaction Nothing (Transaction 0 "" nullsourcepos (fromGregorian 2011 01 01) Nothing Unmarked "" "" "" [] [ posting {paccount = "a", pamount = Mixed [usd 1 @@ eur 1]} , posting {paccount = "a", pamount = Mixed [usd (-2) @@ eur 1]} ]) ] , tests "isTransactionBalanced" [ test "detect balanced" $ assertBool "" $ isTransactionBalanced Nothing $ Transaction 0 "" nullsourcepos (fromGregorian 2009 01 01) Nothing Unmarked "" "a" "" [] [ posting {paccount = "b", pamount = Mixed [usd 1.00]} , posting {paccount = "c", pamount = Mixed [usd (-1.00)]} ] ,test "detect unbalanced" $ assertBool "" $ not $ isTransactionBalanced Nothing $ Transaction 0 "" nullsourcepos (fromGregorian 2009 01 01) Nothing Unmarked "" "a" "" [] [ posting {paccount = "b", pamount = Mixed [usd 1.00]} , posting {paccount = "c", pamount = Mixed [usd (-1.01)]} ] ,test "detect unbalanced, one posting" $ assertBool "" $ not $ isTransactionBalanced Nothing $ Transaction 0 "" nullsourcepos (fromGregorian 2009 01 01) Nothing Unmarked "" "a" "" [] [posting {paccount = "b", pamount = Mixed [usd 1.00]}] ,test "one zero posting is considered balanced for now" $ assertBool "" $ isTransactionBalanced Nothing $ Transaction 0 "" nullsourcepos (fromGregorian 2009 01 01) Nothing Unmarked "" "a" "" [] [posting {paccount = "b", pamount = Mixed [usd 0]}] ,test "virtual postings don't need to balance" $ assertBool "" $ isTransactionBalanced Nothing $ Transaction 0 "" nullsourcepos (fromGregorian 2009 01 01) Nothing Unmarked "" "a" "" [] [ posting {paccount = "b", pamount = Mixed [usd 1.00]} , posting {paccount = "c", pamount = Mixed [usd (-1.00)]} , posting {paccount = "d", pamount = Mixed [usd 100], ptype = VirtualPosting} ] ,test "balanced virtual postings need to balance among themselves" $ assertBool "" $ not $ isTransactionBalanced Nothing $ Transaction 0 "" nullsourcepos (fromGregorian 2009 01 01) Nothing Unmarked "" "a" "" [] [ posting {paccount = "b", pamount = Mixed [usd 1.00]} , posting {paccount = "c", pamount = Mixed [usd (-1.00)]} , posting {paccount = "d", pamount = Mixed [usd 100], ptype = BalancedVirtualPosting} ] ,test "balanced virtual postings need to balance among themselves (2)" $ assertBool "" $ isTransactionBalanced Nothing $ Transaction 0 "" nullsourcepos (fromGregorian 2009 01 01) Nothing Unmarked "" "a" "" [] [ posting {paccount = "b", pamount = Mixed [usd 1.00]} , posting {paccount = "c", pamount = Mixed [usd (-1.00)]} , posting {paccount = "d", pamount = Mixed [usd 100], ptype = BalancedVirtualPosting} , posting {paccount = "3", pamount = Mixed [usd (-100)], ptype = BalancedVirtualPosting} ] ] ] hledger-lib-1.19.1/Hledger/Data/TransactionModifier.hs0000644000000000000000000001457113722544246020713 0ustar0000000000000000{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE CPP #-} {-| A 'TransactionModifier' is a rule that modifies certain 'Transaction's, typically adding automated postings to them. -} module Hledger.Data.TransactionModifier ( modifyTransactions ) where import Control.Applicative ((<|>)) import Data.Maybe #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif import qualified Data.Text as T import Data.Time.Calendar import Hledger.Data.Types import Hledger.Data.Dates import Hledger.Data.Amount import Hledger.Data.Transaction import Hledger.Query import Hledger.Data.Posting (commentJoin, commentAddTag) import Hledger.Utils.Debug -- $setup -- >>> :set -XOverloadedStrings -- >>> import Hledger.Data.Posting -- >>> import Hledger.Data.Transaction -- >>> import Hledger.Data.Journal -- | Apply all the given transaction modifiers, in turn, to each transaction. -- Or if any of them fails to be parsed, return the first error. A reference -- date is provided to help interpret relative dates in transaction modifier -- queries. modifyTransactions :: Day -> [TransactionModifier] -> [Transaction] -> Either String [Transaction] modifyTransactions d tmods ts = do fs <- mapM (transactionModifierToFunction d) tmods -- convert modifiers to functions, or return a parse error let modifytxn t = t'' where t' = foldr (flip (.)) id fs t -- apply each function in turn t'' = if t' == t -- and add some tags if it was changed then t' else t'{tcomment=tcomment t' `commentAddTag` ("modified",""), ttags=("modified","") : ttags t'} Right $ map modifytxn ts -- | Converts a 'TransactionModifier' to a 'Transaction'-transforming function -- which applies the modification(s) specified by the TransactionModifier. -- Or, returns the error message there is a problem parsing the TransactionModifier's query. -- A reference date is provided to help interpret relative dates in the query. -- -- The postings of the transformed transaction will reference it in the usual -- way (ie, 'txnTieKnot' is called). -- -- Currently the only kind of modification possible is adding automated -- postings when certain other postings are present. -- -- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]} -- >>> test = either putStr (putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction nulldate -- >>> test $ TransactionModifier "" ["pong" `post` usd 2] -- 0000-01-01 -- ping $1.00 -- pong $2.00 ; generated-posting: = -- -- >>> test $ TransactionModifier "miss" ["pong" `post` usd 2] -- 0000-01-01 -- ping $1.00 -- -- >>> test $ TransactionModifier "ping" ["pong" `post` amount{aismultiplier=True, aquantity=3}] -- 0000-01-01 -- ping $1.00 -- pong $3.00 ; generated-posting: = ping -- -- transactionModifierToFunction :: Day -> TransactionModifier -> Either String (Transaction -> Transaction) transactionModifierToFunction refdate TransactionModifier{tmquerytxt, tmpostingrules} = do q <- simplifyQuery . fst <$> parseQuery refdate tmquerytxt let fs = map (tmPostingRuleToFunction tmquerytxt) tmpostingrules generatePostings ps = [p' | p <- ps , p' <- if q `matchesPosting` p then p:[f p | f <- fs] else [p]] Right $ \t@(tpostings -> ps) -> txnTieKnot t{tpostings=generatePostings ps} -- | Converts a 'TransactionModifier''s posting rule to a 'Posting'-generating function, -- which will be used to make a new posting based on the old one (an "automated posting"). -- The new posting's amount can optionally be the old posting's amount multiplied by a constant. -- If the old posting had a total-priced amount, the new posting's multiplied amount will be unit-priced. -- The new posting will have two tags added: a normal generated-posting: tag which also appears in the comment, -- and a hidden _generated-posting: tag which does not. -- The TransactionModifier's query text is also provided, and saved -- as the tags' value. tmPostingRuleToFunction :: T.Text -> TMPostingRule -> (Posting -> Posting) tmPostingRuleToFunction querytxt pr = \p -> renderPostingCommentDates $ pr { pdate = pdate pr <|> pdate p , pdate2 = pdate2 pr <|> pdate2 p , pamount = amount' p , pcomment = pcomment pr `commentAddTag` ("generated-posting",qry) , ptags = ("generated-posting", qry) : ("_generated-posting",qry) : ptags pr } where qry = "= " <> querytxt amount' = case postingRuleMultiplier pr of Nothing -> const $ pamount pr Just n -> \p -> -- Multiply the old posting's amount by the posting rule's multiplier. let pramount = dbg6 "pramount" $ head $ amounts $ pamount pr matchedamount = dbg6 "matchedamount" $ pamount p -- Handle a matched amount with a total price carefully so as to keep the transaction balanced (#928). -- Approach 1: convert to a unit price and increase the display precision slightly -- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount -- Approach 2: multiply the total price (keeping it positive) as well as the quantity Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmountAndPrice` matchedamount in case acommodity pramount of "" -> Mixed as -- TODO multipliers with commodity symbols are not yet a documented feature. -- For now: in addition to multiplying the quantity, it also replaces the -- matched amount's commodity, display style, and price with those of the posting rule. c -> Mixed [a{acommodity = c, astyle = astyle pramount, aprice = aprice pramount} | a <- as] postingRuleMultiplier :: TMPostingRule -> Maybe Quantity postingRuleMultiplier p = case amounts $ pamount p of [a] | aismultiplier a -> Just $ aquantity a _ -> Nothing renderPostingCommentDates :: Posting -> Posting renderPostingCommentDates p = p { pcomment = comment' } where dates = T.concat $ catMaybes [T.pack . showDate <$> pdate p, ("=" <>) . T.pack . showDate <$> pdate2 p] comment' | T.null dates = pcomment p | otherwise = ("[" <> dates <> "]") `commentJoin` pcomment p hledger-lib-1.19.1/Hledger/Data/Types.hs0000644000000000000000000006021413723502755016046 0ustar0000000000000000{-| Most data types are defined here to avoid import cycles. Here is an overview of the hledger data model: > Journal -- a journal is read from one or more data files. It contains.. > [Transaction] -- journal transactions (aka entries), which have date, cleared status, code, description and.. > [Posting] -- multiple account postings, which have account name and amount > [MarketPrice] -- historical market prices for commodities > > Ledger -- a ledger is derived from a journal, by applying a filter specification and doing some further processing. It contains.. > Journal -- a filtered copy of the original journal, containing only the transactions and postings we are interested in > [Account] -- all accounts, in tree order beginning with a "root" account", with their balances and sub/parent accounts For more detailed documentation on each type, see the corresponding modules. -} -- {-# LANGUAGE DeriveAnyClass #-} -- https://hackage.haskell.org/package/deepseq-1.4.4.0/docs/Control-DeepSeq.html#v:rnf {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeSynonymInstances #-} module Hledger.Data.Types where import GHC.Generics (Generic) import Data.Decimal import Data.Default import Data.Functor (($>)) import Data.List (intercalate) import Text.Blaze (ToMarkup(..)) --XXX https://hackage.haskell.org/package/containers/docs/Data-Map.html --Note: You should use Data.Map.Strict instead of this module if: --You will eventually need all the values stored. --The stored values don't represent large virtual data structures to be lazily computed. import qualified Data.Map as M import Data.Text (Text) -- import qualified Data.Text as T import Data.Time.Calendar import Data.Time.LocalTime import Data.Word (Word8) import System.Time (ClockTime(..)) import Text.Printf import Hledger.Utils.Regex -- | A possibly incomplete year-month-day date provided by the user, to be -- interpreted as either a date or a date span depending on context. Missing -- parts "on the left" will be filled from the provided reference date, e.g. if -- the year and month are missing, the reference date's year and month are used. -- Missing parts "on the right" are assumed, when interpreting as a date, to be -- 1, (e.g. if the year and month are present but the day is missing, it means -- first day of that month); or when interpreting as a date span, to be a -- wildcard (so it would mean all days of that month). See the `smartdate` -- parser for more examples. -- -- Or, one of the standard periods and an offset relative to the reference date: -- (last|this|next) (day|week|month|quarter|year), where "this" means the period -- containing the reference date. data SmartDate = SmartAssumeStart Year (Maybe (Month, Maybe MonthDay)) | SmartFromReference (Maybe Month) MonthDay | SmartMonth Month | SmartRelative SmartSequence SmartInterval deriving (Show) data SmartSequence = Last | This | Next deriving (Show) data SmartInterval = Day | Week | Month | Quarter | Year deriving (Show) data WhichDate = PrimaryDate | SecondaryDate deriving (Eq,Show) data DateSpan = DateSpan (Maybe Day) (Maybe Day) deriving (Eq,Ord,Generic) instance Default DateSpan where def = DateSpan Nothing Nothing -- synonyms for various date-related scalars type Year = Integer type Month = Int -- 1-12 type Quarter = Int -- 1-4 type YearWeek = Int -- 1-52 type MonthWeek = Int -- 1-5 type YearDay = Int -- 1-366 type MonthDay = Int -- 1-31 type WeekDay = Int -- 1-7 -- Typical report periods (spans of time), both finite and open-ended. -- A richer abstraction than DateSpan. data Period = DayPeriod Day | WeekPeriod Day | MonthPeriod Year Month | QuarterPeriod Year Quarter | YearPeriod Year | PeriodBetween Day Day | PeriodFrom Day | PeriodTo Day | PeriodAll deriving (Eq,Ord,Show,Generic) instance Default Period where def = PeriodAll ---- Typical report period/subperiod durations, from a day to a year. --data Duration = -- DayLong -- WeekLong -- MonthLong -- QuarterLong -- YearLong -- deriving (Eq,Ord,Show,Generic) -- Ways in which a period can be divided into subperiods. data Interval = NoInterval | Days Int | Weeks Int | Months Int | Quarters Int | Years Int | DayOfMonth Int | WeekdayOfMonth Int Int | DayOfWeek Int | DayOfYear Int Int -- Month, Day -- WeekOfYear Int -- MonthOfYear Int -- QuarterOfYear Int deriving (Eq,Show,Ord,Generic) instance Default Interval where def = NoInterval type AccountName = Text data AccountType = Asset | Liability | Equity | Revenue | Expense | Cash -- ^ a subtype of Asset - liquid assets to show in cashflow report deriving (Show,Eq,Ord,Generic) -- not worth the trouble, letters defined in accountdirectivep for now --instance Read AccountType -- where -- readsPrec _ ('A' : xs) = [(Asset, xs)] -- readsPrec _ ('L' : xs) = [(Liability, xs)] -- readsPrec _ ('E' : xs) = [(Equity, xs)] -- readsPrec _ ('R' : xs) = [(Revenue, xs)] -- readsPrec _ ('X' : xs) = [(Expense, xs)] -- readsPrec _ _ = [] data AccountAlias = BasicAlias AccountName AccountName | RegexAlias Regexp Replacement deriving (Eq, Read, Show, Ord, Generic) data Side = L | R deriving (Eq,Show,Read,Ord,Generic) -- | The basic numeric type used in amounts. type Quantity = Decimal -- The following is for hledger-web, and requires blaze-markup. -- Doing it here avoids needing a matching flag on the hledger-web package. instance ToMarkup Quantity where toMarkup = toMarkup . show -- | An amount's per-unit or total cost/selling price in another -- commodity, as recorded in the journal entry eg with @ or @@. -- Docs call this "transaction price". The amount is always positive. data AmountPrice = UnitPrice Amount | TotalPrice Amount deriving (Eq,Ord,Generic,Show) -- | Display style for an amount. data AmountStyle = AmountStyle { ascommodityside :: Side, -- ^ does the symbol appear on the left or the right ? ascommodityspaced :: Bool, -- ^ space between symbol and quantity ? asprecision :: !AmountPrecision, -- ^ number of digits displayed after the decimal point asdecimalpoint :: Maybe Char, -- ^ character used as decimal point: period or comma. Nothing means "unspecified, use default" asdigitgroups :: Maybe DigitGroupStyle -- ^ style for displaying digit groups, if any } deriving (Eq,Ord,Read,Generic) instance Show AmountStyle where show AmountStyle{..} = printf "AmountStylePP \"%s %s %s %s %s..\"" (show ascommodityside) (show ascommodityspaced) (show asprecision) (show asdecimalpoint) (show asdigitgroups) data AmountPrecision = Precision !Word8 | NaturalPrecision deriving (Eq,Ord,Read,Show,Generic) -- | A style for displaying digit groups in the integer part of a -- floating point number. It consists of the character used to -- separate groups (comma or period, whichever is not used as decimal -- point), and the size of each group, starting with the one nearest -- the decimal point. The last group size is assumed to repeat. Eg, -- comma between thousands is DigitGroups ',' [3]. data DigitGroupStyle = DigitGroups Char [Word8] deriving (Eq,Ord,Read,Show,Generic) type CommoditySymbol = Text data Commodity = Commodity { csymbol :: CommoditySymbol, cformat :: Maybe AmountStyle } deriving (Show,Eq,Generic) --,Ord) data Amount = Amount { acommodity :: CommoditySymbol, -- commodity symbol, or special value "AUTO" aquantity :: Quantity, -- numeric quantity, or zero in case of "AUTO" aismultiplier :: Bool, -- ^ kludge: a flag marking this amount and posting as a multiplier -- in a TMPostingRule. In a regular Posting, should always be false. astyle :: AmountStyle, aprice :: Maybe AmountPrice -- ^ the (fixed, transaction-specific) price for this amount, if any } deriving (Eq,Ord,Generic,Show) newtype MixedAmount = Mixed [Amount] deriving (Eq,Ord,Generic,Show) data PostingType = RegularPosting | VirtualPosting | BalancedVirtualPosting deriving (Eq,Show,Generic) type TagName = Text type TagValue = Text type Tag = (TagName, TagValue) -- ^ A tag name and (possibly empty) value. type DateTag = (TagName, Day) -- | The status of a transaction or posting, recorded with a status mark -- (nothing, !, or *). What these mean is ultimately user defined. data Status = Unmarked | Pending | Cleared deriving (Eq,Ord,Bounded,Enum,Generic) instance Show Status where -- custom show.. bad idea.. don't do it.. show Unmarked = "" show Pending = "!" show Cleared = "*" -- | A balance assertion is a declaration about an account's expected balance -- at a certain point (posting date and parse order). They provide additional -- error checking and readability to a journal file. -- -- The 'BalanceAssertion' type is also used to represent balance assignments, -- which instruct hledger what an account's balance should become at a certain -- point. -- -- Different kinds of balance assertions are discussed eg on #290. -- Variables include: -- -- - which postings are to be summed (real/virtual; unmarked/pending/cleared; this account/this account including subs) -- -- - which commodities within the balance are to be checked -- -- - whether to do a partial or a total check (disallowing other commodities) -- -- I suspect we want: -- -- 1. partial, subaccount-exclusive, Ledger-compatible assertions. Because -- they're what we've always had, and removing them would break some -- journals unnecessarily. Implemented with = syntax. -- -- 2. total assertions. Because otherwise assertions are a bit leaky. -- Implemented with == syntax. -- -- 3. subaccount-inclusive assertions. Because that's something folks need. -- Not implemented. -- -- 4. flexible assertions allowing custom criteria (perhaps arbitrary -- queries). Because power users have diverse needs and want to try out -- different schemes (assert cleared balances, assert balance from real or -- virtual postings, etc.). Not implemented. -- -- 5. multicommodity assertions, asserting the balance of multiple commodities -- at once. Not implemented, requires #934. -- data BalanceAssertion = BalanceAssertion { baamount :: Amount, -- ^ the expected balance in a particular commodity batotal :: Bool, -- ^ disallow additional non-asserted commodities ? bainclusive :: Bool, -- ^ include subaccounts when calculating the actual balance ? baposition :: GenericSourcePos -- ^ the assertion's file position, for error reporting } deriving (Eq,Generic,Show) data Posting = Posting { pdate :: Maybe Day, -- ^ this posting's date, if different from the transaction's pdate2 :: Maybe Day, -- ^ this posting's secondary date, if different from the transaction's pstatus :: Status, paccount :: AccountName, pamount :: MixedAmount, pcomment :: Text, -- ^ this posting's comment lines, as a single non-indented multi-line string ptype :: PostingType, ptags :: [Tag], -- ^ tag names and values, extracted from the comment pbalanceassertion :: Maybe BalanceAssertion, -- ^ an expected balance in the account after this posting, -- in a single commodity, excluding subaccounts. ptransaction :: Maybe Transaction, -- ^ this posting's parent transaction (co-recursive types). -- Tying this knot gets tedious, Maybe makes it easier/optional. poriginal :: Maybe Posting -- ^ When this posting has been transformed in some way -- (eg its amount or price was inferred, or the account name was -- changed by a pivot or budget report), this references the original -- untransformed posting (which will have Nothing in this field). } deriving (Generic) -- The equality test for postings ignores the parent transaction's -- identity, to avoid recurring ad infinitum. -- XXX could check that it's Just or Nothing. instance Eq Posting where (==) (Posting a1 b1 c1 d1 e1 f1 g1 h1 i1 _ _) (Posting a2 b2 c2 d2 e2 f2 g2 h2 i2 _ _) = a1==a2 && b1==b2 && c1==c2 && d1==d2 && e1==e2 && f1==f2 && g1==g2 && h1==h2 && i1==i2 -- | Posting's show instance elides the parent transaction so as not to recurse forever. instance Show Posting where show Posting{..} = "PostingPP {" ++ intercalate ", " [ "pdate=" ++ show (show pdate) ,"pdate2=" ++ show (show pdate2) ,"pstatus=" ++ show (show pstatus) ,"paccount=" ++ show paccount ,"pamount=" ++ show pamount ,"pcomment=" ++ show pcomment ,"ptype=" ++ show ptype ,"ptags=" ++ show ptags ,"pbalanceassertion=" ++ show pbalanceassertion ,"ptransaction=" ++ show (ptransaction $> "txn") ,"poriginal=" ++ show poriginal ] ++ "}" -- TODO: needs renaming, or removal if no longer needed. See also TextPosition in Hledger.UI.Editor -- | The position of parse errors (eg), like parsec's SourcePos but generic. data GenericSourcePos = GenericSourcePos FilePath Int Int -- ^ file path, 1-based line number and 1-based column number. | JournalSourcePos FilePath (Int, Int) -- ^ file path, inclusive range of 1-based line numbers (first, last). deriving (Eq, Read, Show, Ord, Generic) --{-# ANN Transaction "HLint: ignore" #-} -- Ambiguous type variable ‘p0’ arising from an annotation -- prevents the constraint ‘(Data p0)’ from being solved. -- Probable fix: use a type annotation to specify what ‘p0’ should be. data Transaction = Transaction { tindex :: Integer, -- ^ this transaction's 1-based position in the transaction stream, or 0 when not available tprecedingcomment :: Text, -- ^ any comment lines immediately preceding this transaction tsourcepos :: GenericSourcePos, -- ^ the file position where the date starts tdate :: Day, tdate2 :: Maybe Day, tstatus :: Status, tcode :: Text, tdescription :: Text, tcomment :: Text, -- ^ this transaction's comment lines, as a single non-indented multi-line string ttags :: [Tag], -- ^ tag names and values, extracted from the comment tpostings :: [Posting] -- ^ this transaction's postings } deriving (Eq,Generic,Show) -- | A transaction modifier rule. This has a query which matches postings -- in the journal, and a list of transformations to apply to those -- postings or their transactions. Currently there is one kind of transformation: -- the TMPostingRule, which adds a posting ("auto posting") to the transaction, -- optionally setting its amount to the matched posting's amount multiplied by a constant. data TransactionModifier = TransactionModifier { tmquerytxt :: Text, tmpostingrules :: [TMPostingRule] } deriving (Eq,Generic,Show) nulltransactionmodifier = TransactionModifier{ tmquerytxt = "" ,tmpostingrules = [] } -- | A transaction modifier transformation, which adds an extra posting -- to the matched posting's transaction. -- Can be like a regular posting, or the amount can have the aismultiplier flag set, -- indicating that it's a multiplier for the matched posting's amount. type TMPostingRule = Posting -- | A periodic transaction rule, describing a transaction that recurs. data PeriodicTransaction = PeriodicTransaction { ptperiodexpr :: Text, -- ^ the period expression as written ptinterval :: Interval, -- ^ the interval at which this transaction recurs ptspan :: DateSpan, -- ^ the (possibly unbounded) period during which this transaction recurs. Contains a whole number of intervals. -- ptstatus :: Status, -- ^ some of Transaction's fields ptcode :: Text, ptdescription :: Text, ptcomment :: Text, pttags :: [Tag], ptpostings :: [Posting] } deriving (Eq,Generic) -- , Show in PeriodicTransaction.hs nullperiodictransaction = PeriodicTransaction{ ptperiodexpr = "" ,ptinterval = def ,ptspan = def ,ptstatus = Unmarked ,ptcode = "" ,ptdescription = "" ,ptcomment = "" ,pttags = [] ,ptpostings = [] } data TimeclockCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord,Generic) data TimeclockEntry = TimeclockEntry { tlsourcepos :: GenericSourcePos, tlcode :: TimeclockCode, tldatetime :: LocalTime, tlaccount :: AccountName, tldescription :: Text } deriving (Eq,Ord,Generic) -- | A market price declaration made by the journal format's P directive. -- It declares two things: a historical exchange rate between two commodities, -- and an amount display style for the second commodity. data PriceDirective = PriceDirective { pddate :: Day ,pdcommodity :: CommoditySymbol ,pdamount :: Amount } deriving (Eq,Ord,Generic,Show) -- Show instance derived in Amount.hs (XXX why ?) -- | A historical market price (exchange rate) from one commodity to another. -- A more concise form of a PriceDirective, without the amount display info. data MarketPrice = MarketPrice { mpdate :: Day -- ^ Date on which this price becomes effective. ,mpfrom :: CommoditySymbol -- ^ The commodity being converted from. ,mpto :: CommoditySymbol -- ^ The commodity being converted to. ,mprate :: Quantity -- ^ One unit of the "from" commodity is worth this quantity of the "to" commodity. } deriving (Eq,Ord,Generic) -- Show instance derived in Amount.hs (XXX why ?) -- additional valuation-related types in Valuation.hs -- | A Journal, containing transactions and various other things. -- The basic data model for hledger. -- -- This is used during parsing (as the type alias ParsedJournal), and -- then finalised/validated for use as a Journal. Some extra -- parsing-related fields are included for convenience, at least for -- now. In a ParsedJournal these are updated as parsing proceeds, in a -- Journal they represent the final state at end of parsing (used eg -- by the add command). -- data Journal = Journal { -- parsing-related data jparsedefaultyear :: Maybe Year -- ^ the current default year, specified by the most recent Y directive (or current date) ,jparsedefaultcommodity :: Maybe (CommoditySymbol,AmountStyle) -- ^ the current default commodity and its format, specified by the most recent D directive ,jparseparentaccounts :: [AccountName] -- ^ the current stack of parent account names, specified by apply account directives ,jparsealiases :: [AccountAlias] -- ^ the current account name aliases in effect, specified by alias directives (& options ?) -- ,jparsetransactioncount :: Integer -- ^ the current count of transactions parsed so far (only journal format txns, currently) ,jparsetimeclockentries :: [TimeclockEntry] -- ^ timeclock sessions which have not been clocked out ,jincludefilestack :: [FilePath] -- principal data ,jdeclaredaccounts :: [(AccountName,AccountDeclarationInfo)] -- ^ Accounts declared by account directives, in parse order (after journal finalisation) ,jdeclaredaccounttypes :: M.Map AccountType [AccountName] -- ^ Accounts whose type has been declared in account directives (usually 5 top-level accounts) ,jcommodities :: M.Map CommoditySymbol Commodity -- ^ commodities and formats declared by commodity directives ,jinferredcommodities :: M.Map CommoditySymbol AmountStyle -- ^ commodities and formats inferred from journal amounts TODO misnamed, should be eg jusedstyles ,jpricedirectives :: [PriceDirective] -- ^ Declarations of market prices by P directives, in parse order (after journal finalisation) ,jinferredmarketprices :: [MarketPrice] -- ^ Market prices implied by transactions, in parse order (after journal finalisation) ,jtxnmodifiers :: [TransactionModifier] ,jperiodictxns :: [PeriodicTransaction] ,jtxns :: [Transaction] ,jfinalcommentlines :: Text -- ^ any final trailing comments in the (main) journal file ,jfiles :: [(FilePath, Text)] -- ^ the file path and raw text of the main and -- any included journal files. The main file is first, -- followed by any included files in the order encountered. ,jlastreadtime :: ClockTime -- ^ when this journal was last read from its file(s) } deriving (Eq, Generic) deriving instance Generic ClockTime -- | A journal in the process of being parsed, not yet finalised. -- The data is partial, and list fields are in reverse order. type ParsedJournal = Journal -- | The id of a data format understood by hledger, eg @journal@ or @csv@. -- The --output-format option selects one of these for output. type StorageFormat = String -- | Extra information about an account that can be derived from -- its account directive (and the other account directives). data AccountDeclarationInfo = AccountDeclarationInfo { adicomment :: Text -- ^ any comment lines following an account directive for this account ,aditags :: [Tag] -- ^ tags extracted from the account comment, if any ,adideclarationorder :: Int -- ^ the order in which this account was declared, -- relative to other account declarations, during parsing (1..) } deriving (Eq,Show,Generic) nullaccountdeclarationinfo = AccountDeclarationInfo { adicomment = "" ,aditags = [] ,adideclarationorder = 0 } -- | An account, with its balances, parent/subaccount relationships, etc. -- Only the name is required; the other fields are added when needed. data Account = Account { aname :: AccountName -- ^ this account's full name ,adeclarationinfo :: Maybe AccountDeclarationInfo -- ^ optional extra info from account directives -- relationships in the tree ,asubs :: [Account] -- ^ this account's sub-accounts ,aparent :: Maybe Account -- ^ parent account ,aboring :: Bool -- ^ used in the accounts report to label elidable parents -- balance information ,anumpostings :: Int -- ^ the number of postings to this account ,aebalance :: MixedAmount -- ^ this account's balance, excluding subaccounts ,aibalance :: MixedAmount -- ^ this account's balance, including subaccounts } deriving (Generic) -- | Whether an account's balance is normally a positive number (in -- accounting terms, a debit balance) or a negative number (credit balance). -- Assets and expenses are normally positive (debit), while liabilities, equity -- and income are normally negative (credit). -- https://en.wikipedia.org/wiki/Normal_balance data NormalSign = NormallyPositive | NormallyNegative deriving (Show, Eq) -- | A Ledger has the journal it derives from, and the accounts -- derived from that. Accounts are accessible both list-wise and -- tree-wise, since each one knows its parent and subs; the first -- account is the root of the tree and always exists. data Ledger = Ledger { ljournal :: Journal, laccounts :: [Account] } hledger-lib-1.19.1/Hledger/Data/Valuation.hs0000644000000000000000000004703113723502755016706 0ustar0000000000000000{-| Convert amounts to some related value in various ways. This involves looking up historical market prices (exchange rates) between commodities. -} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveGeneric #-} module Hledger.Data.Valuation ( ValuationType(..) ,PriceOracle ,journalPriceOracle ,unsupportedValueThenError -- ,amountApplyValuation -- ,amountValueAtDate ,mixedAmountApplyValuation ,mixedAmountValueAtDate ,marketPriceReverse ,priceDirectiveToMarketPrice -- ,priceLookup ,tests_Valuation ) where import Control.Applicative ((<|>)) import Data.Decimal (roundTo) import Data.Function ((&), on) import Data.Graph.Inductive (Gr, Node, NodeMap, mkMapGraph, mkNode, lab, out, sp) import Data.List import Data.List.Extra (nubSortBy) import qualified Data.Map as M import Data.Maybe import qualified Data.Text as T import Data.Time.Calendar (Day, fromGregorian) import Data.MemoUgly (memo) import GHC.Generics (Generic) import Safe (headMay) import Hledger.Utils import Hledger.Data.Types import Hledger.Data.Amount ------------------------------------------------------------------------------ -- Types -- | What kind of value conversion should be done on amounts ? -- CLI: --value=cost|then|end|now|DATE[,COMM] data ValuationType = AtCost (Maybe CommoditySymbol) -- ^ convert to cost commodity using transaction prices, then optionally to given commodity using market prices at posting date | AtThen (Maybe CommoditySymbol) -- ^ convert to default or given valuation commodity, using market prices at each posting's date | AtEnd (Maybe CommoditySymbol) -- ^ convert to default or given valuation commodity, using market prices at period end(s) | AtNow (Maybe CommoditySymbol) -- ^ convert to default or given valuation commodity, using current market prices | AtDate Day (Maybe CommoditySymbol) -- ^ convert to default or given valuation commodity, using market prices on some date | AtDefault (Maybe CommoditySymbol) -- ^ works like AtNow in single period reports, like AtEnd in multiperiod reports deriving (Show,Eq) -- | A snapshot of the known exchange rates between commodity pairs at a given date, -- as a graph allowing fast lookup and path finding, along with some helper data. data PriceGraph = PriceGraph { prGraph :: Gr CommoditySymbol Quantity -- ^ A directed graph of exchange rates between commodity pairs. -- Node labels are commodities and edge labels are exchange rates, -- which were either: -- declared by P directives, -- inferred from transaction prices, -- inferred by reversing a declared rate, -- or inferred by reversing a transaction-inferred rate. -- There will be at most one edge between each directed pair of commodities, -- eg there can be one USD->EUR and one EUR->USD. ,prNodemap :: NodeMap CommoditySymbol -- ^ Mapping of graph node ids to commodity symbols. ,prDefaultValuationCommodities :: M.Map CommoditySymbol CommoditySymbol -- ^ The default valuation commodity for each source commodity. -- These are used when a valuation commodity is not specified -- (-V). They are the destination commodity of the latest -- (declared or inferred, but not reverse) each -- source commodity's latest market price (on the date of this -- graph). } deriving (Show,Generic) -- | A price oracle is a magic memoising function that efficiently -- looks up market prices (exchange rates) from one commodity to -- another (or if unspecified, to a default valuation commodity) on a -- given date. type PriceOracle = (Day, CommoditySymbol, Maybe CommoditySymbol) -> Maybe (CommoditySymbol, Quantity) -- | Generate a price oracle (memoising price lookup function) from a -- journal's directive-declared and transaction-inferred market -- prices. For best performance, generate this only once per journal, -- reusing it across reports if there are more than one, as -- compoundBalanceCommand does. -- The boolean argument is whether to infer market prices from -- transactions or not. journalPriceOracle :: Bool -> Journal -> PriceOracle journalPriceOracle infer Journal{jpricedirectives, jinferredmarketprices} = let declaredprices = map priceDirectiveToMarketPrice jpricedirectives inferredprices = if infer then jinferredmarketprices else [] makepricegraph = memo $ makePriceGraph declaredprices inferredprices in memo $ uncurry3 $ priceLookup makepricegraph priceDirectiveToMarketPrice :: PriceDirective -> MarketPrice priceDirectiveToMarketPrice PriceDirective{..} = MarketPrice{ mpdate = pddate , mpfrom = pdcommodity , mpto = acommodity pdamount , mprate = aquantity pdamount } ------------------------------------------------------------------------------ -- Converting things to value -- | Apply a specified valuation to this mixed amount, using the -- provided price oracle, commodity styles, reference dates, and -- whether this is for a multiperiod report or not. -- See amountApplyValuation. mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Maybe Day -> Day -> Bool -> ValuationType -> MixedAmount -> MixedAmount mixedAmountApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod v (Mixed as) = Mixed $ map (amountApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod v) as -- | Apply a specified valuation to this amount, using the provided -- price oracle, reference dates, and whether this is for a -- multiperiod report or not. Also fix up its display style using the -- provided commodity styles. -- -- When the valuation requires converting to another commodity, a -- valuation (conversion) date is chosen based on the valuation type, -- the provided reference dates, and whether this is for a -- single-period or multi-period report. It will be one of: -- -- - a fixed date specified by the ValuationType itself -- (--value=DATE). -- -- - the provided "period end" date - this is typically the last day -- of a subperiod (--value=end with a multi-period report), or of -- the specified report period or the journal (--value=end with a -- single-period report). -- -- - the provided "report end" date - the last day of the specified -- report period, if any (-V/-X with a report end date). -- -- - the provided "today" date - (--value=now, or -V/X with no report -- end date). -- -- Note --value=then is not supported by this function, and will cause an error; -- use postingApplyValuation for that. -- -- This is all a bit complicated. See the reference doc at -- https://hledger.org/hledger.html#effect-of-valuation-on-reports -- (hledger_options.m4.md "Effect of valuation on reports"), and #1083. -- amountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Maybe Day -> Day -> Bool -> ValuationType -> Amount -> Amount amountApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod v a = case v of AtCost Nothing -> styleAmount styles $ amountCost a AtCost mc -> amountValueAtDate priceoracle styles mc periodlast $ styleAmount styles $ amountCost a AtThen _mc -> error' unsupportedValueThenError -- PARTIAL: -- amountValueAtDate priceoracle styles mc periodlast a -- posting date unknown, handle like AtEnd AtEnd mc -> amountValueAtDate priceoracle styles mc periodlast a AtNow mc -> amountValueAtDate priceoracle styles mc today a AtDefault mc | ismultiperiod -> amountValueAtDate priceoracle styles mc periodlast a AtDefault mc -> amountValueAtDate priceoracle styles mc (fromMaybe today mreportlast) a AtDate d mc -> amountValueAtDate priceoracle styles mc d a -- | Standard error message for a report not supporting --value=then. unsupportedValueThenError :: String unsupportedValueThenError = "Sorry, --value=then is not yet implemented for this kind of report." -- | Find the market value of each component amount in the given -- commodity, or its default valuation commodity, at the given -- valuation date, using the given market price oracle. -- When market prices available on that date are not sufficient to -- calculate the value, amounts are left unchanged. mixedAmountValueAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> MixedAmount -> MixedAmount mixedAmountValueAtDate priceoracle styles mc d (Mixed as) = Mixed $ map (amountValueAtDate priceoracle styles mc d) as -- | Find the market value of this amount in the given valuation -- commodity if any, otherwise the default valuation commodity, at the -- given valuation date. (The default valuation commodity is the -- commodity of the latest applicable market price before the -- valuation date.) -- -- The returned amount will have its commodity's canonical style applied, -- but with the precision adjusted to show all significant decimal digits -- up to a maximum of 8. (experimental) -- -- If the market prices available on that date are not sufficient to -- calculate this value, the amount is left unchanged. amountValueAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> Amount -> Amount amountValueAtDate priceoracle styles mto d a = case priceoracle (d, acommodity a, mto) of Nothing -> a Just (comm, rate) -> -- setNaturalPrecisionUpTo 8 $ -- XXX force higher precision in case amount appears to be zero ? -- Make default display style use precision 2 instead of 0 ? -- Leave as is for now; mentioned in manual. styleAmount styles amount{acommodity=comm, aquantity=rate * aquantity a} ------------------------------------------------------------------------------ -- Market price lookup -- | Given a memoising price graph generator, a valuation date, a -- source commodity and an optional valuation commodity, find the -- value on that date of one unit of the source commodity in the -- valuation commodity, or in a default valuation commodity. Returns -- the valuation commodity that was specified or chosen, and the -- quantity of it that one unit of the source commodity is worth. Or -- if no applicable market price can be found or calculated, or if the -- source commodity and the valuation commodity are the same, returns -- Nothing. -- -- See makePriceGraph for how prices are determined. -- Note that both market prices and default valuation commodities can -- vary with valuation date, since that determines which market prices -- are visible. -- priceLookup :: (Day -> PriceGraph) -> Day -> CommoditySymbol -> Maybe CommoditySymbol -> Maybe (CommoditySymbol, Quantity) priceLookup makepricegraph d from mto = -- trace ("priceLookup ("++show d++", "++show from++", "++show mto++")") $ let -- build a graph of the commodity exchange rates in effect on this day -- XXX should hide these fgl details better PriceGraph{prGraph=g, prNodemap=m, prDefaultValuationCommodities=defaultdests} = traceAt 1 ("valuation date: "++show d) $ makepricegraph d fromnode = node m from mto' = mto <|> mdefaultto where mdefaultto = dbg1 ("default valuation commodity for "++T.unpack from) $ M.lookup from defaultdests in case mto' of Nothing -> Nothing Just to | to==from -> Nothing Just to -> -- We have a commodity to convert to. Find the most direct price available. case mindirectprice of Nothing -> Nothing Just q -> Just (to, q) where tonode = node m to mindirectprice :: Maybe Quantity = -- Find the shortest path, if any, between from and to. case sp fromnode tonode g :: Maybe [Node] of Nothing -> Nothing Just nodes -> dbg ("market price for "++intercalate " -> " (map T.unpack comms)) $ -- TODO: it would be nice to include price date as part of the label -- in PriceGraph, so we could show the dates of market prices here Just $ product $ pathEdgeLabels g nodes -- convert to a single exchange rate where comms = catMaybes $ map (lab g) nodes -- log a message and a Maybe Quantity, hiding Just/Nothing and limiting decimal places dbg msg = dbg1With (((msg++": ")++) . maybe "" (show . roundTo 8)) tests_priceLookup = let p y m d from q to = MarketPrice{mpdate=fromGregorian y m d, mpfrom=from, mpto=to, mprate=q} ps1 = [ p 2000 01 01 "A" 10 "B" ,p 2000 01 01 "B" 10 "C" ,p 2000 01 01 "C" 10 "D" ,p 2000 01 01 "E" 2 "D" ,p 2001 01 01 "A" 11 "B" ] makepricegraph = makePriceGraph ps1 [] in test "priceLookup" $ do priceLookup makepricegraph (fromGregorian 1999 01 01) "A" Nothing @?= Nothing priceLookup makepricegraph (fromGregorian 2000 01 01) "A" Nothing @?= Just ("B",10) priceLookup makepricegraph (fromGregorian 2000 01 01) "B" (Just "A") @?= Just ("A",0.1) priceLookup makepricegraph (fromGregorian 2000 01 01) "A" (Just "E") @?= Just ("E",500) -- | Build the graph of commodity conversion prices for a given day. -- Converts a list of declared market prices in parse order, and a -- list of transaction-inferred market prices in parse order, to a -- graph of all known exchange rates between commodity pairs in effect -- on that day. Cf hledger.m4.md -> Valuation: -- -- hledger looks for a market price (exchange rate) from commodity A -- to commodity B in one or more of these ways, in this order of -- preference: -- -- 1. A *declared market price* or *inferred market price*: -- A's latest market price in B on or before the valuation date -- as declared by a P directive, or (with the `--infer-value` flag) -- inferred from transaction prices. -- -- 2. A *reverse market price*: -- the inverse of a declared or inferred market price from B to A. -- -- 3. A *chained market price*: -- a synthetic price formed by combining the shortest chain of market -- prices (any of the above types) leading from A to B. -- -- 1 and 2 form the edges of the price graph, and we can query it for -- 3 (which is the reason we use a graph). -- -- We also identify each commodity's default valuation commodity, if -- any. For each commodity A, hledger picks a default valuation -- commodity as follows, in this order of preference: -- -- 1. The price commodity from the latest declared market price for A -- on or before valuation date. -- -- 2. The price commodity from the latest declared market price for A -- on any date. (Allows conversion to proceed if there are inferred -- prices before the valuation date.) -- -- 3. If there are no P directives at all (any commodity or date), and -- the `--infer-value` flag is used, then the price commodity from -- the latest transaction price for A on or before valuation date. -- makePriceGraph :: [MarketPrice] -> [MarketPrice] -> Day -> PriceGraph makePriceGraph alldeclaredprices allinferredprices d = dbg9 ("makePriceGraph "++show d) $ PriceGraph{prGraph=g, prNodemap=m, prDefaultValuationCommodities=defaultdests} where -- prices in effect on date d, either declared or inferred visibledeclaredprices = filter ((<=d).mpdate) alldeclaredprices visibleinferredprices = filter ((<=d).mpdate) allinferredprices declaredandinferredprices = dbg2 "declaredandinferredprices" $ effectiveMarketPrices visibledeclaredprices visibleinferredprices -- infer any additional reverse prices not already declared or inferred reverseprices = dbg2 "reverseprices" $ map marketPriceReverse declaredandinferredprices \\ declaredandinferredprices -- build the graph and associated node map (g, m) = mkMapGraph (dbg9 "price graph labels" $ sort allcomms) -- this must include all nodes mentioned in edges (dbg9 "price graph edges" $ [(mpfrom, mpto, mprate) | MarketPrice{..} <- prices]) :: (Gr CommoditySymbol Quantity, NodeMap CommoditySymbol) where prices = declaredandinferredprices ++ reverseprices allcomms = map mpfrom prices -- determine a default valuation commodity for each source commodity -- somewhat but not quite like effectiveMarketPrices defaultdests = M.fromList [(mpfrom,mpto) | MarketPrice{..} <- pricesfordefaultcomms] where pricesfordefaultcomms = dbg2 "prices for choosing default valuation commodities, by date then parse order" $ ps & zip [1..] -- label items with their parse order & sortBy (compare `on` (\(parseorder,MarketPrice{..})->(mpdate,parseorder))) -- sort by increasing date then increasing parse order & map snd -- discard labels where ps | not $ null visibledeclaredprices = visibledeclaredprices | not $ null alldeclaredprices = alldeclaredprices | otherwise = visibleinferredprices -- will be null without --infer-value -- | Given a list of P-declared market prices in parse order and a -- list of transaction-inferred market prices in parse order, select -- just the latest prices that are in effect for each commodity pair. -- That is, for each commodity pair, the latest price by date then -- parse order, with declared prices having precedence over inferred -- prices on the same day. effectiveMarketPrices :: [MarketPrice] -> [MarketPrice] -> [MarketPrice] effectiveMarketPrices declaredprices inferredprices = let -- label each item with its same-day precedence, then parse order declaredprices' = [(1, i, p) | (i,p) <- zip [1..] declaredprices] inferredprices' = [(0, i, p) | (i,p) <- zip [1..] inferredprices] in -- combine declaredprices' ++ inferredprices' -- sort by decreasing date then decreasing precedence then decreasing parse order & sortBy (flip compare `on` (\(precedence,parseorder,mp)->(mpdate mp,precedence,parseorder))) -- discard the sorting labels & map third3 -- keep only the first (ie the newest, highest precedence, latest parsed) price for each pair & nubSortBy (compare `on` (\(MarketPrice{..})->(mpfrom,mpto))) marketPriceReverse :: MarketPrice -> MarketPrice marketPriceReverse mp@MarketPrice{..} = mp{mpfrom=mpto, mpto=mpfrom, mprate=1/mprate} ------------------------------------------------------------------------------ -- fgl helpers -- | Look up an existing graph node by its label. -- (If the node does not exist, a new one will be generated, but not -- persisted in the nodemap.) node :: Ord a => NodeMap a -> a -> Node node m = fst . fst . mkNode m -- | Convert a valid path within the given graph to the corresponding -- edge labels. When there are multiple edges between two nodes, the -- lowest-sorting label is used. pathEdgeLabels :: (Show b, Ord b) => Gr a b -> [Node] -> [b] pathEdgeLabels g = map frommaybe . map (nodesEdgeLabel g) . pathEdges where frommaybe = fromMaybe (error' "pathEdgeLabels: expected no Nothings here") -- PARTIAL: -- | Convert a path to node pairs representing the path's edges. pathEdges :: [Node] -> [(Node,Node)] pathEdges p = [(f,t) | f:t:_ <- tails p] -- | Get the label of a graph edge from one node to another. -- When there are multiple such edges, the lowest-sorting label is used. nodesEdgeLabel :: Ord b => Gr a b -> (Node, Node) -> Maybe b nodesEdgeLabel g (from,to) = headMay $ sort [l | (_,t,l) <- out g from, t==to] ------------------------------------------------------------------------------ tests_Valuation = tests "Valuation" [ tests_priceLookup ] hledger-lib-1.19.1/Hledger/Query.hs0000644000000000000000000011760313723502755015203 0ustar0000000000000000{-| A general query system for matching things (accounts, postings, transactions..) by various criteria, and a SimpleTextParser for query expressions. -} -- Silence safe 0.3.18's deprecation warnings for (max|min)imum(By)?Def for now -- (may hide other deprecation warnings too). https://github.com/ndmitchell/safe/issues/26 {-# OPTIONS_GHC -Wno-warnings-deprecations #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} module Hledger.Query ( -- * Query and QueryOpt Query(..), QueryOpt(..), payeeTag, noteTag, generatedTransactionTag, -- * parsing parseQuery, simplifyQuery, filterQuery, -- * accessors queryIsNull, queryIsAcct, queryIsAmt, queryIsDepth, queryIsDate, queryIsDate2, queryIsDateOrDate2, queryIsStartDateOnly, queryIsSym, queryIsReal, queryIsStatus, queryIsEmpty, queryStartDate, queryEndDate, queryDateSpan, queryDateSpan', queryDepth, inAccount, inAccountQuery, -- * matching matchesTransaction, matchesPosting, matchesAccount, matchesMixedAmount, matchesAmount, matchesCommodity, matchesTags, matchesPriceDirective, words'', prefixes, -- * tests tests_Query ) where import Control.Applicative ((<|>), many, optional) import Data.Either (partitionEithers) import Data.List (partition) import Data.Maybe (fromMaybe, isJust, mapMaybe) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif import qualified Data.Text as T import Data.Time.Calendar (Day, fromGregorian ) import Safe (readDef, readMay, maximumByMay, maximumMay, minimumMay) import Text.Megaparsec (between, noneOf, sepBy) import Text.Megaparsec.Char (char, string) import Hledger.Utils hiding (words') import Hledger.Data.Types import Hledger.Data.AccountName import Hledger.Data.Amount (nullamt, usd) import Hledger.Data.Dates import Hledger.Data.Posting import Hledger.Data.Transaction -- | A query is a composition of search criteria, which can be used to -- match postings, transactions, accounts and more. data Query = Any -- ^ always match | None -- ^ never match | Not Query -- ^ negate this match | Or [Query] -- ^ match if any of these match | And [Query] -- ^ match if all of these match | Code Regexp -- ^ match if code matches this regexp | Desc Regexp -- ^ match if description matches this regexp | Acct Regexp -- ^ match postings whose account matches this regexp | Date DateSpan -- ^ match if primary date in this date span | Date2 DateSpan -- ^ match if secondary date in this date span | StatusQ Status -- ^ match txns/postings with this status | Real Bool -- ^ match if "realness" (involves a real non-virtual account ?) has this value | Amt OrdPlus Quantity -- ^ match if the amount's numeric quantity is less than/greater than/equal to/unsignedly equal to some value | Sym Regexp -- ^ match if the entire commodity symbol is matched by this regexp | Empty Bool -- ^ if true, show zero-amount postings/accounts which are usually not shown -- more of a query option than a query criteria ? | Depth Int -- ^ match if account depth is less than or equal to this value. -- Depth is sometimes used like a query (for filtering report data) -- and sometimes like a query option (for controlling display) | Tag Regexp (Maybe Regexp) -- ^ match if a tag's name, and optionally its value, is matched by these respective regexps -- matching the regexp if provided, exists deriving (Eq,Show) -- | Construct a payee tag payeeTag :: Maybe String -> Either RegexError Query payeeTag = fmap (Tag (toRegexCI' "payee")) . maybe (pure Nothing) (fmap Just . toRegexCI) -- | Construct a note tag noteTag :: Maybe String -> Either RegexError Query noteTag = fmap (Tag (toRegexCI' "note")) . maybe (pure Nothing) (fmap Just . toRegexCI) -- | Construct a generated-transaction tag generatedTransactionTag :: Query generatedTransactionTag = Tag (toRegexCI' "generated-transaction") Nothing -- | A more expressive Ord, used for amt: queries. The Abs* variants -- compare with the absolute value of a number, ignoring sign. data OrdPlus = Lt | LtEq | Gt | GtEq | Eq | AbsLt | AbsLtEq | AbsGt | AbsGtEq | AbsEq deriving (Show,Eq) -- | A query option changes a query's/report's behaviour and output in some way. data QueryOpt = QueryOptInAcctOnly AccountName -- ^ show an account register focussed on this account | QueryOptInAcct AccountName -- ^ as above but include sub-accounts in the account register -- | QueryOptCostBasis -- ^ show amounts converted to cost where possible -- | QueryOptDate2 -- ^ show secondary dates instead of primary dates deriving (Show, Eq) -- parsing -- -- | A query restricting the account(s) to be shown in the sidebar, if any. -- -- Just looks at the first query option. -- showAccountMatcher :: [QueryOpt] -> Maybe Query -- showAccountMatcher (QueryOptInAcctSubsOnly a:_) = Just $ Acct True $ accountNameToAccountRegex a -- showAccountMatcher _ = Nothing -- | Convert a query expression containing zero or more -- space-separated terms to a query and zero or more query options; or -- return an error message if query parsing fails. -- -- A query term is either: -- -- 1. a search pattern, which matches on one or more fields, eg: -- -- acct:REGEXP - match the account name with a regular expression -- desc:REGEXP - match the transaction description -- date:PERIODEXP - match the date with a period expression -- -- The prefix indicates the field to match, or if there is no prefix -- account name is assumed. -- -- 2. a query option, which modifies the reporting behaviour in some -- way. There is currently one of these, which may appear only once: -- -- inacct:FULLACCTNAME -- -- The usual shell quoting rules are assumed. When a pattern contains -- whitespace, it (or the whole term including prefix) should be enclosed -- in single or double quotes. -- -- Period expressions may contain relative dates, so a reference date is -- required to fully parse these. -- -- Multiple terms are combined as follows: -- 1. multiple account patterns are OR'd together -- 2. multiple description patterns are OR'd together -- 3. multiple status patterns are OR'd together -- 4. then all terms are AND'd together -- -- >>> parseQuery nulldate "expenses:dining out" -- Right (Or [Acct (RegexpCI "expenses:dining"),Acct (RegexpCI "out")],[]) -- -- >>> parseQuery nulldate "\"expenses:dining out\"" -- Right (Acct (RegexpCI "expenses:dining out"),[]) parseQuery :: Day -> T.Text -> Either String (Query,[QueryOpt]) parseQuery d s = do let termstrs = words'' prefixes s eterms <- sequence $ map (parseQueryTerm d) termstrs let (pats, opts) = partitionEithers eterms (descpats, pats') = partition queryIsDesc pats (acctpats, pats'') = partition queryIsAcct pats' (statuspats, otherpats) = partition queryIsStatus pats'' q = simplifyQuery $ And $ [Or acctpats, Or descpats, Or statuspats] ++ otherpats Right (q, opts) -- XXX -- | Quote-and-prefix-aware version of words - don't split on spaces which -- are inside quotes, including quotes which may have one of the specified -- prefixes in front, and maybe an additional not: prefix in front of that. words'' :: [T.Text] -> T.Text -> [T.Text] words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX where maybeprefixedquotedphrases :: SimpleTextParser [T.Text] maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, singleQuotedPattern, doubleQuotedPattern, pattern] `sepBy` skipNonNewlineSpaces1 prefixedQuotedPattern :: SimpleTextParser T.Text prefixedQuotedPattern = do not' <- fromMaybe "" `fmap` (optional $ string "not:") let allowednexts | T.null not' = prefixes | otherwise = prefixes ++ [""] next <- choice' $ map string allowednexts let prefix :: T.Text prefix = not' <> next p <- singleQuotedPattern <|> doubleQuotedPattern return $ prefix <> stripquotes p singleQuotedPattern :: SimpleTextParser T.Text singleQuotedPattern = between (char '\'') (char '\'') (many $ noneOf ("'" :: [Char])) >>= return . stripquotes . T.pack doubleQuotedPattern :: SimpleTextParser T.Text doubleQuotedPattern = between (char '"') (char '"') (many $ noneOf ("\"" :: [Char])) >>= return . stripquotes . T.pack pattern :: SimpleTextParser T.Text pattern = fmap T.pack $ many (noneOf (" \n\r" :: [Char])) -- XXX -- keep synced with patterns below, excluding "not" prefixes :: [T.Text] prefixes = map (<>":") [ "inacctonly" ,"inacct" ,"amt" ,"code" ,"desc" ,"payee" ,"note" ,"acct" ,"date" ,"date2" ,"status" ,"cur" ,"real" ,"empty" ,"depth" ,"tag" ] defaultprefix :: T.Text defaultprefix = "acct" -- -- | Parse the query string as a boolean tree of match patterns. -- parseQueryTerm :: String -> Query -- parseQueryTerm s = either (const (Any)) id $ runParser query () "" $ lexmatcher s -- lexmatcher :: String -> [String] -- lexmatcher s = words' s -- query :: GenParser String () Query -- query = undefined -- | Parse a single query term as either a query or a query option, -- or return an error message if parsing fails. parseQueryTerm :: Day -> T.Text -> Either String (Either Query QueryOpt) parseQueryTerm _ (T.stripPrefix "inacctonly:" -> Just s) = Right $ Right $ QueryOptInAcctOnly s parseQueryTerm _ (T.stripPrefix "inacct:" -> Just s) = Right $ Right $ QueryOptInAcct s parseQueryTerm d (T.stripPrefix "not:" -> Just s) = case parseQueryTerm d s of Right (Left m) -> Right $ Left $ Not m Right (Right _) -> Right $ Left Any -- not:somequeryoption will be ignored Left err -> Left err parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Left . Code <$> toRegexCI (T.unpack s) parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Left . Desc <$> toRegexCI (T.unpack s) parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Left <$> payeeTag (Just $ T.unpack s) parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Left <$> noteTag (Just $ T.unpack s) parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left . Acct <$> toRegexCI (T.unpack s) parseQueryTerm d (T.stripPrefix "date2:" -> Just s) = case parsePeriodExpr d s of Left e -> Left $ "\"date2:"++T.unpack s++"\" gave a "++showDateParseError e Right (_,span) -> Right $ Left $ Date2 span parseQueryTerm d (T.stripPrefix "date:" -> Just s) = case parsePeriodExpr d s of Left e -> Left $ "\"date:"++T.unpack s++"\" gave a "++showDateParseError e Right (_,span) -> Right $ Left $ Date span parseQueryTerm _ (T.stripPrefix "status:" -> Just s) = case parseStatus s of Left e -> Left $ "\"status:"++T.unpack s++"\" gave a parse error: " ++ e Right st -> Right $ Left $ StatusQ st parseQueryTerm _ (T.stripPrefix "real:" -> Just s) = Right $ Left $ Real $ parseBool s || T.null s parseQueryTerm _ (T.stripPrefix "amt:" -> Just s) = Right $ Left $ Amt ord q where (ord, q) = either error id $ parseAmountQueryTerm s -- PARTIAL: parseQueryTerm _ (T.stripPrefix "empty:" -> Just s) = Right $ Left $ Empty $ parseBool s parseQueryTerm _ (T.stripPrefix "depth:" -> Just s) | n >= 0 = Right $ Left $ Depth n | otherwise = Left "depth: should have a positive number" where n = readDef 0 (T.unpack s) parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Left . Sym <$> toRegexCI ('^' : T.unpack s ++ "$") -- support cur: as an alias parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = Left <$> parseTag s parseQueryTerm _ "" = Right $ Left $ Any parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s -- | Parse the argument of an amt query term ([OP][SIGN]NUM), to an -- OrdPlus and a Quantity, or if parsing fails, an error message. OP -- can be <=, <, >=, >, or = . NUM can be a simple integer or decimal. -- If a decimal, the decimal mark must be period, and it must have -- digits preceding it. Digit group marks are not allowed. parseAmountQueryTerm :: T.Text -> Either String (OrdPlus, Quantity) parseAmountQueryTerm amtarg = case amtarg of -- number has a + sign, do a signed comparison (parse "<=+" -> Just q) -> Right (LtEq ,q) (parse "<+" -> Just q) -> Right (Lt ,q) (parse ">=+" -> Just q) -> Right (GtEq ,q) (parse ">+" -> Just q) -> Right (Gt ,q) (parse "=+" -> Just q) -> Right (Eq ,q) (parse "+" -> Just q) -> Right (Eq ,q) -- number has a - sign, do a signed comparison (parse "<-" -> Just q) -> Right (Lt ,-q) (parse "<=-" -> Just q) -> Right (LtEq ,-q) (parse ">-" -> Just q) -> Right (Gt ,-q) (parse ">=-" -> Just q) -> Right (GtEq ,-q) (parse "=-" -> Just q) -> Right (Eq ,-q) (parse "-" -> Just q) -> Right (Eq ,-q) -- number is unsigned and zero, do a signed comparison (more useful) (parse "<=" -> Just 0) -> Right (LtEq ,0) (parse "<" -> Just 0) -> Right (Lt ,0) (parse ">=" -> Just 0) -> Right (GtEq ,0) (parse ">" -> Just 0) -> Right (Gt ,0) -- number is unsigned and non-zero, do an absolute magnitude comparison (parse "<=" -> Just q) -> Right (AbsLtEq ,q) (parse "<" -> Just q) -> Right (AbsLt ,q) (parse ">=" -> Just q) -> Right (AbsGtEq ,q) (parse ">" -> Just q) -> Right (AbsGt ,q) (parse "=" -> Just q) -> Right (AbsEq ,q) (parse "" -> Just q) -> Right (AbsEq ,q) _ -> Left $ "could not parse as a comparison operator followed by an optionally-signed number: " ++ T.unpack amtarg where -- Strip outer whitespace from the text, require and remove the -- specified prefix, remove all whitespace from the remainder, and -- read it as a simple integer or decimal if possible. parse :: T.Text -> T.Text -> Maybe Quantity parse p s = (T.stripPrefix p . T.strip) s >>= readMay . filter (not.(==' ')) . T.unpack parseTag :: T.Text -> Either RegexError Query parseTag s = do tag <- toRegexCI . T.unpack $ if T.null v then s else n body <- if T.null v then pure Nothing else Just <$> toRegexCI (tail $ T.unpack v) return $ Tag tag body where (n,v) = T.break (=='=') s -- | Parse the value part of a "status:" query, or return an error. parseStatus :: T.Text -> Either String Status parseStatus s | s `elem` ["*","1"] = Right Cleared | s `elem` ["!"] = Right Pending | s `elem` ["","0"] = Right Unmarked | otherwise = Left $ "could not parse "++show s++" as a status (should be *, ! or empty)" -- | Parse the boolean value part of a "status:" query. "1" means true, -- anything else will be parsed as false without error. parseBool :: T.Text -> Bool parseBool s = s `elem` truestrings truestrings :: [T.Text] truestrings = ["1"] simplifyQuery :: Query -> Query simplifyQuery q = let q' = simplify q in if q' == q then q else simplifyQuery q' where simplify (And []) = Any simplify (And [q]) = simplify q simplify (And qs) | same qs = simplify $ head qs | any (==None) qs = None | all queryIsDate qs = Date $ spansIntersect $ mapMaybe queryTermDateSpan qs | otherwise = And $ concat $ [map simplify dateqs, map simplify otherqs] where (dateqs, otherqs) = partition queryIsDate $ filter (/=Any) qs simplify (Or []) = Any simplify (Or [q]) = simplifyQuery q simplify (Or qs) | same qs = simplify $ head qs | any (==Any) qs = Any -- all queryIsDate qs = Date $ spansUnion $ mapMaybe queryTermDateSpan qs ? | otherwise = Or $ map simplify $ filter (/=None) qs simplify (Date (DateSpan Nothing Nothing)) = Any simplify (Date2 (DateSpan Nothing Nothing)) = Any simplify q = q same [] = True same (a:as) = all (a==) as -- | Remove query terms (or whole sub-expressions) not matching the given -- predicate from this query. XXX Semantics not completely clear. filterQuery :: (Query -> Bool) -> Query -> Query filterQuery p = simplifyQuery . filterQuery' p filterQuery' :: (Query -> Bool) -> Query -> Query filterQuery' p (And qs) = And $ map (filterQuery p) qs filterQuery' p (Or qs) = Or $ map (filterQuery p) qs -- filterQuery' p (Not q) = Not $ filterQuery p q filterQuery' p q = if p q then q else Any -- * accessors -- | Does this query match everything ? queryIsNull :: Query -> Bool queryIsNull Any = True queryIsNull (And []) = True queryIsNull (Not (Or [])) = True queryIsNull _ = False queryIsDepth :: Query -> Bool queryIsDepth (Depth _) = True queryIsDepth _ = False queryIsDate :: Query -> Bool queryIsDate (Date _) = True queryIsDate _ = False queryIsDate2 :: Query -> Bool queryIsDate2 (Date2 _) = True queryIsDate2 _ = False queryIsDateOrDate2 :: Query -> Bool queryIsDateOrDate2 (Date _) = True queryIsDateOrDate2 (Date2 _) = True queryIsDateOrDate2 _ = False queryIsDesc :: Query -> Bool queryIsDesc (Desc _) = True queryIsDesc _ = False queryIsAcct :: Query -> Bool queryIsAcct (Acct _) = True queryIsAcct _ = False queryIsAmt :: Query -> Bool queryIsAmt (Amt _ _) = True queryIsAmt _ = False queryIsSym :: Query -> Bool queryIsSym (Sym _) = True queryIsSym _ = False queryIsReal :: Query -> Bool queryIsReal (Real _) = True queryIsReal _ = False queryIsStatus :: Query -> Bool queryIsStatus (StatusQ _) = True queryIsStatus _ = False queryIsEmpty :: Query -> Bool queryIsEmpty (Empty _) = True queryIsEmpty _ = False -- | Does this query specify a start date and nothing else (that would -- filter postings prior to the date) ? -- When the flag is true, look for a starting secondary date instead. queryIsStartDateOnly :: Bool -> Query -> Bool queryIsStartDateOnly _ Any = False queryIsStartDateOnly _ None = False queryIsStartDateOnly secondary (Or ms) = and $ map (queryIsStartDateOnly secondary) ms queryIsStartDateOnly secondary (And ms) = and $ map (queryIsStartDateOnly secondary) ms queryIsStartDateOnly False (Date (DateSpan (Just _) _)) = True queryIsStartDateOnly True (Date2 (DateSpan (Just _) _)) = True queryIsStartDateOnly _ _ = False -- | What start date (or secondary date) does this query specify, if any ? -- For OR expressions, use the earliest of the dates. NOT is ignored. queryStartDate :: Bool -> Query -> Maybe Day queryStartDate secondary (Or ms) = earliestMaybeDate $ map (queryStartDate secondary) ms queryStartDate secondary (And ms) = latestMaybeDate $ map (queryStartDate secondary) ms queryStartDate False (Date (DateSpan (Just d) _)) = Just d queryStartDate True (Date2 (DateSpan (Just d) _)) = Just d queryStartDate _ _ = Nothing -- | What end date (or secondary date) does this query specify, if any ? -- For OR expressions, use the latest of the dates. NOT is ignored. queryEndDate :: Bool -> Query -> Maybe Day queryEndDate secondary (Or ms) = latestMaybeDate' $ map (queryEndDate secondary) ms queryEndDate secondary (And ms) = earliestMaybeDate' $ map (queryEndDate secondary) ms queryEndDate False (Date (DateSpan _ (Just d))) = Just d queryEndDate True (Date2 (DateSpan _ (Just d))) = Just d queryEndDate _ _ = Nothing queryTermDateSpan (Date span) = Just span queryTermDateSpan _ = Nothing -- | What date span (or with a true argument, what secondary date span) does this query specify ? -- OR clauses specifying multiple spans return their union (the span enclosing all of them). -- AND clauses specifying multiple spans return their intersection. -- NOT clauses are ignored. queryDateSpan :: Bool -> Query -> DateSpan queryDateSpan secondary (Or qs) = spansUnion $ map (queryDateSpan secondary) qs queryDateSpan secondary (And qs) = spansIntersect $ map (queryDateSpan secondary) qs queryDateSpan False (Date span) = span queryDateSpan True (Date2 span) = span queryDateSpan _ _ = nulldatespan -- | What date span does this query specify, treating primary and secondary dates as equivalent ? -- OR clauses specifying multiple spans return their union (the span enclosing all of them). -- AND clauses specifying multiple spans return their intersection. -- NOT clauses are ignored. queryDateSpan' :: Query -> DateSpan queryDateSpan' (Or qs) = spansUnion $ map queryDateSpan' qs queryDateSpan' (And qs) = spansIntersect $ map queryDateSpan' qs queryDateSpan' (Date span) = span queryDateSpan' (Date2 span) = span queryDateSpan' _ = nulldatespan -- | What is the earliest of these dates, where Nothing is earliest ? earliestMaybeDate :: [Maybe Day] -> Maybe Day earliestMaybeDate = fromMaybe Nothing . minimumMay -- | What is the latest of these dates, where Nothing is earliest ? latestMaybeDate :: [Maybe Day] -> Maybe Day latestMaybeDate = fromMaybe Nothing . maximumMay -- | What is the earliest of these dates, where Nothing is the latest ? earliestMaybeDate' :: [Maybe Day] -> Maybe Day earliestMaybeDate' = fromMaybe Nothing . minimumMay . filter isJust -- | What is the latest of these dates, where Nothing is the latest ? latestMaybeDate' :: [Maybe Day] -> Maybe Day latestMaybeDate' = fromMaybe Nothing . maximumByMay compareNothingMax where compareNothingMax Nothing Nothing = EQ compareNothingMax (Just _) Nothing = LT compareNothingMax Nothing (Just _) = GT compareNothingMax (Just a) (Just b) = compare a b -- | The depth limit this query specifies, if it has one queryDepth :: Query -> Maybe Int queryDepth = minimumMay . queryDepth' where queryDepth' (Depth d) = [d] queryDepth' (Or qs) = concatMap queryDepth' qs queryDepth' (And qs) = concatMap queryDepth' qs queryDepth' _ = [] -- | The account we are currently focussed on, if any, and whether subaccounts are included. -- Just looks at the first query option. inAccount :: [QueryOpt] -> Maybe (AccountName,Bool) inAccount [] = Nothing inAccount (QueryOptInAcctOnly a:_) = Just (a,False) inAccount (QueryOptInAcct a:_) = Just (a,True) -- | A query for the account(s) we are currently focussed on, if any. -- Just looks at the first query option. inAccountQuery :: [QueryOpt] -> Maybe Query inAccountQuery [] = Nothing inAccountQuery (QueryOptInAcctOnly a : _) = Just . Acct $ accountNameToAccountOnlyRegex a inAccountQuery (QueryOptInAcct a : _) = Just . Acct $ accountNameToAccountRegex a -- -- | Convert a query to its inverse. -- negateQuery :: Query -> Query -- negateQuery = Not -- matching -- | Does the match expression match this account ? -- A matching in: clause is also considered a match. -- When matching by account name pattern, if there's a regular -- expression error, this function calls error. matchesAccount :: Query -> AccountName -> Bool matchesAccount (None) _ = False matchesAccount (Not m) a = not $ matchesAccount m a matchesAccount (Or ms) a = any (`matchesAccount` a) ms matchesAccount (And ms) a = all (`matchesAccount` a) ms matchesAccount (Acct r) a = regexMatch r $ T.unpack a -- XXX pack matchesAccount (Depth d) a = accountNameLevel a <= d matchesAccount (Tag _ _) _ = False matchesAccount _ _ = True matchesMixedAmount :: Query -> MixedAmount -> Bool matchesMixedAmount q (Mixed []) = q `matchesAmount` nullamt matchesMixedAmount q (Mixed as) = any (q `matchesAmount`) as matchesCommodity :: Query -> CommoditySymbol -> Bool matchesCommodity (Sym r) = regexMatch r . T.unpack matchesCommodity _ = const True -- | Does the match expression match this (simple) amount ? matchesAmount :: Query -> Amount -> Bool matchesAmount (Not q) a = not $ q `matchesAmount` a matchesAmount (Any) _ = True matchesAmount (None) _ = False matchesAmount (Or qs) a = any (`matchesAmount` a) qs matchesAmount (And qs) a = all (`matchesAmount` a) qs matchesAmount (Amt ord n) a = compareAmount ord n a matchesAmount (Sym r) a = matchesCommodity (Sym r) (acommodity a) matchesAmount _ _ = True -- | Is this simple (single-amount) mixed amount's quantity less than, greater than, equal to, or unsignedly equal to this number ? -- For multi-amount (multiple commodities, or just unsimplified) mixed amounts this is always true. -- | Is this amount's quantity less than, greater than, equal to, or unsignedly equal to this number ? compareAmount :: OrdPlus -> Quantity -> Amount -> Bool compareAmount ord q Amount{aquantity=aq} = case ord of Lt -> aq < q LtEq -> aq <= q Gt -> aq > q GtEq -> aq >= q Eq -> aq == q AbsLt -> abs aq < abs q AbsLtEq -> abs aq <= abs q AbsGt -> abs aq > abs q AbsGtEq -> abs aq >= abs q AbsEq -> abs aq == abs q -- | Does the match expression match this posting ? -- -- Note that for account match we try both original and effective account matchesPosting :: Query -> Posting -> Bool matchesPosting (Not q) p = not $ q `matchesPosting` p matchesPosting (Any) _ = True matchesPosting (None) _ = False matchesPosting (Or qs) p = any (`matchesPosting` p) qs matchesPosting (And qs) p = all (`matchesPosting` p) qs matchesPosting (Code r) p = regexMatch r $ maybe "" (T.unpack . tcode) $ ptransaction p matchesPosting (Desc r) p = regexMatch r $ maybe "" (T.unpack . tdescription) $ ptransaction p matchesPosting (Acct r) p = matches p || matches (originalPosting p) where matches p = regexMatch r . T.unpack $ paccount p -- XXX pack matchesPosting (Date span) p = span `spanContainsDate` postingDate p matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p matchesPosting (StatusQ s) p = postingStatus p == s matchesPosting (Real v) p = v == isReal p matchesPosting q@(Depth _) Posting{paccount=a} = q `matchesAccount` a matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt -- matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt -- matchesPosting (Empty v) Posting{pamount=a} = v == mixedAmountLooksZero a -- matchesPosting (Empty False) Posting{pamount=a} = True -- matchesPosting (Empty True) Posting{pamount=a} = mixedAmountLooksZero a matchesPosting (Empty _) _ = True matchesPosting (Sym r) Posting{pamount=Mixed as} = any (matchesCommodity (Sym r)) $ map acommodity as matchesPosting (Tag n v) p = case (reString n, v) of ("payee", Just v) -> maybe False (regexMatch v . T.unpack . transactionPayee) $ ptransaction p ("note", Just v) -> maybe False (regexMatch v . T.unpack . transactionNote) $ ptransaction p (_, v) -> matchesTags n v $ postingAllTags p -- | Does the match expression match this transaction ? matchesTransaction :: Query -> Transaction -> Bool matchesTransaction (Not q) t = not $ q `matchesTransaction` t matchesTransaction (Any) _ = True matchesTransaction (None) _ = False matchesTransaction (Or qs) t = any (`matchesTransaction` t) qs matchesTransaction (And qs) t = all (`matchesTransaction` t) qs matchesTransaction (Code r) t = regexMatch r $ T.unpack $ tcode t matchesTransaction (Desc r) t = regexMatch r $ T.unpack $ tdescription t matchesTransaction q@(Acct _) t = any (q `matchesPosting`) $ tpostings t matchesTransaction (Date span) t = spanContainsDate span $ tdate t matchesTransaction (Date2 span) t = spanContainsDate span $ transactionDate2 t matchesTransaction (StatusQ s) t = tstatus t == s matchesTransaction (Real v) t = v == hasRealPostings t matchesTransaction q@(Amt _ _) t = any (q `matchesPosting`) $ tpostings t matchesTransaction (Empty _) _ = True matchesTransaction (Depth d) t = any (Depth d `matchesPosting`) $ tpostings t matchesTransaction q@(Sym _) t = any (q `matchesPosting`) $ tpostings t matchesTransaction (Tag n v) t = case (reString n, v) of ("payee", Just v) -> regexMatch v . T.unpack . transactionPayee $ t ("note", Just v) -> regexMatch v . T.unpack . transactionNote $ t (_, v) -> matchesTags n v $ transactionAllTags t -- | Does the query match the name and optionally the value of any of these tags ? matchesTags :: Regexp -> Maybe Regexp -> [Tag] -> Bool matchesTags namepat valuepat = not . null . filter (matches namepat valuepat) where matches npat vpat (n,v) = regexMatch npat (T.unpack n) && maybe (const True) regexMatch vpat (T.unpack v) -- | Does the query match this market price ? matchesPriceDirective :: Query -> PriceDirective -> Bool matchesPriceDirective (None) _ = False matchesPriceDirective (Not q) p = not $ matchesPriceDirective q p matchesPriceDirective (Or qs) p = any (`matchesPriceDirective` p) qs matchesPriceDirective (And qs) p = all (`matchesPriceDirective` p) qs matchesPriceDirective q@(Amt _ _) p = matchesAmount q (pdamount p) matchesPriceDirective q@(Sym _) p = matchesCommodity q (pdcommodity p) matchesPriceDirective (Date span) p = spanContainsDate span (pddate p) matchesPriceDirective _ _ = True -- tests tests_Query = tests "Query" [ test "simplifyQuery" $ do (simplifyQuery $ Or [Acct $ toRegex' "a"]) @?= (Acct $ toRegex' "a") (simplifyQuery $ Or [Any,None]) @?= (Any) (simplifyQuery $ And [Any,None]) @?= (None) (simplifyQuery $ And [Any,Any]) @?= (Any) (simplifyQuery $ And [Acct $ toRegex' "b",Any]) @?= (Acct $ toRegex' "b") (simplifyQuery $ And [Any,And [Date (DateSpan Nothing Nothing)]]) @?= (Any) (simplifyQuery $ And [Date (DateSpan Nothing (Just $ fromGregorian 2013 01 01)), Date (DateSpan (Just $ fromGregorian 2012 01 01) Nothing)]) @?= (Date (DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01))) (simplifyQuery $ And [Or [],Or [Desc $ toRegex' "b b"]]) @?= (Desc $ toRegex' "b b") ,test "parseQuery" $ do (parseQuery nulldate "acct:'expenses:autres d\233penses' desc:b") @?= Right (And [Acct $ toRegexCI' "expenses:autres d\233penses", Desc $ toRegexCI' "b"], []) parseQuery nulldate "inacct:a desc:\"b b\"" @?= Right (Desc $ toRegexCI' "b b", [QueryOptInAcct "a"]) parseQuery nulldate "inacct:a inacct:b" @?= Right (Any, [QueryOptInAcct "a", QueryOptInAcct "b"]) parseQuery nulldate "desc:'x x'" @?= Right (Desc $ toRegexCI' "x x", []) parseQuery nulldate "'a a' 'b" @?= Right (Or [Acct $ toRegexCI' "a a",Acct $ toRegexCI' "'b"], []) parseQuery nulldate "\"" @?= Right (Acct $ toRegexCI' "\"", []) ,test "words''" $ do (words'' [] "a b") @?= ["a","b"] (words'' [] "'a b'") @?= ["a b"] (words'' [] "not:a b") @?= ["not:a","b"] (words'' [] "not:'a b'") @?= ["not:a b"] (words'' [] "'not:a b'") @?= ["not:a b"] (words'' ["desc:"] "not:desc:'a b'") @?= ["not:desc:a b"] (words'' prefixes "\"acct:expenses:autres d\233penses\"") @?= ["acct:expenses:autres d\233penses"] (words'' prefixes "\"") @?= ["\""] ,test "filterQuery" $ do filterQuery queryIsDepth Any @?= Any filterQuery queryIsDepth (Depth 1) @?= Depth 1 filterQuery (not.queryIsDepth) (And [And [StatusQ Cleared,Depth 1]]) @?= StatusQ Cleared filterQuery queryIsDepth (And [Date nulldatespan, Not (Or [Any, Depth 1])]) @?= Any -- XXX unclear ,test "parseQueryTerm" $ do parseQueryTerm nulldate "a" @?= Right (Left $ Acct $ toRegexCI' "a") parseQueryTerm nulldate "acct:expenses:autres d\233penses" @?= Right (Left $ Acct $ toRegexCI' "expenses:autres d\233penses") parseQueryTerm nulldate "not:desc:a b" @?= Right (Left $ Not $ Desc $ toRegexCI' "a b") parseQueryTerm nulldate "status:1" @?= Right (Left $ StatusQ Cleared) parseQueryTerm nulldate "status:*" @?= Right (Left $ StatusQ Cleared) parseQueryTerm nulldate "status:!" @?= Right (Left $ StatusQ Pending) parseQueryTerm nulldate "status:0" @?= Right (Left $ StatusQ Unmarked) parseQueryTerm nulldate "status:" @?= Right (Left $ StatusQ Unmarked) parseQueryTerm nulldate "payee:x" @?= Left <$> payeeTag (Just "x") parseQueryTerm nulldate "note:x" @?= Left <$> noteTag (Just "x") parseQueryTerm nulldate "real:1" @?= Right (Left $ Real True) parseQueryTerm nulldate "date:2008" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2008 01 01) (Just $ fromGregorian 2009 01 01)) parseQueryTerm nulldate "date:from 2012/5/17" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2012 05 17) Nothing) parseQueryTerm nulldate "date:20180101-201804" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 04 01)) parseQueryTerm nulldate "inacct:a" @?= Right (Right $ QueryOptInAcct "a") parseQueryTerm nulldate "tag:a" @?= Right (Left $ Tag (toRegexCI' "a") Nothing) parseQueryTerm nulldate "tag:a=some value" @?= Right (Left $ Tag (toRegexCI' "a") (Just $ toRegexCI' "some value")) parseQueryTerm nulldate "amt:<0" @?= Right (Left $ Amt Lt 0) parseQueryTerm nulldate "amt:>10000.10" @?= Right (Left $ Amt AbsGt 10000.1) ,test "parseAmountQueryTerm" $ do parseAmountQueryTerm "<0" @?= Right (Lt,0) -- special case for convenience, since AbsLt 0 would be always false parseAmountQueryTerm ">0" @?= Right (Gt,0) -- special case for convenience and consistency with above parseAmountQueryTerm " > - 0 " @?= Right (Gt,0) -- accept whitespace around the argument parts parseAmountQueryTerm ">10000.10" @?= Right (AbsGt,10000.1) parseAmountQueryTerm "=0.23" @?= Right (AbsEq,0.23) parseAmountQueryTerm "0.23" @?= Right (AbsEq,0.23) parseAmountQueryTerm "<=+0.23" @?= Right (LtEq,0.23) parseAmountQueryTerm "-0.23" @?= Right (Eq,(-0.23)) assertLeft $ parseAmountQueryTerm "-0,23" assertLeft $ parseAmountQueryTerm "=.23" ,test "queryStartDate" $ do let small = Just $ fromGregorian 2000 01 01 big = Just $ fromGregorian 2000 01 02 queryStartDate False (And [Date $ DateSpan small Nothing, Date $ DateSpan big Nothing]) @?= big queryStartDate False (And [Date $ DateSpan small Nothing, Date $ DateSpan Nothing Nothing]) @?= small queryStartDate False (Or [Date $ DateSpan small Nothing, Date $ DateSpan big Nothing]) @?= small queryStartDate False (Or [Date $ DateSpan small Nothing, Date $ DateSpan Nothing Nothing]) @?= Nothing ,test "queryEndDate" $ do let small = Just $ fromGregorian 2000 01 01 big = Just $ fromGregorian 2000 01 02 queryEndDate False (And [Date $ DateSpan Nothing small, Date $ DateSpan Nothing big]) @?= small queryEndDate False (And [Date $ DateSpan Nothing small, Date $ DateSpan Nothing Nothing]) @?= small queryEndDate False (Or [Date $ DateSpan Nothing small, Date $ DateSpan Nothing big]) @?= big queryEndDate False (Or [Date $ DateSpan Nothing small, Date $ DateSpan Nothing Nothing]) @?= Nothing ,test "matchesAccount" $ do assertBool "" $ (Acct $ toRegex' "b:c") `matchesAccount` "a:bb:c:d" assertBool "" $ not $ (Acct $ toRegex' "^a:b") `matchesAccount` "c:a:b" assertBool "" $ Depth 2 `matchesAccount` "a" assertBool "" $ Depth 2 `matchesAccount` "a:b" assertBool "" $ not $ Depth 2 `matchesAccount` "a:b:c" assertBool "" $ Date nulldatespan `matchesAccount` "a" assertBool "" $ Date2 nulldatespan `matchesAccount` "a" assertBool "" $ not $ Tag (toRegex' "a") Nothing `matchesAccount` "a" ,tests "matchesPosting" [ test "positive match on cleared posting status" $ assertBool "" $ (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared} ,test "negative match on cleared posting status" $ assertBool "" $ not $ (Not $ StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared} ,test "positive match on unmarked posting status" $ assertBool "" $ (StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked} ,test "negative match on unmarked posting status" $ assertBool "" $ not $ (Not $ StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked} ,test "positive match on true posting status acquired from transaction" $ assertBool "" $ (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Unmarked,ptransaction=Just nulltransaction{tstatus=Cleared}} ,test "real:1 on real posting" $ assertBool "" $ (Real True) `matchesPosting` nullposting{ptype=RegularPosting} ,test "real:1 on virtual posting fails" $ assertBool "" $ not $ (Real True) `matchesPosting` nullposting{ptype=VirtualPosting} ,test "real:1 on balanced virtual posting fails" $ assertBool "" $ not $ (Real True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting} ,test "acct:" $ assertBool "" $ (Acct $ toRegex' "'b") `matchesPosting` nullposting{paccount="'b"} ,test "tag:" $ do assertBool "" $ not $ (Tag (toRegex' "a") (Just $ toRegex' "r$")) `matchesPosting` nullposting assertBool "" $ (Tag (toRegex' "foo") Nothing) `matchesPosting` nullposting{ptags=[("foo","")]} assertBool "" $ (Tag (toRegex' "foo") Nothing) `matchesPosting` nullposting{ptags=[("foo","baz")]} assertBool "" $ (Tag (toRegex' "foo") (Just $ toRegex' "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]} assertBool "" $ not $ (Tag (toRegex' "foo") (Just $ toRegex' "a$")) `matchesPosting` nullposting{ptags=[("foo","bar")]} assertBool "" $ not $ (Tag (toRegex' " foo ") (Just $ toRegex' "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]} assertBool "" $ not $ (Tag (toRegex' "foo foo") (Just $ toRegex' " ar ba ")) `matchesPosting` nullposting{ptags=[("foo foo","bar bar")]} ,test "a tag match on a posting also sees inherited tags" $ assertBool "" $ (Tag (toRegex' "txntag") Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}} ,test "cur:" $ do let toSym = either id (const $ error' "No query opts") . either error' id . parseQueryTerm (fromGregorian 2000 01 01) . ("cur:"<>) assertBool "" $ not $ toSym "$" `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- becomes "^$$", ie testing for null symbol assertBool "" $ (toSym "\\$") `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- have to quote $ for regexpr assertBool "" $ (toSym "shekels") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]} assertBool "" $ not $ (toSym "shek") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]} ] ,test "matchesTransaction" $ do assertBool "" $ Any `matchesTransaction` nulltransaction assertBool "" $ not $ (Desc $ toRegex' "x x") `matchesTransaction` nulltransaction{tdescription="x"} assertBool "" $ (Desc $ toRegex' "x x") `matchesTransaction` nulltransaction{tdescription="x x"} -- see posting for more tag tests assertBool "" $ (Tag (toRegex' "foo") (Just $ toRegex' "a")) `matchesTransaction` nulltransaction{ttags=[("foo","bar")]} assertBool "" $ (Tag (toRegex' "payee") (Just $ toRegex' "payee")) `matchesTransaction` nulltransaction{tdescription="payee|note"} assertBool "" $ (Tag (toRegex' "note") (Just $ toRegex' "note")) `matchesTransaction` nulltransaction{tdescription="payee|note"} -- a tag match on a transaction also matches posting tags assertBool "" $ (Tag (toRegex' "postingtag") Nothing) `matchesTransaction` nulltransaction{tpostings=[nullposting{ptags=[("postingtag","")]}]} ] hledger-lib-1.19.1/Hledger/Read.hs0000644000000000000000000002610413723300774014741 0ustar0000000000000000--- * -*- outline-regexp:"--- \\*"; -*- --- ** doc -- In Emacs, use TAB on lines beginning with "-- *" to collapse/expand sections. {-| This is the entry point to hledger's reading system, which can read Journals from various data formats. Use this module if you want to parse journal data or read journal files. Generally it should not be necessary to import modules below this one. -} --- ** language {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} --- ** exports module Hledger.Read ( -- * Journal files PrefixedFilePath, defaultJournal, defaultJournalPath, readJournalFiles, readJournalFile, requireJournalFileExists, ensureJournalFileExists, -- * Journal parsing readJournal, readJournal', -- * Re-exported JournalReader.accountaliasp, JournalReader.postingp, findReader, splitReaderPrefix, module Hledger.Read.Common, -- * Tests tests_Read, ) where --- ** imports import Control.Arrow (right) import qualified Control.Exception as C import Control.Monad (when) import "mtl" Control.Monad.Except (runExceptT) import Data.Default (def) import Data.Foldable (asum) import Data.List (group, sort, sortBy) import Data.List.NonEmpty (nonEmpty) import Data.Maybe (fromMaybe) import Data.Ord (comparing) import Data.Semigroup (sconcat) import Data.Text (Text) import qualified Data.Text as T import Data.Time (Day) import Safe (headDef) import System.Directory (doesFileExist, getHomeDirectory) import System.Environment (getEnv) import System.Exit (exitFailure) import System.FilePath ((<.>), (), splitDirectories, splitFileName) import System.Info (os) import System.IO (stderr, writeFile) import Text.Printf (hPrintf, printf) import Hledger.Data.Dates (getCurrentDay, parsedateM, showDate) import Hledger.Data.Types import Hledger.Read.Common import Hledger.Read.JournalReader as JournalReader import Hledger.Read.CsvReader (tests_CsvReader) -- import Hledger.Read.TimedotReader (tests_TimedotReader) -- import Hledger.Read.TimeclockReader (tests_TimeclockReader) import Hledger.Utils import Prelude hiding (getContents, writeFile) --- ** doctest setup -- $setup -- >>> :set -XOverloadedStrings --- ** journal reading journalEnvVar = "LEDGER_FILE" journalEnvVar2 = "LEDGER" journalDefaultFilename = ".hledger.journal" -- | Read a Journal from the given text, assuming journal format; or -- throw an error. readJournal' :: Text -> IO Journal readJournal' t = readJournal def Nothing t >>= either error' return -- PARTIAL: -- | @readJournal iopts mfile txt@ -- -- Read a Journal from some text, or return an error message. -- -- The reader (data format) is chosen based on, in this order: -- -- - a reader name provided in @iopts@ -- -- - a reader prefix in the @mfile@ path -- -- - a file extension in @mfile@ -- -- If none of these is available, or if the reader name is unrecognised, -- we use the journal reader. (We used to try all readers in this case; -- since hledger 1.17, we prefer predictability.) readJournal :: InputOpts -> Maybe FilePath -> Text -> IO (Either String Journal) readJournal iopts mpath txt = do let r :: Reader IO = fromMaybe JournalReader.reader $ findReader (mformat_ iopts) mpath dbg6IO "trying reader" (rFormat r) (runExceptT . (rReadFn r) iopts (fromMaybe "(string)" mpath)) txt -- | Read the default journal file specified by the environment, or raise an error. defaultJournal :: IO Journal defaultJournal = defaultJournalPath >>= readJournalFile def >>= either error' return -- PARTIAL: -- | Get the default journal file path specified by the environment. -- Like ledger, we look first for the LEDGER_FILE environment -- variable, and if that does not exist, for the legacy LEDGER -- environment variable. If neither is set, or the value is blank, -- return the hard-coded default, which is @.hledger.journal@ in the -- users's home directory (or in the current directory, if we cannot -- determine a home directory). defaultJournalPath :: IO String defaultJournalPath = do s <- envJournalPath if null s then defaultJournalPath else return s where envJournalPath = getEnv journalEnvVar `C.catch` (\(_::C.IOException) -> getEnv journalEnvVar2 `C.catch` (\(_::C.IOException) -> return "")) defaultJournalPath = do home <- getHomeDirectory `C.catch` (\(_::C.IOException) -> return "") return $ home journalDefaultFilename -- | A file path optionally prefixed by a reader name and colon -- (journal:, csv:, timedot:, etc.). type PrefixedFilePath = FilePath -- | Read a Journal from each specified file path and combine them into one. -- Or, return the first error message. -- -- Combining Journals means concatenating them, basically. -- The parse state resets at the start of each file, which means that -- directives & aliases do not affect subsequent sibling or parent files. -- They do affect included child files though. -- Also the final parse state saved in the Journal does span all files. readJournalFiles :: InputOpts -> [PrefixedFilePath] -> IO (Either String Journal) readJournalFiles iopts = fmap (right (maybe def sconcat . nonEmpty) . sequence) . mapM (readJournalFile iopts) -- | Read a Journal from this file, or from stdin if the file path is -, -- or return an error message. The file path can have a READER: prefix. -- -- The reader (data format) to use is determined from (in priority order): -- the @mformat_@ specified in the input options, if any; -- the file path's READER: prefix, if any; -- a recognised file name extension. -- if none of these identify a known reader, the journal reader is used. -- -- The input options can also configure balance assertion checking, automated posting -- generation, a rules file for converting CSV data, etc. readJournalFile :: InputOpts -> PrefixedFilePath -> IO (Either String Journal) readJournalFile iopts prefixedfile = do let (mfmt, f) = splitReaderPrefix prefixedfile iopts' = iopts{mformat_=asum [mfmt, mformat_ iopts]} requireJournalFileExists f t <- readFileOrStdinPortably f -- <- T.readFile f -- or without line ending translation, for testing ej <- readJournal iopts' (Just f) t case ej of Left e -> return $ Left e Right j | new_ iopts -> do ds <- previousLatestDates f let (newj, newds) = journalFilterSinceLatestDates ds j when (new_save_ iopts && not (null newds)) $ saveLatestDates newds f return $ Right newj Right j -> return $ Right j --- ** utilities -- | If the specified journal file does not exist (and is not "-"), -- give a helpful error and quit. requireJournalFileExists :: FilePath -> IO () requireJournalFileExists "-" = return () requireJournalFileExists f = do exists <- doesFileExist f when (not exists) $ do -- XXX might not be a journal file hPrintf stderr "The hledger journal file \"%s\" was not found.\n" f hPrintf stderr "Please create it first, eg with \"hledger add\" or a text editor.\n" hPrintf stderr "Or, specify an existing journal file with -f or LEDGER_FILE.\n" exitFailure -- | Ensure there is a journal file at the given path, creating an empty one if needed. -- On Windows, also ensure that the path contains no trailing dots -- which could cause data loss (see 'isWindowsUnsafeDotPath'). ensureJournalFileExists :: FilePath -> IO () ensureJournalFileExists f = do when (os/="mingw32" && isWindowsUnsafeDotPath f) $ do hPrintf stderr "Part of file path %s\n ends with a dot, which is unsafe on Windows; please use a different path.\n" (show f) exitFailure exists <- doesFileExist f when (not exists) $ do hPrintf stderr "Creating hledger journal file %s.\n" f -- note Hledger.Utils.UTF8.* do no line ending conversion on windows, -- we currently require unix line endings on all platforms. newJournalContent >>= writeFile f -- | Does any part of this path contain non-. characters and end with a . ? -- Such paths are not safe to use on Windows (cf #1056). isWindowsUnsafeDotPath :: FilePath -> Bool isWindowsUnsafeDotPath = not . null . filter (not . all (=='.')) . filter ((=='.').last) . splitDirectories -- | Give the content for a new auto-created journal file. newJournalContent :: IO String newJournalContent = do d <- getCurrentDay return $ printf "; journal created %s by hledger\n" (show d) -- A "LatestDates" is zero or more copies of the same date, -- representing the latest transaction date read from a file, -- and how many transactions there were on that date. type LatestDates = [Day] -- | Get all instances of the latest date in an unsorted list of dates. -- Ie, if the latest date appears once, return it in a one-element list, -- if it appears three times (anywhere), return three of it. latestDates :: [Day] -> LatestDates latestDates = headDef [] . take 1 . group . reverse . sort -- | Remember that these transaction dates were the latest seen when -- reading this journal file. saveLatestDates :: LatestDates -> FilePath -> IO () saveLatestDates dates f = writeFile (latestDatesFileFor f) $ unlines $ map showDate dates -- | What were the latest transaction dates seen the last time this -- journal file was read ? If there were multiple transactions on the -- latest date, that number of dates is returned, otherwise just one. -- Or none if no transactions were read, or if latest dates info is not -- available for this file. previousLatestDates :: FilePath -> IO LatestDates previousLatestDates f = do let latestfile = latestDatesFileFor f parsedate s = maybe (fail $ "could not parse date \"" ++ s ++ "\"") return $ parsedateM s exists <- doesFileExist latestfile if exists then traverse (parsedate . T.unpack . T.strip) . T.lines =<< readFileStrictly latestfile else return [] -- | Where to save latest transaction dates for the given file path. -- (.latest.FILE) latestDatesFileFor :: FilePath -> FilePath latestDatesFileFor f = dir ".latest" <.> fname where (dir, fname) = splitFileName f readFileStrictly :: FilePath -> IO Text readFileStrictly f = readFilePortably f >>= \t -> C.evaluate (T.length t) >> return t -- | Given zero or more latest dates (all the same, representing the -- latest previously seen transaction date, and how many transactions -- were seen on that date), remove transactions with earlier dates -- from the journal, and the same number of transactions on the -- latest date, if any, leaving only transactions that we can assume -- are newer. Also returns the new latest dates of the new journal. journalFilterSinceLatestDates :: LatestDates -> Journal -> (Journal, LatestDates) journalFilterSinceLatestDates [] j = (j, latestDates $ map tdate $ jtxns j) journalFilterSinceLatestDates ds@(d:_) j = (j', ds') where samedateorlaterts = filter ((>= d).tdate) $ jtxns j (samedatets, laterts) = span ((== d).tdate) $ sortBy (comparing tdate) samedateorlaterts newsamedatets = drop (length ds) samedatets j' = j{jtxns=newsamedatets++laterts} ds' = latestDates $ map tdate $ samedatets++laterts --- ** tests tests_Read = tests "Read" [ tests_Common ,tests_CsvReader ,tests_JournalReader ] hledger-lib-1.19.1/Hledger/Read/Common.hs0000644000000000000000000015650413725501202016170 0ustar0000000000000000--- * -*- outline-regexp:"--- \\*"; -*- --- ** doc -- In Emacs, use TAB on lines beginning with "-- *" to collapse/expand sections. {-| File reading/parsing utilities used by multiple readers, and a good amount of the parsers for journal format, to avoid import cycles when JournalReader imports other readers. Some of these might belong in Hledger.Read.JournalReader or Hledger.Read. -} --- ** language {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoMonoLocalBinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} --- ** exports module Hledger.Read.Common ( Reader (..), InputOpts (..), definputopts, rawOptsToInputOpts, -- * parsing utilities runTextParser, rtp, runJournalParser, rjp, runErroringJournalParser, rejp, genericSourcePos, journalSourcePos, parseAndFinaliseJournal, parseAndFinaliseJournal', journalFinalise, setYear, getYear, setDefaultCommodityAndStyle, getDefaultCommodityAndStyle, getDefaultAmountStyle, getAmountStyle, addDeclaredAccountType, pushParentAccount, popParentAccount, getParentAccount, addAccountAlias, getAccountAliases, clearAccountAliases, journalAddFile, -- * parsers -- ** transaction bits statusp, codep, descriptionp, -- ** dates datep, datetimep, secondarydatep, -- ** account names modifiedaccountnamep, accountnamep, -- ** amounts spaceandamountormissingp, amountp, amountp', mamountp', commoditysymbolp, priceamountp, balanceassertionp, lotpricep, numberp, fromRawNumber, rawnumberp, -- ** comments multilinecommentp, emptyorcommentlinep, followingcommentp, transactioncommentp, postingcommentp, -- ** bracketed dates bracketeddatetagsp, -- ** misc singlespacedtextp, singlespacedtextsatisfyingp, singlespacep, skipNonNewlineSpaces, skipNonNewlineSpaces1, -- * tests tests_Common, ) where --- ** imports import Prelude () import "base-compat-batteries" Prelude.Compat hiding (fail, readFile) import Control.Applicative.Permutations (runPermutation, toPermutationWithDefault) import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail) import Control.Monad.Except (ExceptT(..), runExceptT, throwError) import Control.Monad.State.Strict hiding (fail) import Data.Bifunctor (bimap, second) import Data.Char (digitToInt, isDigit, isSpace) import Data.Decimal (DecimalRaw (Decimal), Decimal) import Data.Default (Default(..)) import Data.Function ((&)) import Data.Functor.Identity (Identity) import "base-compat-batteries" Data.List.Compat import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe (catMaybes, fromMaybe, isJust, listToMaybe) import qualified Data.Map as M import qualified Data.Semigroup as Sem import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar (Day, fromGregorianValid, toGregorian) import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..)) import Data.Word (Word8) import System.Time (getClockTime) import Text.Megaparsec import Text.Megaparsec.Char (char, char', digitChar, newline, string) import Text.Megaparsec.Char.Lexer (decimal) import Text.Megaparsec.Custom (FinalParseError, attachSource, customErrorBundlePretty, finalErrorBundlePretty, parseErrorAt, parseErrorAtRegion) import Hledger.Data import Hledger.Utils --- ** doctest setup -- $setup -- >>> :set -XOverloadedStrings --- ** types -- main types; a few more below -- | A hledger journal reader is a triple of storage format name, a -- detector of that format, and a parser from that format to Journal. -- The type variable m appears here so that rParserr can hold a -- journal parser, which depends on it. data Reader m = Reader { -- The canonical name of the format handled by this reader rFormat :: StorageFormat -- The file extensions recognised as containing this format ,rExtensions :: [String] -- The entry point for reading this format, accepting input options, file -- path for error messages and file contents, producing an exception-raising IO -- action that produces a journal or error message. ,rReadFn :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal -- The actual megaparsec parser called by the above, in case -- another parser (includedirectivep) wants to use it directly. ,rParser :: MonadIO m => ErroringJournalParser m ParsedJournal } instance Show (Reader m) where show r = rFormat r ++ " reader" -- $setup -- | Various options to use when reading journal files. -- Similar to CliOptions.inputflags, simplifies the journal-reading functions. data InputOpts = InputOpts { -- files_ :: [FilePath] mformat_ :: Maybe StorageFormat -- ^ a file/storage format to try, unless overridden -- by a filename prefix. Nothing means try all. ,mrules_file_ :: Maybe FilePath -- ^ a conversion rules file to use (when reading CSV) ,aliases_ :: [String] -- ^ account name aliases to apply ,anon_ :: Bool -- ^ do light anonymisation/obfuscation of the data ,ignore_assertions_ :: Bool -- ^ don't check balance assertions ,new_ :: Bool -- ^ read only new transactions since this file was last read ,new_save_ :: Bool -- ^ save latest new transactions state for next time ,pivot_ :: String -- ^ use the given field's value as the account name ,auto_ :: Bool -- ^ generate automatic postings when journal is parsed } deriving (Show) instance Default InputOpts where def = definputopts definputopts :: InputOpts definputopts = InputOpts def def def def def def True def def rawOptsToInputOpts :: RawOpts -> InputOpts rawOptsToInputOpts rawopts = InputOpts{ -- files_ = listofstringopt "file" rawopts mformat_ = Nothing ,mrules_file_ = maybestringopt "rules-file" rawopts ,aliases_ = listofstringopt "alias" rawopts ,anon_ = boolopt "anon" rawopts ,ignore_assertions_ = boolopt "ignore-assertions" rawopts ,new_ = boolopt "new" rawopts ,new_save_ = True ,pivot_ = stringopt "pivot" rawopts ,auto_ = boolopt "auto" rawopts } --- ** parsing utilities -- | Run a text parser in the identity monad. See also: parseWithState. runTextParser, rtp :: TextParser Identity a -> Text -> Either (ParseErrorBundle Text CustomErr) a runTextParser p t = runParser p "" t rtp = runTextParser -- | Run a journal parser in some monad. See also: parseWithState. runJournalParser, rjp :: Monad m => JournalParser m a -> Text -> m (Either (ParseErrorBundle Text CustomErr) a) runJournalParser p t = runParserT (evalStateT p nulljournal) "" t rjp = runJournalParser -- | Run an erroring journal parser in some monad. See also: parseWithState. runErroringJournalParser, rejp :: Monad m => ErroringJournalParser m a -> Text -> m (Either FinalParseError (Either (ParseErrorBundle Text CustomErr) a)) runErroringJournalParser p t = runExceptT $ runParserT (evalStateT p nulljournal) "" t rejp = runErroringJournalParser genericSourcePos :: SourcePos -> GenericSourcePos genericSourcePos p = GenericSourcePos (sourceName p) (unPos $ sourceLine p) (unPos $ sourceColumn p) -- | Construct a generic start & end line parse position from start and end megaparsec SourcePos's. journalSourcePos :: SourcePos -> SourcePos -> GenericSourcePos journalSourcePos p p' = JournalSourcePos (sourceName p) (unPos $ sourceLine p, line') where line' | (unPos $ sourceColumn p') == 1 = unPos (sourceLine p') - 1 | otherwise = unPos $ sourceLine p' -- might be at end of file withat last new-line -- | Given a parser to ParsedJournal, input options, file path and -- content: run the parser on the content, and finalise the result to -- get a Journal; or throw an error. parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> InputOpts -> FilePath -> Text -> ExceptT String IO Journal parseAndFinaliseJournal parser iopts f txt = do y <- liftIO getCurrentYear let initJournal = nulljournal{ jparsedefaultyear = Just y, jincludefilestack = [f] } eep <- liftIO $ runExceptT $ runParserT (evalStateT parser initJournal) f txt -- TODO: urgh.. clean this up somehow case eep of Left finalParseError -> throwError $ finalErrorBundlePretty $ attachSource f txt finalParseError Right ep -> case ep of Left e -> throwError $ customErrorBundlePretty e Right pj -> journalFinalise iopts f txt pj -- | Like parseAndFinaliseJournal but takes a (non-Erroring) JournalParser. -- Used for timeclock/timedot. -- TODO: get rid of this, use parseAndFinaliseJournal instead parseAndFinaliseJournal' :: JournalParser IO ParsedJournal -> InputOpts -> FilePath -> Text -> ExceptT String IO Journal parseAndFinaliseJournal' parser iopts f txt = do y <- liftIO getCurrentYear let initJournal = nulljournal { jparsedefaultyear = Just y , jincludefilestack = [f] } ep <- liftIO $ runParserT (evalStateT parser initJournal) f txt -- see notes above case ep of Left e -> throwError $ customErrorBundlePretty e Right pj -> journalFinalise iopts f txt pj -- | Post-process a Journal that has just been parsed or generated, in this order: -- -- - apply canonical amount styles, -- -- - save misc info and reverse transactions into their original parse order, -- -- - evaluate balance assignments and balance each transaction, -- -- - apply transaction modifiers (auto postings) if enabled, -- -- - check balance assertions if enabled. -- -- - infer transaction-implied market prices from transaction prices -- journalFinalise :: InputOpts -> FilePath -> Text -> Journal -> ExceptT String IO Journal journalFinalise iopts f txt pj = do t <- liftIO getClockTime d <- liftIO getCurrentDay -- Infer and apply canonical styles for each commodity (or fail). -- This affects transaction balancing/assertions/assignments, so needs to be done early. -- (TODO: since #903's refactoring for hledger 1.12, -- journalApplyCommodityStyles here is seeing the -- transactions before they get reversesd to normal order.) case journalApplyCommodityStyles pj of Left e -> throwError e Right pj' -> either throwError return $ pj' & journalAddFile (f, txt) -- save the file path and content & journalSetLastReadTime t -- save the last read time & journalReverse -- convert all lists to parse order & (if not (auto_ iopts) || null (jtxnmodifiers pj) then -- Auto postings are not active. -- Balance all transactions and maybe check balance assertions. journalBalanceTransactions (not $ ignore_assertions_ iopts) else \j -> do -- Either monad -- Auto postings are active. -- Balance all transactions without checking balance assertions, j' <- journalBalanceTransactions False j -- then add the auto postings -- (Note adding auto postings after balancing means #893b fails; -- adding them before balancing probably means #893a, #928, #938 fail.) case journalModifyTransactions d j' of Left e -> throwError e Right j'' -> do -- then apply commodity styles once more, to style the auto posting amounts. (XXX inefficient ?) j''' <- journalApplyCommodityStyles j'' -- then check balance assertions. journalBalanceTransactions (not $ ignore_assertions_ iopts) j''' ) & fmap journalInferMarketPricesFromTransactions -- infer market prices from commodity-exchanging transactions setYear :: Year -> JournalParser m () setYear y = modify' (\j -> j{jparsedefaultyear=Just y}) getYear :: JournalParser m (Maybe Year) getYear = fmap jparsedefaultyear get setDefaultCommodityAndStyle :: (CommoditySymbol,AmountStyle) -> JournalParser m () setDefaultCommodityAndStyle cs = modify' (\j -> j{jparsedefaultcommodity=Just cs}) getDefaultCommodityAndStyle :: JournalParser m (Maybe (CommoditySymbol,AmountStyle)) getDefaultCommodityAndStyle = jparsedefaultcommodity `fmap` get -- | Get amount style associated with default currency. -- -- Returns 'AmountStyle' used to defined by a latest default commodity directive -- prior to current position within this file or its parents. getDefaultAmountStyle :: JournalParser m (Maybe AmountStyle) getDefaultAmountStyle = fmap snd <$> getDefaultCommodityAndStyle -- | Lookup currency-specific amount style. -- -- Returns 'AmountStyle' used in commodity directive within current journal -- prior to current position or in its parents files. getAmountStyle :: CommoditySymbol -> JournalParser m (Maybe AmountStyle) getAmountStyle commodity = do specificStyle <- maybe Nothing cformat . M.lookup commodity . jcommodities <$> get defaultStyle <- fmap snd <$> getDefaultCommodityAndStyle let effectiveStyle = listToMaybe $ catMaybes [specificStyle, defaultStyle] return effectiveStyle addDeclaredAccountType :: AccountName -> AccountType -> JournalParser m () addDeclaredAccountType acct atype = modify' (\j -> j{jdeclaredaccounttypes = M.insertWith (++) atype [acct] (jdeclaredaccounttypes j)}) pushParentAccount :: AccountName -> JournalParser m () pushParentAccount acct = modify' (\j -> j{jparseparentaccounts = acct : jparseparentaccounts j}) popParentAccount :: JournalParser m () popParentAccount = do j <- get case jparseparentaccounts j of [] -> unexpected (Tokens ('E' :| "nd of apply account block with no beginning")) (_:rest) -> put j{jparseparentaccounts=rest} getParentAccount :: JournalParser m AccountName getParentAccount = fmap (concatAccountNames . reverse . jparseparentaccounts) get addAccountAlias :: MonadState Journal m => AccountAlias -> m () addAccountAlias a = modify' (\(j@Journal{..}) -> j{jparsealiases=a:jparsealiases}) getAccountAliases :: MonadState Journal m => m [AccountAlias] getAccountAliases = fmap jparsealiases get clearAccountAliases :: MonadState Journal m => m () clearAccountAliases = modify' (\j -> j{jparsealiases=[]}) -- getTransactionCount :: MonadState Journal m => m Integer -- getTransactionCount = fmap jparsetransactioncount get -- -- setTransactionCount :: MonadState Journal m => Integer -> m () -- setTransactionCount i = modify' (\j -> j{jparsetransactioncount=i}) -- -- -- | Increment the transaction index by one and return the new value. -- incrementTransactionCount :: MonadState Journal m => m Integer -- incrementTransactionCount = do -- modify' (\j -> j{jparsetransactioncount=jparsetransactioncount j + 1}) -- getTransactionCount journalAddFile :: (FilePath,Text) -> Journal -> Journal journalAddFile f j@Journal{jfiles=fs} = j{jfiles=fs++[f]} -- append, unlike the other fields, even though we do a final reverse, -- to compensate for additional reversal due to including/monoid-concatting -- A version of `match` that is strict in the returned text match' :: TextParser m a -> TextParser m (Text, a) match' p = do (!txt, p) <- match p pure (txt, p) --- ** parsers --- *** transaction bits statusp :: TextParser m Status statusp = choice' [ skipNonNewlineSpaces >> char '*' >> return Cleared , skipNonNewlineSpaces >> char '!' >> return Pending , return Unmarked ] codep :: TextParser m Text codep = option "" $ do try $ do skipNonNewlineSpaces1 char '(' code <- takeWhileP Nothing $ \c -> c /= ')' && c /= '\n' char ')' "closing bracket ')' for transaction code" pure code descriptionp :: TextParser m Text descriptionp = takeWhileP Nothing (not . semicolonOrNewline) where semicolonOrNewline c = c == ';' || c == '\n' --- *** dates -- | Parse a date in YYYY-MM-DD format. -- Slash (/) and period (.) are also allowed as separators. -- The year may be omitted if a default year has been set. -- Leading zeroes may be omitted. datep :: JournalParser m Day datep = do mYear <- getYear lift $ datep' mYear datep' :: Maybe Year -> TextParser m Day datep' mYear = do startOffset <- getOffset d1 <- yearorintp "year or month" sep <- datesepchar "date separator" d2 <- decimal "month or day" case d1 of Left y -> fullDate startOffset y sep d2 Right m -> partialDate startOffset mYear m sep d2 "full or partial date" where fullDate :: Int -> Year -> Char -> Month -> TextParser m Day fullDate startOffset year sep1 month = do sep2 <- satisfy isDateSepChar "date separator" day <- decimal "day" endOffset <- getOffset let dateStr = show year ++ [sep1] ++ show month ++ [sep2] ++ show day when (sep1 /= sep2) $ customFailure $ parseErrorAtRegion startOffset endOffset $ "invalid date (mixing date separators is not allowed): " ++ dateStr case fromGregorianValid year month day of Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $ "well-formed but invalid date: " ++ dateStr Just date -> pure $! date partialDate :: Int -> Maybe Year -> Month -> Char -> MonthDay -> TextParser m Day partialDate startOffset mYear month sep day = do endOffset <- getOffset case mYear of Just year -> case fromGregorianValid year month day of Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $ "well-formed but invalid date: " ++ dateStr Just date -> pure $! date where dateStr = show year ++ [sep] ++ show month ++ [sep] ++ show day Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $ "partial date "++dateStr++" found, but the current year is unknown" where dateStr = show month ++ [sep] ++ show day {-# INLINABLE datep' #-} -- | Parse a date and time in YYYY-MM-DD HH:MM[:SS][+-ZZZZ] format. -- Slash (/) and period (.) are also allowed as date separators. -- The year may be omitted if a default year has been set. -- Seconds are optional. -- The timezone is optional and ignored (the time is always interpreted as a local time). -- Leading zeroes may be omitted (except in a timezone). datetimep :: JournalParser m LocalTime datetimep = do mYear <- getYear lift $ datetimep' mYear datetimep' :: Maybe Year -> TextParser m LocalTime datetimep' mYear = do day <- datep' mYear skipNonNewlineSpaces1 time <- timeOfDay optional timeZone -- ignoring time zones pure $ LocalTime day time where timeOfDay :: TextParser m TimeOfDay timeOfDay = do off1 <- getOffset h' <- twoDigitDecimal "hour" off2 <- getOffset unless (h' >= 0 && h' <= 23) $ customFailure $ parseErrorAtRegion off1 off2 "invalid time (bad hour)" char ':' "':' (hour-minute separator)" off3 <- getOffset m' <- twoDigitDecimal "minute" off4 <- getOffset unless (m' >= 0 && m' <= 59) $ customFailure $ parseErrorAtRegion off3 off4 "invalid time (bad minute)" s' <- option 0 $ do char ':' "':' (minute-second separator)" off5 <- getOffset s' <- twoDigitDecimal "second" off6 <- getOffset unless (s' >= 0 && s' <= 59) $ customFailure $ parseErrorAtRegion off5 off6 "invalid time (bad second)" -- we do not support leap seconds pure s' pure $ TimeOfDay h' m' (fromIntegral s') twoDigitDecimal :: TextParser m Int twoDigitDecimal = do d1 <- digitToInt <$> digitChar d2 <- digitToInt <$> (digitChar "a second digit") pure $ d1*10 + d2 timeZone :: TextParser m String timeZone = do plusminus <- satisfy $ \c -> c == '-' || c == '+' fourDigits <- count 4 (digitChar "a digit (for a time zone)") pure $ plusminus:fourDigits secondarydatep :: Day -> TextParser m Day secondarydatep primaryDate = char '=' *> datep' (Just primaryYear) where primaryYear = first3 $ toGregorian primaryDate -- | Parse a year number or an Int. Years must contain at least four -- digits. yearorintp :: TextParser m (Either Year Int) yearorintp = do yearOrMonth <- takeWhile1P (Just "digit") isDigit let n = readDecimal yearOrMonth return $ if T.length yearOrMonth >= 4 then Left n else Right (fromInteger n) --- *** account names -- | Parse an account name (plus one following space if present), -- then apply any parent account prefix and/or account aliases currently in effect, -- in that order. (Ie first add the parent account prefix, then rewrite with aliases). -- This calls error if any account alias with an invalid regular expression exists. modifiedaccountnamep :: JournalParser m AccountName modifiedaccountnamep = do parent <- getParentAccount aliases <- getAccountAliases -- off1 <- getOffset a <- lift accountnamep -- off2 <- getOffset -- XXX or accountNameApplyAliasesMemo ? doesn't seem to make a difference (retest that function) case accountNameApplyAliases aliases $ joinAccountNames parent a of Right a' -> return $! a' -- should not happen, regexaliasp will have displayed a better error already: -- (XXX why does customFailure cause error to be displayed there, but not here ?) -- Left e -> customFailure $! parseErrorAtRegion off1 off2 err Left e -> error' err -- PARTIAL: where err = "problem in account alias applied to "++T.unpack a++": "++e -- | Parse an account name, plus one following space if present. -- Account names have one or more parts separated by the account separator character, -- and are terminated by two or more spaces (or end of input). -- Each part is at least one character long, may have single spaces inside it, -- and starts with a non-whitespace. -- Note, this means "{account}", "%^!" and ";comment" are all accepted -- (parent parsers usually prevent/consume the last). -- It should have required parts to start with an alphanumeric; -- for now it remains as-is for backwards compatibility. accountnamep :: TextParser m AccountName accountnamep = singlespacedtextp -- | Parse any text beginning with a non-whitespace character, until a -- double space or the end of input. -- TODO including characters which normally start a comment (;#) - exclude those ? singlespacedtextp :: TextParser m T.Text singlespacedtextp = singlespacedtextsatisfyingp (const True) -- | Similar to 'singlespacedtextp', except that the text must only contain -- characters satisfying the given predicate. singlespacedtextsatisfyingp :: (Char -> Bool) -> TextParser m T.Text singlespacedtextsatisfyingp pred = do firstPart <- partp otherParts <- many $ try $ singlespacep *> partp pure $! T.unwords $ firstPart : otherParts where partp = takeWhile1P Nothing (\c -> pred c && not (isSpace c)) -- | Parse one non-newline whitespace character that is not followed by another one. singlespacep :: TextParser m () singlespacep = spacenonewline *> notFollowedBy spacenonewline --- *** amounts -- | Parse whitespace then an amount, with an optional left or right -- currency symbol and optional price, or return the special -- "missing" marker amount. spaceandamountormissingp :: JournalParser m MixedAmount spaceandamountormissingp = option missingmixedamt $ try $ do lift $ skipNonNewlineSpaces1 Mixed . (:[]) <$> amountp -- | Parse a single-commodity amount, with optional symbol on the left -- or right, followed by, in any order: an optional transaction price, -- an optional ledger-style lot price, and/or an optional ledger-style -- lot date. A lot price and lot date will be ignored. amountp :: JournalParser m Amount amountp = label "amount" $ do let spaces = lift $ skipNonNewlineSpaces amount <- amountwithoutpricep <* spaces (mprice, _elotprice, _elotdate) <- runPermutation $ (,,) <$> toPermutationWithDefault Nothing (Just <$> priceamountp <* spaces) <*> toPermutationWithDefault Nothing (Just <$> lotpricep <* spaces) <*> toPermutationWithDefault Nothing (Just <$> lotdatep <* spaces) pure $ amount { aprice = mprice } -- XXX Just like amountp but don't allow lot prices. Needed for balanceassertionp. amountpnolotprices :: JournalParser m Amount amountpnolotprices = label "amount" $ do let spaces = lift $ skipNonNewlineSpaces amount <- amountwithoutpricep spaces mprice <- optional $ priceamountp <* spaces pure $ amount { aprice = mprice } amountwithoutpricep :: JournalParser m Amount amountwithoutpricep = do (mult, sign) <- lift $ (,) <$> multiplierp <*> signp leftsymbolamountp mult sign <|> rightornosymbolamountp mult sign where leftsymbolamountp :: Bool -> (Decimal -> Decimal) -> JournalParser m Amount leftsymbolamountp mult sign = label "amount" $ do c <- lift commoditysymbolp suggestedStyle <- getAmountStyle c commodityspaced <- lift skipNonNewlineSpaces' sign2 <- lift $ signp offBeforeNum <- getOffset ambiguousRawNum <- lift rawnumberp mExponent <- lift $ optional $ try exponentp offAfterNum <- getOffset let numRegion = (offBeforeNum, offAfterNum) (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent let s = amountstyle{ascommodityside=L, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} return $ nullamt{acommodity=c, aquantity=sign (sign2 q), aismultiplier=mult, astyle=s, aprice=Nothing} rightornosymbolamountp :: Bool -> (Decimal -> Decimal) -> JournalParser m Amount rightornosymbolamountp mult sign = label "amount" $ do offBeforeNum <- getOffset ambiguousRawNum <- lift rawnumberp mExponent <- lift $ optional $ try exponentp offAfterNum <- getOffset let numRegion = (offBeforeNum, offAfterNum) mSpaceAndCommodity <- lift $ optional $ try $ (,) <$> skipNonNewlineSpaces' <*> commoditysymbolp case mSpaceAndCommodity of -- right symbol amount Just (commodityspaced, c) -> do suggestedStyle <- getAmountStyle c (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} return $ nullamt{acommodity=c, aquantity=sign q, aismultiplier=mult, astyle=s, aprice=Nothing} -- no symbol amount Nothing -> do suggestedStyle <- getDefaultAmountStyle (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent -- if a default commodity has been set, apply it and its style to this amount -- (unless it's a multiplier in an automated posting) defcs <- getDefaultCommodityAndStyle let (c,s) = case (mult, defcs) of (False, Just (defc,defs)) -> (defc, defs{asprecision=max (asprecision defs) prec}) _ -> ("", amountstyle{asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}) return $ nullamt{acommodity=c, aquantity=sign q, aismultiplier=mult, astyle=s, aprice=Nothing} -- For reducing code duplication. Doesn't parse anything. Has the type -- of a parser only in order to throw parse errors (for convenience). interpretNumber :: (Int, Int) -- offsets -> Maybe AmountStyle -> Either AmbiguousNumber RawNumber -> Maybe Integer -> TextParser m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle) interpretNumber posRegion suggestedStyle ambiguousNum mExp = let rawNum = either (disambiguateNumber suggestedStyle) id ambiguousNum in case fromRawNumber rawNum mExp of Left errMsg -> customFailure $ uncurry parseErrorAtRegion posRegion errMsg Right (q,p,d,g) -> pure (q, Precision p, d, g) -- | Parse an amount from a string, or get an error. amountp' :: String -> Amount amountp' s = case runParser (evalStateT (amountp <* eof) nulljournal) "" (T.pack s) of Right amt -> amt Left err -> error' $ show err -- PARTIAL: XXX should throwError -- | Parse a mixed amount from a string, or get an error. mamountp' :: String -> MixedAmount mamountp' = Mixed . (:[]) . amountp' -- | Parse a minus or plus sign followed by zero or more spaces, -- or nothing, returning a function that negates or does nothing. signp :: Num a => TextParser m (a -> a) signp = ((char '-' *> pure negate <|> char '+' *> pure id) <* skipNonNewlineSpaces) <|> pure id multiplierp :: TextParser m Bool multiplierp = option False $ char '*' *> pure True commoditysymbolp :: TextParser m CommoditySymbol commoditysymbolp = quotedcommoditysymbolp <|> simplecommoditysymbolp "commodity symbol" quotedcommoditysymbolp :: TextParser m CommoditySymbol quotedcommoditysymbolp = between (char '"') (char '"') $ takeWhile1P Nothing f where f c = c /= ';' && c /= '\n' && c /= '\"' simplecommoditysymbolp :: TextParser m CommoditySymbol simplecommoditysymbolp = takeWhile1P Nothing (not . isNonsimpleCommodityChar) priceamountp :: JournalParser m AmountPrice priceamountp = label "transaction price" $ do -- https://www.ledger-cli.org/3.0/doc/ledger3.html#Virtual-posting-costs parenthesised <- option False $ char '(' >> pure True char '@' priceConstructor <- char '@' *> pure TotalPrice <|> pure UnitPrice when parenthesised $ void $ char ')' lift skipNonNewlineSpaces priceAmount <- amountwithoutpricep -- "unpriced amount (specifying a price)" pure $ priceConstructor priceAmount balanceassertionp :: JournalParser m BalanceAssertion balanceassertionp = do sourcepos <- genericSourcePos <$> lift getSourcePos char '=' istotal <- fmap isJust $ optional $ try $ char '=' isinclusive <- fmap isJust $ optional $ try $ char '*' lift skipNonNewlineSpaces -- this amount can have a price; balance assertions ignore it, -- but balance assignments will use it a <- amountpnolotprices "amount (for a balance assertion or assignment)" return BalanceAssertion { baamount = a , batotal = istotal , bainclusive = isinclusive , baposition = sourcepos } -- Parse a Ledger-style fixed {=UNITPRICE} or non-fixed {UNITPRICE} -- or fixed {{=TOTALPRICE}} or non-fixed {{TOTALPRICE}} lot price, -- and ignore it. -- https://www.ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices . lotpricep :: JournalParser m () lotpricep = label "ledger-style lot price" $ do char '{' doublebrace <- option False $ char '{' >> pure True _fixed <- fmap isJust $ optional $ lift skipNonNewlineSpaces >> char '=' lift skipNonNewlineSpaces _a <- amountwithoutpricep lift skipNonNewlineSpaces char '}' when (doublebrace) $ void $ char '}' return () -- Parse a Ledger-style lot date [DATE], and ignore it. -- https://www.ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices . lotdatep :: JournalParser m () lotdatep = (do char '[' lift skipNonNewlineSpaces _d <- datep lift skipNonNewlineSpaces char ']' return () ) "ledger-style lot date" -- | Parse a string representation of a number for its value and display -- attributes. -- -- Some international number formats are accepted, eg either period or comma -- may be used for the decimal mark, and the other of these may be used for -- separating digit groups in the integer part. See -- http://en.wikipedia.org/wiki/Decimal_separator for more examples. -- -- This returns: the parsed numeric value, the precision (number of digits -- seen following the decimal mark), the decimal mark character used if any, -- and the digit group style if any. -- numberp :: Maybe AmountStyle -> TextParser m (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle) numberp suggestedStyle = label "number" $ do -- a number is an optional sign followed by a sequence of digits possibly -- interspersed with periods, commas, or both -- dbgparse 0 "numberp" sign <- signp rawNum <- either (disambiguateNumber suggestedStyle) id <$> rawnumberp mExp <- optional $ try $ exponentp dbg7 "numberp suggestedStyle" suggestedStyle `seq` return () case dbg7 "numberp quantity,precision,mdecimalpoint,mgrps" $ fromRawNumber rawNum mExp of Left errMsg -> Fail.fail errMsg Right (q, p, d, g) -> pure (sign q, p, d, g) exponentp :: TextParser m Integer exponentp = char' 'e' *> signp <*> decimal "exponent" -- | Interpret a raw number as a decimal number. -- -- Returns: -- - the decimal number -- - the precision (number of digits after the decimal point) -- - the decimal point character, if any -- - the digit group style, if any (digit group character and sizes of digit groups) fromRawNumber :: RawNumber -> Maybe Integer -> Either String (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle) fromRawNumber (WithSeparators _ _ _) (Just _) = Left "invalid number: mixing digit separators with exponents is not allowed" fromRawNumber raw mExp = do (quantity, precision) <- toQuantity (fromMaybe 0 mExp) (digitGroup raw) (decimalGroup raw) return (quantity, precision, mDecPt raw, digitGroupStyle raw) where toQuantity :: Integer -> DigitGrp -> DigitGrp -> Either String (Quantity, Word8) toQuantity e preDecimalGrp postDecimalGrp | precision < 0 = Right (Decimal 0 (digitGrpNum * 10^(-precision)), 0) | precision < 256 = Right (Decimal precision8 digitGrpNum, precision8) | otherwise = Left "invalid number: numbers with more than 255 decimal digits are not allowed at this time" where digitGrpNum = digitGroupNumber $ preDecimalGrp <> postDecimalGrp precision = toInteger (digitGroupLength postDecimalGrp) - e precision8 = fromIntegral precision :: Word8 mDecPt (NoSeparators _ mDecimals) = fst <$> mDecimals mDecPt (WithSeparators _ _ mDecimals) = fst <$> mDecimals decimalGroup (NoSeparators _ mDecimals) = maybe mempty snd mDecimals decimalGroup (WithSeparators _ _ mDecimals) = maybe mempty snd mDecimals digitGroup (NoSeparators digitGrp _) = digitGrp digitGroup (WithSeparators _ digitGrps _) = mconcat digitGrps digitGroupStyle (NoSeparators _ _) = Nothing digitGroupStyle (WithSeparators sep grps _) = Just . DigitGroups sep $ groupSizes grps -- Outputs digit group sizes from least significant to most significant groupSizes :: [DigitGrp] -> [Word8] groupSizes digitGrps = reverse $ case map (fromIntegral . digitGroupLength) digitGrps of (a:b:cs) | a < b -> b:cs gs -> gs disambiguateNumber :: Maybe AmountStyle -> AmbiguousNumber -> RawNumber disambiguateNumber suggestedStyle (AmbiguousNumber grp1 sep grp2) = -- If present, use the suggested style to disambiguate; -- otherwise, assume that the separator is a decimal point where possible. if isDecimalPointChar sep && maybe True (sep `isValidDecimalBy`) suggestedStyle then NoSeparators grp1 (Just (sep, grp2)) else WithSeparators sep [grp1, grp2] Nothing where isValidDecimalBy :: Char -> AmountStyle -> Bool isValidDecimalBy c = \case AmountStyle{asdecimalpoint = Just d} -> d == c AmountStyle{asdigitgroups = Just (DigitGroups g _)} -> g /= c AmountStyle{asprecision = Precision 0} -> False _ -> True -- | Parse and interpret the structure of a number without external hints. -- Numbers are digit strings, possibly separated into digit groups by one -- of two types of separators. (1) Numbers may optionally have a decimal -- mark, which may be either a period or comma. (2) Numbers may -- optionally contain digit group marks, which must all be either a -- period, a comma, or a space. -- -- It is our task to deduce the characters used as decimal mark and -- digit group mark, based on the allowed syntax. For instance, we -- make use of the fact that a decimal mark can occur at most once and -- must be to the right of all digit group marks. -- -- >>> parseTest rawnumberp "1,234,567.89" -- Right (WithSeparators ',' ["1","234","567"] (Just ('.',"89"))) -- >>> parseTest rawnumberp "1,000" -- Left (AmbiguousNumber "1" ',' "000") -- >>> parseTest rawnumberp "1 000" -- Right (WithSeparators ' ' ["1","000"] Nothing) -- rawnumberp :: TextParser m (Either AmbiguousNumber RawNumber) rawnumberp = label "number" $ do rawNumber <- fmap Right leadingDecimalPt <|> leadingDigits -- Guard against mistyped numbers mExtraDecimalSep <- optional $ lookAhead $ satisfy isDecimalPointChar when (isJust mExtraDecimalSep) $ Fail.fail "invalid number (invalid use of separator)" mExtraFragment <- optional $ lookAhead $ try $ char ' ' *> getOffset <* digitChar case mExtraFragment of Just off -> customFailure $ parseErrorAt off "invalid number (excessive trailing digits)" Nothing -> pure () return $ dbg7 "rawnumberp" rawNumber where leadingDecimalPt :: TextParser m RawNumber leadingDecimalPt = do decPt <- satisfy isDecimalPointChar decGrp <- digitgroupp pure $ NoSeparators mempty (Just (decPt, decGrp)) leadingDigits :: TextParser m (Either AmbiguousNumber RawNumber) leadingDigits = do grp1 <- digitgroupp withSeparators grp1 <|> fmap Right (trailingDecimalPt grp1) <|> pure (Right $ NoSeparators grp1 Nothing) withSeparators :: DigitGrp -> TextParser m (Either AmbiguousNumber RawNumber) withSeparators grp1 = do (sep, grp2) <- try $ (,) <$> satisfy isDigitSeparatorChar <*> digitgroupp grps <- many $ try $ char sep *> digitgroupp let digitGroups = grp1 : grp2 : grps fmap Right (withDecimalPt sep digitGroups) <|> pure (withoutDecimalPt grp1 sep grp2 grps) withDecimalPt :: Char -> [DigitGrp] -> TextParser m RawNumber withDecimalPt digitSep digitGroups = do decPt <- satisfy $ \c -> isDecimalPointChar c && c /= digitSep decDigitGrp <- option mempty digitgroupp pure $ WithSeparators digitSep digitGroups (Just (decPt, decDigitGrp)) withoutDecimalPt :: DigitGrp -> Char -> DigitGrp -> [DigitGrp] -> Either AmbiguousNumber RawNumber withoutDecimalPt grp1 sep grp2 grps | null grps && isDecimalPointChar sep = Left $ AmbiguousNumber grp1 sep grp2 | otherwise = Right $ WithSeparators sep (grp1:grp2:grps) Nothing trailingDecimalPt :: DigitGrp -> TextParser m RawNumber trailingDecimalPt grp1 = do decPt <- satisfy isDecimalPointChar pure $ NoSeparators grp1 (Just (decPt, mempty)) isDecimalPointChar :: Char -> Bool isDecimalPointChar c = c == '.' || c == ',' isDigitSeparatorChar :: Char -> Bool isDigitSeparatorChar c = isDecimalPointChar c || c == ' ' -- | Some kinds of number literal we might parse. data RawNumber = NoSeparators DigitGrp (Maybe (Char, DigitGrp)) -- ^ A number with no digit group marks (eg 100), -- or with a leading or trailing comma or period -- which (apparently) we interpret as a decimal mark (like 100. or .100) | WithSeparators Char [DigitGrp] (Maybe (Char, DigitGrp)) -- ^ A number with identifiable digit group marks -- (eg 1,000,000 or 1,000.50 or 1 000) deriving (Show, Eq) -- | Another kind of number literal: this one contains either a digit -- group separator or a decimal mark, we're not sure which (eg 1,000 or 100.50). data AmbiguousNumber = AmbiguousNumber DigitGrp Char DigitGrp deriving (Show, Eq) -- | Description of a single digit group in a number literal. -- "Thousands" is one well known digit grouping, but there are others. data DigitGrp = DigitGrp { digitGroupLength :: !Word, -- ^ The number of digits in this group. -- This is Word to avoid the need to do overflow -- checking for the Semigroup instance of DigitGrp. digitGroupNumber :: !Integer -- ^ The natural number formed by this group's digits. This should always be positive. } deriving (Eq) -- | A custom show instance, showing digit groups as the parser saw them. instance Show DigitGrp where show (DigitGrp len num) = "\"" ++ padding ++ numStr ++ "\"" where numStr = show num padding = genericReplicate (toInteger len - toInteger (length numStr)) '0' instance Sem.Semigroup DigitGrp where DigitGrp l1 n1 <> DigitGrp l2 n2 = DigitGrp (l1 + l2) (n1 * 10^l2 + n2) instance Monoid DigitGrp where mempty = DigitGrp 0 0 mappend = (Sem.<>) digitgroupp :: TextParser m DigitGrp digitgroupp = label "digits" $ makeGroup <$> takeWhile1P (Just "digit") isDigit where makeGroup = uncurry DigitGrp . foldl' step (0, 0) . T.unpack step (!l, !a) c = (l+1, a*10 + fromIntegral (digitToInt c)) --- *** comments multilinecommentp :: TextParser m () multilinecommentp = startComment *> anyLine `skipManyTill` endComment where startComment = string "comment" *> trailingSpaces endComment = eof <|> string "end comment" *> trailingSpaces trailingSpaces = skipNonNewlineSpaces <* newline anyLine = void $ takeWhileP Nothing (\c -> c /= '\n') *> newline {-# INLINABLE multilinecommentp #-} -- | A blank or comment line in journal format: a line that's empty or -- containing only whitespace or whose first non-whitespace character -- is semicolon, hash, or star. emptyorcommentlinep :: TextParser m () emptyorcommentlinep = do skipNonNewlineSpaces skiplinecommentp <|> void newline where skiplinecommentp :: TextParser m () skiplinecommentp = do satisfy $ \c -> c == ';' || c == '#' || c == '*' void $ takeWhileP Nothing (\c -> c /= '\n') optional newline pure () {-# INLINABLE emptyorcommentlinep #-} -- A parser combinator for parsing (possibly multiline) comments -- following journal items. -- -- Several journal items may be followed by comments, which begin with -- semicolons and extend to the end of the line. Such comments may span -- multiple lines, but comment lines below the journal item must be -- preceded by leading whitespace. -- -- This parser combinator accepts a parser that consumes all input up -- until the next newline. This parser should extract the "content" from -- comments. The resulting parser returns this content plus the raw text -- of the comment itself. -- -- See followingcommentp for tests. -- followingcommentp' :: (Monoid a, Show a) => TextParser m a -> TextParser m (Text, a) followingcommentp' contentp = do skipNonNewlineSpaces -- there can be 0 or 1 sameLine sameLine <- try headerp *> ((:[]) <$> match' contentp) <|> pure [] _ <- eolof -- there can be 0 or more nextLines nextLines <- many $ try (skipNonNewlineSpaces1 *> headerp) *> match' contentp <* eolof let -- if there's just a next-line comment, insert an empty same-line comment -- so the next-line comment doesn't get rendered as a same-line comment. sameLine' | null sameLine && not (null nextLines) = [("",mempty)] | otherwise = sameLine (texts, contents) = unzip $ sameLine' ++ nextLines strippedCommentText = T.unlines $ map T.strip texts commentContent = mconcat contents pure (strippedCommentText, commentContent) where headerp = char ';' *> skipNonNewlineSpaces {-# INLINABLE followingcommentp' #-} -- | Parse the text of a (possibly multiline) comment following a journal item. -- -- >>> rtp followingcommentp "" -- no comment -- Right "" -- >>> rtp followingcommentp ";" -- just a (empty) same-line comment. newline is added -- Right "\n" -- >>> rtp followingcommentp "; \n" -- Right "\n" -- >>> rtp followingcommentp ";\n ;\n" -- a same-line and a next-line comment -- Right "\n\n" -- >>> rtp followingcommentp "\n ;\n" -- just a next-line comment. Insert an empty same-line comment so the next-line comment doesn't become a same-line comment. -- Right "\n\n" -- followingcommentp :: TextParser m Text followingcommentp = fst <$> followingcommentp' (void $ takeWhileP Nothing (/= '\n')) -- XXX support \r\n ? {-# INLINABLE followingcommentp #-} -- | Parse a transaction comment and extract its tags. -- -- The first line of a transaction may be followed by comments, which -- begin with semicolons and extend to the end of the line. Transaction -- comments may span multiple lines, but comment lines below the -- transaction must be preceded by leading whitespace. -- -- 2000/1/1 ; a transaction comment starting on the same line ... -- ; extending to the next line -- account1 $1 -- account2 -- -- Tags are name-value pairs. -- -- >>> let getTags (_,tags) = tags -- >>> let parseTags = fmap getTags . rtp transactioncommentp -- -- >>> parseTags "; name1: val1, name2:all this is value2" -- Right [("name1","val1"),("name2","all this is value2")] -- -- A tag's name must be immediately followed by a colon, without -- separating whitespace. The corresponding value consists of all the text -- following the colon up until the next colon or newline, stripped of -- leading and trailing whitespace. -- transactioncommentp :: TextParser m (Text, [Tag]) transactioncommentp = followingcommentp' commenttagsp {-# INLINABLE transactioncommentp #-} commenttagsp :: TextParser m [Tag] commenttagsp = do tagName <- fmap (last . T.split isSpace) $ takeWhileP Nothing (\c -> c /= ':' && c /= '\n') atColon tagName <|> pure [] -- if not ':', then either '\n' or EOF where atColon :: Text -> TextParser m [Tag] atColon name = char ':' *> do if T.null name then commenttagsp else do skipNonNewlineSpaces val <- tagValue let tag = (name, val) (tag:) <$> commenttagsp tagValue :: TextParser m Text tagValue = do val <- T.strip <$> takeWhileP Nothing (\c -> c /= ',' && c /= '\n') _ <- optional $ char ',' pure val {-# INLINABLE commenttagsp #-} -- | Parse a posting comment and extract its tags and dates. -- -- Postings may be followed by comments, which begin with semicolons and -- extend to the end of the line. Posting comments may span multiple -- lines, but comment lines below the posting must be preceded by -- leading whitespace. -- -- 2000/1/1 -- account1 $1 ; a posting comment starting on the same line ... -- ; extending to the next line -- -- account2 -- ; a posting comment beginning on the next line -- -- Tags are name-value pairs. -- -- >>> let getTags (_,tags,_,_) = tags -- >>> let parseTags = fmap getTags . rtp (postingcommentp Nothing) -- -- >>> parseTags "; name1: val1, name2:all this is value2" -- Right [("name1","val1"),("name2","all this is value2")] -- -- A tag's name must be immediately followed by a colon, without -- separating whitespace. The corresponding value consists of all the text -- following the colon up until the next colon or newline, stripped of -- leading and trailing whitespace. -- -- Posting dates may be expressed with "date"/"date2" tags or with -- bracketed date syntax. Posting dates will inherit their year from the -- transaction date if the year is not specified. We throw parse errors on -- invalid dates. -- -- >>> let getDates (_,_,d1,d2) = (d1, d2) -- >>> let parseDates = fmap getDates . rtp (postingcommentp (Just 2000)) -- -- >>> parseDates "; date: 1/2, date2: 1999/12/31" -- Right (Just 2000-01-02,Just 1999-12-31) -- >>> parseDates "; [1/2=1999/12/31]" -- Right (Just 2000-01-02,Just 1999-12-31) -- -- Example: tags, date tags, and bracketed dates -- >>> rtp (postingcommentp (Just 2000)) "; a:b, date:3/4, [=5/6]" -- Right ("a:b, date:3/4, [=5/6]\n",[("a","b"),("date","3/4")],Just 2000-03-04,Just 2000-05-06) -- -- Example: extraction of dates from date tags ignores trailing text -- >>> rtp (postingcommentp (Just 2000)) "; date:3/4=5/6" -- Right ("date:3/4=5/6\n",[("date","3/4=5/6")],Just 2000-03-04,Nothing) -- postingcommentp :: Maybe Year -> TextParser m (Text, [Tag], Maybe Day, Maybe Day) postingcommentp mYear = do (commentText, (tags, dateTags)) <- followingcommentp' (commenttagsanddatesp mYear) let mdate = fmap snd $ find ((=="date") .fst) dateTags mdate2 = fmap snd $ find ((=="date2").fst) dateTags pure (commentText, tags, mdate, mdate2) {-# INLINABLE postingcommentp #-} commenttagsanddatesp :: Maybe Year -> TextParser m ([Tag], [DateTag]) commenttagsanddatesp mYear = do (txt, dateTags) <- match $ readUpTo ':' -- next char is either ':' or '\n' (or EOF) let tagName = last (T.split isSpace txt) (fmap.second) (dateTags++) (atColon tagName) <|> pure ([], dateTags) -- if not ':', then either '\n' or EOF where readUpTo :: Char -> TextParser m [DateTag] readUpTo end = do void $ takeWhileP Nothing (\c -> c /= end && c /= '\n' && c /= '[') -- if not '[' then ':' or '\n' or EOF atBracket (readUpTo end) <|> pure [] atBracket :: TextParser m [DateTag] -> TextParser m [DateTag] atBracket cont = do -- Uses the fact that bracketed date-tags cannot contain newlines dateTags <- option [] $ lookAhead (bracketeddatetagsp mYear) _ <- char '[' dateTags' <- cont pure $ dateTags ++ dateTags' atColon :: Text -> TextParser m ([Tag], [DateTag]) atColon name = char ':' *> do skipNonNewlineSpaces (tags, dateTags) <- case name of "" -> pure ([], []) "date" -> dateValue name "date2" -> dateValue name _ -> tagValue name _ <- optional $ char ',' bimap (tags++) (dateTags++) <$> commenttagsanddatesp mYear dateValue :: Text -> TextParser m ([Tag], [DateTag]) dateValue name = do (txt, (date, dateTags)) <- match' $ do date <- datep' mYear dateTags <- readUpTo ',' pure (date, dateTags) let val = T.strip txt pure $ ( [(name, val)] , (name, date) : dateTags ) tagValue :: Text -> TextParser m ([Tag], [DateTag]) tagValue name = do (txt, dateTags) <- match' $ readUpTo ',' let val = T.strip txt pure $ ( [(name, val)] , dateTags ) {-# INLINABLE commenttagsanddatesp #-} -- | Parse Ledger-style bracketed posting dates ([DATE=DATE2]), as -- "date" and/or "date2" tags. Anything that looks like an attempt at -- this (a square-bracketed sequence of 0123456789/-.= containing at -- least one digit and one date separator) is also parsed, and will -- throw an appropriate error. -- -- The dates are parsed in full here so that errors are reported in -- the right position. A missing year in DATE can be inferred if a -- default date is provided. A missing year in DATE2 will be inferred -- from DATE. -- -- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[2016/1/2=3/4]" -- Right [("date",2016-01-02),("date2",2016-03-04)] -- -- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[1]" -- Left ...not a bracketed date... -- -- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[2016/1/32]" -- Left ...1:2:...well-formed but invalid date: 2016/1/32... -- -- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[1/31]" -- Left ...1:2:...partial date 1/31 found, but the current year is unknown... -- -- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[0123456789/-.=/-.=]" -- Left ...1:13:...expecting month or day... -- bracketeddatetagsp :: Maybe Year -> TextParser m [(TagName, Day)] bracketeddatetagsp mYear1 = do -- dbgparse 0 "bracketeddatetagsp" try $ do s <- lookAhead $ between (char '[') (char ']') $ takeWhile1P Nothing isBracketedDateChar unless (T.any isDigit s && T.any isDateSepChar s) $ Fail.fail "not a bracketed date" -- Looks sufficiently like a bracketed date to commit to parsing a date between (char '[') (char ']') $ do md1 <- optional $ datep' mYear1 let mYear2 = fmap readYear md1 <|> mYear1 md2 <- optional $ char '=' *> datep' mYear2 pure $ catMaybes [("date",) <$> md1, ("date2",) <$> md2] where readYear = first3 . toGregorian isBracketedDateChar c = isDigit c || isDateSepChar c || c == '=' {-# INLINABLE bracketeddatetagsp #-} --- ** tests tests_Common = tests "Common" [ tests "amountp" [ test "basic" $ assertParseEq amountp "$47.18" (usd 47.18) ,test "ends with decimal mark" $ assertParseEq amountp "$1." (usd 1 `withPrecision` Precision 0) ,test "unit price" $ assertParseEq amountp "$10 @ €0.5" -- not precise enough: -- (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) -- `withStyle` asdecimalpoint=Just '.' amount{ acommodity="$" ,aquantity=10 -- need to test internal precision with roundTo ? I think not ,astyle=amountstyle{asprecision=Precision 0, asdecimalpoint=Nothing} ,aprice=Just $ UnitPrice $ amount{ acommodity="€" ,aquantity=0.5 ,astyle=amountstyle{asprecision=Precision 1, asdecimalpoint=Just '.'} } } ,test "total price" $ assertParseEq amountp "$10 @@ €5" amount{ acommodity="$" ,aquantity=10 ,astyle=amountstyle{asprecision=Precision 0, asdecimalpoint=Nothing} ,aprice=Just $ TotalPrice $ amount{ acommodity="€" ,aquantity=5 ,astyle=amountstyle{asprecision=Precision 0, asdecimalpoint=Nothing} } } ,test "unit price, parenthesised" $ assertParse amountp "$10 (@) €0.5" ,test "total price, parenthesised" $ assertParse amountp "$10 (@@) €0.5" ] ,let p = lift (numberp Nothing) :: JournalParser IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle) in test "numberp" $ do assertParseEq p "0" (0, 0, Nothing, Nothing) assertParseEq p "1" (1, 0, Nothing, Nothing) assertParseEq p "1.1" (1.1, 1, Just '.', Nothing) assertParseEq p "1,000.1" (1000.1, 1, Just '.', Just $ DigitGroups ',' [3]) assertParseEq p "1.00.000,1" (100000.1, 1, Just ',', Just $ DigitGroups '.' [3,2]) assertParseEq p "1,000,000" (1000000, 0, Nothing, Just $ DigitGroups ',' [3,3]) -- could be simplified to [3] assertParseEq p "1." (1, 0, Just '.', Nothing) assertParseEq p "1," (1, 0, Just ',', Nothing) assertParseEq p ".1" (0.1, 1, Just '.', Nothing) assertParseEq p ",1" (0.1, 1, Just ',', Nothing) assertParseError p "" "" assertParseError p "1,000.000,1" "" assertParseError p "1.000,000.1" "" assertParseError p "1,000.000.1" "" assertParseError p "1,,1" "" assertParseError p "1..1" "" assertParseError p ".1," "" assertParseError p ",1." "" assertParseEq p "1.555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" (1.555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555, 255, Just '.', Nothing) assertParseError p "1.5555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" "" ,tests "spaceandamountormissingp" [ test "space and amount" $ assertParseEq spaceandamountormissingp " $47.18" (Mixed [usd 47.18]) ,test "empty string" $ assertParseEq spaceandamountormissingp "" missingmixedamt -- ,test "just space" $ assertParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ? -- ,test "just amount" $ assertParseError spaceandamountormissingp "$47.18" "" -- succeeds, consuming nothing ] ] hledger-lib-1.19.1/Hledger/Read/CsvReader.hs0000644000000000000000000015441013723502755016624 0ustar0000000000000000--- * -*- outline-regexp:"--- \\*"; -*- --- ** doc -- In Emacs, use TAB on lines beginning with "-- *" to collapse/expand sections. {-| A reader for CSV data, using an extra rules file to help interpret the data. -} -- Lots of haddocks in this file are for non-exported types. -- Here's a command that will render them: -- stack haddock hledger-lib --fast --no-haddock-deps --haddock-arguments='--ignore-all-exports' --open --- ** language {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} --- ** exports module Hledger.Read.CsvReader ( -- * Reader reader, -- * Misc. CSV, CsvRecord, CsvValue, csvFileFor, rulesFileFor, parseRulesFile, printCSV, -- * Tests tests_CsvReader, ) where --- ** imports import Prelude () import "base-compat-batteries" Prelude.Compat hiding (fail) import Control.Applicative (liftA2) import Control.Exception (IOException, handle, throw) import Control.Monad (liftM, unless, when) import Control.Monad.Except (ExceptT, throwError) import qualified Control.Monad.Fail as Fail import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.State.Strict (StateT, get, modify', evalStateT) import Control.Monad.Trans.Class (lift) import Data.Char (toLower, isDigit, isSpace, isAlphaNum, isAscii, ord) import Data.Bifunctor (first) import "base-compat-batteries" Data.List.Compat import qualified Data.List.Split as LS (splitOn) import Data.Maybe (catMaybes, fromMaybe, isJust) import Data.MemoUgly (memo) import Data.Ord (comparing) import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T import Data.Time.Calendar (Day) import Data.Time.Format (parseTimeM, defaultTimeLocale) import Safe (atMay, headMay, lastMay, readDef, readMay) import System.Directory (doesFileExist) import System.FilePath ((), takeDirectory, takeExtension, takeFileName) import qualified Data.Csv as Cassava import qualified Data.Csv.Parser.Megaparsec as CassavaMP import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Foldable (asum, toList) import Text.Megaparsec hiding (match, parse) import Text.Megaparsec.Char (char, newline, string) import Text.Megaparsec.Custom (customErrorBundlePretty, parseErrorAt) import Text.Printf (printf) import Hledger.Data import Hledger.Utils import Hledger.Read.Common (Reader(..),InputOpts(..),amountp, statusp, genericSourcePos, journalFinalise) --- ** doctest setup -- $setup -- >>> :set -XOverloadedStrings --- ** some types type CSV = [CsvRecord] type CsvRecord = [CsvValue] type CsvValue = String --- ** reader reader :: MonadIO m => Reader m reader = Reader {rFormat = "csv" ,rExtensions = ["csv","tsv","ssv"] ,rReadFn = parse ,rParser = error' "sorry, CSV files can't be included yet" -- PARTIAL: } -- | Parse and post-process a "Journal" from CSV data, or give an error. -- Does not check balance assertions. -- XXX currently ignores the provided data, reads it from the file path instead. parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal parse iopts f t = do let rulesfile = mrules_file_ iopts r <- liftIO $ readJournalFromCsv rulesfile f t case r of Left e -> throwError e Right pj -> journalFinalise iopts{ignore_assertions_=True} f t pj' where -- journalFinalise assumes the journal's items are -- reversed, as produced by JournalReader's parser. -- But here they are already properly ordered. So we'd -- better preemptively reverse them once more. XXX inefficient pj' = journalReverse pj --- ** reading rules files --- *** rules utilities -- Not used by hledger; just for lib users, -- | An pure-exception-throwing IO action that parses this file's content -- as CSV conversion rules, interpolating any included files first, -- and runs some extra validation checks. parseRulesFile :: FilePath -> ExceptT String IO CsvRules parseRulesFile f = liftIO (readFilePortably f >>= expandIncludes (takeDirectory f)) >>= either throwError return . parseAndValidateCsvRules f -- | Given a CSV file path, what would normally be the corresponding rules file ? rulesFileFor :: FilePath -> FilePath rulesFileFor = (++ ".rules") -- | Given a CSV rules file path, what would normally be the corresponding CSV file ? csvFileFor :: FilePath -> FilePath csvFileFor = reverse . drop 6 . reverse defaultRulesText :: FilePath -> Text defaultRulesText csvfile = T.pack $ unlines ["# hledger csv conversion rules for " ++ csvFileFor (takeFileName csvfile) ,"# cf http://hledger.org/manual#csv-files" ,"" ,"account1 assets:bank:checking" ,"" ,"fields date, description, amount1" ,"" ,"#skip 1" ,"#newest-first" ,"" ,"#date-format %-d/%-m/%Y" ,"#date-format %-m/%-d/%Y" ,"#date-format %Y-%h-%d" ,"" ,"#currency $" ,"" ,"if ITUNES" ," account2 expenses:entertainment" ,"" ,"if (TO|FROM) SAVINGS" ," account2 assets:bank:savings\n" ] addDirective :: (DirectiveName, String) -> CsvRulesParsed -> CsvRulesParsed addDirective d r = r{rdirectives=d:rdirectives r} addAssignment :: (HledgerFieldName, FieldTemplate) -> CsvRulesParsed -> CsvRulesParsed addAssignment a r = r{rassignments=a:rassignments r} setIndexesAndAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed setIndexesAndAssignmentsFromList fs r = addAssignmentsFromList fs . setCsvFieldIndexesFromList fs $ r setCsvFieldIndexesFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed setCsvFieldIndexesFromList fs r = r{rcsvfieldindexes=zip fs [1..]} addAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed addAssignmentsFromList fs r = foldl' maybeAddAssignment r journalfieldnames where maybeAddAssignment rules f = (maybe id addAssignmentFromIndex $ elemIndex f fs) rules where addAssignmentFromIndex i = addAssignment (f, "%"++show (i+1)) addConditionalBlock :: ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed addConditionalBlock b r = r{rconditionalblocks=b:rconditionalblocks r} addConditionalBlocks :: [ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed addConditionalBlocks bs r = r{rconditionalblocks=bs++rconditionalblocks r} getDirective :: DirectiveName -> CsvRules -> Maybe FieldTemplate getDirective directivename = lookup directivename . rdirectives instance ShowErrorComponent String where showErrorComponent = id -- | Inline all files referenced by include directives in this hledger CSV rules text, recursively. -- Included file paths may be relative to the directory of the provided file path. -- This is done as a pre-parse step to simplify the CSV rules parser. expandIncludes :: FilePath -> Text -> IO Text expandIncludes dir content = mapM (expandLine dir) (T.lines content) >>= return . T.unlines where expandLine dir line = case line of (T.stripPrefix "include " -> Just f) -> expandIncludes dir' =<< T.readFile f' where f' = dir dropWhile isSpace (T.unpack f) dir' = takeDirectory f' _ -> return line -- | An error-throwing IO action that parses this text as CSV conversion rules -- and runs some extra validation checks. The file path is used in error messages. parseAndValidateCsvRules :: FilePath -> T.Text -> Either String CsvRules parseAndValidateCsvRules rulesfile s = case parseCsvRules rulesfile s of Left err -> Left $ customErrorBundlePretty err Right rules -> first makeFancyParseError $ validateRules rules where makeFancyParseError :: String -> String makeFancyParseError errorString = parseErrorPretty (FancyError 0 (S.singleton $ ErrorFail errorString) :: ParseError Text String) -- | Parse this text as CSV conversion rules. The file path is for error messages. parseCsvRules :: FilePath -> T.Text -> Either (ParseErrorBundle T.Text CustomErr) CsvRules -- parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s parseCsvRules rulesfile s = runParser (evalStateT rulesp defrules) rulesfile s -- | Return the validated rules, or an error. validateRules :: CsvRules -> Either String CsvRules validateRules rules = do unless (isAssigned "date") $ Left "Please specify (at top level) the date field. Eg: date %1\n" Right rules where isAssigned f = isJust $ getEffectiveAssignment rules [] f --- *** rules types -- | A set of data definitions and account-matching patterns sufficient to -- convert a particular CSV data file into meaningful journal transactions. data CsvRules' a = CsvRules' { rdirectives :: [(DirectiveName,String)], -- ^ top-level rules, as (keyword, value) pairs rcsvfieldindexes :: [(CsvFieldName, CsvFieldIndex)], -- ^ csv field names and their column number, if declared by a fields list rassignments :: [(HledgerFieldName, FieldTemplate)], -- ^ top-level assignments to hledger fields, as (field name, value template) pairs rconditionalblocks :: [ConditionalBlock], -- ^ conditional blocks, which containing additional assignments/rules to apply to matched csv records rblocksassigning :: a -- (String -> [ConditionalBlock]) -- ^ all conditional blocks which can potentially assign field with a given name (memoized) } -- | Type used by parsers. Directives, assignments and conditional blocks -- are in the reverse order compared to what is in the file and rblocksassigning is non-functional, -- could not be used for processing CSV records yet type CsvRulesParsed = CsvRules' () -- | Type used after parsing is done. Directives, assignments and conditional blocks -- are in the same order as they were in the unput file and rblocksassigning is functional. -- Ready to be used for CSV record processing type CsvRules = CsvRules' (String -> [ConditionalBlock]) instance Eq CsvRules where r1 == r2 = (rdirectives r1, rcsvfieldindexes r1, rassignments r1) == (rdirectives r2, rcsvfieldindexes r2, rassignments r2) -- It is used for debug output only instance Show CsvRules where show r = "CsvRules { rdirectives=" ++ show (rdirectives r) ++ ", rcsvfieldindexes=" ++ show (rcsvfieldindexes r) ++ ", rassignments=" ++ show (rassignments r) ++ ", rconditionalblocks="++ show (rconditionalblocks r) ++ " }" type CsvRulesParser a = StateT CsvRulesParsed SimpleTextParser a -- | The keyword of a CSV rule - "fields", "skip", "if", etc. type DirectiveName = String -- | CSV field name. type CsvFieldName = String -- | 1-based CSV column number. type CsvFieldIndex = Int -- | Percent symbol followed by a CSV field name or column number. Eg: %date, %1. type CsvFieldReference = String -- | One of the standard hledger fields or pseudo-fields that can be assigned to. -- Eg date, account1, amount, amount1-in, date-format. type HledgerFieldName = String -- | A text value to be assigned to a hledger field, possibly -- containing csv field references to be interpolated. type FieldTemplate = String -- | A strptime date parsing pattern, as supported by Data.Time.Format. type DateFormat = String -- | A prefix for a matcher test, either & or none (implicit or). data MatcherPrefix = And | None deriving (Show, Eq) -- | A single test for matching a CSV record, in one way or another. data Matcher = RecordMatcher MatcherPrefix Regexp -- ^ match if this regexp matches the overall CSV record | FieldMatcher MatcherPrefix CsvFieldReference Regexp -- ^ match if this regexp matches the referenced CSV field's value deriving (Show, Eq) -- | A conditional block: a set of CSV record matchers, and a sequence -- of rules which will be enabled only if one or more of the matchers -- succeeds. -- -- Three types of rule are allowed inside conditional blocks: field -- assignments, skip, end. (A skip or end rule is stored as if it was -- a field assignment, and executed in validateCsv. XXX) data ConditionalBlock = CB { cbMatchers :: [Matcher] ,cbAssignments :: [(HledgerFieldName, FieldTemplate)] } deriving (Show, Eq) defrules :: CsvRulesParsed defrules = CsvRules' { rdirectives=[], rcsvfieldindexes=[], rassignments=[], rconditionalblocks=[], rblocksassigning = () } -- | Create CsvRules from the content parsed out of the rules file mkrules :: CsvRulesParsed -> CsvRules mkrules rules = let conditionalblocks = reverse $ rconditionalblocks rules maybeMemo = if length conditionalblocks >= 15 then memo else id in CsvRules' { rdirectives=reverse $ rdirectives rules, rcsvfieldindexes=rcsvfieldindexes rules, rassignments=reverse $ rassignments rules, rconditionalblocks=conditionalblocks, rblocksassigning = maybeMemo (\f -> filter (any ((==f).fst) . cbAssignments) conditionalblocks) } matcherPrefix :: Matcher -> MatcherPrefix matcherPrefix (RecordMatcher prefix _) = prefix matcherPrefix (FieldMatcher prefix _ _) = prefix -- | Group matchers into associative pairs based on prefix, e.g.: -- A -- & B -- C -- D -- & E -- => [[A, B], [C], [D, E]] groupedMatchers :: [Matcher] -> [[Matcher]] groupedMatchers [] = [] groupedMatchers (x:xs) = (x:ys) : groupedMatchers zs where (ys, zs) = span (\y -> matcherPrefix y == And) xs --- *** rules parsers {- Grammar for the CSV conversion rules, more or less: RULES: RULE* RULE: ( FIELD-LIST | FIELD-ASSIGNMENT | CONDITIONAL-BLOCK | SKIP | NEWEST-FIRST | DATE-FORMAT | COMMENT | BLANK ) NEWLINE FIELD-LIST: fields SPACE FIELD-NAME ( SPACE? , SPACE? FIELD-NAME )* FIELD-NAME: QUOTED-FIELD-NAME | BARE-FIELD-NAME QUOTED-FIELD-NAME: " (any CHAR except double-quote)+ " BARE-FIELD-NAME: any CHAR except space, tab, #, ; FIELD-ASSIGNMENT: JOURNAL-FIELD ASSIGNMENT-SEPARATOR FIELD-VALUE JOURNAL-FIELD: date | date2 | status | code | description | comment | account1 | account2 | amount | JOURNAL-PSEUDO-FIELD JOURNAL-PSEUDO-FIELD: amount-in | amount-out | currency ASSIGNMENT-SEPARATOR: SPACE | ( : SPACE? ) FIELD-VALUE: VALUE (possibly containing CSV-FIELD-REFERENCEs) CSV-FIELD-REFERENCE: % CSV-FIELD CSV-FIELD: ( FIELD-NAME | FIELD-NUMBER ) (corresponding to a CSV field) FIELD-NUMBER: DIGIT+ CONDITIONAL-BLOCK: if ( FIELD-MATCHER NEWLINE )+ INDENTED-BLOCK FIELD-MATCHER: ( CSV-FIELD-NAME SPACE? )? ( MATCHOP SPACE? )? PATTERNS MATCHOP: ~ PATTERNS: ( NEWLINE REGEXP )* REGEXP INDENTED-BLOCK: ( SPACE ( FIELD-ASSIGNMENT | COMMENT ) NEWLINE )+ REGEXP: ( NONSPACE CHAR* ) SPACE? VALUE: SPACE? ( CHAR* ) SPACE? COMMENT: SPACE? COMMENT-CHAR VALUE COMMENT-CHAR: # | ; NONSPACE: any CHAR not a SPACE-CHAR BLANK: SPACE? SPACE: SPACE-CHAR+ SPACE-CHAR: space | tab CHAR: any character except newline DIGIT: 0-9 -} rulesp :: CsvRulesParser CsvRules rulesp = do _ <- many $ choice [blankorcommentlinep "blank or comment line" ,(directivep >>= modify' . addDirective) "directive" ,(fieldnamelistp >>= modify' . setIndexesAndAssignmentsFromList) "field name list" ,(fieldassignmentp >>= modify' . addAssignment) "field assignment" -- conditionalblockp backtracks because it shares "if" prefix with conditionaltablep. ,try (conditionalblockp >>= modify' . addConditionalBlock) "conditional block" -- 'reverse' is there to ensure that conditions are added in the order they listed in the file ,(conditionaltablep >>= modify' . addConditionalBlocks . reverse) "conditional table" ] eof r <- get return $ mkrules r blankorcommentlinep :: CsvRulesParser () blankorcommentlinep = lift (dbgparse 8 "trying blankorcommentlinep") >> choiceInState [blanklinep, commentlinep] blanklinep :: CsvRulesParser () blanklinep = lift skipNonNewlineSpaces >> newline >> return () "blank line" commentlinep :: CsvRulesParser () commentlinep = lift skipNonNewlineSpaces >> commentcharp >> lift restofline >> return () "comment line" commentcharp :: CsvRulesParser Char commentcharp = oneOf (";#*" :: [Char]) directivep :: CsvRulesParser (DirectiveName, String) directivep = (do lift $ dbgparse 8 "trying directive" d <- fmap T.unpack $ choiceInState $ map (lift . string . T.pack) directives v <- (((char ':' >> lift (many spacenonewline)) <|> lift (some spacenonewline)) >> directivevalp) <|> (optional (char ':') >> lift skipNonNewlineSpaces >> lift eolof >> return "") return (d, v) ) "directive" directives :: [String] directives = ["date-format" ,"separator" -- ,"default-account" -- ,"default-currency" ,"skip" ,"newest-first" , "balance-type" ] directivevalp :: CsvRulesParser String directivevalp = anySingle `manyTill` lift eolof fieldnamelistp :: CsvRulesParser [CsvFieldName] fieldnamelistp = (do lift $ dbgparse 8 "trying fieldnamelist" string "fields" optional $ char ':' lift skipNonNewlineSpaces1 let separator = lift skipNonNewlineSpaces >> char ',' >> lift skipNonNewlineSpaces f <- fromMaybe "" <$> optional fieldnamep fs <- some $ (separator >> fromMaybe "" <$> optional fieldnamep) lift restofline return $ map (map toLower) $ f:fs ) "field name list" fieldnamep :: CsvRulesParser String fieldnamep = quotedfieldnamep <|> barefieldnamep quotedfieldnamep :: CsvRulesParser String quotedfieldnamep = do char '"' f <- some $ noneOf ("\"\n:;#~" :: [Char]) char '"' return f barefieldnamep :: CsvRulesParser String barefieldnamep = some $ noneOf (" \t\n,;#~" :: [Char]) fieldassignmentp :: CsvRulesParser (HledgerFieldName, FieldTemplate) fieldassignmentp = do lift $ dbgparse 8 "trying fieldassignmentp" f <- journalfieldnamep v <- choiceInState [ assignmentseparatorp >> fieldvalp , lift eolof >> return "" ] return (f,v) "field assignment" journalfieldnamep :: CsvRulesParser String journalfieldnamep = do lift (dbgparse 8 "trying journalfieldnamep") T.unpack <$> choiceInState (map (lift . string . T.pack) journalfieldnames) maxpostings = 99 -- Transaction fields and pseudo fields for CSV conversion. -- Names must precede any other name they contain, for the parser -- (amount-in before amount; date2 before date). TODO: fix journalfieldnames = concat [[ "account" ++ i ,"amount" ++ i ++ "-in" ,"amount" ++ i ++ "-out" ,"amount" ++ i ,"balance" ++ i ,"comment" ++ i ,"currency" ++ i ] | x <- [maxpostings, (maxpostings-1)..1], let i = show x] ++ ["amount-in" ,"amount-out" ,"amount" ,"balance" ,"code" ,"comment" ,"currency" ,"date2" ,"date" ,"description" ,"status" ,"skip" -- skip and end are not really fields, but we list it here to allow conditional rules that skip records ,"end" ] assignmentseparatorp :: CsvRulesParser () assignmentseparatorp = do lift $ dbgparse 8 "trying assignmentseparatorp" _ <- choiceInState [ lift skipNonNewlineSpaces >> char ':' >> lift skipNonNewlineSpaces , lift skipNonNewlineSpaces1 ] return () fieldvalp :: CsvRulesParser String fieldvalp = do lift $ dbgparse 8 "trying fieldvalp" anySingle `manyTill` lift eolof -- A conditional block: one or more matchers, one per line, followed by one or more indented rules. conditionalblockp :: CsvRulesParser ConditionalBlock conditionalblockp = do lift $ dbgparse 8 "trying conditionalblockp" -- "if\nMATCHER" or "if \nMATCHER" or "if MATCHER" start <- getOffset string "if" >> ( (newline >> return Nothing) <|> (lift skipNonNewlineSpaces1 >> optional newline)) ms <- some matcherp as <- catMaybes <$> many (lift skipNonNewlineSpaces1 >> choice [ lift eolof >> return Nothing , fmap Just fieldassignmentp ]) when (null as) $ customFailure $ parseErrorAt start $ "start of conditional block found, but no assignment rules afterward\n(assignment rules in a conditional block should be indented)\n" return $ CB{cbMatchers=ms, cbAssignments=as} "conditional block" -- A conditional table: "if" followed by separator, followed by some field names, -- followed by many lines, each of which has: -- one matchers, followed by field assignments (as many as there were fields) conditionaltablep :: CsvRulesParser [ConditionalBlock] conditionaltablep = do lift $ dbgparse 8 "trying conditionaltablep" start <- getOffset string "if" sep <- lift $ satisfy (\c -> not (isAlphaNum c || isSpace c)) fields <- journalfieldnamep `sepBy1` (char sep) newline body <- flip manyTill (lift eolof) $ do off <- getOffset m <- matcherp' (char sep >> return ()) vs <- LS.splitOn [sep] <$> lift restofline if (length vs /= length fields) then customFailure $ parseErrorAt off $ ((printf "line of conditional table should have %d values, but this one has only %d\n" (length fields) (length vs)) :: String) else return (m,vs) when (null body) $ customFailure $ parseErrorAt start $ "start of conditional table found, but no assignment rules afterward\n" return $ flip map body $ \(m,vs) -> CB{cbMatchers=[m], cbAssignments=zip fields vs} "conditional table" -- A single matcher, on one line. matcherp' :: CsvRulesParser () -> CsvRulesParser Matcher matcherp' end = try (fieldmatcherp end) <|> recordmatcherp end matcherp :: CsvRulesParser Matcher matcherp = matcherp' (lift eolof) -- A single whole-record matcher. -- A pattern on the whole line, not beginning with a csv field reference. recordmatcherp :: CsvRulesParser () -> CsvRulesParser Matcher recordmatcherp end = do lift $ dbgparse 8 "trying recordmatcherp" -- pos <- currentPos -- _ <- optional (matchoperatorp >> lift skipNonNewlineSpaces >> optional newline) p <- matcherprefixp r <- regexp end return $ RecordMatcher p r -- when (null ps) $ -- Fail.fail "start of record matcher found, but no patterns afterward\n(patterns should not be indented)\n" "record matcher" -- | A single matcher for a specific field. A csv field reference -- (like %date or %1), and a pattern on the rest of the line, -- optionally space-separated. Eg: -- %description chez jacques fieldmatcherp :: CsvRulesParser () -> CsvRulesParser Matcher fieldmatcherp end = do lift $ dbgparse 8 "trying fieldmatcher" -- An optional fieldname (default: "all") -- f <- fromMaybe "all" `fmap` (optional $ do -- f' <- fieldnamep -- lift skipNonNewlineSpaces -- return f') p <- matcherprefixp f <- csvfieldreferencep <* lift skipNonNewlineSpaces -- optional operator.. just ~ (case insensitive infix regex) for now -- _op <- fromMaybe "~" <$> optional matchoperatorp lift skipNonNewlineSpaces r <- regexp end return $ FieldMatcher p f r "field matcher" matcherprefixp :: CsvRulesParser MatcherPrefix matcherprefixp = do lift $ dbgparse 8 "trying matcherprefixp" (char '&' >> lift skipNonNewlineSpaces >> return And) <|> return None csvfieldreferencep :: CsvRulesParser CsvFieldReference csvfieldreferencep = do lift $ dbgparse 8 "trying csvfieldreferencep" char '%' f <- fieldnamep return $ '%' : quoteIfNeeded f -- A single regular expression regexp :: CsvRulesParser () -> CsvRulesParser Regexp regexp end = do lift $ dbgparse 8 "trying regexp" -- notFollowedBy matchoperatorp c <- lift nonspace cs <- anySingle `manyTill` end case toRegexCI . strip $ c:cs of Left x -> Fail.fail $ "CSV parser: " ++ x Right x -> return x -- -- A match operator, indicating the type of match to perform. -- -- Currently just ~ meaning case insensitive infix regex match. -- matchoperatorp :: CsvRulesParser String -- matchoperatorp = fmap T.unpack $ choiceInState $ map string -- ["~" -- -- ,"!~" -- -- ,"=" -- -- ,"!=" -- ] --- ** reading csv files -- | Read a Journal from the given CSV data (and filename, used for error -- messages), or return an error. Proceed as follows: -- -- 1. parse CSV conversion rules from the specified rules file, or from -- the default rules file for the specified CSV file, if it exists, -- or throw a parse error; if it doesn't exist, use built-in default rules -- -- 2. parse the CSV data, or throw a parse error -- -- 3. convert the CSV records to transactions using the rules -- -- 4. if the rules file didn't exist, create it with the default rules and filename -- -- 5. return the transactions as a Journal -- readJournalFromCsv :: Maybe FilePath -> FilePath -> Text -> IO (Either String Journal) readJournalFromCsv Nothing "-" _ = return $ Left "please use --rules-file when reading CSV from stdin" readJournalFromCsv mrulesfile csvfile csvdata = handle (\(e::IOException) -> return $ Left $ show e) $ do -- make and throw an IO exception.. which we catch and convert to an Either above ? let throwerr = throw . userError -- parse the csv rules let rulesfile = fromMaybe (rulesFileFor csvfile) mrulesfile rulesfileexists <- doesFileExist rulesfile rulestext <- if rulesfileexists then do dbg6IO "using conversion rules file" rulesfile readFilePortably rulesfile >>= expandIncludes (takeDirectory rulesfile) else return $ defaultRulesText rulesfile rules <- either throwerr return $ parseAndValidateCsvRules rulesfile rulestext dbg6IO "rules" rules -- parse the skip directive's value, if any let skiplines = case getDirective "skip" rules of Nothing -> 0 Just "" -> 1 Just s -> readDef (throwerr $ "could not parse skip value: " ++ show s) s -- parse csv let -- parsec seems to fail if you pass it "-" here TODO: try again with megaparsec parsecfilename = if csvfile == "-" then "(stdin)" else csvfile separator = case getDirective "separator" rules >>= parseSeparator of Just c -> c _ | ext == "ssv" -> ';' _ | ext == "tsv" -> '\t' _ -> ',' where ext = map toLower $ drop 1 $ takeExtension csvfile dbg6IO "using separator" separator records <- (either throwerr id . dbg7 "validateCsv" . validateCsv rules skiplines . dbg7 "parseCsv") `fmap` parseCsv separator parsecfilename csvdata dbg6IO "first 3 csv records" $ take 3 records -- identify header lines -- let (headerlines, datalines) = identifyHeaderLines records -- mfieldnames = lastMay headerlines let -- convert CSV records to transactions txns = snd $ mapAccumL (\pos r -> let SourcePos name line col = pos line' = (mkPos . (+1) . unPos) line pos' = SourcePos name line' col in (pos, transactionFromCsvRecord pos' rules r) ) (initialPos parsecfilename) records -- Ensure transactions are ordered chronologically. -- First, if the CSV records seem to be most-recent-first (because -- there's an explicit "newest-first" directive, or there's more -- than one date and the first date is more recent than the last): -- reverse them to get same-date transactions ordered chronologically. txns' = (if newestfirst || mdataseemsnewestfirst == Just True then reverse else id) txns where newestfirst = dbg6 "newestfirst" $ isJust $ getDirective "newest-first" rules mdataseemsnewestfirst = dbg6 "mdataseemsnewestfirst" $ case nub $ map tdate txns of ds | length ds > 1 -> Just $ head ds > last ds _ -> Nothing -- Second, sort by date. txns'' = sortBy (comparing tdate) txns' when (not rulesfileexists) $ do dbg1IO "creating conversion rules file" rulesfile writeFile rulesfile $ T.unpack rulestext return $ Right nulljournal{jtxns=txns''} -- | Parse special separator names TAB and SPACE, or return the first -- character. Return Nothing on empty string parseSeparator :: String -> Maybe Char parseSeparator = specials . map toLower where specials "space" = Just ' ' specials "tab" = Just '\t' specials (x:_) = Just x specials [] = Nothing parseCsv :: Char -> FilePath -> Text -> IO (Either String CSV) parseCsv separator filePath csvdata = case filePath of "-" -> liftM (parseCassava separator "(stdin)") T.getContents _ -> return $ parseCassava separator filePath csvdata parseCassava :: Char -> FilePath -> Text -> Either String CSV parseCassava separator path content = either (Left . errorBundlePretty) (Right . parseResultToCsv) <$> CassavaMP.decodeWith (decodeOptions separator) Cassava.NoHeader path $ BL.fromStrict $ T.encodeUtf8 content decodeOptions :: Char -> Cassava.DecodeOptions decodeOptions separator = Cassava.defaultDecodeOptions { Cassava.decDelimiter = fromIntegral (ord separator) } parseResultToCsv :: (Foldable t, Functor t) => t (t B.ByteString) -> CSV parseResultToCsv = toListList . unpackFields where toListList = toList . fmap toList unpackFields = (fmap . fmap) (T.unpack . T.decodeUtf8) printCSV :: CSV -> String printCSV records = unlined (printRecord `map` records) where printRecord = concat . intersperse "," . map printField printField f = "\"" ++ concatMap escape f ++ "\"" escape '"' = "\"\"" escape x = [x] unlined = concat . intersperse "\n" -- | Return the cleaned up and validated CSV data (can be empty), or an error. validateCsv :: CsvRules -> Int -> Either String CSV -> Either String [CsvRecord] validateCsv _ _ (Left err) = Left err validateCsv rules numhdrlines (Right rs) = validate $ applyConditionalSkips $ drop numhdrlines $ filternulls rs where filternulls = filter (/=[""]) skipCount r = case (getEffectiveAssignment rules r "end", getEffectiveAssignment rules r "skip") of (Nothing, Nothing) -> Nothing (Just _, _) -> Just maxBound (Nothing, Just "") -> Just 1 (Nothing, Just x) -> Just (read x) applyConditionalSkips [] = [] applyConditionalSkips (r:rest) = case skipCount r of Nothing -> r:(applyConditionalSkips rest) Just cnt -> applyConditionalSkips (drop (cnt-1) rest) validate [] = Right [] validate rs@(_first:_) = case lessthan2 of Just r -> Left $ printf "CSV record %s has less than two fields" (show r) Nothing -> Right rs where lessthan2 = headMay $ filter ((<2).length) rs -- -- | The highest (0-based) field index referenced in the field -- -- definitions, or -1 if no fields are defined. -- maxFieldIndex :: CsvRules -> Int -- maxFieldIndex r = maximumDef (-1) $ catMaybes [ -- dateField r -- ,statusField r -- ,codeField r -- ,amountField r -- ,amountInField r -- ,amountOutField r -- ,currencyField r -- ,accountField r -- ,account2Field r -- ,date2Field r -- ] --- ** converting csv records to transactions showRules rules record = unlines $ catMaybes [ (("the "++fld++" rule is: ")++) <$> getEffectiveAssignment rules record fld | fld <- journalfieldnames] -- | Look up the value (template) of a csv rule by rule keyword. csvRule :: CsvRules -> DirectiveName -> Maybe FieldTemplate csvRule rules = (`getDirective` rules) -- | Look up the value template assigned to a hledger field by field -- list/field assignment rules, taking into account the current record and -- conditional rules. hledgerField :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe FieldTemplate hledgerField = getEffectiveAssignment -- | Look up the final value assigned to a hledger field, with csv field -- references interpolated. hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe String hledgerFieldValue rules record = fmap (renderTemplate rules record) . hledgerField rules record transactionFromCsvRecord :: SourcePos -> CsvRules -> CsvRecord -> Transaction transactionFromCsvRecord sourcepos rules record = t where ---------------------------------------------------------------------- -- 1. Define some helpers: rule = csvRule rules :: DirectiveName -> Maybe FieldTemplate -- ruleval = csvRuleValue rules record :: DirectiveName -> Maybe String field = hledgerField rules record :: HledgerFieldName -> Maybe FieldTemplate fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String parsedate = parseDateWithCustomOrDefaultFormats (rule "date-format") mkdateerror datefield datevalue mdateformat = unlines ["error: could not parse \""++datevalue++"\" as a date using date format " ++maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" show mdateformat ,showRecord record ,"the "++datefield++" rule is: "++(fromMaybe "required, but missing" $ field datefield) ,"the date-format is: "++fromMaybe "unspecified" mdateformat ,"you may need to " ++"change your "++datefield++" rule, " ++maybe "add a" (const "change your") mdateformat++" date-format rule, " ++"or "++maybe "add a" (const "change your") mskip++" skip rule" ,"for m/d/y or d/m/y dates, use date-format %-m/%-d/%Y or date-format %-d/%-m/%Y" ] where mskip = rule "skip" ---------------------------------------------------------------------- -- 2. Gather values needed for the transaction itself, by evaluating the -- field assignment rules using the CSV record's data, and parsing a bit -- more where needed (dates, status). mdateformat = rule "date-format" date = fromMaybe "" $ fieldval "date" -- PARTIAL: date' = fromMaybe (error' $ mkdateerror "date" date mdateformat) $ parsedate date mdate2 = fieldval "date2" mdate2' = maybe Nothing (maybe (error' $ mkdateerror "date2" (fromMaybe "" mdate2) mdateformat) Just . parsedate) mdate2 status = case fieldval "status" of Nothing -> Unmarked Just s -> either statuserror id $ runParser (statusp <* eof) "" $ T.pack s where statuserror err = error' $ unlines ["error: could not parse \""++s++"\" as a cleared status (should be *, ! or empty)" ,"the parse error is: "++customErrorBundlePretty err ] code = maybe "" singleline $ fieldval "code" description = maybe "" singleline $ fieldval "description" comment = maybe "" singleline $ fieldval "comment" precomment = maybe "" singleline $ fieldval "precomment" ---------------------------------------------------------------------- -- 3. Generate the postings for which an account has been assigned -- (possibly indirectly due to an amount or balance assignment) p1IsVirtual = (accountNamePostingType . T.pack <$> fieldval "account1") == Just VirtualPosting ps = [p | n <- [1..maxpostings] ,let comment = T.pack $ fromMaybe "" $ fieldval ("comment"++show n) ,let currency = fromMaybe "" (fieldval ("currency"++show n) <|> fieldval "currency") ,let mamount = getAmount rules record currency p1IsVirtual n ,let mbalance = getBalance rules record currency n ,Just (acct,isfinal) <- [getAccount rules record mamount mbalance n] -- skips Nothings ,let acct' | not isfinal && acct==unknownExpenseAccount && fromMaybe False (mamount >>= isNegativeMixedAmount) = unknownIncomeAccount | otherwise = acct ,let p = nullposting{paccount = accountNameWithoutPostingType acct' ,pamount = fromMaybe missingmixedamt mamount ,ptransaction = Just t ,pbalanceassertion = mkBalanceAssertion rules record <$> mbalance ,pcomment = comment ,ptype = accountNamePostingType acct } ] ---------------------------------------------------------------------- -- 4. Build the transaction (and name it, so the postings can reference it). t = nulltransaction{ tsourcepos = genericSourcePos sourcepos -- the CSV line number ,tdate = date' ,tdate2 = mdate2' ,tstatus = status ,tcode = T.pack code ,tdescription = T.pack description ,tcomment = T.pack comment ,tprecedingcomment = T.pack precomment ,tpostings = ps } -- | Figure out the amount specified for posting N, if any. -- A currency symbol to prepend to the amount, if any, is provided, -- and whether posting 1 requires balancing or not. -- This looks for a non-empty amount value assigned to "amountN", "amountN-in", or "amountN-out". -- For postings 1 or 2 it also looks at "amount", "amount-in", "amount-out". -- If more than one of these has a value, it looks for one that is non-zero. -- If there's multiple non-zeros, or no non-zeros but multiple zeros, it throws an error. getAmount :: CsvRules -> CsvRecord -> String -> Bool -> Int -> Maybe MixedAmount getAmount rules record currency p1IsVirtual n = -- Warning, many tricky corner cases here. -- docs: hledger_csv.m4.md #### amount -- tests: tests/csv.test ~ 13, 31-34 let unnumberedfieldnames = ["amount","amount-in","amount-out"] -- amount field names which can affect this posting fieldnames = map (("amount"++show n)++) ["","-in","-out"] -- For posting 1, also recognise the old amount/amount-in/amount-out names. -- For posting 2, the same but only if posting 1 needs balancing. ++ if n==1 || n==2 && not p1IsVirtual then unnumberedfieldnames else [] -- assignments to any of these field names with non-empty values assignments = [(f,a') | f <- fieldnames , Just v@(_:_) <- [strip . renderTemplate rules record <$> hledgerField rules record f] , let a = parseAmount rules record currency v -- With amount/amount-in/amount-out, in posting 2, -- flip the sign and convert to cost, as they did before 1.17 , let a' = if f `elem` unnumberedfieldnames && n==2 then mixedAmountCost (-a) else a ] -- if any of the numbered field names are present, discard all the unnumbered ones assignments' | any isnumbered assignments = filter isnumbered assignments | otherwise = assignments where isnumbered (f,_) = any (flip elem ['0'..'9']) f -- if there's more than one value and only some are zeros, discard the zeros assignments'' | length assignments' > 1 && not (null nonzeros) = nonzeros | otherwise = assignments' where nonzeros = filter (not . mixedAmountLooksZero . snd) assignments' in case -- dbg0 ("amounts for posting "++show n) assignments'' of [] -> Nothing [(f,a)] | "-out" `isSuffixOf` f -> Just (-a) -- for -out fields, flip the sign [(_,a)] -> Just a fs -> error' $ unlines $ [ -- PARTIAL: "multiple non-zero amounts or multiple zero amounts assigned," ,"please ensure just one. (https://hledger.org/csv.html#amount)" ," " ++ showRecord record ," for posting: " ++ show n ] ++ [" assignment: " ++ f ++ " " ++ fromMaybe "" (hledgerField rules record f) ++ "\t=> value: " ++ showMixedAmount a -- XXX not sure this is showing all the right info | (f,a) <- fs] where -- | Given a non-empty amount string to parse, along with a possibly -- non-empty currency symbol to prepend, parse as a hledger amount (as -- in journal format), or raise an error. -- The CSV rules and record are provided for the error message. parseAmount :: CsvRules -> CsvRecord -> String -> String -> MixedAmount parseAmount rules record currency amountstr = either mkerror (Mixed . (:[])) $ -- PARTIAL: runParser (evalStateT (amountp <* eof) nulljournal) "" $ T.pack $ (currency++) $ simplifySign amountstr where mkerror e = error' $ unlines ["error: could not parse \""++amountstr++"\" as an amount" ,showRecord record ,showRules rules record -- ,"the default-currency is: "++fromMaybe "unspecified" (getDirective "default-currency" rules) ,"the parse error is: "++customErrorBundlePretty e ,"you may need to " ++"change your amount*, balance*, or currency* rules, " ++"or add or change your skip rule" ] -- | Figure out the expected balance (assertion or assignment) specified for posting N, -- if any (and its parse position). getBalance :: CsvRules -> CsvRecord -> String -> Int -> Maybe (Amount, GenericSourcePos) getBalance rules record currency n = (fieldval ("balance"++show n) -- for posting 1, also recognise the old field name <|> if n==1 then fieldval "balance" else Nothing) >>= parsebalance currency n . strip where parsebalance currency n s | null s = Nothing | otherwise = Just (either (mkerror n s) id $ runParser (evalStateT (amountp <* eof) nulljournal) "" $ T.pack $ (currency++) $ simplifySign s ,nullsourcepos) -- XXX parse position to show when assertion fails, -- the csv record's line number would be good where mkerror n s e = error' $ unlines ["error: could not parse \""++s++"\" as balance"++show n++" amount" ,showRecord record ,showRules rules record -- ,"the default-currency is: "++fromMaybe "unspecified" mdefaultcurrency ,"the parse error is: "++customErrorBundlePretty e ] -- mdefaultcurrency = rule "default-currency" fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String -- | Make a balance assertion for the given amount, with the given parse -- position (to be shown in assertion failures), with the assertion type -- possibly set by a balance-type rule. -- The CSV rules and current record are also provided, to be shown in case -- balance-type's argument is bad (XXX refactor). mkBalanceAssertion :: CsvRules -> CsvRecord -> (Amount, GenericSourcePos) -> BalanceAssertion mkBalanceAssertion rules record (amt, pos) = assrt{baamount=amt, baposition=pos} where assrt = case getDirective "balance-type" rules of Nothing -> nullassertion Just "=" -> nullassertion Just "==" -> nullassertion{batotal=True} Just "=*" -> nullassertion{bainclusive=True} Just "==*" -> nullassertion{batotal=True, bainclusive=True} Just x -> error' $ unlines -- PARTIAL: [ "balance-type \"" ++ x ++"\" is invalid. Use =, ==, =* or ==*." , showRecord record , showRules rules record ] -- | Figure out the account name specified for posting N, if any. -- And whether it is the default unknown account (which may be -- improved later) or an explicitly set account (which may not). getAccount :: CsvRules -> CsvRecord -> Maybe MixedAmount -> Maybe (Amount, GenericSourcePos) -> Int -> Maybe (AccountName, Bool) getAccount rules record mamount mbalance n = let fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String maccount = T.pack <$> fieldval ("account"++show n) in case maccount of -- accountN is set to the empty string - no posting will be generated Just "" -> Nothing -- accountN is set (possibly to "expenses:unknown"! #1192) - mark it final Just a -> Just (a, True) -- accountN is unset Nothing -> case (mamount, mbalance) of -- amountN is set, or implied by balanceN - set accountN to -- the default unknown account ("expenses:unknown") and -- allow it to be improved later (Just _, _) -> Just (unknownExpenseAccount, False) (_, Just _) -> Just (unknownExpenseAccount, False) -- amountN is also unset - no posting will be generated (Nothing, Nothing) -> Nothing -- | Default account names to use when needed. unknownExpenseAccount = "expenses:unknown" unknownIncomeAccount = "income:unknown" type CsvAmountString = String -- | Canonicalise the sign in a CSV amount string. -- Such strings can have a minus sign, negating parentheses, -- or any two of these (which cancels out). -- -- >>> simplifySign "1" -- "1" -- >>> simplifySign "-1" -- "-1" -- >>> simplifySign "(1)" -- "-1" -- >>> simplifySign "--1" -- "1" -- >>> simplifySign "-(1)" -- "1" -- >>> simplifySign "(-1)" -- "1" -- >>> simplifySign "((1))" -- "1" simplifySign :: CsvAmountString -> CsvAmountString simplifySign ('(':s) | lastMay s == Just ')' = simplifySign $ negateStr $ init s simplifySign ('-':'(':s) | lastMay s == Just ')' = simplifySign $ init s simplifySign ('-':'-':s) = s simplifySign s = s negateStr :: String -> String negateStr ('-':s) = s negateStr s = '-':s -- | Show a (approximate) recreation of the original CSV record. showRecord :: CsvRecord -> String showRecord r = "record values: "++intercalate "," (map show r) -- | Given the conversion rules, a CSV record and a hledger field name, find -- the value template ultimately assigned to this field, if any, by a field -- assignment at top level or in a conditional block matching this record. -- -- Note conditional blocks' patterns are matched against an approximation of the -- CSV record: all the field values, without enclosing quotes, comma-separated. -- getEffectiveAssignment :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe FieldTemplate getEffectiveAssignment rules record f = lastMay $ map snd $ assignments where -- all active assignments to field f, in order assignments = dbg7 "assignments" $ filter ((==f).fst) $ toplevelassignments ++ conditionalassignments where -- all top level field assignments toplevelassignments = rassignments rules -- all field assignments in conditional blocks assigning to field f and active for the current csv record conditionalassignments = concatMap cbAssignments $ filter isBlockActive $ (rblocksassigning rules) f where -- does this conditional block match the current csv record ? isBlockActive :: ConditionalBlock -> Bool isBlockActive CB{..} = any (all matcherMatches) $ groupedMatchers cbMatchers where -- does this individual matcher match the current csv record ? matcherMatches :: Matcher -> Bool matcherMatches (RecordMatcher _ pat) = regexMatch pat' wholecsvline where pat' = dbg7 "regex" pat -- A synthetic whole CSV record to match against. Note, this can be -- different from the original CSV data: -- - any whitespace surrounding field values is preserved -- - any quotes enclosing field values are removed -- - and the field separator is always comma -- which means that a field containing a comma will look like two fields. wholecsvline = dbg7 "wholecsvline" $ intercalate "," record matcherMatches (FieldMatcher _ csvfieldref pat) = regexMatch pat csvfieldvalue where -- the value of the referenced CSV field to match against. csvfieldvalue = dbg7 "csvfieldvalue" $ replaceCsvFieldReference rules record csvfieldref -- | Render a field assignment's template, possibly interpolating referenced -- CSV field values. Outer whitespace is removed from interpolated values. renderTemplate :: CsvRules -> CsvRecord -> FieldTemplate -> String renderTemplate rules record t = maybe t concat $ parseMaybe (many $ takeWhile1P Nothing (/='%') <|> replaceCsvFieldReference rules record <$> referencep) t where referencep = liftA2 (:) (char '%') (takeWhile1P (Just "reference") isDescriptorChar) :: Parsec CustomErr String String isDescriptorChar c = isAscii c && (isAlphaNum c || c == '_' || c == '-') -- | Replace something that looks like a reference to a csv field ("%date" or "%1) -- with that field's value. If it doesn't look like a field reference, or if we -- can't find such a field, leave it unchanged. replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> String replaceCsvFieldReference rules record s@('%':fieldname) = fromMaybe s $ csvFieldValue rules record fieldname replaceCsvFieldReference _ _ s = s -- | Get the (whitespace-stripped) value of a CSV field, identified by its name or -- column number, ("date" or "1"), from the given CSV record, if such a field exists. csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe String csvFieldValue rules record fieldname = do fieldindex <- if | all isDigit fieldname -> readMay fieldname | otherwise -> lookup (map toLower fieldname) $ rcsvfieldindexes rules fieldvalue <- strip <$> atMay record (fieldindex-1) return fieldvalue -- | Parse the date string using the specified date-format, or if unspecified -- the "simple date" formats (YYYY/MM/DD, YYYY-MM-DD, YYYY.MM.DD, leading -- zeroes optional). parseDateWithCustomOrDefaultFormats :: Maybe DateFormat -> String -> Maybe Day parseDateWithCustomOrDefaultFormats mformat s = asum $ map parsewith formats where parsewith = flip (parseTimeM True defaultTimeLocale) s formats = maybe ["%Y/%-m/%-d" ,"%Y-%-m-%-d" ,"%Y.%-m.%-d" -- ,"%-m/%-d/%Y" -- ,parseTime defaultTimeLocale "%Y/%m/%e" (take 5 s ++ "0" ++ drop 5 s) -- ,parseTime defaultTimeLocale "%Y-%m-%e" (take 5 s ++ "0" ++ drop 5 s) -- ,parseTime defaultTimeLocale "%m/%e/%Y" ('0':s) -- ,parseTime defaultTimeLocale "%m-%e-%Y" ('0':s) ] (:[]) mformat --- ** tests tests_CsvReader = tests "CsvReader" [ tests "parseCsvRules" [ test "empty file" $ parseCsvRules "unknown" "" @?= Right (mkrules defrules) ] ,tests "rulesp" [ test "trailing comments" $ parseWithState' defrules rulesp "skip\n# \n#\n" @?= Right (mkrules $ defrules{rdirectives = [("skip","")]}) ,test "trailing blank lines" $ parseWithState' defrules rulesp "skip\n\n \n" @?= (Right (mkrules $ defrules{rdirectives = [("skip","")]})) ,test "no final newline" $ parseWithState' defrules rulesp "skip" @?= (Right (mkrules $ defrules{rdirectives=[("skip","")]})) ,test "assignment with empty value" $ parseWithState' defrules rulesp "account1 \nif foo\n account2 foo\n" @?= (Right (mkrules $ defrules{rassignments = [("account1","")], rconditionalblocks = [CB{cbMatchers=[RecordMatcher None (toRegex' "foo")],cbAssignments=[("account2","foo")]}]})) ] ,tests "conditionalblockp" [ test "space after conditional" $ -- #1120 parseWithState' defrules conditionalblockp "if a\n account2 b\n \n" @?= (Right $ CB{cbMatchers=[RecordMatcher None $ toRegexCI' "a"],cbAssignments=[("account2","b")]}) ,tests "csvfieldreferencep" [ test "number" $ parseWithState' defrules csvfieldreferencep "%1" @?= (Right "%1") ,test "name" $ parseWithState' defrules csvfieldreferencep "%date" @?= (Right "%date") ,test "quoted name" $ parseWithState' defrules csvfieldreferencep "%\"csv date\"" @?= (Right "%\"csv date\"") ] ,tests "matcherp" [ test "recordmatcherp" $ parseWithState' defrules matcherp "A A\n" @?= (Right $ RecordMatcher None $ toRegexCI' "A A") ,test "recordmatcherp.starts-with-&" $ parseWithState' defrules matcherp "& A A\n" @?= (Right $ RecordMatcher And $ toRegexCI' "A A") ,test "fieldmatcherp.starts-with-%" $ parseWithState' defrules matcherp "description A A\n" @?= (Right $ RecordMatcher None $ toRegexCI' "description A A") ,test "fieldmatcherp" $ parseWithState' defrules matcherp "%description A A\n" @?= (Right $ FieldMatcher None "%description" $ toRegexCI' "A A") ,test "fieldmatcherp.starts-with-&" $ parseWithState' defrules matcherp "& %description A A\n" @?= (Right $ FieldMatcher And "%description" $ toRegexCI' "A A") -- ,test "fieldmatcherp with operator" $ -- parseWithState' defrules matcherp "%description ~ A A\n" @?= (Right $ FieldMatcher "%description" "A A") ] ,tests "getEffectiveAssignment" [ let rules = mkrules $ defrules {rcsvfieldindexes=[("csvdate",1)],rassignments=[("date","%csvdate")]} in test "toplevel" $ getEffectiveAssignment rules ["a","b"] "date" @?= (Just "%csvdate") ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a"] [("date","%csvdate")]]} in test "conditional" $ getEffectiveAssignment rules ["a","b"] "date" @?= (Just "%csvdate") ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher None "%description" $ toRegex' "b"] [("date","%csvdate")]]} in test "conditional-with-or-a" $ getEffectiveAssignment rules ["a"] "date" @?= (Just "%csvdate") ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher None "%description" $ toRegex' "b"] [("date","%csvdate")]]} in test "conditional-with-or-b" $ getEffectiveAssignment rules ["_", "b"] "date" @?= (Just "%csvdate") ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher And "%description" $ toRegex' "b"] [("date","%csvdate")]]} in test "conditional.with-and" $ getEffectiveAssignment rules ["a", "b"] "date" @?= (Just "%csvdate") ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher And "%description" $ toRegex' "b", FieldMatcher None "%description" $ toRegex' "c"] [("date","%csvdate")]]} in test "conditional.with-and-or" $ getEffectiveAssignment rules ["_", "c"] "date" @?= (Just "%csvdate") ] ] ] hledger-lib-1.19.1/Hledger/Read/JournalReader.hs0000644000000000000000000011152613723606465017507 0ustar0000000000000000--- * -*- outline-regexp:"--- *"; -*- --- ** doc -- In Emacs, use TAB on lines beginning with "-- *" to collapse/expand sections. {-| A reader for hledger's journal file format (). hledger's journal format is a compatible subset of c++ ledger's (), so this reader should handle many ledger files as well. Example: @ 2012\/3\/24 gift expenses:gifts $10 assets:cash @ Journal format supports the include directive which can read files in other formats, so the other file format readers need to be importable and invocable here. Some important parts of journal parsing are therefore kept in Hledger.Read.Common, to avoid import cycles. -} --- ** language {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoMonoLocalBinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} --- ** exports module Hledger.Read.JournalReader ( -- * Reader-finding utils findReader, splitReaderPrefix, -- * Reader reader, -- * Parsing utils genericSourcePos, parseAndFinaliseJournal, runJournalParser, rjp, -- * Parsers used elsewhere getParentAccount, journalp, directivep, defaultyeardirectivep, marketpricedirectivep, datetimep, datep, modifiedaccountnamep, postingp, statusp, emptyorcommentlinep, followingcommentp, accountaliasp -- * Tests ,tests_JournalReader ) where --- ** imports -- import qualified Prelude (fail) -- import "base-compat-batteries" Prelude.Compat hiding (fail, readFile) import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail) import qualified Control.Exception as C import Control.Monad (forM_, when, void) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Except (ExceptT(..), runExceptT) import Control.Monad.State.Strict (get,modify',put) import Control.Monad.Trans.Class (lift) import Data.Char (toLower) import Data.Either (isRight) import qualified Data.Map.Strict as M #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup ((<>)) #endif import Data.Text (Text) import Data.String import Data.List import Data.Maybe import qualified Data.Text as T import Data.Time.Calendar import Data.Time.LocalTime import Safe import Text.Megaparsec hiding (parse) import Text.Megaparsec.Char import Text.Megaparsec.Custom import Text.Printf import System.FilePath import "Glob" System.FilePath.Glob hiding (match) import Hledger.Data import Hledger.Read.Common import Hledger.Utils import qualified Hledger.Read.TimedotReader as TimedotReader (reader) import qualified Hledger.Read.TimeclockReader as TimeclockReader (reader) import qualified Hledger.Read.CsvReader as CsvReader (reader) --- ** doctest setup -- $setup -- >>> :set -XOverloadedStrings --- ** reader finding utilities -- Defined here rather than Hledger.Read so that we can use them in includedirectivep below. -- The available journal readers, each one handling a particular data format. readers' :: MonadIO m => [Reader m] readers' = [ reader ,TimeclockReader.reader ,TimedotReader.reader ,CsvReader.reader -- ,LedgerReader.reader ] readerNames :: [String] readerNames = map rFormat (readers'::[Reader IO]) -- | @findReader mformat mpath@ -- -- Find the reader named by @mformat@, if provided. -- Or, if a file path is provided, find the first reader that handles -- its file extension, if any. findReader :: MonadIO m => Maybe StorageFormat -> Maybe FilePath -> Maybe (Reader m) findReader Nothing Nothing = Nothing findReader (Just fmt) _ = headMay [r | r <- readers', rFormat r == fmt] findReader Nothing (Just path) = case prefix of Just fmt -> headMay [r | r <- readers', rFormat r == fmt] Nothing -> headMay [r | r <- readers', ext `elem` rExtensions r] where (prefix,path') = splitReaderPrefix path ext = map toLower $ drop 1 $ takeExtension path' -- | A file path optionally prefixed by a reader name and colon -- (journal:, csv:, timedot:, etc.). type PrefixedFilePath = FilePath -- | If a filepath is prefixed by one of the reader names and a colon, -- split that off. Eg "csv:-" -> (Just "csv", "-"). splitReaderPrefix :: PrefixedFilePath -> (Maybe String, FilePath) splitReaderPrefix f = headDef (Nothing, f) [(Just r, drop (length r + 1) f) | r <- readerNames, (r++":") `isPrefixOf` f] --- ** reader reader :: MonadIO m => Reader m reader = Reader {rFormat = "journal" ,rExtensions = ["journal", "j", "hledger", "ledger"] ,rReadFn = parse ,rParser = journalp -- no need to add command line aliases like journalp' -- when called as a subparser I think } -- | Parse and post-process a "Journal" from hledger's journal file -- format, or give an error. parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal parse iopts = parseAndFinaliseJournal journalp' iopts where journalp' = do -- reverse parsed aliases to ensure that they are applied in order given on commandline mapM_ addAccountAlias (reverse $ aliasesFromOpts iopts) journalp -- | Get the account name aliases from options, if any. aliasesFromOpts :: InputOpts -> [AccountAlias] aliasesFromOpts = map (\a -> fromparse $ runParser accountaliasp ("--alias "++quoteIfNeeded a) $ T.pack a) . aliases_ --- ** parsers --- *** journal -- | A journal parser. Accumulates and returns a "ParsedJournal", -- which should be finalised/validated before use. -- -- >>> rejp (journalp <* eof) "2015/1/1\n a 0\n" -- Right (Right Journal with 1 transactions, 1 accounts) -- journalp :: MonadIO m => ErroringJournalParser m ParsedJournal journalp = do many addJournalItemP eof get -- | A side-effecting parser; parses any kind of journal item -- and updates the parse state accordingly. addJournalItemP :: MonadIO m => ErroringJournalParser m () addJournalItemP = -- all journal line types can be distinguished by the first -- character, can use choice without backtracking choice [ directivep , transactionp >>= modify' . addTransaction , transactionmodifierp >>= modify' . addTransactionModifier , periodictransactionp >>= modify' . addPeriodicTransaction , marketpricedirectivep >>= modify' . addPriceDirective , void (lift emptyorcommentlinep) , void (lift multilinecommentp) ] "transaction or directive" --- *** directives -- | Parse any journal directive and update the parse state accordingly. -- Cf http://hledger.org/manual.html#directives, -- http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives directivep :: MonadIO m => ErroringJournalParser m () directivep = (do optional $ char '!' choice [ includedirectivep ,aliasdirectivep ,endaliasesdirectivep ,accountdirectivep ,applyaccountdirectivep ,commoditydirectivep ,endapplyaccountdirectivep ,tagdirectivep ,endtagdirectivep ,defaultyeardirectivep ,defaultcommoditydirectivep ,commodityconversiondirectivep ,ignoredpricecommoditydirectivep ] ) "directive" -- | Parse an include directive. include's argument is an optionally -- file-format-prefixed file path or glob pattern. In the latter case, -- the prefix is applied to each matched path. Examples: -- foo.j, foo/bar.j, timedot:foo/2020*.md includedirectivep :: MonadIO m => ErroringJournalParser m () includedirectivep = do string "include" lift skipNonNewlineSpaces1 prefixedglob <- T.unpack <$> takeWhileP Nothing (/= '\n') -- don't consume newline yet parentoff <- getOffset parentpos <- getSourcePos let (mprefix,glob) = splitReaderPrefix prefixedglob paths <- getFilePaths parentoff parentpos glob let prefixedpaths = case mprefix of Nothing -> paths Just fmt -> map ((fmt++":")++) paths forM_ prefixedpaths $ parseChild parentpos void newline where getFilePaths :: MonadIO m => Int -> SourcePos -> FilePath -> JournalParser m [FilePath] getFilePaths parseroff parserpos filename = do let curdir = takeDirectory (sourceName parserpos) filename' <- lift $ expandHomePath filename `orRethrowIOError` (show parserpos ++ " locating " ++ filename) -- Compiling filename as a glob pattern works even if it is a literal fileglob <- case tryCompileWith compDefault{errorRecovery=False} filename' of Right x -> pure x Left e -> customFailure $ parseErrorAt parseroff $ "Invalid glob pattern: " ++ e -- Get all matching files in the current working directory, sorting in -- lexicographic order to simulate the output of 'ls'. filepaths <- liftIO $ sort <$> globDir1 fileglob curdir if (not . null) filepaths then pure filepaths else customFailure $ parseErrorAt parseroff $ "No existing files match pattern: " ++ filename parseChild :: MonadIO m => SourcePos -> PrefixedFilePath -> ErroringJournalParser m () parseChild parentpos prefixedpath = do let (_mprefix,filepath) = splitReaderPrefix prefixedpath parentj <- get let parentfilestack = jincludefilestack parentj when (filepath `elem` parentfilestack) $ Fail.fail ("Cyclic include: " ++ filepath) childInput <- lift $ readFilePortably filepath `orRethrowIOError` (show parentpos ++ " reading " ++ filepath) let initChildj = newJournalWithParseStateFrom filepath parentj -- Choose a reader/format based on the file path, or fall back -- on journal. Duplicating readJournal a bit here. let r = fromMaybe reader $ findReader Nothing (Just prefixedpath) parser = rParser r dbg6IO "trying reader" (rFormat r) updatedChildj <- journalAddFile (filepath, childInput) <$> parseIncludeFile parser initChildj filepath childInput -- discard child's parse info, combine other fields put $ updatedChildj <> parentj newJournalWithParseStateFrom :: FilePath -> Journal -> Journal newJournalWithParseStateFrom filepath j = nulljournal{ jparsedefaultyear = jparsedefaultyear j ,jparsedefaultcommodity = jparsedefaultcommodity j ,jparseparentaccounts = jparseparentaccounts j ,jparsealiases = jparsealiases j ,jcommodities = jcommodities j -- ,jparsetransactioncount = jparsetransactioncount j ,jparsetimeclockentries = jparsetimeclockentries j ,jincludefilestack = filepath : jincludefilestack j } -- | Lift an IO action into the exception monad, rethrowing any IO -- error with the given message prepended. orRethrowIOError :: MonadIO m => IO a -> String -> TextParser m a orRethrowIOError io msg = do eResult <- liftIO $ (Right <$> io) `C.catch` \(e::C.IOException) -> pure $ Left $ printf "%s:\n%s" msg (show e) case eResult of Right res -> pure res Left errMsg -> Fail.fail errMsg -- Parse an account directive, adding its info to the journal's -- list of account declarations. accountdirectivep :: JournalParser m () accountdirectivep = do off <- getOffset -- XXX figure out a more precise position later string "account" lift skipNonNewlineSpaces1 -- the account name, possibly modified by preceding alias or apply account directives acct <- modifiedaccountnamep -- maybe an account type code (ALERX) after two or more spaces -- XXX added in 1.11, deprecated in 1.13, remove in 1.14 mtypecode :: Maybe Char <- lift $ optional $ try $ do skipNonNewlineSpaces1 -- at least one more space in addition to the one consumed by modifiedaccountp choice $ map char "ALERX" -- maybe a comment, on this and/or following lines (cmt, tags) <- lift transactioncommentp -- maybe Ledger-style subdirectives (ignored) skipMany indentedlinep -- an account type may have been set by account type code or a tag; -- the latter takes precedence let mtypecode' :: Maybe Text = maybe (T.singleton <$> mtypecode) Just $ lookup accountTypeTagName tags metype = parseAccountTypeCode <$> mtypecode' -- update the journal addAccountDeclaration (acct, cmt, tags) case metype of Nothing -> return () Just (Right t) -> addDeclaredAccountType acct t Just (Left err) -> customFailure $ parseErrorAt off err -- The special tag used for declaring account type. XXX change to "class" ? accountTypeTagName = "type" parseAccountTypeCode :: Text -> Either String AccountType parseAccountTypeCode s = case T.toLower s of "asset" -> Right Asset "a" -> Right Asset "liability" -> Right Liability "l" -> Right Liability "equity" -> Right Equity "e" -> Right Equity "revenue" -> Right Revenue "r" -> Right Revenue "expense" -> Right Expense "x" -> Right Expense "cash" -> Right Cash "c" -> Right Cash _ -> Left err where err = "invalid account type code "++T.unpack s++", should be one of " ++ (intercalate ", " $ ["A","L","E","R","X","C","Asset","Liability","Equity","Revenue","Expense","Cash"]) -- Add an account declaration to the journal, auto-numbering it. addAccountDeclaration :: (AccountName,Text,[Tag]) -> JournalParser m () addAccountDeclaration (a,cmt,tags) = modify' (\j -> let decls = jdeclaredaccounts j d = (a, nullaccountdeclarationinfo{ adicomment = cmt ,aditags = tags ,adideclarationorder = length decls + 1 }) in j{jdeclaredaccounts = d:decls}) indentedlinep :: JournalParser m String indentedlinep = lift skipNonNewlineSpaces1 >> (rstrip <$> lift restofline) -- | Parse a one-line or multi-line commodity directive. -- -- >>> Right _ <- rjp commoditydirectivep "commodity $1.00" -- >>> Right _ <- rjp commoditydirectivep "commodity $\n format $1.00" -- >>> Right _ <- rjp commoditydirectivep "commodity $\n\n" -- a commodity with no format -- >>> Right _ <- rjp commoditydirectivep "commodity $1.00\n format $1.00" -- both, what happens ? commoditydirectivep :: JournalParser m () commoditydirectivep = commoditydirectiveonelinep <|> commoditydirectivemultilinep -- | Parse a one-line commodity directive. -- -- >>> Right _ <- rjp commoditydirectiveonelinep "commodity $1.00" -- >>> Right _ <- rjp commoditydirectiveonelinep "commodity $1.00 ; blah\n" commoditydirectiveonelinep :: JournalParser m () commoditydirectiveonelinep = do (off, Amount{acommodity,astyle}) <- try $ do string "commodity" lift skipNonNewlineSpaces1 off <- getOffset amount <- amountp pure $ (off, amount) lift skipNonNewlineSpaces _ <- lift followingcommentp let comm = Commodity{csymbol=acommodity, cformat=Just $ dbg6 "style from commodity directive" astyle} if asdecimalpoint astyle == Nothing then customFailure $ parseErrorAt off pleaseincludedecimalpoint else modify' (\j -> j{jcommodities=M.insert acommodity comm $ jcommodities j}) pleaseincludedecimalpoint :: String pleaseincludedecimalpoint = chomp $ unlines [ "Please include a decimal point or decimal comma in commodity directives," ,"to help us parse correctly. It may be followed by zero or more decimal digits." ,"Examples:" ,"commodity $1000. ; no thousands mark, decimal period, no decimals" ,"commodity 1.234,00 ARS ; period at thousands, decimal comma, 2 decimals" ,"commodity EUR 1 000,000 ; space at thousands, decimal comma, 3 decimals" ,"commodity INR1,23,45,678.0 ; comma at thousands/lakhs/crores, decimal period, 1 decimal" ] -- | Parse a multi-line commodity directive, containing 0 or more format subdirectives. -- -- >>> Right _ <- rjp commoditydirectivemultilinep "commodity $ ; blah \n format $1.00 ; blah" commoditydirectivemultilinep :: JournalParser m () commoditydirectivemultilinep = do string "commodity" lift skipNonNewlineSpaces1 sym <- lift commoditysymbolp _ <- lift followingcommentp mformat <- lastMay <$> many (indented $ formatdirectivep sym) let comm = Commodity{csymbol=sym, cformat=mformat} modify' (\j -> j{jcommodities=M.insert sym comm $ jcommodities j}) where indented = (lift skipNonNewlineSpaces1 >>) -- | Parse a format (sub)directive, throwing a parse error if its -- symbol does not match the one given. formatdirectivep :: CommoditySymbol -> JournalParser m AmountStyle formatdirectivep expectedsym = do string "format" lift skipNonNewlineSpaces1 off <- getOffset Amount{acommodity,astyle} <- amountp _ <- lift followingcommentp if acommodity==expectedsym then if asdecimalpoint astyle == Nothing then customFailure $ parseErrorAt off pleaseincludedecimalpoint else return $ dbg6 "style from format subdirective" astyle else customFailure $ parseErrorAt off $ printf "commodity directive symbol \"%s\" and format directive symbol \"%s\" should be the same" expectedsym acommodity keywordp :: String -> JournalParser m () keywordp = (() <$) . string . fromString spacesp :: JournalParser m () spacesp = () <$ lift skipNonNewlineSpaces1 -- | Backtracking parser similar to string, but allows varying amount of space between words keywordsp :: String -> JournalParser m () keywordsp = try . sequence_ . intersperse spacesp . map keywordp . words applyaccountdirectivep :: JournalParser m () applyaccountdirectivep = do keywordsp "apply account" "apply account directive" lift skipNonNewlineSpaces1 parent <- lift accountnamep newline pushParentAccount parent endapplyaccountdirectivep :: JournalParser m () endapplyaccountdirectivep = do keywordsp "end apply account" "end apply account directive" popParentAccount aliasdirectivep :: JournalParser m () aliasdirectivep = do string "alias" lift skipNonNewlineSpaces1 alias <- lift accountaliasp addAccountAlias alias accountaliasp :: TextParser m AccountAlias accountaliasp = regexaliasp <|> basicaliasp basicaliasp :: TextParser m AccountAlias basicaliasp = do -- dbgparse 0 "basicaliasp" old <- rstrip <$> (some $ noneOf ("=" :: [Char])) char '=' skipNonNewlineSpaces new <- rstrip <$> anySingle `manyTill` eolof -- eol in journal, eof in command lines, normally return $ BasicAlias (T.pack old) (T.pack new) regexaliasp :: TextParser m AccountAlias regexaliasp = do -- dbgparse 0 "regexaliasp" char '/' off1 <- getOffset re <- some $ noneOf ("/\n\r" :: [Char]) -- paranoid: don't try to read past line end off2 <- getOffset char '/' skipNonNewlineSpaces char '=' skipNonNewlineSpaces repl <- anySingle `manyTill` eolof case toRegexCI re of Right r -> return $! RegexAlias r repl Left e -> customFailure $! parseErrorAtRegion off1 off2 e endaliasesdirectivep :: JournalParser m () endaliasesdirectivep = do keywordsp "end aliases" "end aliases directive" clearAccountAliases tagdirectivep :: JournalParser m () tagdirectivep = do string "tag" "tag directive" lift skipNonNewlineSpaces1 _ <- lift $ some nonspace lift restofline return () endtagdirectivep :: JournalParser m () endtagdirectivep = do (keywordsp "end tag" <|> keywordp "pop") "end tag or pop directive" lift restofline return () defaultyeardirectivep :: JournalParser m () defaultyeardirectivep = do char 'Y' "default year" lift skipNonNewlineSpaces setYear =<< lift yearp defaultcommoditydirectivep :: JournalParser m () defaultcommoditydirectivep = do char 'D' "default commodity" lift skipNonNewlineSpaces1 off <- getOffset Amount{acommodity,astyle} <- amountp lift restofline if asdecimalpoint astyle == Nothing then customFailure $ parseErrorAt off pleaseincludedecimalpoint else setDefaultCommodityAndStyle (acommodity, astyle) marketpricedirectivep :: JournalParser m PriceDirective marketpricedirectivep = do char 'P' "market price" lift skipNonNewlineSpaces date <- try (do {LocalTime d _ <- datetimep; return d}) <|> datep -- a time is ignored lift skipNonNewlineSpaces1 symbol <- lift commoditysymbolp lift skipNonNewlineSpaces price <- amountp lift restofline return $ PriceDirective date symbol price ignoredpricecommoditydirectivep :: JournalParser m () ignoredpricecommoditydirectivep = do char 'N' "ignored-price commodity" lift skipNonNewlineSpaces1 lift commoditysymbolp lift restofline return () commodityconversiondirectivep :: JournalParser m () commodityconversiondirectivep = do char 'C' "commodity conversion" lift skipNonNewlineSpaces1 amountp lift skipNonNewlineSpaces char '=' lift skipNonNewlineSpaces amountp lift restofline return () --- *** transactions -- | Parse a transaction modifier (auto postings) rule. transactionmodifierp :: JournalParser m TransactionModifier transactionmodifierp = do char '=' "modifier transaction" lift skipNonNewlineSpaces querytxt <- lift $ T.strip <$> descriptionp (_comment, _tags) <- lift transactioncommentp -- TODO apply these to modified txns ? postings <- postingsp Nothing return $ TransactionModifier querytxt postings -- | Parse a periodic transaction rule. -- -- This reuses periodexprp which parses period expressions on the command line. -- This is awkward because periodexprp supports relative and partial dates, -- which we don't really need here, and it doesn't support the notion of a -- default year set by a Y directive, which we do need to consider here. -- We resolve it as follows: in periodic transactions' period expressions, -- if there is a default year Y in effect, partial/relative dates are calculated -- relative to Y/1/1. If not, they are calculated related to today as usual. periodictransactionp :: MonadIO m => JournalParser m PeriodicTransaction periodictransactionp = do -- first line char '~' "periodic transaction" lift $ skipNonNewlineSpaces -- a period expression off <- getOffset -- if there's a default year in effect, use Y/1/1 as base for partial/relative dates today <- liftIO getCurrentDay mdefaultyear <- getYear let refdate = case mdefaultyear of Nothing -> today Just y -> fromGregorian y 1 1 periodExcerpt <- lift $ excerpt_ $ singlespacedtextsatisfyingp (\c -> c /= ';' && c /= '\n') let periodtxt = T.strip $ getExcerptText periodExcerpt -- first parsing with 'singlespacedtextp', then "re-parsing" with -- 'periodexprp' saves 'periodexprp' from having to respect the single- -- and double-space parsing rules (interval, span) <- lift $ reparseExcerpt periodExcerpt $ do pexp <- periodexprp refdate (<|>) eof $ do offset1 <- getOffset void takeRest offset2 <- getOffset customFailure $ parseErrorAtRegion offset1 offset2 $ "remainder of period expression cannot be parsed" <> "\nperhaps you need to terminate the period expression with a double space?" <> "\na double space is required between period expression and description/comment" pure pexp -- In periodic transactions, the period expression has an additional constraint: case checkPeriodicTransactionStartDate interval span periodtxt of Just e -> customFailure $ parseErrorAt off e Nothing -> pure () status <- lift statusp "cleared status" code <- lift codep "transaction code" description <- lift $ T.strip <$> descriptionp (comment, tags) <- lift transactioncommentp -- next lines; use same year determined above postings <- postingsp (Just $ first3 $ toGregorian refdate) return $ nullperiodictransaction{ ptperiodexpr=periodtxt ,ptinterval=interval ,ptspan=span ,ptstatus=status ,ptcode=code ,ptdescription=description ,ptcomment=comment ,pttags=tags ,ptpostings=postings } -- | Parse a (possibly unbalanced) transaction. transactionp :: JournalParser m Transaction transactionp = do -- dbgparse 0 "transactionp" startpos <- getSourcePos date <- datep "transaction" edate <- optional (lift $ secondarydatep date) "secondary date" lookAhead (lift spacenonewline <|> newline) "whitespace or newline" status <- lift statusp "cleared status" code <- lift codep "transaction code" description <- lift $ T.strip <$> descriptionp (comment, tags) <- lift transactioncommentp let year = first3 $ toGregorian date postings <- postingsp (Just year) endpos <- getSourcePos let sourcepos = journalSourcePos startpos endpos return $ txnTieKnot $ Transaction 0 "" sourcepos date edate status code description comment tags postings --- *** postings -- Parse the following whitespace-beginning lines as postings, posting -- tags, and/or comments (inferring year, if needed, from the given date). postingsp :: Maybe Year -> JournalParser m [Posting] postingsp mTransactionYear = many (postingp mTransactionYear) "postings" -- linebeginningwithspaces :: JournalParser m String -- linebeginningwithspaces = do -- sp <- lift skipNonNewlineSpaces1 -- c <- nonspace -- cs <- lift restofline -- return $ sp ++ (c:cs) ++ "\n" postingp :: Maybe Year -> JournalParser m Posting postingp mTransactionYear = do -- lift $ dbgparse 0 "postingp" (status, account) <- try $ do lift skipNonNewlineSpaces1 status <- lift statusp lift skipNonNewlineSpaces account <- modifiedaccountnamep return (status, account) let (ptype, account') = (accountNamePostingType account, textUnbracket account) lift skipNonNewlineSpaces amount <- option missingmixedamt $ Mixed . (:[]) <$> amountp lift skipNonNewlineSpaces massertion <- optional balanceassertionp lift skipNonNewlineSpaces (comment,tags,mdate,mdate2) <- lift $ postingcommentp mTransactionYear return posting { pdate=mdate , pdate2=mdate2 , pstatus=status , paccount=account' , pamount=amount , pcomment=comment , ptype=ptype , ptags=tags , pbalanceassertion=massertion } --- ** tests tests_JournalReader = tests "JournalReader" [ let p = lift accountnamep :: JournalParser IO AccountName in tests "accountnamep" [ test "basic" $ assertParse p "a:b:c" -- ,test "empty inner component" $ assertParseError p "a::c" "" -- TODO -- ,test "empty leading component" $ assertParseError p ":b:c" "x" -- ,test "empty trailing component" $ assertParseError p "a:b:" "x" ] -- "Parse a date in YYYY/MM/DD format. -- Hyphen (-) and period (.) are also allowed as separators. -- The year may be omitted if a default year has been set. -- Leading zeroes may be omitted." ,tests "datep" [ test "YYYY/MM/DD" $ assertParseEq datep "2018/01/01" (fromGregorian 2018 1 1) ,test "YYYY-MM-DD" $ assertParse datep "2018-01-01" ,test "YYYY.MM.DD" $ assertParse datep "2018.01.01" ,test "yearless date with no default year" $ assertParseError datep "1/1" "current year is unknown" ,test "yearless date with default year" $ do let s = "1/1" ep <- parseWithState nulljournal{jparsedefaultyear=Just 2018} datep s either (assertFailure . ("parse error at "++) . customErrorBundlePretty) (const $ return ()) ep ,test "no leading zero" $ assertParse datep "2018/1/1" ] ,test "datetimep" $ do let good = assertParse datetimep bad = (\t -> assertParseError datetimep t "") good "2011/1/1 00:00" good "2011/1/1 23:59:59" bad "2011/1/1" bad "2011/1/1 24:00:00" bad "2011/1/1 00:60:00" bad "2011/1/1 00:00:60" bad "2011/1/1 3:5:7" -- timezone is parsed but ignored let t = LocalTime (fromGregorian 2018 1 1) (TimeOfDay 0 0 0) assertParseEq datetimep "2018/1/1 00:00-0800" t assertParseEq datetimep "2018/1/1 00:00+1234" t ,tests "periodictransactionp" [ test "more period text in comment after one space" $ assertParseEq periodictransactionp "~ monthly from 2018/6 ;In 2019 we will change this\n" nullperiodictransaction { ptperiodexpr = "monthly from 2018/6" ,ptinterval = Months 1 ,ptspan = DateSpan (Just $ fromGregorian 2018 6 1) Nothing ,ptdescription = "" ,ptcomment = "In 2019 we will change this\n" } ,test "more period text in description after two spaces" $ assertParseEq periodictransactionp "~ monthly from 2018/6 In 2019 we will change this\n" nullperiodictransaction { ptperiodexpr = "monthly from 2018/6" ,ptinterval = Months 1 ,ptspan = DateSpan (Just $ fromGregorian 2018 6 1) Nothing ,ptdescription = "In 2019 we will change this" ,ptcomment = "" } ,test "Next year in description" $ assertParseEq periodictransactionp "~ monthly Next year blah blah\n" nullperiodictransaction { ptperiodexpr = "monthly" ,ptinterval = Months 1 ,ptspan = DateSpan Nothing Nothing ,ptdescription = "Next year blah blah" ,ptcomment = "" } ,test "Just date, no description" $ assertParseEq periodictransactionp "~ 2019-01-04\n" nullperiodictransaction { ptperiodexpr = "2019-01-04" ,ptinterval = NoInterval ,ptspan = DateSpan (Just $ fromGregorian 2019 1 4) (Just $ fromGregorian 2019 1 5) ,ptdescription = "" ,ptcomment = "" } ,test "Just date, no description + empty transaction comment" $ assertParse periodictransactionp "~ 2019-01-04\n ;\n a 1\n b\n" ] ,tests "postingp" [ test "basic" $ assertParseEq (postingp Nothing) " expenses:food:dining $10.00 ; a: a a \n ; b: b b \n" posting{ paccount="expenses:food:dining", pamount=Mixed [usd 10], pcomment="a: a a\nb: b b\n", ptags=[("a","a a"), ("b","b b")] } ,test "posting dates" $ assertParseEq (postingp Nothing) " a 1. ; date:2012/11/28, date2=2012/11/29,b:b\n" nullposting{ paccount="a" ,pamount=Mixed [num 1] ,pcomment="date:2012/11/28, date2=2012/11/29,b:b\n" ,ptags=[("date", "2012/11/28"), ("date2=2012/11/29,b", "b")] -- TODO tag name parsed too greedily ,pdate=Just $ fromGregorian 2012 11 28 ,pdate2=Nothing -- Just $ fromGregorian 2012 11 29 } ,test "posting dates bracket syntax" $ assertParseEq (postingp Nothing) " a 1. ; [2012/11/28=2012/11/29]\n" nullposting{ paccount="a" ,pamount=Mixed [num 1] ,pcomment="[2012/11/28=2012/11/29]\n" ,ptags=[] ,pdate= Just $ fromGregorian 2012 11 28 ,pdate2=Just $ fromGregorian 2012 11 29 } ,test "quoted commodity symbol with digits" $ assertParse (postingp Nothing) " a 1 \"DE123\"\n" ,test "only lot price" $ assertParse (postingp Nothing) " a 1A {1B}\n" ,test "fixed lot price" $ assertParse (postingp Nothing) " a 1A {=1B}\n" ,test "total lot price" $ assertParse (postingp Nothing) " a 1A {{1B}}\n" ,test "fixed total lot price, and spaces" $ assertParse (postingp Nothing) " a 1A {{ = 1B }}\n" ,test "lot price before transaction price" $ assertParse (postingp Nothing) " a 1A {1B} @ 1B\n" ,test "lot price after transaction price" $ assertParse (postingp Nothing) " a 1A @ 1B {1B}\n" ,test "lot price after balance assertion not allowed" $ assertParseError (postingp Nothing) " a 1A @ 1B = 1A {1B}\n" "unexpected '{'" ,test "only lot date" $ assertParse (postingp Nothing) " a 1A [2000-01-01]\n" ,test "transaction price, lot price, lot date" $ assertParse (postingp Nothing) " a 1A @ 1B {1B} [2000-01-01]\n" ,test "lot date, lot price, transaction price" $ assertParse (postingp Nothing) " a 1A [2000-01-01] {1B} @ 1B\n" ,test "balance assertion over entire contents of account" $ assertParse (postingp Nothing) " a $1 == $1\n" ] ,tests "transactionmodifierp" [ test "basic" $ assertParseEq transactionmodifierp "= (some value expr)\n some:postings 1.\n" nulltransactionmodifier { tmquerytxt = "(some value expr)" ,tmpostingrules = [nullposting{paccount="some:postings", pamount=Mixed[num 1]}] } ] ,tests "transactionp" [ test "just a date" $ assertParseEq transactionp "2015/1/1\n" nulltransaction{tdate=fromGregorian 2015 1 1} ,test "more complex" $ assertParseEq transactionp (T.unlines [ "2012/05/14=2012/05/15 (code) desc ; tcomment1", " ; tcomment2", " ; ttag1: val1", " * a $1.00 ; pcomment1", " ; pcomment2", " ; ptag1: val1", " ; ptag2: val2" ]) nulltransaction{ tsourcepos=JournalSourcePos "" (1,7), -- XXX why 7 here ? tprecedingcomment="", tdate=fromGregorian 2012 5 14, tdate2=Just $ fromGregorian 2012 5 15, tstatus=Unmarked, tcode="code", tdescription="desc", tcomment="tcomment1\ntcomment2\nttag1: val1\n", ttags=[("ttag1","val1")], tpostings=[ nullposting{ pdate=Nothing, pstatus=Cleared, paccount="a", pamount=Mixed [usd 1], pcomment="pcomment1\npcomment2\nptag1: val1\nptag2: val2\n", ptype=RegularPosting, ptags=[("ptag1","val1"),("ptag2","val2")], ptransaction=Nothing } ] } ,test "parses a well-formed transaction" $ assertBool "" $ isRight $ rjp transactionp $ T.unlines ["2007/01/28 coopportunity" ," expenses:food:groceries $47.18" ," assets:checking $-47.18" ,"" ] ,test "does not parse a following comment as part of the description" $ assertParseEqOn transactionp "2009/1/1 a ;comment\n b 1\n" tdescription "a" ,test "parses a following whitespace line" $ assertBool "" $ isRight $ rjp transactionp $ T.unlines ["2012/1/1" ," a 1" ," b" ," " ] ,test "parses an empty transaction comment following whitespace line" $ assertBool "" $ isRight $ rjp transactionp $ T.unlines ["2012/1/1" ," ;" ," a 1" ," b" ," " ] ,test "comments everywhere, two postings parsed" $ assertParseEqOn transactionp (T.unlines ["2009/1/1 x ; transaction comment" ," a 1 ; posting 1 comment" ," ; posting 1 comment 2" ," b" ," ; posting 2 comment" ]) (length . tpostings) 2 ] -- directives ,tests "directivep" [ test "supports !" $ do assertParseE directivep "!account a\n" assertParseE directivep "!D 1.0\n" ] ,tests "accountdirectivep" [ test "with-comment" $ assertParse accountdirectivep "account a:b ; a comment\n" ,test "does-not-support-!" $ assertParseError accountdirectivep "!account a:b\n" "" ,test "account-type-code" $ assertParse accountdirectivep "account a:b A\n" ,test "account-type-tag" $ assertParseStateOn accountdirectivep "account a:b ; type:asset\n" jdeclaredaccounts [("a:b", AccountDeclarationInfo{adicomment = "type:asset\n" ,aditags = [("type","asset")] ,adideclarationorder = 1 }) ] ] ,test "commodityconversiondirectivep" $ do assertParse commodityconversiondirectivep "C 1h = $50.00\n" ,test "defaultcommoditydirectivep" $ do assertParse defaultcommoditydirectivep "D $1,000.0\n" assertParseError defaultcommoditydirectivep "D $1000\n" "Please include a decimal point or decimal comma" ,tests "defaultyeardirectivep" [ test "1000" $ assertParse defaultyeardirectivep "Y 1000" -- XXX no \n like the others -- ,test "999" $ assertParseError defaultyeardirectivep "Y 999" "bad year number" ,test "12345" $ assertParse defaultyeardirectivep "Y 12345" ] ,test "ignoredpricecommoditydirectivep" $ do assertParse ignoredpricecommoditydirectivep "N $\n" ,tests "includedirectivep" [ test "include" $ assertParseErrorE includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile" ,test "glob" $ assertParseErrorE includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*" ] ,test "marketpricedirectivep" $ assertParseEq marketpricedirectivep "P 2017/01/30 BTC $922.83\n" PriceDirective{ pddate = fromGregorian 2017 1 30, pdcommodity = "BTC", pdamount = usd 922.83 } ,test "tagdirectivep" $ do assertParse tagdirectivep "tag foo \n" ,test "endtagdirectivep" $ do assertParse endtagdirectivep "end tag \n" assertParse endtagdirectivep "pop \n" ,tests "journalp" [ test "empty file" $ assertParseEqE journalp "" nulljournal ] -- these are defined here rather than in Common so they can use journalp ,test "parseAndFinaliseJournal" $ do ej <- runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n" let Right j = ej assertEqual "" [""] $ journalFilePaths j ] hledger-lib-1.19.1/Hledger/Read/TimedotReader.hs0000644000000000000000000001646113723300774017476 0ustar0000000000000000--- * -*- outline-regexp:"--- \\*"; -*- --- ** doc -- In Emacs, use TAB on lines beginning with "-- *" to collapse/expand sections. {-| A reader for the "timedot" file format. Example: @ #DATE #ACCT DOTS # Each dot represents 15m, spaces are ignored #ACCT 8 # numbers with or without a following h represent hours #ACCT 5m # numbers followed by m represent minutes # on 2/1, 1h was spent on FOSS haskell work, 0.25h on research, etc. 2/1 fos.haskell .... .. biz.research . inc.client1 .... .... .... .... .... .... 2/2 biz.research . inc.client1 .... .... .. @ -} --- ** language {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} --- ** exports module Hledger.Read.TimedotReader ( -- * Reader reader, -- * Misc other exports timedotfilep, ) where --- ** imports import Prelude () import "base-compat-batteries" Prelude.Compat import Control.Monad import Control.Monad.Except (ExceptT) import Control.Monad.State.Strict import Data.Char (isSpace) import Data.List (foldl') import Data.Text (Text) import qualified Data.Text as T import Data.Time (Day) import Text.Megaparsec hiding (parse) import Text.Megaparsec.Char import Hledger.Data import Hledger.Read.Common hiding (emptyorcommentlinep) import Hledger.Utils --- ** doctest setup -- $setup -- >>> :set -XOverloadedStrings --- ** reader reader :: MonadIO m => Reader m reader = Reader {rFormat = "timedot" ,rExtensions = ["timedot"] ,rReadFn = parse ,rParser = timedotp } -- | Parse and post-process a "Journal" from the timedot format, or give an error. parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal parse = parseAndFinaliseJournal' timedotp --- ** utilities traceparse, traceparse' :: String -> TextParser m () traceparse = const $ return () traceparse' = const $ return () -- for debugging: -- traceparse s = traceParse (s++"?") -- traceparse' s = trace s $ return () --- ** parsers {- Rough grammar for timedot format: timedot: preamble day* preamble: (emptyline | commentline | orgheading)* orgheading: orgheadingprefix restofline day: dateline entry* (emptyline | commentline)* dateline: orgheadingprefix? date description? orgheadingprefix: star+ space+ description: restofline ; till semicolon? entry: orgheadingprefix? space* singlespaced (doublespace quantity?)? doublespace: space space+ quantity: (dot (dot | space)* | number | number unit) Date lines and item lines can begin with an org heading prefix, which is ignored. Org headings before the first date line are ignored, regardless of content. -} timedotfilep = timedotp -- XXX rename export above timedotp :: JournalParser m ParsedJournal timedotp = preamblep >> many dayp >> eof >> get preamblep :: JournalParser m () preamblep = do lift $ traceparse "preamblep" many $ notFollowedBy datelinep >> (lift $ emptyorcommentlinep "#;*") lift $ traceparse' "preamblep" -- | Parse timedot day entries to zero or more time transactions for that day. -- @ -- 2020/2/1 optional day description -- fos.haskell .... .. -- biz.research . -- inc.client1 .... .... .... .... .... .... -- @ dayp :: JournalParser m () dayp = label "timedot day entry" $ do lift $ traceparse "dayp" (d,desc) <- datelinep commentlinesp ts <- many $ entryp <* commentlinesp modify' $ addTransactions $ map (\t -> t{tdate=d, tdescription=desc}) ts lift $ traceparse' "dayp" where addTransactions :: [Transaction] -> Journal -> Journal addTransactions ts j = foldl' (flip ($)) j (map addTransaction ts) datelinep :: JournalParser m (Day,Text) datelinep = do lift $ traceparse "datelinep" lift $ optional orgheadingprefixp d <- datep desc <- strip <$> lift restofline lift $ traceparse' "datelinep" return (d, T.pack desc) -- | Zero or more empty lines or hash/semicolon comment lines -- or org headlines which do not start a new day. commentlinesp :: JournalParser m () commentlinesp = do lift $ traceparse "commentlinesp" void $ many $ try $ lift $ emptyorcommentlinep "#;" -- orgnondatelinep :: JournalParser m () -- orgnondatelinep = do -- lift $ traceparse "orgnondatelinep" -- lift orgheadingprefixp -- notFollowedBy datelinep -- void $ lift restofline -- lift $ traceparse' "orgnondatelinep" orgheadingprefixp = do -- traceparse "orgheadingprefixp" skipSome (char '*') >> skipNonNewlineSpaces1 -- | Parse a single timedot entry to one (dateless) transaction. -- @ -- fos.haskell .... .. -- @ entryp :: JournalParser m Transaction entryp = do lift $ traceparse "entryp" pos <- genericSourcePos <$> getSourcePos notFollowedBy datelinep lift $ optional $ choice [orgheadingprefixp, skipNonNewlineSpaces1] a <- modifiedaccountnamep lift skipNonNewlineSpaces hours <- try (lift followingcommentp >> return 0) <|> (durationp <* (try (lift followingcommentp) <|> (newline >> return ""))) let t = nulltransaction{ tsourcepos = pos, tstatus = Cleared, tpostings = [ nullposting{paccount=a ,pamount=Mixed [setAmountPrecision (Precision 2) $ num hours] -- don't assume hours; do set precision to 2 ,ptype=VirtualPosting ,ptransaction=Just t } ] } lift $ traceparse' "entryp" return t durationp :: JournalParser m Quantity durationp = do lift $ traceparse "durationp" try numericquantityp <|> dotquantityp -- <* traceparse' "durationp" -- | Parse a duration of seconds, minutes, hours, days, weeks, months or years, -- written as a decimal number followed by s, m, h, d, w, mo or y, assuming h -- if there is no unit. Returns the duration as hours, assuming -- 1m = 60s, 1h = 60m, 1d = 24h, 1w = 7d, 1mo = 30d, 1y=365d. -- @ -- 1.5 -- 1.5h -- 90m -- @ numericquantityp :: JournalParser m Quantity numericquantityp = do -- lift $ traceparse "numericquantityp" (q, _, _, _) <- lift $ numberp Nothing msymbol <- optional $ choice $ map (string . fst) timeUnits lift skipNonNewlineSpaces let q' = case msymbol of Nothing -> q Just sym -> case lookup sym timeUnits of Just mult -> q * mult Nothing -> q -- shouldn't happen.. ignore return q' -- (symbol, equivalent in hours). timeUnits = [("s",2.777777777777778e-4) ,("mo",5040) -- before "m" ,("m",1.6666666666666666e-2) ,("h",1) ,("d",24) ,("w",168) ,("y",61320) ] -- | Parse a quantity written as a line of dots, each representing 0.25. -- @ -- .... .. -- @ dotquantityp :: JournalParser m Quantity dotquantityp = do -- lift $ traceparse "dotquantityp" dots <- filter (not.isSpace) <$> many (oneOf (". " :: [Char])) return $ fromIntegral (length dots) / 4 -- | XXX new comment line parser, move to Hledger.Read.Common.emptyorcommentlinep -- Parse empty lines, all-blank lines, and lines beginning with any of the provided -- comment-beginning characters. emptyorcommentlinep :: [Char] -> TextParser m () emptyorcommentlinep cs = label ("empty line or comment line beginning with "++cs) $ do traceparse "emptyorcommentlinep" -- XXX possible to combine label and traceparse ? skipNonNewlineSpaces void newline <|> void commentp traceparse' "emptyorcommentlinep" where commentp = do choice (map (some.char) cs) takeWhileP Nothing (/='\n') <* newline hledger-lib-1.19.1/Hledger/Read/TimeclockReader.hs0000644000000000000000000001067413722544246020006 0ustar0000000000000000--- * -*- outline-regexp:"--- \\*"; -*- --- ** doc -- In Emacs, use TAB on lines beginning with "-- *" to collapse/expand sections. {-| A reader for the timeclock file format generated by timeclock.el (). Example: @ i 2007\/03\/10 12:26:00 hledger o 2007\/03\/10 17:26:02 @ From timeclock.el 2.6: @ A timeclock contains data in the form of a single entry per line. Each entry has the form: CODE YYYY/MM/DD HH:MM:SS [COMMENT] CODE is one of: b, h, i, o or O. COMMENT is optional when the code is i, o or O. The meanings of the codes are: b Set the current time balance, or \"time debt\". Useful when archiving old log data, when a debt must be carried forward. The COMMENT here is the number of seconds of debt. h Set the required working time for the given day. This must be the first entry for that day. The COMMENT in this case is the number of hours in this workday. Floating point amounts are allowed. i Clock in. The COMMENT in this case should be the name of the project worked on. o Clock out. COMMENT is unnecessary, but can be used to provide a description of how the period went, for example. O Final clock out. Whatever project was being worked on, it is now finished. Useful for creating summary reports. @ -} --- ** language {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} --- ** exports module Hledger.Read.TimeclockReader ( -- * Reader reader, -- * Misc other exports timeclockfilep, ) where --- ** imports import Prelude () import "base-compat-batteries" Prelude.Compat import Control.Monad import Control.Monad.Except (ExceptT) import Control.Monad.State.Strict import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T import Text.Megaparsec hiding (parse) import Hledger.Data -- XXX too much reuse ? import Hledger.Read.Common import Hledger.Utils --- ** doctest setup -- $setup -- >>> :set -XOverloadedStrings --- ** reader reader :: MonadIO m => Reader m reader = Reader {rFormat = "timeclock" ,rExtensions = ["timeclock"] ,rReadFn = parse ,rParser = timeclockfilep } -- | Parse and post-process a "Journal" from timeclock.el's timeclock -- format, saving the provided file path and the current time, or give an -- error. parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal parse = parseAndFinaliseJournal' timeclockfilep --- ** parsers timeclockfilep :: MonadIO m => JournalParser m ParsedJournal timeclockfilep = do many timeclockitemp eof j@Journal{jparsetimeclockentries=es} <- get -- Convert timeclock entries in this journal to transactions, closing any unfinished sessions. -- Doing this here rather than in journalFinalise means timeclock sessions can't span file boundaries, -- but it simplifies code above. now <- liftIO getCurrentLocalTime -- entries have been parsed in reverse order. timeclockEntriesToTransactions -- expects them to be in normal order, then we must reverse again since -- journalFinalise expects them in reverse order let j' = j{jtxns = reverse $ timeclockEntriesToTransactions now $ reverse es, jparsetimeclockentries = []} return j' where -- As all ledger line types can be distinguished by the first -- character, excepting transactions versus empty (blank or -- comment-only) lines, can use choice w/o try timeclockitemp = choice [ void (lift emptyorcommentlinep) , timeclockentryp >>= \e -> modify' (\j -> j{jparsetimeclockentries = e : jparsetimeclockentries j}) ] "timeclock entry, comment line, or empty line" -- | Parse a timeclock entry. timeclockentryp :: JournalParser m TimeclockEntry timeclockentryp = do sourcepos <- genericSourcePos <$> lift getSourcePos code <- oneOf ("bhioO" :: [Char]) lift skipNonNewlineSpaces1 datetime <- datetimep account <- fromMaybe "" <$> optional (lift skipNonNewlineSpaces1 >> modifiedaccountnamep) description <- T.pack . fromMaybe "" <$> lift (optional (skipNonNewlineSpaces1 >> restofline)) return $ TimeclockEntry sourcepos (read [code]) datetime account description hledger-lib-1.19.1/Hledger/Reports.hs0000644000000000000000000000251213723502755015524 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-} {-| Generate several common kinds of report from a journal, as \"*Report\" - simple intermediate data structures intended to be easily rendered as text, html, json, csv etc. by hledger commands, hamlet templates, javascript, or whatever. -} module Hledger.Reports ( module Hledger.Reports.ReportOptions, module Hledger.Reports.ReportTypes, module Hledger.Reports.EntriesReport, module Hledger.Reports.PostingsReport, module Hledger.Reports.TransactionsReport, module Hledger.Reports.AccountTransactionsReport, module Hledger.Reports.BalanceReport, module Hledger.Reports.MultiBalanceReport, module Hledger.Reports.BudgetReport, -- * Tests tests_Reports ) where import Hledger.Reports.ReportOptions import Hledger.Reports.ReportTypes import Hledger.Reports.AccountTransactionsReport import Hledger.Reports.EntriesReport import Hledger.Reports.PostingsReport import Hledger.Reports.TransactionsReport import Hledger.Reports.BalanceReport import Hledger.Reports.MultiBalanceReport import Hledger.Reports.BudgetReport import Hledger.Utils.Test tests_Reports = tests "Reports" [ tests_BalanceReport ,tests_BudgetReport ,tests_AccountTransactionsReport ,tests_EntriesReport ,tests_MultiBalanceReport ,tests_PostingsReport ,tests_ReportOptions ] hledger-lib-1.19.1/Hledger/Reports/ReportOptions.hs0000644000000000000000000005441613723502755020365 0ustar0000000000000000{-| Options common to most hledger reports. -} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Hledger.Reports.ReportOptions ( ReportOpts(..), BalanceType(..), AccountListMode(..), ValuationType(..), FormatStr, defreportopts, rawOptsToReportOpts, checkReportOpts, flat_, tree_, reportOptsToggleStatus, simplifyStatuses, whichDateFromOpts, journalSelectingAmountFromOpts, intervalFromRawOpts, forecastPeriodFromRawOpts, queryFromOpts, queryFromOptsOnly, queryOptsFromOpts, transactionDateFn, postingDateFn, reportSpan, reportStartDate, reportEndDate, specifiedStartEndDates, specifiedStartDate, specifiedEndDate, reportPeriodStart, reportPeriodOrJournalStart, reportPeriodLastDay, reportPeriodOrJournalLastDay, valuationTypeIsCost, valuationTypeIsDefaultValue, tests_ReportOptions ) where import Control.Applicative ((<|>)) import Data.List.Extra (nubSort) import Data.Maybe (fromMaybe, isJust) import qualified Data.Text as T import Data.Time.Calendar (Day, addDays, fromGregorian) import Data.Default (Default(..)) import Safe (lastDef, lastMay) import System.Console.ANSI (hSupportsANSIColor) import System.Environment (lookupEnv) import System.IO (stdout) import Text.Megaparsec.Custom import Hledger.Data import Hledger.Query import Hledger.Utils type FormatStr = String -- | Which "balance" is being shown in a balance report. data BalanceType = PeriodChange -- ^ The change of balance in each period. | CumulativeChange -- ^ The accumulated change across multiple periods. | HistoricalBalance -- ^ The historical ending balance, including the effect of -- all postings before the report period. Unless altered by, -- a query, this is what you would see on a bank statement. deriving (Eq,Show) instance Default BalanceType where def = PeriodChange -- | Should accounts be displayed: in the command's default style, hierarchically, or as a flat list ? data AccountListMode = ALFlat | ALTree deriving (Eq, Show) instance Default AccountListMode where def = ALFlat -- | Standard options for customising report filtering and output. -- Most of these correspond to standard hledger command-line options -- or query arguments, but not all. Some are used only by certain -- commands, as noted below. data ReportOpts = ReportOpts { -- for most reports: today_ :: Maybe Day -- ^ The current date. A late addition to ReportOpts. -- Optional, but when set it may affect some reports: -- Reports use it when picking a -V valuation date. -- This is not great, adds indeterminacy. ,period_ :: Period ,interval_ :: Interval ,statuses_ :: [Status] -- ^ Zero, one, or two statuses to be matched ,value_ :: Maybe ValuationType -- ^ What value should amounts be converted to ? ,infer_value_ :: Bool -- ^ Infer market prices from transactions ? ,depth_ :: Maybe Int ,date2_ :: Bool ,empty_ :: Bool ,no_elide_ :: Bool ,real_ :: Bool ,format_ :: Maybe FormatStr ,query_ :: String -- ^ All query arguments space sepeareted -- and quoted if needed (see 'quoteIfNeeded') -- ,average_ :: Bool -- for posting reports (register) ,related_ :: Bool -- for account transactions reports (aregister) ,txn_dates_ :: Bool -- for balance reports (bal, bs, cf, is) ,balancetype_ :: BalanceType ,accountlistmode_ :: AccountListMode ,drop_ :: Int ,row_total_ :: Bool ,no_total_ :: Bool ,pretty_tables_ :: Bool ,sort_amount_ :: Bool ,percent_ :: Bool ,invert_ :: Bool -- ^ if true, flip all amount signs in reports ,normalbalance_ :: Maybe NormalSign -- ^ This can be set when running balance reports on a set of accounts -- with the same normal balance type (eg all assets, or all incomes). -- - It helps --sort-amount know how to sort negative numbers -- (eg in the income section of an income statement) -- - It helps compound balance report commands (is, bs etc.) do -- sign normalisation, converting normally negative subreports to -- normally positive for a more conventional display. ,color_ :: Bool -- ^ Whether to use ANSI color codes in text output. -- Influenced by the --color/colour flag (cf CliOptions), -- whether stdout is an interactive terminal, and the value of -- TERM and existence of NO_COLOR environment variables. ,forecast_ :: Maybe DateSpan ,transpose_ :: Bool } deriving (Show) instance Default ReportOpts where def = defreportopts defreportopts :: ReportOpts defreportopts = ReportOpts def def def def def def def def def def def def def def def def def def def def def def def def def def def def def rawOptsToReportOpts :: RawOpts -> IO ReportOpts rawOptsToReportOpts rawopts = checkReportOpts <$> do let rawopts' = checkRawOpts rawopts d <- getCurrentDay no_color <- isJust <$> lookupEnv "NO_COLOR" supports_color <- hSupportsANSIColor stdout let colorflag = stringopt "color" rawopts return defreportopts{ today_ = Just d ,period_ = periodFromRawOpts d rawopts' ,interval_ = intervalFromRawOpts rawopts' ,statuses_ = statusesFromRawOpts rawopts' ,value_ = valuationTypeFromRawOpts rawopts' ,infer_value_ = boolopt "infer-value" rawopts' ,depth_ = maybeposintopt "depth" rawopts' ,date2_ = boolopt "date2" rawopts' ,empty_ = boolopt "empty" rawopts' ,no_elide_ = boolopt "no-elide" rawopts' ,real_ = boolopt "real" rawopts' ,format_ = maybestringopt "format" rawopts' -- XXX move to CliOpts or move validation from Cli.CliOptions to here ,query_ = unwords . map quoteIfNeeded $ listofstringopt "args" rawopts' -- doesn't handle an arg like "" right ,average_ = boolopt "average" rawopts' ,related_ = boolopt "related" rawopts' ,txn_dates_ = boolopt "txn-dates" rawopts' ,balancetype_ = balancetypeopt rawopts' ,accountlistmode_ = accountlistmodeopt rawopts' ,drop_ = posintopt "drop" rawopts' ,row_total_ = boolopt "row-total" rawopts' ,no_total_ = boolopt "no-total" rawopts' ,sort_amount_ = boolopt "sort-amount" rawopts' ,percent_ = boolopt "percent" rawopts' ,invert_ = boolopt "invert" rawopts' ,pretty_tables_ = boolopt "pretty-tables" rawopts' ,color_ = and [not no_color ,not $ colorflag `elem` ["never","no"] ,colorflag `elem` ["always","yes"] || supports_color ] ,forecast_ = forecastPeriodFromRawOpts d rawopts' ,transpose_ = boolopt "transpose" rawopts' } -- | Do extra validation of raw option values, raising an error if there's a problem. checkRawOpts :: RawOpts -> RawOpts checkRawOpts rawopts -- our standard behaviour is to accept conflicting options actually, -- using the last one - more forgiving for overriding command-line aliases -- | countopts ["change","cumulative","historical"] > 1 -- = usageError "please specify at most one of --change, --cumulative, --historical" -- | countopts ["flat","tree"] > 1 -- = usageError "please specify at most one of --flat, --tree" -- | countopts ["daily","weekly","monthly","quarterly","yearly"] > 1 -- = usageError "please specify at most one of --daily, " | otherwise = rawopts -- where -- countopts = length . filter (`boolopt` rawopts) -- | Do extra validation of report options, raising an error if there's a problem. checkReportOpts :: ReportOpts -> ReportOpts checkReportOpts ropts@ReportOpts{..} = either usageError (const ropts) $ do case depth_ of Just d | d < 0 -> Left "--depth should have a positive number" _ -> Right () accountlistmodeopt :: RawOpts -> AccountListMode accountlistmodeopt = fromMaybe ALFlat . choiceopt parse where parse = \case "tree" -> Just ALTree "flat" -> Just ALFlat _ -> Nothing balancetypeopt :: RawOpts -> BalanceType balancetypeopt = fromMaybe PeriodChange . choiceopt parse where parse = \case "historical" -> Just HistoricalBalance "cumulative" -> Just CumulativeChange _ -> Nothing -- Get the period specified by any -b/--begin, -e/--end and/or -p/--period -- options appearing in the command line. -- Its bounds are the rightmost begin date specified by a -b or -p, and -- the rightmost end date specified by a -e or -p. Cf #1011. -- Today's date is provided to help interpret any relative dates. periodFromRawOpts :: Day -> RawOpts -> Period periodFromRawOpts d rawopts = case (mlastb, mlaste) of (Nothing, Nothing) -> PeriodAll (Just b, Nothing) -> PeriodFrom b (Nothing, Just e) -> PeriodTo e (Just b, Just e) -> simplifyPeriod $ PeriodBetween b e where mlastb = case beginDatesFromRawOpts d rawopts of [] -> Nothing bs -> Just $ last bs mlaste = case endDatesFromRawOpts d rawopts of [] -> Nothing es -> Just $ last es -- Get all begin dates specified by -b/--begin or -p/--period options, in order, -- using the given date to interpret relative date expressions. beginDatesFromRawOpts :: Day -> RawOpts -> [Day] beginDatesFromRawOpts d = collectopts (begindatefromrawopt d) where begindatefromrawopt d (n,v) | n == "begin" = either (\e -> usageError $ "could not parse "++n++" date: "++customErrorBundlePretty e) Just $ fixSmartDateStrEither' d (T.pack v) | n == "period" = case either (\e -> usageError $ "could not parse period option: "++customErrorBundlePretty e) id $ parsePeriodExpr d (stripquotes $ T.pack v) of (_, DateSpan (Just b) _) -> Just b _ -> Nothing | otherwise = Nothing -- Get all end dates specified by -e/--end or -p/--period options, in order, -- using the given date to interpret relative date expressions. endDatesFromRawOpts :: Day -> RawOpts -> [Day] endDatesFromRawOpts d = collectopts (enddatefromrawopt d) where enddatefromrawopt d (n,v) | n == "end" = either (\e -> usageError $ "could not parse "++n++" date: "++customErrorBundlePretty e) Just $ fixSmartDateStrEither' d (T.pack v) | n == "period" = case either (\e -> usageError $ "could not parse period option: "++customErrorBundlePretty e) id $ parsePeriodExpr d (stripquotes $ T.pack v) of (_, DateSpan _ (Just e)) -> Just e _ -> Nothing | otherwise = Nothing -- | Get the report interval, if any, specified by the last of -p/--period, -- -D/--daily, -W/--weekly, -M/--monthly etc. options. -- An interval from --period counts only if it is explicitly defined. intervalFromRawOpts :: RawOpts -> Interval intervalFromRawOpts = lastDef NoInterval . collectopts intervalfromrawopt where intervalfromrawopt (n,v) | n == "period" = either (\e -> usageError $ "could not parse period option: "++customErrorBundlePretty e) extractIntervalOrNothing $ parsePeriodExpr (error' "intervalFromRawOpts: did not expect to need today's date here") -- PARTIAL: should not happen; we are just getting the interval, which does not use the reference date (stripquotes $ T.pack v) | n == "daily" = Just $ Days 1 | n == "weekly" = Just $ Weeks 1 | n == "monthly" = Just $ Months 1 | n == "quarterly" = Just $ Quarters 1 | n == "yearly" = Just $ Years 1 | otherwise = Nothing -- | get period expression from --forecast option forecastPeriodFromRawOpts :: Day -> RawOpts -> Maybe DateSpan forecastPeriodFromRawOpts d opts = case maybestringopt "forecast" opts of Nothing -> Nothing Just "" -> Just nulldatespan Just str -> either (\e -> usageError $ "could not parse forecast period : "++customErrorBundlePretty e) (Just . snd) $ parsePeriodExpr d $ stripquotes $ T.pack str -- | Extract the interval from the parsed -p/--period expression. -- Return Nothing if an interval is not explicitly defined. extractIntervalOrNothing :: (Interval, DateSpan) -> Maybe Interval extractIntervalOrNothing (NoInterval, _) = Nothing extractIntervalOrNothing (interval, _) = Just interval -- | Get any statuses to be matched, as specified by -U/--unmarked, -- -P/--pending, -C/--cleared flags. -UPC is equivalent to no flags, -- so this returns a list of 0-2 unique statuses. statusesFromRawOpts :: RawOpts -> [Status] statusesFromRawOpts = simplifyStatuses . collectopts statusfromrawopt where statusfromrawopt (n,_) | n == "unmarked" = Just Unmarked | n == "pending" = Just Pending | n == "cleared" = Just Cleared | otherwise = Nothing -- | Reduce a list of statuses to just one of each status, -- and if all statuses are present return the empty list. simplifyStatuses l | length l' >= numstatuses = [] | otherwise = l' where l' = nubSort l numstatuses = length [minBound .. maxBound :: Status] -- | Add/remove this status from the status list. Used by hledger-ui. reportOptsToggleStatus s ropts@ReportOpts{statuses_=ss} | s `elem` ss = ropts{statuses_=filter (/= s) ss} | otherwise = ropts{statuses_=simplifyStatuses (s:ss)} -- | Parse the type of valuation to be performed, if any, specified by -- -B/--cost, -V, -X/--exchange, or --value flags. If there's more -- than one of these, the rightmost flag wins. valuationTypeFromRawOpts :: RawOpts -> Maybe ValuationType valuationTypeFromRawOpts = lastMay . collectopts valuationfromrawopt where valuationfromrawopt (n,v) -- option name, value | n == "B" = Just $ AtCost Nothing | n == "V" = Just $ AtDefault Nothing | n == "X" = Just $ AtDefault (Just $ T.pack v) | n == "value" = Just $ valuation v | otherwise = Nothing valuation v | t `elem` ["cost","c"] = AtCost mc | t `elem` ["then" ,"t"] = AtThen mc | t `elem` ["end" ,"e"] = AtEnd mc | t `elem` ["now" ,"n"] = AtNow mc | otherwise = case parsedateM t of Just d -> AtDate d mc Nothing -> usageError $ "could not parse \""++t++"\" as valuation type, should be: cost|then|end|now|c|t|e|n|YYYY-MM-DD" where -- parse --value's value: TYPE[,COMM] (t,c') = break (==',') v mc = case drop 1 c' of "" -> Nothing c -> Just $ T.pack c valuationTypeIsCost :: ReportOpts -> Bool valuationTypeIsCost ropts = case value_ ropts of Just (AtCost _) -> True _ -> False valuationTypeIsDefaultValue :: ReportOpts -> Bool valuationTypeIsDefaultValue ropts = case value_ ropts of Just (AtDefault _) -> True _ -> False -- | Select the Transaction date accessor based on --date2. transactionDateFn :: ReportOpts -> (Transaction -> Day) transactionDateFn ReportOpts{..} = if date2_ then transactionDate2 else tdate -- | Select the Posting date accessor based on --date2. postingDateFn :: ReportOpts -> (Posting -> Day) postingDateFn ReportOpts{..} = if date2_ then postingDate2 else postingDate -- | Report which date we will report on based on --date2. whichDateFromOpts :: ReportOpts -> WhichDate whichDateFromOpts ReportOpts{..} = if date2_ then SecondaryDate else PrimaryDate -- | Legacy-compatible convenience aliases for accountlistmode_. tree_ :: ReportOpts -> Bool tree_ ReportOpts{accountlistmode_ = ALTree} = True tree_ ReportOpts{accountlistmode_ = ALFlat} = False flat_ :: ReportOpts -> Bool flat_ = not . tree_ -- depthFromOpts :: ReportOpts -> Int -- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts) -- | Convert this journal's postings' amounts to cost using their -- transaction prices, if specified by options (-B/--value=cost). -- Maybe soon superseded by newer valuation code. journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal journalSelectingAmountFromOpts opts = case value_ opts of Just (AtCost _) -> journalToCost _ -> id -- | Convert report options and arguments to a query. -- If there is a parsing problem, this function calls error. queryFromOpts :: Day -> ReportOpts -> Query queryFromOpts d ropts = simplifyQuery . And $ [flagsq, argsq] where flagsq = queryFromOptsOnly d ropts argsq = fst $ either error' id $ parseQuery d (T.pack $ query_ ropts) -- PARTIAL: -- | Convert report options to a query, ignoring any non-flag command line arguments. queryFromOptsOnly :: Day -> ReportOpts -> Query queryFromOptsOnly _d ReportOpts{..} = simplifyQuery $ And flagsq where flagsq = consIf Real real_ . consIf Empty empty_ . consJust Depth depth_ $ [ (if date2_ then Date2 else Date) $ periodAsDateSpan period_ , Or $ map StatusQ statuses_ ] consIf f b = if b then (f True:) else id consJust f = maybe id ((:) . f) -- | Convert report options and arguments to query options. -- If there is a parsing problem, this function calls error. queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt] queryOptsFromOpts d = snd . either error' id . parseQuery d . T.pack . query_ -- PARTIAL: -- Report dates. -- | The effective report span is the start and end dates specified by -- options or queries, or otherwise the earliest and latest transaction or -- posting dates in the journal. If no dates are specified by options/queries -- and the journal is empty, returns the null date span. -- Needs IO to parse smart dates in options/queries. reportSpan :: Journal -> ReportOpts -> IO DateSpan reportSpan j ropts = do (mspecifiedstartdate, mspecifiedenddate) <- dbg3 "specifieddates" <$> specifiedStartEndDates ropts let DateSpan mjournalstartdate mjournalenddate = dbg3 "journalspan" $ journalDateSpan False j -- ignore secondary dates mstartdate = mspecifiedstartdate <|> mjournalstartdate menddate = mspecifiedenddate <|> mjournalenddate return $ dbg3 "reportspan" $ DateSpan mstartdate menddate reportStartDate :: Journal -> ReportOpts -> IO (Maybe Day) reportStartDate j ropts = spanStart <$> reportSpan j ropts reportEndDate :: Journal -> ReportOpts -> IO (Maybe Day) reportEndDate j ropts = spanEnd <$> reportSpan j ropts -- | The specified report start/end dates are the dates specified by options or queries, if any. -- Needs IO to parse smart dates in options/queries. specifiedStartEndDates :: ReportOpts -> IO (Maybe Day, Maybe Day) specifiedStartEndDates ropts = do today <- getCurrentDay let q = queryFromOpts today ropts mspecifiedstartdate = queryStartDate False q mspecifiedenddate = queryEndDate False q return (mspecifiedstartdate, mspecifiedenddate) specifiedStartDate :: ReportOpts -> IO (Maybe Day) specifiedStartDate ropts = fst <$> specifiedStartEndDates ropts specifiedEndDate :: ReportOpts -> IO (Maybe Day) specifiedEndDate ropts = snd <$> specifiedStartEndDates ropts -- Some pure alternatives to the above. XXX review/clean up -- Get the report's start date. -- If no report period is specified, will be Nothing. -- Will also be Nothing if ReportOpts does not have today_ set, -- since we need that to get the report period robustly -- (unlike reportStartDate, which looks up the date with IO.) reportPeriodStart :: ReportOpts -> Maybe Day reportPeriodStart ropts@ReportOpts{..} = do t <- today_ queryStartDate False $ queryFromOpts t ropts -- Get the report's start date, or if no report period is specified, -- the journal's start date (the earliest posting date). If there's no -- report period and nothing in the journal, will be Nothing. reportPeriodOrJournalStart :: ReportOpts -> Journal -> Maybe Day reportPeriodOrJournalStart ropts j = reportPeriodStart ropts <|> journalStartDate False j -- Get the last day of the overall report period. -- This the inclusive end date (one day before the -- more commonly used, exclusive, report end date). -- If no report period is specified, will be Nothing. -- Will also be Nothing if ReportOpts does not have today_ set, -- since we need that to get the report period robustly -- (unlike reportEndDate, which looks up the date with IO.) reportPeriodLastDay :: ReportOpts -> Maybe Day reportPeriodLastDay ropts@ReportOpts{..} = do t <- today_ let q = queryFromOpts t ropts qend <- queryEndDate False q return $ addDays (-1) qend -- Get the last day of the overall report period, or if no report -- period is specified, the last day of the journal (ie the latest -- posting date). If there's no report period and nothing in the -- journal, will be Nothing. reportPeriodOrJournalLastDay :: ReportOpts -> Journal -> Maybe Day reportPeriodOrJournalLastDay ropts j = reportPeriodLastDay ropts <|> journalEndDate False j -- tests tests_ReportOptions = tests "ReportOptions" [ test "queryFromOpts" $ do queryFromOpts nulldate defreportopts @?= Any queryFromOpts nulldate defreportopts{query_="a"} @?= Acct (toRegexCI' "a") queryFromOpts nulldate defreportopts{query_="desc:'a a'"} @?= Desc (toRegexCI' "a a") queryFromOpts nulldate defreportopts{period_=PeriodFrom (fromGregorian 2012 01 01),query_="date:'to 2013'" } @?= (Date $ DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01)) queryFromOpts nulldate defreportopts{query_="date2:'in 2012'"} @?= (Date2 $ DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01)) queryFromOpts nulldate defreportopts{query_="'a a' 'b"} @?= Or [Acct $ toRegexCI' "a a", Acct $ toRegexCI' "'b"] ,test "queryOptsFromOpts" $ do queryOptsFromOpts nulldate defreportopts @?= [] queryOptsFromOpts nulldate defreportopts{query_="a"} @?= [] queryOptsFromOpts nulldate defreportopts{period_=PeriodFrom (fromGregorian 2012 01 01) ,query_="date:'to 2013'"} @?= [] ] hledger-lib-1.19.1/Hledger/Reports/ReportTypes.hs0000644000000000000000000001625613722544246020036 0ustar0000000000000000{- | New common report types, used by the BudgetReport for now, perhaps all reports later. -} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} module Hledger.Reports.ReportTypes ( PeriodicReport(..) , PeriodicReportRow(..) , Percentage , Change , Balance , Total , Average , periodicReportSpan , prNormaliseSign , prMapName , prMapMaybeName , CompoundPeriodicReport(..) , CBCSubreportSpec(..) , DisplayName(..) , flatDisplayName , treeDisplayName , prrFullName , prrDisplayName , prrDepth ) where import Data.Aeson import Data.Decimal import Data.Maybe (mapMaybe) #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup(..)) #endif import GHC.Generics (Generic) import Hledger.Data import Hledger.Query (Query) type Percentage = Decimal type Change = MixedAmount -- ^ A change in balance during a certain period. type Balance = MixedAmount -- ^ An ending balance as of some date. type Total = MixedAmount -- ^ The sum of 'Change's in a report or a report row. Does not make sense for 'Balance's. type Average = MixedAmount -- ^ The average of 'Change's or 'Balance's in a report or report row. -- | A periodic report is a generic tabular report, where each row corresponds -- to some label (usually an account name) and each column to a date period. -- The column periods are usually consecutive subperiods formed by splitting -- the overall report period by some report interval (daily, weekly, etc.). -- It has: -- -- 1. a list of each column's period (date span) -- -- 2. a list of rows, each containing: -- -- * an account label -- -- * the account's depth -- -- * A list of amounts, one for each column. Depending on the value type, -- these can represent balance changes, ending balances, budget -- performance, etc. (for example, see 'BalanceType' and -- "Hledger.Cli.Commands.Balance"). -- -- * the total of the row's amounts for a periodic report, -- or zero for cumulative/historical reports (since summing -- end balances generally doesn't make sense). -- -- * the average of the row's amounts -- -- 3. the column totals, and the overall grand total (or zero for -- cumulative/historical reports) and grand average. data PeriodicReport a b = PeriodicReport { prDates :: [DateSpan] -- The subperiods formed by splitting the overall -- report period by the report interval. For -- ending-balance reports, only the end date is -- significant. Usually displayed as report columns. , prRows :: [PeriodicReportRow a b] -- One row per account in the report. , prTotals :: PeriodicReportRow () b -- The grand totals row. } deriving (Show, Functor, Generic, ToJSON) data PeriodicReportRow a b = PeriodicReportRow { prrName :: a -- An account name. , prrAmounts :: [b] -- The data value for each subperiod. , prrTotal :: b -- The total of this row's values. , prrAverage :: b -- The average of this row's values. } deriving (Show, Functor, Generic, ToJSON) instance Num b => Semigroup (PeriodicReportRow a b) where (PeriodicReportRow _ amts1 t1 a1) <> (PeriodicReportRow n2 amts2 t2 a2) = PeriodicReportRow n2 (sumPadded amts1 amts2) (t1 + t2) (a1 + a2) where sumPadded (a:as) (b:bs) = (a + b) : sumPadded as bs sumPadded as [] = as sumPadded [] bs = bs -- | Figure out the overall date span of a PeridicReport periodicReportSpan :: PeriodicReport a b -> DateSpan periodicReportSpan (PeriodicReport [] _ _) = DateSpan Nothing Nothing periodicReportSpan (PeriodicReport colspans _ _) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans) -- | Given a PeriodicReport and its normal balance sign, -- if it is known to be normally negative, convert it to normally positive. prNormaliseSign :: Num b => NormalSign -> PeriodicReport a b -> PeriodicReport a b prNormaliseSign NormallyNegative = fmap negate prNormaliseSign NormallyPositive = id -- | Map a function over the row names. prMapName :: (a -> b) -> PeriodicReport a c -> PeriodicReport b c prMapName f report = report{prRows = map (prrMapName f) $ prRows report} -- | Map a function over the row names, possibly discarding some. prMapMaybeName :: (a -> Maybe b) -> PeriodicReport a c -> PeriodicReport b c prMapMaybeName f report = report{prRows = mapMaybe (prrMapMaybeName f) $ prRows report} -- | Map a function over the row names of the PeriodicReportRow. prrMapName :: (a -> b) -> PeriodicReportRow a c -> PeriodicReportRow b c prrMapName f row = row{prrName = f $ prrName row} -- | Map maybe a function over the row names of the PeriodicReportRow. prrMapMaybeName :: (a -> Maybe b) -> PeriodicReportRow a c -> Maybe (PeriodicReportRow b c) prrMapMaybeName f row = case f $ prrName row of Nothing -> Nothing Just a -> Just row{prrName = a} -- | A compound balance report has: -- -- * an overall title -- -- * the period (date span) of each column -- -- * one or more named, normal-positive multi balance reports, -- with columns corresponding to the above, and a flag indicating -- whether they increased or decreased the overall totals -- -- * a list of overall totals for each column, and their grand total and average -- -- It is used in compound balance report commands like balancesheet, -- cashflow and incomestatement. data CompoundPeriodicReport a b = CompoundPeriodicReport { cbrTitle :: String , cbrDates :: [DateSpan] , cbrSubreports :: [(String, PeriodicReport a b, Bool)] , cbrTotals :: PeriodicReportRow () b } deriving (Show, Generic, ToJSON) -- | Description of one subreport within a compound balance report. -- Part of a "CompoundBalanceCommandSpec", but also used in hledger-lib. data CBCSubreportSpec = CBCSubreportSpec { cbcsubreporttitle :: String , cbcsubreportquery :: Journal -> Query , cbcsubreportnormalsign :: NormalSign , cbcsubreportincreasestotal :: Bool } -- | A full name, display name, and depth for an account. data DisplayName = DisplayName { displayFull :: AccountName , displayName :: AccountName , displayDepth :: Int } deriving (Show, Eq, Ord) instance ToJSON DisplayName where toJSON = toJSON . displayFull toEncoding = toEncoding . displayFull -- | Construct a flat display name, where the full name is also displayed at -- depth 1 flatDisplayName :: AccountName -> DisplayName flatDisplayName a = DisplayName a a 1 -- | Construct a tree display name, where only the leaf is displayed at its -- given depth treeDisplayName :: AccountName -> DisplayName treeDisplayName a = DisplayName a (accountLeafName a) (accountNameLevel a) -- | Get the full, canonical, name of a PeriodicReportRow tagged by a -- DisplayName. prrFullName :: PeriodicReportRow DisplayName a -> AccountName prrFullName = displayFull . prrName -- | Get the display name of a PeriodicReportRow tagged by a DisplayName. prrDisplayName :: PeriodicReportRow DisplayName a -> AccountName prrDisplayName = displayName . prrName -- | Get the display depth of a PeriodicReportRow tagged by a DisplayName. prrDepth :: PeriodicReportRow DisplayName a -> Int prrDepth = displayDepth . prrName hledger-lib-1.19.1/Hledger/Reports/AccountTransactionsReport.hs0000644000000000000000000002515413723502755022714 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-} {-| An account-centric transactions report. -} module Hledger.Reports.AccountTransactionsReport ( AccountTransactionsReport, AccountTransactionsReportItem, accountTransactionsReport, accountTransactionsReportItems, transactionRegisterDate, tests_AccountTransactionsReport ) where import Data.List import Data.Ord import Data.Maybe import qualified Data.Text as T import Data.Time.Calendar import Hledger.Data import Hledger.Query import Hledger.Reports.ReportOptions import Hledger.Utils -- | An account transactions report represents transactions affecting -- a particular account (or possibly several accounts, but we don't -- use that). It is used eg by hledger-ui's and hledger-web's register -- view, and hledger's aregister report, where we want to show one row -- per transaction, in the context of the current account. Report -- items consist of: -- -- - the transaction, unmodified -- -- - the transaction as seen in the context of the current account and query, -- which means: -- -- - the transaction date is set to the "transaction context date", -- which can be different from the transaction's general date: -- if postings to the current account (and matched by the report query) -- have their own dates, it's the earliest of these dates. -- -- - the transaction's postings are filtered, excluding any which are not -- matched by the report query -- -- - a text description of the other account(s) posted to/from -- -- - a flag indicating whether there's more than one other account involved -- -- - the total increase/decrease to the current account -- -- - the report transactions' running total after this transaction; -- or if historical balance is requested (-H), the historical running total. -- The historical running total includes transactions from before the -- report start date if one is specified, filtered by the report query. -- The historical running total may or may not be the account's historical -- running balance, depending on the report query. -- -- Items are sorted by transaction register date (the earliest date the transaction -- posts to the current account), most recent first. -- Reporting intervals are currently ignored. -- type AccountTransactionsReport = (String -- label for the balance column, eg "balance" or "total" ,[AccountTransactionsReportItem] -- line items, one per transaction ) type AccountTransactionsReportItem = ( Transaction -- the transaction, unmodified ,Transaction -- the transaction, as seen from the current account ,Bool -- is this a split (more than one posting to other accounts) ? ,String -- a display string describing the other account(s), if any ,MixedAmount -- the amount posted to the current account(s) (or total amount posted) ,MixedAmount -- the register's running total or the current account(s)'s historical balance, after this transaction ) totallabel = "Period Total" balancelabel = "Historical Total" accountTransactionsReport :: ReportOpts -> Journal -> Query -> Query -> AccountTransactionsReport accountTransactionsReport ropts j reportq thisacctq = (label, items) where -- a depth limit should not affect the account transactions report -- seems unnecessary for some reason XXX reportq' = -- filterQuery (not . queryIsDepth) reportq -- get all transactions ts1 = -- ptraceAtWith 5 (("ts1:\n"++).pshowTransactions) $ jtxns j -- apply any cur:SYM filters in reportq' symq = filterQuery queryIsSym reportq' ts2 = ptraceAtWith 5 (("ts2:\n"++).pshowTransactions) $ (if queryIsNull symq then id else map (filterTransactionAmounts symq)) ts1 -- keep just the transactions affecting this account (via possibly realness or status-filtered postings) realq = filterQuery queryIsReal reportq' statusq = filterQuery queryIsStatus reportq' ts3 = traceAt 3 ("thisacctq: "++show thisacctq) $ ptraceAtWith 5 (("ts3:\n"++).pshowTransactions) $ filter (matchesTransaction thisacctq . filterTransactionPostings (And [realq, statusq])) ts2 -- maybe convert these transactions to cost or value -- PARTIAL: prices = journalPriceOracle (infer_value_ ropts) j styles = journalCommodityStyles j periodlast = fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen reportPeriodOrJournalLastDay ropts j mreportlast = reportPeriodLastDay ropts today = fromMaybe (error' "journalApplyValuation: could not pick a valuation date, ReportOpts today_ is unset") $ today_ ropts -- XXX shouldn't happen multiperiod = interval_ ropts /= NoInterval tval = case value_ ropts of Just v -> \t -> transactionApplyValuation prices styles periodlast mreportlast today multiperiod t v Nothing -> id ts4 = ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $ map tval ts3 -- sort by the transaction's register date, for accurate starting balance -- these are not yet filtered by tdate, we want to search them all for priorps ts5 = ptraceAtWith 5 (("ts5:\n"++).pshowTransactions) $ sortBy (comparing (transactionRegisterDate reportq' thisacctq)) ts4 (startbal,label) | balancetype_ ropts == HistoricalBalance = (sumPostings priorps, balancelabel) | otherwise = (nullmixedamt, totallabel) where priorps = dbg5 "priorps" $ filter (matchesPosting (dbg5 "priorq" $ And [thisacctq, tostartdateq, datelessreportq])) $ transactionsPostings ts5 tostartdateq = case mstartdate of Just _ -> Date (DateSpan Nothing mstartdate) Nothing -> None -- no start date specified, there are no prior postings mstartdate = queryStartDate (date2_ ropts) reportq' datelessreportq = filterQuery (not . queryIsDateOrDate2) reportq' -- accountTransactionsReportItem will keep transactions of any date which have any posting inside the report period. -- Should we also require that transaction date is inside the report period ? -- Should we be filtering by reportq here to apply other query terms (?) -- Make it an option for now. filtertxns = txn_dates_ ropts items = reverse $ accountTransactionsReportItems reportq' thisacctq startbal negate $ (if filtertxns then filter (reportq' `matchesTransaction`) else id) $ ts5 pshowTransactions :: [Transaction] -> String pshowTransactions = pshow . map (\t -> unwords [show $ tdate t, T.unpack $ tdescription t]) -- | Generate transactions report items from a list of transactions, -- using the provided user-specified report query, a query specifying -- which account to use as the focus, a starting balance, a sign-setting -- function and a balance-summing function. Or with a None current account -- query, this can also be used for the transactionsReport. accountTransactionsReportItems :: Query -> Query -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [AccountTransactionsReportItem] accountTransactionsReportItems reportq thisacctq bal signfn = catMaybes . snd . mapAccumL (accountTransactionsReportItem reportq thisacctq signfn) bal accountTransactionsReportItem :: Query -> Query -> (MixedAmount -> MixedAmount) -> MixedAmount -> Transaction -> (MixedAmount, Maybe AccountTransactionsReportItem) accountTransactionsReportItem reportq thisacctq signfn bal torig = balItem -- 201403: This is used for both accountTransactionsReport and transactionsReport, which makes it a bit overcomplicated -- 201407: I've lost my grip on this, let's just hope for the best -- 201606: we now calculate change and balance from filtered postings, check this still works well for all callers XXX where tfiltered@Transaction{tpostings=reportps} = filterTransactionPostings reportq torig tacct = tfiltered{tdate=transactionRegisterDate reportq thisacctq tfiltered} balItem = case reportps of [] -> (bal, Nothing) -- no matched postings in this transaction, skip it _ -> (b, Just (torig, tacct, numotheraccts > 1, otheracctstr, a, b)) where (thisacctps, otheracctps) = partition (matchesPosting thisacctq) reportps numotheraccts = length $ nub $ map paccount otheracctps otheracctstr | thisacctq == None = summarisePostingAccounts reportps -- no current account ? summarise all matched postings | numotheraccts == 0 = summarisePostingAccounts thisacctps -- only postings to current account ? summarise those | otherwise = summarisePostingAccounts otheracctps -- summarise matched postings to other account(s) a = signfn $ negate $ sum $ map pamount thisacctps b = bal + a -- | What is the transaction's date in the context of a particular account -- (specified with a query) and report query, as in an account register ? -- It's normally the transaction's general date, but if any posting(s) -- matched by the report query and affecting the matched account(s) have -- their own earlier dates, it's the earliest of these dates. -- Secondary transaction/posting dates are ignored. transactionRegisterDate :: Query -> Query -> Transaction -> Day transactionRegisterDate reportq thisacctq t | null thisacctps = tdate t | otherwise = minimum $ map postingDate thisacctps where reportps = tpostings $ filterTransactionPostings reportq t thisacctps = filter (matchesPosting thisacctq) reportps -- -- | Generate a short readable summary of some postings, like -- -- "from (negatives) to (positives)". -- summarisePostings :: [Posting] -> String -- summarisePostings ps = -- case (summarisePostingAccounts froms, summarisePostingAccounts tos) of -- ("",t) -> "to "++t -- (f,"") -> "from "++f -- (f,t) -> "from "++f++" to "++t -- where -- (froms,tos) = partition (fromMaybe False . isNegativeMixedAmount . pamount) ps -- | Generate a simplified summary of some postings' accounts. -- To reduce noise, if there are both real and virtual postings, show only the real ones. summarisePostingAccounts :: [Posting] -> String summarisePostingAccounts ps = (intercalate ", " . map (T.unpack . accountSummarisedName) . nub . map paccount) displayps -- XXX pack where realps = filter isReal ps displayps | null realps = ps | otherwise = realps -- tests tests_AccountTransactionsReport = tests "AccountTransactionsReport" [ ] hledger-lib-1.19.1/Hledger/Reports/BalanceReport.hs0000644000000000000000000002613513723300774020251 0ustar0000000000000000{-| Balance report, used by the balance command. -} {-# LANGUAGE FlexibleInstances, RecordWildCards, ScopedTypeVariables, OverloadedStrings #-} module Hledger.Reports.BalanceReport ( BalanceReport, BalanceReportItem, balanceReport, flatShowsExclusiveBalance, -- * Tests tests_BalanceReport ) where import Data.Time.Calendar import Hledger.Data import Hledger.Read (mamountp') import Hledger.Query import Hledger.Utils import Hledger.Reports.MultiBalanceReport (multiBalanceReportWith) import Hledger.Reports.ReportOptions import Hledger.Reports.ReportTypes -- | A simple balance report. It has: -- -- 1. a list of items, one per account, each containing: -- -- * the full account name -- -- * the Ledger-style elided short account name -- (the leaf account name, prefixed by any boring parents immediately above); -- or with --flat, the full account name again -- -- * the number of indentation steps for rendering a Ledger-style account tree, -- taking into account elided boring parents, --no-elide and --flat -- -- * an amount -- -- 2. the total of all amounts -- type BalanceReport = ([BalanceReportItem], MixedAmount) type BalanceReportItem = (AccountName, AccountName, Int, MixedAmount) -- | When true (the default), this makes balance --flat reports and their implementation clearer. -- Single/multi-col balance reports currently aren't all correct if this is false. flatShowsExclusiveBalance = True -- | Enabling this makes balance --flat --empty also show parent accounts without postings, -- in addition to those with postings and a zero balance. Disabling it shows only the latter. -- No longer supported, but leave this here for a bit. -- flatShowsPostinglessAccounts = True -- | Generate a simple balance report, containing the matched accounts and -- their balances (change of balance) during the specified period. -- If the normalbalance_ option is set, it adjusts the sorting and sign of -- amounts (see ReportOpts and CompoundBalanceCommand). balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport balanceReport ropts q j = (rows, total) where report = multiBalanceReportWith ropts q j (journalPriceOracle (infer_value_ ropts) j) rows = [( prrFullName row , prrDisplayName row , prrDepth row - 1 -- BalanceReport uses 0-based account depths , prrTotal row ) | row <- prRows report] total = prrTotal $ prTotals report -- tests Right samplejournal2 = journalBalanceTransactions False nulljournal{ jtxns = [ txnTieKnot Transaction{ tindex=0, tsourcepos=nullsourcepos, tdate=fromGregorian 2008 01 01, tdate2=Just $ fromGregorian 2009 01 01, tstatus=Unmarked, tcode="", tdescription="income", tcomment="", ttags=[], tpostings= [posting {paccount="assets:bank:checking", pamount=Mixed [usd 1]} ,posting {paccount="income:salary", pamount=missingmixedamt} ], tprecedingcomment="" } ] } tests_BalanceReport = tests "BalanceReport" [ let (opts,journal) `gives` r = do let (eitems, etotal) = r (aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt) (map showw aitems) @?= (map showw eitems) (showMixedAmountDebug atotal) @?= (showMixedAmountDebug etotal) in tests "balanceReport" [ test "no args, null journal" $ (defreportopts, nulljournal) `gives` ([], 0) ,test "no args, sample journal" $ (defreportopts, samplejournal) `gives` ([ ("assets:bank:checking","assets:bank:checking",0, mamountp' "$1.00") ,("assets:bank:saving","assets:bank:saving",0, mamountp' "$1.00") ,("assets:cash","assets:cash",0, mamountp' "$-2.00") ,("expenses:food","expenses:food",0, mamountp' "$1.00") ,("expenses:supplies","expenses:supplies",0, mamountp' "$1.00") ,("income:gifts","income:gifts",0, mamountp' "$-1.00") ,("income:salary","income:salary",0, mamountp' "$-1.00") ], Mixed [usd 0]) ,test "with --tree" $ (defreportopts{accountlistmode_=ALTree}, samplejournal) `gives` ([ ("assets","assets",0, mamountp' "$0.00") ,("assets:bank","bank",1, mamountp' "$2.00") ,("assets:bank:checking","checking",2, mamountp' "$1.00") ,("assets:bank:saving","saving",2, mamountp' "$1.00") ,("assets:cash","cash",1, mamountp' "$-2.00") ,("expenses","expenses",0, mamountp' "$2.00") ,("expenses:food","food",1, mamountp' "$1.00") ,("expenses:supplies","supplies",1, mamountp' "$1.00") ,("income","income",0, mamountp' "$-2.00") ,("income:gifts","gifts",1, mamountp' "$-1.00") ,("income:salary","salary",1, mamountp' "$-1.00") ], Mixed [usd 0]) ,test "with --depth=N" $ (defreportopts{depth_=Just 1}, samplejournal) `gives` ([ ("expenses", "expenses", 0, mamountp' "$2.00") ,("income", "income", 0, mamountp' "$-2.00") ], Mixed [usd 0]) ,test "with depth:N" $ (defreportopts{query_="depth:1"}, samplejournal) `gives` ([ ("expenses", "expenses", 0, mamountp' "$2.00") ,("income", "income", 0, mamountp' "$-2.00") ], Mixed [usd 0]) ,test "with date:" $ (defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives` ([], 0) ,test "with date2:" $ (defreportopts{query_="date2:'in 2009'"}, samplejournal2) `gives` ([ ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00") ,("income:salary","income:salary",0,mamountp' "$-1.00") ], Mixed [usd 0]) ,test "with desc:" $ (defreportopts{query_="desc:income"}, samplejournal) `gives` ([ ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00") ,("income:salary","income:salary",0, mamountp' "$-1.00") ], Mixed [usd 0]) ,test "with not:desc:" $ (defreportopts{query_="not:desc:income"}, samplejournal) `gives` ([ ("assets:bank:saving","assets:bank:saving",0, mamountp' "$1.00") ,("assets:cash","assets:cash",0, mamountp' "$-2.00") ,("expenses:food","expenses:food",0, mamountp' "$1.00") ,("expenses:supplies","expenses:supplies",0, mamountp' "$1.00") ,("income:gifts","income:gifts",0, mamountp' "$-1.00") ], Mixed [usd 0]) ,test "with period on a populated period" $ (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2)}, samplejournal) `gives` ( [ ("assets:bank:checking","assets:bank:checking",0, mamountp' "$1.00") ,("income:salary","income:salary",0, mamountp' "$-1.00") ], Mixed [usd 0]) ,test "with period on an unpopulated period" $ (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}, samplejournal) `gives` ([], 0) {- ,test "accounts report with account pattern o" ~: defreportopts{patterns_=["o"]} `gives` [" $1 expenses:food" ," $-2 income" ," $-1 gifts" ," $-1 salary" ,"--------------------" ," $-1" ] ,test "accounts report with account pattern o and --depth 1" ~: defreportopts{patterns_=["o"],depth_=Just 1} `gives` [" $1 expenses" ," $-2 income" ,"--------------------" ," $-1" ] ,test "accounts report with account pattern a" ~: defreportopts{patterns_=["a"]} `gives` [" $-1 assets" ," $1 bank:saving" ," $-2 cash" ," $-1 income:salary" ," $1 liabilities:debts" ,"--------------------" ," $-1" ] ,test "accounts report with account pattern e" ~: defreportopts{patterns_=["e"]} `gives` [" $-1 assets" ," $1 bank:saving" ," $-2 cash" ," $2 expenses" ," $1 food" ," $1 supplies" ," $-2 income" ," $-1 gifts" ," $-1 salary" ," $1 liabilities:debts" ,"--------------------" ," 0" ] ,test "accounts report with unmatched parent of two matched subaccounts" ~: defreportopts{patterns_=["cash","saving"]} `gives` [" $-1 assets" ," $1 bank:saving" ," $-2 cash" ,"--------------------" ," $-1" ] ,test "accounts report with multi-part account name" ~: defreportopts{patterns_=["expenses:food"]} `gives` [" $1 expenses:food" ,"--------------------" ," $1" ] ,test "accounts report with negative account pattern" ~: defreportopts{patterns_=["not:assets"]} `gives` [" $2 expenses" ," $1 food" ," $1 supplies" ," $-2 income" ," $-1 gifts" ," $-1 salary" ," $1 liabilities:debts" ,"--------------------" ," $1" ] ,test "accounts report negative account pattern always matches full name" ~: defreportopts{patterns_=["not:e"]} `gives` ["--------------------" ," 0" ] ,test "accounts report negative patterns affect totals" ~: defreportopts{patterns_=["expenses","not:food"]} `gives` [" $1 expenses:supplies" ,"--------------------" ," $1" ] ,test "accounts report with -E shows zero-balance accounts" ~: defreportopts{patterns_=["assets"],empty_=True} `gives` [" $-1 assets" ," $1 bank" ," 0 checking" ," $1 saving" ," $-2 cash" ,"--------------------" ," $-1" ] ,test "accounts report with cost basis" $ j <- (readJournal def Nothing $ unlines ["" ,"2008/1/1 test " ," a:b 10h @ $50" ," c:d " ]) >>= either error' return let j' = journalCanonicaliseAmounts $ journalToCost j -- enable cost basis adjustment balanceReportAsText defreportopts (balanceReport defreportopts Any j') `is` [" $500 a:b" ," $-500 c:d" ,"--------------------" ," 0" ] -} ] ] hledger-lib-1.19.1/Hledger/Reports/BudgetReport.hs0000644000000000000000000003563313722544246020144 0ustar0000000000000000{- | -} {-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} module Hledger.Reports.BudgetReport ( BudgetGoal, BudgetTotal, BudgetAverage, BudgetCell, BudgetReportRow, BudgetReport, budgetReport, budgetReportAsTable, budgetReportAsText, -- * Helpers reportPeriodName, -- * Tests tests_BudgetReport ) where import Data.Decimal import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM import Data.List import Data.List.Extra (nubSort) import Data.Maybe #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif import Data.Time.Calendar import Safe --import Data.List --import Data.Maybe import qualified Data.Map as Map import Data.Map (Map) import qualified Data.Text as T --import qualified Data.Text.Lazy as TL --import System.Console.CmdArgs.Explicit as C --import Lucid as L import Text.Printf (printf) import Text.Tabular as T import Hledger.Data import Hledger.Utils import Hledger.Reports.ReportOptions import Hledger.Reports.ReportTypes import Hledger.Reports.MultiBalanceReport type BudgetGoal = Change type BudgetTotal = Total type BudgetAverage = Average -- | A budget report tracks expected and actual changes per account and subperiod. type BudgetCell = (Maybe Change, Maybe BudgetGoal) type BudgetReportRow = PeriodicReportRow DisplayName BudgetCell type BudgetReport = PeriodicReport DisplayName BudgetCell -- | Calculate budget goals from all periodic transactions, -- actual balance changes from the regular transactions, -- and compare these to get a 'BudgetReport'. -- Unbudgeted accounts may be hidden or renamed (see budgetRollup). budgetReport :: ReportOpts -> Bool -> DateSpan -> Day -> Journal -> BudgetReport budgetReport ropts' assrt reportspan d j = dbg1 "sortedbudgetreport" budgetreport where -- Budget report demands ALTree mode to ensure subaccounts and subaccount budgets are properly handled -- and that reports with and without --empty make sense when compared side by side ropts = ropts' { accountlistmode_ = ALTree } showunbudgeted = empty_ ropts budgetedaccts = dbg2 "budgetedacctsinperiod" $ nub $ concatMap expandAccountName $ accountNamesFromPostings $ concatMap tpostings $ concatMap (`runPeriodicTransaction` reportspan) $ jperiodictxns j actualj = dbg1With (("actualj"++).show.jtxns) $ budgetRollUp budgetedaccts showunbudgeted j budgetj = dbg1With (("budgetj"++).show.jtxns) $ budgetJournal assrt ropts reportspan j actualreport@(PeriodicReport actualspans _ _) = dbg1 "actualreport" $ multiBalanceReport d ropts{empty_=True} actualj budgetgoalreport@(PeriodicReport _ budgetgoalitems budgetgoaltotals) = dbg1 "budgetgoalreport" $ multiBalanceReport d ropts{empty_=True} budgetj budgetgoalreport' -- If no interval is specified: -- budgetgoalreport's span might be shorter actualreport's due to periodic txns; -- it should be safe to replace it with the latter, so they combine well. | interval_ ropts == NoInterval = PeriodicReport actualspans budgetgoalitems budgetgoaltotals | otherwise = budgetgoalreport budgetreport = combineBudgetAndActual ropts j budgetgoalreport' actualreport -- | Use all periodic transactions in the journal to generate -- budget transactions in the specified report period. -- Budget transactions are similar to forecast transactions except -- their purpose is to set goal amounts (of change) per account and period. budgetJournal :: Bool -> ReportOpts -> DateSpan -> Journal -> Journal budgetJournal assrt _ropts reportspan j = either error' id $ journalBalanceTransactions assrt j{ jtxns = budgetts } -- PARTIAL: where budgetspan = dbg2 "budgetspan" $ reportspan budgetts = dbg1 "budgetts" $ [makeBudgetTxn t | pt <- jperiodictxns j , t <- runPeriodicTransaction pt budgetspan ] makeBudgetTxn t = txnTieKnot $ t { tdescription = T.pack "Budget transaction" } -- | Adjust a journal's account names for budget reporting, in two ways: -- -- 1. accounts with no budget goal anywhere in their ancestry are moved -- under the "unbudgeted" top level account. -- -- 2. subaccounts with no budget goal are merged with their closest parent account -- with a budget goal, so that only budgeted accounts are shown. -- This can be disabled by --empty. -- budgetRollUp :: [AccountName] -> Bool -> Journal -> Journal budgetRollUp budgetedaccts showunbudgeted j = j { jtxns = remapTxn <$> jtxns j } where remapTxn = mapPostings (map remapPosting) where mapPostings f t = txnTieKnot $ t { tpostings = f $ tpostings t } remapPosting p = p { paccount = remapAccount $ paccount p, poriginal = Just . fromMaybe p $ poriginal p } where remapAccount a | hasbudget = a | hasbudgetedparent = if showunbudgeted then a else budgetedparent | otherwise = if showunbudgeted then u <> acctsep <> a else u where hasbudget = a `elem` budgetedaccts hasbudgetedparent = not $ T.null budgetedparent budgetedparent = headDef "" $ filter (`elem` budgetedaccts) $ parentAccountNames a u = unbudgetedAccountName -- | Combine a per-account-and-subperiod report of budget goals, and one -- of actual change amounts, into a budget performance report. -- The two reports should have the same report interval, but need not -- have exactly the same account rows or date columns. -- (Cells in the combined budget report can be missing a budget goal, -- an actual amount, or both.) The combined report will include: -- -- - consecutive subperiods at the same interval as the two reports, -- spanning the period of both reports -- -- - all accounts mentioned in either report, sorted by account code or -- account name or amount as appropriate. -- combineBudgetAndActual :: ReportOpts -> Journal -> MultiBalanceReport -> MultiBalanceReport -> BudgetReport combineBudgetAndActual ropts j (PeriodicReport budgetperiods budgetrows (PeriodicReportRow _ budgettots budgetgrandtot budgetgrandavg)) (PeriodicReport actualperiods actualrows (PeriodicReportRow _ actualtots actualgrandtot actualgrandavg)) = PeriodicReport periods sortedrows totalrow where periods = nubSort . filter (/= nulldatespan) $ budgetperiods ++ actualperiods -- first, combine any corresponding budget goals with actual changes rows1 = [ PeriodicReportRow acct amtandgoals totamtandgoal avgamtandgoal | PeriodicReportRow acct actualamts actualtot actualavg <- actualrows , let mbudgetgoals = HM.lookup (displayFull acct) budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage) , let budgetmamts = maybe (Nothing <$ periods) (map Just . first3) mbudgetgoals :: [Maybe BudgetGoal] , let mbudgettot = second3 <$> mbudgetgoals :: Maybe BudgetTotal , let mbudgetavg = third3 <$> mbudgetgoals :: Maybe BudgetAverage , let acctBudgetByPeriod = Map.fromList [ (p,budgetamt) | (p, Just budgetamt) <- zip budgetperiods budgetmamts ] :: Map DateSpan BudgetGoal , let acctActualByPeriod = Map.fromList [ (p,actualamt) | (p, Just actualamt) <- zip actualperiods (map Just actualamts) ] :: Map DateSpan Change , let amtandgoals = [ (Map.lookup p acctActualByPeriod, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [BudgetCell] , let totamtandgoal = (Just actualtot, mbudgettot) , let avgamtandgoal = (Just actualavg, mbudgetavg) ] where budgetGoalsByAcct :: HashMap AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) = HM.fromList [ (displayFull acct, (amts, tot, avg)) | PeriodicReportRow acct amts tot avg <- budgetrows ] -- next, make rows for budget goals with no actual changes rows2 = [ PeriodicReportRow acct amtandgoals totamtandgoal avgamtandgoal | PeriodicReportRow acct budgetgoals budgettot budgetavg <- budgetrows , displayFull acct `notElem` map prrFullName rows1 , let acctBudgetByPeriod = Map.fromList $ zip budgetperiods budgetgoals :: Map DateSpan BudgetGoal , let amtandgoals = [ (Nothing, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [BudgetCell] , let totamtandgoal = (Nothing, Just budgettot) , let avgamtandgoal = (Nothing, Just budgetavg) ] -- combine and re-sort rows -- TODO: add --sort-budget to sort by budget goal amount sortedrows :: [BudgetReportRow] = sortRowsLike (mbrsorted unbudgetedrows ++ mbrsorted rows') rows where (unbudgetedrows, rows') = partition ((==unbudgetedAccountName) . prrFullName) rows mbrsorted = map prrFullName . sortRows ropts j . map (fmap $ fromMaybe 0 . fst) rows = rows1 ++ rows2 -- TODO: grand total & average shows 0% when there are no actual amounts, inconsistent with other cells totalrow = PeriodicReportRow () [ (Map.lookup p totActualByPeriod, Map.lookup p totBudgetByPeriod) | p <- periods ] ( Just actualgrandtot, Just budgetgrandtot ) ( Just actualgrandavg, Just budgetgrandavg ) where totBudgetByPeriod = Map.fromList $ zip budgetperiods budgettots :: Map DateSpan BudgetTotal totActualByPeriod = Map.fromList $ zip actualperiods actualtots :: Map DateSpan Change -- | Render a budget report as plain text suitable for console output. budgetReportAsText :: ReportOpts -> BudgetReport -> String budgetReportAsText ropts@ReportOpts{..} budgetr = title ++ "\n\n" ++ tableAsText ropts showcell (maybetranspose $ budgetReportAsTable ropts budgetr) where multiperiod = interval_ /= NoInterval title = printf "Budget performance in %s%s:" (showDateSpan $ periodicReportSpan budgetr) (case value_ of Just (AtCost _mc) -> ", valued at cost" Just (AtThen _mc) -> error' unsupportedValueThenError -- PARTIAL: Just (AtEnd _mc) -> ", valued at period ends" Just (AtNow _mc) -> ", current value" -- XXX duplicates the above Just (AtDefault _mc) | multiperiod -> ", valued at period ends" Just (AtDefault _mc) -> ", current value" Just (AtDate d _mc) -> ", valued at "++showDate d Nothing -> "") actualwidth = maximum' $ map fst amountsAndGoals budgetwidth = maximum' $ map snd amountsAndGoals amountsAndGoals = map (\(a,g) -> (amountWidth a, amountWidth g)) . concatMap prrAmounts $ prRows budgetr where amountWidth = maybe 0 (length . showMixedAmountElided False) -- XXX lay out actual, percentage and/or goal in the single table cell for now, should probably use separate cells showcell :: BudgetCell -> String showcell (mactual, mbudget) = actualstr ++ " " ++ budgetstr where percentwidth = 4 actual = fromMaybe 0 mactual actualstr = printf ("%"++show actualwidth++"s") (showamt actual) budgetstr = case mbudget of Nothing -> replicate (percentwidth + 7 + budgetwidth) ' ' Just budget -> case percentage actual budget of Just pct -> printf ("[%"++show percentwidth++"s%% of %"++show budgetwidth++"s]") (show $ roundTo 0 pct) (showamt' budget) Nothing -> printf ("["++replicate (percentwidth+5) ' '++"%"++show budgetwidth++"s]") (showamt' budget) showamt = showMixedAmountElided color_ showamt' = showMixedAmountElided False -- XXX colored budget amounts disrupts layout -- | Calculate the percentage of actual change to budget goal to show, if any. -- If valuing at cost, both amounts are converted to cost before comparing. -- A percentage will not be shown if: -- - actual or goal are not the same, single, commodity -- - the goal is zero percentage :: Change -> BudgetGoal -> Maybe Percentage percentage actual budget = case (maybecost $ normaliseMixedAmount actual, maybecost $ normaliseMixedAmount budget) of (Mixed [a], Mixed [b]) | (acommodity a == acommodity b || amountLooksZero a) && not (amountLooksZero b) -> Just $ 100 * aquantity a / aquantity b _ -> -- trace (pshow $ (maybecost actual, maybecost budget)) -- debug missing percentage Nothing where maybecost = if valuationTypeIsCost ropts then mixedAmountCost else id maybetranspose | transpose_ = \(Table rh ch vals) -> Table ch rh (transpose vals) | otherwise = id -- | Build a 'Table' from a multi-column balance report. budgetReportAsTable :: ReportOpts -> BudgetReport -> Table String String (Maybe MixedAmount, Maybe MixedAmount) budgetReportAsTable ropts@ReportOpts{balancetype_} (PeriodicReport spans rows (PeriodicReportRow _ coltots grandtot grandavg)) = addtotalrow $ Table (T.Group NoLine $ map Header accts) (T.Group NoLine $ map Header colheadings) (map rowvals rows) where colheadings = map (reportPeriodName balancetype_ spans) spans ++ [" Total" | row_total_ ropts] ++ ["Average" | average_ ropts] accts = map renderacct rows -- FIXME. Have to check explicitly for which to render here, since -- budgetReport sets accountlistmode to ALTree. Find a principled way to do -- this. renderacct row = case accountlistmode_ ropts of ALTree -> replicate ((prrDepth row - 1)*2) ' ' ++ T.unpack (prrDisplayName row) ALFlat -> T.unpack . accountNameDrop (drop_ ropts) $ prrFullName row rowvals (PeriodicReportRow _ as rowtot rowavg) = as ++ [rowtot | row_total_ ropts] ++ [rowavg | average_ ropts] addtotalrow | no_total_ ropts = id | otherwise = (+----+ (row "" $ coltots ++ [grandtot | row_total_ ropts && not (null coltots)] ++ [grandavg | average_ ropts && not (null coltots)] )) -- | Make a name for the given period in a multiperiod report, given -- the type of balance being reported and the full set of report -- periods. This will be used as a column heading (or row heading, in -- a register summary report). We try to pick a useful name as follows: -- -- - ending-balance reports: the period's end date -- -- - balance change reports where the periods are months and all in the same year: -- the short month name in the current locale -- -- - all other balance change reports: a description of the datespan, -- abbreviated to compact form if possible (see showDateSpan). -- reportPeriodName :: BalanceType -> [DateSpan] -> DateSpan -> String reportPeriodName balancetype spans = case balancetype of PeriodChange -> if multiyear then showDateSpan else showDateSpanMonthAbbrev where multiyear = (>1) $ length $ nubSort $ map spanStartYear spans _ -> maybe "" (showDate . prevday) . spanEnd -- tests tests_BudgetReport = tests "BudgetReport" [ ] hledger-lib-1.19.1/Hledger/Reports/EntriesReport.hs0000644000000000000000000000407513723502755020337 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances, ScopedTypeVariables #-} {-| Journal entries report, used by the print command. -} module Hledger.Reports.EntriesReport ( EntriesReport, EntriesReportItem, entriesReport, -- * Tests tests_EntriesReport ) where import Data.List (sortBy) import Data.Maybe (fromMaybe) import Data.Ord (comparing) import Data.Time (fromGregorian) import Hledger.Data import Hledger.Query import Hledger.Reports.ReportOptions import Hledger.Utils -- | A journal entries report is a list of whole transactions as -- originally entered in the journal (mostly). This is used by eg -- hledger's print command and hledger-web's journal entries view. type EntriesReport = [EntriesReportItem] type EntriesReportItem = Transaction -- | Select transactions for an entries report. entriesReport :: ReportOpts -> Query -> Journal -> EntriesReport entriesReport ropts@ReportOpts{..} q j@Journal{..} = sortBy (comparing getdate) $ filter (q `matchesTransaction`) $ map tvalue jtxns where getdate = transactionDateFn ropts -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports". tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings} where pvalue p = maybe p (postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast mreportlast today False p) value_ where periodlast = fromMaybe today $ reportPeriodOrJournalLastDay ropts j mreportlast = reportPeriodLastDay ropts today = fromMaybe (error' "erValue: could not pick a valuation date, ReportOpts today_ is unset") today_ -- PARTIAL: should not happen tests_EntriesReport = tests "EntriesReport" [ tests "entriesReport" [ test "not acct" $ (length $ entriesReport defreportopts (Not . Acct $ toRegex' "bank") samplejournal) @?= 1 ,test "date" $ (length $ entriesReport defreportopts (Date $ DateSpan (Just $ fromGregorian 2008 06 01) (Just $ fromGregorian 2008 07 01)) samplejournal) @?= 3 ] ] hledger-lib-1.19.1/Hledger/Reports/MultiBalanceReport.hs0000644000000000000000000007530413723605121021260 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-| Multi-column balance reports, used by the balance command. -} module Hledger.Reports.MultiBalanceReport ( MultiBalanceReport, MultiBalanceReportRow, multiBalanceReport, multiBalanceReportWith, CompoundBalanceReport, compoundBalanceReport, compoundBalanceReportWith, tableAsText, sortRows, sortRowsLike, -- -- * Tests tests_MultiBalanceReport ) where import Control.Monad (guard) import Data.Foldable (toList) import Data.List (sortOn, transpose) import Data.List.NonEmpty (NonEmpty(..)) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM import Data.Map (Map) import qualified Data.Map as M import Data.Maybe (fromMaybe, mapMaybe) import Data.Ord (Down(..)) #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup ((<>)) #endif import Data.Semigroup (sconcat) import Data.Time.Calendar (Day, addDays, fromGregorian) import Safe (headMay, lastDef, lastMay) import Text.Tabular as T import Text.Tabular.AsciiWide (render) import Hledger.Data import Hledger.Query import Hledger.Utils import Hledger.Read (mamountp') import Hledger.Reports.ReportOptions import Hledger.Reports.ReportTypes -- | A multi balance report is a kind of periodic report, where the amounts -- correspond to balance changes or ending balances in a given period. It has: -- -- 1. a list of each column's period (date span) -- -- 2. a list of rows, each containing: -- -- * the full account name, display name, and display depth -- -- * A list of amounts, one for each column. -- -- * the total of the row's amounts for a periodic report -- -- * the average of the row's amounts -- -- 3. the column totals, and the overall grand total (or zero for -- cumulative/historical reports) and grand average. type MultiBalanceReport = PeriodicReport DisplayName MixedAmount type MultiBalanceReportRow = PeriodicReportRow DisplayName MixedAmount type CompoundBalanceReport = CompoundPeriodicReport DisplayName MixedAmount -- type alias just to remind us which AccountNames might be depth-clipped, below. type ClippedAccountName = AccountName -- | Generate a multicolumn balance report for the matched accounts, -- showing the change of balance, accumulated balance, or historical balance -- in each of the specified periods. If the normalbalance_ option is set, it -- adjusts the sorting and sign of amounts (see ReportOpts and -- CompoundBalanceCommand). hledger's most powerful and useful report, used -- by the balance command (in multiperiod mode) and (via compoundBalanceReport) -- by the bs/cf/is commands. multiBalanceReport :: Day -> ReportOpts -> Journal -> MultiBalanceReport multiBalanceReport today ropts j = multiBalanceReportWith ropts q j (journalPriceOracle infer j) where q = queryFromOpts today ropts infer = infer_value_ ropts -- | A helper for multiBalanceReport. This one takes an explicit Query -- instead of deriving one from ReportOpts, and an extra argument, a -- PriceOracle to be used for looking up market prices. Commands which -- run multiple reports (bs etc.) can generate the price oracle just -- once for efficiency, passing it to each report by calling this -- function directly. multiBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle -> MultiBalanceReport multiBalanceReportWith ropts q j priceoracle = report where -- Queries, report/column dates. reportspan = dbg "reportspan" $ calculateReportSpan ropts q j reportq = dbg "reportq" $ makeReportQuery ropts reportspan q -- Group postings into their columns. colps = dbg'' "colps" $ getPostingsByColumn ropts reportq j reportspan colspans = dbg "colspans" $ M.keys colps -- The matched accounts with a starting balance. All of these should appear -- in the report, even if they have no postings during the report period. startbals = dbg' "startbals" $ startingBalances ropts reportq j reportspan -- Generate and postprocess the report, negating balances and taking percentages if needed report = dbg' "report" $ generateMultiBalanceReport ropts reportq j priceoracle colspans colps startbals -- | Generate a compound balance report from a list of CBCSubreportSpec. This -- shares postings between the subreports. compoundBalanceReport :: Day -> ReportOpts -> Journal -> [CBCSubreportSpec] -> CompoundBalanceReport compoundBalanceReport today ropts j = compoundBalanceReportWith ropts q j (journalPriceOracle infer j) where q = queryFromOpts today ropts infer = infer_value_ ropts -- | A helper for compoundBalanceReport, similar to multiBalanceReportWith. compoundBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle -> [CBCSubreportSpec] -> CompoundBalanceReport compoundBalanceReportWith ropts q j priceoracle subreportspecs = cbr where -- Queries, report/column dates. reportspan = dbg "reportspan" $ calculateReportSpan ropts q j reportq = dbg "reportq" $ makeReportQuery ropts reportspan q -- Group postings into their columns. colps = dbg'' "colps" $ getPostingsByColumn ropts{empty_=True} reportq j reportspan colspans = dbg "colspans" $ M.keys colps -- The matched accounts with a starting balance. All of these should appear -- in the report, even if they have no postings during the report period. startbals = dbg' "startbals" $ startingBalances ropts reportq j reportspan subreports = map generateSubreport subreportspecs where generateSubreport CBCSubreportSpec{..} = ( cbcsubreporttitle -- Postprocess the report, negating balances and taking percentages if needed , prNormaliseSign cbcsubreportnormalsign $ generateMultiBalanceReport ropts' reportq j priceoracle colspans colps' startbals' , cbcsubreportincreasestotal ) where ropts' = ropts{normalbalance_=Just cbcsubreportnormalsign} -- Filter the column postings according to each subreport colps' = filter (matchesPosting $ cbcsubreportquery j) <$> colps startbals' = HM.filterWithKey (\k _ -> matchesAccount (cbcsubreportquery j) k) startbals -- Sum the subreport totals by column. Handle these cases: -- - no subreports -- - empty subreports, having no subtotals (#588) -- - subreports with a shorter subtotals row than the others overalltotals = case subreports of [] -> PeriodicReportRow () [] nullmixedamt nullmixedamt (r:rs) -> sconcat $ fmap subreportTotal (r:|rs) where subreportTotal (_, sr, increasestotal) = (if increasestotal then id else fmap negate) $ prTotals sr cbr = CompoundPeriodicReport "" colspans subreports overalltotals -- | Calculate starting balances, if needed for -H -- -- Balances at report start date, from all earlier postings which otherwise match the query. -- These balances are unvalued. -- TODO: Do we want to check whether to bother calculating these? isHistorical -- and startDate is not nothing, otherwise mempty? This currently gives a -- failure with some totals which are supposed to be 0 being blank. startingBalances :: ReportOpts -> Query -> Journal -> DateSpan -> HashMap AccountName Account startingBalances ropts q j reportspan = acctchanges where acctchanges = acctChangesFromPostings ropts' startbalq . map fst $ getPostings ropts' startbalq j -- q projected back before the report start date. -- When there's no report start date, in case there are future txns (the hledger-ui case above), -- we use emptydatespan to make sure they aren't counted as starting balance. startbalq = dbg'' "startbalq" $ And [datelessq, precedingspanq] datelessq = dbg "datelessq" $ filterQuery (not . queryIsDateOrDate2) q ropts' = case accountlistmode_ ropts of ALTree -> ropts{no_elide_=True, period_=precedingperiod} ALFlat -> ropts{period_=precedingperiod} precedingperiod = dateSpanAsPeriod . spanIntersect precedingspan . periodAsDateSpan $ period_ ropts precedingspan = DateSpan Nothing $ spanStart reportspan precedingspanq = (if date2_ ropts then Date2 else Date) $ case precedingspan of DateSpan Nothing Nothing -> emptydatespan a -> a -- | Calculate the span of the report to be generated. calculateReportSpan :: ReportOpts -> Query -> Journal -> DateSpan calculateReportSpan ropts q j = reportspan where -- The date span specified by -b/-e/-p options and query args if any. requestedspan = dbg "requestedspan" $ queryDateSpan (date2_ ropts) q -- If the requested span is open-ended, close it using the journal's end dates. -- This can still be the null (open) span if the journal is empty. requestedspan' = dbg "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan (date2_ ropts) j -- The list of interval spans enclosing the requested span. -- This list can be empty if the journal was empty, -- or if hledger-ui has added its special date:-tomorrow to the query -- and all txns are in the future. intervalspans = dbg "intervalspans" $ splitSpan (interval_ ropts) requestedspan' -- The requested span enlarged to enclose a whole number of intervals. -- This can be the null span if there were no intervals. reportspan = DateSpan (spanStart =<< headMay intervalspans) (spanEnd =<< lastMay intervalspans) -- | Remove any date queries and insert queries from the report span. -- The user's query expanded to the report span -- if there is one (otherwise any date queries are left as-is, which -- handles the hledger-ui+future txns case above). makeReportQuery :: ReportOpts -> DateSpan -> Query -> Query makeReportQuery ropts reportspan q | reportspan == nulldatespan = q | otherwise = And [dateless q, reportspandatesq] where reportspandatesq = dbg "reportspandatesq" $ dateqcons reportspan dateless = dbg "dateless" . filterQuery (not . queryIsDateOrDate2) dateqcons = if date2_ ropts then Date2 else Date -- | Group postings, grouped by their column getPostingsByColumn :: ReportOpts -> Query -> Journal -> DateSpan -> Map DateSpan [Posting] getPostingsByColumn ropts q j reportspan = columns where -- Postings matching the query within the report period. ps :: [(Posting, Day)] = dbg'' "ps" $ getPostings ropts q j days = map snd ps -- The date spans to be included as report columns. colspans = calculateColSpans ropts reportspan days addPosting (p, d) = maybe id (M.adjust (p:)) $ latestSpanContaining colspans d emptyMap = M.fromList . zip colspans $ repeat [] -- Group postings into their columns columns = foldr addPosting emptyMap ps -- | Gather postings matching the query within the report period. getPostings :: ReportOpts -> Query -> Journal -> [(Posting, Day)] getPostings ropts q = map (\p -> (p, date p)) . journalPostings . filterJournalAmounts symq . -- remove amount parts excluded by cur: filterJournalPostings reportq -- remove postings not matched by (adjusted) query where symq = dbg "symq" . filterQuery queryIsSym $ dbg "requested q" q -- The user's query with no depth limit, and expanded to the report span -- if there is one (otherwise any date queries are left as-is, which -- handles the hledger-ui+future txns case above). reportq = dbg "reportq" $ depthless q depthless = dbg "depthless" . filterQuery (not . queryIsDepth) date = case whichDateFromOpts ropts of PrimaryDate -> postingDate SecondaryDate -> postingDate2 -- | Calculate the DateSpans to be used for the columns of the report. calculateColSpans :: ReportOpts -> DateSpan -> [Day] -> [DateSpan] calculateColSpans ropts reportspan days = splitSpan (interval_ ropts) displayspan where displayspan | empty_ ropts = dbg "displayspan (-E)" reportspan -- all the requested intervals | otherwise = dbg "displayspan" $ reportspan `spanIntersect` matchedspan -- exclude leading/trailing empty intervals matchedspan = dbg "matchedspan" $ daysSpan days -- | Gather the account balance changes into a regular matrix -- including the accounts from all columns. calculateAccountChanges :: ReportOpts -> Query -> [DateSpan] -> Map DateSpan [Posting] -> HashMap ClippedAccountName (Map DateSpan Account) calculateAccountChanges ropts q colspans colps | queryDepth q == Just 0 = acctchanges <> elided | otherwise = acctchanges where -- Transpose to get each account's balance changes across all columns. acctchanges = transposeMap colacctchanges colacctchanges :: Map DateSpan (HashMap ClippedAccountName Account) = dbg'' "colacctchanges" $ fmap (acctChangesFromPostings ropts q) colps elided = HM.singleton "..." $ M.fromList [(span, nullacct) | span <- colspans] -- | Given a set of postings, eg for a single report column, gather -- the accounts that have postings and calculate the change amount for -- each. Accounts and amounts will be depth-clipped appropriately if -- a depth limit is in effect. acctChangesFromPostings :: ReportOpts -> Query -> [Posting] -> HashMap ClippedAccountName Account acctChangesFromPostings ropts q ps = HM.fromList [(aname a, a) | a <- as] where as = filterAccounts . drop 1 $ accountsFromPostings ps filterAccounts = case accountlistmode_ ropts of ALTree -> filter ((depthq `matchesAccount`) . aname) -- exclude deeper balances ALFlat -> clipAccountsAndAggregate (queryDepth depthq) . -- aggregate deeper balances at the depth limit. filter ((0<) . anumpostings) depthq = dbg "depthq" $ filterQuery queryIsDepth q -- | Accumulate and value amounts, as specified by the report options. -- -- Makes sure all report columns have an entry. accumValueAmounts :: ReportOpts -> Journal -> PriceOracle -> [DateSpan] -> HashMap ClippedAccountName Account -> HashMap ClippedAccountName (Map DateSpan Account) -> HashMap ClippedAccountName (Map DateSpan Account) accumValueAmounts ropts j priceoracle colspans startbals acctchanges = -- PARTIAL: HM.mapWithKey processRow $ acctchanges <> (mempty <$ startbals) where -- Must accumulate before valuing, since valuation can change without any -- postings. Make sure every column has an entry. processRow name changes = M.mapWithKey valueAcct . rowbals name $ changes <> zeros -- The row amounts to be displayed: per-period changes, -- zero-based cumulative totals, or -- starting-balance-based historical balances. rowbals name changes = dbg'' "rowbals" $ case balancetype_ ropts of PeriodChange -> changes CumulativeChange -> snd $ M.mapAccum f nullacct changes HistoricalBalance -> snd $ M.mapAccum f (startingBalanceFor name) changes where f a b = let s = sumAcct a b in (s, s) -- Add the values of two accounts. Should be right-biased, since it's used -- in scanl, so other properties (such as anumpostings) stay in the right place sumAcct Account{aibalance=i1,aebalance=e1} a@Account{aibalance=i2,aebalance=e2} = a{aibalance = i1 + i2, aebalance = e1 + e2} -- We may be converting amounts to value, per hledger_options.m4.md "Effect of --value on reports". valueAcct (DateSpan _ (Just end)) acct = acct{aibalance = value (aibalance acct), aebalance = value (aebalance acct)} where value = avalue (addDays (-1) end) valueAcct _ _ = error' "multiBalanceReport: expected all spans to have an end date" -- XXX should not happen avalue periodlast = maybe id (mixedAmountApplyValuation priceoracle styles periodlast mreportlast today multiperiod) $ value_ ropts where -- Some things needed if doing valuation. styles = journalCommodityStyles j mreportlast = reportPeriodLastDay ropts today = fromMaybe (error' "multiBalanceReport: could not pick a valuation date, ReportOpts today_ is unset") $ today_ ropts -- XXX shouldn't happen multiperiod = interval_ ropts /= NoInterval startingBalanceFor a = HM.lookupDefault nullacct a startbals zeros = M.fromList [(span, nullacct) | span <- colspans] -- | Lay out a set of postings grouped by date span into a regular matrix with rows -- given by AccountName and columns by DateSpan, then generate a MultiBalanceReport -- from the columns. generateMultiBalanceReport :: ReportOpts -> Query -> Journal -> PriceOracle -> [DateSpan] -> Map DateSpan [Posting] -> HashMap AccountName Account -> MultiBalanceReport generateMultiBalanceReport ropts q j priceoracle colspans colps startbals = report where -- Each account's balance changes across all columns. acctchanges = dbg'' "acctchanges" $ calculateAccountChanges ropts q colspans colps -- Process changes into normal, cumulative, or historical amounts, plus value them accumvalued = accumValueAmounts ropts j priceoracle colspans startbals acctchanges -- All account names that will be displayed, possibly depth-clipped. displaynames = dbg'' "displaynames" $ displayedAccounts ropts q accumvalued -- All the rows of the report. rows = dbg'' "rows" $ buildReportRows ropts displaynames accumvalued -- Calculate column totals totalsrow = dbg' "totalsrow" $ calculateTotalsRow ropts rows -- Sorted report rows. sortedrows = dbg' "sortedrows" $ sortRows ropts j rows -- Postprocess the report, negating balances and taking percentages if needed report = postprocessReport ropts $ PeriodicReport colspans sortedrows totalsrow -- | Build the report rows. -- -- One row per account, with account name info, row amounts, row total and row average. buildReportRows :: ReportOpts -> HashMap AccountName DisplayName -> HashMap AccountName (Map DateSpan Account) -> [MultiBalanceReportRow] buildReportRows ropts displaynames = toList . HM.mapMaybeWithKey mkRow where mkRow name accts = do displayname <- HM.lookup name displaynames return $ PeriodicReportRow displayname rowbals rowtot rowavg where rowbals = map balance $ toList accts -- The total and average for the row. -- These are always simply the sum/average of the displayed row amounts. -- Total for a cumulative/historical report is always the last column. rowtot = case balancetype_ ropts of PeriodChange -> sum rowbals _ -> lastDef 0 rowbals rowavg = averageMixedAmounts rowbals balance = case accountlistmode_ ropts of ALTree -> aibalance; ALFlat -> aebalance -- | Calculate accounts which are to be displayed in the report, as well as -- their name and depth displayedAccounts :: ReportOpts -> Query -> HashMap AccountName (Map DateSpan Account) -> HashMap AccountName DisplayName displayedAccounts ropts q valuedaccts | depth == 0 = HM.singleton "..." $ DisplayName "..." "..." 1 | otherwise = HM.mapWithKey (\a _ -> displayedName a) displayedAccts where -- Accounts which are to be displayed displayedAccts = (if depth == 0 then id else HM.filterWithKey keep) valuedaccts where keep name amts = isInteresting name amts || name `HM.member` interestingParents displayedName name = case accountlistmode_ ropts of ALTree -> DisplayName name leaf . max 0 $ level - boringParents ALFlat -> DisplayName name droppedName 1 where droppedName = accountNameDrop (drop_ ropts) name leaf = accountNameFromComponents . reverse . map accountLeafName $ droppedName : takeWhile notDisplayed parents level = max 0 $ accountNameLevel name - drop_ ropts parents = take (level - 1) $ parentAccountNames name boringParents = if no_elide_ ropts then 0 else length $ filter notDisplayed parents notDisplayed = not . (`HM.member` displayedAccts) -- Accounts interesting for their own sake isInteresting name amts = d <= depth -- Throw out anything too deep && ((empty_ ropts && all (null . asubs) amts) -- Keep all leaves when using empty_ || not (isZeroRow balance amts)) -- Throw out anything with zero balance where d = accountNameLevel name balance | ALTree <- accountlistmode_ ropts, d == depth = aibalance | otherwise = aebalance -- Accounts interesting because they are a fork for interesting subaccounts interestingParents = dbg'' "interestingParents" $ case accountlistmode_ ropts of ALTree -> HM.filterWithKey hasEnoughSubs numSubs ALFlat -> mempty where hasEnoughSubs name nsubs = nsubs >= minSubs && accountNameLevel name > drop_ ropts minSubs = if no_elide_ ropts then 1 else 2 isZeroRow balance = all (mixedAmountLooksZero . balance) depth = fromMaybe maxBound $ queryDepth q numSubs = subaccountTallies . HM.keys $ HM.filterWithKey isInteresting valuedaccts -- | Sort the rows by amount or by account declaration order. sortRows :: ReportOpts -> Journal -> [MultiBalanceReportRow] -> [MultiBalanceReportRow] sortRows ropts j | sort_amount_ ropts, ALTree <- accountlistmode_ ropts = sortTreeMBRByAmount | sort_amount_ ropts, ALFlat <- accountlistmode_ ropts = sortFlatMBRByAmount | otherwise = sortMBRByAccountDeclaration where -- Sort the report rows, representing a tree of accounts, by row total at each level. -- Similar to sortMBRByAccountDeclaration/sortAccountNamesByDeclaration. sortTreeMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow] sortTreeMBRByAmount rows = mapMaybe (`HM.lookup` rowMap) sortedanames where accounttree = accountTree "root" $ map prrFullName rows rowMap = HM.fromList $ map (\row -> (prrFullName row, row)) rows -- Set the inclusive balance of an account from the rows, or sum the -- subaccounts if it's not present accounttreewithbals = mapAccounts setibalance accounttree setibalance a = a{aibalance = maybe (sum . map aibalance $ asubs a) prrTotal $ HM.lookup (aname a) rowMap} sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive $ normalbalance_ ropts) accounttreewithbals sortedanames = map aname $ drop 1 $ flattenAccounts sortedaccounttree -- Sort the report rows, representing a flat account list, by row total. sortFlatMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow] sortFlatMBRByAmount = case normalbalance_ ropts of Just NormallyNegative -> sortOn amt _ -> sortOn (Down . amt) where amt = normaliseMixedAmountSquashPricesForDisplay . prrTotal -- Sort the report rows by account declaration order then account name. sortMBRByAccountDeclaration :: [MultiBalanceReportRow] -> [MultiBalanceReportRow] sortMBRByAccountDeclaration rows = sortRowsLike sortedanames rows where sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) $ map prrFullName rows -- | Build the report totals row. -- -- Calculate the column totals. These are always the sum of column amounts. calculateTotalsRow :: ReportOpts -> [MultiBalanceReportRow] -> PeriodicReportRow () MixedAmount calculateTotalsRow ropts rows = PeriodicReportRow () coltotals grandtotal grandaverage where isTopRow row = flat_ ropts || not (any (`HM.member` rowMap) parents) where parents = init . expandAccountName $ prrFullName row rowMap = HM.fromList $ map (\row -> (prrFullName row, row)) rows colamts = transpose . map prrAmounts $ filter isTopRow rows coltotals :: [MixedAmount] = dbg'' "coltotals" $ map sum colamts -- Calculate the grand total and average. These are always the sum/average -- of the column totals. -- Total for a cumulative/historical report is always the last column. grandtotal = case balancetype_ ropts of PeriodChange -> sum coltotals _ -> lastDef 0 coltotals grandaverage = averageMixedAmounts coltotals -- | Map the report rows to percentages and negate if needed postprocessReport :: ReportOpts -> MultiBalanceReport -> MultiBalanceReport postprocessReport ropts = maybePercent . maybeInvert where maybeInvert = if invert_ ropts then fmap negate else id maybePercent = if percent_ ropts then prPercent else id prPercent (PeriodicReport spans rows totalrow) = PeriodicReport spans (map percentRow rows) (percentRow totalrow) where percentRow (PeriodicReportRow name rowvals rowtotal rowavg) = PeriodicReportRow name (zipWith perdivide rowvals $ prrAmounts totalrow) (perdivide rowtotal $ prrTotal totalrow) (perdivide rowavg $ prrAverage totalrow) -- | Transpose a Map of HashMaps to a HashMap of Maps. -- -- Makes sure that all DateSpans are present in all rows. transposeMap :: Map DateSpan (HashMap AccountName a) -> HashMap AccountName (Map DateSpan a) transposeMap xs = M.foldrWithKey addSpan mempty xs where addSpan span acctmap seen = HM.foldrWithKey (addAcctSpan span) seen acctmap addAcctSpan span acct a = HM.alter f acct where f = Just . M.insert span a . fromMaybe mempty -- | A sorting helper: sort a list of things (eg report rows) keyed by account name -- to match the provided ordering of those same account names. sortRowsLike :: [AccountName] -> [PeriodicReportRow DisplayName b] -> [PeriodicReportRow DisplayName b] sortRowsLike sortedas rows = mapMaybe (`HM.lookup` rowMap) sortedas where rowMap = HM.fromList $ map (\row -> (prrFullName row, row)) rows -- | Given a list of account names, find all forking parent accounts, i.e. -- those which fork between different branches subaccountTallies :: [AccountName] -> HashMap AccountName Int subaccountTallies = foldr incrementParent mempty . expandAccountNames where incrementParent a = HM.insertWith (+) (parentAccountName a) 1 -- | A helper: what percentage is the second mixed amount of the first ? -- Keeps the sign of the first amount. -- Uses unifyMixedAmount to unify each argument and then divides them. -- Both amounts should be in the same, single commodity. -- This can call error if the arguments are not right. perdivide :: MixedAmount -> MixedAmount -> MixedAmount perdivide a b = fromMaybe (error' errmsg) $ do -- PARTIAL: a' <- unifyMixedAmount a b' <- unifyMixedAmount b guard $ amountIsZero a' || amountIsZero b' || acommodity a' == acommodity b' return $ mixed [per $ if aquantity b' == 0 then 0 else aquantity a' / abs (aquantity b') * 100] where errmsg = "Cannot calculate percentages if accounts have different commodities (Hint: Try --cost, -V or similar flags.)" -- Local debug helper -- add a prefix to this function's debug output dbg s = let p = "multiBalanceReport" in Hledger.Utils.dbg3 (p++" "++s) dbg' s = let p = "multiBalanceReport" in Hledger.Utils.dbg4 (p++" "++s) dbg'' s = let p = "multiBalanceReport" in Hledger.Utils.dbg5 (p++" "++s) -- dbg = const id -- exclude this function from debug output -- common rendering helper, XXX here for now tableAsText :: ReportOpts -> (a -> String) -> Table String String a -> String tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell = unlines . trimborder . lines . render pretty id id showcell . align where trimborder = drop 1 . init . map (drop 1 . init) align (Table l t d) = Table l' t d where acctswidth = maximum' $ map strWidth (headerContents l) l' = padRightWide acctswidth <$> l -- tests tests_MultiBalanceReport = tests "MultiBalanceReport" [ let amt0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = Precision 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False} (opts,journal) `gives` r = do let (eitems, etotal) = r (PeriodicReport _ aitems atotal) = multiBalanceReport nulldate opts journal showw (PeriodicReportRow a lAmt amt amt') = (displayFull a, displayName a, displayDepth a, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt') (map showw aitems) @?= (map showw eitems) showMixedAmountDebug (prrTotal atotal) @?= showMixedAmountDebug etotal -- we only check the sum of the totals in tests "multiBalanceReport" [ test "null journal" $ (defreportopts, nulljournal) `gives` ([], Mixed [nullamt]) ,test "with -H on a populated period" $ (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives` ( [ PeriodicReportRow (flatDisplayName "assets:bank:checking") [mamountp' "$1.00"] (mamountp' "$1.00") (Mixed [amt0 {aquantity=1}]) , PeriodicReportRow (flatDisplayName "income:salary") [mamountp' "$-1.00"] (mamountp' "$-1.00") (Mixed [amt0 {aquantity=(-1)}]) ], mamountp' "$0.00") -- ,test "a valid history on an empty period" $ -- (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3), balancetype_=HistoricalBalance}, samplejournal) `gives` -- ( -- [ -- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=1}]) -- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amt0 {aquantity=(-1)}]) -- ], -- Mixed [usd0]) -- ,test "a valid history on an empty period (more complex)" $ -- (defreportopts{period_= PeriodBetween (fromGregorian 2009 1 1) (fromGregorian 2009 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives` -- ( -- [ -- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=1}]) -- ,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=1}]) -- ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",Mixed [amt0 {aquantity=(-2)}]) -- ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=(1)}]) -- ,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=(1)}]) -- ,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amt0 {aquantity=(-1)}]) -- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amt0 {aquantity=(-1)}]) -- ], -- Mixed [usd0]) ] ] hledger-lib-1.19.1/Hledger/Reports/PostingsReport.hs0000644000000000000000000006427013723502755020537 0ustar0000000000000000{-| Postings report, used by the register command. -} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} module Hledger.Reports.PostingsReport ( PostingsReport, PostingsReportItem, postingsReport, mkpostingsReportItem, -- * Tests tests_PostingsReport ) where import Data.List import Data.List.Extra (nubSort) import Data.Maybe -- import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar import Safe (headMay, lastMay) import Hledger.Data import Hledger.Query import Hledger.Utils import Hledger.Reports.ReportOptions -- | A postings report is a list of postings with a running total, a label -- for the total field, and a little extra transaction info to help with rendering. -- This is used eg for the register command. type PostingsReport = (String -- label for the running balance column XXX remove ,[PostingsReportItem] -- line items, one per posting ) type PostingsReportItem = (Maybe Day -- The posting date, if this is the first posting in a -- transaction or if it's different from the previous -- posting's date. Or if this a summary posting, the -- report interval's start date if this is the first -- summary posting in the interval. ,Maybe Day -- If this is a summary posting, the report interval's -- end date if this is the first summary posting in -- the interval. ,Maybe String -- The posting's transaction's description, if this is the first posting in the transaction. ,Posting -- The posting, possibly with the account name depth-clipped. ,MixedAmount -- The running total after this posting, or with --average, -- the running average posting amount. With --historical, -- postings before the report start date are included in -- the running total/average. ) -- | A summary posting summarises the activity in one account within a report -- interval. It is kludgily represented by a regular Posting with no description, -- the interval's start date stored as the posting date, and the interval's end -- date attached with a tuple. type SummaryPosting = (Posting, Day) -- | Select postings from the journal and add running balance and other -- information to make a postings report. Used by eg hledger's register command. postingsReport :: ReportOpts -> Query -> Journal -> PostingsReport postingsReport ropts@ReportOpts{..} q j = (totallabel, items) where reportspan = adjustReportDates ropts q j whichdate = whichDateFromOpts ropts mdepth = queryDepth q styles = journalCommodityStyles j priceoracle = journalPriceOracle infer_value_ j multiperiod = interval_ /= NoInterval today = fromMaybe (error' "postingsReport: could not pick a valuation date, ReportOpts today_ is unset") today_ -- PARTIAL: -- postings to be included in the report, and similarly-matched postings before the report start date (precedingps, reportps) = matchedPostingsBeforeAndDuring ropts q j reportspan -- Postings, or summary postings with their subperiod's end date, to be displayed. displayps :: [(Posting, Maybe Day)] | multiperiod = let summaryps = summarisePostingsByInterval interval_ whichdate mdepth showempty reportspan reportps in [(pvalue p lastday, Just periodend) | (p, periodend) <- summaryps, let lastday = addDays (-1) periodend] | otherwise = [(pvalue p reportorjournallast, Nothing) | p <- reportps] where showempty = empty_ || average_ -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports". pvalue p periodlast = maybe p (postingApplyValuation priceoracle styles periodlast mreportlast today multiperiod p) value_ where mreportlast = reportPeriodLastDay ropts reportorjournallast = fromMaybe (error' "postingsReport: expected a non-empty journal") $ -- PARTIAL: shouldn't happen reportPeriodOrJournalLastDay ropts j -- Posting report items ready for display. items = dbg4 "postingsReport items" $ postingsReportItems displayps (nullposting,Nothing) whichdate mdepth startbal runningcalc startnum where -- In historical mode we'll need a starting balance, which we -- may be converting to value per hledger_options.m4.md "Effect -- of --value on reports". -- XXX balance report doesn't value starting balance.. should this ? historical = balancetype_ == HistoricalBalance startbal | average_ = if historical then bvalue precedingavg else 0 | otherwise = if historical then bvalue precedingsum else 0 where precedingsum = sumPostings precedingps precedingavg | null precedingps = 0 | otherwise = divideMixedAmount (fromIntegral $ length precedingps) precedingsum bvalue = maybe id (mixedAmountApplyValuation priceoracle styles daybeforereportstart Nothing today multiperiod) value_ -- XXX constrain valuation type to AtDate daybeforereportstart here ? where daybeforereportstart = maybe (error' "postingsReport: expected a non-empty journal") -- PARTIAL: shouldn't happen (addDays (-1)) $ reportPeriodOrJournalStart ropts j runningcalc = registerRunningCalculationFn ropts startnum = if historical then length precedingps + 1 else 1 -- | Based on the given report options, return a function that does the appropriate -- running calculation for the register report, ie a running average or running total. -- This function will take the item number, previous average/total, and new posting amount, -- and return the new average/total. registerRunningCalculationFn :: ReportOpts -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) registerRunningCalculationFn ropts | average_ ropts = \i avg amt -> avg + divideMixedAmount (fromIntegral i) (amt - avg) | otherwise = \_ bal amt -> bal + amt totallabel = "Total" -- | Adjust report start/end dates to more useful ones based on -- journal data and report intervals. Ie: -- 1. If the start date is unspecified, use the earliest date in the journal (if any) -- 2. If the end date is unspecified, use the latest date in the journal (if any) -- 3. If a report interval is specified, enlarge the dates to enclose whole intervals adjustReportDates :: ReportOpts -> Query -> Journal -> DateSpan adjustReportDates opts q j = reportspan where -- see also multiBalanceReport requestedspan = dbg3 "requestedspan" $ queryDateSpan' q -- span specified by -b/-e/-p options and query args journalspan = dbg3 "journalspan" $ dates `spanUnion` date2s -- earliest and latest dates (or date2s) in the journal where dates = journalDateSpan False j date2s = journalDateSpan True j requestedspanclosed = dbg3 "requestedspanclosed" $ requestedspan `spanDefaultsFrom` journalspan -- if open-ended, close it using the journal's dates (if any) intervalspans = dbg3 "intervalspans" $ splitSpan (interval_ opts) requestedspanclosed -- get the whole intervals enclosing that mreportstart = dbg3 "reportstart" $ maybe Nothing spanStart $ headMay intervalspans -- start of the first interval, or open ended mreportend = dbg3 "reportend" $ maybe Nothing spanEnd $ lastMay intervalspans -- end of the last interval, or open ended reportspan = dbg3 "reportspan" $ DateSpan mreportstart mreportend -- the requested span enlarged to whole intervals if possible -- | Find postings matching a given query, within a given date span, -- and also any similarly-matched postings before that date span. -- Date restrictions and depth restrictions in the query are ignored. -- A helper for the postings report. matchedPostingsBeforeAndDuring :: ReportOpts -> Query -> Journal -> DateSpan -> ([Posting],[Posting]) matchedPostingsBeforeAndDuring opts q j (DateSpan mstart mend) = dbg5 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps where beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing mstart beforeandduringps = dbg5 "ps5" $ sortOn sortdate $ -- sort postings by date or date2 dbg5 "ps4" $ (if invert_ opts then map negatePostingAmount else id) $ -- with --invert, invert amounts dbg5 "ps3" $ map (filterPostingAmount symq) $ -- remove amount parts which the query's cur: terms would exclude dbg5 "ps2" $ (if related_ opts then concatMap relatedPostings else id) $ -- with -r, replace each with its sibling postings dbg5 "ps1" $ filter (beforeandduringq `matchesPosting`) $ -- filter postings by the query, with no start date or depth limit journalPostings $ journalSelectingAmountFromOpts opts j -- maybe convert to cost early, will be seen by amt:. XXX what about converting to value ? where beforeandduringq = dbg4 "beforeandduringq" $ And [depthless $ dateless q, beforeendq] where depthless = filterQuery (not . queryIsDepth) dateless = filterQuery (not . queryIsDateOrDate2) beforeendq = dateqtype $ DateSpan Nothing mend sortdate = if date2_ opts then postingDate2 else postingDate symq = dbg4 "symq" $ filterQuery queryIsSym q dateqtype | queryIsDate2 dateq || (queryIsDate dateq && date2_ opts) = Date2 | otherwise = Date where dateq = dbg4 "dateq" $ filterQuery queryIsDateOrDate2 $ dbg4 "q" q -- XXX confused by multiple date:/date2: ? -- | Generate postings report line items from a list of postings or (with -- non-Nothing dates attached) summary postings. postingsReportItems :: [(Posting,Maybe Day)] -> (Posting,Maybe Day) -> WhichDate -> Maybe Int -> MixedAmount -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) -> Int -> [PostingsReportItem] postingsReportItems [] _ _ _ _ _ _ = [] postingsReportItems ((p,menddate):ps) (pprev,menddateprev) wd d b runningcalcfn itemnum = i:(postingsReportItems ps (p,menddate) wd d b' runningcalcfn (itemnum+1)) where i = mkpostingsReportItem showdate showdesc wd menddate p' b' (showdate, showdesc) | isJust menddate = (menddate /= menddateprev, False) | otherwise = (isfirstintxn || isdifferentdate, isfirstintxn) isfirstintxn = ptransaction p /= ptransaction pprev isdifferentdate = case wd of PrimaryDate -> postingDate p /= postingDate pprev SecondaryDate -> postingDate2 p /= postingDate2 pprev p' = p{paccount= clipOrEllipsifyAccountName d $ paccount p} b' = runningcalcfn itemnum b (pamount p) -- | Generate one postings report line item, containing the posting, -- the current running balance, and optionally the posting date and/or -- the transaction description. mkpostingsReportItem :: Bool -> Bool -> WhichDate -> Maybe Day -> Posting -> MixedAmount -> PostingsReportItem mkpostingsReportItem showdate showdesc wd menddate p b = (if showdate then Just date else Nothing ,menddate ,if showdesc then Just desc else Nothing ,p ,b ) where date = case wd of PrimaryDate -> postingDate p SecondaryDate -> postingDate2 p desc = T.unpack $ maybe "" tdescription $ ptransaction p -- | Convert a list of postings into summary postings, one per interval, -- aggregated to the specified depth if any. -- Each summary posting will have a non-Nothing interval end date. summarisePostingsByInterval :: Interval -> WhichDate -> Maybe Int -> Bool -> DateSpan -> [Posting] -> [SummaryPosting] summarisePostingsByInterval interval wd mdepth showempty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan where summarisespan s = summarisePostingsInDateSpan s wd mdepth showempty (postingsinspan s) postingsinspan s = filter (isPostingInDateSpan' wd s) ps -- | Given a date span (representing a report interval) and a list of -- postings within it, aggregate the postings into one summary posting per -- account. Each summary posting will have a non-Nothing interval end date. -- -- When a depth argument is present, postings to accounts of greater -- depth are also aggregated where possible. If the depth is 0, all -- postings in the span are aggregated into a single posting with -- account name "...". -- -- The showempty flag includes spans with no postings and also postings -- with 0 amount. -- summarisePostingsInDateSpan :: DateSpan -> WhichDate -> Maybe Int -> Bool -> [Posting] -> [SummaryPosting] summarisePostingsInDateSpan (DateSpan b e) wd mdepth showempty ps | null ps && (isNothing b || isNothing e) = [] | null ps && showempty = [(summaryp, e')] | otherwise = summarypes where postingdate = if wd == PrimaryDate then postingDate else postingDate2 b' = fromMaybe (maybe nulldate postingdate $ headMay ps) b e' = fromMaybe (maybe (addDays 1 nulldate) postingdate $ lastMay ps) e summaryp = nullposting{pdate=Just b'} clippedanames = nub $ map (clipAccountName mdepth) anames summaryps | mdepth == Just 0 = [summaryp{paccount="...",pamount=sum $ map pamount ps}] | otherwise = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames] summarypes = map (, e') $ (if showempty then id else filter (not . mixedAmountLooksZero . pamount)) summaryps anames = nubSort $ map paccount ps -- aggregate balances by account, like ledgerFromJournal, then do depth-clipping accts = accountsFromPostings ps balance a = maybe nullmixedamt bal $ lookupAccount a accts where bal = if isclipped a then aibalance else aebalance isclipped a = maybe True (accountNameLevel a >=) mdepth negatePostingAmount :: Posting -> Posting negatePostingAmount p = p { pamount = negate $ pamount p } -- tests tests_PostingsReport = tests "PostingsReport" [ test "postingsReport" $ do let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts query journal) @?= n -- with the query specified explicitly (Any, nulljournal) `gives` 0 (Any, samplejournal) `gives` 13 -- register --depth just clips account names (Depth 2, samplejournal) `gives` 13 (And [Depth 1, StatusQ Cleared, Acct (toRegex' "expenses")], samplejournal) `gives` 2 (And [And [Depth 1, StatusQ Cleared], Acct (toRegex' "expenses")], samplejournal) `gives` 2 -- with query and/or command-line options (length $ snd $ postingsReport defreportopts Any samplejournal) @?= 13 (length $ snd $ postingsReport defreportopts{interval_=Months 1} Any samplejournal) @?= 11 (length $ snd $ postingsReport defreportopts{interval_=Months 1, empty_=True} Any samplejournal) @?= 20 (length $ snd $ postingsReport defreportopts (Acct (toRegex' "assets:bank:checking")) samplejournal) @?= 5 -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0 -- [(Just (fromGregorian 2008 01 01,"income"),assets:bank:checking $1,$1) -- ,(Nothing,income:salary $-1,0) -- ,(Just (2008-06-01,"gift"),assets:bank:checking $1,$1) -- ,(Nothing,income:gifts $-1,0) -- ,(Just (2008-06-02,"save"),assets:bank:saving $1,$1) -- ,(Nothing,assets:bank:checking $-1,0) -- ,(Just (2008-06-03,"eat & shop"),expenses:food $1,$1) -- ,(Nothing,expenses:supplies $1,$2) -- ,(Nothing,assets:cash $-2,0) -- ,(Just (2008-12-31,"pay off"),liabilities:debts $1,$1) -- ,(Nothing,assets:bank:checking $-1,0) {- let opts = defreportopts (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines ["2008/01/01 income assets:bank:checking $1 $1" ," income:salary $-1 0" ,"2008/06/01 gift assets:bank:checking $1 $1" ," income:gifts $-1 0" ,"2008/06/02 save assets:bank:saving $1 $1" ," assets:bank:checking $-1 0" ,"2008/06/03 eat & shop expenses:food $1 $1" ," expenses:supplies $1 $2" ," assets:cash $-2 0" ,"2008/12/31 pay off liabilities:debts $1 $1" ," assets:bank:checking $-1 0" ] ,"postings report with cleared option" ~: do let opts = defreportopts{cleared_=True} j <- readJournal' sample_journal_str (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines ["2008/06/03 eat & shop expenses:food $1 $1" ," expenses:supplies $1 $2" ," assets:cash $-2 0" ,"2008/12/31 pay off liabilities:debts $1 $1" ," assets:bank:checking $-1 0" ] ,"postings report with uncleared option" ~: do let opts = defreportopts{uncleared_=True} j <- readJournal' sample_journal_str (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines ["2008/01/01 income assets:bank:checking $1 $1" ," income:salary $-1 0" ,"2008/06/01 gift assets:bank:checking $1 $1" ," income:gifts $-1 0" ,"2008/06/02 save assets:bank:saving $1 $1" ," assets:bank:checking $-1 0" ] ,"postings report sorts by date" ~: do j <- readJournal' $ unlines ["2008/02/02 a" ," b 1" ," c" ,"" ,"2008/01/01 d" ," e 1" ," f" ] let opts = defreportopts registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/02/02"] ,"postings report with account pattern" ~: do j <- samplejournal let opts = defreportopts{patterns_=["cash"]} (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines ["2008/06/03 eat & shop assets:cash $-2 $-2" ] ,"postings report with account pattern, case insensitive" ~: do j <- samplejournal let opts = defreportopts{patterns_=["cAsH"]} (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines ["2008/06/03 eat & shop assets:cash $-2 $-2" ] ,"postings report with display expression" ~: do j <- samplejournal let gives displayexpr = (registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is`) where opts = defreportopts "d<[2008/6/2]" `gives` ["2008/01/01","2008/06/01"] "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"] "d=[2008/6/2]" `gives` ["2008/06/02"] "d>=[2008/6/2]" `gives` ["2008/06/02","2008/06/03","2008/12/31"] "d>[2008/6/2]" `gives` ["2008/06/03","2008/12/31"] ,"postings report with period expression" ~: do j <- samplejournal let periodexpr `gives` dates = do j' <- samplejournal registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j') `is` dates where opts = defreportopts{period_=maybePeriod date1 periodexpr} "" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"] "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"] "2007" `gives` [] "june" `gives` ["2008/06/01","2008/06/02","2008/06/03"] "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"] "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"] let opts = defreportopts{period_=maybePeriod date1 "yearly"} (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines ["2008/01/01 - 2008/12/31 assets:bank:saving $1 $1" ," assets:cash $-2 $-1" ," expenses:food $1 0" ," expenses:supplies $1 $1" ," income:gifts $-1 0" ," income:salary $-1 $-1" ," liabilities:debts $1 0" ] let opts = defreportopts{period_=maybePeriod date1 "quarterly"} registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/10/01"] let opts = defreportopts{period_=maybePeriod date1 "quarterly",empty_=True} registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"] ] , "postings report with depth arg" ~: do j <- samplejournal let opts = defreportopts{depth_=Just 2} (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines ["2008/01/01 income assets:bank $1 $1" ," income:salary $-1 0" ,"2008/06/01 gift assets:bank $1 $1" ," income:gifts $-1 0" ,"2008/06/02 save assets:bank $1 $1" ," assets:bank $-1 0" ,"2008/06/03 eat & shop expenses:food $1 $1" ," expenses:supplies $1 $2" ," assets:cash $-2 0" ,"2008/12/31 pay off liabilities:debts $1 $1" ," assets:bank $-1 0" ] -} ,test "summarisePostingsByInterval" $ summarisePostingsByInterval (Quarters 1) PrimaryDate Nothing False (DateSpan Nothing Nothing) [] @?= [] -- ,tests_summarisePostingsInDateSpan = [ -- "summarisePostingsInDateSpan" ~: do -- let gives (b,e,depth,showempty,ps) = -- (summarisePostingsInDateSpan (DateSpan b e) depth showempty ps `is`) -- let ps = -- [ -- nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]} -- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [usd 2]} -- ,nullposting{lpdescription="desc",lpaccount="expenses:food", lpamount=Mixed [usd 4]} -- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [usd 8]} -- ] -- ("2008/01/01","2009/01/01",0,9999,False,[]) `gives` -- [] -- ("2008/01/01","2009/01/01",0,9999,True,[]) `gives` -- [ -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31"} -- ] -- ("2008/01/01","2009/01/01",0,9999,False,ts) `gives` -- [ -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food", lpamount=Mixed [usd 4]} -- ,nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food:dining", lpamount=Mixed [usd 10]} -- ,nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]} -- ] -- ("2008/01/01","2009/01/01",0,2,False,ts) `gives` -- [ -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=Mixed [usd 15]} -- ] -- ("2008/01/01","2009/01/01",0,1,False,ts) `gives` -- [ -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=Mixed [usd 15]} -- ] -- ("2008/01/01","2009/01/01",0,0,False,ts) `gives` -- [ -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [usd 15]} -- ] ] hledger-lib-1.19.1/Hledger/Reports/TransactionsReport.hs0000644000000000000000000001160413723502755021372 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-} {-| A transactions report. Like an EntriesReport, but with more information such as a running balance. -} module Hledger.Reports.TransactionsReport ( TransactionsReport, TransactionsReportItem, transactionsReport, transactionsReportByCommodity, triOrigTransaction, triDate, triAmount, triBalance, triCommodityAmount, triCommodityBalance, tests_TransactionsReport ) where import Data.List import Data.List.Extra (nubSort) import Data.Ord import Hledger.Data import Hledger.Query import Hledger.Reports.ReportOptions import Hledger.Reports.AccountTransactionsReport import Hledger.Utils -- | A transactions report includes a list of transactions touching multiple accounts -- (posting-filtered and unfiltered variants), a running balance, and some -- other information helpful for rendering a register view (a flag -- indicating multiple other accounts and a display string describing -- them) with or without a notion of current account(s). -- Two kinds of report use this data structure, see transactionsReport -- and accountTransactionsReport below for details. type TransactionsReport = (String -- label for the balance column, eg "balance" or "total" ,[TransactionsReportItem] -- line items, one per transaction ) type TransactionsReportItem = (Transaction -- the original journal transaction, unmodified ,Transaction -- the transaction as seen from a particular account, with postings maybe filtered ,Bool -- is this a split, ie more than one other account posting ,String -- a display string describing the other account(s), if any ,MixedAmount -- the amount posted to the current account(s) by the filtered postings (or total amount posted) ,MixedAmount -- the running total of item amounts, starting from zero; -- or with --historical, the running total including items -- (matched by the report query) preceding the report period ) triOrigTransaction (torig,_,_,_,_,_) = torig triDate (_,tacct,_,_,_,_) = tdate tacct triAmount (_,_,_,_,a,_) = a triBalance (_,_,_,_,_,a) = a triCommodityAmount c = filterMixedAmountByCommodity c . triAmount triCommodityBalance c = filterMixedAmountByCommodity c . triBalance totallabel = "Period Total" -- | Select transactions from the whole journal. This is similar to a -- "postingsReport" except with transaction-based report items which -- are ordered most recent first. XXX Or an EntriesReport - use that instead ? -- This is used by hledger-web's journal view. transactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport transactionsReport opts j q = (totallabel, items) where -- XXX items' first element should be the full transaction with all postings items = reverse $ accountTransactionsReportItems q None nullmixedamt id ts ts = sortBy (comparing date) $ filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts opts j date = transactionDateFn opts -- | Split a transactions report whose items may involve several commodities, -- into one or more single-commodity transactions reports. transactionsReportByCommodity :: TransactionsReport -> [(CommoditySymbol, TransactionsReport)] transactionsReportByCommodity tr = [(c, filterTransactionsReportByCommodity c tr) | c <- transactionsReportCommodities tr] where transactionsReportCommodities (_,items) = nubSort . map acommodity $ concatMap (amounts . triAmount) items -- Remove transaction report items and item amount (and running -- balance amount) components that don't involve the specified -- commodity. Other item fields such as the transaction are left unchanged. filterTransactionsReportByCommodity :: CommoditySymbol -> TransactionsReport -> TransactionsReport filterTransactionsReportByCommodity c (label,items) = (label, fixTransactionsReportItemBalances $ concat [filterTransactionsReportItemByCommodity c i | i <- items]) where filterTransactionsReportItemByCommodity c (t,t2,s,o,a,bal) | c `elem` cs = [item'] | otherwise = [] where cs = map acommodity $ amounts a item' = (t,t2,s,o,a',bal) a' = filterMixedAmountByCommodity c a fixTransactionsReportItemBalances [] = [] fixTransactionsReportItemBalances [i] = [i] fixTransactionsReportItemBalances items = reverse $ i:(go startbal is) where i:is = reverse items startbal = filterMixedAmountByCommodity c $ triBalance i go _ [] = [] go bal ((t,t2,s,o,amt,_):is) = (t,t2,s,o,amt,bal'):go bal' is where bal' = bal + amt -- tests tests_TransactionsReport = tests "TransactionsReport" [ ] hledger-lib-1.19.1/Hledger/Utils.hs0000644000000000000000000001766113722544246015201 0ustar0000000000000000{-| Standard imports and utilities which are useful everywhere, or needed low in the module hierarchy. This is the bottom of hledger's module graph. -} {-# LANGUAGE OverloadedStrings, LambdaCase #-} module Hledger.Utils (---- provide these frequently used modules - or not, for clearer api: -- module Control.Monad, -- module Data.List, -- module Data.Maybe, -- module Data.Time.Calendar, -- module Data.Time.Clock, -- module Data.Time.LocalTime, -- module Data.Tree, -- module Text.RegexPR, -- module Text.Printf, ---- all of this one: module Hledger.Utils, module Hledger.Utils.Debug, module Hledger.Utils.Parse, module Hledger.Utils.Regex, module Hledger.Utils.String, module Hledger.Utils.Text, module Hledger.Utils.Test, module Hledger.Utils.Color, module Hledger.Utils.Tree, -- Debug.Trace.trace, -- module Data.PPrint, -- module Hledger.Utils.UTF8IOCompat error',userError',usageError, -- the rest need to be done in each module I think ) where import Control.Monad (liftM, when) -- import Data.Char import Data.Default import Data.FileEmbed (makeRelativeToProject, embedStringFile) import Data.List -- import Data.Maybe -- import Data.PPrint -- import Data.String.Here (hereFile) import Data.Text (Text) import qualified Data.Text.IO as T import Data.Time.Clock import Data.Time.LocalTime -- import Data.Text (Text) -- import qualified Data.Text as T -- import Language.Haskell.TH.Quote (QuasiQuoter(..)) import Language.Haskell.TH.Syntax (Q, Exp) import System.Directory (getHomeDirectory) import System.FilePath((), isRelative) import System.IO -- import Text.Printf -- import qualified Data.Map as Map import Hledger.Utils.Debug import Hledger.Utils.Parse import Hledger.Utils.Regex import Hledger.Utils.String import Hledger.Utils.Text import Hledger.Utils.Test import Hledger.Utils.Color import Hledger.Utils.Tree -- import Prelude hiding (readFile,writeFile,appendFile,getContents,putStr,putStrLn) -- import Hledger.Utils.UTF8IOCompat (readFile,writeFile,appendFile,getContents,putStr,putStrLn) import Hledger.Utils.UTF8IOCompat (error',userError',usageError) -- tuples first3 (x,_,_) = x second3 (_,x,_) = x third3 (_,_,x) = x first4 (x,_,_,_) = x second4 (_,x,_,_) = x third4 (_,_,x,_) = x fourth4 (_,_,_,x) = x first5 (x,_,_,_,_) = x second5 (_,x,_,_,_) = x third5 (_,_,x,_,_) = x fourth5 (_,_,_,x,_) = x fifth5 (_,_,_,_,x) = x first6 (x,_,_,_,_,_) = x second6 (_,x,_,_,_,_) = x third6 (_,_,x,_,_,_) = x fourth6 (_,_,_,x,_,_) = x fifth6 (_,_,_,_,x,_) = x sixth6 (_,_,_,_,_,x) = x -- currying curry2 :: ((a, b) -> c) -> a -> b -> c curry2 f x y = f (x, y) uncurry2 :: (a -> b -> c) -> (a, b) -> c uncurry2 f (x, y) = f x y curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d curry3 f x y z = f (x, y, z) uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d uncurry3 f (x, y, z) = f x y z curry4 :: ((a, b, c, d) -> e) -> a -> b -> c -> d -> e curry4 f w x y z = f (w, x, y, z) uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e uncurry4 f (w, x, y, z) = f w x y z -- lists splitAtElement :: Eq a => a -> [a] -> [[a]] splitAtElement x l = case l of [] -> [] e:es | e==x -> split es es -> split es where split es = let (first,rest) = break (x==) es in first : splitAtElement x rest -- text -- time getCurrentLocalTime :: IO LocalTime getCurrentLocalTime = do t <- getCurrentTime tz <- getCurrentTimeZone return $ utcToLocalTime tz t getCurrentZonedTime :: IO ZonedTime getCurrentZonedTime = do t <- getCurrentTime tz <- getCurrentTimeZone return $ utcToZonedTime tz t -- misc instance Default Bool where def = False -- | Apply a function the specified number of times, -- which should be > 0 (otherwise does nothing). -- Possibly uses O(n) stack ? applyN :: Int -> (a -> a) -> a -> a applyN n f | n < 1 = id | otherwise = (!! n) . iterate f -- from protolude, compare -- applyN :: Int -> (a -> a) -> a -> a -- applyN n f = X.foldr (.) identity (X.replicate n f) -- | Convert a possibly relative, possibly tilde-containing file path to an absolute one, -- given the current directory. ~username is not supported. Leave "-" unchanged. -- Can raise an error. expandPath :: FilePath -> FilePath -> IO FilePath -- general type sig for use in reader parsers expandPath _ "-" = return "-" expandPath curdir p = (if isRelative p then (curdir ) else id) `liftM` expandHomePath p -- PARTIAL: -- | Expand user home path indicated by tilde prefix expandHomePath :: FilePath -> IO FilePath expandHomePath = \case ('~':'/':p) -> ( p) <$> getHomeDirectory ('~':'\\':p) -> ( p) <$> getHomeDirectory ('~':_) -> ioError $ userError "~USERNAME in paths is not supported" p -> return p -- | Read text from a file, -- converting any \r\n line endings to \n,, -- using the system locale's text encoding, -- ignoring any utf8 BOM prefix (as seen in paypal's 2018 CSV, eg) if that encoding is utf8. readFilePortably :: FilePath -> IO Text readFilePortably f = openFile f ReadMode >>= readHandlePortably -- | Like readFilePortably, but read from standard input if the path is "-". readFileOrStdinPortably :: String -> IO Text readFileOrStdinPortably f = openFileOrStdin f ReadMode >>= readHandlePortably where openFileOrStdin :: String -> IOMode -> IO Handle openFileOrStdin "-" _ = return stdin openFileOrStdin f m = openFile f m readHandlePortably :: Handle -> IO Text readHandlePortably h = do hSetNewlineMode h universalNewlineMode menc <- hGetEncoding h when (fmap show menc == Just "UTF-8") $ -- XXX no Eq instance, rely on Show hSetEncoding h utf8_bom T.hGetContents h -- | Total version of maximum, for integral types, giving 0 for an empty list. maximum' :: Integral a => [a] -> a maximum' [] = 0 maximum' xs = maximumStrict xs -- | Strict version of sum that doesn’t leak space {-# INLINABLE sumStrict #-} sumStrict :: Num a => [a] -> a sumStrict = foldl' (+) 0 -- | Strict version of maximum that doesn’t leak space {-# INLINABLE maximumStrict #-} maximumStrict :: Ord a => [a] -> a maximumStrict = foldl1' max -- | Strict version of minimum that doesn’t leak space {-# INLINABLE minimumStrict #-} minimumStrict :: Ord a => [a] -> a minimumStrict = foldl1' min -- | This is a version of sequence based on difference lists. It is -- slightly faster but we mostly use it because it uses the heap -- instead of the stack. This has the advantage that Neil Mitchell’s -- trick of limiting the stack size to discover space leaks doesn’t -- show this as a false positive. {-# INLINABLE sequence' #-} sequence' :: Monad f => [f a] -> f [a] sequence' ms = do h <- go id ms return (h []) where go h [] = return h go h (m:ms) = do x <- m go (h . (x :)) ms -- | Like mapM but uses sequence'. {-# INLINABLE mapM' #-} mapM' :: Monad f => (a -> f b) -> [a] -> f [b] mapM' f = sequence' . map f -- | Like embedFile, but takes a path relative to the package directory. -- Similar to embedFileRelative ? embedFileRelative :: FilePath -> Q Exp embedFileRelative f = makeRelativeToProject f >>= embedStringFile -- -- | Like hereFile, but takes a path relative to the package directory. -- -- Similar to embedFileRelative ? -- hereFileRelative :: FilePath -> Q Exp -- hereFileRelative f = makeRelativeToProject f >>= hereFileExp -- where -- QuasiQuoter{quoteExp=hereFileExp} = hereFile tests_Utils = tests "Utils" [ tests_Text ] hledger-lib-1.19.1/Hledger/Utils/Color.hs0000644000000000000000000000116213700101030016214 0ustar0000000000000000-- | Basic color helpers for prettifying console output. {-# LANGUAGE OverloadedStrings #-} module Hledger.Utils.Color ( color, bgColor, Color(..), ColorIntensity(..) ) where import System.Console.ANSI -- | Wrap a string in ANSI codes to set and reset foreground colour. color :: ColorIntensity -> Color -> String -> String color int col s = setSGRCode [SetColor Foreground int col] ++ s ++ setSGRCode [] -- | Wrap a string in ANSI codes to set and reset background colour. bgColor :: ColorIntensity -> Color -> String -> String bgColor int col s = setSGRCode [SetColor Background int col] ++ s ++ setSGRCode [] hledger-lib-1.19.1/Hledger/Utils/Debug.hs0000644000000000000000000002700613722544246016221 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, TypeFamilies #-} {- | Debugging helpers. You can enable increasingly verbose debug output by adding --debug [1-9] to a hledger command line. --debug with no argument means --debug 1. This is implemented by calling dbgN or similar helpers, defined below. These calls can be found throughout hledger code; they have been added organically where it seemed likely they would be needed again. The choice of debug level has not been very systematic. 202006 Here's a start at some guidelines, not yet applied project-wide: Debug level: What to show: ------------ --------------------------------------------------------- 0 normal command output only (no warnings, eg) 1 (--debug) useful warnings, most common troubleshooting info, eg valuation 2 common troubleshooting info, more detail 3 report options selection 4 report generation 5 report generation, more detail 6 input file reading 7 input file reading, more detail 8 command line parsing 9 any other rarely needed / more in-depth info Tip: when debugging with GHCI, the first run after loading Debug.hs sets the debug level. If you need to change it, you must touch Debug.hs, :reload in GHCI, then run the command with a new --debug value. Or, often it's more convenient to add a temporary dbg0 and :reload (dbg0 always prints). -} -- more: -- http://hackage.haskell.org/packages/archive/TraceUtils/0.1.0.2/doc/html/Debug-TraceUtils.html -- http://hackage.haskell.org/packages/archive/trace-call/0.1/doc/html/Debug-TraceCall.html -- http://hackage.haskell.org/packages/archive/htrace/0.1/doc/html/Debug-HTrace.html -- http://hackage.haskell.org/packages/archive/traced/2009.7.20/doc/html/Debug-Traced.html module Hledger.Utils.Debug ( pprint ,pshow ,ptrace ,traceWith ,traceAt ,traceAtWith ,debugLevel ,ptraceAt ,ptraceAtWith ,dbg0 ,dbg1 ,dbg2 ,dbg3 ,dbg4 ,dbg5 ,dbg6 ,dbg7 ,dbg8 ,dbg9 ,dbg0With ,dbg1With ,dbg2With ,dbg3With ,dbg4With ,dbg5With ,dbg6With ,dbg7With ,dbg8With ,dbg9With ,dbgExit ,ptraceAtIO ,dbg0IO ,dbg1IO ,dbg2IO ,dbg3IO ,dbg4IO ,dbg5IO ,dbg6IO ,dbg7IO ,dbg8IO ,dbg9IO ,plog ,plogAt ,traceParse ,dbgparse ,module Debug.Trace ) where import Control.Monad (when) import Control.Monad.IO.Class import Data.List hiding (uncons) import qualified Data.Text as T import Debug.Trace import Hledger.Utils.Parse import Safe (readDef) import System.Environment (getArgs) import System.Exit import System.IO.Unsafe (unsafePerformIO) import Text.Megaparsec import Text.Printf import Text.Show.Pretty (ppShow, pPrint) -- | Pretty print. Easier alias for pretty-show's pPrint. pprint :: Show a => a -> IO () pprint = pPrint -- | Pretty show. Easier alias for pretty-show's ppShow. pshow :: Show a => a -> String pshow = ppShow -- | Pretty trace. Easier alias for traceShowId + ppShow. ptrace :: Show a => a -> a ptrace = traceWith pshow -- | Like traceShowId, but uses a custom show function to render the value. -- traceShowIdWith was too much of a mouthful. traceWith :: Show a => (a -> String) -> a -> a traceWith f a = trace (f a) a -- | Global debug level, which controls the verbosity of debug output -- on the console. The default is 0 meaning no debug output. The -- @--debug@ command line flag sets it to 1, or @--debug=N@ sets it to -- a higher value (note: not @--debug N@ for some reason). This uses -- unsafePerformIO and can be accessed from anywhere and before normal -- command-line processing. When running with :main in GHCI, you must -- touch and reload this module to see the effect of a new --debug option. -- After command-line processing, it is also available as the @debug_@ -- field of 'Hledger.Cli.CliOptions.CliOpts'. -- {-# OPTIONS_GHC -fno-cse #-} -- {-# NOINLINE debugLevel #-} debugLevel :: Int debugLevel = case snd $ break (=="--debug") args of "--debug":[] -> 1 "--debug":n:_ -> readDef 1 n _ -> case take 1 $ filter ("--debug" `isPrefixOf`) args of ['-':'-':'d':'e':'b':'u':'g':'=':v] -> readDef 1 v _ -> 0 where args = unsafePerformIO getArgs -- | Trace (print to stderr) a string if the global debug level is at -- or above the specified level. At level 0, always prints. Otherwise, -- uses unsafePerformIO. traceAt :: Int -> String -> a -> a traceAt level | level > 0 && debugLevel < level = flip const | otherwise = trace -- | Trace (print to stderr) a showable value using a custom show function. traceAtWith :: (a -> String) -> a -> a traceAtWith f a = trace (f a) a -- | Pretty-print a label and a showable value to the console -- if the global debug level is at or above the specified level. -- At level 0, always prints. Otherwise, uses unsafePerformIO. ptraceAt :: Show a => Int -> String -> a -> a ptraceAt level | level > 0 && debugLevel < level = flip const | otherwise = \s a -> let p = ppShow a ls = lines p nlorspace | length ls > 1 = "\n" | otherwise = " " ++ take (10 - length s) (repeat ' ') ls' | length ls > 1 = map (" "++) ls | otherwise = ls in trace (s++":"++nlorspace++intercalate "\n" ls') a -- | Like ptraceAt, but takes a custom show function instead of a label. ptraceAtWith :: Show a => Int -> (a -> String) -> a -> a ptraceAtWith level f | level > 0 && debugLevel < level = id | otherwise = \a -> let p = f a -- ls = lines p -- nlorspace | length ls > 1 = "\n" -- | otherwise = " " ++ take (10 - length s) (repeat ' ') -- ls' | length ls > 1 = map (" "++) ls -- | otherwise = ls -- in trace (s++":"++nlorspace++intercalate "\n" ls') a in trace p a -- "dbg" would clash with megaparsec. -- | Pretty-print a label and the showable value to the console, then return it. dbg0 :: Show a => String -> a -> a dbg0 = ptraceAt 0 -- | Pretty-print a label and the showable value to the console when the global debug level is >= 1, then return it. -- Uses unsafePerformIO. dbg1 :: Show a => String -> a -> a dbg1 = ptraceAt 1 dbg2 :: Show a => String -> a -> a dbg2 = ptraceAt 2 dbg3 :: Show a => String -> a -> a dbg3 = ptraceAt 3 dbg4 :: Show a => String -> a -> a dbg4 = ptraceAt 4 dbg5 :: Show a => String -> a -> a dbg5 = ptraceAt 5 dbg6 :: Show a => String -> a -> a dbg6 = ptraceAt 6 dbg7 :: Show a => String -> a -> a dbg7 = ptraceAt 7 dbg8 :: Show a => String -> a -> a dbg8 = ptraceAt 8 dbg9 :: Show a => String -> a -> a dbg9 = ptraceAt 9 -- | Like dbg0, but takes a custom show function instead of a label. dbg0With :: Show a => (a -> String) -> a -> a dbg0With = ptraceAtWith 0 dbg1With :: Show a => (a -> String) -> a -> a dbg1With = ptraceAtWith 1 dbg2With :: Show a => (a -> String) -> a -> a dbg2With = ptraceAtWith 2 dbg3With :: Show a => (a -> String) -> a -> a dbg3With = ptraceAtWith 3 dbg4With :: Show a => (a -> String) -> a -> a dbg4With = ptraceAtWith 4 dbg5With :: Show a => (a -> String) -> a -> a dbg5With = ptraceAtWith 5 dbg6With :: Show a => (a -> String) -> a -> a dbg6With = ptraceAtWith 6 dbg7With :: Show a => (a -> String) -> a -> a dbg7With = ptraceAtWith 7 dbg8With :: Show a => (a -> String) -> a -> a dbg8With = ptraceAtWith 8 dbg9With :: Show a => (a -> String) -> a -> a dbg9With = ptraceAtWith 9 -- | Like dbg0, but also exit the program. Uses unsafePerformIO. dbgExit :: Show a => String -> a -> a dbgExit msg = const (unsafePerformIO exitFailure) . dbg0 msg -- | Like ptraceAt, but convenient to insert in an IO monad and -- enforces monadic sequencing (plus convenience aliases). -- XXX These have a bug; they should use -- traceIO, not trace, otherwise GHC can occasionally over-optimise -- (cf lpaste a few days ago where it killed/blocked a child thread). ptraceAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m () ptraceAtIO lvl lbl x = liftIO $ ptraceAt lvl lbl x `seq` return () -- XXX Could not deduce (a ~ ()) -- ptraceAtM :: (Monad m, Show a) => Int -> String -> a -> m a -- ptraceAtM lvl lbl x = ptraceAt lvl lbl x `seq` return x dbg0IO :: (MonadIO m, Show a) => String -> a -> m () dbg0IO = ptraceAtIO 0 dbg1IO :: (MonadIO m, Show a) => String -> a -> m () dbg1IO = ptraceAtIO 1 dbg2IO :: (MonadIO m, Show a) => String -> a -> m () dbg2IO = ptraceAtIO 2 dbg3IO :: (MonadIO m, Show a) => String -> a -> m () dbg3IO = ptraceAtIO 3 dbg4IO :: (MonadIO m, Show a) => String -> a -> m () dbg4IO = ptraceAtIO 4 dbg5IO :: (MonadIO m, Show a) => String -> a -> m () dbg5IO = ptraceAtIO 5 dbg6IO :: (MonadIO m, Show a) => String -> a -> m () dbg6IO = ptraceAtIO 6 dbg7IO :: (MonadIO m, Show a) => String -> a -> m () dbg7IO = ptraceAtIO 7 dbg8IO :: (MonadIO m, Show a) => String -> a -> m () dbg8IO = ptraceAtIO 8 dbg9IO :: (MonadIO m, Show a) => String -> a -> m () dbg9IO = ptraceAtIO 9 -- | Log a label and a pretty-printed showable value to ./debug.log, then return it. -- Can fail, see plogAt. plog :: Show a => String -> a -> a plog = plogAt 0 -- | Log a label and a pretty-printed showable value to ./debug.log, -- if the global debug level is at or above the specified level. -- At level 0, always logs. Otherwise, uses unsafePerformIO. -- Tends to fail if called more than once, at least when built with -threaded -- (Exception: debug.log: openFile: resource busy (file is locked)). plogAt :: Show a => Int -> String -> a -> a plogAt lvl | lvl > 0 && debugLevel < lvl = flip const | otherwise = \s a -> let p = ppShow a ls = lines p nlorspace | length ls > 1 = "\n" | otherwise = " " ++ take (10 - length s) (repeat ' ') ls' | length ls > 1 = map (" "++) ls | otherwise = ls output = s++":"++nlorspace++intercalate "\n" ls'++"\n" in unsafePerformIO $ appendFile "debug.log" output >> return a -- XXX redundant ? More/less robust than plogAt ? -- -- | Like dbg, but writes the output to "debug.log" in the current directory. -- dbglog :: Show a => String -> a -> a -- dbglog label a = -- (unsafePerformIO $ -- appendFile "debug.log" $ label ++ ": " ++ ppShow a ++ "\n") -- `seq` a -- | Print the provided label (if non-null) and current parser state -- (position and next input) to the console. (See also megaparsec's dbg.) traceParse :: String -> TextParser m () traceParse msg = do pos <- getSourcePos next <- (T.take peeklength) `fmap` getInput let (l,c) = (sourceLine pos, sourceColumn pos) s = printf "at line %2d col %2d: %s" (unPos l) (unPos c) (show next) :: String s' = printf ("%-"++show (peeklength+30)++"s") s ++ " " ++ msg trace s' $ return () where peeklength = 30 -- | Print the provided label (if non-null) and current parser state -- (position and next input) to the console if the global debug level -- is at or above the specified level. Uses unsafePerformIO. -- (See also megaparsec's dbg.) traceParseAt :: Int -> String -> TextParser m () traceParseAt level msg = when (level <= debugLevel) $ traceParse msg -- | Convenience alias for traceParseAt dbgparse :: Int -> String -> TextParser m () dbgparse level msg = traceParseAt level msg hledger-lib-1.19.1/Hledger/Utils/Parse.hs0000644000000000000000000001122213722544246016236 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} module Hledger.Utils.Parse ( SimpleStringParser, SimpleTextParser, TextParser, JournalParser, ErroringJournalParser, choice', choiceInState, surroundedBy, parsewith, parsewithString, parseWithState, parseWithState', fromparse, parseerror, showDateParseError, nonspace, isNonNewlineSpace, restofline, eolof, spacenonewline, skipNonNewlineSpaces, skipNonNewlineSpaces1, skipNonNewlineSpaces', -- * re-exports CustomErr ) where import Control.Monad.Except (ExceptT) import Control.Monad.State.Strict (StateT, evalStateT) import Data.Char import Data.Functor.Identity (Identity(..)) import Data.List import Data.Text (Text) import Text.Megaparsec import Text.Megaparsec.Char import Text.Megaparsec.Custom import Text.Printf import Hledger.Data.Types import Hledger.Utils.UTF8IOCompat (error') -- | A parser of string to some type. type SimpleStringParser a = Parsec CustomErr String a -- | A parser of strict text to some type. type SimpleTextParser = Parsec CustomErr Text -- XXX an "a" argument breaks the CsvRulesParser declaration somehow -- | A parser of text that runs in some monad. type TextParser m a = ParsecT CustomErr Text m a -- | A parser of text that runs in some monad, keeping a Journal as state. type JournalParser m a = StateT Journal (ParsecT CustomErr Text m) a -- | A parser of text that runs in some monad, keeping a Journal as -- state, that can throw an exception to end parsing, preventing -- further parser backtracking. type ErroringJournalParser m a = StateT Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) a -- | Backtracking choice, use this when alternatives share a prefix. -- Consumes no input if all choices fail. choice' :: [TextParser m a] -> TextParser m a choice' = choice . map try -- | Backtracking choice, use this when alternatives share a prefix. -- Consumes no input if all choices fail. choiceInState :: [StateT s (ParsecT CustomErr Text m) a] -> StateT s (ParsecT CustomErr Text m) a choiceInState = choice . map try surroundedBy :: Applicative m => m openclose -> m a -> m a surroundedBy p = between p p parsewith :: Parsec e Text a -> Text -> Either (ParseErrorBundle Text e) a parsewith p = runParser p "" parsewithString :: Parsec e String a -> String -> Either (ParseErrorBundle String e) a parsewithString p = runParser p "" -- | Run a stateful parser with some initial state on a text. -- See also: runTextParser, runJournalParser. parseWithState :: Monad m => st -> StateT st (ParsecT CustomErr Text m) a -> Text -> m (Either (ParseErrorBundle Text CustomErr) a) parseWithState ctx p s = runParserT (evalStateT p ctx) "" s parseWithState' :: (Stream s) => st -> StateT st (ParsecT e s Identity) a -> s -> (Either (ParseErrorBundle s e) a) parseWithState' ctx p s = runParser (evalStateT p ctx) "" s fromparse :: (Show t, Show (Token t), Show e) => Either (ParseErrorBundle t e) a -> a fromparse = either parseerror id parseerror :: (Show t, Show (Token t), Show e) => ParseErrorBundle t e -> a parseerror e = error' $ showParseError e -- PARTIAL: showParseError :: (Show t, Show (Token t), Show e) => ParseErrorBundle t e -> String showParseError e = "parse error at " ++ show e showDateParseError :: (Show t, Show (Token t), Show e) => ParseErrorBundle t e -> String showDateParseError e = printf "date parse error (%s)" (intercalate ", " $ tail $ lines $ show e) nonspace :: TextParser m Char nonspace = satisfy (not . isSpace) isNonNewlineSpace :: Char -> Bool isNonNewlineSpace c = c /= '\n' && isSpace c -- XXX support \r\n ? -- isNonNewlineSpace c = c /= '\n' && c /= '\r' && isSpace c spacenonewline :: (Stream s, Char ~ Token s) => ParsecT CustomErr s m Char spacenonewline = satisfy isNonNewlineSpace {-# INLINABLE spacenonewline #-} restofline :: TextParser m String restofline = anySingle `manyTill` eolof -- Skip many non-newline spaces. skipNonNewlineSpaces :: (Stream s, Token s ~ Char) => ParsecT CustomErr s m () skipNonNewlineSpaces = () <$ takeWhileP Nothing isNonNewlineSpace {-# INLINABLE skipNonNewlineSpaces #-} -- Skip many non-newline spaces, failing if there are none. skipNonNewlineSpaces1 :: (Stream s, Token s ~ Char) => ParsecT CustomErr s m () skipNonNewlineSpaces1 = () <$ takeWhile1P Nothing isNonNewlineSpace {-# INLINABLE skipNonNewlineSpaces1 #-} -- Skip many non-newline spaces, returning True if any have been skipped. skipNonNewlineSpaces' :: (Stream s, Token s ~ Char) => ParsecT CustomErr s m Bool skipNonNewlineSpaces' = True <$ skipNonNewlineSpaces1 <|> pure False {-# INLINABLE skipNonNewlineSpaces' #-} eolof :: TextParser m () eolof = (newline >> return ()) <|> eof hledger-lib-1.19.1/Hledger/Utils/Regex.hs0000644000000000000000000002424313724277550016250 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances #-} {-| Easy regular expression helpers, currently based on regex-tdfa. These should: - be cross-platform, not requiring C libraries - support unicode - support extended regular expressions - support replacement, with backreferences etc. - support splitting - have mnemonic names - have simple monomorphic types - work with simple strings Regex strings are automatically compiled into regular expressions the first time they are seen, and these are cached. If you use a huge number of unique regular expressions this might lead to increased memory usage. Several functions have memoised variants (*Memo), which also trade space for time. Currently two APIs are provided: - The old partial one (with ' suffixes') which will call error on any problem (eg with malformed regexps). This comes from hledger's origin as a command-line tool. - The new total one which will return an error message. This is better for long-running apps like hledger-web. Current limitations: - (?i) and similar are not supported -} module Hledger.Utils.Regex ( -- * Regexp type and constructors Regexp(reString) ,toRegex ,toRegexCI ,toRegex' ,toRegexCI' -- * type aliases ,Replacement ,RegexError -- * total regex operations ,regexMatch ,regexReplace ,regexReplaceUnmemo ,regexReplaceAllBy ) where import Control.Monad (foldM) import Data.Aeson (ToJSON(..), Value(String)) import Data.Array ((!), elems, indices) import Data.Char (isDigit) import Data.List (foldl') import Data.MemoUgly (memo) import qualified Data.Text as T import Text.Regex.TDFA ( Regex, CompOption(..), defaultCompOpt, defaultExecOpt, makeRegexOptsM, AllMatches(getAllMatches), match, MatchText, RegexLike(..), RegexMaker(..), RegexOptions(..), RegexContext(..) ) import Hledger.Utils.UTF8IOCompat (error') -- | Regular expression. Extended regular expression-ish syntax ? But does not support eg (?i) syntax. data Regexp = Regexp { reString :: String, reCompiled :: Regex } | RegexpCI { reString :: String, reCompiled :: Regex } instance Eq Regexp where Regexp s1 _ == Regexp s2 _ = s1 == s2 RegexpCI s1 _ == RegexpCI s2 _ = s1 == s2 _ == _ = False instance Ord Regexp where Regexp s1 _ `compare` Regexp s2 _ = s1 `compare` s2 RegexpCI s1 _ `compare` RegexpCI s2 _ = s1 `compare` s2 Regexp _ _ `compare` RegexpCI _ _ = LT RegexpCI _ _ `compare` Regexp _ _ = GT instance Show Regexp where showsPrec d r = showParen (d > app_prec) $ reCons . showsPrec (app_prec+1) (reString r) where app_prec = 10 reCons = case r of Regexp _ _ -> showString "Regexp " RegexpCI _ _ -> showString "RegexpCI " instance Read Regexp where readsPrec d r = readParen (d > app_prec) (\r -> [(toRegexCI' m,t) | ("RegexCI",s) <- lex r, (m,t) <- readsPrec (app_prec+1) s]) r ++ readParen (d > app_prec) (\r -> [(toRegex' m, t) | ("Regex",s) <- lex r, (m,t) <- readsPrec (app_prec+1) s]) r where app_prec = 10 instance ToJSON Regexp where toJSON (Regexp s _) = String . T.pack $ "Regexp " ++ s toJSON (RegexpCI s _) = String . T.pack $ "RegexpCI " ++ s instance RegexLike Regexp String where matchOnce = matchOnce . reCompiled matchAll = matchAll . reCompiled matchCount = matchCount . reCompiled matchTest = matchTest . reCompiled matchAllText = matchAllText . reCompiled matchOnceText = matchOnceText . reCompiled instance RegexContext Regexp String String where match = match . reCompiled matchM = matchM . reCompiled -- Convert a Regexp string to a compiled Regex, or return an error message. toRegex :: String -> Either RegexError Regexp toRegex = memo $ \s -> mkRegexErr s (Regexp s <$> makeRegexM s) -- Like toRegex, but make a case-insensitive Regex. toRegexCI :: String -> Either RegexError Regexp toRegexCI = memo $ \s -> mkRegexErr s (RegexpCI s <$> makeRegexOptsM defaultCompOpt{caseSensitive=False} defaultExecOpt s) -- | Make a nice error message for a regexp error. mkRegexErr :: String -> Maybe a -> Either RegexError a mkRegexErr s = maybe (Left errmsg) Right where errmsg = "this regular expression could not be compiled: " ++ s -- Convert a Regexp string to a compiled Regex, throw an error toRegex' :: String -> Regexp toRegex' = either error' id . toRegex -- Like toRegex', but make a case-insensitive Regex. toRegexCI' :: String -> Regexp toRegexCI' = either error' id . toRegexCI -- | A replacement pattern. May include numeric backreferences (\N). type Replacement = String -- | An regular expression compilation/processing error message. type RegexError = String -- helpers -- | Test whether a Regexp matches a String. This is an alias for `matchTest` for consistent -- naming. regexMatch :: Regexp -> String -> Bool regexMatch = matchTest -------------------------------------------------------------------------------- -- new total functions -- | A memoising version of regexReplace. Caches the result for each -- search pattern, replacement pattern, target string tuple. regexReplace :: Regexp -> Replacement -> String -> Either RegexError String regexReplace re repl = memo $ regexReplaceUnmemo re repl -- helpers: -- Replace this regular expression with this replacement pattern in this -- string, or return an error message. regexReplaceUnmemo :: Regexp -> Replacement -> String -> Either RegexError String regexReplaceUnmemo re repl s = foldM (replaceMatch repl) s (reverse $ match (reCompiled re) s :: [MatchText String]) where -- Replace one match within the string with the replacement text -- appropriate for this match. Or return an error message. replaceMatch :: Replacement -> String -> MatchText String -> Either RegexError String replaceMatch replpat s matchgroups = erepl >>= \repl -> Right $ pre ++ repl ++ post where ((_,(off,len)):_) = elems matchgroups -- groups should have 0-based indexes, and there should always be at least one, since this is a match (pre, post') = splitAt off s post = drop len post' -- The replacement text: the replacement pattern with all -- numeric backreferences replaced by the appropriate groups -- from this match. Or an error message. erepl = regexReplaceAllByM backrefRegex (lookupMatchGroup matchgroups) replpat where -- Given some match groups and a numeric backreference, -- return the referenced group text, or an error message. lookupMatchGroup :: MatchText String -> String -> Either RegexError String lookupMatchGroup grps ('\\':s@(_:_)) | all isDigit s = case read s of n | n `elem` indices grps -> Right $ fst (grps ! n) _ -> Left $ "no match group exists for backreference \"\\"++s++"\"" lookupMatchGroup _ s = Left $ "lookupMatchGroup called on non-numeric-backreference \""++s++"\", shouldn't happen" backrefRegex = toRegex' "\\\\[0-9]+" -- PARTIAL: should not fail -- regexReplace' :: Regexp -> Replacement -> String -> String -- regexReplace' re repl s = -- foldl (replaceMatch repl) s (reverse $ match (reCompiled re) s :: [MatchText String]) -- where -- replaceMatch :: Replacement -> String -> MatchText String -> String -- replaceMatch replpat s matchgroups = pre ++ repl ++ post -- where -- ((_,(off,len)):_) = elems matchgroups -- groups should have 0-based indexes, and there should always be at least one, since this is a match -- (pre, post') = splitAt off s -- post = drop len post' -- repl = regexReplaceAllBy backrefRegex (lookupMatchGroup matchgroups) replpat -- where -- lookupMatchGroup :: MatchText String -> String -> String -- lookupMatchGroup grps ('\\':s@(_:_)) | all isDigit s = -- case read s of n | n `elem` indices grps -> fst (grps ! n) -- -- PARTIAL: -- _ -> error' $ "no match group exists for backreference \"\\"++s++"\"" -- lookupMatchGroup _ s = error' $ "lookupMatchGroup called on non-numeric-backreference \""++s++"\", shouldn't happen" -- backrefRegex = toRegex' "\\\\[0-9]+" -- PARTIAL: should not fail -- helpers -- adapted from http://stackoverflow.com/questions/9071682/replacement-substition-with-haskell-regex-libraries: -- Replace all occurrences of a regexp in a string, transforming each match -- with the given pure function. regexReplaceAllBy :: Regexp -> (String -> String) -> String -> String regexReplaceAllBy re transform s = prependdone rest where (_, rest, prependdone) = foldl' go (0, s, id) matches where matches = getAllMatches $ match (reCompiled re) s :: [(Int, Int)] -- offset and length go :: (Int,String,String->String) -> (Int,Int) -> (Int,String,String->String) go (pos,todo,prepend) (off,len) = let (prematch, matchandrest) = splitAt (off - pos) todo (matched, rest) = splitAt len matchandrest in (off + len, rest, prepend . (prematch++) . (transform matched ++)) -- Replace all occurrences of a regexp in a string, transforming each match -- with the given monadic function. Eg if the monad is Either, a Left result -- from the transform function short-circuits and is returned as the overall -- result. regexReplaceAllByM :: forall m. Monad m => Regexp -> (String -> m String) -> String -> m String regexReplaceAllByM re transform s = foldM go (0, s, id) matches >>= \(_, rest, prependdone) -> pure $ prependdone rest where matches = getAllMatches $ match (reCompiled re) s :: [(Int, Int)] -- offset and length go :: (Int,String,String->String) -> (Int,Int) -> m (Int,String,String->String) go (pos,todo,prepend) (off,len) = let (prematch, matchandrest) = splitAt (off - pos) todo (matched, rest) = splitAt len matchandrest in transform matched >>= \matched' -> pure (off + len, rest, prepend . (prematch++) . (matched' ++)) hledger-lib-1.19.1/Hledger/Utils/String.hs0000644000000000000000000003545413725504032016437 0ustar0000000000000000-- | String formatting helpers, starting to get a bit out of control. module Hledger.Utils.String ( takeEnd, -- * misc lowercase, uppercase, underline, stripbrackets, unbracket, -- quoting quoteIfNeeded, singleQuoteIfNeeded, -- quotechars, -- whitespacechars, words', unwords', stripAnsi, -- * single-line layout strip, lstrip, rstrip, chomp, singleline, elideLeft, elideRight, formatString, -- * multi-line layout concatTopPadded, concatBottomPadded, concatOneLine, vConcatLeftAligned, vConcatRightAligned, padtop, padbottom, padleft, padright, cliptopleft, fitto, -- * wide-character-aware layout charWidth, strWidth, takeWidth, fitString, fitStringMulti, padLeftWide, padRightWide ) where import Data.Char (isDigit, isSpace, toLower, toUpper) import Data.List (intercalate, transpose) import Text.Megaparsec (Parsec, (<|>), (), anySingle, between, many, noneOf, oneOf, parseMaybe, sepBy, takeWhileP, try) import Text.Megaparsec.Char (char, string) import Text.Printf (printf) import Hledger.Utils.Parse -- | Take elements from the end of a list. takeEnd n l = go (drop n l) l where go (_:xs) (_:ys) = go xs ys go [] r = r go _ [] = [] lowercase, uppercase :: String -> String lowercase = map toLower uppercase = map toUpper -- | Remove leading and trailing whitespace. strip :: String -> String strip = lstrip . rstrip -- | Remove leading whitespace. lstrip :: String -> String lstrip = dropWhile isSpace -- | Remove trailing whitespace. rstrip :: String -> String rstrip = reverse . lstrip . reverse -- | Remove trailing newlines/carriage returns. chomp :: String -> String chomp = reverse . dropWhile (`elem` "\r\n") . reverse -- | Remove consecutive line breaks, replacing them with single space singleline :: String -> String singleline = unwords . filter (/="") . (map strip) . lines stripbrackets :: String -> String stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse :: String -> String elideLeft :: Int -> String -> String elideLeft width s = if length s > width then ".." ++ takeEnd (width - 2) s else s elideRight :: Int -> String -> String elideRight width s = if length s > width then take (width - 2) s ++ ".." else s -- | Clip and pad a string to a minimum & maximum width, and/or left/right justify it. -- Works on multi-line strings too (but will rewrite non-unix line endings). formatString :: Bool -> Maybe Int -> Maybe Int -> String -> String formatString leftJustified minwidth maxwidth s = intercalate "\n" $ map (printf fmt) $ lines s where justify = if leftJustified then "-" else "" minwidth' = maybe "" show minwidth maxwidth' = maybe "" (("."++).show) maxwidth fmt = "%" ++ justify ++ minwidth' ++ maxwidth' ++ "s" underline :: String -> String underline s = s' ++ replicate (length s) '-' ++ "\n" where s' | last s == '\n' = s | otherwise = s ++ "\n" -- | Double-quote this string if it contains whitespace, single quotes -- or double-quotes, escaping the quotes as needed. quoteIfNeeded :: String -> String quoteIfNeeded s | any (`elem` s) (quotechars++whitespacechars++redirectchars) = show s | otherwise = s -- | Single-quote this string if it contains whitespace or double-quotes. -- No good for strings containing single quotes. singleQuoteIfNeeded :: String -> String singleQuoteIfNeeded s | any (`elem` s) whitespacechars = "'"++s++"'" | otherwise = s quotechars, whitespacechars, redirectchars :: [Char] quotechars = "'\"" whitespacechars = " \t\n\r" redirectchars = "<>" -- | Quote-aware version of words - don't split on spaces which are inside quotes. -- NB correctly handles "a'b" but not "''a''". Can raise an error if parsing fails. words' :: String -> [String] words' "" = [] words' s = map stripquotes $ fromparse $ parsewithString p s where p = do ss <- (singleQuotedPattern <|> doubleQuotedPattern <|> pattern) `sepBy` skipNonNewlineSpaces1 -- eof return ss pattern = many (noneOf whitespacechars) singleQuotedPattern = between (char '\'') (char '\'') (many $ noneOf "'") doubleQuotedPattern = between (char '"') (char '"') (many $ noneOf "\"") -- | Quote-aware version of unwords - single-quote strings which contain whitespace unwords' :: [String] -> String unwords' = unwords . map quoteIfNeeded -- | Strip one matching pair of single or double quotes on the ends of a string. stripquotes :: String -> String stripquotes s = if isSingleQuoted s || isDoubleQuoted s then init $ tail s else s isSingleQuoted s@(_:_:_) = head s == '\'' && last s == '\'' isSingleQuoted _ = False isDoubleQuoted s@(_:_:_) = head s == '"' && last s == '"' isDoubleQuoted _ = False unbracket :: String -> String unbracket s | (head s == '[' && last s == ']') || (head s == '(' && last s == ')') = init $ tail s | otherwise = s -- | Join several multi-line strings as side-by-side rectangular strings of the same height, top-padded. -- Treats wide characters as double width. concatTopPadded :: [String] -> String concatTopPadded strs = intercalate "\n" $ map concat $ transpose padded where lss = map lines strs h = maximum $ map length lss ypad ls = replicate (difforzero h (length ls)) "" ++ ls xpad ls = map (padLeftWide w) ls where w | null ls = 0 | otherwise = maximum $ map strWidth ls padded = map (xpad . ypad) lss -- | Join several multi-line strings as side-by-side rectangular strings of the same height, bottom-padded. -- Treats wide characters as double width. concatBottomPadded :: [String] -> String concatBottomPadded strs = intercalate "\n" $ map concat $ transpose padded where lss = map lines strs h = maximum $ map length lss ypad ls = ls ++ replicate (difforzero h (length ls)) "" xpad ls = map (padRightWide w) ls where w | null ls = 0 | otherwise = maximum $ map strWidth ls padded = map (xpad . ypad) lss -- | Join multi-line strings horizontally, after compressing each of -- them to a single line with a comma and space between each original line. concatOneLine :: [String] -> String concatOneLine strs = concat $ map ((intercalate ", ").lines) strs -- | Join strings vertically, left-aligned and right-padded. vConcatLeftAligned :: [String] -> String vConcatLeftAligned ss = intercalate "\n" $ map showfixedwidth ss where showfixedwidth = printf (printf "%%-%ds" width) width = maximum $ map length ss -- | Join strings vertically, right-aligned and left-padded. vConcatRightAligned :: [String] -> String vConcatRightAligned ss = intercalate "\n" $ map showfixedwidth ss where showfixedwidth = printf (printf "%%%ds" width) width = maximum $ map length ss -- | Convert a multi-line string to a rectangular string top-padded to the specified height. padtop :: Int -> String -> String padtop h s = intercalate "\n" xpadded where ls = lines s sh = length ls sw | null ls = 0 | otherwise = maximum $ map length ls ypadded = replicate (difforzero h sh) "" ++ ls xpadded = map (padleft sw) ypadded -- | Convert a multi-line string to a rectangular string bottom-padded to the specified height. padbottom :: Int -> String -> String padbottom h s = intercalate "\n" xpadded where ls = lines s sh = length ls sw | null ls = 0 | otherwise = maximum $ map length ls ypadded = ls ++ replicate (difforzero h sh) "" xpadded = map (padleft sw) ypadded difforzero :: (Num a, Ord a) => a -> a -> a difforzero a b = maximum [(a - b), 0] -- | Convert a multi-line string to a rectangular string left-padded to the specified width. -- Treats wide characters as double width. padleft :: Int -> String -> String padleft w "" = concat $ replicate w " " padleft w s = intercalate "\n" $ map (printf (printf "%%%ds" w)) $ lines s -- | Convert a multi-line string to a rectangular string right-padded to the specified width. -- Treats wide characters as double width. padright :: Int -> String -> String padright w "" = concat $ replicate w " " padright w s = intercalate "\n" $ map (printf (printf "%%-%ds" w)) $ lines s -- | Clip a multi-line string to the specified width and height from the top left. cliptopleft :: Int -> Int -> String -> String cliptopleft w h = intercalate "\n" . take h . map (take w) . lines -- | Clip and pad a multi-line string to fill the specified width and height. fitto :: Int -> Int -> String -> String fitto w h s = intercalate "\n" $ take h $ rows ++ repeat blankline where rows = map (fit w) $ lines s fit w = take w . (++ repeat ' ') blankline = replicate w ' ' -- Functions below treat wide (eg CJK) characters as double-width. -- | General-purpose wide-char-aware single-line string layout function. -- It can left- or right-pad a short string to a minimum width. -- It can left- or right-clip a long string to a maximum width, optionally inserting an ellipsis (the third argument). -- It clips and pads on the right when the fourth argument is true, otherwise on the left. -- It treats wide characters as double width. fitString :: Maybe Int -> Maybe Int -> Bool -> Bool -> String -> String fitString mminwidth mmaxwidth ellipsify rightside s = (clip . pad) s where clip :: String -> String clip s = case mmaxwidth of Just w | strWidth s > w -> case rightside of True -> takeWidth (w - length ellipsis) s ++ ellipsis False -> ellipsis ++ reverse (takeWidth (w - length ellipsis) $ reverse s) | otherwise -> s where ellipsis = if ellipsify then ".." else "" Nothing -> s pad :: String -> String pad s = case mminwidth of Just w | sw < w -> case rightside of True -> s ++ replicate (w - sw) ' ' False -> replicate (w - sw) ' ' ++ s | otherwise -> s Nothing -> s where sw = strWidth s -- | A version of fitString that works on multi-line strings, -- separate for now to avoid breakage. -- This will rewrite any line endings to unix newlines. fitStringMulti :: Maybe Int -> Maybe Int -> Bool -> Bool -> String -> String fitStringMulti mminwidth mmaxwidth ellipsify rightside s = (intercalate "\n" . map (fitString mminwidth mmaxwidth ellipsify rightside) . lines) s -- | Left-pad a string to the specified width. -- Treats wide characters as double width. -- Works on multi-line strings too (but will rewrite non-unix line endings). padLeftWide :: Int -> String -> String padLeftWide w "" = replicate w ' ' padLeftWide w s = intercalate "\n" $ map (fitString (Just w) Nothing False False) $ lines s -- XXX not yet replaceable by -- padLeftWide w = fitStringMulti (Just w) Nothing False False -- | Right-pad a string to the specified width. -- Treats wide characters as double width. -- Works on multi-line strings too (but will rewrite non-unix line endings). padRightWide :: Int -> String -> String padRightWide w "" = replicate w ' ' padRightWide w s = intercalate "\n" $ map (fitString (Just w) Nothing False True) $ lines s -- XXX not yet replaceable by -- padRightWide w = fitStringMulti (Just w) Nothing False True -- | Double-width-character-aware string truncation. Take as many -- characters as possible from a string without exceeding the -- specified width. Eg takeWidth 3 "りんご" = "り". takeWidth :: Int -> String -> String takeWidth _ "" = "" takeWidth 0 _ = "" takeWidth w (c:cs) | cw <= w = c:takeWidth (w-cw) cs | otherwise = "" where cw = charWidth c -- from Pandoc (copyright John MacFarlane, GPL) -- see also http://unicode.org/reports/tr11/#Description -- | Calculate the render width of a string, considering -- wide characters (counted as double width), ANSI escape codes -- (not counted), and line breaks (in a multi-line string, the longest -- line determines the width). strWidth :: String -> Int strWidth = maximum . (0:) . map (foldr (\a b -> charWidth a + b) 0) . lines . stripAnsi -- | Strip ANSI escape sequences from a string. -- -- >>> stripAnsi "\ESC[31m-1\ESC[m" -- "-1" stripAnsi :: String -> String stripAnsi s = case parseMaybe (many $ "" <$ try ansi <|> pure <$> anySingle) s of Nothing -> error "Bad ansi escape" -- PARTIAL: should not happen Just xs -> concat xs where -- This parses lots of invalid ANSI escape codes, but that should be fine ansi = string "\ESC[" *> digitSemicolons *> suffix "ansi" :: Parsec CustomErr String Char digitSemicolons = takeWhileP Nothing (\c -> isDigit c || c == ';') suffix = oneOf ['A', 'B', 'C', 'D', 'H', 'J', 'K', 'f', 'm', 's', 'u'] -- | Get the designated render width of a character: 0 for a combining -- character, 1 for a regular character, 2 for a wide character. -- (Wide characters are rendered as exactly double width in apps and -- fonts that support it.) (From Pandoc.) charWidth :: Char -> Int charWidth c = case c of _ | c < '\x0300' -> 1 | c >= '\x0300' && c <= '\x036F' -> 0 -- combining | c >= '\x0370' && c <= '\x10FC' -> 1 | c >= '\x1100' && c <= '\x115F' -> 2 | c >= '\x1160' && c <= '\x11A2' -> 1 | c >= '\x11A3' && c <= '\x11A7' -> 2 | c >= '\x11A8' && c <= '\x11F9' -> 1 | c >= '\x11FA' && c <= '\x11FF' -> 2 | c >= '\x1200' && c <= '\x2328' -> 1 | c >= '\x2329' && c <= '\x232A' -> 2 | c >= '\x232B' && c <= '\x2E31' -> 1 | c >= '\x2E80' && c <= '\x303E' -> 2 | c == '\x303F' -> 1 | c >= '\x3041' && c <= '\x3247' -> 2 | c >= '\x3248' && c <= '\x324F' -> 1 -- ambiguous | c >= '\x3250' && c <= '\x4DBF' -> 2 | c >= '\x4DC0' && c <= '\x4DFF' -> 1 | c >= '\x4E00' && c <= '\xA4C6' -> 2 | c >= '\xA4D0' && c <= '\xA95F' -> 1 | c >= '\xA960' && c <= '\xA97C' -> 2 | c >= '\xA980' && c <= '\xABF9' -> 1 | c >= '\xAC00' && c <= '\xD7FB' -> 2 | c >= '\xD800' && c <= '\xDFFF' -> 1 | c >= '\xE000' && c <= '\xF8FF' -> 1 -- ambiguous | c >= '\xF900' && c <= '\xFAFF' -> 2 | c >= '\xFB00' && c <= '\xFDFD' -> 1 | c >= '\xFE00' && c <= '\xFE0F' -> 1 -- ambiguous | c >= '\xFE10' && c <= '\xFE19' -> 2 | c >= '\xFE20' && c <= '\xFE26' -> 1 | c >= '\xFE30' && c <= '\xFE6B' -> 2 | c >= '\xFE70' && c <= '\xFEFF' -> 1 | c >= '\xFF01' && c <= '\xFF60' -> 2 | c >= '\xFF61' && c <= '\x16A38' -> 1 | c >= '\x1B000' && c <= '\x1B001' -> 2 | c >= '\x1D000' && c <= '\x1F1FF' -> 1 | c >= '\x1F200' && c <= '\x1F251' -> 2 | c >= '\x1F300' && c <= '\x1F773' -> 1 | c >= '\x20000' && c <= '\x3FFFD' -> 2 | otherwise -> 1 hledger-lib-1.19.1/Hledger/Utils/Test.hs0000644000000000000000000001570713700101030016067 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Hledger.Utils.Test ( module Test.Tasty ,module Test.Tasty.HUnit -- ,module QC -- ,module SC ,tests ,test ,assertLeft ,assertRight ,assertParse ,assertParseEq ,assertParseEqOn ,assertParseError ,assertParseE ,assertParseEqE ,assertParseErrorE ,assertParseStateOn ) where import Control.Monad.Except (ExceptT, runExceptT) import Control.Monad.State.Strict (StateT, evalStateT, execStateT) import Data.Default (Default(..)) #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup ((<>)) #endif -- import Data.CallStack import Data.List (isInfixOf) import qualified Data.Text as T import Test.Tasty hiding (defaultMain) import Test.Tasty.HUnit -- import Test.Tasty.QuickCheck as QC -- import Test.Tasty.SmallCheck as SC import Text.Megaparsec import Text.Megaparsec.Custom ( CustomErr, FinalParseError, attachSource, customErrorBundlePretty, finalErrorBundlePretty, ) import Hledger.Utils.Debug (pshow) -- import Hledger.Utils.UTF8IOCompat (error') -- * tasty helpers -- TODO: pretty-print values in failure messages -- | Name and group a list of tests. Shorter alias for Test.Tasty.HUnit.testGroup. tests :: String -> [TestTree] -> TestTree tests = testGroup -- | Name an assertion or sequence of assertions. Shorter alias for Test.Tasty.HUnit.testCase. test :: String -> Assertion -> TestTree test = testCase -- | Assert any Left value. assertLeft :: (HasCallStack, Eq b, Show b) => Either a b -> Assertion assertLeft (Left _) = return () assertLeft (Right b) = assertFailure $ "expected Left, got (Right " ++ show b ++ ")" -- | Assert any Right value. assertRight :: (HasCallStack, Eq a, Show a) => Either a b -> Assertion assertRight (Right _) = return () assertRight (Left a) = assertFailure $ "expected Right, got (Left " ++ show a ++ ")" -- | Assert that this stateful parser runnable in IO successfully parses -- all of the given input text, showing the parse error if it fails. -- Suitable for hledger's JournalParser parsers. assertParse :: (HasCallStack, Eq a, Show a, Default st) => StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> Assertion assertParse parser input = do ep <- runParserT (evalStateT (parser <* eof) def) "" input either (assertFailure.(++"\n").("\nparse error at "++).customErrorBundlePretty) (const $ return ()) ep -- | Assert a parser produces an expected value. assertParseEq :: (HasCallStack, Eq a, Show a, Default st) => StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> Assertion assertParseEq parser input expected = assertParseEqOn parser input id expected -- | Like assertParseEq, but transform the parse result with the given function -- before comparing it. assertParseEqOn :: (HasCallStack, Eq b, Show b, Default st) => StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (a -> b) -> b -> Assertion assertParseEqOn parser input f expected = do ep <- runParserT (evalStateT (parser <* eof) def) "" input either (assertFailure . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty) (assertEqual "" expected . f) ep -- | Assert that this stateful parser runnable in IO fails to parse -- the given input text, with a parse error containing the given string. assertParseError :: (HasCallStack, Eq a, Show a, Default st) => StateT st (ParsecT CustomErr T.Text IO) a -> String -> String -> Assertion assertParseError parser input errstr = do ep <- runParserT (evalStateT parser def) "" (T.pack input) case ep of Right v -> assertFailure $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n" Left e -> do let e' = customErrorBundlePretty e if errstr `isInfixOf` e' then return () else assertFailure $ "\nparse error is not as expected:\n" ++ e' ++ "\n" -- | Run a stateful parser in IO like assertParse, then assert that the -- final state (the wrapped state, not megaparsec's internal state), -- transformed by the given function, matches the given expected value. assertParseStateOn :: (HasCallStack, Eq b, Show b, Default st) => StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (st -> b) -> b -> Assertion assertParseStateOn parser input f expected = do es <- runParserT (execStateT (parser <* eof) def) "" input case es of Left err -> assertFailure $ (++"\n") $ ("\nparse error at "++) $ customErrorBundlePretty err Right s -> assertEqual "" expected $ f s -- | These "E" variants of the above are suitable for hledger's ErroringJournalParser parsers. assertParseE :: (HasCallStack, Eq a, Show a, Default st) => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text -> Assertion assertParseE parser input = do let filepath = "" eep <- runExceptT $ runParserT (evalStateT (parser <* eof) def) filepath input case eep of Left finalErr -> let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr in assertFailure $ "parse error at " <> prettyErr Right ep -> either (assertFailure.(++"\n").("\nparse error at "++).customErrorBundlePretty) (const $ return ()) ep assertParseEqE :: (Default st, Eq a, Show a, HasCallStack) => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text -> a -> Assertion assertParseEqE parser input expected = assertParseEqOnE parser input id expected assertParseEqOnE :: (HasCallStack, Eq b, Show b, Default st) => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text -> (a -> b) -> b -> Assertion assertParseEqOnE parser input f expected = do let filepath = "" eep <- runExceptT $ runParserT (evalStateT (parser <* eof) def) filepath input case eep of Left finalErr -> let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr in assertFailure $ "parse error at " <> prettyErr Right ep -> either (assertFailure . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty) (assertEqual "" expected . f) ep assertParseErrorE :: (Default st, Eq a, Show a, HasCallStack) => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text -> String -> Assertion assertParseErrorE parser input errstr = do let filepath = "" eep <- runExceptT $ runParserT (evalStateT parser def) filepath input case eep of Left finalErr -> do let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr if errstr `isInfixOf` prettyErr then return () else assertFailure $ "\nparse error is not as expected:\n" ++ prettyErr ++ "\n" Right ep -> case ep of Right v -> assertFailure $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n" Left e -> do let e' = customErrorBundlePretty e if errstr `isInfixOf` e' then return () else assertFailure $ "\nparse error is not as expected:\n" ++ e' ++ "\n" hledger-lib-1.19.1/Hledger/Utils/Text.hs0000644000000000000000000004015213723606465016117 0ustar0000000000000000-- | Text formatting helpers, ported from String as needed. -- There may be better alternatives out there. {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Hledger.Utils.Text ( -- -- * misc -- lowercase, -- uppercase, -- underline, -- stripbrackets, textUnbracket, -- -- quoting quoteIfSpaced, textQuoteIfNeeded, -- singleQuoteIfNeeded, -- -- quotechars, -- -- whitespacechars, escapeDoubleQuotes, -- escapeSingleQuotes, -- escapeQuotes, -- words', -- unwords', stripquotes, -- isSingleQuoted, -- isDoubleQuoted, -- -- * single-line layout -- elideLeft, textElideRight, -- formatString, -- -- * multi-line layout textConcatTopPadded, -- concatBottomPadded, -- concatOneLine, -- vConcatLeftAligned, -- vConcatRightAligned, -- padtop, -- padbottom, -- padleft, -- padright, -- cliptopleft, -- fitto, fitText, -- -- * wide-character-aware layout textWidth, textTakeWidth, -- fitString, -- fitStringMulti, textPadLeftWide, textPadRightWide, -- -- * Reading readDecimal, -- -- * tests tests_Text ) where import Data.Char (digitToInt) import Data.List #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif import Data.Text (Text) import qualified Data.Text as T -- import Text.Parsec -- import Text.Printf (printf) -- import Hledger.Utils.Parse -- import Hledger.Utils.Regex import Hledger.Utils.String (charWidth) import Hledger.Utils.Test -- lowercase, uppercase :: String -> String -- lowercase = map toLower -- uppercase = map toUpper -- stripbrackets :: String -> String -- stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse :: String -> String -- elideLeft :: Int -> String -> String -- elideLeft width s = -- if length s > width then ".." ++ reverse (take (width - 2) $ reverse s) else s textElideRight :: Int -> Text -> Text textElideRight width t = if T.length t > width then T.take (width - 2) t <> ".." else t -- -- | Clip and pad a string to a minimum & maximum width, and/or left/right justify it. -- -- Works on multi-line strings too (but will rewrite non-unix line endings). -- formatString :: Bool -> Maybe Int -> Maybe Int -> String -> String -- formatString leftJustified minwidth maxwidth s = intercalate "\n" $ map (printf fmt) $ lines s -- where -- justify = if leftJustified then "-" else "" -- minwidth' = maybe "" show minwidth -- maxwidth' = maybe "" (("."++).show) maxwidth -- fmt = "%" ++ justify ++ minwidth' ++ maxwidth' ++ "s" -- underline :: String -> String -- underline s = s' ++ replicate (length s) '-' ++ "\n" -- where s' -- | last s == '\n' = s -- | otherwise = s ++ "\n" -- | Wrap a string in double quotes, and \-prefix any embedded single -- quotes, if it contains whitespace and is not already single- or -- double-quoted. quoteIfSpaced :: T.Text -> T.Text quoteIfSpaced s | isSingleQuoted s || isDoubleQuoted s = s | not $ any (`elem` (T.unpack s)) whitespacechars = s | otherwise = textQuoteIfNeeded s -- -- | Wrap a string in double quotes, and \-prefix any embedded single -- -- quotes, if it contains whitespace and is not already single- or -- -- double-quoted. -- quoteIfSpaced :: String -> String -- quoteIfSpaced s | isSingleQuoted s || isDoubleQuoted s = s -- | not $ any (`elem` s) whitespacechars = s -- | otherwise = "'"++escapeSingleQuotes s++"'" -- -- | Double-quote this string if it contains whitespace, single quotes -- -- or double-quotes, escaping the quotes as needed. textQuoteIfNeeded :: T.Text -> T.Text textQuoteIfNeeded s | any (`elem` T.unpack s) (quotechars++whitespacechars) = "\"" <> escapeDoubleQuotes s <> "\"" | otherwise = s -- -- | Single-quote this string if it contains whitespace or double-quotes. -- -- No good for strings containing single quotes. -- singleQuoteIfNeeded :: String -> String -- singleQuoteIfNeeded s | any (`elem` s) whitespacechars = "'"++s++"'" -- | otherwise = s quotechars, whitespacechars :: [Char] quotechars = "'\"" whitespacechars = " \t\n\r" escapeDoubleQuotes :: T.Text -> T.Text escapeDoubleQuotes = T.replace "\"" "\\\"" -- escapeSingleQuotes :: T.Text -> T.Text -- escapeSingleQuotes = T.replace "'" "\'" -- escapeQuotes :: String -> String -- escapeQuotes = regexReplace "([\"'])" "\\1" -- -- | Quote-aware version of words - don't split on spaces which are inside quotes. -- -- NB correctly handles "a'b" but not "''a''". Can raise an error if parsing fails. -- words' :: String -> [String] -- words' "" = [] -- words' s = map stripquotes $ fromparse $ parsewith p s -- where -- p = do ss <- (singleQuotedPattern <|> doubleQuotedPattern <|> pattern) `sepBy` many1 spacenonewline -- -- eof -- return ss -- pattern = many (noneOf whitespacechars) -- singleQuotedPattern = between (char '\'') (char '\'') (many $ noneOf "'") -- doubleQuotedPattern = between (char '"') (char '"') (many $ noneOf "\"") -- -- | Quote-aware version of unwords - single-quote strings which contain whitespace -- unwords' :: [Text] -> Text -- unwords' = T.unwords . map quoteIfNeeded -- | Strip one matching pair of single or double quotes on the ends of a string. stripquotes :: Text -> Text stripquotes s = if isSingleQuoted s || isDoubleQuoted s then T.init $ T.tail s else s isSingleQuoted :: Text -> Bool isSingleQuoted s = T.length (T.take 2 s) == 2 && T.head s == '\'' && T.last s == '\'' isDoubleQuoted :: Text -> Bool isDoubleQuoted s = T.length (T.take 2 s) == 2 && T.head s == '"' && T.last s == '"' textUnbracket :: Text -> Text textUnbracket s | (T.head s == '[' && T.last s == ']') || (T.head s == '(' && T.last s == ')') = T.init $ T.tail s | otherwise = s -- | Join several multi-line strings as side-by-side rectangular strings of the same height, top-padded. -- Treats wide characters as double width. textConcatTopPadded :: [Text] -> Text textConcatTopPadded ts = T.intercalate "\n" $ map T.concat $ transpose padded where lss = map T.lines ts :: [[Text]] h = maximum $ map length lss ypad ls = replicate (difforzero h (length ls)) "" ++ ls xpad ls = map (textPadLeftWide w) ls where w | null ls = 0 | otherwise = maximum $ map textWidth ls padded = map (xpad . ypad) lss :: [[Text]] -- -- | Join several multi-line strings as side-by-side rectangular strings of the same height, bottom-padded. -- -- Treats wide characters as double width. -- concatBottomPadded :: [String] -> String -- concatBottomPadded strs = intercalate "\n" $ map concat $ transpose padded -- where -- lss = map lines strs -- h = maximum $ map length lss -- ypad ls = ls ++ replicate (difforzero h (length ls)) "" -- xpad ls = map (padRightWide w) ls where w | null ls = 0 -- | otherwise = maximum $ map strWidth ls -- padded = map (xpad . ypad) lss -- -- | Join multi-line strings horizontally, after compressing each of -- -- them to a single line with a comma and space between each original line. -- concatOneLine :: [String] -> String -- concatOneLine strs = concat $ map ((intercalate ", ").lines) strs -- -- | Join strings vertically, left-aligned and right-padded. -- vConcatLeftAligned :: [String] -> String -- vConcatLeftAligned ss = intercalate "\n" $ map showfixedwidth ss -- where -- showfixedwidth = printf (printf "%%-%ds" width) -- width = maximum $ map length ss -- -- | Join strings vertically, right-aligned and left-padded. -- vConcatRightAligned :: [String] -> String -- vConcatRightAligned ss = intercalate "\n" $ map showfixedwidth ss -- where -- showfixedwidth = printf (printf "%%%ds" width) -- width = maximum $ map length ss -- -- | Convert a multi-line string to a rectangular string top-padded to the specified height. -- padtop :: Int -> String -> String -- padtop h s = intercalate "\n" xpadded -- where -- ls = lines s -- sh = length ls -- sw | null ls = 0 -- | otherwise = maximum $ map length ls -- ypadded = replicate (difforzero h sh) "" ++ ls -- xpadded = map (padleft sw) ypadded -- -- | Convert a multi-line string to a rectangular string bottom-padded to the specified height. -- padbottom :: Int -> String -> String -- padbottom h s = intercalate "\n" xpadded -- where -- ls = lines s -- sh = length ls -- sw | null ls = 0 -- | otherwise = maximum $ map length ls -- ypadded = ls ++ replicate (difforzero h sh) "" -- xpadded = map (padleft sw) ypadded difforzero :: (Num a, Ord a) => a -> a -> a difforzero a b = maximum [(a - b), 0] -- -- | Convert a multi-line string to a rectangular string left-padded to the specified width. -- -- Treats wide characters as double width. -- padleft :: Int -> String -> String -- padleft w "" = concat $ replicate w " " -- padleft w s = intercalate "\n" $ map (printf (printf "%%%ds" w)) $ lines s -- -- | Convert a multi-line string to a rectangular string right-padded to the specified width. -- -- Treats wide characters as double width. -- padright :: Int -> String -> String -- padright w "" = concat $ replicate w " " -- padright w s = intercalate "\n" $ map (printf (printf "%%-%ds" w)) $ lines s -- -- | Clip a multi-line string to the specified width and height from the top left. -- cliptopleft :: Int -> Int -> String -> String -- cliptopleft w h = intercalate "\n" . take h . map (take w) . lines -- -- | Clip and pad a multi-line string to fill the specified width and height. -- fitto :: Int -> Int -> String -> String -- fitto w h s = intercalate "\n" $ take h $ rows ++ repeat blankline -- where -- rows = map (fit w) $ lines s -- fit w = take w . (++ repeat ' ') -- blankline = replicate w ' ' -- -- Functions below treat wide (eg CJK) characters as double-width. -- | General-purpose wide-char-aware single-line text layout function. -- It can left- or right-pad a short string to a minimum width. -- It can left- or right-clip a long string to a maximum width, optionally inserting an ellipsis (the third argument). -- It clips and pads on the right when the fourth argument is true, otherwise on the left. -- It treats wide characters as double width. fitText :: Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text fitText mminwidth mmaxwidth ellipsify rightside = clip . pad where clip :: Text -> Text clip s = case mmaxwidth of Just w | textWidth s > w -> case rightside of True -> textTakeWidth (w - T.length ellipsis) s <> ellipsis False -> ellipsis <> T.reverse (textTakeWidth (w - T.length ellipsis) $ T.reverse s) | otherwise -> s where ellipsis = if ellipsify then ".." else "" Nothing -> s pad :: Text -> Text pad s = case mminwidth of Just w | sw < w -> case rightside of True -> s <> T.replicate (w - sw) " " False -> T.replicate (w - sw) " " <> s | otherwise -> s Nothing -> s where sw = textWidth s -- -- | A version of fitString that works on multi-line strings, -- -- separate for now to avoid breakage. -- -- This will rewrite any line endings to unix newlines. -- fitStringMulti :: Maybe Int -> Maybe Int -> Bool -> Bool -> String -> String -- fitStringMulti mminwidth mmaxwidth ellipsify rightside s = -- (intercalate "\n" . map (fitString mminwidth mmaxwidth ellipsify rightside) . lines) s -- | Left-pad a text to the specified width. -- Treats wide characters as double width. -- Works on multi-line texts too (but will rewrite non-unix line endings). textPadLeftWide :: Int -> Text -> Text textPadLeftWide w "" = T.replicate w " " textPadLeftWide w s = T.intercalate "\n" $ map (fitText (Just w) Nothing False False) $ T.lines s -- XXX not yet replaceable by -- padLeftWide w = fitStringMulti (Just w) Nothing False False -- | Right-pad a string to the specified width. -- Treats wide characters as double width. -- Works on multi-line strings too (but will rewrite non-unix line endings). textPadRightWide :: Int -> Text -> Text textPadRightWide w "" = T.replicate w " " textPadRightWide w s = T.intercalate "\n" $ map (fitText (Just w) Nothing False True) $ T.lines s -- XXX not yet replaceable by -- padRightWide w = fitStringMulti (Just w) Nothing False True -- | Double-width-character-aware string truncation. Take as many -- characters as possible from a string without exceeding the -- specified width. Eg textTakeWidth 3 "りんご" = "り". textTakeWidth :: Int -> Text -> Text textTakeWidth _ "" = "" textTakeWidth 0 _ = "" textTakeWidth w t | not (T.null t), let c = T.head t, let cw = charWidth c, cw <= w = T.cons c $ textTakeWidth (w-cw) (T.tail t) | otherwise = "" -- -- from Pandoc (copyright John MacFarlane, GPL) -- -- see also http://unicode.org/reports/tr11/#Description -- | Calculate the designated render width of a string, taking into -- account wide characters and line breaks (the longest line within a -- multi-line string determines the width ). textWidth :: Text -> Int textWidth "" = 0 textWidth s = maximum $ map (T.foldr (\a b -> charWidth a + b) 0) $ T.lines s -- -- | Get the designated render width of a character: 0 for a combining -- -- character, 1 for a regular character, 2 for a wide character. -- -- (Wide characters are rendered as exactly double width in apps and -- -- fonts that support it.) (From Pandoc.) -- charWidth :: Char -> Int -- charWidth c = -- case c of -- _ | c < '\x0300' -> 1 -- | c >= '\x0300' && c <= '\x036F' -> 0 -- combining -- | c >= '\x0370' && c <= '\x10FC' -> 1 -- | c >= '\x1100' && c <= '\x115F' -> 2 -- | c >= '\x1160' && c <= '\x11A2' -> 1 -- | c >= '\x11A3' && c <= '\x11A7' -> 2 -- | c >= '\x11A8' && c <= '\x11F9' -> 1 -- | c >= '\x11FA' && c <= '\x11FF' -> 2 -- | c >= '\x1200' && c <= '\x2328' -> 1 -- | c >= '\x2329' && c <= '\x232A' -> 2 -- | c >= '\x232B' && c <= '\x2E31' -> 1 -- | c >= '\x2E80' && c <= '\x303E' -> 2 -- | c == '\x303F' -> 1 -- | c >= '\x3041' && c <= '\x3247' -> 2 -- | c >= '\x3248' && c <= '\x324F' -> 1 -- ambiguous -- | c >= '\x3250' && c <= '\x4DBF' -> 2 -- | c >= '\x4DC0' && c <= '\x4DFF' -> 1 -- | c >= '\x4E00' && c <= '\xA4C6' -> 2 -- | c >= '\xA4D0' && c <= '\xA95F' -> 1 -- | c >= '\xA960' && c <= '\xA97C' -> 2 -- | c >= '\xA980' && c <= '\xABF9' -> 1 -- | c >= '\xAC00' && c <= '\xD7FB' -> 2 -- | c >= '\xD800' && c <= '\xDFFF' -> 1 -- | c >= '\xE000' && c <= '\xF8FF' -> 1 -- ambiguous -- | c >= '\xF900' && c <= '\xFAFF' -> 2 -- | c >= '\xFB00' && c <= '\xFDFD' -> 1 -- | c >= '\xFE00' && c <= '\xFE0F' -> 1 -- ambiguous -- | c >= '\xFE10' && c <= '\xFE19' -> 2 -- | c >= '\xFE20' && c <= '\xFE26' -> 1 -- | c >= '\xFE30' && c <= '\xFE6B' -> 2 -- | c >= '\xFE70' && c <= '\xFEFF' -> 1 -- | c >= '\xFF01' && c <= '\xFF60' -> 2 -- | c >= '\xFF61' && c <= '\x16A38' -> 1 -- | c >= '\x1B000' && c <= '\x1B001' -> 2 -- | c >= '\x1D000' && c <= '\x1F1FF' -> 1 -- | c >= '\x1F200' && c <= '\x1F251' -> 2 -- | c >= '\x1F300' && c <= '\x1F773' -> 1 -- | c >= '\x20000' && c <= '\x3FFFD' -> 2 -- | otherwise -> 1 -- | Read a decimal number from a Text. Assumes the input consists only of digit -- characters. readDecimal :: Text -> Integer readDecimal = foldl' step 0 . T.unpack where step a c = a * 10 + toInteger (digitToInt c) tests_Text = tests "Text" [ test "quoteIfSpaced" $ do quoteIfSpaced "a'a" @?= "a'a" quoteIfSpaced "a\"a" @?= "a\"a" quoteIfSpaced "a a" @?= "\"a a\"" quoteIfSpaced "mimi's cafe" @?= "\"mimi's cafe\"" quoteIfSpaced "\"alex\" cafe" @?= "\"\\\"alex\\\" cafe\"" quoteIfSpaced "le'shan's cafe" @?= "\"le'shan's cafe\"" quoteIfSpaced "\"be'any's\" cafe" @?= "\"\\\"be'any's\\\" cafe\"" ] hledger-lib-1.19.1/Hledger/Utils/Tree.hs0000644000000000000000000000133013723502755016062 0ustar0000000000000000module Hledger.Utils.Tree ( FastTree(..) , treeFromPaths ) where -- import Data.Char import Data.List (foldl') import qualified Data.Map as M -- | An efficient-to-build tree suggested by Cale Gibbard, probably -- better than accountNameTreeFrom. newtype FastTree a = T (M.Map a (FastTree a)) deriving (Show, Eq, Ord) emptyTree :: FastTree a emptyTree = T M.empty mergeTrees :: (Ord a) => FastTree a -> FastTree a -> FastTree a mergeTrees (T m) (T m') = T (M.unionWith mergeTrees m m') treeFromPath :: [a] -> FastTree a treeFromPath [] = T M.empty treeFromPath (x:xs) = T (M.singleton x (treeFromPath xs)) treeFromPaths :: (Ord a) => [[a]] -> FastTree a treeFromPaths = foldl' mergeTrees emptyTree . map treeFromPath hledger-lib-1.19.1/Hledger/Utils/UTF8IOCompat.hs0000644000000000000000000000554013712635747017322 0ustar0000000000000000{-# LANGUAGE CPP #-} {- | UTF-8 aware string IO functions that will work across multiple platforms and GHC versions. Includes code from Text.Pandoc.UTF8 ((C) 2010 John MacFarlane). Example usage: import Prelude hiding (readFile,writeFile,appendFile,getContents,putStr,putStrLn) import UTF8IOCompat (readFile,writeFile,appendFile,getContents,putStr,putStrLn) import UTF8IOCompat (SystemString,fromSystemString,toSystemString,error',userError') 2013/4/10 update: we now trust that current GHC versions & platforms do the right thing, so this file is a no-op and on its way to being removed. Not carefully tested. 2019/10/20 update: all packages have base>=4.9 which corresponds to GHC v8.0.1 and higher. Tear this file apart! -} -- TODO obsolete ? module Hledger.Utils.UTF8IOCompat ( readFile, writeFile, appendFile, getContents, hGetContents, putStr, putStrLn, hPutStr, hPutStrLn, -- error', userError', usageError, ) where -- import Control.Monad (liftM) -- import qualified Data.ByteString.Lazy as B -- import qualified Data.ByteString.Lazy.Char8 as B8 -- import qualified Data.ByteString.Lazy.UTF8 as U8 (toString, fromString) import Prelude hiding (readFile, writeFile, appendFile, getContents, putStr, putStrLn) import System.IO -- (Handle) -- bom :: B.ByteString -- bom = B.pack [0xEF, 0xBB, 0xBF] -- stripBOM :: B.ByteString -> B.ByteString -- stripBOM s | bom `B.isPrefixOf` s = B.drop 3 s -- stripBOM s = s -- readFile :: FilePath -> IO String -- readFile = liftM (U8.toString . stripBOM) . B.readFile -- writeFile :: FilePath -> String -> IO () -- writeFile f = B.writeFile f . U8.fromString -- appendFile :: FilePath -> String -> IO () -- appendFile f = B.appendFile f . U8.fromString -- getContents :: IO String -- getContents = liftM (U8.toString . stripBOM) B.getContents -- hGetContents :: Handle -> IO String -- hGetContents h = liftM (U8.toString . stripBOM) (B.hGetContents h) -- putStr :: String -> IO () -- putStr = bs_putStr . U8.fromString -- putStrLn :: String -> IO () -- putStrLn = bs_putStrLn . U8.fromString -- hPutStr :: Handle -> String -> IO () -- hPutStr h = bs_hPutStr h . U8.fromString -- hPutStrLn :: Handle -> String -> IO () -- hPutStrLn h = bs_hPutStrLn h . U8.fromString -- -- span GHC versions including 6.12.3 - 7.4.1: -- bs_putStr = B8.putStr -- bs_putStrLn = B8.putStrLn -- bs_hPutStr = B8.hPut -- bs_hPutStrLn h bs = B8.hPut h bs >> B8.hPut h (B.singleton 0x0a) -- | A SystemString-aware version of error. error' :: String -> a error' = #if __GLASGOW_HASKELL__ < 800 -- (easier than if base < 4.9) error #else errorWithoutStackTrace #endif -- | A SystemString-aware version of userError. userError' :: String -> IOError userError' = userError -- | A SystemString-aware version of error that adds a usage hint. usageError :: String -> a usageError = error' . (++ " (use -h to see usage)") hledger-lib-1.19.1/Text/Tabular/AsciiWide.hs0000644000000000000000000001543713700101030016655 0ustar0000000000000000-- | Text.Tabular.AsciiArt from tabular-0.2.2.7, modified to treat -- wide characters as double width. module Text.Tabular.AsciiWide where import Data.List (intersperse, transpose) import Text.Tabular import Hledger.Utils.String -- | for simplicity, we assume that each cell is rendered -- on a single line render :: Bool -- ^ pretty tables -> (rh -> String) -> (ch -> String) -> (a -> String) -> Table rh ch a -> String render pretty fr fc f (Table rh ch cells) = unlines $ [ bar VT SingleLine -- +--------------------------------------+ , renderColumns pretty sizes ch2 , bar VM DoubleLine -- +======================================+ ] ++ (renderRs $ fmap renderR $ zipHeader [] cells $ fmap fr rh) ++ [ bar VB SingleLine ] -- +--------------------------------------+ where bar vpos prop = concat (renderHLine vpos pretty sizes ch2 prop) -- ch2 and cell2 include the row and column labels ch2 = Group DoubleLine [Header "", fmap fc ch] cells2 = headerContents ch2 : zipWith (\h cs -> h : map f cs) rhStrings cells -- renderR (cs,h) = renderColumns pretty sizes $ Group DoubleLine [ Header h , fmap fst $ zipHeader "" (map f cs) ch] rhStrings = map fr $ headerContents rh -- maximum width for each column sizes = map (maximum . map strWidth) . transpose $ cells2 renderRs (Header s) = [s] renderRs (Group p hs) = concat . intersperse sep . map renderRs $ hs where sep = renderHLine VM pretty sizes ch2 p verticalBar :: Bool -> Char verticalBar pretty = if pretty then '│' else '|' leftBar :: Bool -> String leftBar pretty = verticalBar pretty : " " rightBar :: Bool -> String rightBar pretty = " " ++ [verticalBar pretty] midBar :: Bool -> String midBar pretty = " " ++ verticalBar pretty : " " doubleMidBar :: Bool -> String doubleMidBar pretty = if pretty then " ║ " else " || " -- | We stop rendering on the shortest list! renderColumns :: Bool -- ^ pretty -> [Int] -- ^ max width for each column -> Header String -> String renderColumns pretty is h = leftBar pretty ++ coreLine ++ rightBar pretty where coreLine = concatMap helper $ flattenHeader $ zipHeader 0 is h helper = either hsep (uncurry padLeftWide) hsep :: Properties -> String hsep NoLine = " " hsep SingleLine = midBar pretty hsep DoubleLine = doubleMidBar pretty renderHLine :: VPos -> Bool -- ^ pretty -> [Int] -- ^ width specifications -> Header String -> Properties -> [String] renderHLine _ _ _ _ NoLine = [] renderHLine vpos pretty w h prop = [renderHLine' vpos pretty prop w h] renderHLine' :: VPos -> Bool -> Properties -> [Int] -> Header String -> String renderHLine' vpos pretty prop is h = edge HL ++ sep ++ coreLine ++ sep ++ edge HR where edge hpos = boxchar vpos hpos SingleLine prop pretty coreLine = concatMap helper $ flattenHeader $ zipHeader 0 is h helper = either vsep dashes dashes (i,_) = concat (replicate i sep) sep = boxchar vpos HM NoLine prop pretty vsep v = case v of NoLine -> sep ++ sep _ -> sep ++ cross v prop ++ sep cross v h = boxchar vpos HM v h pretty data VPos = VT | VM | VB -- top middle bottom data HPos = HL | HM | HR -- left middle right boxchar :: VPos -> HPos -> Properties -> Properties -> Bool -> String boxchar vpos hpos vert horiz = lineart u d l r where u = case vpos of VT -> NoLine _ -> vert d = case vpos of VB -> NoLine _ -> vert l = case hpos of HL -> NoLine _ -> horiz r = case hpos of HR -> NoLine _ -> horiz pick :: String -> String -> Bool -> String pick x _ True = x pick _ x False = x lineart :: Properties -> Properties -> Properties -> Properties -> Bool -> String -- up down left right lineart SingleLine SingleLine SingleLine SingleLine = pick "┼" "+" lineart SingleLine SingleLine SingleLine NoLine = pick "┤" "+" lineart SingleLine SingleLine NoLine SingleLine = pick "├" "+" lineart SingleLine NoLine SingleLine SingleLine = pick "┴" "+" lineart NoLine SingleLine SingleLine SingleLine = pick "┬" "+" lineart SingleLine NoLine NoLine SingleLine = pick "└" "+" lineart SingleLine NoLine SingleLine NoLine = pick "┘" "+" lineart NoLine SingleLine SingleLine NoLine = pick "┐" "+" lineart NoLine SingleLine NoLine SingleLine = pick "┌" "+" lineart SingleLine SingleLine NoLine NoLine = pick "│" "|" lineart NoLine NoLine SingleLine SingleLine = pick "─" "-" lineart DoubleLine DoubleLine DoubleLine DoubleLine = pick "╬" "++" lineart DoubleLine DoubleLine DoubleLine NoLine = pick "╣" "++" lineart DoubleLine DoubleLine NoLine DoubleLine = pick "╠" "++" lineart DoubleLine NoLine DoubleLine DoubleLine = pick "╩" "++" lineart NoLine DoubleLine DoubleLine DoubleLine = pick "╦" "++" lineart DoubleLine NoLine NoLine DoubleLine = pick "╚" "++" lineart DoubleLine NoLine DoubleLine NoLine = pick "╝" "++" lineart NoLine DoubleLine DoubleLine NoLine = pick "╗" "++" lineart NoLine DoubleLine NoLine DoubleLine = pick "╔" "++" lineart DoubleLine DoubleLine NoLine NoLine = pick "║" "||" lineart NoLine NoLine DoubleLine DoubleLine = pick "═" "=" lineart DoubleLine NoLine NoLine SingleLine = pick "╙" "++" lineart DoubleLine NoLine SingleLine NoLine = pick "╜" "++" lineart NoLine DoubleLine SingleLine NoLine = pick "╖" "++" lineart NoLine DoubleLine NoLine SingleLine = pick "╓" "++" lineart SingleLine NoLine NoLine DoubleLine = pick "╘" "+" lineart SingleLine NoLine DoubleLine NoLine = pick "╛" "+" lineart NoLine SingleLine DoubleLine NoLine = pick "╕" "+" lineart NoLine SingleLine NoLine DoubleLine = pick "╒" "+" lineart DoubleLine DoubleLine SingleLine NoLine = pick "╢" "++" lineart DoubleLine DoubleLine NoLine SingleLine = pick "╟" "++" lineart DoubleLine NoLine SingleLine SingleLine = pick "╨" "++" lineart NoLine DoubleLine SingleLine SingleLine = pick "╥" "++" lineart SingleLine SingleLine DoubleLine NoLine = pick "╡" "+" lineart SingleLine SingleLine NoLine DoubleLine = pick "╞" "+" lineart SingleLine NoLine DoubleLine DoubleLine = pick "╧" "+" lineart NoLine SingleLine DoubleLine DoubleLine = pick "╤" "+" lineart SingleLine SingleLine DoubleLine DoubleLine = pick "╪" "+" lineart DoubleLine DoubleLine SingleLine SingleLine = pick "╫" "++" lineart _ _ _ _ = const "" -- hledger-lib-1.19.1/Text/Megaparsec/Custom.hs0000644000000000000000000003575113700101030016744 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -- new {-# LANGUAGE LambdaCase #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} -- new module Text.Megaparsec.Custom ( -- * Custom parse error type CustomErr, -- * Failing with an arbitrary source position parseErrorAt, parseErrorAtRegion, -- * Re-parsing SourceExcerpt, getExcerptText, excerpt_, reparseExcerpt, -- * Pretty-printing custom parse errors customErrorBundlePretty, -- * "Final" parse errors FinalParseError, FinalParseError', FinalParseErrorBundle, FinalParseErrorBundle', -- * Constructing "final" parse errors finalError, finalFancyFailure, finalFail, finalCustomFailure, -- * Pretty-printing "final" parse errors finalErrorBundlePretty, attachSource, -- * Handling parse errors from include files with "final" parse errors parseIncludeFile, ) where import Prelude () import "base-compat-batteries" Prelude.Compat hiding (readFile) import Control.Monad.Except import Control.Monad.State.Strict (StateT, evalStateT) import Data.Foldable (asum, toList) import qualified Data.List.NonEmpty as NE import qualified Data.Set as S import Data.Text (Text) import Text.Megaparsec --- * Custom parse error type -- | A custom error type for the parser. The type is specialized to -- parsers of 'Text' streams. data CustomErr -- | Fail with a message at a specific source position interval. The -- interval must be contained within a single line. = ErrorFailAt Int -- Starting offset Int -- Ending offset String -- Error message -- | Re-throw parse errors obtained from the "re-parsing" of an excerpt -- of the source text. | ErrorReparsing (NE.NonEmpty (ParseError Text CustomErr)) -- Source fragment parse errors deriving (Show, Eq, Ord) -- We require an 'Ord' instance for 'CustomError' so that they may be -- stored in a 'Set'. The actual instance is inconsequential, so we just -- derive it, but the derived instance requires an (orphan) instance for -- 'ParseError'. Hopefully this does not cause any trouble. deriving instance Ord (ParseError Text CustomErr) -- Note: the pretty-printing of our 'CustomErr' type is only partally -- defined in its 'ShowErrorComponent' instance; we perform additional -- adjustments in 'customErrorBundlePretty'. instance ShowErrorComponent CustomErr where showErrorComponent (ErrorFailAt _ _ errMsg) = errMsg showErrorComponent (ErrorReparsing _) = "" -- dummy value errorComponentLen (ErrorFailAt startOffset endOffset _) = endOffset - startOffset errorComponentLen (ErrorReparsing _) = 1 -- dummy value --- * Failing with an arbitrary source position -- | Fail at a specific source position, given by the raw offset from the -- start of the input stream (the number of tokens processed at that -- point). parseErrorAt :: Int -> String -> CustomErr parseErrorAt offset msg = ErrorFailAt offset (offset+1) msg -- | Fail at a specific source interval, given by the raw offsets of its -- endpoints from the start of the input stream (the numbers of tokens -- processed at those points). -- -- Note that care must be taken to ensure that the specified interval does -- not span multiple lines of the input source. This will not be checked. parseErrorAtRegion :: Int -- ^ Start offset -> Int -- ^ End end offset -> String -- ^ Error message -> CustomErr parseErrorAtRegion startOffset endOffset msg = if startOffset < endOffset then ErrorFailAt startOffset endOffset msg else ErrorFailAt startOffset (startOffset+1) msg --- * Re-parsing -- | A fragment of source suitable for "re-parsing". The purpose of this -- data type is to preserve the content and source position of the excerpt -- so that parse errors raised during "re-parsing" may properly reference -- the original source. data SourceExcerpt = SourceExcerpt Int -- Offset of beginning of excerpt Text -- Fragment of source file -- | Get the raw text of a source excerpt. getExcerptText :: SourceExcerpt -> Text getExcerptText (SourceExcerpt _ txt) = txt -- | 'excerpt_ p' applies the given parser 'p' and extracts the portion of -- the source consumed by 'p', along with the source position of this -- portion. This is the only way to create a source excerpt suitable for -- "re-parsing" by 'reparseExcerpt'. -- This function could be extended to return the result of 'p', but we don't -- currently need this. excerpt_ :: MonadParsec CustomErr Text m => m a -> m SourceExcerpt excerpt_ p = do offset <- getOffset (!txt, _) <- match p pure $ SourceExcerpt offset txt -- | 'reparseExcerpt s p' "re-parses" the source excerpt 's' using the -- parser 'p'. Parse errors raised by 'p' will be re-thrown at the source -- position of the source excerpt. -- -- In order for the correct source file to be displayed when re-throwing -- parse errors, we must ensure that the source file during the use of -- 'reparseExcerpt s p' is the same as that during the use of 'excerpt_' -- that generated the source excerpt 's'. However, we can usually expect -- this condition to be satisfied because, at the time of writing, the -- only changes of source file in the codebase take place through include -- files, and the parser for include files neither accepts nor returns -- 'SourceExcerpt's. reparseExcerpt :: Monad m => SourceExcerpt -> ParsecT CustomErr Text m a -> ParsecT CustomErr Text m a reparseExcerpt (SourceExcerpt offset txt) p = do (_, res) <- lift $ runParserT' p (offsetInitialState offset txt) case res of Right result -> pure result Left errBundle -> customFailure $ ErrorReparsing $ bundleErrors errBundle where offsetInitialState :: Int -> s -> #if MIN_VERSION_megaparsec(8,0,0) State s e #else State s #endif offsetInitialState initialOffset s = State { stateInput = s , stateOffset = initialOffset , statePosState = PosState { pstateInput = s , pstateOffset = initialOffset , pstateSourcePos = initialPos "" , pstateTabWidth = defaultTabWidth , pstateLinePrefix = "" } #if MIN_VERSION_megaparsec(8,0,0) , stateParseErrors = [] #endif } --- * Pretty-printing custom parse errors -- | Pretty-print our custom parse errors. It is necessary to use this -- instead of 'errorBundlePretty' when custom parse errors are thrown. -- -- This function intercepts our custom parse errors and applies final -- adjustments ('finalizeCustomError') before passing them to -- 'errorBundlePretty'. These adjustments are part of the implementation -- of the behaviour of our custom parse errors. -- -- Note: We must ensure that the offset of the 'PosState' of the provided -- 'ParseErrorBundle' is no larger than the offset specified by a -- 'ErrorFailAt' constructor. This is guaranteed if this offset is set to -- 0 (that is, the beginning of the source file), which is the -- case for 'ParseErrorBundle's returned from 'runParserT'. customErrorBundlePretty :: ParseErrorBundle Text CustomErr -> String customErrorBundlePretty errBundle = let errBundle' = errBundle { bundleErrors = NE.sortWith errorOffset $ -- megaparsec requires that the list of errors be sorted by their offsets bundleErrors errBundle >>= finalizeCustomError } in errorBundlePretty errBundle' where finalizeCustomError :: ParseError Text CustomErr -> NE.NonEmpty (ParseError Text CustomErr) finalizeCustomError err = case findCustomError err of Nothing -> pure err Just errFailAt@(ErrorFailAt startOffset _ _) -> -- Adjust the offset pure $ FancyError startOffset $ S.singleton $ ErrorCustom errFailAt Just (ErrorReparsing errs) -> -- Extract and finalize the inner errors errs >>= finalizeCustomError -- If any custom errors are present, arbitrarily take the first one -- (since only one custom error should be used at a time). findCustomError :: ParseError Text CustomErr -> Maybe CustomErr findCustomError err = case err of FancyError _ errSet -> finds (\case {ErrorCustom e -> Just e; _ -> Nothing}) errSet _ -> Nothing finds :: (Foldable t) => (a -> Maybe b) -> t a -> Maybe b finds f = asum . map f . toList --- * "Final" parse errors -- -- | A type representing "final" parse errors that cannot be backtracked -- from and are guaranteed to halt parsing. The anti-backtracking -- behaviour is implemented by an 'ExceptT' layer in the parser's monad -- stack, using this type as the 'ExceptT' error type. -- -- We have three goals for this type: -- (1) it should be possible to convert any parse error into a "final" -- parse error, -- (2) it should be possible to take a parse error thrown from an include -- file and re-throw it in the parent file, and -- (3) the pretty-printing of "final" parse errors should be consistent -- with that of ordinary parse errors, but should also report a stack of -- files for errors thrown from include files. -- -- In order to pretty-print a "final" parse error (goal 3), it must be -- bundled with include filepaths and its full source text. When a "final" -- parse error is thrown from within a parser, we do not have access to -- the full source, so we must hold the parse error until it can be joined -- with its source (and include filepaths, if it was thrown from an -- include file) by the parser's caller. -- -- A parse error with include filepaths and its full source text is -- represented by the 'FinalParseErrorBundle' type, while a parse error in -- need of either include filepaths, full source text, or both is -- represented by the 'FinalParseError' type. data FinalParseError' e -- a parse error thrown as a "final" parse error = FinalError (ParseError Text e) -- a parse error obtained from running a parser, e.g. using 'runParserT' | FinalBundle (ParseErrorBundle Text e) -- a parse error thrown from an include file | FinalBundleWithStack (FinalParseErrorBundle' e) deriving (Show) type FinalParseError = FinalParseError' CustomErr -- We need a 'Monoid' instance for 'FinalParseError' so that 'ExceptT -- FinalParseError m' is an instance of Alternative and MonadPlus, which -- is needed to use some parser combinators, e.g. 'many'. -- -- This monoid instance simply takes the first (left-most) error. instance Semigroup (FinalParseError' e) where e <> _ = e instance Monoid (FinalParseError' e) where mempty = FinalError $ FancyError 0 $ S.singleton (ErrorFail "default parse error") mappend = (<>) -- | A type bundling a 'ParseError' with its full source text, filepath, -- and stack of include files. Suitable for pretty-printing. -- -- Megaparsec's 'ParseErrorBundle' type already bundles a parse error with -- its full source text and filepath, so we just add a stack of include -- files. data FinalParseErrorBundle' e = FinalParseErrorBundle' { finalErrorBundle :: ParseErrorBundle Text e , includeFileStack :: [FilePath] } deriving (Show) type FinalParseErrorBundle = FinalParseErrorBundle' CustomErr --- * Constructing and throwing final parse errors -- | Convert a "regular" parse error into a "final" parse error. finalError :: ParseError Text e -> FinalParseError' e finalError = FinalError -- | Like megaparsec's 'fancyFailure', but as a "final" parse error. finalFancyFailure :: (MonadParsec e s m, MonadError (FinalParseError' e) m) => S.Set (ErrorFancy e) -> m a finalFancyFailure errSet = do offset <- getOffset throwError $ FinalError $ FancyError offset errSet -- | Like 'fail', but as a "final" parse error. finalFail :: (MonadParsec e s m, MonadError (FinalParseError' e) m) => String -> m a finalFail = finalFancyFailure . S.singleton . ErrorFail -- | Like megaparsec's 'customFailure', but as a "final" parse error. finalCustomFailure :: (MonadParsec e s m, MonadError (FinalParseError' e) m) => e -> m a finalCustomFailure = finalFancyFailure . S.singleton . ErrorCustom --- * Pretty-printing "final" parse errors -- | Pretty-print a "final" parse error: print the stack of include files, -- then apply the pretty-printer for parse error bundles. Note that -- 'attachSource' must be used on a "final" parse error before it can be -- pretty-printed. finalErrorBundlePretty :: FinalParseErrorBundle' CustomErr -> String finalErrorBundlePretty bundle = concatMap showIncludeFilepath (includeFileStack bundle) <> customErrorBundlePretty (finalErrorBundle bundle) where showIncludeFilepath path = "in file included from " <> path <> ",\n" -- | Supply a filepath and source text to a "final" parse error so that it -- can be pretty-printed. You must ensure that you provide the appropriate -- source text and filepath. attachSource :: FilePath -> Text -> FinalParseError' e -> FinalParseErrorBundle' e attachSource filePath sourceText finalParseError = case finalParseError of -- A parse error thrown directly with the 'FinalError' constructor -- requires both source and filepath. FinalError parseError -> let bundle = ParseErrorBundle { bundleErrors = parseError NE.:| [] , bundlePosState = initialPosState filePath sourceText } in FinalParseErrorBundle' { finalErrorBundle = bundle , includeFileStack = [] } -- A 'ParseErrorBundle' already has the appropriate source and filepath -- and so needs neither. FinalBundle peBundle -> FinalParseErrorBundle' { finalErrorBundle = peBundle , includeFileStack = [] } -- A parse error from a 'FinalParseErrorBundle' was thrown from an -- include file, so we add the filepath to the stack. FinalBundleWithStack fpeBundle -> fpeBundle { includeFileStack = filePath : includeFileStack fpeBundle } --- * Handling parse errors from include files with "final" parse errors -- | Parse a file with the given parser and initial state, discarding the -- final state and re-throwing any parse errors as "final" parse errors. parseIncludeFile :: Monad m => StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a -> st -> FilePath -> Text -> StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a parseIncludeFile parser initialState filepath text = catchError parser' handler where parser' = do eResult <- lift $ lift $ runParserT (evalStateT parser initialState) filepath text case eResult of Left parseErrorBundle -> throwError $ FinalBundle parseErrorBundle Right result -> pure result -- Attach source and filepath of the include file to its parse errors handler e = throwError $ FinalBundleWithStack $ attachSource filepath text e --- * Helpers -- Like megaparsec's 'initialState', but instead for 'PosState'. Used when -- constructing 'ParseErrorBundle's. The values for "tab width" and "line -- prefix" are taken from 'initialState'. initialPosState :: FilePath -> Text -> PosState Text initialPosState filePath sourceText = PosState { pstateInput = sourceText , pstateOffset = 0 , pstateSourcePos = initialPos filePath , pstateTabWidth = defaultTabWidth , pstateLinePrefix = "" } hledger-lib-1.19.1/test/unittest.hs0000644000000000000000000000072213722544246015353 0ustar0000000000000000{- Run the hledger-lib package's unit tests using the tasty test runner. -} -- package-qualified import to avoid cabal missing-home-modules warning (and double-building ?) {-# LANGUAGE PackageImports #-} import "hledger-lib" Hledger (tests_Hledger) import System.Environment (setEnv) import Test.Tasty (defaultMain) main :: IO () main = do setEnv "TASTY_HIDE_SUCCESSES" "true" setEnv "TASTY_ANSI_TRICKS" "false" -- helps the above defaultMain tests_Hledger hledger-lib-1.19.1/test/doctests.hs0000644000000000000000000000367113722544246015332 0ustar0000000000000000{- Run doctests in Hledger source files under the current directory (./Hledger.hs, ./Hledger/**, ./Text/**) using the doctest runner. Arguments are case-insensitive file path substrings, to limit the files searched. --verbose shows files being searched for doctests and progress while running. --slow reloads ghci between each test (https://github.com/sol/doctest#a-note-on-performance). Eg, in hledger source dir: $ make ghci-doctest, :main [--verbose] [--slow] [CIFILEPATHSUBSTRINGS] or: $ stack test hledger-lib:test:doctests [--test-arguments '[--verbose] [--slow] [CIFILEPATHSUBSTRINGS]'] -} -- This file can't be called doctest.hs ("File name does not match module name") {-# LANGUAGE PackageImports #-} import Control.Monad import Data.Char import Data.List import System.Environment import "Glob" System.FilePath.Glob import Test.DocTest main :: IO () main = do args <- getArgs let verbose = "--verbose" `elem` args slow = "--slow" `elem` args pats = filter (not . ("-" `isPrefixOf`)) args -- find source files sourcefiles <- (filter (not . isInfixOf "/.") . concat) <$> sequence [ glob "Hledger.hs" ,glob "Hledger/**/*.hs" ,glob "Text/**/*.hs" ] -- filter by patterns (case insensitive infix substring match) let fs | null pats = sourcefiles | otherwise = [f | f <- sourcefiles, let f' = map toLower f, any (`isInfixOf` f') pats'] where pats' = map (map toLower) pats fslen = length fs if (null fs) then do putStrLn $ "No file paths found matching: " ++ unwords pats else do putStrLn $ "Loading and searching for doctests in " ++ show fslen ++ if fslen > 1 then " files, plus any files they import:" else " file, plus any files it imports:" when verbose $ putStrLn $ unwords fs doctest $ (if verbose then ("--verbose" :) else id) $ -- doctest >= 0.15.0 (if slow then id else ("--fast" :)) $ -- doctest >= 0.11.4 fs hledger-lib-1.19.1/LICENSE0000644000000000000000000010451313302271455013162 0ustar0000000000000000 GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The GNU General Public License is a free, copyleft license for software and other kinds of works. The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change all versions of a program--to make sure it remains free software for all its users. We, the Free Software Foundation, use the GNU General Public License for most of our software; it applies also to any other work released this way by its authors. You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for them if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. To protect your rights, we need to prevent others from denying you these rights or asking you to surrender the rights. Therefore, you have certain responsibilities if you distribute copies of the software, or if you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same freedoms that you received. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. Developers that use the GNU GPL protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License giving you legal permission to copy, distribute and/or modify it. For the developers' and authors' protection, the GPL clearly explains that there is no warranty for this free software. For both users' and authors' sake, the GPL requires that modified versions be marked as changed, so that their problems will not be attributed erroneously to authors of previous versions. Some devices are designed to deny users access to install or run modified versions of the software inside them, although the manufacturer can do so. This is fundamentally incompatible with the aim of protecting users' freedom to change the software. The systematic pattern of such abuse occurs in the area of products for individuals to use, which is precisely where it is most unacceptable. Therefore, we have designed this version of the GPL to prohibit the practice for those products. If such problems arise substantially in other domains, we stand ready to extend this provision to those domains in future versions of the GPL, as needed to protect the freedom of users. Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of software on general-purpose computers, but in those that do, we wish to avoid the special danger that patents applied to a free program could make it effectively proprietary. To prevent this, the GPL assures that patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. TERMS AND CONDITIONS 0. Definitions. "This License" refers to version 3 of the GNU General Public License. "Copyright" also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. "The Program" refers to any copyrightable work licensed under this License. Each licensee is addressed as "you". "Licensees" and "recipients" may be individuals or organizations. To "modify" a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a "modified version" of the earlier work or a work "based on" the earlier work. A "covered work" means either the unmodified Program or a work based on the Program. To "propagate" a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. To "convey" a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. An interactive user interface displays "Appropriate Legal Notices" to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. 1. Source Code. The "source code" for a work means the preferred form of the work for making modifications to it. "Object code" means any non-source form of a work. A "Standard Interface" means an interface that either is an official standard defined by a recognized standards body, or, in the case of interfaces specified for a particular programming language, one that is widely used among developers working in that language. The "System Libraries" of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that Major Component, and (b) serves only to enable use of the work with that Major Component, or to implement a Standard Interface for which an implementation is available to the public in source code form. A "Major Component", in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code interpreter used to run it. The "Corresponding Source" for a work in object code form means all the source code needed to generate, install, and (for an executable work) run the object code and to modify the work, including scripts to control those activities. However, it does not include the work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, Corresponding Source includes interface definition files associated with source files for the work, and the source code for shared libraries and dynamically linked subprograms that the work is specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. The Corresponding Source need not include anything that users can regenerate automatically from other parts of the Corresponding Source. The Corresponding Source for a work in source code form is that same work. 2. Basic Permissions. All rights granted under this License are granted for the term of copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running a covered work is covered by this License only if the output, given its content, constitutes a covered work. This License acknowledges your rights of fair use or other equivalent, as provided by copyright law. You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the sole purpose of having them make modifications exclusively for you, or provide you with facilities for running those works, provided that you comply with the terms of this License in conveying all material for which you do not control copyright. Those thus making or running the covered works for you must do so exclusively on your behalf, under your direction and control, on terms that prohibit them from making any copies of your copyrighted material outside their relationship with you. Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 3. Protecting Users' Legal Rights From Anti-Circumvention Law. No covered work shall be deemed part of an effective technological measure under any applicable law fulfilling obligations under article 11 of the WIPO copyright treaty adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention of such measures. When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License with respect to the covered work, and you disclaim any intention to limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. 4. Conveying Verbatim Copies. You may convey verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice; keep intact all notices stating that this License and any non-permissive terms added in accord with section 7 apply to the code; keep intact all notices of the absence of any warranty; and give all recipients a copy of this License along with the Program. You may charge any price or no price for each copy that you convey, and you may offer support or warranty protection for a fee. 5. Conveying Modified Source Versions. You may convey a work based on the Program, or the modifications to produce it from the Program, in the form of source code under the terms of section 4, provided that you also meet all of these conditions: a) The work must carry prominent notices stating that you modified it, and giving a relevant date. b) The work must carry prominent notices stating that it is released under this License and any conditions added under section 7. This requirement modifies the requirement in section 4 to "keep intact all notices". c) You must license the entire work, as a whole, under this License to anyone who comes into possession of a copy. This License will therefore apply, along with any applicable section 7 additional terms, to the whole of the work, and all its parts, regardless of how they are packaged. This License gives no permission to license the work in any other way, but it does not invalidate such permission if you have separately received it. d) If the work has interactive user interfaces, each must display Appropriate Legal Notices; however, if the Program has interactive interfaces that do not display Appropriate Legal Notices, your work need not make them do so. A compilation of a covered work with other separate and independent works, which are not by their nature extensions of the covered work, and which are not combined with it such as to form a larger program, in or on a volume of a storage or distribution medium, is called an "aggregate" if the compilation and its resulting copyright are not used to limit the access or legal rights of the compilation's users beyond what the individual works permit. Inclusion of a covered work in an aggregate does not cause this License to apply to the other parts of the aggregate. 6. Conveying Non-Source Forms. You may convey a covered work in object code form under the terms of sections 4 and 5, provided that you also convey the machine-readable Corresponding Source under the terms of this License, in one of these ways: a) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by the Corresponding Source fixed on a durable physical medium customarily used for software interchange. b) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a written offer, valid for at least three years and valid for as long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a durable physical medium customarily used for software interchange, for a price no more than your reasonable cost of physically performing this conveying of source, or (2) access to copy the Corresponding Source from a network server at no charge. c) Convey individual copies of the object code with a copy of the written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d) Convey the object code by offering access from a designated place (gratis or for a charge), and offer equivalent access to the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the Corresponding Source may be on a different server (operated by you or a third party) that supports equivalent copying facilities, provided you maintain clear directions next to the object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you remain obligated to ensure that it is available for as long as needed to satisfy these requirements. e) Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. A "User Product" is either (1) a "consumer product", which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for incorporation into a dwelling. In determining whether a product is a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, "normally used" refers to a typical or common use of that class of product, regardless of the status of the particular user or of the way in which the particular user actually uses, or expects or is expected to use, the product. A product is a consumer product regardless of whether the product has substantial commercial, industrial or non-consumer uses, unless such uses represent the only significant mode of use of the product. "Installation Information" for a User Product means any methods, procedures, authorization keys, or other information required to install and execute modified versions of a covered work in that User Product from a modified version of its Corresponding Source. The information must suffice to ensure that the continued functioning of the modified object code is in no case prevented or interfered with solely because modification has been made. If you convey an object code work under this section in, or with, or specifically for use in, a User Product, and the conveying occurs as part of a transaction in which the right of possession and use of the User Product is transferred to the recipient in perpetuity or for a fixed term (regardless of how the transaction is characterized), the Corresponding Source conveyed under this section must be accompanied by the Installation Information. But this requirement does not apply if neither you nor any third party retains the ability to install modified object code on the User Product (for example, the work has been installed in ROM). The requirement to provide Installation Information does not include a requirement to continue to provide support service, warranty, or updates for a work that has been modified or installed by the recipient, or for the User Product in which it has been modified or installed. Access to a network may be denied when the modification itself materially and adversely affects the operation of the network or violates the rules and protocols for communication across the network. Corresponding Source conveyed, and Installation Information provided, in accord with this section must be in a format that is publicly documented (and with an implementation available to the public in source code form), and must require no special password or key for unpacking, reading or copying. 7. Additional Terms. "Additional permissions" are terms that supplement the terms of this License by making exceptions from one or more of its conditions. Additional permissions that are applicable to the entire Program shall be treated as though they were included in this License, to the extent that they are valid under applicable law. If additional permissions apply only to part of the Program, that part may be used separately under those permissions, but the entire Program remains governed by this License without regard to the additional permissions. When you convey a copy of a covered work, you may at your option remove any additional permissions from that copy, or from any part of it. (Additional permissions may be written to require their own removal in certain cases when you modify the work.) You may place additional permissions on material, added by you to a covered work, for which you have or can give appropriate copyright permission. Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright holders of that material) supplement the terms of this License with terms: a) Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or b) Requiring preservation of specified reasonable legal notices or author attributions in that material or in the Appropriate Legal Notices displayed by works containing it; or c) Prohibiting misrepresentation of the origin of that material, or requiring that modified versions of such material be marked in reasonable ways as different from the original version; or d) Limiting the use for publicity purposes of names of licensors or authors of the material; or e) Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or f) Requiring indemnification of licensors and authors of that material by anyone who conveys the material (or modified versions of it) with contractual assumptions of liability to the recipient, for any liability that these contractual assumptions directly impose on those licensors and authors. All other non-permissive additional terms are considered "further restrictions" within the meaning of section 10. If the Program as you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document contains a further restriction but permits relicensing or conveying under this License, you may add to a covered work material governed by the terms of that license document, provided that the further restriction does not survive such relicensing or conveying. If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the additional terms that apply to those files, or a notice indicating where to find the applicable terms. Additional terms, permissive or non-permissive, may be stated in the form of a separately written license, or stated as exceptions; the above requirements apply either way. 8. Termination. You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights under this License (including any patent licenses granted under the third paragraph of section 11). However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, you do not qualify to receive new licenses for the same material under section 10. 9. Acceptance Not Required for Having Copies. You are not required to accept this License in order to receive or run a copy of the Program. Ancillary propagation of a covered work occurring solely as a consequence of using peer-to-peer transmission to receive a copy likewise does not require acceptance. However, nothing other than this License grants you permission to propagate or modify any covered work. These actions infringe copyright if you do not accept this License. Therefore, by modifying or propagating a covered work, you indicate your acceptance of this License to do so. 10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and propagate that work, subject to this License. You are not responsible for enforcing compliance by third parties with this License. An "entity transaction" is a transaction transferring control of an organization, or substantially all assets of one, or subdividing an organization, or merging organizations. If propagation of a covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or could give under the previous paragraph, plus a right to possession of the Corresponding Source of the work from the predecessor in interest, if the predecessor has it or can get it with reasonable efforts. You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you may not impose a license fee, royalty, or other charge for exercise of rights granted under this License, and you may not initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging that any patent claim is infringed by making, using, selling, offering for sale, or importing the Program or any portion of it. 11. Patents. A "contributor" is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. The work thus licensed is called the contributor's "contributor version". A contributor's "essential patent claims" are all patent claims owned or controlled by the contributor, whether already acquired or hereafter acquired, that would be infringed by some manner, permitted by this License, of making, using, or selling its contributor version, but do not include claims that would be infringed only as a consequence of further modification of the contributor version. For purposes of this definition, "control" includes the right to grant patent sublicenses in a manner consistent with the requirements of this License. Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and otherwise run, modify and propagate the contents of its contributor version. In the following three paragraphs, a "patent license" is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a patent or covenant not to sue for patent infringement). To "grant" such a patent license to a party means to make such an agreement or commitment not to enforce a patent against the party. If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available for anyone to copy, free of charge and under the terms of this License, through a publicly available network server or other readily accessible means, then you must either (1) cause the Corresponding Source to be so available, or (2) arrange to deprive yourself of the benefit of the patent license for this particular work, or (3) arrange, in a manner consistent with the requirements of this License, to extend the patent license to downstream recipients. "Knowingly relying" means you have actual knowledge that, but for the patent license, your conveying the covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid. If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties receiving the covered work authorizing them to use, propagate, modify or convey a specific copy of the covered work, then the patent license you grant is automatically extended to all recipients of the covered work and works based on it. A patent license is "discriminatory" if it does not include within the scope of its coverage, prohibits the exercise of, or is conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third party that is in the business of distributing software, under which you make payment to the third party based on the extent of your activity of conveying the work, and under which the third party grants, to any of the parties who would receive the covered work from you, a discriminatory patent license (a) in connection with copies of the covered work conveyed by you (or copies made from those copies), or (b) primarily for and in connection with specific products or compilations that contain the covered work, unless you entered into that arrangement, or that patent license was granted, prior to 28 March 2007. Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. 12. No Surrender of Others' Freedom. If conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot convey a covered work so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not convey it at all. For example, if you agree to terms that obligate you to collect a royalty for further conveying from those to whom you convey the Program, the only way you could satisfy both those terms and this License would be to refrain entirely from conveying the Program. 13. Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU Affero General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the special requirements of the GNU Affero General Public License, section 13, concerning interaction through a network will apply to the combination as such. 14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies that a certain numbered version of the GNU General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU General Public License, you may choose any version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. 15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, reviewing courts shall apply local law that most closely approximates an absolute waiver of all civil liability in connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . Also add information on how to contact you by electronic and paper mail. If the program does terminal interaction, make it output a short notice like this when it starts in an interactive mode: Copyright (C) This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, your program's commands might be different; for a GUI interface, you would use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see . The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read . hledger-lib-1.19.1/Setup.hs0000644000000000000000000000005613302271455013606 0ustar0000000000000000import Distribution.Simple main = defaultMain hledger-lib-1.19.1/hledger-lib.cabal0000644000000000000000000001555113725533425015331 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack -- -- hash: 4cff01322093c9a60a07a65c0ed150394360e71104dd3e7b52fc6782c5cf5a57 name: hledger-lib version: 1.19.1 synopsis: A reusable library providing the core functionality of hledger description: A reusable library containing hledger's core functionality. This is used by most hledger* packages so that they support the same common file formats, command line options, reports etc. . hledger is a robust, cross-platform set of tools for tracking money, time, or any other commodity, using double-entry accounting and a simple, editable file format, with command-line, terminal and web interfaces. It is a Haskell rewrite of Ledger, and one of the leading implementations of Plain Text Accounting. Read more at: category: Finance stability: stable homepage: http://hledger.org bug-reports: http://bugs.hledger.org author: Simon Michael maintainer: Simon Michael license: GPL-3 license-file: LICENSE tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC==8.10.0.20200123 build-type: Simple extra-source-files: CHANGES.md README.md test/unittest.hs test/doctests.hs hledger_csv.5 hledger_csv.txt hledger_csv.info hledger_journal.5 hledger_journal.txt hledger_journal.info hledger_timedot.5 hledger_timedot.txt hledger_timedot.info hledger_timeclock.5 hledger_timeclock.txt hledger_timeclock.info source-repository head type: git location: https://github.com/simonmichael/hledger library exposed-modules: Hledger Hledger.Data Hledger.Data.Account Hledger.Data.AccountName Hledger.Data.Amount Hledger.Data.Commodity Hledger.Data.Dates Hledger.Data.Journal Hledger.Data.Json Hledger.Data.Ledger Hledger.Data.Period Hledger.Data.PeriodicTransaction Hledger.Data.StringFormat Hledger.Data.Posting Hledger.Data.RawOptions Hledger.Data.Timeclock Hledger.Data.Transaction Hledger.Data.TransactionModifier Hledger.Data.Types Hledger.Data.Valuation Hledger.Query Hledger.Read Hledger.Read.Common Hledger.Read.CsvReader Hledger.Read.JournalReader Hledger.Read.TimedotReader Hledger.Read.TimeclockReader Hledger.Reports Hledger.Reports.ReportOptions Hledger.Reports.ReportTypes Hledger.Reports.AccountTransactionsReport Hledger.Reports.BalanceReport Hledger.Reports.BudgetReport Hledger.Reports.EntriesReport Hledger.Reports.MultiBalanceReport Hledger.Reports.PostingsReport Hledger.Reports.TransactionsReport Hledger.Utils Hledger.Utils.Color Hledger.Utils.Debug Hledger.Utils.Parse Hledger.Utils.Regex Hledger.Utils.String Hledger.Utils.Test Hledger.Utils.Text Hledger.Utils.Tree Hledger.Utils.UTF8IOCompat Text.Tabular.AsciiWide other-modules: Text.Megaparsec.Custom Paths_hledger_lib hs-source-dirs: ./. ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans build-depends: Decimal >=0.5.1 , Glob >=0.9 , aeson >=1 , aeson-pretty , ansi-terminal >=0.9 , array , base >=4.9 && <4.15 , base-compat-batteries >=0.10.1 && <0.12 , blaze-markup >=0.5.1 , bytestring , call-stack , cassava , cassava-megaparsec , cmdargs >=0.10 , containers , data-default >=0.5 , directory , extra >=1.6.3 , fgl >=5.5.4.0 , file-embed >=0.0.10 , filepath , hashtables >=1.2.3.1 , megaparsec >=7.0.0 && <9.1 , mtl >=2.2.1 , old-time , parsec >=3 , parser-combinators >=0.4.0 , pretty-show >=1.6.4 , regex-tdfa , safe >=0.2 , split >=0.1 , tabular >=0.2 , tasty >=1.2.3 , tasty-hunit >=0.10.0.2 , template-haskell , text >=1.2 , time >=1.5 , timeit , transformers >=0.2 , uglymemo , unordered-containers >=0.2 , utf8-string >=0.3.5 default-language: Haskell2010 test-suite doctest type: exitcode-stdio-1.0 main-is: doctests.hs hs-source-dirs: ./. test ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans build-depends: Decimal >=0.5.1 , Glob >=0.7 , aeson >=1 , aeson-pretty , ansi-terminal >=0.9 , array , base >=4.9 && <4.15 , base-compat-batteries >=0.10.1 && <0.12 , blaze-markup >=0.5.1 , bytestring , call-stack , cassava , cassava-megaparsec , cmdargs >=0.10 , containers , data-default >=0.5 , directory , doctest >=0.16.3 , extra >=1.6.3 , fgl >=5.5.4.0 , file-embed >=0.0.10 , filepath , hashtables >=1.2.3.1 , megaparsec >=7.0.0 && <9.1 , mtl >=2.2.1 , old-time , parsec >=3 , parser-combinators >=0.4.0 , pretty-show >=1.6.4 , regex-tdfa , safe >=0.2 , split >=0.1 , tabular >=0.2 , tasty >=1.2.3 , tasty-hunit >=0.10.0.2 , template-haskell , text >=1.2 , time >=1.5 , timeit , transformers >=0.2 , uglymemo , unordered-containers >=0.2 , utf8-string >=0.3.5 if (impl(ghc < 8.2)) buildable: False default-language: Haskell2010 test-suite unittest type: exitcode-stdio-1.0 main-is: unittest.hs hs-source-dirs: ./. test ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans build-depends: Decimal >=0.5.1 , Glob >=0.9 , aeson >=1 , aeson-pretty , ansi-terminal >=0.9 , array , base >=4.9 && <4.15 , base-compat-batteries >=0.10.1 && <0.12 , blaze-markup >=0.5.1 , bytestring , call-stack , cassava , cassava-megaparsec , cmdargs >=0.10 , containers , data-default >=0.5 , directory , extra >=1.6.3 , fgl >=5.5.4.0 , file-embed >=0.0.10 , filepath , hashtables >=1.2.3.1 , hledger-lib , megaparsec >=7.0.0 && <9.1 , mtl >=2.2.1 , old-time , parsec >=3 , parser-combinators >=0.4.0 , pretty-show >=1.6.4 , regex-tdfa , safe >=0.2 , split >=0.1 , tabular >=0.2 , tasty >=1.2.3 , tasty-hunit >=0.10.0.2 , template-haskell , text >=1.2 , time >=1.5 , timeit , transformers >=0.2 , uglymemo , unordered-containers >=0.2 , utf8-string >=0.3.5 buildable: True default-language: Haskell2010 hledger-lib-1.19.1/CHANGES.md0000644000000000000000000010234313725533425013555 0ustar0000000000000000Internal/api/developer-ish changes in the hledger-lib (and hledger) packages. For user-visible changes, see the hledger package changelog. # 1.19.1 2020-09-07 - Allow megaparsec 9 - stripAnsi: correctly strip ansi sequences with no numbers/semicolons. (Stephen Morgan) - Added case-insensitive accountNameToAccountRegexCI, accountNameToAccountOnlyRegexCI, made the default account type queries case insensitive again. (#1341) # 1.19 2020-09-01 - Added a missing lower bound for aeson, making cabal installs more reliable. (#1268) - The Regex type alias has been replaced by the Regexp ADT, which contains both the compiled regular expression (so is guaranteed to be usable at runtime) and the original string (so can be serialised, printed, compared, etc.) A Regexp also knows whether is it case sensitive or case insensitive. The Hledger.Utils.Regex API has changed. (#1312, #1330). - Typeable and Data instances are no longer derived for hledger's data types; they were redundant/no longer needed. - NFData instances are no longer derived for hledger's data types. This speeds up a full build by roughly 7%. But it means we can't deep-evaluate hledger values, or time hledger code with Criterion. https://github.com/simonmichael/hledger/pull/1330#issuecomment-684075129 has some ideas on this. - Query no longer has a custom Show instance - Hledger.Utils.String: quoteIfNeeded now actually escapes quotes in strings. escapeQuotes was dropped. (Stephen Morgan) - Hledger.Utils.Tree: dropped some old utilities - Some fromIntegral calls have been replaced with safer code, removing some potential for integer wrapping bugs (#1325, #1326) - Parsing numbers with more than 255 decimal places now gives an error instead of silently misparsing (#1326) - Digit groups are now limited to at most 255 digits each. (#1326) - Exponents are parsed as Integer rather than Int. This means exponents greater than 9223372036854775807 or less than -9223372036854775808 are now parsed correctly, in theory. (In practice, very large exponents will cause hledger to eat all your memory, so avoid them for now.) (#1326) - AmountStyle's asprecision is now a sum type with Word8, instead of an Int with magic values. - DigitGroupStyle uses Word8 instead of Int. - Partial helper function parsedate has been dropped, use fromGregorian instead. - Partial helper function mkdatespan has been dropped. - Helper function transaction now takes a Day instead of a date string. (Stephen Morgan) - Old CPP directives made redundant by version bounds have been removed. (Stephen Morgan) - Smart dates are now represented by the SmartDate type, and are always well formed. (Stephen Morgan) - accountTransactionsReport (used for hledger aregister and hledger-ui/hledger-web registers) now filters transactions more thoroughly, so eg transactions dated outside the report period will not be shown. Previously the transaction would be shown if it had any posting dated inside the report period. Possibly some other filter criteria now get applied that didn't before. I think on balance this will give slightly preferable results. - The old BalanceReport code has been dropped at last, replaced by MultiBalanceReport so that all balance reports now use the same code. (Stephen Morgan, #1256). - The large multiBalanceReport function has been split up and refactored extensively. - Tabular data formerly represented as [[MixedAmount]] is now HashMap AccountName (Map DateSpan Account). Reports with many columns are now faster. - Calculating starting balances no longer calls the whole balanceReport, just the first few functions. - displayedAccounts is completely rewritten. Perhaps one subtle thing to note is that in tree mode it no longer excludes nodes with zero inclusive balance unless they also have zero exclusive balance. - Simon's note: "I'll mark the passing of the old multiBalanceReport, into which I poured many an hour :). It is in a way the heart (brain ?) of hledger - the key feature of ledgerlikes (balance report) and a key improvement introduced by hledger (tabular multiperiod balance reports) ... Thanks @Xitian9, great work." # 1.18.1 2020-06-21 - fix some doc typos (Martin Michlmayr) # 1.18 2020-06-07 - added: getHledgerCliOpts', takes an explicit argument list - added: toJsonText - changed: isNegativeMixedAmount now gives an answer for multi-commodity amounts which are all negative - changed: multiBalanceReport now gets the query from ReportOpts (Dmitry Astapov) - renamed: isZeroAmount -> amountLooksZero isReallyZeroAmount -> amountIsZero isZeroMixedAmount -> mixedAmountLooksZero isReallyZeroMixedAmount -> mixedAmountIsZero isReallyZeroMixedAmountCost dropped - renamed: finaliseJournal -> journalFinalise - renamed: fixedlotpricep -> lotpricep, now also parses non-fixed lot prices - dropped: transactionPostingBalances - dropped: outputflags no longer exported by Hledger.Cli.CliOptions - fixed: documentation for journalExpenseAccountQuery (Pavan Rikhi) # 1.17.1 2020-03-19 - require newer Decimal, math-functions libs to ensure consistent rounding behaviour, even when built with old GHCs/snapshots. hledger uses banker's rounding (rounds to nearest even number, eg 0.5 displayed with zero decimal places is "0"). - added: debug helpers traceAt, traceAtWith - Journal is now a Semigroup, not a Monoid (since <> is right-biased). (Stephen Morgan) # 1.17.0.1 2020-03-01 - fix org heading comments and doctest setup comment that were breaking haddock (and in some cases, installation) # 1.17 2020-03-01 - Reader-finding utilities have moved from Hledger.Read to Hledger.Read.JournalReader so the include directive can use them. - Reader changes: - rExperimental flag removed - old rParser renamed to rReadFn - new rParser field provides the actual parser. This seems to require making Reader a higher-kinded type, unfortunately. - Hledger.Tabular.AsciiWide now renders smoother outer borders in pretty (unicode) mode. Also, a fix for table edges always using single-width intersections and support for double horizontal lines with single vertical lines. (Eric Mertens) - Hledger.Utils.Parse: restofline can go to eof also - Hledger.Read cleanup - Hledger.Read.CsvReader cleanup Exports added: CsvRecord, CsvValue, csvFileFor. Exports removed: expandIncludes, parseAndValidateCsvRules, transactionFromCsvRecord - more cleanup of amount canonicalisation helpers (#1187) Stop exporting journalAmounts, overJournalAmounts, traverseJournalAmounts. Rename journalAmounts helper to journalStyleInfluencingAmounts. - export mapMixedAmount - Don't store leaf name in PeriodReport. (Stephen Morgan) Calculate at the point of consumption instead. - Generalise PeriodicReport to be polymorphic in the account labels. (Stephen Morgan) - Use records instead of tuples in PeriodicReport. (Stephen Morgan) - Use PeriodicReport in place of MultiBalanceReport. (Stephen Morgan) - Calculate MultiReportBalance columns more efficiently. (Stephen Morgan) Only calculate posting date once for each posting, and calculate their columns instead of checking each DateSpan separately. - Moved JSON instances from hledger-web to hledger-lib (Hledger.Data.Json), and added ToJSON instances for all (?) remaining data types, up to Ledger. - Dropped nullassertion's "assertion" alias, fixing a warning. Perhaps we'll stick with the null* naming convention. # 1.16.2 2020-01-14 - add support for megaparsec 8 (#1175) # 1.16.1 2019-12-03 - Drop unnecessary mtl-compat dependency - Fix building with GHC 8.0, 8.2 # 1.16 2019-12-01 - drop support for GHC 7.10, due to MonadFail hassles in JournalReader.hs - add support for GHC 8.8, base-compat 0.11 (#1090) We are now using the new fail from the MonadFail class, which we always import qualified as Fail.fail, from base-compat-batteries Control.Monad.Fail.Compat to work with old GHC versions. If old fail is needed (shouldn't be) it should be imported qualified as Prelude.Fail, using imports such as: import Prelude hiding (fail) import qualified Prelude (fail) import Control.Monad.State.Strict hiding (fail) import "base-compat-batteries" Prelude.Compat hiding (fail) import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail - hledger and hledger-lib unit tests have been ported to tasty. - The doctest suite has been disabled for now since it doesn't run well with cabal (#1139) # 1.15.2 2019-09-05 Changes: - postingApplyValuation, mixedAmountApplyValuation, amountApplyValuation take an argument, the report end date if one was specified. # 1.15.1 2019-09-02 - fix failing doctests # 1.15 2019-09-01 Removals include: - journalPrices - BalanceHistoryReport - postingValueAtDate Additions include: - MarketPrice (more pure form of PriceDirective without the amount style information) - PriceOracle (efficient lookup of exchange rates) - ValuationType (ways to convert amount value) - aliasnamep (export) - setNaturalPrecisionUpTo - dbgNWith, ptraceAtWith - postingTransformAmount, postingToCost, postingValue - amountToCost, mixedAmountToCost - valueTypeFromOpts - mapJournalTransactions, mapJournalPostings, mapTransactionPostings - journalStartDate, journalEndDate - journalPriceOracle - marketPriceReverse - priceDirectiveToMarketPrice - mixedAmountApplyValuation - mixedAmountValueAtDate Changes include: - Price -> AmountPrice, AKA "transaction price" - old MarketPrice -> PriceDirective - TransactionsReport/AccountTransactionsReport split into separate files - journalTransactionsReport -> transactionsReport - accountTransactionsReportItems: rewrite using catMaybes and mapAccumL (Henning Thielemann) - optionally save the current date in ReportOpts - Hledger.Cli tests now have correct prefix; add Cli.Utils tests - MultiBalanceReport now returns zero for row totals when in cumulative or historical mode (#329) # 1.14.1 2019-03-20 - require easytest <0.3 to fix build issue # 1.14 2019-03-01 - added: transaction, [v]post*, balassert* constructors, for tests etc. - renamed: porigin -> poriginal - refactored: transaction balancing & balance assertion checking (#438) # 1.13.1 (2019/02/02) - stop depending on here to avoid haskell-src-meta/stackage blockage. # 1.13 (2019/02/01) - in Journal's jtxns field, forecasted txns are appended rather than prepended - API changes: added: +setFullPrecision +setMinimalPrecision +expectParseStateOn +embedFileRelative +hereFileRelative changed: - amultiplier -> aismultiplier - Amount fields reordered for clearer debug output - tpreceding_comment_lines -> tprecedingcomment, reordered - Hledger.Data.TransactionModifier.transactionModifierToFunction -> modifyTransactions - Hledger.Read.Common.applyTransactionModifiers -> Hledger.Data.Journal.journalModifyTransactions - HelpTemplate -> CommandDoc # 1.12 (2018/12/02) - switch to megaparsec 7 (Alex Chen) We now track the stack of include files in Journal ourselves, since megaparsec dropped this feature. - add 'ExceptT' layer to our parser monad again (Alex Chen) We previously had a parser type, 'type ErroringJournalParser = ExceptT String ...' for throwing parse errors without allowing further backtracking. This parser type was removed under the assumption that it would be possible to write our parser without this capability. However, after a hairy backtracking bug, we would now prefer to have the option to prevent backtracking. - Define a 'FinalParseError' type specifically for the 'ExceptT' layer - Any parse error can be raised as a "final" parse error - Tracks the stack of include files for parser errors, anticipating the removal of the tracking of stacks of include files in megaparsec 7 - Although a stack of include files is also tracked in the 'StateT Journal' layer of the parser, it seems easier to guarantee correct error messages in the 'ExceptT FinalParserError' layer - This does not make the 'StateT Journal' stack redundant because the 'ExceptT FinalParseError' stack cannot be used to detect cycles of include files - more support for location-aware parse errors when re-parsing (Alex Chen) - make 'includedirectivep' an 'ErroringJournalParser' (Alex Chen) - drop Ord instance breaking GHC 8.6 build (Peter Simons) - flip the arguments of (divide\|multiply)\[Mixed\]Amount - showTransaction: fix a case showing multiple missing amounts showTransaction could sometimes hide the last posting's amount even if one of the other posting amounts was already implicit, producing invalid transaction output. - plog, plogAt: add missing newline - split up journalFinalise, reorder journal finalisation steps (#893) (Jesse Rosenthal) The `journalFinalise` function has been split up, allowing more granular control. - journalSetTime --> journalSetLastReadTime - journalSetFilePath has been removed, use journalAddFile instead # 1.11.1 (2018/10/06) - add, lib: fix wrong transaction rendering in balance assertion errors and when using the add command # 1.11 (2018/9/30) - compilation now works when locale is unset (#849) - all unit tests have been converted from HUnit+test-framework to easytest - doctests now run quicker by default, by skipping reloading between tests. This can be disabled by passing --slow to the doctests test suite executable. - doctests test suite executable now supports --verbose, which shows progress output as tests are run if doctest 0.16.0+ is installed (and hopefully is harmless otherwise). - doctests now support file pattern arguments, provide more informative output. Limiting to just the file(s) you're interested can make doctest start much quicker. With one big caveat: you can limit the starting files, but it always imports and tests all other local files those import. - a bunch of custom Show instances have been replaced with defaults, for easier troubleshooting. These were sometimes obscuring important details, eg in test failure output. Our new policy is: stick with default derived Show instances as far as possible, but when necessary adjust them to valid haskell syntax so pretty-show can pretty-print them (eg when they contain Day values, cf https://github.com/haskell/time/issues/101). By convention, when fields are shown in less than full detail, and/or in double-quoted pseudo syntax, we show a double period (..) in the output. - Amount has a new Show instance. Amount's show instance hid important details by default, and showing more details required increasing the debug level, which was inconvenient. Now it has a single show instance which shows more information, is fairly compact, and is pretty-printable. ghci> usd 1 OLD: Amount {acommodity="$", aquantity=1.00, ..} NEW: Amount {acommodity = "$", aquantity = 1.00, aprice = NoPrice, astyle = AmountStyle "L False 2 Just '.' Nothing..", amultiplier = False} MixedAmount's show instance is unchanged, but showMixedAmountDebug is affected by this change: ghci> putStrLn $ showMixedAmountDebug $ Mixed [usd 1] OLD: Mixed [Amount {acommodity="$", aquantity=1.00, aprice=, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}}] NEW: Mixed [Amount {acommodity="$", aquantity=1.00, aprice=, astyle=AmountStyle "L False 2 Just '.' Nothing.."}] - Same-line & next-line comments of transactions, postings, etc. are now parsed a bit more precisely (followingcommentp). Previously, parsing no comment gave the same result as an empty comment (a single newline); now it gives an empty string.\ Also, and perhaps as a consequence of the above, when there's no same-line comment but there is a next-line comment, we'll insert an empty first line, since otherwise next-line comments would get moved up to the same line when rendered. - Hledger.Utils.Test exports HasCallStack - queryDateSpan, queryDateSpan' now intersect date AND'ed date spans instead of unioning them, and docs are clearer. - pushAccount -> pushDeclaredAccount - jaccounts -> jdeclaredaccounts - AutoTransaction.hs -> PeriodicTransaction.hs & TransactionModifier.hs - Hledger.Utils.Debug helpers have been renamed/cleaned up # 1.10 (2018/6/30) - build cleanly with all supported GHC versions again (7.10 to 8.4) - support/use latest base-compat (#794) - support/require megaparsec 6.4+ - extensive refactoring and cleanup of parsers and related types and utilities - readJournalFile(s) cleanup, these now use InputOpts - doctests now run a bit faster (#802) # 1.9.1 (2018/4/30) - new generic PeriodicReport, and some report-related type aliases - new BudgetReport - make (readJournal\|tryReader)s?WithOpts the default api, dropping "WithOpts" - automated postings and command line account aliases happen earlier in journal processing (see hledger changelog) # 1.9 (2018/3/31) - support ghc 8.4, latest deps - when the system text encoding is UTF-8, ignore any UTF-8 BOM prefix found when reading files. - CompoundBalanceReport amounts are now normally positive. The bs/bse/cf/is commands now show normal income, liability and equity balances as positive. Negative numbers now indicate a contra-balance (eg an overdrawn checking account), a net loss, a negative net worth, etc. This makes these reports more like conventional financial statements, and easier to read and share with others. (experimental) - splitSpan now returns no spans for an empty datespan - don't count periodic/modifier txns in Journal debug output - lib/ui/web/api: move embedded manual files to extra-source-files - Use skipMany/skipSome for parsing spacenonewline (Moritz Kiefer) This avoids allocating the list of space characters only to then discard it. - rename, clarify purpose of balanceReportFromMultiBalanceReport - fix some hlint warnings - add some easytest tests # 1.5 (2017/12/31) - -V/--value uses today's market prices by default, not those of last transaction date. #683, #648) - csv: allow balance assignment (balance assertion only, no amount) in csv records (Nadrieril) - journal: allow space as digit group separator character, #330 (Mykola Orliuk) - journal: balance assertion errors now show line of failed assertion posting, #481 (Sam Jeeves) - journal: better errors for directives, #402 (Mykola Orliuk) - journal: better errors for included files, #660 (Mykola Orliuk) - journal: commodity directives in parent files are inherited by included files, #487 (Mykola Orliuk) - journal: commodity directives limits precision even after -B, #509 (Mykola Orliuk) - journal: decimal point/digit group separator chars are now inferred from an applicable commodity directive or default commodity directive. #399, #487 (Mykola Orliuk) - journal: numbers are parsed more strictly (Mykola Orliuk) - journal: support Ledger-style automated postings, enabled with --auto flag (Dmitry Astapov) - journal: support Ledger-style periodic transactions, enabled with --forecast flag (Dmitry Astapov) - period expressions: fix "nth day of {week,month}", which could generate wrong intervals (Dmitry Astapov) - period expressions: month names are now case-insensitive (Dmitry Astapov) - period expressions: stricter checking for invalid expressions (Mykola Orliuk) - period expressions: support "every 11th Nov" (Dmitry Astapov) - period expressions: support "every 2nd Thursday of month" (Dmitry Astapov) - period expressions: support "every Tuesday", short for "every th day of week" (Dmitry Astapov) - remove upper bounds on all but hledger* and base (experimental) It's rare that my deps break their api or that newer versions must be avoided, and very common that they release new versions which I must tediously and promptly test and release hackage revisions for or risk falling out of stackage. Trying it this way for a bit. # 1.4 (2017/9/30) - add readJournalFile\[s\]WithOpts, with simpler arguments and support for detecting new transactions since the last read. - query: add payee: and note: query terms, improve description/payee/note docs (Jakub Zárybnický, Simon Michael, #598, #608) - journal, cli: make trailing whitespace significant in regex account aliases Trailing whitespace in the replacement part of a regular expression account alias is now significant. Eg, converting a parent account to just an account name prefix: --alias '/:acct:/=:acct' - timedot: allow a quantity of seconds, minutes, days, weeks, months or years to be logged as Ns, Nm, Nd, Nw, Nmo, Ny - csv: switch the order of generated postings, so account1 is first. This simplifies things and facilitates future improvements. - csv: show the "creating/using rules file" message only with --debug - csv: fix multiple includes in one rules file - csv: add "newest-first" rule for more robust same-day ordering - deps: allow ansi-terminal 0.7 - deps: add missing parsec lower bound, possibly related to #596, fpco/stackage#2835 - deps: drop oldtime flag, require time 1.5+ - deps: remove ghc < 7.6 support, remove obsolete CPP conditionals - deps: fix test suite with ghc 8.2 # 1.3.1 (2017/8/25) - Fix a bug with -H showing nothing for empty periods (#583, Nicholas Niro) This patch fixes a bug that happened when using the -H option on a period without any transaction. Previously, the behavior was no output at all even though it should have shown the previous ending balances of past transactions. (This is similar to previously using -H with -E, but with the extra advantage of not showing empty accounts) - allow megaparsec 6 (#594) - allow megaparsec-6.1 (Hans-Peter Deifel) - fix test suite with Cabal 2 (#596) # 1.3 (2017/6/30) journal: The "uncleared" transaction/posting status, and associated UI flags and keys, have been renamed to "unmarked" to remove ambiguity and confusion. This means that we have dropped the `--uncleared` flag, and our `-U` flag now matches only unmarked things and not pending ones. See the issue and linked mail list discussion for more background. (#564) csv: assigning to the "balance" field name creates balance assertions (#537, Dmitry Astapov). csv: Doubled minus signs are handled more robustly (fixes #524, Nicolas Wavrant, Simon Michael) Multiple "status:" query terms are now OR'd together. (#564) deps: allow megaparsec 5.3. # 1.2 (2017/3/31) ## journal format A pipe character can optionally be used to delimit payee names in transaction descriptions, for more accurate querying and pivoting by payee. Eg, for a description like `payee name | additional notes`, the two parts will be accessible as pseudo-fields/tags named `payee` and `note`. Some journal parse errors now show the range of lines involved, not just the first. ## ledger format The experimental `ledger:` reader based on the WIP ledger4 project has been disabled, reducing build dependencies. ## Misc Fix a bug when tying the knot between postings and their parent transaction, reducing memory usage by about 10% (#483) (Mykola Orliuk) Fix a few spaceleaks (#413) (Moritz Kiefer) Add Ledger.Parse.Text to package.yaml, fixing a potential build failure. Allow megaparsec 5.2 (#503) Rename optserror -> usageError, consolidate with other error functions # 1.1 (2016/12/31) ## journal format - balance assignments are now supported (#438, #129, #157, #288) This feature also brings a slight performance drop (\~5%); optimisations welcome. - also recognise `*.hledger` files as hledger journal format ## ledger format - use ledger-parse from the ledger4 project as an alternate reader for C++ Ledger journals The idea is that some day we might get better compatibility with Ledger files this way. Right now this reader is not very useful and will be used only if you explicitly select it with a `ledger:` prefix. It parses transaction dates, descriptions, accounts and amounts, and ignores everything else. Amount parsing is delegated to hledger's journal parser, and malformed amounts might be silently ignored. This adds at least some of the following as new dependencies for hledger-lib: parsers, parsec, attoparsec, trifecta. ## misc - update base lower bound to enforce GHC 7.10+ hledger-lib had a valid install plan with GHC 7.8, but currently requires GHC 7.10 to compile. Now we require base 4.8+ everywhere to ensure the right GHC version at the start. - Hledger.Read api cleanups - rename dbgIO to dbg0IO, consistent with dbg0, and document a bug in dbg*IO - make readJournalFiles \[f\] equivalent to readJournalFile f (#437) - more general parser types enabling reuse outside of IO (#439) # 1.0.1 (2016/10/27) - allow megaparsec 5.0 or 5.1 # 1.0 (2016/10/26) ## timedot format - new "timedot" format for retroactive/approximate time logging. Timedot is a plain text format for logging dated, categorised quantities (eg time), supported by hledger. It is convenient for approximate and retroactive time logging, eg when the real-time clock-in/out required with a timeclock file is too precise or too interruptive. It can be formatted like a bar chart, making clear at a glance where time was spent. ## timeclock format - renamed "timelog" format to "timeclock", matching the emacs package - sessions can no longer span file boundaries (unclocked-out sessions will be auto-closed at the end of the file). - transaction ids now count up rather than down (#394) - timeclock files no longer support default year directives - removed old code for appending timeclock transactions to journal transactions. A holdover from the days when both were allowed in one file. ## csv format - fix empty field assignment parsing, rule parse errors after megaparsec port (#407) (Hans-Peter Deifel) ## journal format - journal files can now include timeclock or timedot files (#320) (but not yet CSV files). - fixed an issue with ordering of same-date transactions included from other files - the "commodity" directive and "format" subdirective are now supported, allowing full control of commodity style (#295) The commodity directive's format subdirective can now be used to override the inferred style for a commodity, eg to increase or decrease the precision. This is at least a good workaround for #295. - Ledger-style "apply account"/"end apply account" directives are now used to set a default parent account. - the Ledger-style "account" directive is now accepted (and ignored). - bracketed posting dates are more robust (#304) Bracketed posting dates were fragile; they worked only if you wrote full 10-character dates. Also some semantics were a bit unclear. Now they should be robust, and have been documented more clearly. This is a legacy undocumented Ledger syntax, but it improves compatibility and might be preferable to the more verbose "date:" tags if you write posting dates often (as I do). Internally, bracketed posting dates are no longer considered to be tags. Journal comment, tag, and posting date parsers have been reworked, all with doctests. - balance assertion failure messages are clearer - with --debug=2, more detail about balance assertions is shown. ## misc - file parsers have been ported from Parsec to Megaparsec \o/ (#289, #366) (Alexey Shmalko, Moritz Kiefer) - most hledger types have been converted from String to Text, reducing memory usage by 30%+ on large files - file parsers have been simplified for easier troubleshooting (#275). The journal/timeclock/timedot parsers, instead of constructing opaque journal update functions which are later applied to build the journal, now construct the journal directly by modifying the parser state. This is easier to understand and debug. It also rules out the possibility of journal updates being a space leak. (They weren't, in fact this change increased memory usage slightly, but that has been addressed in other ways). The ParsedJournal type alias has been added to distinguish "being-parsed" journals and "finalised" journals. - file format detection is more robust. The Journal, Timelog and Timedot readers' detectors now check each line in the sample data, not just the first one. I think the sample data is only about 30 chars right now, but even so this fixed a format detection issue I was seeing. Also, we now always try parsing stdin as journal format (not just sometimes). - all file formats now produce transaction ids, not just journal (#394) - git clone of the hledger repo on windows now works (#345) - added missing benchmark file (#342) - our stack.yaml files are more compatible across stack versions (#300) - use newer file-embed to fix ghci working directory dependence () - report more accurate dates in account transaction report when postings have their own dates (affects hledger-ui and hledger-web registers). The newly-named "transaction register date" is the date to be displayed for that transaction in a transaction register, for some current account and filter query. It is either the transaction date from the journal ("transaction general date"), or if postings to the current account and matched by the register's filter query have their own dates, the earliest of those posting dates. - simplify account transactions report's running total. The account transactions report used for hledger-ui and -web registers now gives either the "period total" or "historical total", depending strictly on the --historical flag. It doesn't try to indicate whether the historical total is the accurate historical balance (which depends on the user's report query). - reloading a file now preserves the effect of options, query arguments etc. - reloading a journal should now reload all included files as well. - the Hledger.Read.* modules have been reorganised for better reuse. Hledger.Read.Utils has been renamed Hledger.Read.Common and holds low-level parsers & utilities; high-level read utilities are now in Hledger.Read. - clarify amount display style canonicalisation code and terminology a bit. Individual amounts still have styles; from these we derive the standard "commodity styles". In user docs, we might call these "commodity formats" since they can be controlled by the "format" subdirective in journal files. - Journal is now a monoid - expandPath now throws a proper IO error - more unit tests, start using doctest 0.27 (2015/10/30) - The main hledger types now derive NFData, which makes it easier to time things with criterion. - Utils has been split up more. - Utils.Regex: regular expression compilation has been memoized, and memoizing versions of regexReplace\[CI\] have been added, since compiling regular expressions every time seems to be quite expensive (#244). - Utils.String: strWidth is now aware of multi-line strings (#242). - Read: parsers now use a consistent p suffix. - New dependencies: deepseq, uglymemo. - All the hledger packages' cabal files are now generated from simpler, less redundant yaml files by hpack, in principle. In practice, manual fixups are still needed until hpack gets better, but it's still a win. 0.26 (2015/7/12) - allow year parser to handle arbitrarily large years - Journal's Show instance reported one too many accounts - some cleanup of debug trace helpers - tighten up some date and account name parsers (don't accept leading spaces; hadddocks) - drop regexpr dependency 0.25.1 (2015/4/29) - support/require base-compat >0.8 (#245) 0.25 (2015/4/7) - GHC 7.10 compatibility (#239) 0.24.1 (2015/3/15) - fix JournalReader "ctx" compilation warning - add some type signatures in Utils to help make ghci-web 0.24 (2014/12/25) - fix combineJournalUpdates folding order - fix a regexReplaceCI bug - fix a splitAtElement bug with adjacent separators - mostly replace slow regexpr with regex-tdfa (fixes #189) - use the modern Text.Parsec API - allow transformers 0.4* - regexReplace now supports backreferences - Transactions now remember their parse location in the journal file - export Regexp types, disambiguate CsvReader's similarly-named type - export failIfInvalidMonth/Day (fixes #216) - track the commodity of zero amounts when possible (useful eg for hledger-web's multi-commodity charts) - show posting dates in debug output - more debug helpers 0.23.3 (2014/9/12) - allow transformers 0.4* 0.23.2 (2014/5/8) - postingsReport: also fix date sorting of displayed postings (#184) 0.23.1 (2014/5/7) - postingsReport: with disordered journal entries, postings before the report start date could get wrongly included. (#184) 0.23 (2014/5/1) - orDatesFrom -> spanDefaultsFrom 0.22.2 (2014/4/16) - display years before 1000 with four digits, not three - avoid pretty-show to build with GHC < 7.4 - allow text 1.1, drop data-pprint to build with GHC 7.8.x 0.22.1 (2014/1/6) and older: see http://hledger.org/release-notes or doc/CHANGES.md. hledger-lib-1.19.1/README.md0000644000000000000000000000045713722544246013445 0ustar0000000000000000# hledger-lib A reusable library containing hledger's core functionality. This is used by most hledger* packages so that they support the same common file formats, command line options, reports etc. See also: the [project README](https://hledger.org/README.html) and [home page](https://hledger.org). hledger-lib-1.19.1/hledger_csv.50000644000000000000000000011441713725533425014543 0ustar0000000000000000.\"t .TH "hledger_csv" "5" "September 2020" "hledger 1.18.99" "hledger User Manuals" .SH NAME .PP CSV - how hledger reads CSV data, and the CSV rules file format .SH DESCRIPTION .PP hledger can read CSV files (Character Separated Value - usually comma, semicolon, or tab) containing dated records as if they were journal files, automatically converting each CSV record into a transaction. .PP (To learn about \f[I]writing\f[R] CSV, see CSV output.) .PP We describe each CSV file\[aq]s format with a corresponding \f[I]rules file\f[R]. By default this is named like the CSV file with a \f[C].rules\f[R] extension added. Eg when reading \f[C]FILE.csv\f[R], hledger also looks for \f[C]FILE.csv.rules\f[R] in the same directory as \f[C]FILE.csv\f[R]. You can specify a different rules file with the \f[C]--rules-file\f[R] option. If a rules file is not found, hledger will create a sample rules file, which you\[aq]ll need to adjust. .PP This file contains rules describing the CSV data (header line, fields layout, date format etc.), and how to construct hledger journal entries (transactions) from it. Often there will also be a list of conditional rules for categorising transactions based on their descriptions. Here\[aq]s an overview of the CSV rules; these are described more fully below, after the examples: .PP .TS tab(@); lw(30.1n) lw(39.9n). T{ \f[B]\f[CB]skip\f[B]\f[R] T}@T{ skip one or more header lines or matched CSV records T} T{ \f[B]\f[CB]fields\f[B]\f[R] T}@T{ name CSV fields, assign them to hledger fields T} T{ \f[B]field assignment\f[R] T}@T{ assign a value to one hledger field, with interpolation T} T{ \f[B]\f[CB]separator\f[B]\f[R] T}@T{ a custom field separator T} T{ \f[B]\f[CB]if\f[B] block\f[R] T}@T{ apply some rules to CSV records matched by patterns T} T{ \f[B]\f[CB]if\f[B] table\f[R] T}@T{ apply some rules to CSV records matched by patterns, alternate syntax T} T{ \f[B]\f[CB]end\f[B]\f[R] T}@T{ skip the remaining CSV records T} T{ \f[B]\f[CB]date-format\f[B]\f[R] T}@T{ describe the format of CSV dates T} T{ \f[B]\f[CB]newest-first\f[B]\f[R] T}@T{ disambiguate record order when there\[aq]s only one date T} T{ \f[B]\f[CB]include\f[B]\f[R] T}@T{ inline another CSV rules file T} T{ \f[B]\f[CB]balance-type\f[B]\f[R] T}@T{ choose which type of balance assignments to use T} .TE .PP Note, for best error messages when reading CSV files, use a \f[C].csv\f[R], \f[C].tsv\f[R] or \f[C].ssv\f[R] file extension or file prefix - see File Extension below. .PP There\[aq]s an introductory Convert CSV files tutorial on hledger.org. .SH EXAMPLES .PP Here are some sample hledger CSV rules files. See also the full collection at: .PD 0 .P .PD https://github.com/simonmichael/hledger/tree/master/examples/csv .SS Basic .PP At minimum, the rules file must identify the date and amount fields, and often it also specifies the date format and how many header lines there are. Here\[aq]s a simple CSV file and a rules file for it: .IP .nf \f[C] Date, Description, Id, Amount 12/11/2019, Foo, 123, 10.23 \f[R] .fi .IP .nf \f[C] # basic.csv.rules skip 1 fields date, description, _, amount date-format %d/%m/%Y \f[R] .fi .IP .nf \f[C] $ hledger print -f basic.csv 2019-11-12 Foo expenses:unknown 10.23 income:unknown -10.23 \f[R] .fi .PP Default account names are chosen, since we didn\[aq]t set them. .SS Bank of Ireland .PP Here\[aq]s a CSV with two amount fields (Debit and Credit), and a balance field, which we can use to add balance assertions, which is not necessary but provides extra error checking: .IP .nf \f[C] Date,Details,Debit,Credit,Balance 07/12/2012,LODGMENT 529898,,10.0,131.21 07/12/2012,PAYMENT,5,,126 \f[R] .fi .IP .nf \f[C] # bankofireland-checking.csv.rules # skip the header line skip # name the csv fields, and assign some of them as journal entry fields fields date, description, amount-out, amount-in, balance # We generate balance assertions by assigning to \[dq]balance\[dq] # above, but you may sometimes need to remove these because: # # - the CSV balance differs from the true balance, # by up to 0.0000000000005 in my experience # # - it is sometimes calculated based on non-chronological ordering, # eg when multiple transactions clear on the same day # date is in UK/Ireland format date-format %d/%m/%Y # set the currency currency EUR # set the base account for all txns account1 assets:bank:boi:checking \f[R] .fi .IP .nf \f[C] $ hledger -f bankofireland-checking.csv print 2012-12-07 LODGMENT 529898 assets:bank:boi:checking EUR10.0 = EUR131.2 income:unknown EUR-10.0 2012-12-07 PAYMENT assets:bank:boi:checking EUR-5.0 = EUR126.0 expenses:unknown EUR5.0 \f[R] .fi .PP The balance assertions don\[aq]t raise an error above, because we\[aq]re reading directly from CSV, but they will be checked if these entries are imported into a journal file. .SS Amazon .PP Here we convert amazon.com order history, and use an if block to generate a third posting if there\[aq]s a fee. (In practice you\[aq]d probably get this data from your bank instead, but it\[aq]s an example.) .IP .nf \f[C] \[dq]Date\[dq],\[dq]Type\[dq],\[dq]To/From\[dq],\[dq]Name\[dq],\[dq]Status\[dq],\[dq]Amount\[dq],\[dq]Fees\[dq],\[dq]Transaction ID\[dq] \[dq]Jul 29, 2012\[dq],\[dq]Payment\[dq],\[dq]To\[dq],\[dq]Foo.\[dq],\[dq]Completed\[dq],\[dq]$20.00\[dq],\[dq]$0.00\[dq],\[dq]16000000000000DGLNJPI1P9B8DKPVHL\[dq] \[dq]Jul 30, 2012\[dq],\[dq]Payment\[dq],\[dq]To\[dq],\[dq]Adapteva, Inc.\[dq],\[dq]Completed\[dq],\[dq]$25.00\[dq],\[dq]$1.00\[dq],\[dq]17LA58JSKRD4HDGLNJPI1P9B8DKPVHL\[dq] \f[R] .fi .IP .nf \f[C] # amazon-orders.csv.rules # skip one header line skip 1 # name the csv fields, and assign the transaction\[aq]s date, amount and code. # Avoided the \[dq]status\[dq] and \[dq]amount\[dq] hledger field names to prevent confusion. fields date, _, toorfrom, name, amzstatus, amzamount, fees, code # how to parse the date date-format %b %-d, %Y # combine two fields to make the description description %toorfrom %name # save the status as a tag comment status:%amzstatus # set the base account for all transactions account1 assets:amazon # leave amount1 blank so it can balance the other(s). # I\[aq]m assuming amzamount excludes the fees, don\[aq]t remember # set a generic account2 account2 expenses:misc amount2 %amzamount # and maybe refine it further: #include categorisation.rules # add a third posting for fees, but only if they are non-zero. if %fees [1-9] account3 expenses:fees amount3 %fees \f[R] .fi .IP .nf \f[C] $ hledger -f amazon-orders.csv print 2012-07-29 (16000000000000DGLNJPI1P9B8DKPVHL) To Foo. ; status:Completed assets:amazon expenses:misc $20.00 2012-07-30 (17LA58JSKRD4HDGLNJPI1P9B8DKPVHL) To Adapteva, Inc. ; status:Completed assets:amazon expenses:misc $25.00 expenses:fees $1.00 \f[R] .fi .SS Paypal .PP Here\[aq]s a real-world rules file for (customised) Paypal CSV, with some Paypal-specific rules, and a second rules file included: .IP .nf \f[C] \[dq]Date\[dq],\[dq]Time\[dq],\[dq]TimeZone\[dq],\[dq]Name\[dq],\[dq]Type\[dq],\[dq]Status\[dq],\[dq]Currency\[dq],\[dq]Gross\[dq],\[dq]Fee\[dq],\[dq]Net\[dq],\[dq]From Email Address\[dq],\[dq]To Email Address\[dq],\[dq]Transaction ID\[dq],\[dq]Item Title\[dq],\[dq]Item ID\[dq],\[dq]Reference Txn ID\[dq],\[dq]Receipt ID\[dq],\[dq]Balance\[dq],\[dq]Note\[dq] \[dq]10/01/2019\[dq],\[dq]03:46:20\[dq],\[dq]PDT\[dq],\[dq]Calm Radio\[dq],\[dq]Subscription Payment\[dq],\[dq]Completed\[dq],\[dq]USD\[dq],\[dq]-6.99\[dq],\[dq]0.00\[dq],\[dq]-6.99\[dq],\[dq]simon\[at]joyful.com\[dq],\[dq]memberships\[at]calmradio.com\[dq],\[dq]60P57143A8206782E\[dq],\[dq]MONTHLY - $1 for the first 2 Months: Me - Order 99309. Item total: $1.00 USD first 2 months, then $6.99 / Month\[dq],\[dq]\[dq],\[dq]I-R8YLY094FJYR\[dq],\[dq]\[dq],\[dq]-6.99\[dq],\[dq]\[dq] \[dq]10/01/2019\[dq],\[dq]03:46:20\[dq],\[dq]PDT\[dq],\[dq]\[dq],\[dq]Bank Deposit to PP Account \[dq],\[dq]Pending\[dq],\[dq]USD\[dq],\[dq]6.99\[dq],\[dq]0.00\[dq],\[dq]6.99\[dq],\[dq]\[dq],\[dq]simon\[at]joyful.com\[dq],\[dq]0TU1544T080463733\[dq],\[dq]\[dq],\[dq]\[dq],\[dq]60P57143A8206782E\[dq],\[dq]\[dq],\[dq]0.00\[dq],\[dq]\[dq] \[dq]10/01/2019\[dq],\[dq]08:57:01\[dq],\[dq]PDT\[dq],\[dq]Patreon\[dq],\[dq]PreApproved Payment Bill User Payment\[dq],\[dq]Completed\[dq],\[dq]USD\[dq],\[dq]-7.00\[dq],\[dq]0.00\[dq],\[dq]-7.00\[dq],\[dq]simon\[at]joyful.com\[dq],\[dq]support\[at]patreon.com\[dq],\[dq]2722394R5F586712G\[dq],\[dq]Patreon* Membership\[dq],\[dq]\[dq],\[dq]B-0PG93074E7M86381M\[dq],\[dq]\[dq],\[dq]-7.00\[dq],\[dq]\[dq] \[dq]10/01/2019\[dq],\[dq]08:57:01\[dq],\[dq]PDT\[dq],\[dq]\[dq],\[dq]Bank Deposit to PP Account \[dq],\[dq]Pending\[dq],\[dq]USD\[dq],\[dq]7.00\[dq],\[dq]0.00\[dq],\[dq]7.00\[dq],\[dq]\[dq],\[dq]simon\[at]joyful.com\[dq],\[dq]71854087RG994194F\[dq],\[dq]Patreon* Membership\[dq],\[dq]\[dq],\[dq]2722394R5F586712G\[dq],\[dq]\[dq],\[dq]0.00\[dq],\[dq]\[dq] \[dq]10/19/2019\[dq],\[dq]03:02:12\[dq],\[dq]PDT\[dq],\[dq]Wikimedia Foundation, Inc.\[dq],\[dq]Subscription Payment\[dq],\[dq]Completed\[dq],\[dq]USD\[dq],\[dq]-2.00\[dq],\[dq]0.00\[dq],\[dq]-2.00\[dq],\[dq]simon\[at]joyful.com\[dq],\[dq]tle\[at]wikimedia.org\[dq],\[dq]K9U43044RY432050M\[dq],\[dq]Monthly donation to the Wikimedia Foundation\[dq],\[dq]\[dq],\[dq]I-R5C3YUS3285L\[dq],\[dq]\[dq],\[dq]-2.00\[dq],\[dq]\[dq] \[dq]10/19/2019\[dq],\[dq]03:02:12\[dq],\[dq]PDT\[dq],\[dq]\[dq],\[dq]Bank Deposit to PP Account \[dq],\[dq]Pending\[dq],\[dq]USD\[dq],\[dq]2.00\[dq],\[dq]0.00\[dq],\[dq]2.00\[dq],\[dq]\[dq],\[dq]simon\[at]joyful.com\[dq],\[dq]3XJ107139A851061F\[dq],\[dq]\[dq],\[dq]\[dq],\[dq]K9U43044RY432050M\[dq],\[dq]\[dq],\[dq]0.00\[dq],\[dq]\[dq] \[dq]10/22/2019\[dq],\[dq]05:07:06\[dq],\[dq]PDT\[dq],\[dq]Noble Benefactor\[dq],\[dq]Subscription Payment\[dq],\[dq]Completed\[dq],\[dq]USD\[dq],\[dq]10.00\[dq],\[dq]-0.59\[dq],\[dq]9.41\[dq],\[dq]noble\[at]bene.fac.tor\[dq],\[dq]simon\[at]joyful.com\[dq],\[dq]6L8L1662YP1334033\[dq],\[dq]Joyful Systems\[dq],\[dq]\[dq],\[dq]I-KC9VBGY2GWDB\[dq],\[dq]\[dq],\[dq]9.41\[dq],\[dq]\[dq] \f[R] .fi .IP .nf \f[C] # paypal-custom.csv.rules # Tips: # Export from Activity -> Statements -> Custom -> Activity download # Suggested transaction type: \[dq]Balance affecting\[dq] # Paypal\[aq]s default fields in 2018 were: # \[dq]Date\[dq],\[dq]Time\[dq],\[dq]TimeZone\[dq],\[dq]Name\[dq],\[dq]Type\[dq],\[dq]Status\[dq],\[dq]Currency\[dq],\[dq]Gross\[dq],\[dq]Fee\[dq],\[dq]Net\[dq],\[dq]From Email Address\[dq],\[dq]To Email Address\[dq],\[dq]Transaction ID\[dq],\[dq]Shipping Address\[dq],\[dq]Address Status\[dq],\[dq]Item Title\[dq],\[dq]Item ID\[dq],\[dq]Shipping and Handling Amount\[dq],\[dq]Insurance Amount\[dq],\[dq]Sales Tax\[dq],\[dq]Option 1 Name\[dq],\[dq]Option 1 Value\[dq],\[dq]Option 2 Name\[dq],\[dq]Option 2 Value\[dq],\[dq]Reference Txn ID\[dq],\[dq]Invoice Number\[dq],\[dq]Custom Number\[dq],\[dq]Quantity\[dq],\[dq]Receipt ID\[dq],\[dq]Balance\[dq],\[dq]Address Line 1\[dq],\[dq]Address Line 2/District/Neighborhood\[dq],\[dq]Town/City\[dq],\[dq]State/Province/Region/County/Territory/Prefecture/Republic\[dq],\[dq]Zip/Postal Code\[dq],\[dq]Country\[dq],\[dq]Contact Phone Number\[dq],\[dq]Subject\[dq],\[dq]Note\[dq],\[dq]Country Code\[dq],\[dq]Balance Impact\[dq] # This rules file assumes the following more detailed fields, configured in \[dq]Customize report fields\[dq]: # \[dq]Date\[dq],\[dq]Time\[dq],\[dq]TimeZone\[dq],\[dq]Name\[dq],\[dq]Type\[dq],\[dq]Status\[dq],\[dq]Currency\[dq],\[dq]Gross\[dq],\[dq]Fee\[dq],\[dq]Net\[dq],\[dq]From Email Address\[dq],\[dq]To Email Address\[dq],\[dq]Transaction ID\[dq],\[dq]Item Title\[dq],\[dq]Item ID\[dq],\[dq]Reference Txn ID\[dq],\[dq]Receipt ID\[dq],\[dq]Balance\[dq],\[dq]Note\[dq] fields date, time, timezone, description_, type, status_, currency, grossamount, feeamount, netamount, fromemail, toemail, code, itemtitle, itemid, referencetxnid, receiptid, balance, note skip 1 date-format %-m/%-d/%Y # ignore some paypal events if In Progress Temporary Hold Update to skip # add more fields to the description description %description_ %itemtitle # save some other fields as tags comment itemid:%itemid, fromemail:%fromemail, toemail:%toemail, time:%time, type:%type, status:%status_ # convert to short currency symbols if %currency USD currency $ if %currency EUR currency E if %currency GBP currency P # generate postings # the first posting will be the money leaving/entering my paypal account # (negative means leaving my account, in all amount fields) account1 assets:online:paypal amount1 %netamount # the second posting will be money sent to/received from other party # (account2 is set below) amount2 -%grossamount # if there\[aq]s a fee, add a third posting for the money taken by paypal. if %feeamount [1-9] account3 expenses:banking:paypal amount3 -%feeamount comment3 business: # choose an account for the second posting # override the default account names: # if the amount is positive, it\[aq]s income (a debit) if %grossamount \[ha][\[ha]-] account2 income:unknown # if negative, it\[aq]s an expense (a credit) if %grossamount \[ha]- account2 expenses:unknown # apply common rules for setting account2 & other tweaks include common.rules # apply some overrides specific to this csv # Transfers from/to bank. These are usually marked Pending, # which can be disregarded in this case. if Bank Account Bank Deposit to PP Account description %type for %referencetxnid %itemtitle account2 assets:bank:wf:pchecking account1 assets:online:paypal # Currency conversions if Currency Conversion account2 equity:currency conversion \f[R] .fi .IP .nf \f[C] # common.rules if darcs noble benefactor account2 revenues:foss donations:darcshub comment2 business: if Calm Radio account2 expenses:online:apps if electronic frontier foundation Patreon wikimedia Advent of Code account2 expenses:dues if Google account2 expenses:online:apps description google | music \f[R] .fi .IP .nf \f[C] $ hledger -f paypal-custom.csv print 2019-10-01 (60P57143A8206782E) Calm Radio MONTHLY - $1 for the first 2 Months: Me - Order 99309. Item total: $1.00 USD first 2 months, then $6.99 / Month ; itemid:, fromemail:simon\[at]joyful.com, toemail:memberships\[at]calmradio.com, time:03:46:20, type:Subscription Payment, status:Completed assets:online:paypal $-6.99 = $-6.99 expenses:online:apps $6.99 2019-10-01 (0TU1544T080463733) Bank Deposit to PP Account for 60P57143A8206782E ; itemid:, fromemail:, toemail:simon\[at]joyful.com, time:03:46:20, type:Bank Deposit to PP Account, status:Pending assets:online:paypal $6.99 = $0.00 assets:bank:wf:pchecking $-6.99 2019-10-01 (2722394R5F586712G) Patreon Patreon* Membership ; itemid:, fromemail:simon\[at]joyful.com, toemail:support\[at]patreon.com, time:08:57:01, type:PreApproved Payment Bill User Payment, status:Completed assets:online:paypal $-7.00 = $-7.00 expenses:dues $7.00 2019-10-01 (71854087RG994194F) Bank Deposit to PP Account for 2722394R5F586712G Patreon* Membership ; itemid:, fromemail:, toemail:simon\[at]joyful.com, time:08:57:01, type:Bank Deposit to PP Account, status:Pending assets:online:paypal $7.00 = $0.00 assets:bank:wf:pchecking $-7.00 2019-10-19 (K9U43044RY432050M) Wikimedia Foundation, Inc. Monthly donation to the Wikimedia Foundation ; itemid:, fromemail:simon\[at]joyful.com, toemail:tle\[at]wikimedia.org, time:03:02:12, type:Subscription Payment, status:Completed assets:online:paypal $-2.00 = $-2.00 expenses:dues $2.00 expenses:banking:paypal ; business: 2019-10-19 (3XJ107139A851061F) Bank Deposit to PP Account for K9U43044RY432050M ; itemid:, fromemail:, toemail:simon\[at]joyful.com, time:03:02:12, type:Bank Deposit to PP Account, status:Pending assets:online:paypal $2.00 = $0.00 assets:bank:wf:pchecking $-2.00 2019-10-22 (6L8L1662YP1334033) Noble Benefactor Joyful Systems ; itemid:, fromemail:noble\[at]bene.fac.tor, toemail:simon\[at]joyful.com, time:05:07:06, type:Subscription Payment, status:Completed assets:online:paypal $9.41 = $9.41 revenues:foss donations:darcshub $-10.00 ; business: expenses:banking:paypal $0.59 ; business: \f[R] .fi .SH CSV RULES .PP The following kinds of rule can appear in the rules file, in any order. Blank lines and lines beginning with \f[C]#\f[R] or \f[C];\f[R] are ignored. .SS \f[C]skip\f[R] .IP .nf \f[C] skip N \f[R] .fi .PP The word \[dq]skip\[dq] followed by a number (or no number, meaning 1) tells hledger to ignore this many non-empty lines preceding the CSV data. (Empty/blank lines are skipped automatically.) You\[aq]ll need this whenever your CSV data contains header lines. .PP It also has a second purpose: it can be used inside if blocks to ignore certain CSV records (described below). .SS \f[C]fields\f[R] .IP .nf \f[C] fields FIELDNAME1, FIELDNAME2, ... \f[R] .fi .PP A fields list (the word \[dq]fields\[dq] followed by comma-separated field names) is the quick way to assign CSV field values to hledger fields. It does two things: .IP "1." 3 it names the CSV fields. This is optional, but can be convenient later for interpolating them. .IP "2." 3 when you use a standard hledger field name, it assigns the CSV value to that part of the hledger transaction. .PP Here\[aq]s an example that says \[dq]use the 1st, 2nd and 4th fields as the transaction\[aq]s date, description and amount; name the last two fields for later reference; and ignore the others\[dq]: .IP .nf \f[C] fields date, description, , amount, , , somefield, anotherfield \f[R] .fi .PP Field names may not contain whitespace. Fields you don\[aq]t care about can be left unnamed. Currently there must be least two items (there must be at least one comma). .PP Note, always use comma in the fields list, even if your CSV uses another separator character. .PP Here are the standard hledger field/pseudo-field names. For more about the transaction parts they refer to, see the manual for hledger\[aq]s journal format. .SS Transaction field names .PP \f[C]date\f[R], \f[C]date2\f[R], \f[C]status\f[R], \f[C]code\f[R], \f[C]description\f[R], \f[C]comment\f[R] can be used to form the transaction\[aq]s first line. .SS Posting field names .SS account .PP \f[C]accountN\f[R], where N is 1 to 99, causes a posting to be generated, with that account name. .PP Most often there are two postings, so you\[aq]ll want to set \f[C]account1\f[R] and \f[C]account2\f[R]. Typically \f[C]account1\f[R] is associated with the CSV file, and is set once with a top-level assignment, while \f[C]account2\f[R] is set based on each transaction\[aq]s description, and in conditional blocks. .PP If a posting\[aq]s account name is left unset but its amount is set (see below), a default account name will be chosen (like \[dq]expenses:unknown\[dq] or \[dq]income:unknown\[dq]). .SS amount .PP \f[C]amountN\f[R] sets posting N\[aq]s amount. If the CSV uses separate fields for inflows and outflows, you can use \f[C]amountN-in\f[R] and \f[C]amountN-out\f[R] instead. By assigning to \f[C]amount1\f[R], \f[C]amount2\f[R], ... etc. you can generate anywhere from 0 to 99 postings. .PP There is also an older, unnumbered form of these names, suitable for 2-posting transactions, which sets both posting 1\[aq]s and (negated) posting 2\[aq]s amount: \f[C]amount\f[R], or \f[C]amount-in\f[R] and \f[C]amount-out\f[R]. This is still supported because it keeps pre-hledger-1.17 csv rules files working, and because it can be more succinct, and because it converts posting 2\[aq]s amount to cost if there\[aq]s a transaction price, which can be useful. .PP If you have an existing rules file using the unnumbered form, you might want to use the numbered form in certain conditional blocks, without having to update and retest all the old rules. To facilitate this, posting 1 ignores \f[C]amount\f[R]/\f[C]amount-in\f[R]/\f[C]amount-out\f[R] if any of \f[C]amount1\f[R]/\f[C]amount1-in\f[R]/\f[C]amount1-out\f[R] are assigned, and posting 2 ignores them if any of \f[C]amount2\f[R]/\f[C]amount2-in\f[R]/\f[C]amount2-out\f[R] are assigned, avoiding conflicts. .SS currency .PP If the CSV has the currency symbol in a separate field (ie, not part of the amount field), you can use \f[C]currencyN\f[R] to prepend it to posting N\[aq]s amount. Or, \f[C]currency\f[R] with no number affects all postings. .SS balance .PP \f[C]balanceN\f[R] sets a balance assertion amount (or if the posting amount is left empty, a balance assignment) on posting N. .PP Also, for compatibility with hledger <1.17: \f[C]balance\f[R] with no number is equivalent to \f[C]balance1\f[R]. .PP You can adjust the type of assertion/assignment with the \f[C]balance-type\f[R] rule (see below). .SS comment .PP Finally, \f[C]commentN\f[R] sets a comment on the Nth posting. Comments can also contain tags, as usual. .PP See TIPS below for more about setting amounts and currency. .SS field assignment .IP .nf \f[C] HLEDGERFIELDNAME FIELDVALUE \f[R] .fi .PP Instead of or in addition to a fields list, you can use a \[dq]field assignment\[dq] rule to set the value of a single hledger field, by writing its name (any of the standard hledger field names above) followed by a text value. The value may contain interpolated CSV fields, referenced by their 1-based position in the CSV record (\f[C]%N\f[R]), or by the name they were given in the fields list (\f[C]%CSVFIELDNAME\f[R]). Some examples: .IP .nf \f[C] # set the amount to the 4th CSV field, with \[dq] USD\[dq] appended amount %4 USD # combine three fields to make a comment, containing note: and date: tags comment note: %somefield - %anotherfield, date: %1 \f[R] .fi .PP Interpolation strips outer whitespace (so a CSV value like \f[C]\[dq] 1 \[dq]\f[R] becomes \f[C]1\f[R] when interpolated) (#1051). See TIPS below for more about referencing other fields. .SS \f[C]separator\f[R] .PP You can use the \f[C]separator\f[R] rule to read other kinds of character-separated data. The argument is any single separator character, or the words \f[C]tab\f[R] or \f[C]space\f[R] (case insensitive). Eg, for comma-separated values (CSV): .IP .nf \f[C] separator , \f[R] .fi .PP or for semicolon-separated values (SSV): .IP .nf \f[C] separator ; \f[R] .fi .PP or for tab-separated values (TSV): .IP .nf \f[C] separator TAB \f[R] .fi .PP If the input file has a \f[C].csv\f[R], \f[C].ssv\f[R] or \f[C].tsv\f[R] file extension (or a \f[C]csv:\f[R], \f[C]ssv:\f[R], \f[C]tsv:\f[R] prefix), the appropriate separator will be inferred automatically, and you won\[aq]t need this rule. .SS \f[C]if\f[R] block .IP .nf \f[C] if MATCHER RULE if MATCHER MATCHER MATCHER RULE RULE \f[R] .fi .PP Conditional blocks (\[dq]if blocks\[dq]) are a block of rules that are applied only to CSV records which match certain patterns. They are often used for customising account names based on transaction descriptions. .SS Matching the whole record .PP Each MATCHER can be a record matcher, which looks like this: .IP .nf \f[C] REGEX \f[R] .fi .PP REGEX is a case-insensitive regular expression which tries to match anywhere within the CSV record. It is a POSIX ERE (extended regular expression) that also supports GNU word boundaries (\f[C]\[rs]b\f[R], \f[C]\[rs]B\f[R], \f[C]\[rs]<\f[R], \f[C]\[rs]>\f[R]), and nothing else. If you have trouble, be sure to check our https://hledger.org/hledger.html#regular-expressions doc. .PP Important note: the record that is matched is not the original record, but a synthetic one, with any enclosing double quotes (but not enclosing whitespace) removed, and always comma-separated (which means that a field containing a comma will appear like two fields). Eg, if the original record is \f[C]2020-01-01; \[dq]Acme, Inc.\[dq]; 1,000\f[R], the REGEX will actually see \f[C]2020-01-01,Acme, Inc., 1,000\f[R]). .SS Matching individual fields .PP Or, MATCHER can be a field matcher, like this: .IP .nf \f[C] %CSVFIELD REGEX \f[R] .fi .PP which matches just the content of a particular CSV field. CSVFIELD is a percent sign followed by the field\[aq]s name or column number, like \f[C]%date\f[R] or \f[C]%1\f[R]. .SS Combining matchers .PP A single matcher can be written on the same line as the \[dq]if\[dq]; or multiple matchers can be written on the following lines, non-indented. Multiple matchers are OR\[aq]d (any one of them can match), unless one begins with an \f[C]&\f[R] symbol, in which case it is AND\[aq]ed with the previous matcher. .IP .nf \f[C] if MATCHER & MATCHER RULE \f[R] .fi .SS Rules applied on successful match .PP After the patterns there should be one or more rules to apply, all indented by at least one space. Three kinds of rule are allowed in conditional blocks: .IP \[bu] 2 field assignments (to set a hledger field) .IP \[bu] 2 skip (to skip the matched CSV record) .IP \[bu] 2 end (to skip all remaining CSV records). .PP Examples: .IP .nf \f[C] # if the CSV record contains \[dq]groceries\[dq], set account2 to \[dq]expenses:groceries\[dq] if groceries account2 expenses:groceries \f[R] .fi .IP .nf \f[C] # if the CSV record contains any of these patterns, set account2 and comment as shown if monthly service fee atm transaction fee banking thru software account2 expenses:business:banking comment XXX deductible ? check it \f[R] .fi .SS \f[C]if\f[R] table .IP .nf \f[C] if,CSVFIELDNAME1,CSVFIELDNAME2,...,CSVFIELDNAMEn MATCHER1,VALUE11,VALUE12,...,VALUE1n MATCHER2,VALUE21,VALUE22,...,VALUE2n MATCHER3,VALUE31,VALUE32,...,VALUE3n \f[R] .fi .PP Conditional tables (\[dq]if tables\[dq]) are a different syntax to specify field assignments that will be applied only to CSV records which match certain patterns. .PP MATCHER could be either field or record matcher, as described above. When MATCHER matches, values from that row would be assigned to the CSV fields named on the \f[C]if\f[R] line, in the same order. .PP Therefore \f[C]if\f[R] table is exactly equivalent to a sequence of of \f[C]if\f[R] blocks: .IP .nf \f[C] if MATCHER1 CSVFIELDNAME1 VALUE11 CSVFIELDNAME2 VALUE12 ... CSVFIELDNAMEn VALUE1n if MATCHER2 CSVFIELDNAME1 VALUE21 CSVFIELDNAME2 VALUE22 ... CSVFIELDNAMEn VALUE2n if MATCHER3 CSVFIELDNAME1 VALUE31 CSVFIELDNAME2 VALUE32 ... CSVFIELDNAMEn VALUE3n \f[R] .fi .PP Each line starting with MATCHER should contain enough (possibly empty) values for all the listed fields. .PP Rules would be checked and applied in the order they are listed in the table and, like with \f[C]if\f[R] blocks, later rules (in the same or another table) or \f[C]if\f[R] blocks could override the effect of any rule. .PP Instead of \[aq],\[aq] you can use a variety of other non-alphanumeric characters as a separator. First character after \f[C]if\f[R] is taken to be the separator for the rest of the table. It is the responsibility of the user to ensure that separator does not occur inside MATCHERs and values - there is no way to escape separator. .PP Example: .IP .nf \f[C] if,account2,comment atm transaction fee,expenses:business:banking,deductible? check it %description groceries,expenses:groceries, 2020/01/12.*Plumbing LLC,expenses:house:upkeep,emergency plumbing call-out \f[R] .fi .SS \f[C]end\f[R] .PP This rule can be used inside if blocks (only), to make hledger stop reading this CSV file and move on to the next input file, or to command execution. Eg: .IP .nf \f[C] # ignore everything following the first empty record if ,,,, end \f[R] .fi .SS \f[C]date-format\f[R] .IP .nf \f[C] date-format DATEFMT \f[R] .fi .PP This is a helper for the \f[C]date\f[R] (and \f[C]date2\f[R]) fields. If your CSV dates are not formatted like \f[C]YYYY-MM-DD\f[R], \f[C]YYYY/MM/DD\f[R] or \f[C]YYYY.MM.DD\f[R], you\[aq]ll need to add a date-format rule describing them with a strptime date parsing pattern, which must parse the CSV date value completely. Some examples: .IP .nf \f[C] # MM/DD/YY date-format %m/%d/%y \f[R] .fi .IP .nf \f[C] # D/M/YYYY # The - makes leading zeros optional. date-format %-d/%-m/%Y \f[R] .fi .IP .nf \f[C] # YYYY-Mmm-DD date-format %Y-%h-%d \f[R] .fi .IP .nf \f[C] # M/D/YYYY HH:MM AM some other junk # Note the time and junk must be fully parsed, though only the date is used. date-format %-m/%-d/%Y %l:%M %p some other junk \f[R] .fi .PP For the supported strptime syntax, see: .PD 0 .P .PD https://hackage.haskell.org/package/time/docs/Data-Time-Format.html#v:formatTime .SS \f[C]newest-first\f[R] .PP hledger always sorts the generated transactions by date. Transactions on the same date should appear in the same order as their CSV records, as hledger can usually auto-detect whether the CSV\[aq]s normal order is oldest first or newest first. But if all of the following are true: .IP \[bu] 2 the CSV might sometimes contain just one day of data (all records having the same date) .IP \[bu] 2 the CSV records are normally in reverse chronological order (newest at the top) .IP \[bu] 2 and you care about preserving the order of same-day transactions .PP then, you should add the \f[C]newest-first\f[R] rule as a hint. Eg: .IP .nf \f[C] # tell hledger explicitly that the CSV is normally newest first newest-first \f[R] .fi .SS \f[C]include\f[R] .IP .nf \f[C] include RULESFILE \f[R] .fi .PP This includes the contents of another CSV rules file at this point. \f[C]RULESFILE\f[R] is an absolute file path or a path relative to the current file\[aq]s directory. This can be useful for sharing common rules between several rules files, eg: .IP .nf \f[C] # someaccount.csv.rules ## someaccount-specific rules fields date,description,amount account1 assets:someaccount account2 expenses:misc ## common rules include categorisation.rules \f[R] .fi .SS \f[C]balance-type\f[R] .PP Balance assertions generated by assigning to balanceN are of the simple \f[C]=\f[R] type by default, which is a single-commodity, subaccount-excluding assertion. You may find the subaccount-including variants more useful, eg if you have created some virtual subaccounts of checking to help with budgeting. You can select a different type of assertion with the \f[C]balance-type\f[R] rule: .IP .nf \f[C] # balance assertions will consider all commodities and all subaccounts balance-type ==* \f[R] .fi .PP Here are the balance assertion types for quick reference: .IP .nf \f[C] = single commodity, exclude subaccounts =* single commodity, include subaccounts == multi commodity, exclude subaccounts ==* multi commodity, include subaccounts \f[R] .fi .SH TIPS .SS Rapid feedback .PP It\[aq]s a good idea to get rapid feedback while creating/troubleshooting CSV rules. Here\[aq]s a good way, using entr from http://eradman.com/entrproject : .IP .nf \f[C] $ ls foo.csv* | entr bash -c \[aq]echo ----; hledger -f foo.csv print desc:SOMEDESC\[aq] \f[R] .fi .PP A desc: query (eg) is used to select just one, or a few, transactions of interest. \[dq]bash -c\[dq] is used to run multiple commands, so we can echo a separator each time the command re-runs, making it easier to read the output. .SS Valid CSV .PP hledger accepts CSV conforming to RFC 4180. When CSV values are enclosed in quotes, note: .IP \[bu] 2 they must be double quotes (not single quotes) .IP \[bu] 2 spaces outside the quotes are not allowed .SS File Extension .PP To help hledger identify the format and show the right error messages, CSV/SSV/TSV files should normally be named with a \f[C].csv\f[R], \f[C].ssv\f[R] or \f[C].tsv\f[R] filename extension. Or, the file path should be prefixed with \f[C]csv:\f[R], \f[C]ssv:\f[R] or \f[C]tsv:\f[R]. Eg: .IP .nf \f[C] $ hledger -f foo.ssv print \f[R] .fi .PP or: .IP .nf \f[C] $ cat foo | hledger -f ssv:- foo \f[R] .fi .PP You can override the file extension with a separator rule if needed. See also: Input files in the hledger manual. .SS Reading multiple CSV files .PP If you use multiple \f[C]-f\f[R] options to read multiple CSV files at once, hledger will look for a correspondingly-named rules file for each CSV file. But if you use the \f[C]--rules-file\f[R] option, that rules file will be used for all the CSV files. .SS Valid transactions .PP After reading a CSV file, hledger post-processes and validates the generated journal entries as it would for a journal file - balancing them, applying balance assignments, and canonicalising amount styles. Any errors at this stage will be reported in the usual way, displaying the problem entry. .PP There is one exception: balance assertions, if you have generated them, will not be checked, since normally these will work only when the CSV data is part of the main journal. If you do need to check balance assertions generated from CSV right away, pipe into another hledger: .IP .nf \f[C] $ hledger -f file.csv print | hledger -f- print \f[R] .fi .SS Deduplicating, importing .PP When you download a CSV file periodically, eg to get your latest bank transactions, the new file may overlap with the old one, containing some of the same records. .PP The import command will (a) detect the new transactions, and (b) append just those transactions to your main journal. It is idempotent, so you don\[aq]t have to remember how many times you ran it or with which version of the CSV. (It keeps state in a hidden \f[C].latest.FILE.csv\f[R] file.) This is the easiest way to import CSV data. Eg: .IP .nf \f[C] # download the latest CSV files, then run this command. # Note, no -f flags needed here. $ hledger import *.csv [--dry] \f[R] .fi .PP This method works for most CSV files. (Where records have a stable chronological order, and new records appear only at the new end.) .PP A number of other tools and workflows, hledger-specific and otherwise, exist for converting, deduplicating, classifying and managing CSV data. See: .IP \[bu] 2 https://hledger.org -> sidebar -> real world setups .IP \[bu] 2 https://plaintextaccounting.org -> data import/conversion .SS Setting amounts .PP A posting amount can be set in one of these ways: .IP \[bu] 2 by assigning (with a fields list or field assignment) to \f[C]amountN\f[R] (posting N\[aq]s amount) or \f[C]amount\f[R] (posting 1\[aq]s amount) .IP \[bu] 2 by assigning to \f[C]amountN-in\f[R] and \f[C]amountN-out\f[R] (or \f[C]amount-in\f[R] and \f[C]amount-out\f[R]). For each CSV record, whichever of these has a non-zero value will be used, with appropriate sign. If both contain a non-zero value, this may not work. .IP \[bu] 2 by assigning to \f[C]balanceN\f[R] (or \f[C]balance\f[R]) instead of the above, setting the amount indirectly via a balance assignment. If you do this the default account name may be wrong, so you should set that explicitly. .PP There is some special handling for an amount\[aq]s sign: .IP \[bu] 2 If an amount value is parenthesised, it will be de-parenthesised and sign-flipped. .IP \[bu] 2 If an amount value begins with a double minus sign, those cancel out and are removed. .IP \[bu] 2 If an amount value begins with a plus sign, that will be removed .SS Setting currency/commodity .PP If the currency/commodity symbol is included in the CSV\[aq]s amount field(s), you don\[aq]t have to do anything special. .PP If the currency is provided as a separate CSV field, you can either: .IP \[bu] 2 assign that to \f[C]currency\f[R], which adds it to all posting amounts. The symbol will prepended to the amount quantity (on the left side). If you write a trailing space after the symbol, there will be a space between symbol and amount (an exception to the usual whitespace stripping). .IP \[bu] 2 or assign it to \f[C]currencyN\f[R] which adds it to posting N\[aq]s amount only. .IP \[bu] 2 or for more control, construct the amount from symbol and quantity using field assignment, eg: .RS 2 .IP .nf \f[C] fields date,description,currency,quantity # add currency symbol on the right: amount %quantity %currency \f[R] .fi .RE .SS Referencing other fields .PP In field assignments, you can interpolate only CSV fields, not hledger fields. In the example below, there\[aq]s both a CSV field and a hledger field named amount1, but %amount1 always means the CSV field, not the hledger field: .IP .nf \f[C] # Name the third CSV field \[dq]amount1\[dq] fields date,description,amount1 # Set hledger\[aq]s amount1 to the CSV amount1 field followed by USD amount1 %amount1 USD # Set comment to the CSV amount1 (not the amount1 assigned above) comment %amount1 \f[R] .fi .PP Here, since there\[aq]s no CSV amount1 field, %amount1 will produce a literal \[dq]amount1\[dq]: .IP .nf \f[C] fields date,description,csvamount amount1 %csvamount USD # Can\[aq]t interpolate amount1 here comment %amount1 \f[R] .fi .PP When there are multiple field assignments to the same hledger field, only the last one takes effect. Here, comment\[aq]s value will be be B, or C if \[dq]something\[dq] is matched, but never A: .IP .nf \f[C] comment A comment B if something comment C \f[R] .fi .SS How CSV rules are evaluated .PP Here\[aq]s how to think of CSV rules being evaluated (if you really need to). First, .IP \[bu] 2 \f[C]include\f[R] - all includes are inlined, from top to bottom, depth first. (At each include point the file is inlined and scanned for further includes, recursively, before proceeding.) .PP Then \[dq]global\[dq] rules are evaluated, top to bottom. If a rule is repeated, the last one wins: .IP \[bu] 2 \f[C]skip\f[R] (at top level) .IP \[bu] 2 \f[C]date-format\f[R] .IP \[bu] 2 \f[C]newest-first\f[R] .IP \[bu] 2 \f[C]fields\f[R] - names the CSV fields, optionally sets up initial assignments to hledger fields .PP Then for each CSV record in turn: .IP \[bu] 2 test all \f[C]if\f[R] blocks. If any of them contain a \f[C]end\f[R] rule, skip all remaining CSV records. Otherwise if any of them contain a \f[C]skip\f[R] rule, skip that many CSV records. If there are multiple matched \f[C]skip\f[R] rules, the first one wins. .IP \[bu] 2 collect all field assignments at top level and in matched \f[C]if\f[R] blocks. When there are multiple assignments for a field, keep only the last one. .IP \[bu] 2 compute a value for each hledger field - either the one that was assigned to it (and interpolate the %CSVFIELDNAME references), or a default .IP \[bu] 2 generate a synthetic hledger transaction from these values. .PP This is all part of the CSV reader, one of several readers hledger can use to parse input files. When all files have been read successfully, the transactions are passed as input to whichever hledger command the user specified. .SH "REPORTING BUGS" Report bugs at http://bugs.hledger.org (or on the #hledger IRC channel or hledger mail list) .SH AUTHORS Simon Michael and contributors .SH COPYRIGHT Copyright (C) 2007-2019 Simon Michael. .br Released under GNU GPL v3 or later. .SH SEE ALSO hledger(1), hledger\-ui(1), hledger\-web(1), hledger\-api(1), hledger_csv(5), hledger_journal(5), hledger_timeclock(5), hledger_timedot(5), ledger(1) http://hledger.org hledger-lib-1.19.1/hledger_csv.txt0000644000000000000000000012017513725533425015214 0ustar0000000000000000 hledger_csv(5) hledger User Manuals hledger_csv(5) NAME CSV - how hledger reads CSV data, and the CSV rules file format DESCRIPTION hledger can read CSV files (Character Separated Value - usually comma, semicolon, or tab) containing dated records as if they were journal files, automatically converting each CSV record into a transaction. (To learn about writing CSV, see CSV output.) We describe each CSV file's format with a corresponding rules file. By default this is named like the CSV file with a .rules extension added. Eg when reading FILE.csv, hledger also looks for FILE.csv.rules in the same directory as FILE.csv. You can specify a different rules file with the --rules-file option. If a rules file is not found, hledger will create a sample rules file, which you'll need to adjust. This file contains rules describing the CSV data (header line, fields layout, date format etc.), and how to construct hledger journal entries (transactions) from it. Often there will also be a list of conditional rules for categorising transactions based on their descriptions. Here's an overview of the CSV rules; these are described more fully be- low, after the examples: skip skip one or more header lines or matched CSV records fields name CSV fields, assign them to hledger fields field assignment assign a value to one hledger field, with interpolation separator a custom field separator if block apply some rules to CSV records matched by patterns if table apply some rules to CSV records matched by patterns, alternate syntax end skip the remaining CSV records date-format describe the format of CSV dates newest-first disambiguate record order when there's only one date include inline another CSV rules file balance-type choose which type of balance assignments to use Note, for best error messages when reading CSV files, use a .csv, .tsv or .ssv file extension or file prefix - see File Extension below. There's an introductory Convert CSV files tutorial on hledger.org. EXAMPLES Here are some sample hledger CSV rules files. See also the full col- lection at: https://github.com/simonmichael/hledger/tree/master/examples/csv Basic At minimum, the rules file must identify the date and amount fields, and often it also specifies the date format and how many header lines there are. Here's a simple CSV file and a rules file for it: Date, Description, Id, Amount 12/11/2019, Foo, 123, 10.23 # basic.csv.rules skip 1 fields date, description, _, amount date-format %d/%m/%Y $ hledger print -f basic.csv 2019-11-12 Foo expenses:unknown 10.23 income:unknown -10.23 Default account names are chosen, since we didn't set them. Bank of Ireland Here's a CSV with two amount fields (Debit and Credit), and a balance field, which we can use to add balance assertions, which is not neces- sary but provides extra error checking: Date,Details,Debit,Credit,Balance 07/12/2012,LODGMENT 529898,,10.0,131.21 07/12/2012,PAYMENT,5,,126 # bankofireland-checking.csv.rules # skip the header line skip # name the csv fields, and assign some of them as journal entry fields fields date, description, amount-out, amount-in, balance # We generate balance assertions by assigning to "balance" # above, but you may sometimes need to remove these because: # # - the CSV balance differs from the true balance, # by up to 0.0000000000005 in my experience # # - it is sometimes calculated based on non-chronological ordering, # eg when multiple transactions clear on the same day # date is in UK/Ireland format date-format %d/%m/%Y # set the currency currency EUR # set the base account for all txns account1 assets:bank:boi:checking $ hledger -f bankofireland-checking.csv print 2012-12-07 LODGMENT 529898 assets:bank:boi:checking EUR10.0 = EUR131.2 income:unknown EUR-10.0 2012-12-07 PAYMENT assets:bank:boi:checking EUR-5.0 = EUR126.0 expenses:unknown EUR5.0 The balance assertions don't raise an error above, because we're read- ing directly from CSV, but they will be checked if these entries are imported into a journal file. Amazon Here we convert amazon.com order history, and use an if block to gener- ate a third posting if there's a fee. (In practice you'd probably get this data from your bank instead, but it's an example.) "Date","Type","To/From","Name","Status","Amount","Fees","Transaction ID" "Jul 29, 2012","Payment","To","Foo.","Completed","$20.00","$0.00","16000000000000DGLNJPI1P9B8DKPVHL" "Jul 30, 2012","Payment","To","Adapteva, Inc.","Completed","$25.00","$1.00","17LA58JSKRD4HDGLNJPI1P9B8DKPVHL" # amazon-orders.csv.rules # skip one header line skip 1 # name the csv fields, and assign the transaction's date, amount and code. # Avoided the "status" and "amount" hledger field names to prevent confusion. fields date, _, toorfrom, name, amzstatus, amzamount, fees, code # how to parse the date date-format %b %-d, %Y # combine two fields to make the description description %toorfrom %name # save the status as a tag comment status:%amzstatus # set the base account for all transactions account1 assets:amazon # leave amount1 blank so it can balance the other(s). # I'm assuming amzamount excludes the fees, don't remember # set a generic account2 account2 expenses:misc amount2 %amzamount # and maybe refine it further: #include categorisation.rules # add a third posting for fees, but only if they are non-zero. if %fees [1-9] account3 expenses:fees amount3 %fees $ hledger -f amazon-orders.csv print 2012-07-29 (16000000000000DGLNJPI1P9B8DKPVHL) To Foo. ; status:Completed assets:amazon expenses:misc $20.00 2012-07-30 (17LA58JSKRD4HDGLNJPI1P9B8DKPVHL) To Adapteva, Inc. ; status:Completed assets:amazon expenses:misc $25.00 expenses:fees $1.00 Paypal Here's a real-world rules file for (customised) Paypal CSV, with some Paypal-specific rules, and a second rules file included: "Date","Time","TimeZone","Name","Type","Status","Currency","Gross","Fee","Net","From Email Address","To Email Address","Transaction ID","Item Title","Item ID","Reference Txn ID","Receipt ID","Balance","Note" "10/01/2019","03:46:20","PDT","Calm Radio","Subscription Payment","Completed","USD","-6.99","0.00","-6.99","simon@joyful.com","memberships@calmradio.com","60P57143A8206782E","MONTHLY - $1 for the first 2 Months: Me - Order 99309. Item total: $1.00 USD first 2 months, then $6.99 / Month","","I-R8YLY094FJYR","","-6.99","" "10/01/2019","03:46:20","PDT","","Bank Deposit to PP Account ","Pending","USD","6.99","0.00","6.99","","simon@joyful.com","0TU1544T080463733","","","60P57143A8206782E","","0.00","" "10/01/2019","08:57:01","PDT","Patreon","PreApproved Payment Bill User Payment","Completed","USD","-7.00","0.00","-7.00","simon@joyful.com","support@patreon.com","2722394R5F586712G","Patreon* Membership","","B-0PG93074E7M86381M","","-7.00","" "10/01/2019","08:57:01","PDT","","Bank Deposit to PP Account ","Pending","USD","7.00","0.00","7.00","","simon@joyful.com","71854087RG994194F","Patreon* Membership","","2722394R5F586712G","","0.00","" "10/19/2019","03:02:12","PDT","Wikimedia Foundation, Inc.","Subscription Payment","Completed","USD","-2.00","0.00","-2.00","simon@joyful.com","tle@wikimedia.org","K9U43044RY432050M","Monthly donation to the Wikimedia Foundation","","I-R5C3YUS3285L","","-2.00","" "10/19/2019","03:02:12","PDT","","Bank Deposit to PP Account ","Pending","USD","2.00","0.00","2.00","","simon@joyful.com","3XJ107139A851061F","","","K9U43044RY432050M","","0.00","" "10/22/2019","05:07:06","PDT","Noble Benefactor","Subscription Payment","Completed","USD","10.00","-0.59","9.41","noble@bene.fac.tor","simon@joyful.com","6L8L1662YP1334033","Joyful Systems","","I-KC9VBGY2GWDB","","9.41","" # paypal-custom.csv.rules # Tips: # Export from Activity -> Statements -> Custom -> Activity download # Suggested transaction type: "Balance affecting" # Paypal's default fields in 2018 were: # "Date","Time","TimeZone","Name","Type","Status","Currency","Gross","Fee","Net","From Email Address","To Email Address","Transaction ID","Shipping Address","Address Status","Item Title","Item ID","Shipping and Handling Amount","Insurance Amount","Sales Tax","Option 1 Name","Option 1 Value","Option 2 Name","Option 2 Value","Reference Txn ID","Invoice Number","Custom Number","Quantity","Receipt ID","Balance","Address Line 1","Address Line 2/District/Neighborhood","Town/City","State/Province/Region/County/Territory/Prefecture/Republic","Zip/Postal Code","Country","Contact Phone Number","Subject","Note","Country Code","Balance Impact" # This rules file assumes the following more detailed fields, configured in "Customize report fields": # "Date","Time","TimeZone","Name","Type","Status","Currency","Gross","Fee","Net","From Email Address","To Email Address","Transaction ID","Item Title","Item ID","Reference Txn ID","Receipt ID","Balance","Note" fields date, time, timezone, description_, type, status_, currency, grossamount, feeamount, netamount, fromemail, toemail, code, itemtitle, itemid, referencetxnid, receiptid, balance, note skip 1 date-format %-m/%-d/%Y # ignore some paypal events if In Progress Temporary Hold Update to skip # add more fields to the description description %description_ %itemtitle # save some other fields as tags comment itemid:%itemid, fromemail:%fromemail, toemail:%toemail, time:%time, type:%type, status:%status_ # convert to short currency symbols if %currency USD currency $ if %currency EUR currency E if %currency GBP currency P # generate postings # the first posting will be the money leaving/entering my paypal account # (negative means leaving my account, in all amount fields) account1 assets:online:paypal amount1 %netamount # the second posting will be money sent to/received from other party # (account2 is set below) amount2 -%grossamount # if there's a fee, add a third posting for the money taken by paypal. if %feeamount [1-9] account3 expenses:banking:paypal amount3 -%feeamount comment3 business: # choose an account for the second posting # override the default account names: # if the amount is positive, it's income (a debit) if %grossamount ^[^-] account2 income:unknown # if negative, it's an expense (a credit) if %grossamount ^- account2 expenses:unknown # apply common rules for setting account2 & other tweaks include common.rules # apply some overrides specific to this csv # Transfers from/to bank. These are usually marked Pending, # which can be disregarded in this case. if Bank Account Bank Deposit to PP Account description %type for %referencetxnid %itemtitle account2 assets:bank:wf:pchecking account1 assets:online:paypal # Currency conversions if Currency Conversion account2 equity:currency conversion # common.rules if darcs noble benefactor account2 revenues:foss donations:darcshub comment2 business: if Calm Radio account2 expenses:online:apps if electronic frontier foundation Patreon wikimedia Advent of Code account2 expenses:dues if Google account2 expenses:online:apps description google | music $ hledger -f paypal-custom.csv print 2019-10-01 (60P57143A8206782E) Calm Radio MONTHLY - $1 for the first 2 Months: Me - Order 99309. Item total: $1.00 USD first 2 months, then $6.99 / Month ; itemid:, fromemail:simon@joyful.com, toemail:memberships@calmradio.com, time:03:46:20, type:Subscription Payment, status:Completed assets:online:paypal $-6.99 = $-6.99 expenses:online:apps $6.99 2019-10-01 (0TU1544T080463733) Bank Deposit to PP Account for 60P57143A8206782E ; itemid:, fromemail:, toemail:simon@joyful.com, time:03:46:20, type:Bank Deposit to PP Account, status:Pending assets:online:paypal $6.99 = $0.00 assets:bank:wf:pchecking $-6.99 2019-10-01 (2722394R5F586712G) Patreon Patreon* Membership ; itemid:, fromemail:simon@joyful.com, toemail:support@patreon.com, time:08:57:01, type:PreApproved Payment Bill User Payment, status:Completed assets:online:paypal $-7.00 = $-7.00 expenses:dues $7.00 2019-10-01 (71854087RG994194F) Bank Deposit to PP Account for 2722394R5F586712G Patreon* Membership ; itemid:, fromemail:, toemail:simon@joyful.com, time:08:57:01, type:Bank Deposit to PP Account, status:Pending assets:online:paypal $7.00 = $0.00 assets:bank:wf:pchecking $-7.00 2019-10-19 (K9U43044RY432050M) Wikimedia Foundation, Inc. Monthly donation to the Wikimedia Foundation ; itemid:, fromemail:simon@joyful.com, toemail:tle@wikimedia.org, time:03:02:12, type:Subscription Payment, status:Completed assets:online:paypal $-2.00 = $-2.00 expenses:dues $2.00 expenses:banking:paypal ; business: 2019-10-19 (3XJ107139A851061F) Bank Deposit to PP Account for K9U43044RY432050M ; itemid:, fromemail:, toemail:simon@joyful.com, time:03:02:12, type:Bank Deposit to PP Account, status:Pending assets:online:paypal $2.00 = $0.00 assets:bank:wf:pchecking $-2.00 2019-10-22 (6L8L1662YP1334033) Noble Benefactor Joyful Systems ; itemid:, fromemail:noble@bene.fac.tor, toemail:simon@joyful.com, time:05:07:06, type:Subscription Payment, status:Completed assets:online:paypal $9.41 = $9.41 revenues:foss donations:darcshub $-10.00 ; business: expenses:banking:paypal $0.59 ; business: CSV RULES The following kinds of rule can appear in the rules file, in any order. Blank lines and lines beginning with # or ; are ignored. skip skip N The word "skip" followed by a number (or no number, meaning 1) tells hledger to ignore this many non-empty lines preceding the CSV data. (Empty/blank lines are skipped automatically.) You'll need this when- ever your CSV data contains header lines. It also has a second purpose: it can be used inside if blocks to ignore certain CSV records (described below). fields fields FIELDNAME1, FIELDNAME2, ... A fields list (the word "fields" followed by comma-separated field names) is the quick way to assign CSV field values to hledger fields. It does two things: 1. it names the CSV fields. This is optional, but can be convenient later for interpolating them. 2. when you use a standard hledger field name, it assigns the CSV value to that part of the hledger transaction. Here's an example that says "use the 1st, 2nd and 4th fields as the transaction's date, description and amount; name the last two fields for later reference; and ignore the others": fields date, description, , amount, , , somefield, anotherfield Field names may not contain whitespace. Fields you don't care about can be left unnamed. Currently there must be least two items (there must be at least one comma). Note, always use comma in the fields list, even if your CSV uses an- other separator character. Here are the standard hledger field/pseudo-field names. For more about the transaction parts they refer to, see the manual for hledger's jour- nal format. Transaction field names date, date2, status, code, description, comment can be used to form the transaction's first line. Posting field names account accountN, where N is 1 to 99, causes a posting to be generated, with that account name. Most often there are two postings, so you'll want to set account1 and account2. Typically account1 is associated with the CSV file, and is set once with a top-level assignment, while account2 is set based on each transaction's description, and in conditional blocks. If a posting's account name is left unset but its amount is set (see below), a default account name will be chosen (like "expenses:unknown" or "income:unknown"). amount amountN sets posting N's amount. If the CSV uses separate fields for inflows and outflows, you can use amountN-in and amountN-out instead. By assigning to amount1, amount2, ... etc. you can generate anywhere from 0 to 99 postings. There is also an older, unnumbered form of these names, suitable for 2-posting transactions, which sets both posting 1's and (negated) post- ing 2's amount: amount, or amount-in and amount-out. This is still supported because it keeps pre-hledger-1.17 csv rules files working, and because it can be more succinct, and because it converts posting 2's amount to cost if there's a transaction price, which can be useful. If you have an existing rules file using the unnumbered form, you might want to use the numbered form in certain conditional blocks, without having to update and retest all the old rules. To facilitate this, posting 1 ignores amount/amount-in/amount-out if any of amount1/amount1-in/amount1-out are assigned, and posting 2 ignores them if any of amount2/amount2-in/amount2-out are assigned, avoiding con- flicts. currency If the CSV has the currency symbol in a separate field (ie, not part of the amount field), you can use currencyN to prepend it to posting N's amount. Or, currency with no number affects all postings. balance balanceN sets a balance assertion amount (or if the posting amount is left empty, a balance assignment) on posting N. Also, for compatibility with hledger <1.17: balance with no number is equivalent to balance1. You can adjust the type of assertion/assignment with the balance-type rule (see below). comment Finally, commentN sets a comment on the Nth posting. Comments can also contain tags, as usual. See TIPS below for more about setting amounts and currency. field assignment HLEDGERFIELDNAME FIELDVALUE Instead of or in addition to a fields list, you can use a "field as- signment" rule to set the value of a single hledger field, by writing its name (any of the standard hledger field names above) followed by a text value. The value may contain interpolated CSV fields, referenced by their 1-based position in the CSV record (%N), or by the name they were given in the fields list (%CSVFIELDNAME). Some examples: # set the amount to the 4th CSV field, with " USD" appended amount %4 USD # combine three fields to make a comment, containing note: and date: tags comment note: %somefield - %anotherfield, date: %1 Interpolation strips outer whitespace (so a CSV value like " 1 " be- comes 1 when interpolated) (#1051). See TIPS below for more about ref- erencing other fields. separator You can use the separator rule to read other kinds of character-sepa- rated data. The argument is any single separator character, or the words tab or space (case insensitive). Eg, for comma-separated values (CSV): separator , or for semicolon-separated values (SSV): separator ; or for tab-separated values (TSV): separator TAB If the input file has a .csv, .ssv or .tsv file extension (or a csv:, ssv:, tsv: prefix), the appropriate separator will be inferred automat- ically, and you won't need this rule. if block if MATCHER RULE if MATCHER MATCHER MATCHER RULE RULE Conditional blocks ("if blocks") are a block of rules that are applied only to CSV records which match certain patterns. They are often used for customising account names based on transaction descriptions. Matching the whole record Each MATCHER can be a record matcher, which looks like this: REGEX REGEX is a case-insensitive regular expression which tries to match anywhere within the CSV record. It is a POSIX ERE (extended regular expression) that also supports GNU word boundaries (\b, \B, \<, \>), and nothing else. If you have trouble, be sure to check our https://hledger.org/hledger.html#regular-expressions doc. Important note: the record that is matched is not the original record, but a synthetic one, with any enclosing double quotes (but not enclos- ing whitespace) removed, and always comma-separated (which means that a field containing a comma will appear like two fields). Eg, if the original record is 2020-01-01; "Acme, Inc."; 1,000, the REGEX will ac- tually see 2020-01-01,Acme, Inc., 1,000). Matching individual fields Or, MATCHER can be a field matcher, like this: %CSVFIELD REGEX which matches just the content of a particular CSV field. CSVFIELD is a percent sign followed by the field's name or column number, like %date or %1. Combining matchers A single matcher can be written on the same line as the "if"; or multi- ple matchers can be written on the following lines, non-indented. Mul- tiple matchers are OR'd (any one of them can match), unless one begins with an & symbol, in which case it is AND'ed with the previous matcher. if MATCHER & MATCHER RULE Rules applied on successful match After the patterns there should be one or more rules to apply, all in- dented by at least one space. Three kinds of rule are allowed in con- ditional blocks: o field assignments (to set a hledger field) o skip (to skip the matched CSV record) o end (to skip all remaining CSV records). Examples: # if the CSV record contains "groceries", set account2 to "expenses:groceries" if groceries account2 expenses:groceries # if the CSV record contains any of these patterns, set account2 and comment as shown if monthly service fee atm transaction fee banking thru software account2 expenses:business:banking comment XXX deductible ? check it if table if,CSVFIELDNAME1,CSVFIELDNAME2,...,CSVFIELDNAMEn MATCHER1,VALUE11,VALUE12,...,VALUE1n MATCHER2,VALUE21,VALUE22,...,VALUE2n MATCHER3,VALUE31,VALUE32,...,VALUE3n Conditional tables ("if tables") are a different syntax to specify field assignments that will be applied only to CSV records which match certain patterns. MATCHER could be either field or record matcher, as described above. When MATCHER matches, values from that row would be assigned to the CSV fields named on the if line, in the same order. Therefore if table is exactly equivalent to a sequence of of if blocks: if MATCHER1 CSVFIELDNAME1 VALUE11 CSVFIELDNAME2 VALUE12 ... CSVFIELDNAMEn VALUE1n if MATCHER2 CSVFIELDNAME1 VALUE21 CSVFIELDNAME2 VALUE22 ... CSVFIELDNAMEn VALUE2n if MATCHER3 CSVFIELDNAME1 VALUE31 CSVFIELDNAME2 VALUE32 ... CSVFIELDNAMEn VALUE3n Each line starting with MATCHER should contain enough (possibly empty) values for all the listed fields. Rules would be checked and applied in the order they are listed in the table and, like with if blocks, later rules (in the same or another ta- ble) or if blocks could override the effect of any rule. Instead of ',' you can use a variety of other non-alphanumeric charac- ters as a separator. First character after if is taken to be the sepa- rator for the rest of the table. It is the responsibility of the user to ensure that separator does not occur inside MATCHERs and values - there is no way to escape separator. Example: if,account2,comment atm transaction fee,expenses:business:banking,deductible? check it %description groceries,expenses:groceries, 2020/01/12.*Plumbing LLC,expenses:house:upkeep,emergency plumbing call-out end This rule can be used inside if blocks (only), to make hledger stop reading this CSV file and move on to the next input file, or to command execution. Eg: # ignore everything following the first empty record if ,,,, end date-format date-format DATEFMT This is a helper for the date (and date2) fields. If your CSV dates are not formatted like YYYY-MM-DD, YYYY/MM/DD or YYYY.MM.DD, you'll need to add a date-format rule describing them with a strptime date parsing pattern, which must parse the CSV date value completely. Some examples: # MM/DD/YY date-format %m/%d/%y # D/M/YYYY # The - makes leading zeros optional. date-format %-d/%-m/%Y # YYYY-Mmm-DD date-format %Y-%h-%d # M/D/YYYY HH:MM AM some other junk # Note the time and junk must be fully parsed, though only the date is used. date-format %-m/%-d/%Y %l:%M %p some other junk For the supported strptime syntax, see: https://hackage.haskell.org/package/time/docs/Data-Time-For- mat.html#v:formatTime newest-first hledger always sorts the generated transactions by date. Transactions on the same date should appear in the same order as their CSV records, as hledger can usually auto-detect whether the CSV's normal order is oldest first or newest first. But if all of the following are true: o the CSV might sometimes contain just one day of data (all records having the same date) o the CSV records are normally in reverse chronological order (newest at the top) o and you care about preserving the order of same-day transactions then, you should add the newest-first rule as a hint. Eg: # tell hledger explicitly that the CSV is normally newest first newest-first include include RULESFILE This includes the contents of another CSV rules file at this point. RULESFILE is an absolute file path or a path relative to the current file's directory. This can be useful for sharing common rules between several rules files, eg: # someaccount.csv.rules ## someaccount-specific rules fields date,description,amount account1 assets:someaccount account2 expenses:misc ## common rules include categorisation.rules balance-type Balance assertions generated by assigning to balanceN are of the simple = type by default, which is a single-commodity, subaccount-excluding assertion. You may find the subaccount-including variants more useful, eg if you have created some virtual subaccounts of checking to help with budgeting. You can select a different type of assertion with the balance-type rule: # balance assertions will consider all commodities and all subaccounts balance-type ==* Here are the balance assertion types for quick reference: = single commodity, exclude subaccounts =* single commodity, include subaccounts == multi commodity, exclude subaccounts ==* multi commodity, include subaccounts TIPS Rapid feedback It's a good idea to get rapid feedback while creating/troubleshooting CSV rules. Here's a good way, using entr from http://eradman.com/entr- project : $ ls foo.csv* | entr bash -c 'echo ----; hledger -f foo.csv print desc:SOMEDESC' A desc: query (eg) is used to select just one, or a few, transactions of interest. "bash -c" is used to run multiple commands, so we can echo a separator each time the command re-runs, making it easier to read the output. Valid CSV hledger accepts CSV conforming to RFC 4180. When CSV values are en- closed in quotes, note: o they must be double quotes (not single quotes) o spaces outside the quotes are not allowed File Extension To help hledger identify the format and show the right error messages, CSV/SSV/TSV files should normally be named with a .csv, .ssv or .tsv filename extension. Or, the file path should be prefixed with csv:, ssv: or tsv:. Eg: $ hledger -f foo.ssv print or: $ cat foo | hledger -f ssv:- foo You can override the file extension with a separator rule if needed. See also: Input files in the hledger manual. Reading multiple CSV files If you use multiple -f options to read multiple CSV files at once, hledger will look for a correspondingly-named rules file for each CSV file. But if you use the --rules-file option, that rules file will be used for all the CSV files. Valid transactions After reading a CSV file, hledger post-processes and validates the gen- erated journal entries as it would for a journal file - balancing them, applying balance assignments, and canonicalising amount styles. Any errors at this stage will be reported in the usual way, displaying the problem entry. There is one exception: balance assertions, if you have generated them, will not be checked, since normally these will work only when the CSV data is part of the main journal. If you do need to check balance as- sertions generated from CSV right away, pipe into another hledger: $ hledger -f file.csv print | hledger -f- print Deduplicating, importing When you download a CSV file periodically, eg to get your latest bank transactions, the new file may overlap with the old one, containing some of the same records. The import command will (a) detect the new transactions, and (b) append just those transactions to your main journal. It is idempotent, so you don't have to remember how many times you ran it or with which version of the CSV. (It keeps state in a hidden .latest.FILE.csv file.) This is the easiest way to import CSV data. Eg: # download the latest CSV files, then run this command. # Note, no -f flags needed here. $ hledger import *.csv [--dry] This method works for most CSV files. (Where records have a stable chronological order, and new records appear only at the new end.) A number of other tools and workflows, hledger-specific and otherwise, exist for converting, deduplicating, classifying and managing CSV data. See: o https://hledger.org -> sidebar -> real world setups o https://plaintextaccounting.org -> data import/conversion Setting amounts A posting amount can be set in one of these ways: o by assigning (with a fields list or field assignment) to amountN (posting N's amount) or amount (posting 1's amount) o by assigning to amountN-in and amountN-out (or amount-in and amount- out). For each CSV record, whichever of these has a non-zero value will be used, with appropriate sign. If both contain a non-zero value, this may not work. o by assigning to balanceN (or balance) instead of the above, setting the amount indirectly via a balance assignment. If you do this the default account name may be wrong, so you should set that explicitly. There is some special handling for an amount's sign: o If an amount value is parenthesised, it will be de-parenthesised and sign-flipped. o If an amount value begins with a double minus sign, those cancel out and are removed. o If an amount value begins with a plus sign, that will be removed Setting currency/commodity If the currency/commodity symbol is included in the CSV's amount field(s), you don't have to do anything special. If the currency is provided as a separate CSV field, you can either: o assign that to currency, which adds it to all posting amounts. The symbol will prepended to the amount quantity (on the left side). If you write a trailing space after the symbol, there will be a space between symbol and amount (an exception to the usual whitespace stripping). o or assign it to currencyN which adds it to posting N's amount only. o or for more control, construct the amount from symbol and quantity using field assignment, eg: fields date,description,currency,quantity # add currency symbol on the right: amount %quantity %currency Referencing other fields In field assignments, you can interpolate only CSV fields, not hledger fields. In the example below, there's both a CSV field and a hledger field named amount1, but %amount1 always means the CSV field, not the hledger field: # Name the third CSV field "amount1" fields date,description,amount1 # Set hledger's amount1 to the CSV amount1 field followed by USD amount1 %amount1 USD # Set comment to the CSV amount1 (not the amount1 assigned above) comment %amount1 Here, since there's no CSV amount1 field, %amount1 will produce a lit- eral "amount1": fields date,description,csvamount amount1 %csvamount USD # Can't interpolate amount1 here comment %amount1 When there are multiple field assignments to the same hledger field, only the last one takes effect. Here, comment's value will be be B, or C if "something" is matched, but never A: comment A comment B if something comment C How CSV rules are evaluated Here's how to think of CSV rules being evaluated (if you really need to). First, o include - all includes are inlined, from top to bottom, depth first. (At each include point the file is inlined and scanned for further includes, recursively, before proceeding.) Then "global" rules are evaluated, top to bottom. If a rule is re- peated, the last one wins: o skip (at top level) o date-format o newest-first o fields - names the CSV fields, optionally sets up initial assignments to hledger fields Then for each CSV record in turn: o test all if blocks. If any of them contain a end rule, skip all re- maining CSV records. Otherwise if any of them contain a skip rule, skip that many CSV records. If there are multiple matched skip rules, the first one wins. o collect all field assignments at top level and in matched if blocks. When there are multiple assignments for a field, keep only the last one. o compute a value for each hledger field - either the one that was as- signed to it (and interpolate the %CSVFIELDNAME references), or a de- fault o generate a synthetic hledger transaction from these values. This is all part of the CSV reader, one of several readers hledger can use to parse input files. When all files have been read successfully, the transactions are passed as input to whichever hledger command the user specified. REPORTING BUGS Report bugs at http://bugs.hledger.org (or on the #hledger IRC channel or hledger mail list) AUTHORS Simon Michael and contributors COPYRIGHT Copyright (C) 2007-2019 Simon Michael. Released under GNU GPL v3 or later. SEE ALSO hledger(1), hledger-ui(1), hledger-web(1), hledger-api(1), hledger_csv(5), hledger_journal(5), hledger_timeclock(5), hledger_time- dot(5), ledger(1) http://hledger.org hledger 1.18.99 September 2020 hledger_csv(5) hledger-lib-1.19.1/hledger_csv.info0000644000000000000000000012165313725533425015332 0ustar0000000000000000This is hledger_csv.info, produced by makeinfo version 6.7 from stdin.  File: hledger_csv.info, Node: Top, Next: EXAMPLES, Up: (dir) hledger_csv(5) hledger 1.18.99 ****************************** CSV - how hledger reads CSV data, and the CSV rules file format hledger can read CSV files (Character Separated Value - usually comma, semicolon, or tab) containing dated records as if they were journal files, automatically converting each CSV record into a transaction. (To learn about _writing_ CSV, see CSV output.) We describe each CSV file's format with a corresponding _rules file_. By default this is named like the CSV file with a '.rules' extension added. Eg when reading 'FILE.csv', hledger also looks for 'FILE.csv.rules' in the same directory as 'FILE.csv'. You can specify a different rules file with the '--rules-file' option. If a rules file is not found, hledger will create a sample rules file, which you'll need to adjust. This file contains rules describing the CSV data (header line, fields layout, date format etc.), and how to construct hledger journal entries (transactions) from it. Often there will also be a list of conditional rules for categorising transactions based on their descriptions. Here's an overview of the CSV rules; these are described more fully below, after the examples: *'skip'* skip one or more header lines or matched CSV records *'fields'* name CSV fields, assign them to hledger fields *field assignment* assign a value to one hledger field, with interpolation *'separator'* a custom field separator *'if' block* apply some rules to CSV records matched by patterns *'if' table* apply some rules to CSV records matched by patterns, alternate syntax *'end'* skip the remaining CSV records *'date-format'* describe the format of CSV dates *'newest-first'* disambiguate record order when there's only one date *'include'* inline another CSV rules file *'balance-type'* choose which type of balance assignments to use Note, for best error messages when reading CSV files, use a '.csv', '.tsv' or '.ssv' file extension or file prefix - see File Extension below. There's an introductory Convert CSV files tutorial on hledger.org. * Menu: * EXAMPLES:: * CSV RULES:: * TIPS::  File: hledger_csv.info, Node: EXAMPLES, Next: CSV RULES, Prev: Top, Up: Top 1 EXAMPLES ********** Here are some sample hledger CSV rules files. See also the full collection at: https://github.com/simonmichael/hledger/tree/master/examples/csv * Menu: * Basic:: * Bank of Ireland:: * Amazon:: * Paypal::  File: hledger_csv.info, Node: Basic, Next: Bank of Ireland, Up: EXAMPLES 1.1 Basic ========= At minimum, the rules file must identify the date and amount fields, and often it also specifies the date format and how many header lines there are. Here's a simple CSV file and a rules file for it: Date, Description, Id, Amount 12/11/2019, Foo, 123, 10.23 # basic.csv.rules skip 1 fields date, description, _, amount date-format %d/%m/%Y $ hledger print -f basic.csv 2019-11-12 Foo expenses:unknown 10.23 income:unknown -10.23 Default account names are chosen, since we didn't set them.  File: hledger_csv.info, Node: Bank of Ireland, Next: Amazon, Prev: Basic, Up: EXAMPLES 1.2 Bank of Ireland =================== Here's a CSV with two amount fields (Debit and Credit), and a balance field, which we can use to add balance assertions, which is not necessary but provides extra error checking: Date,Details,Debit,Credit,Balance 07/12/2012,LODGMENT 529898,,10.0,131.21 07/12/2012,PAYMENT,5,,126 # bankofireland-checking.csv.rules # skip the header line skip # name the csv fields, and assign some of them as journal entry fields fields date, description, amount-out, amount-in, balance # We generate balance assertions by assigning to "balance" # above, but you may sometimes need to remove these because: # # - the CSV balance differs from the true balance, # by up to 0.0000000000005 in my experience # # - it is sometimes calculated based on non-chronological ordering, # eg when multiple transactions clear on the same day # date is in UK/Ireland format date-format %d/%m/%Y # set the currency currency EUR # set the base account for all txns account1 assets:bank:boi:checking $ hledger -f bankofireland-checking.csv print 2012-12-07 LODGMENT 529898 assets:bank:boi:checking EUR10.0 = EUR131.2 income:unknown EUR-10.0 2012-12-07 PAYMENT assets:bank:boi:checking EUR-5.0 = EUR126.0 expenses:unknown EUR5.0 The balance assertions don't raise an error above, because we're reading directly from CSV, but they will be checked if these entries are imported into a journal file.  File: hledger_csv.info, Node: Amazon, Next: Paypal, Prev: Bank of Ireland, Up: EXAMPLES 1.3 Amazon ========== Here we convert amazon.com order history, and use an if block to generate a third posting if there's a fee. (In practice you'd probably get this data from your bank instead, but it's an example.) "Date","Type","To/From","Name","Status","Amount","Fees","Transaction ID" "Jul 29, 2012","Payment","To","Foo.","Completed","$20.00","$0.00","16000000000000DGLNJPI1P9B8DKPVHL" "Jul 30, 2012","Payment","To","Adapteva, Inc.","Completed","$25.00","$1.00","17LA58JSKRD4HDGLNJPI1P9B8DKPVHL" # amazon-orders.csv.rules # skip one header line skip 1 # name the csv fields, and assign the transaction's date, amount and code. # Avoided the "status" and "amount" hledger field names to prevent confusion. fields date, _, toorfrom, name, amzstatus, amzamount, fees, code # how to parse the date date-format %b %-d, %Y # combine two fields to make the description description %toorfrom %name # save the status as a tag comment status:%amzstatus # set the base account for all transactions account1 assets:amazon # leave amount1 blank so it can balance the other(s). # I'm assuming amzamount excludes the fees, don't remember # set a generic account2 account2 expenses:misc amount2 %amzamount # and maybe refine it further: #include categorisation.rules # add a third posting for fees, but only if they are non-zero. if %fees [1-9] account3 expenses:fees amount3 %fees $ hledger -f amazon-orders.csv print 2012-07-29 (16000000000000DGLNJPI1P9B8DKPVHL) To Foo. ; status:Completed assets:amazon expenses:misc $20.00 2012-07-30 (17LA58JSKRD4HDGLNJPI1P9B8DKPVHL) To Adapteva, Inc. ; status:Completed assets:amazon expenses:misc $25.00 expenses:fees $1.00  File: hledger_csv.info, Node: Paypal, Prev: Amazon, Up: EXAMPLES 1.4 Paypal ========== Here's a real-world rules file for (customised) Paypal CSV, with some Paypal-specific rules, and a second rules file included: "Date","Time","TimeZone","Name","Type","Status","Currency","Gross","Fee","Net","From Email Address","To Email Address","Transaction ID","Item Title","Item ID","Reference Txn ID","Receipt ID","Balance","Note" "10/01/2019","03:46:20","PDT","Calm Radio","Subscription Payment","Completed","USD","-6.99","0.00","-6.99","simon@joyful.com","memberships@calmradio.com","60P57143A8206782E","MONTHLY - $1 for the first 2 Months: Me - Order 99309. Item total: $1.00 USD first 2 months, then $6.99 / Month","","I-R8YLY094FJYR","","-6.99","" "10/01/2019","03:46:20","PDT","","Bank Deposit to PP Account ","Pending","USD","6.99","0.00","6.99","","simon@joyful.com","0TU1544T080463733","","","60P57143A8206782E","","0.00","" "10/01/2019","08:57:01","PDT","Patreon","PreApproved Payment Bill User Payment","Completed","USD","-7.00","0.00","-7.00","simon@joyful.com","support@patreon.com","2722394R5F586712G","Patreon* Membership","","B-0PG93074E7M86381M","","-7.00","" "10/01/2019","08:57:01","PDT","","Bank Deposit to PP Account ","Pending","USD","7.00","0.00","7.00","","simon@joyful.com","71854087RG994194F","Patreon* Membership","","2722394R5F586712G","","0.00","" "10/19/2019","03:02:12","PDT","Wikimedia Foundation, Inc.","Subscription Payment","Completed","USD","-2.00","0.00","-2.00","simon@joyful.com","tle@wikimedia.org","K9U43044RY432050M","Monthly donation to the Wikimedia Foundation","","I-R5C3YUS3285L","","-2.00","" "10/19/2019","03:02:12","PDT","","Bank Deposit to PP Account ","Pending","USD","2.00","0.00","2.00","","simon@joyful.com","3XJ107139A851061F","","","K9U43044RY432050M","","0.00","" "10/22/2019","05:07:06","PDT","Noble Benefactor","Subscription Payment","Completed","USD","10.00","-0.59","9.41","noble@bene.fac.tor","simon@joyful.com","6L8L1662YP1334033","Joyful Systems","","I-KC9VBGY2GWDB","","9.41","" # paypal-custom.csv.rules # Tips: # Export from Activity -> Statements -> Custom -> Activity download # Suggested transaction type: "Balance affecting" # Paypal's default fields in 2018 were: # "Date","Time","TimeZone","Name","Type","Status","Currency","Gross","Fee","Net","From Email Address","To Email Address","Transaction ID","Shipping Address","Address Status","Item Title","Item ID","Shipping and Handling Amount","Insurance Amount","Sales Tax","Option 1 Name","Option 1 Value","Option 2 Name","Option 2 Value","Reference Txn ID","Invoice Number","Custom Number","Quantity","Receipt ID","Balance","Address Line 1","Address Line 2/District/Neighborhood","Town/City","State/Province/Region/County/Territory/Prefecture/Republic","Zip/Postal Code","Country","Contact Phone Number","Subject","Note","Country Code","Balance Impact" # This rules file assumes the following more detailed fields, configured in "Customize report fields": # "Date","Time","TimeZone","Name","Type","Status","Currency","Gross","Fee","Net","From Email Address","To Email Address","Transaction ID","Item Title","Item ID","Reference Txn ID","Receipt ID","Balance","Note" fields date, time, timezone, description_, type, status_, currency, grossamount, feeamount, netamount, fromemail, toemail, code, itemtitle, itemid, referencetxnid, receiptid, balance, note skip 1 date-format %-m/%-d/%Y # ignore some paypal events if In Progress Temporary Hold Update to skip # add more fields to the description description %description_ %itemtitle # save some other fields as tags comment itemid:%itemid, fromemail:%fromemail, toemail:%toemail, time:%time, type:%type, status:%status_ # convert to short currency symbols if %currency USD currency $ if %currency EUR currency E if %currency GBP currency P # generate postings # the first posting will be the money leaving/entering my paypal account # (negative means leaving my account, in all amount fields) account1 assets:online:paypal amount1 %netamount # the second posting will be money sent to/received from other party # (account2 is set below) amount2 -%grossamount # if there's a fee, add a third posting for the money taken by paypal. if %feeamount [1-9] account3 expenses:banking:paypal amount3 -%feeamount comment3 business: # choose an account for the second posting # override the default account names: # if the amount is positive, it's income (a debit) if %grossamount ^[^-] account2 income:unknown # if negative, it's an expense (a credit) if %grossamount ^- account2 expenses:unknown # apply common rules for setting account2 & other tweaks include common.rules # apply some overrides specific to this csv # Transfers from/to bank. These are usually marked Pending, # which can be disregarded in this case. if Bank Account Bank Deposit to PP Account description %type for %referencetxnid %itemtitle account2 assets:bank:wf:pchecking account1 assets:online:paypal # Currency conversions if Currency Conversion account2 equity:currency conversion # common.rules if darcs noble benefactor account2 revenues:foss donations:darcshub comment2 business: if Calm Radio account2 expenses:online:apps if electronic frontier foundation Patreon wikimedia Advent of Code account2 expenses:dues if Google account2 expenses:online:apps description google | music $ hledger -f paypal-custom.csv print 2019-10-01 (60P57143A8206782E) Calm Radio MONTHLY - $1 for the first 2 Months: Me - Order 99309. Item total: $1.00 USD first 2 months, then $6.99 / Month ; itemid:, fromemail:simon@joyful.com, toemail:memberships@calmradio.com, time:03:46:20, type:Subscription Payment, status:Completed assets:online:paypal $-6.99 = $-6.99 expenses:online:apps $6.99 2019-10-01 (0TU1544T080463733) Bank Deposit to PP Account for 60P57143A8206782E ; itemid:, fromemail:, toemail:simon@joyful.com, time:03:46:20, type:Bank Deposit to PP Account, status:Pending assets:online:paypal $6.99 = $0.00 assets:bank:wf:pchecking $-6.99 2019-10-01 (2722394R5F586712G) Patreon Patreon* Membership ; itemid:, fromemail:simon@joyful.com, toemail:support@patreon.com, time:08:57:01, type:PreApproved Payment Bill User Payment, status:Completed assets:online:paypal $-7.00 = $-7.00 expenses:dues $7.00 2019-10-01 (71854087RG994194F) Bank Deposit to PP Account for 2722394R5F586712G Patreon* Membership ; itemid:, fromemail:, toemail:simon@joyful.com, time:08:57:01, type:Bank Deposit to PP Account, status:Pending assets:online:paypal $7.00 = $0.00 assets:bank:wf:pchecking $-7.00 2019-10-19 (K9U43044RY432050M) Wikimedia Foundation, Inc. Monthly donation to the Wikimedia Foundation ; itemid:, fromemail:simon@joyful.com, toemail:tle@wikimedia.org, time:03:02:12, type:Subscription Payment, status:Completed assets:online:paypal $-2.00 = $-2.00 expenses:dues $2.00 expenses:banking:paypal ; business: 2019-10-19 (3XJ107139A851061F) Bank Deposit to PP Account for K9U43044RY432050M ; itemid:, fromemail:, toemail:simon@joyful.com, time:03:02:12, type:Bank Deposit to PP Account, status:Pending assets:online:paypal $2.00 = $0.00 assets:bank:wf:pchecking $-2.00 2019-10-22 (6L8L1662YP1334033) Noble Benefactor Joyful Systems ; itemid:, fromemail:noble@bene.fac.tor, toemail:simon@joyful.com, time:05:07:06, type:Subscription Payment, status:Completed assets:online:paypal $9.41 = $9.41 revenues:foss donations:darcshub $-10.00 ; business: expenses:banking:paypal $0.59 ; business:  File: hledger_csv.info, Node: CSV RULES, Next: TIPS, Prev: EXAMPLES, Up: Top 2 CSV RULES *********** The following kinds of rule can appear in the rules file, in any order. Blank lines and lines beginning with '#' or ';' are ignored. * Menu: * skip:: * fields:: * field assignment:: * separator:: * if block:: * if table:: * end:: * date-format:: * newest-first:: * include:: * balance-type::  File: hledger_csv.info, Node: skip, Next: fields, Up: CSV RULES 2.1 'skip' ========== skip N The word "skip" followed by a number (or no number, meaning 1) tells hledger to ignore this many non-empty lines preceding the CSV data. (Empty/blank lines are skipped automatically.) You'll need this whenever your CSV data contains header lines. It also has a second purpose: it can be used inside if blocks to ignore certain CSV records (described below).  File: hledger_csv.info, Node: fields, Next: field assignment, Prev: skip, Up: CSV RULES 2.2 'fields' ============ fields FIELDNAME1, FIELDNAME2, ... A fields list (the word "fields" followed by comma-separated field names) is the quick way to assign CSV field values to hledger fields. It does two things: 1. it names the CSV fields. This is optional, but can be convenient later for interpolating them. 2. when you use a standard hledger field name, it assigns the CSV value to that part of the hledger transaction. Here's an example that says "use the 1st, 2nd and 4th fields as the transaction's date, description and amount; name the last two fields for later reference; and ignore the others": fields date, description, , amount, , , somefield, anotherfield Field names may not contain whitespace. Fields you don't care about can be left unnamed. Currently there must be least two items (there must be at least one comma). Note, always use comma in the fields list, even if your CSV uses another separator character. Here are the standard hledger field/pseudo-field names. For more about the transaction parts they refer to, see the manual for hledger's journal format. * Menu: * Transaction field names:: * Posting field names::  File: hledger_csv.info, Node: Transaction field names, Next: Posting field names, Up: fields 2.2.1 Transaction field names ----------------------------- 'date', 'date2', 'status', 'code', 'description', 'comment' can be used to form the transaction's first line.  File: hledger_csv.info, Node: Posting field names, Prev: Transaction field names, Up: fields 2.2.2 Posting field names ------------------------- * Menu: * account:: * amount:: * currency:: * balance:: * comment::  File: hledger_csv.info, Node: account, Next: amount, Up: Posting field names 2.2.2.1 account ............... 'accountN', where N is 1 to 99, causes a posting to be generated, with that account name. Most often there are two postings, so you'll want to set 'account1' and 'account2'. Typically 'account1' is associated with the CSV file, and is set once with a top-level assignment, while 'account2' is set based on each transaction's description, and in conditional blocks. If a posting's account name is left unset but its amount is set (see below), a default account name will be chosen (like "expenses:unknown" or "income:unknown").  File: hledger_csv.info, Node: amount, Next: currency, Prev: account, Up: Posting field names 2.2.2.2 amount .............. 'amountN' sets posting N's amount. If the CSV uses separate fields for inflows and outflows, you can use 'amountN-in' and 'amountN-out' instead. By assigning to 'amount1', 'amount2', ... etc. you can generate anywhere from 0 to 99 postings. There is also an older, unnumbered form of these names, suitable for 2-posting transactions, which sets both posting 1's and (negated) posting 2's amount: 'amount', or 'amount-in' and 'amount-out'. This is still supported because it keeps pre-hledger-1.17 csv rules files working, and because it can be more succinct, and because it converts posting 2's amount to cost if there's a transaction price, which can be useful. If you have an existing rules file using the unnumbered form, you might want to use the numbered form in certain conditional blocks, without having to update and retest all the old rules. To facilitate this, posting 1 ignores 'amount'/'amount-in'/'amount-out' if any of 'amount1'/'amount1-in'/'amount1-out' are assigned, and posting 2 ignores them if any of 'amount2'/'amount2-in'/'amount2-out' are assigned, avoiding conflicts.  File: hledger_csv.info, Node: currency, Next: balance, Prev: amount, Up: Posting field names 2.2.2.3 currency ................ If the CSV has the currency symbol in a separate field (ie, not part of the amount field), you can use 'currencyN' to prepend it to posting N's amount. Or, 'currency' with no number affects all postings.  File: hledger_csv.info, Node: balance, Next: comment, Prev: currency, Up: Posting field names 2.2.2.4 balance ............... 'balanceN' sets a balance assertion amount (or if the posting amount is left empty, a balance assignment) on posting N. Also, for compatibility with hledger <1.17: 'balance' with no number is equivalent to 'balance1'. You can adjust the type of assertion/assignment with the 'balance-type' rule (see below).  File: hledger_csv.info, Node: comment, Prev: balance, Up: Posting field names 2.2.2.5 comment ............... Finally, 'commentN' sets a comment on the Nth posting. Comments can also contain tags, as usual. See TIPS below for more about setting amounts and currency.  File: hledger_csv.info, Node: field assignment, Next: separator, Prev: fields, Up: CSV RULES 2.3 field assignment ==================== HLEDGERFIELDNAME FIELDVALUE Instead of or in addition to a fields list, you can use a "field assignment" rule to set the value of a single hledger field, by writing its name (any of the standard hledger field names above) followed by a text value. The value may contain interpolated CSV fields, referenced by their 1-based position in the CSV record ('%N'), or by the name they were given in the fields list ('%CSVFIELDNAME'). Some examples: # set the amount to the 4th CSV field, with " USD" appended amount %4 USD # combine three fields to make a comment, containing note: and date: tags comment note: %somefield - %anotherfield, date: %1 Interpolation strips outer whitespace (so a CSV value like '" 1 "' becomes '1' when interpolated) (#1051). See TIPS below for more about referencing other fields.  File: hledger_csv.info, Node: separator, Next: if block, Prev: field assignment, Up: CSV RULES 2.4 'separator' =============== You can use the 'separator' rule to read other kinds of character-separated data. The argument is any single separator character, or the words 'tab' or 'space' (case insensitive). Eg, for comma-separated values (CSV): separator , or for semicolon-separated values (SSV): separator ; or for tab-separated values (TSV): separator TAB If the input file has a '.csv', '.ssv' or '.tsv' file extension (or a 'csv:', 'ssv:', 'tsv:' prefix), the appropriate separator will be inferred automatically, and you won't need this rule.  File: hledger_csv.info, Node: if block, Next: if table, Prev: separator, Up: CSV RULES 2.5 'if' block ============== if MATCHER RULE if MATCHER MATCHER MATCHER RULE RULE Conditional blocks ("if blocks") are a block of rules that are applied only to CSV records which match certain patterns. They are often used for customising account names based on transaction descriptions. * Menu: * Matching the whole record:: * Matching individual fields:: * Combining matchers:: * Rules applied on successful match::  File: hledger_csv.info, Node: Matching the whole record, Next: Matching individual fields, Up: if block 2.5.1 Matching the whole record ------------------------------- Each MATCHER can be a record matcher, which looks like this: REGEX REGEX is a case-insensitive regular expression which tries to match anywhere within the CSV record. It is a POSIX ERE (extended regular expression) that also supports GNU word boundaries ('\b', '\B', '\<', '\>'), and nothing else. If you have trouble, be sure to check our https://hledger.org/hledger.html#regular-expressions doc. Important note: the record that is matched is not the original record, but a synthetic one, with any enclosing double quotes (but not enclosing whitespace) removed, and always comma-separated (which means that a field containing a comma will appear like two fields). Eg, if the original record is '2020-01-01; "Acme, Inc."; 1,000', the REGEX will actually see '2020-01-01,Acme, Inc., 1,000').  File: hledger_csv.info, Node: Matching individual fields, Next: Combining matchers, Prev: Matching the whole record, Up: if block 2.5.2 Matching individual fields -------------------------------- Or, MATCHER can be a field matcher, like this: %CSVFIELD REGEX which matches just the content of a particular CSV field. CSVFIELD is a percent sign followed by the field's name or column number, like '%date' or '%1'.  File: hledger_csv.info, Node: Combining matchers, Next: Rules applied on successful match, Prev: Matching individual fields, Up: if block 2.5.3 Combining matchers ------------------------ A single matcher can be written on the same line as the "if"; or multiple matchers can be written on the following lines, non-indented. Multiple matchers are OR'd (any one of them can match), unless one begins with an '&' symbol, in which case it is AND'ed with the previous matcher. if MATCHER & MATCHER RULE  File: hledger_csv.info, Node: Rules applied on successful match, Prev: Combining matchers, Up: if block 2.5.4 Rules applied on successful match --------------------------------------- After the patterns there should be one or more rules to apply, all indented by at least one space. Three kinds of rule are allowed in conditional blocks: * field assignments (to set a hledger field) * skip (to skip the matched CSV record) * end (to skip all remaining CSV records). Examples: # if the CSV record contains "groceries", set account2 to "expenses:groceries" if groceries account2 expenses:groceries # if the CSV record contains any of these patterns, set account2 and comment as shown if monthly service fee atm transaction fee banking thru software account2 expenses:business:banking comment XXX deductible ? check it  File: hledger_csv.info, Node: if table, Next: end, Prev: if block, Up: CSV RULES 2.6 'if' table ============== if,CSVFIELDNAME1,CSVFIELDNAME2,...,CSVFIELDNAMEn MATCHER1,VALUE11,VALUE12,...,VALUE1n MATCHER2,VALUE21,VALUE22,...,VALUE2n MATCHER3,VALUE31,VALUE32,...,VALUE3n Conditional tables ("if tables") are a different syntax to specify field assignments that will be applied only to CSV records which match certain patterns. MATCHER could be either field or record matcher, as described above. When MATCHER matches, values from that row would be assigned to the CSV fields named on the 'if' line, in the same order. Therefore 'if' table is exactly equivalent to a sequence of of 'if' blocks: if MATCHER1 CSVFIELDNAME1 VALUE11 CSVFIELDNAME2 VALUE12 ... CSVFIELDNAMEn VALUE1n if MATCHER2 CSVFIELDNAME1 VALUE21 CSVFIELDNAME2 VALUE22 ... CSVFIELDNAMEn VALUE2n if MATCHER3 CSVFIELDNAME1 VALUE31 CSVFIELDNAME2 VALUE32 ... CSVFIELDNAMEn VALUE3n Each line starting with MATCHER should contain enough (possibly empty) values for all the listed fields. Rules would be checked and applied in the order they are listed in the table and, like with 'if' blocks, later rules (in the same or another table) or 'if' blocks could override the effect of any rule. Instead of ',' you can use a variety of other non-alphanumeric characters as a separator. First character after 'if' is taken to be the separator for the rest of the table. It is the responsibility of the user to ensure that separator does not occur inside MATCHERs and values - there is no way to escape separator. Example: if,account2,comment atm transaction fee,expenses:business:banking,deductible? check it %description groceries,expenses:groceries, 2020/01/12.*Plumbing LLC,expenses:house:upkeep,emergency plumbing call-out  File: hledger_csv.info, Node: end, Next: date-format, Prev: if table, Up: CSV RULES 2.7 'end' ========= This rule can be used inside if blocks (only), to make hledger stop reading this CSV file and move on to the next input file, or to command execution. Eg: # ignore everything following the first empty record if ,,,, end  File: hledger_csv.info, Node: date-format, Next: newest-first, Prev: end, Up: CSV RULES 2.8 'date-format' ================= date-format DATEFMT This is a helper for the 'date' (and 'date2') fields. If your CSV dates are not formatted like 'YYYY-MM-DD', 'YYYY/MM/DD' or 'YYYY.MM.DD', you'll need to add a date-format rule describing them with a strptime date parsing pattern, which must parse the CSV date value completely. Some examples: # MM/DD/YY date-format %m/%d/%y # D/M/YYYY # The - makes leading zeros optional. date-format %-d/%-m/%Y # YYYY-Mmm-DD date-format %Y-%h-%d # M/D/YYYY HH:MM AM some other junk # Note the time and junk must be fully parsed, though only the date is used. date-format %-m/%-d/%Y %l:%M %p some other junk For the supported strptime syntax, see: https://hackage.haskell.org/package/time/docs/Data-Time-Format.html#v:formatTime  File: hledger_csv.info, Node: newest-first, Next: include, Prev: date-format, Up: CSV RULES 2.9 'newest-first' ================== hledger always sorts the generated transactions by date. Transactions on the same date should appear in the same order as their CSV records, as hledger can usually auto-detect whether the CSV's normal order is oldest first or newest first. But if all of the following are true: * the CSV might sometimes contain just one day of data (all records having the same date) * the CSV records are normally in reverse chronological order (newest at the top) * and you care about preserving the order of same-day transactions then, you should add the 'newest-first' rule as a hint. Eg: # tell hledger explicitly that the CSV is normally newest first newest-first  File: hledger_csv.info, Node: include, Next: balance-type, Prev: newest-first, Up: CSV RULES 2.10 'include' ============== include RULESFILE This includes the contents of another CSV rules file at this point. 'RULESFILE' is an absolute file path or a path relative to the current file's directory. This can be useful for sharing common rules between several rules files, eg: # someaccount.csv.rules ## someaccount-specific rules fields date,description,amount account1 assets:someaccount account2 expenses:misc ## common rules include categorisation.rules  File: hledger_csv.info, Node: balance-type, Prev: include, Up: CSV RULES 2.11 'balance-type' =================== Balance assertions generated by assigning to balanceN are of the simple '=' type by default, which is a single-commodity, subaccount-excluding assertion. You may find the subaccount-including variants more useful, eg if you have created some virtual subaccounts of checking to help with budgeting. You can select a different type of assertion with the 'balance-type' rule: # balance assertions will consider all commodities and all subaccounts balance-type ==* Here are the balance assertion types for quick reference: = single commodity, exclude subaccounts =* single commodity, include subaccounts == multi commodity, exclude subaccounts ==* multi commodity, include subaccounts  File: hledger_csv.info, Node: TIPS, Prev: CSV RULES, Up: Top 3 TIPS ****** * Menu: * Rapid feedback:: * Valid CSV:: * File Extension:: * Reading multiple CSV files:: * Valid transactions:: * Deduplicating importing:: * Setting amounts:: * Setting currency/commodity:: * Referencing other fields:: * How CSV rules are evaluated::  File: hledger_csv.info, Node: Rapid feedback, Next: Valid CSV, Up: TIPS 3.1 Rapid feedback ================== It's a good idea to get rapid feedback while creating/troubleshooting CSV rules. Here's a good way, using entr from http://eradman.com/entrproject : $ ls foo.csv* | entr bash -c 'echo ----; hledger -f foo.csv print desc:SOMEDESC' A desc: query (eg) is used to select just one, or a few, transactions of interest. "bash -c" is used to run multiple commands, so we can echo a separator each time the command re-runs, making it easier to read the output.  File: hledger_csv.info, Node: Valid CSV, Next: File Extension, Prev: Rapid feedback, Up: TIPS 3.2 Valid CSV ============= hledger accepts CSV conforming to RFC 4180. When CSV values are enclosed in quotes, note: * they must be double quotes (not single quotes) * spaces outside the quotes are not allowed  File: hledger_csv.info, Node: File Extension, Next: Reading multiple CSV files, Prev: Valid CSV, Up: TIPS 3.3 File Extension ================== To help hledger identify the format and show the right error messages, CSV/SSV/TSV files should normally be named with a '.csv', '.ssv' or '.tsv' filename extension. Or, the file path should be prefixed with 'csv:', 'ssv:' or 'tsv:'. Eg: $ hledger -f foo.ssv print or: $ cat foo | hledger -f ssv:- foo You can override the file extension with a separator rule if needed. See also: Input files in the hledger manual.  File: hledger_csv.info, Node: Reading multiple CSV files, Next: Valid transactions, Prev: File Extension, Up: TIPS 3.4 Reading multiple CSV files ============================== If you use multiple '-f' options to read multiple CSV files at once, hledger will look for a correspondingly-named rules file for each CSV file. But if you use the '--rules-file' option, that rules file will be used for all the CSV files.  File: hledger_csv.info, Node: Valid transactions, Next: Deduplicating importing, Prev: Reading multiple CSV files, Up: TIPS 3.5 Valid transactions ====================== After reading a CSV file, hledger post-processes and validates the generated journal entries as it would for a journal file - balancing them, applying balance assignments, and canonicalising amount styles. Any errors at this stage will be reported in the usual way, displaying the problem entry. There is one exception: balance assertions, if you have generated them, will not be checked, since normally these will work only when the CSV data is part of the main journal. If you do need to check balance assertions generated from CSV right away, pipe into another hledger: $ hledger -f file.csv print | hledger -f- print  File: hledger_csv.info, Node: Deduplicating importing, Next: Setting amounts, Prev: Valid transactions, Up: TIPS 3.6 Deduplicating, importing ============================ When you download a CSV file periodically, eg to get your latest bank transactions, the new file may overlap with the old one, containing some of the same records. The import command will (a) detect the new transactions, and (b) append just those transactions to your main journal. It is idempotent, so you don't have to remember how many times you ran it or with which version of the CSV. (It keeps state in a hidden '.latest.FILE.csv' file.) This is the easiest way to import CSV data. Eg: # download the latest CSV files, then run this command. # Note, no -f flags needed here. $ hledger import *.csv [--dry] This method works for most CSV files. (Where records have a stable chronological order, and new records appear only at the new end.) A number of other tools and workflows, hledger-specific and otherwise, exist for converting, deduplicating, classifying and managing CSV data. See: * https://hledger.org -> sidebar -> real world setups * https://plaintextaccounting.org -> data import/conversion  File: hledger_csv.info, Node: Setting amounts, Next: Setting currency/commodity, Prev: Deduplicating importing, Up: TIPS 3.7 Setting amounts =================== A posting amount can be set in one of these ways: * by assigning (with a fields list or field assignment) to 'amountN' (posting N's amount) or 'amount' (posting 1's amount) * by assigning to 'amountN-in' and 'amountN-out' (or 'amount-in' and 'amount-out'). For each CSV record, whichever of these has a non-zero value will be used, with appropriate sign. If both contain a non-zero value, this may not work. * by assigning to 'balanceN' (or 'balance') instead of the above, setting the amount indirectly via a balance assignment. If you do this the default account name may be wrong, so you should set that explicitly. There is some special handling for an amount's sign: * If an amount value is parenthesised, it will be de-parenthesised and sign-flipped. * If an amount value begins with a double minus sign, those cancel out and are removed. * If an amount value begins with a plus sign, that will be removed  File: hledger_csv.info, Node: Setting currency/commodity, Next: Referencing other fields, Prev: Setting amounts, Up: TIPS 3.8 Setting currency/commodity ============================== If the currency/commodity symbol is included in the CSV's amount field(s), you don't have to do anything special. If the currency is provided as a separate CSV field, you can either: * assign that to 'currency', which adds it to all posting amounts. The symbol will prepended to the amount quantity (on the left side). If you write a trailing space after the symbol, there will be a space between symbol and amount (an exception to the usual whitespace stripping). * or assign it to 'currencyN' which adds it to posting N's amount only. * or for more control, construct the amount from symbol and quantity using field assignment, eg: fields date,description,currency,quantity # add currency symbol on the right: amount %quantity %currency  File: hledger_csv.info, Node: Referencing other fields, Next: How CSV rules are evaluated, Prev: Setting currency/commodity, Up: TIPS 3.9 Referencing other fields ============================ In field assignments, you can interpolate only CSV fields, not hledger fields. In the example below, there's both a CSV field and a hledger field named amount1, but %amount1 always means the CSV field, not the hledger field: # Name the third CSV field "amount1" fields date,description,amount1 # Set hledger's amount1 to the CSV amount1 field followed by USD amount1 %amount1 USD # Set comment to the CSV amount1 (not the amount1 assigned above) comment %amount1 Here, since there's no CSV amount1 field, %amount1 will produce a literal "amount1": fields date,description,csvamount amount1 %csvamount USD # Can't interpolate amount1 here comment %amount1 When there are multiple field assignments to the same hledger field, only the last one takes effect. Here, comment's value will be be B, or C if "something" is matched, but never A: comment A comment B if something comment C  File: hledger_csv.info, Node: How CSV rules are evaluated, Prev: Referencing other fields, Up: TIPS 3.10 How CSV rules are evaluated ================================ Here's how to think of CSV rules being evaluated (if you really need to). First, * 'include' - all includes are inlined, from top to bottom, depth first. (At each include point the file is inlined and scanned for further includes, recursively, before proceeding.) Then "global" rules are evaluated, top to bottom. If a rule is repeated, the last one wins: * 'skip' (at top level) * 'date-format' * 'newest-first' * 'fields' - names the CSV fields, optionally sets up initial assignments to hledger fields Then for each CSV record in turn: * test all 'if' blocks. If any of them contain a 'end' rule, skip all remaining CSV records. Otherwise if any of them contain a 'skip' rule, skip that many CSV records. If there are multiple matched 'skip' rules, the first one wins. * collect all field assignments at top level and in matched 'if' blocks. When there are multiple assignments for a field, keep only the last one. * compute a value for each hledger field - either the one that was assigned to it (and interpolate the %CSVFIELDNAME references), or a default * generate a synthetic hledger transaction from these values. This is all part of the CSV reader, one of several readers hledger can use to parse input files. When all files have been read successfully, the transactions are passed as input to whichever hledger command the user specified.  Tag Table: Node: Top72 Node: EXAMPLES2677 Ref: #examples2783 Node: Basic2991 Ref: #basic3091 Node: Bank of Ireland3633 Ref: #bank-of-ireland3768 Node: Amazon5230 Ref: #amazon5348 Node: Paypal7067 Ref: #paypal7161 Node: CSV RULES14805 Ref: #csv-rules14914 Node: skip15209 Ref: #skip15302 Node: fields15677 Ref: #fields15799 Node: Transaction field names16964 Ref: #transaction-field-names17124 Node: Posting field names17235 Ref: #posting-field-names17387 Node: account17457 Ref: #account17573 Node: amount18110 Ref: #amount18241 Node: currency19348 Ref: #currency19483 Node: balance19689 Ref: #balance19823 Node: comment20140 Ref: #comment20257 Node: field assignment20420 Ref: #field-assignment20563 Node: separator21381 Ref: #separator21516 Node: if block22056 Ref: #if-block22181 Node: Matching the whole record22582 Ref: #matching-the-whole-record22757 Node: Matching individual fields23561 Ref: #matching-individual-fields23765 Node: Combining matchers23989 Ref: #combining-matchers24185 Node: Rules applied on successful match24498 Ref: #rules-applied-on-successful-match24689 Node: if table25343 Ref: #if-table25462 Node: end27200 Ref: #end27312 Node: date-format27536 Ref: #date-format27668 Node: newest-first28417 Ref: #newest-first28555 Node: include29238 Ref: #include29369 Node: balance-type29813 Ref: #balance-type29933 Node: TIPS30633 Ref: #tips30715 Node: Rapid feedback30971 Ref: #rapid-feedback31088 Node: Valid CSV31548 Ref: #valid-csv31678 Node: File Extension31870 Ref: #file-extension32022 Node: Reading multiple CSV files32451 Ref: #reading-multiple-csv-files32636 Node: Valid transactions32877 Ref: #valid-transactions33055 Node: Deduplicating importing33683 Ref: #deduplicating-importing33862 Node: Setting amounts34895 Ref: #setting-amounts35064 Node: Setting currency/commodity36051 Ref: #setting-currencycommodity36243 Node: Referencing other fields37046 Ref: #referencing-other-fields37246 Node: How CSV rules are evaluated38143 Ref: #how-csv-rules-are-evaluated38316  End Tag Table  Local Variables: coding: utf-8 End: hledger-lib-1.19.1/hledger_journal.50000644000000000000000000016622413725533425015425 0ustar0000000000000000.\"t .TH "hledger_journal" "5" "September 2020" "hledger 1.18.99" "hledger User Manuals" .SH NAME .PP Journal - hledger\[aq]s default file format, representing a General Journal .SH DESCRIPTION .PP hledger\[aq]s usual data source is a plain text file containing journal entries in hledger journal format. This file represents a standard accounting general journal. I use file names ending in \f[C].journal\f[R], but that\[aq]s not required. The journal file contains a number of transaction entries, each describing a transfer of money (or any commodity) between two or more named accounts, in a simple format readable by both hledger and humans. .PP hledger\[aq]s journal format is a compatible subset, mostly, of ledger\[aq]s journal format, so hledger can work with compatible ledger journal files as well. It\[aq]s safe, and encouraged, to run both hledger and ledger on the same journal file, eg to validate the results you\[aq]re getting. .PP You can use hledger without learning any more about this file; just use the add or web or import commands to create and update it. .PP Many users, though, edit the journal file with a text editor, and track changes with a version control system such as git. Editor addons such as ledger-mode or hledger-mode for Emacs, vim-ledger for Vim, and hledger-vscode for Visual Studio Code, make this easier, adding colour, formatting, tab completion, and useful commands. See Editor configuration at hledger.org for the full list. .SH FILE FORMAT .PP Here\[aq]s a description of each part of the file format (and hledger\[aq]s data model). These are mostly in the order you\[aq]ll use them, but in some cases related concepts have been grouped together for easy reference, or linked before they are introduced, so feel free to skip over anything that looks unnecessary right now. .SS Transactions .PP Transactions are the main unit of information in a journal file. They represent events, typically a movement of some quantity of commodities between two or more named accounts. .PP Each transaction is recorded as a journal entry, beginning with a simple date in column 0. This can be followed by any of the following optional fields, separated by spaces: .IP \[bu] 2 a status character (empty, \f[C]!\f[R], or \f[C]*\f[R]) .IP \[bu] 2 a code (any short number or text, enclosed in parentheses) .IP \[bu] 2 a description (any remaining text until end of line or a semicolon) .IP \[bu] 2 a comment (any remaining text following a semicolon until end of line, and any following indented lines beginning with a semicolon) .IP \[bu] 2 0 or more indented \f[I]posting\f[R] lines, describing what was transferred and the accounts involved (indented comment lines are also allowed, but not blank lines or non-indented lines). .PP Here\[aq]s a simple journal file containing one transaction: .IP .nf \f[C] 2008/01/01 income assets:bank:checking $1 income:salary $-1 \f[R] .fi .SS Dates .SS Simple dates .PP Dates in the journal file use \f[I]simple dates\f[R] format: \f[C]YYYY-MM-DD\f[R] or \f[C]YYYY/MM/DD\f[R] or \f[C]YYYY.MM.DD\f[R], with leading zeros optional. The year may be omitted, in which case it will be inferred from the context: the current transaction, the default year set with a default year directive, or the current date when the command is run. Some examples: \f[C]2010-01-31\f[R], \f[C]2010/01/31\f[R], \f[C]2010.1.31\f[R], \f[C]1/31\f[R]. .PP (The UI also accepts simple dates, as well as the more flexible smart dates documented in the hledger manual.) .SS Secondary dates .PP Real-life transactions sometimes involve more than one date - eg the date you write a cheque, and the date it clears in your bank. When you want to model this, for more accurate daily balances, you can specify individual posting dates. .PP Or, you can use the older \f[I]secondary date\f[R] feature (Ledger calls it auxiliary date or effective date). Note: we support this for compatibility, but I usually recommend avoiding this feature; posting dates are almost always clearer and simpler. .PP A secondary date is written after the primary date, following an equals sign. If the year is omitted, the primary date\[aq]s year is assumed. When running reports, the primary (left) date is used by default, but with the \f[C]--date2\f[R] flag (or \f[C]--aux-date\f[R] or \f[C]--effective\f[R]), the secondary (right) date will be used instead. .PP The meaning of secondary dates is up to you, but it\[aq]s best to follow a consistent rule. Eg \[dq]primary = the bank\[aq]s clearing date, secondary = date the transaction was initiated, if different\[dq], as shown here: .IP .nf \f[C] 2010/2/23=2/19 movie ticket expenses:cinema $10 assets:checking \f[R] .fi .IP .nf \f[C] $ hledger register checking 2010-02-23 movie ticket assets:checking $-10 $-10 \f[R] .fi .IP .nf \f[C] $ hledger register checking --date2 2010-02-19 movie ticket assets:checking $-10 $-10 \f[R] .fi .SS Posting dates .PP You can give individual postings a different date from their parent transaction, by adding a posting comment containing a tag (see below) like \f[C]date:DATE\f[R]. This is probably the best way to control posting dates precisely. Eg in this example the expense should appear in May reports, and the deduction from checking should be reported on 6/1 for easy bank reconciliation: .IP .nf \f[C] 2015/5/30 expenses:food $10 ; food purchased on saturday 5/30 assets:checking ; bank cleared it on monday, date:6/1 \f[R] .fi .IP .nf \f[C] $ hledger -f t.j register food 2015-05-30 expenses:food $10 $10 \f[R] .fi .IP .nf \f[C] $ hledger -f t.j register checking 2015-06-01 assets:checking $-10 $-10 \f[R] .fi .PP DATE should be a simple date; if the year is not specified it will use the year of the transaction\[aq]s date. You can set the secondary date similarly, with \f[C]date2:DATE2\f[R]. The \f[C]date:\f[R] or \f[C]date2:\f[R] tags must have a valid simple date value if they are present, eg a \f[C]date:\f[R] tag with no value is not allowed. .PP Ledger\[aq]s earlier, more compact bracketed date syntax is also supported: \f[C][DATE]\f[R], \f[C][DATE=DATE2]\f[R] or \f[C][=DATE2]\f[R]. hledger will attempt to parse any square-bracketed sequence of the \f[C]0123456789/-.=\f[R] characters in this way. With this syntax, DATE infers its year from the transaction and DATE2 infers its year from DATE. .SS Status .PP Transactions, or individual postings within a transaction, can have a status mark, which is a single character before the transaction description or posting account name, separated from it by a space, indicating one of three statuses: .PP .TS tab(@); l l. T{ mark \ T}@T{ status T} _ T{ \ T}@T{ unmarked T} T{ \f[C]!\f[R] T}@T{ pending T} T{ \f[C]*\f[R] T}@T{ cleared T} .TE .PP When reporting, you can filter by status with the \f[C]-U/--unmarked\f[R], \f[C]-P/--pending\f[R], and \f[C]-C/--cleared\f[R] flags; or the \f[C]status:\f[R], \f[C]status:!\f[R], and \f[C]status:*\f[R] queries; or the U, P, C keys in hledger-ui. .PP Note, in Ledger and in older versions of hledger, the \[dq]unmarked\[dq] state is called \[dq]uncleared\[dq]. As of hledger 1.3 we have renamed it to unmarked for clarity. .PP To replicate Ledger and old hledger\[aq]s behaviour of also matching pending, combine -U and -P. .PP Status marks are optional, but can be helpful eg for reconciling with real-world accounts. Some editor modes provide highlighting and shortcuts for working with status. Eg in Emacs ledger-mode, you can toggle transaction status with C-c C-e, or posting status with C-c C-c. .PP What \[dq]uncleared\[dq], \[dq]pending\[dq], and \[dq]cleared\[dq] actually mean is up to you. Here\[aq]s one suggestion: .PP .TS tab(@); lw(9.7n) lw(60.3n). T{ status T}@T{ meaning T} _ T{ uncleared T}@T{ recorded but not yet reconciled; needs review T} T{ pending T}@T{ tentatively reconciled (if needed, eg during a big reconciliation) T} T{ cleared T}@T{ complete, reconciled as far as possible, and considered correct T} .TE .PP With this scheme, you would use \f[C]-PC\f[R] to see the current balance at your bank, \f[C]-U\f[R] to see things which will probably hit your bank soon (like uncashed checks), and no flags to see the most up-to-date state of your finances. .SS Description .PP A transaction\[aq]s description is the rest of the line following the date and status mark (or until a comment begins). Sometimes called the \[dq]narration\[dq] in traditional bookkeeping, it can be used for whatever you wish, or left blank. Transaction descriptions can be queried, unlike comments. .SS Payee and note .PP You can optionally include a \f[C]|\f[R] (pipe) character in descriptions to subdivide the description into separate fields for payee/payer name on the left (up to the first \f[C]|\f[R]) and an additional note field on the right (after the first \f[C]|\f[R]). This may be worthwhile if you need to do more precise querying and pivoting by payee or by note. .SS Comments .PP Lines in the journal beginning with a semicolon (\f[C];\f[R]) or hash (\f[C]#\f[R]) or star (\f[C]*\f[R]) are comments, and will be ignored. (Star comments cause org-mode nodes to be ignored, allowing emacs users to fold and navigate their journals with org-mode or orgstruct-mode.) .PP You can attach comments to a transaction by writing them after the description and/or indented on the following lines (before the postings). Similarly, you can attach comments to an individual posting by writing them after the amount and/or indented on the following lines. Transaction and posting comments must begin with a semicolon (\f[C];\f[R]). .PP Some examples: .IP .nf \f[C] # a file comment ; another file comment * also a file comment, useful in org/orgstruct mode comment A multiline file comment, which continues until a line containing just \[dq]end comment\[dq] (or end of file). end comment 2012/5/14 something ; a transaction comment ; the transaction comment, continued posting1 1 ; a comment for posting 1 posting2 ; a comment for posting 2 ; another comment line for posting 2 ; a file comment (because not indented) \f[R] .fi .PP You can also comment larger regions of a file using \f[C]comment\f[R] and \f[C]end comment\f[R] directives. .SS Tags .PP Tags are a way to add extra labels or labelled data to postings and transactions, which you can then search or pivot on. .PP A simple tag is a word (which may contain hyphens) followed by a full colon, written inside a transaction or posting comment line: .IP .nf \f[C] 2017/1/16 bought groceries ; sometag: \f[R] .fi .PP Tags can have a value, which is the text after the colon, up to the next comma or end of line, with leading/trailing whitespace removed: .IP .nf \f[C] expenses:food $10 ; a-posting-tag: the tag value \f[R] .fi .PP Note this means hledger\[aq]s tag values can not contain commas or newlines. Ending at commas means you can write multiple short tags on one line, comma separated: .IP .nf \f[C] assets:checking ; a comment containing tag1:, tag2: some value ... \f[R] .fi .PP Here, .IP \[bu] 2 \[dq]\f[C]a comment containing\f[R]\[dq] is just comment text, not a tag .IP \[bu] 2 \[dq]\f[C]tag1\f[R]\[dq] is a tag with no value .IP \[bu] 2 \[dq]\f[C]tag2\f[R]\[dq] is another tag, whose value is \[dq]\f[C]some value ...\f[R]\[dq] .PP Tags in a transaction comment affect the transaction and all of its postings, while tags in a posting comment affect only that posting. For example, the following transaction has three tags (\f[C]A\f[R], \f[C]TAG2\f[R], \f[C]third-tag\f[R]) and the posting has four (those plus \f[C]posting-tag\f[R]): .IP .nf \f[C] 1/1 a transaction ; A:, TAG2: ; third-tag: a third transaction tag, <- with a value (a) $1 ; posting-tag: \f[R] .fi .PP Tags are like Ledger\[aq]s metadata feature, except hledger\[aq]s tag values are simple strings. .SS Postings .PP A posting is an addition of some amount to, or removal of some amount from, an account. Each posting line begins with at least one space or tab (2 or 4 spaces is common), followed by: .IP \[bu] 2 (optional) a status character (empty, \f[C]!\f[R], or \f[C]*\f[R]), followed by a space .IP \[bu] 2 (required) an account name (any text, optionally containing \f[B]single spaces\f[R], until end of line or a double space) .IP \[bu] 2 (optional) \f[B]two or more spaces\f[R] or tabs followed by an amount. .PP Positive amounts are being added to the account, negative amounts are being removed. .PP The amounts within a transaction must always sum up to zero. As a convenience, one amount may be left blank; it will be inferred so as to balance the transaction. .PP Be sure to note the unusual two-space delimiter between account name and amount. This makes it easy to write account names containing spaces. But if you accidentally leave only one space (or tab) before the amount, the amount will be considered part of the account name. .SS Virtual postings .PP A posting with a parenthesised account name is called a \f[I]virtual posting\f[R] or \f[I]unbalanced posting\f[R], which means it is exempt from the usual rule that a transaction\[aq]s postings must balance add up to zero. .PP This is not part of double entry accounting, so you might choose to avoid this feature. Or you can use it sparingly for certain special cases where it can be convenient. Eg, you could set opening balances without using a balancing equity account: .IP .nf \f[C] 1/1 opening balances (assets:checking) $1000 (assets:savings) $2000 \f[R] .fi .PP A posting with a bracketed account name is called a \f[I]balanced virtual posting\f[R]. The balanced virtual postings in a transaction must add up to zero (separately from other postings). Eg: .IP .nf \f[C] 1/1 buy food with cash, update budget envelope subaccounts, & something else assets:cash $-10 ; <- these balance expenses:food $7 ; <- expenses:food $3 ; <- [assets:checking:budget:food] $-10 ; <- and these balance [assets:checking:available] $10 ; <- (something:else) $5 ; <- not required to balance \f[R] .fi .PP Ordinary non-parenthesised, non-bracketed postings are called \f[I]real postings\f[R]. You can exclude virtual postings from reports with the \f[C]-R/--real\f[R] flag or \f[C]real:1\f[R] query. .SS Account names .PP Account names typically have several parts separated by a full colon, from which hledger derives a hierarchical chart of accounts. They can be anything you like, but in finance there are traditionally five top-level accounts: \f[C]assets\f[R], \f[C]liabilities\f[R], \f[C]income\f[R], \f[C]expenses\f[R], and \f[C]equity\f[R]. .PP Account names may contain single spaces, eg: \f[C]assets:accounts receivable\f[R]. Because of this, they must always be followed by \f[B]two or more spaces\f[R] (or newline). .PP Account names can be aliased. .SS Amounts .PP After the account name, there is usually an amount. (Important: between account name and amount, there must be \f[B]two or more spaces\f[R].) .PP hledger\[aq]s amount format is flexible, supporting several international formats. Here are some examples. Amounts have a number (the \[dq]quantity\[dq]): .IP .nf \f[C] 1 \f[R] .fi .PP \&..and usually a currency or commodity name (the \[dq]commodity\[dq]). This is a symbol, word, or phrase, to the left or right of the quantity, with or without a separating space: .IP .nf \f[C] $1 4000 AAPL \f[R] .fi .PP If the commodity name contains spaces, numbers, or punctuation, it must be enclosed in double quotes: .IP .nf \f[C] 3 \[dq]no. 42 green apples\[dq] \f[R] .fi .PP Amounts can be preceded by a minus sign (or a plus sign, though plus is the default), The sign can be written before or after a left-side commodity symbol: .IP .nf \f[C] -$1 $-1 \f[R] .fi .PP One or more spaces between the sign and the number are acceptable when parsing (but they won\[aq]t be displayed in output): .IP .nf \f[C] + $1 $- 1 \f[R] .fi .PP Scientific E notation is allowed: .IP .nf \f[C] 1E-6 EUR 1E3 \f[R] .fi .PP A decimal mark can be written as a period or a comma: .IP .nf \f[C] 1.23 1,23456780000009 \f[R] .fi .SS Digit group marks .PP In the integer part of the quantity (left of the decimal mark), groups of digits can optionally be separated by a \[dq]digit group mark\[dq] - a space, comma, or period (different from the decimal mark): .IP .nf \f[C] $1,000,000.00 EUR 2.000.000,00 INR 9,99,99,999.00 1 000 000.9455 \f[R] .fi .PP Note, a number containing a single group mark and no decimal mark is ambiguous. Are these group marks or decimal marks ? .IP .nf \f[C] 1,000 1.000 \f[R] .fi .PP hledger will treat them both as decimal marks by default (cf #793). If you use digit group marks, to prevent confusion and undetected typos we recommend you write commodity directives at the top of the file to explicitly declare the decimal mark (and optionally a digit group mark). Note, these formats (\[dq]amount styles\[dq]) are specific to each commodity, so if your data uses multiple formats, hledger can handle it: .IP .nf \f[C] commodity $1,000.00 commodity EUR 1.000,00 commodity INR 9,99,99,999.00 commodity 1 000 000.9455 \f[R] .fi .SS Amount display style .PP For each commodity, hledger chooses a consistent format to use when displaying amounts. (Except price amounts, which are always displayed as written). The display style is chosen as follows: .IP \[bu] 2 If there is a commodity directive (or default commodity directive) for the commodity, that format is used (see examples above). .IP \[bu] 2 Otherwise the format of the first posting amount in that commodity seen in the journal is used. But the number of decimal places (\[dq]precision\[dq]) will be the maximum from all posting amounts in that commodity. .IP \[bu] 2 Or if there are no such amounts in the journal, a default format is used (like \f[C]$1000.00\f[R]). .PP Transaction prices don\[aq]t affect the amount display style directly, but occasionally they can do so indirectly (eg when an posting\[aq]s amount is inferred using a transaction price). If you find this causing problems, use a commodity directive to fix the display style. .PP In summary: amounts will be displayed much as they appear in your journal, with the max observed number of decimal places. If you want to see fewer decimal places in reports, use a commodity directive to override that. .PP hledger uses banker\[aq]s rounding: it rounds to the nearest even number, eg 0.5 displayed with zero decimal places is \[dq]0\[dq]). (Note, prior to hledger 1.17.1 this could vary if hledger happened to be built with an old version of Decimal (<0.5.1); since 1.17.1 it\[aq]s guaranteed.) .SS Transaction prices .PP Within a transaction, you can note an amount\[aq]s price in another commodity. This can be used to document the cost (in a purchase) or selling price (in a sale). For example, transaction prices are useful to record purchases of a foreign currency. Note transaction prices are fixed at the time of the transaction, and do not change over time. See also market prices, which represent prevailing exchange rates on a certain date. .PP There are several ways to record a transaction price: .IP "1." 3 Write the price per unit, as \f[C]\[at] UNITPRICE\f[R] after the amount: .RS 4 .IP .nf \f[C] 2009/1/1 assets:euros \[Eu]100 \[at] $1.35 ; one hundred euros purchased at $1.35 each assets:dollars ; balancing amount is -$135.00 \f[R] .fi .RE .IP "2." 3 Write the total price, as \f[C]\[at]\[at] TOTALPRICE\f[R] after the amount: .RS 4 .IP .nf \f[C] 2009/1/1 assets:euros \[Eu]100 \[at]\[at] $135 ; one hundred euros purchased at $135 for the lot assets:dollars \f[R] .fi .RE .IP "3." 3 Specify amounts for all postings, using exactly two commodities, and let hledger infer the price that balances the transaction: .RS 4 .IP .nf \f[C] 2009/1/1 assets:euros \[Eu]100 ; one hundred euros purchased assets:dollars $-135 ; for $135 \f[R] .fi .RE .IP "4." 3 Like 1, but the \f[C]\[at]\f[R] is parenthesised, i.e. \f[C](\[at])\f[R]; this is for compatibility with Ledger journals (Virtual posting costs), and is equivalent to 1 in hledger. .IP "5." 3 Like 2, but as in 4 the \f[C]\[at]\[at]\f[R] is parenthesised, i.e. \f[C](\[at]\[at])\f[R]; in hledger, this is equivalent to 2. .PP Use the \f[C]-B/--cost\f[R] flag to convert amounts to their transaction price\[aq]s commodity, if any. (mnemonic: \[dq]B\[dq] is from \[dq]cost Basis\[dq], as in Ledger). Eg here is how -B affects the balance report for the example above: .IP .nf \f[C] $ hledger bal -N --flat $-135 assets:dollars \[Eu]100 assets:euros $ hledger bal -N --flat -B $-135 assets:dollars $135 assets:euros # <- the euros\[aq] cost \f[R] .fi .PP Note -B is sensitive to the order of postings when a transaction price is inferred: the inferred price will be in the commodity of the last amount. So if example 3\[aq]s postings are reversed, while the transaction is equivalent, -B shows something different: .IP .nf \f[C] 2009/1/1 assets:dollars $-135 ; 135 dollars sold assets:euros \[Eu]100 ; for 100 euros \f[R] .fi .IP .nf \f[C] $ hledger bal -N --flat -B \[Eu]-100 assets:dollars # <- the dollars\[aq] selling price \[Eu]100 assets:euros \f[R] .fi .SS Lot prices and lot dates .PP Ledger allows another kind of price, lot price (four variants: \f[C]{UNITPRICE}\f[R], \f[C]{{TOTALPRICE}}\f[R], \f[C]{=FIXEDUNITPRICE}\f[R], \f[C]{{=FIXEDTOTALPRICE}}\f[R]), and/or a lot date (\f[C][DATE]\f[R]) to be specified. These are normally used to select a lot when selling investments. hledger will parse these, for compatibility with Ledger journals, but currently ignores them. A transaction price, lot price and/or lot date may appear in any order, after the posting amount and before the balance assertion if any. .SS Balance assertions .PP hledger supports Ledger-style balance assertions in journal files. These look like, for example, \f[C]= EXPECTEDBALANCE\f[R] following a posting\[aq]s amount. Eg here we assert the expected dollar balance in accounts a and b after each posting: .IP .nf \f[C] 2013/1/1 a $1 =$1 b =$-1 2013/1/2 a $1 =$2 b $-1 =$-2 \f[R] .fi .PP After reading a journal file, hledger will check all balance assertions and report an error if any of them fail. Balance assertions can protect you from, eg, inadvertently disrupting reconciled balances while cleaning up old entries. You can disable them temporarily with the \f[C]-I/--ignore-assertions\f[R] flag, which can be useful for troubleshooting or for reading Ledger files. (Note: this flag currently does not disable balance assignments, below). .SS Assertions and ordering .PP hledger sorts an account\[aq]s postings and assertions first by date and then (for postings on the same day) by parse order. Note this is different from Ledger, which sorts assertions only by parse order. (Also, Ledger assertions do not see the accumulated effect of repeated postings to the same account within a transaction.) .PP So, hledger balance assertions keep working if you reorder differently-dated transactions within the journal. But if you reorder same-dated transactions or postings, assertions might break and require updating. This order dependence does bring an advantage: precise control over the order of postings and assertions within a day, so you can assert intra-day balances. .SS Assertions and included files .PP With included files, things are a little more complicated. Including preserves the ordering of postings and assertions. If you have multiple postings to an account on the same day, split across different files, and you also want to assert the account\[aq]s balance on the same day, you\[aq]ll have to put the assertion in the right file. .SS Assertions and multiple -f options .PP Balance assertions don\[aq]t work well across files specified with multiple -f options. Use include or concatenate the files instead. .SS Assertions and commodities .PP The asserted balance must be a simple single-commodity amount, and in fact the assertion checks only this commodity\[aq]s balance within the (possibly multi-commodity) account balance. This is how assertions work in Ledger also. We could call this a \[dq]partial\[dq] balance assertion. .PP To assert the balance of more than one commodity in an account, you can write multiple postings, each asserting one commodity\[aq]s balance. .PP You can make a stronger \[dq]total\[dq] balance assertion by writing a double equals sign (\f[C]== EXPECTEDBALANCE\f[R]). This asserts that there are no other unasserted commodities in the account (or, that their balance is 0). .IP .nf \f[C] 2013/1/1 a $1 a 1\[Eu] b $-1 c -1\[Eu] 2013/1/2 ; These assertions succeed a 0 = $1 a 0 = 1\[Eu] b 0 == $-1 c 0 == -1\[Eu] 2013/1/3 ; This assertion fails as \[aq]a\[aq] also contains 1\[Eu] a 0 == $1 \f[R] .fi .PP It\[aq]s not yet possible to make a complete assertion about a balance that has multiple commodities. One workaround is to isolate each commodity into its own subaccount: .IP .nf \f[C] 2013/1/1 a:usd $1 a:euro 1\[Eu] b 2013/1/2 a 0 == 0 a:usd 0 == $1 a:euro 0 == 1\[Eu] \f[R] .fi .SS Assertions and prices .PP Balance assertions ignore transaction prices, and should normally be written without one: .IP .nf \f[C] 2019/1/1 (a) $1 \[at] \[Eu]1 = $1 \f[R] .fi .PP We do allow prices to be written there, however, and print shows them, even though they don\[aq]t affect whether the assertion passes or fails. This is for backward compatibility (hledger\[aq]s close command used to generate balance assertions with prices), and because balance \f[I]assignments\f[R] do use them (see below). .SS Assertions and subaccounts .PP The balance assertions above (\f[C]=\f[R] and \f[C]==\f[R]) do not count the balance from subaccounts; they check the account\[aq]s exclusive balance only. You can assert the balance including subaccounts by writing \f[C]=*\f[R] or \f[C]==*\f[R], eg: .IP .nf \f[C] 2019/1/1 equity:opening balances checking:a 5 checking:b 5 checking 1 ==* 11 \f[R] .fi .SS Assertions and virtual postings .PP Balance assertions are checked against all postings, both real and virtual. They are not affected by the \f[C]--real/-R\f[R] flag or \f[C]real:\f[R] query. .SS Assertions and precision .PP Balance assertions compare the exactly calculated amounts, which are not always what is shown by reports. Eg a commodity directive may limit the display precision, but this will not affect balance assertions. Balance assertion failure messages show exact amounts. .SS Balance assignments .PP Ledger-style balance assignments are also supported. These are like balance assertions, but with no posting amount on the left side of the equals sign; instead it is calculated automatically so as to satisfy the assertion. This can be a convenience during data entry, eg when setting opening balances: .IP .nf \f[C] ; starting a new journal, set asset account balances 2016/1/1 opening balances assets:checking = $409.32 assets:savings = $735.24 assets:cash = $42 equity:opening balances \f[R] .fi .PP or when adjusting a balance to reality: .IP .nf \f[C] ; no cash left; update balance, record any untracked spending as a generic expense 2016/1/15 assets:cash = $0 expenses:misc \f[R] .fi .PP The calculated amount depends on the account\[aq]s balance in the commodity at that point (which depends on the previously-dated postings of the commodity to that account since the last balance assertion or assignment). Note that using balance assignments makes your journal a little less explicit; to know the exact amount posted, you have to run hledger or do the calculations yourself, instead of just reading it. .SS Balance assignments and prices .PP A transaction price in a balance assignment will cause the calculated amount to have that price attached: .IP .nf \f[C] 2019/1/1 (a) = $1 \[at] \[Eu]2 \f[R] .fi .IP .nf \f[C] $ hledger print --explicit 2019-01-01 (a) $1 \[at] \[Eu]2 = $1 \[at] \[Eu]2 \f[R] .fi .SS Directives .PP A directive is a line in the journal beginning with a special keyword, that influences how the journal is processed. hledger\[aq]s directives are based on a subset of Ledger\[aq]s, but there are many differences (and also some differences between hledger versions). .PP Directives\[aq] behaviour and interactions can get a little bit complex, so here is a table summarising the directives and their effects, with links to more detailed docs. .PP .TS tab(@); lw(7.8n) lw(8.6n) lw(7.0n) lw(27.8n) lw(18.8n). T{ directive T}@T{ end directive T}@T{ subdirectives T}@T{ purpose T}@T{ can affect (as of 2018/06) T} _ T{ \f[C]account\f[R] T}@T{ T}@T{ any text T}@T{ document account names, declare account types & display order T}@T{ all entries in all files, before or after T} T{ \f[C]alias\f[R] T}@T{ \f[C]end aliases\f[R] T}@T{ T}@T{ rewrite account names T}@T{ following inline/included entries until end of current file or end directive T} T{ \f[C]apply account\f[R] T}@T{ \f[C]end apply account\f[R] T}@T{ T}@T{ prepend a common parent to account names T}@T{ following inline/included entries until end of current file or end directive T} T{ \f[C]comment\f[R] T}@T{ \f[C]end comment\f[R] T}@T{ T}@T{ ignore part of journal T}@T{ following inline/included entries until end of current file or end directive T} T{ \f[C]commodity\f[R] T}@T{ T}@T{ \f[C]format\f[R] T}@T{ declare a commodity and its number notation & display style T}@T{ number notation: following entries in that commodity in all files; display style: amounts of that commodity in reports T} T{ \f[C]D\f[R] T}@T{ T}@T{ T}@T{ declare a commodity to be used for commodityless amounts, and its number notation & display style T}@T{ default commodity: following commodityless entries until end of current file; number notation: following entries in that commodity until end of current file; display style: amounts of that commodity in reports T} T{ \f[C]include\f[R] T}@T{ T}@T{ T}@T{ include entries/directives from another file T}@T{ what the included directives affect T} T{ \f[C]P\f[R] T}@T{ T}@T{ T}@T{ declare a market price for a commodity T}@T{ amounts of that commodity in reports, when -V is used T} T{ \f[C]Y\f[R] T}@T{ T}@T{ T}@T{ declare a year for yearless dates T}@T{ following inline/included entries until end of current file T} T{ \f[C]=\f[R] T}@T{ T}@T{ T}@T{ declare an auto posting rule, adding postings to other transactions T}@T{ all entries in parent/current/child files (but not sibling files, see #1212) T} .TE .PP And some definitions: .PP .TS tab(@); lw(6.0n) lw(64.0n). T{ subdirective T}@T{ optional indented directive line immediately following a parent directive T} T{ number notation T}@T{ how to interpret numbers when parsing journal entries (the identity of the decimal separator character). (Currently each commodity can have its own notation, even in the same file.) T} T{ display style T}@T{ how to display amounts of a commodity in reports (symbol side and spacing, digit groups, decimal separator, decimal places) T} T{ directive scope T}@T{ which entries and (when there are multiple files) which files are affected by a directive T} .TE .PP As you can see, directives vary in which journal entries and files they affect, and whether they are focussed on input (parsing) or output (reports). Some directives have multiple effects. .SS Directives and multiple files .PP If you use multiple \f[C]-f\f[R]/\f[C]--file\f[R] options, or the \f[C]include\f[R] directive, hledger will process multiple input files. But note that directives which affect input (see above) typically last only until the end of the file in which they occur. .PP This may seem inconvenient, but it\[aq]s intentional; it makes reports stable and deterministic, independent of the order of input. Otherwise you could see different numbers if you happened to write -f options in a different order, or if you moved includes around while cleaning up your files. .PP It can be surprising though; for example, it means that \f[C]alias\f[R] directives do not affect parent or sibling files (see below). .SS Comment blocks .PP A line containing just \f[C]comment\f[R] starts a commented region of the file, and a line containing just \f[C]end comment\f[R] (or the end of the current file) ends it. See also comments. .SS Including other files .PP You can pull in the content of additional files by writing an include directive, like this: .IP .nf \f[C] include FILEPATH \f[R] .fi .PP Only journal files can include, and only journal, timeclock or timedot files can be included (not CSV files, currently). .PP If the file path does not begin with a slash, it is relative to the current file\[aq]s folder. .PP A tilde means home directory, eg: \f[C]include \[ti]/main.journal\f[R]. .PP The path may contain glob patterns to match multiple files, eg: \f[C]include *.journal\f[R]. .PP There is limited support for recursive wildcards: \f[C]**/\f[R] (the slash is required) matches 0 or more subdirectories. It\[aq]s not super convenient since you have to avoid include cycles and including directories, but this can be done, eg: \f[C]include */**/*.journal\f[R]. .PP The path may also be prefixed to force a specific file format, overriding the file extension (as described in hledger.1 -> Input files): \f[C]include timedot:\[ti]/notes/2020*.md\f[R]. .SS Default year .PP You can set a default year to be used for subsequent dates which don\[aq]t specify a year. This is a line beginning with \f[C]Y\f[R] followed by the year. Eg: .IP .nf \f[C] Y2009 ; set default year to 2009 12/15 ; equivalent to 2009/12/15 expenses 1 assets Y2010 ; change default year to 2010 2009/1/30 ; specifies the year, not affected expenses 1 assets 1/31 ; equivalent to 2010/1/31 expenses 1 assets \f[R] .fi .SS Declaring commodities .PP The \f[C]commodity\f[R] directive has several functions: .IP "1." 3 It declares commodities which may be used in the journal. This is currently not enforced, but can serve as documentation. .IP "2." 3 It declares what decimal mark character (period or comma) to expect when parsing input - useful to disambiguate international number formats in your data. (Without this, hledger will parse both \f[C]1,000\f[R] and \f[C]1.000\f[R] as 1). .IP "3." 3 It declares the amount display style to use in output - decimal and digit group marks, number of decimal places, symbol placement etc. .PP You are likely to run into one of the problems solved by commodity directives, sooner or later, so it\[aq]s a good idea to just always use them to declare your commodities. .PP A commodity directive is just the word \f[C]commodity\f[R] followed by an amount. It may be written on a single line, like this: .IP .nf \f[C] ; commodity EXAMPLEAMOUNT ; display AAAA amounts with the symbol on the right, space-separated, ; using period as decimal point, with four decimal places, and ; separating thousands with comma. commodity 1,000.0000 AAAA \f[R] .fi .PP or on multiple lines, using the \[dq]format\[dq] subdirective. (In this case the commodity symbol appears twice and should be the same in both places.): .IP .nf \f[C] ; commodity SYMBOL ; format EXAMPLEAMOUNT ; display indian rupees with currency name on the left, ; thousands, lakhs and crores comma-separated, ; period as decimal point, and two decimal places. commodity INR format INR 1,00,00,000.00 \f[R] .fi .PP The quantity of the amount does not matter; only the format is significant. The number must include a decimal mark: either a period or a comma, followed by 0 or more decimal digits. .PP Note hledger normally uses banker\[aq]s rounding, so 0.5 displayed with zero decimal digits is \[dq]0\[dq]. (More at Amount display style.) .SS Default commodity .PP The \f[C]D\f[R] directive sets a default commodity, to be used for amounts without a commodity symbol (ie, plain numbers). This commodity will be applied to all subsequent commodity-less amounts, or until the next \f[C]D\f[R] directive. (Note, this is different from Ledger\[aq]s \f[C]D\f[R].) .PP For compatibility/historical reasons, \f[C]D\f[R] also acts like a \f[C]commodity\f[R] directive, setting the commodity\[aq]s display style (for output) and decimal mark (for parsing input). As with \f[C]commodity\f[R], the amount must always be written with a decimal mark (period or comma). If both directives are used, \f[C]commodity\f[R]\[aq]s style takes precedence. .PP The syntax is \f[C]D AMOUNT\f[R]. Eg: .IP .nf \f[C] ; commodity-less amounts should be treated as dollars ; (and displayed with the dollar sign on the left, thousands separators and two decimal places) D $1,000.00 1/1 a 5 ; <- commodity-less amount, parsed as $5 and displayed as $5.00 b \f[R] .fi .SS Declaring market prices .PP The \f[C]P\f[R] directive declares a market price, which is an exchange rate between two commodities on a certain date. (In Ledger, they are called \[dq]historical prices\[dq].) These are often obtained from a stock exchange, cryptocurrency exchange, or the foreign exchange market. .PP Here is the format: .IP .nf \f[C] P DATE COMMODITYA COMMODITYBAMOUNT \f[R] .fi .IP \[bu] 2 DATE is a simple date .IP \[bu] 2 COMMODITYA is the symbol of the commodity being priced .IP \[bu] 2 COMMODITYBAMOUNT is an amount (symbol and quantity) in a second commodity, giving the price in commodity B of one unit of commodity A. .PP These two market price directives say that one euro was worth 1.35 US dollars during 2009, and $1.40 from 2010 onward: .IP .nf \f[C] P 2009/1/1 \[Eu] $1.35 P 2010/1/1 \[Eu] $1.40 \f[R] .fi .PP The \f[C]-V\f[R], \f[C]-X\f[R] and \f[C]--value\f[R] flags use these market prices to show amount values in another commodity. See Valuation. .SS Declaring accounts .PP \f[C]account\f[R] directives can be used to pre-declare accounts. Though not required, they can provide several benefits: .IP \[bu] 2 They can document your intended chart of accounts, providing a reference. .IP \[bu] 2 They can store extra information about accounts (account numbers, notes, etc.) .IP \[bu] 2 They can help hledger know your accounts\[aq] types (asset, liability, equity, revenue, expense), useful for reports like balancesheet and incomestatement. .IP \[bu] 2 They control account display order in reports, allowing non-alphabetic sorting (eg Revenues to appear above Expenses). .IP \[bu] 2 They help with account name completion in the add command, hledger-iadd, hledger-web, ledger-mode etc. .PP The simplest form is just the word \f[C]account\f[R] followed by a hledger-style account name, eg: .IP .nf \f[C] account assets:bank:checking \f[R] .fi .SS Account comments .PP Comments, beginning with a semicolon, can be added: .IP \[bu] 2 on the same line, \f[B]after two or more spaces\f[R] (because ; is allowed in account names) .IP \[bu] 2 on the next lines, indented .PP An example of both: .IP .nf \f[C] account assets:bank:checking ; same-line comment, note 2+ spaces before ; ; next-line comment ; another with tag, acctno:12345 (not used yet) \f[R] .fi .PP Same-line comments are not supported by Ledger, or hledger <1.13. .SS Account subdirectives .PP We also allow (and ignore) Ledger-style indented subdirectives, just for compatibility.: .IP .nf \f[C] account assets:bank:checking format blah blah ; <- subdirective, ignored \f[R] .fi .PP Here is the full syntax of account directives: .IP .nf \f[C] account ACCTNAME [ACCTTYPE] [;COMMENT] [;COMMENTS] [LEDGER-STYLE SUBDIRECTIVES, IGNORED] \f[R] .fi .SS Account types .PP hledger recognises five main types of account, corresponding to the account classes in the accounting equation: .PP \f[C]Asset\f[R], \f[C]Liability\f[R], \f[C]Equity\f[R], \f[C]Revenue\f[R], \f[C]Expense\f[R]. .PP These account types are important for controlling which accounts appear in the balancesheet, balancesheetequity, incomestatement reports (and probably for other things in future). .PP Additionally, we recognise the \f[C]Cash\f[R] type, which is also an \f[C]Asset\f[R], and which causes accounts to appear in the cashflow report. (\[dq]Cash\[dq] here means liquid assets, eg bank balances but typically not investments or receivables.) .SS Declaring account types .PP Generally, to make these reports work you should declare your top-level accounts and their types, using account directives with \f[C]type:\f[R] tags. .PP The tag\[aq]s value should be one of: \f[C]Asset\f[R], \f[C]Liability\f[R], \f[C]Equity\f[R], \f[C]Revenue\f[R], \f[C]Expense\f[R], \f[C]Cash\f[R], \f[C]A\f[R], \f[C]L\f[R], \f[C]E\f[R], \f[C]R\f[R], \f[C]X\f[R], \f[C]C\f[R] (all case insensitive). The type is inherited by all subaccounts except where they override it. Here\[aq]s a complete example: .IP .nf \f[C] account assets ; type: Asset account assets:bank ; type: Cash account assets:cash ; type: Cash account liabilities ; type: Liability account equity ; type: Equity account revenues ; type: Revenue account expenses ; type: Expense \f[R] .fi .SS Auto-detected account types .PP If you happen to use common english top-level account names, you may not need to declare account types, as they will be detected automatically using the following rules: .PP .TS tab(@); l l. T{ If name matches regular expression: T}@T{ account type is: T} _ T{ \f[C]\[ha]assets?(:|$)\f[R] T}@T{ \f[C]Asset\f[R] T} T{ \f[C]\[ha](debts?|liabilit(y|ies))(:|$)\f[R] T}@T{ \f[C]Liability\f[R] T} T{ \f[C]\[ha]equity(:|$)\f[R] T}@T{ \f[C]Equity\f[R] T} T{ \f[C]\[ha](income|revenue)s?(:|$)\f[R] T}@T{ \f[C]Revenue\f[R] T} T{ \f[C]\[ha]expenses?(:|$)\f[R] T}@T{ \f[C]Expense\f[R] T} .TE .PP .TS tab(@); lw(56.9n) lw(13.1n). T{ If account type is \f[C]Asset\f[R] and name does not contain regular expression: T}@T{ account type is: T} _ T{ \f[C](investment|receivable|:A/R|:fixed)\f[R] T}@T{ \f[C]Cash\f[R] T} .TE .PP Even so, explicit declarations may be a good idea, for clarity and predictability. .SS Interference from auto-detected account types .PP If you assign any account type, it\[aq]s a good idea to assign all of them, to prevent any confusion from mixing declared and auto-detected types. Although it\[aq]s unlikely to happen in real life, here\[aq]s an example: with the following journal, \f[C]balancesheetequity\f[R] shows \[dq]liabilities\[dq] in both Liabilities and Equity sections. Declaring another account as \f[C]type:Liability\f[R] would fix it: .IP .nf \f[C] account liabilities ; type:Equity 2020-01-01 assets 1 liabilities 1 equity -2 \f[R] .fi .SS Old account type syntax .PP In some hledger journals you might instead see this old syntax (the letters ALERX, separated from the account name by two or more spaces); this is deprecated and may be removed soon: .IP .nf \f[C] account assets A account liabilities L account equity E account revenues R account expenses X \f[R] .fi .SS Account display order .PP Account directives also set the order in which accounts are displayed, eg in reports, the hledger-ui accounts screen, and the hledger-web sidebar. By default accounts are listed in alphabetical order. But if you have these account directives in the journal: .IP .nf \f[C] account assets account liabilities account equity account revenues account expenses \f[R] .fi .PP you\[aq]ll see those accounts displayed in declaration order, not alphabetically: .IP .nf \f[C] $ hledger accounts -1 assets liabilities equity revenues expenses \f[R] .fi .PP Undeclared accounts, if any, are displayed last, in alphabetical order. .PP Note that sorting is done at each level of the account tree (within each group of sibling accounts under the same parent). And currently, this directive: .IP .nf \f[C] account other:zoo \f[R] .fi .PP would influence the position of \f[C]zoo\f[R] among \f[C]other\f[R]\[aq]s subaccounts, but not the position of \f[C]other\f[R] among the top-level accounts. This means: .IP \[bu] 2 you will sometimes declare parent accounts (eg \f[C]account other\f[R] above) that you don\[aq]t intend to post to, just to customize their display order .IP \[bu] 2 sibling accounts stay together (you couldn\[aq]t display \f[C]x:y\f[R] in between \f[C]a:b\f[R] and \f[C]a:c\f[R]). .SS Rewriting accounts .PP You can define account alias rules which rewrite your account names, or parts of them, before generating reports. This can be useful for: .IP \[bu] 2 expanding shorthand account names to their full form, allowing easier data entry and a less verbose journal .IP \[bu] 2 adapting old journals to your current chart of accounts .IP \[bu] 2 experimenting with new account organisations, like a new hierarchy or combining two accounts into one .IP \[bu] 2 customising reports .PP Account aliases also rewrite account names in account directives. They do not affect account names being entered via hledger add or hledger-web. .PP See also Rewrite account names. .SS Basic aliases .PP To set an account alias, use the \f[C]alias\f[R] directive in your journal file. This affects all subsequent journal entries in the current file or its included files. The spaces around the = are optional: .IP .nf \f[C] alias OLD = NEW \f[R] .fi .PP Or, you can use the \f[C]--alias \[aq]OLD=NEW\[aq]\f[R] option on the command line. This affects all entries. It\[aq]s useful for trying out aliases interactively. .PP OLD and NEW are case sensitive full account names. hledger will replace any occurrence of the old account name with the new one. Subaccounts are also affected. Eg: .IP .nf \f[C] alias checking = assets:bank:wells fargo:checking ; rewrites \[dq]checking\[dq] to \[dq]assets:bank:wells fargo:checking\[dq], or \[dq]checking:a\[dq] to \[dq]assets:bank:wells fargo:checking:a\[dq] \f[R] .fi .SS Regex aliases .PP There is also a more powerful variant that uses a regular expression, indicated by the forward slashes: .IP .nf \f[C] alias /REGEX/ = REPLACEMENT \f[R] .fi .PP or \f[C]--alias \[aq]/REGEX/=REPLACEMENT\[aq]\f[R]. .PP REGEX is a case-insensitive regular expression. Anywhere it matches inside an account name, the matched part will be replaced by REPLACEMENT. If REGEX contains parenthesised match groups, these can be referenced by the usual numeric backreferences in REPLACEMENT. Eg: .IP .nf \f[C] alias /\[ha](.+):bank:([\[ha]:]+):(.*)/ = \[rs]1:\[rs]2 \[rs]3 ; rewrites \[dq]assets:bank:wells fargo:checking\[dq] to \[dq]assets:wells fargo checking\[dq] \f[R] .fi .PP Also note that REPLACEMENT continues to the end of line (or on command line, to end of option argument), so it can contain trailing whitespace. .SS Combining aliases .PP You can define as many aliases as you like, using journal directives and/or command line options. .PP Recursive aliases - where an account name is rewritten by one alias, then by another alias, and so on - are allowed. Each alias sees the effect of previously applied aliases. .PP In such cases it can be important to understand which aliases will be applied and in which order. For (each account name in) each journal entry, we apply: .IP "1." 3 \f[C]alias\f[R] directives preceding the journal entry, most recently parsed first (ie, reading upward from the journal entry, bottom to top) .IP "2." 3 \f[C]--alias\f[R] options, in the order they appeared on the command line (left to right). .PP In other words, for (an account name in) a given journal entry: .IP \[bu] 2 the nearest alias declaration before/above the entry is applied first .IP \[bu] 2 the next alias before/above that will be be applied next, and so on .IP \[bu] 2 aliases defined after/below the entry do not affect it. .PP This gives nearby aliases precedence over distant ones, and helps provide semantic stability - aliases will keep working the same way independent of which files are being read and in which order. .PP In case of trouble, adding \f[C]--debug=6\f[R] to the command line will show which aliases are being applied when. .SS Aliases and multiple files .PP As explained at Directives and multiple files, \f[C]alias\f[R] directives do not affect parent or sibling files. Eg in this command, .IP .nf \f[C] hledger -f a.aliases -f b.journal \f[R] .fi .PP account aliases defined in a.aliases will not affect b.journal. Including the aliases doesn\[aq]t work either: .IP .nf \f[C] include a.aliases 2020-01-01 ; not affected by a.aliases foo 1 bar \f[R] .fi .PP This means that account aliases should usually be declared at the start of your top-most file, like this: .IP .nf \f[C] alias foo=Foo alias bar=Bar 2020-01-01 ; affected by aliases above foo 1 bar include c.journal ; also affected \f[R] .fi .SS \f[C]end aliases\f[R] .PP You can clear (forget) all currently defined aliases with the \f[C]end aliases\f[R] directive: .IP .nf \f[C] end aliases \f[R] .fi .SS Default parent account .PP You can specify a parent account which will be prepended to all accounts within a section of the journal. Use the \f[C]apply account\f[R] and \f[C]end apply account\f[R] directives like so: .IP .nf \f[C] apply account home 2010/1/1 food $10 cash end apply account \f[R] .fi .PP which is equivalent to: .IP .nf \f[C] 2010/01/01 home:food $10 home:cash $-10 \f[R] .fi .PP If \f[C]end apply account\f[R] is omitted, the effect lasts to the end of the file. Included files are also affected, eg: .IP .nf \f[C] apply account business include biz.journal end apply account apply account personal include personal.journal \f[R] .fi .PP Prior to hledger 1.0, legacy \f[C]account\f[R] and \f[C]end\f[R] spellings were also supported. .PP A default parent account also affects account directives. It does not affect account names being entered via hledger add or hledger-web. If account aliases are present, they are applied after the default parent account. .SS Periodic transactions .PP Periodic transaction rules describe transactions that recur. They allow hledger to generate temporary future transactions to help with forecasting, so you don\[aq]t have to write out each one in the journal, and it\[aq]s easy to try out different forecasts. Secondly, they are also used to define the budgets shown in budget reports. .PP Periodic transactions can be a little tricky, so before you use them, read this whole section - or at least these tips: .IP "1." 3 Two spaces accidentally added or omitted will cause you trouble - read about this below. .IP "2." 3 For troubleshooting, show the generated transactions with \f[C]hledger print --forecast tag:generated\f[R] or \f[C]hledger register --forecast tag:generated\f[R]. .IP "3." 3 Forecasted transactions will begin only after the last non-forecasted transaction\[aq]s date. .IP "4." 3 Forecasted transactions will end 6 months from today, by default. See below for the exact start/end rules. .IP "5." 3 period expressions can be tricky. Their documentation needs improvement, but is worth studying. .IP "6." 3 Some period expressions with a repeating interval must begin on a natural boundary of that interval. Eg in \f[C]weekly from DATE\f[R], DATE must be a monday. \f[C]\[ti] weekly from 2019/10/1\f[R] (a tuesday) will give an error. .IP "7." 3 Other period expressions with an interval are automatically expanded to cover a whole number of that interval. (This is done to improve reports, but it also affects periodic transactions. Yes, it\[aq]s a bit inconsistent with the above.) Eg: \f[C]\[ti] every 10th day of month from 2020/01\f[R], which is equivalent to \f[C]\[ti] every 10th day of month from 2020/01/01\f[R], will be adjusted to start on 2019/12/10. .SS Periodic rule syntax .PP A periodic transaction rule looks like a normal journal entry, with the date replaced by a tilde (\f[C]\[ti]\f[R]) followed by a period expression (mnemonic: \f[C]\[ti]\f[R] looks like a recurring sine wave.): .IP .nf \f[C] \[ti] monthly expenses:rent $2000 assets:bank:checking \f[R] .fi .PP There is an additional constraint on the period expression: the start date must fall on a natural boundary of the interval. Eg \f[C]monthly from 2018/1/1\f[R] is valid, but \f[C]monthly from 2018/1/15\f[R] is not. .PP Partial or relative dates (M/D, D, tomorrow, last week) in the period expression can work (useful or not). They will be relative to today\[aq]s date, unless a Y default year directive is in effect, in which case they will be relative to Y/1/1. .SS Two spaces between period expression and description! .PP If the period expression is followed by a transaction description, these must be separated by \f[B]two or more spaces\f[R]. This helps hledger know where the period expression ends, so that descriptions can not accidentally alter their meaning, as in this example: .IP .nf \f[C] ; 2 or more spaces needed here, so the period is not understood as \[dq]every 2 months in 2020\[dq] ; || ; vv \[ti] every 2 months in 2020, we will review assets:bank:checking $1500 income:acme inc \f[R] .fi .PP So, .IP \[bu] 2 Do write two spaces between your period expression and your transaction description, if any. .IP \[bu] 2 Don\[aq]t accidentally write two spaces in the middle of your period expression. .SS Forecasting with periodic transactions .PP The \f[C]--forecast\f[R] flag activates any periodic transaction rules in the journal. They will generate temporary recurring transactions, which are not saved in the journal, but will appear in all reports (eg print). This can be useful for estimating balances into the future, or experimenting with different scenarios. Or, it can be used as a data entry aid: describe recurring transactions, and every so often copy the output of \f[C]print --forecast\f[R] into the journal. .PP These transactions will have an extra tag indicating which periodic rule generated them: \f[C]generated-transaction:\[ti] PERIODICEXPR\f[R]. And a similar, hidden tag (beginning with an underscore) which, because it\[aq]s never displayed by print, can be used to match transactions generated \[dq]just now\[dq]: \f[C]_generated-transaction:\[ti] PERIODICEXPR\f[R]. .PP Periodic transactions are generated within some forecast period. By default, this .IP \[bu] 2 begins on the later of .RS 2 .IP \[bu] 2 the report start date if specified with -b/-p/date: .IP \[bu] 2 the day after the latest normal (non-periodic) transaction in the journal, or today if there are no normal transactions. .RE .IP \[bu] 2 ends on the report end date if specified with -e/-p/date:, or 6 months (180 days) from today. .PP This means that periodic transactions will begin only after the latest recorded transaction. And a recorded transaction dated in the future can prevent generation of periodic transactions. (You can avoid that by writing the future transaction as a one-time periodic rule instead - put tilde before the date, eg \f[C]\[ti] YYYY-MM-DD ...\f[R]). .PP Or, you can set your own arbitrary \[dq]forecast period\[dq], which can overlap recorded transactions, and need not be in the future, by providing an option argument, like \f[C]--forecast=PERIODEXPR\f[R]. Note the equals sign is required, a space won\[aq]t work. PERIODEXPR is a period expression, which can specify the start date, end date, or both, like in a \f[C]date:\f[R] query. (See also hledger.1 -> Report start & end date). Some examples: \f[C]--forecast=202001-202004\f[R], \f[C]--forecast=jan-\f[R], \f[C]--forecast=2020\f[R]. .SS Budgeting with periodic transactions .PP With the \f[C]--budget\f[R] flag, currently supported by the balance command, each periodic transaction rule declares recurring budget goals for the specified accounts. Eg the first example above declares a goal of spending $2000 on rent (and also, a goal of depositing $2000 into checking) every month. Goals and actual performance can then be compared in budget reports. .PP For more details, see: balance: Budget report and Budgeting and Forecasting. .PP .SS Auto postings .PP \[dq]Automated postings\[dq] or \[dq]auto postings\[dq] are extra postings which get added automatically to transactions which match certain queries, defined by \[dq]auto posting rules\[dq], when you use the \f[C]--auto\f[R] flag. .PP An auto posting rule looks a bit like a transaction: .IP .nf \f[C] = QUERY ACCOUNT AMOUNT ... ACCOUNT [AMOUNT] \f[R] .fi .PP except the first line is an equals sign (mnemonic: \f[C]=\f[R] suggests matching), followed by a query (which matches existing postings), and each \[dq]posting\[dq] line describes a posting to be generated, and the posting amounts can be: .IP \[bu] 2 a normal amount with a commodity symbol, eg \f[C]$2\f[R]. This will be used as-is. .IP \[bu] 2 a number, eg \f[C]2\f[R]. The commodity symbol (if any) from the matched posting will be added to this. .IP \[bu] 2 a numeric multiplier, eg \f[C]*2\f[R] (a star followed by a number N). The matched posting\[aq]s amount (and total price, if any) will be multiplied by N. .IP \[bu] 2 a multiplier with a commodity symbol, eg \f[C]*$2\f[R] (a star, number N, and symbol S). The matched posting\[aq]s amount will be multiplied by N, and its commodity symbol will be replaced with S. .PP Any query term containing spaces must be enclosed in single or double quotes, as on the command line. Eg, note the quotes around the second query term below: .IP .nf \f[C] = expenses:groceries \[aq]expenses:dining out\[aq] (budget:funds:dining out) *-1 \f[R] .fi .PP Some examples: .IP .nf \f[C] ; every time I buy food, schedule a dollar donation = expenses:food (liabilities:charity) $-1 ; when I buy a gift, also deduct that amount from a budget envelope subaccount = expenses:gifts assets:checking:gifts *-1 assets:checking *1 2017/12/1 expenses:food $10 assets:checking 2017/12/14 expenses:gifts $20 assets:checking \f[R] .fi .IP .nf \f[C] $ hledger print --auto 2017-12-01 expenses:food $10 assets:checking (liabilities:charity) $-1 2017-12-14 expenses:gifts $20 assets:checking assets:checking:gifts -$20 assets:checking $20 \f[R] .fi .SS Auto postings and multiple files .PP An auto posting rule can affect any transaction in the current file, or in any parent file or child file. Note, currently it will not affect sibling files (when multiple \f[C]-f\f[R]/\f[C]--file\f[R] are used - see #1212). .SS Auto postings and dates .PP A posting date (or secondary date) in the matched posting, or (taking precedence) a posting date in the auto posting rule itself, will also be used in the generated posting. .SS Auto postings and transaction balancing / inferred amounts / balance assertions .PP Currently, auto postings are added: .IP \[bu] 2 after missing amounts are inferred, and transactions are checked for balancedness, .IP \[bu] 2 but before balance assertions are checked. .PP Note this means that journal entries must be balanced both before and after auto postings are added. This changed in hledger 1.12+; see #893 for background. .SS Auto posting tags .PP Automated postings will have some extra tags: .IP \[bu] 2 \f[C]generated-posting:= QUERY\f[R] - shows this was generated by an auto posting rule, and the query .IP \[bu] 2 \f[C]_generated-posting:= QUERY\f[R] - a hidden tag, which does not appear in hledger\[aq]s output. This can be used to match postings generated \[dq]just now\[dq], rather than generated in the past and saved to the journal. .PP Also, any transaction that has been changed by auto posting rules will have these tags added: .IP \[bu] 2 \f[C]modified:\f[R] - this transaction was modified .IP \[bu] 2 \f[C]_modified:\f[R] - a hidden tag not appearing in the comment; this transaction was modified \[dq]just now\[dq]. .SH "REPORTING BUGS" Report bugs at http://bugs.hledger.org (or on the #hledger IRC channel or hledger mail list) .SH AUTHORS Simon Michael and contributors .SH COPYRIGHT Copyright (C) 2007-2019 Simon Michael. .br Released under GNU GPL v3 or later. .SH SEE ALSO hledger(1), hledger\-ui(1), hledger\-web(1), hledger\-api(1), hledger_csv(5), hledger_journal(5), hledger_timeclock(5), hledger_timedot(5), ledger(1) http://hledger.org hledger-lib-1.19.1/hledger_journal.txt0000644000000000000000000020506013725533425016070 0ustar0000000000000000 hledger_journal(5) hledger User Manuals hledger_journal(5) NAME Journal - hledger's default file format, representing a General Journal DESCRIPTION hledger's usual data source is a plain text file containing journal en- tries in hledger journal format. This file represents a standard ac- counting general journal. I use file names ending in .journal, but that's not required. The journal file contains a number of transaction entries, each describing a transfer of money (or any commodity) between two or more named accounts, in a simple format readable by both hledger and humans. hledger's journal format is a compatible subset, mostly, of ledger's journal format, so hledger can work with compatible ledger journal files as well. It's safe, and encouraged, to run both hledger and ledger on the same journal file, eg to validate the results you're get- ting. You can use hledger without learning any more about this file; just use the add or web or import commands to create and update it. Many users, though, edit the journal file with a text editor, and track changes with a version control system such as git. Editor addons such as ledger-mode or hledger-mode for Emacs, vim-ledger for Vim, and hledger-vscode for Visual Studio Code, make this easier, adding colour, formatting, tab completion, and useful commands. See Editor configura- tion at hledger.org for the full list. FILE FORMAT Here's a description of each part of the file format (and hledger's data model). These are mostly in the order you'll use them, but in some cases related concepts have been grouped together for easy refer- ence, or linked before they are introduced, so feel free to skip over anything that looks unnecessary right now. Transactions Transactions are the main unit of information in a journal file. They represent events, typically a movement of some quantity of commodities between two or more named accounts. Each transaction is recorded as a journal entry, beginning with a sim- ple date in column 0. This can be followed by any of the following op- tional fields, separated by spaces: o a status character (empty, !, or *) o a code (any short number or text, enclosed in parentheses) o a description (any remaining text until end of line or a semicolon) o a comment (any remaining text following a semicolon until end of line, and any following indented lines beginning with a semicolon) o 0 or more indented posting lines, describing what was transferred and the accounts involved (indented comment lines are also allowed, but not blank lines or non-indented lines). Here's a simple journal file containing one transaction: 2008/01/01 income assets:bank:checking $1 income:salary $-1 Dates Simple dates Dates in the journal file use simple dates format: YYYY-MM-DD or YYYY/MM/DD or YYYY.MM.DD, with leading zeros optional. The year may be omitted, in which case it will be inferred from the context: the cur- rent transaction, the default year set with a default year directive, or the current date when the command is run. Some examples: 2010-01-31, 2010/01/31, 2010.1.31, 1/31. (The UI also accepts simple dates, as well as the more flexible smart dates documented in the hledger manual.) Secondary dates Real-life transactions sometimes involve more than one date - eg the date you write a cheque, and the date it clears in your bank. When you want to model this, for more accurate daily balances, you can specify individual posting dates. Or, you can use the older secondary date feature (Ledger calls it aux- iliary date or effective date). Note: we support this for compatibil- ity, but I usually recommend avoiding this feature; posting dates are almost always clearer and simpler. A secondary date is written after the primary date, following an equals sign. If the year is omitted, the primary date's year is assumed. When running reports, the primary (left) date is used by default, but with the --date2 flag (or --aux-date or --effective), the secondary (right) date will be used instead. The meaning of secondary dates is up to you, but it's best to follow a consistent rule. Eg "primary = the bank's clearing date, secondary = date the transaction was initiated, if different", as shown here: 2010/2/23=2/19 movie ticket expenses:cinema $10 assets:checking $ hledger register checking 2010-02-23 movie ticket assets:checking $-10 $-10 $ hledger register checking --date2 2010-02-19 movie ticket assets:checking $-10 $-10 Posting dates You can give individual postings a different date from their parent transaction, by adding a posting comment containing a tag (see below) like date:DATE. This is probably the best way to control posting dates precisely. Eg in this example the expense should appear in May re- ports, and the deduction from checking should be reported on 6/1 for easy bank reconciliation: 2015/5/30 expenses:food $10 ; food purchased on saturday 5/30 assets:checking ; bank cleared it on monday, date:6/1 $ hledger -f t.j register food 2015-05-30 expenses:food $10 $10 $ hledger -f t.j register checking 2015-06-01 assets:checking $-10 $-10 DATE should be a simple date; if the year is not specified it will use the year of the transaction's date. You can set the secondary date similarly, with date2:DATE2. The date: or date2: tags must have a valid simple date value if they are present, eg a date: tag with no value is not allowed. Ledger's earlier, more compact bracketed date syntax is also supported: [DATE], [DATE=DATE2] or [=DATE2]. hledger will attempt to parse any square-bracketed sequence of the 0123456789/-.= characters in this way. With this syntax, DATE infers its year from the transaction and DATE2 infers its year from DATE. Status Transactions, or individual postings within a transaction, can have a status mark, which is a single character before the transaction de- scription or posting account name, separated from it by a space, indi- cating one of three statuses: mark status ------------------ unmarked ! pending * cleared When reporting, you can filter by status with the -U/--unmarked, -P/--pending, and -C/--cleared flags; or the status:, status:!, and status:* queries; or the U, P, C keys in hledger-ui. Note, in Ledger and in older versions of hledger, the "unmarked" state is called "uncleared". As of hledger 1.3 we have renamed it to un- marked for clarity. To replicate Ledger and old hledger's behaviour of also matching pend- ing, combine -U and -P. Status marks are optional, but can be helpful eg for reconciling with real-world accounts. Some editor modes provide highlighting and short- cuts for working with status. Eg in Emacs ledger-mode, you can toggle transaction status with C-c C-e, or posting status with C-c C-c. What "uncleared", "pending", and "cleared" actually mean is up to you. Here's one suggestion: status meaning -------------------------------------------------------------------------- uncleared recorded but not yet reconciled; needs review pending tentatively reconciled (if needed, eg during a big reconcil- iation) cleared complete, reconciled as far as possible, and considered cor- rect With this scheme, you would use -PC to see the current balance at your bank, -U to see things which will probably hit your bank soon (like un- cashed checks), and no flags to see the most up-to-date state of your finances. Description A transaction's description is the rest of the line following the date and status mark (or until a comment begins). Sometimes called the "narration" in traditional bookkeeping, it can be used for whatever you wish, or left blank. Transaction descriptions can be queried, unlike comments. Payee and note You can optionally include a | (pipe) character in descriptions to sub- divide the description into separate fields for payee/payer name on the left (up to the first |) and an additional note field on the right (af- ter the first |). This may be worthwhile if you need to do more pre- cise querying and pivoting by payee or by note. Comments Lines in the journal beginning with a semicolon (;) or hash (#) or star (*) are comments, and will be ignored. (Star comments cause org-mode nodes to be ignored, allowing emacs users to fold and navigate their journals with org-mode or orgstruct-mode.) You can attach comments to a transaction by writing them after the de- scription and/or indented on the following lines (before the postings). Similarly, you can attach comments to an individual posting by writing them after the amount and/or indented on the following lines. Transac- tion and posting comments must begin with a semicolon (;). Some examples: # a file comment ; another file comment * also a file comment, useful in org/orgstruct mode comment A multiline file comment, which continues until a line containing just "end comment" (or end of file). end comment 2012/5/14 something ; a transaction comment ; the transaction comment, continued posting1 1 ; a comment for posting 1 posting2 ; a comment for posting 2 ; another comment line for posting 2 ; a file comment (because not indented) You can also comment larger regions of a file using comment and end comment directives. Tags Tags are a way to add extra labels or labelled data to postings and transactions, which you can then search or pivot on. A simple tag is a word (which may contain hyphens) followed by a full colon, written inside a transaction or posting comment line: 2017/1/16 bought groceries ; sometag: Tags can have a value, which is the text after the colon, up to the next comma or end of line, with leading/trailing whitespace removed: expenses:food $10 ; a-posting-tag: the tag value Note this means hledger's tag values can not contain commas or new- lines. Ending at commas means you can write multiple short tags on one line, comma separated: assets:checking ; a comment containing tag1:, tag2: some value ... Here, o "a comment containing" is just comment text, not a tag o "tag1" is a tag with no value o "tag2" is another tag, whose value is "some value ..." Tags in a transaction comment affect the transaction and all of its postings, while tags in a posting comment affect only that posting. For example, the following transaction has three tags (A, TAG2, third- tag) and the posting has four (those plus posting-tag): 1/1 a transaction ; A:, TAG2: ; third-tag: a third transaction tag, <- with a value (a) $1 ; posting-tag: Tags are like Ledger's metadata feature, except hledger's tag values are simple strings. Postings A posting is an addition of some amount to, or removal of some amount from, an account. Each posting line begins with at least one space or tab (2 or 4 spaces is common), followed by: o (optional) a status character (empty, !, or *), followed by a space o (required) an account name (any text, optionally containing single spaces, until end of line or a double space) o (optional) two or more spaces or tabs followed by an amount. Positive amounts are being added to the account, negative amounts are being removed. The amounts within a transaction must always sum up to zero. As a con- venience, one amount may be left blank; it will be inferred so as to balance the transaction. Be sure to note the unusual two-space delimiter between account name and amount. This makes it easy to write account names containing spa- ces. But if you accidentally leave only one space (or tab) before the amount, the amount will be considered part of the account name. Virtual postings A posting with a parenthesised account name is called a virtual posting or unbalanced posting, which means it is exempt from the usual rule that a transaction's postings must balance add up to zero. This is not part of double entry accounting, so you might choose to avoid this feature. Or you can use it sparingly for certain special cases where it can be convenient. Eg, you could set opening balances without using a balancing equity account: 1/1 opening balances (assets:checking) $1000 (assets:savings) $2000 A posting with a bracketed account name is called a balanced virtual posting. The balanced virtual postings in a transaction must add up to zero (separately from other postings). Eg: 1/1 buy food with cash, update budget envelope subaccounts, & something else assets:cash $-10 ; <- these balance expenses:food $7 ; <- expenses:food $3 ; <- [assets:checking:budget:food] $-10 ; <- and these balance [assets:checking:available] $10 ; <- (something:else) $5 ; <- not required to balance Ordinary non-parenthesised, non-bracketed postings are called real postings. You can exclude virtual postings from reports with the -R/--real flag or real:1 query. Account names Account names typically have several parts separated by a full colon, from which hledger derives a hierarchical chart of accounts. They can be anything you like, but in finance there are traditionally five top- level accounts: assets, liabilities, income, expenses, and equity. Account names may contain single spaces, eg: assets:accounts receiv- able. Because of this, they must always be followed by two or more spaces (or newline). Account names can be aliased. Amounts After the account name, there is usually an amount. (Important: be- tween account name and amount, there must be two or more spaces.) hledger's amount format is flexible, supporting several international formats. Here are some examples. Amounts have a number (the "quan- tity"): 1 ..and usually a currency or commodity name (the "commodity"). This is a symbol, word, or phrase, to the left or right of the quantity, with or without a separating space: $1 4000 AAPL If the commodity name contains spaces, numbers, or punctuation, it must be enclosed in double quotes: 3 "no. 42 green apples" Amounts can be preceded by a minus sign (or a plus sign, though plus is the default), The sign can be written before or after a left-side com- modity symbol: -$1 $-1 One or more spaces between the sign and the number are acceptable when parsing (but they won't be displayed in output): + $1 $- 1 Scientific E notation is allowed: 1E-6 EUR 1E3 A decimal mark can be written as a period or a comma: 1.23 1,23456780000009 Digit group marks In the integer part of the quantity (left of the decimal mark), groups of digits can optionally be separated by a "digit group mark" - a space, comma, or period (different from the decimal mark): $1,000,000.00 EUR 2.000.000,00 INR 9,99,99,999.00 1 000 000.9455 Note, a number containing a single group mark and no decimal mark is ambiguous. Are these group marks or decimal marks ? 1,000 1.000 hledger will treat them both as decimal marks by default (cf #793). If you use digit group marks, to prevent confusion and undetected typos we recommend you write commodity directives at the top of the file to ex- plicitly declare the decimal mark (and optionally a digit group mark). Note, these formats ("amount styles") are specific to each commodity, so if your data uses multiple formats, hledger can handle it: commodity $1,000.00 commodity EUR 1.000,00 commodity INR 9,99,99,999.00 commodity 1 000 000.9455 Amount display style For each commodity, hledger chooses a consistent format to use when displaying amounts. (Except price amounts, which are always displayed as written). The display style is chosen as follows: o If there is a commodity directive (or default commodity directive) for the commodity, that format is used (see examples above). o Otherwise the format of the first posting amount in that commodity seen in the journal is used. But the number of decimal places ("pre- cision") will be the maximum from all posting amounts in that commod- ity. o Or if there are no such amounts in the journal, a default format is used (like $1000.00). Transaction prices don't affect the amount display style directly, but occasionally they can do so indirectly (eg when an posting's amount is inferred using a transaction price). If you find this causing prob- lems, use a commodity directive to fix the display style. In summary: amounts will be displayed much as they appear in your jour- nal, with the max observed number of decimal places. If you want to see fewer decimal places in reports, use a commodity directive to over- ride that. hledger uses banker's rounding: it rounds to the nearest even number, eg 0.5 displayed with zero decimal places is "0"). (Note, prior to hledger 1.17.1 this could vary if hledger happened to be built with an old version of Decimal (<0.5.1); since 1.17.1 it's guaranteed.) Transaction prices Within a transaction, you can note an amount's price in another commod- ity. This can be used to document the cost (in a purchase) or selling price (in a sale). For example, transaction prices are useful to record purchases of a foreign currency. Note transaction prices are fixed at the time of the transaction, and do not change over time. See also market prices, which represent prevailing exchange rates on a cer- tain date. There are several ways to record a transaction price: 1. Write the price per unit, as @ UNITPRICE after the amount: 2009/1/1 assets:euros EUR100 @ $1.35 ; one hundred euros purchased at $1.35 each assets:dollars ; balancing amount is -$135.00 2. Write the total price, as @@ TOTALPRICE after the amount: 2009/1/1 assets:euros EUR100 @@ $135 ; one hundred euros purchased at $135 for the lot assets:dollars 3. Specify amounts for all postings, using exactly two commodities, and let hledger infer the price that balances the transaction: 2009/1/1 assets:euros EUR100 ; one hundred euros purchased assets:dollars $-135 ; for $135 4. Like 1, but the @ is parenthesised, i.e. (@); this is for compati- bility with Ledger journals (Virtual posting costs), and is equiva- lent to 1 in hledger. 5. Like 2, but as in 4 the @@ is parenthesised, i.e. (@@); in hledger, this is equivalent to 2. Use the -B/--cost flag to convert amounts to their transaction price's commodity, if any. (mnemonic: "B" is from "cost Basis", as in Ledger). Eg here is how -B affects the balance report for the example above: $ hledger bal -N --flat $-135 assets:dollars EUR100 assets:euros $ hledger bal -N --flat -B $-135 assets:dollars $135 assets:euros # <- the euros' cost Note -B is sensitive to the order of postings when a transaction price is inferred: the inferred price will be in the commodity of the last amount. So if example 3's postings are reversed, while the transaction is equivalent, -B shows something different: 2009/1/1 assets:dollars $-135 ; 135 dollars sold assets:euros EUR100 ; for 100 euros $ hledger bal -N --flat -B EUR-100 assets:dollars # <- the dollars' selling price EUR100 assets:euros Lot prices and lot dates Ledger allows another kind of price, lot price (four variants: {UNIT- PRICE}, {{TOTALPRICE}}, {=FIXEDUNITPRICE}, {{=FIXEDTOTALPRICE}}), and/or a lot date ([DATE]) to be specified. These are normally used to select a lot when selling investments. hledger will parse these, for compatibility with Ledger journals, but currently ignores them. A transaction price, lot price and/or lot date may appear in any order, after the posting amount and before the balance assertion if any. Balance assertions hledger supports Ledger-style balance assertions in journal files. These look like, for example, = EXPECTEDBALANCE following a posting's amount. Eg here we assert the expected dollar balance in accounts a and b after each posting: 2013/1/1 a $1 =$1 b =$-1 2013/1/2 a $1 =$2 b $-1 =$-2 After reading a journal file, hledger will check all balance assertions and report an error if any of them fail. Balance assertions can pro- tect you from, eg, inadvertently disrupting reconciled balances while cleaning up old entries. You can disable them temporarily with the -I/--ignore-assertions flag, which can be useful for troubleshooting or for reading Ledger files. (Note: this flag currently does not disable balance assignments, below). Assertions and ordering hledger sorts an account's postings and assertions first by date and then (for postings on the same day) by parse order. Note this is dif- ferent from Ledger, which sorts assertions only by parse order. (Also, Ledger assertions do not see the accumulated effect of repeated post- ings to the same account within a transaction.) So, hledger balance assertions keep working if you reorder differently- dated transactions within the journal. But if you reorder same-dated transactions or postings, assertions might break and require updating. This order dependence does bring an advantage: precise control over the order of postings and assertions within a day, so you can assert intra- day balances. Assertions and included files With included files, things are a little more complicated. Including preserves the ordering of postings and assertions. If you have multi- ple postings to an account on the same day, split across different files, and you also want to assert the account's balance on the same day, you'll have to put the assertion in the right file. Assertions and multiple -f options Balance assertions don't work well across files specified with multiple -f options. Use include or concatenate the files instead. Assertions and commodities The asserted balance must be a simple single-commodity amount, and in fact the assertion checks only this commodity's balance within the (possibly multi-commodity) account balance. This is how assertions work in Ledger also. We could call this a "partial" balance assertion. To assert the balance of more than one commodity in an account, you can write multiple postings, each asserting one commodity's balance. You can make a stronger "total" balance assertion by writing a double equals sign (== EXPECTEDBALANCE). This asserts that there are no other unasserted commodities in the account (or, that their balance is 0). 2013/1/1 a $1 a 1EUR b $-1 c -1EUR 2013/1/2 ; These assertions succeed a 0 = $1 a 0 = 1EUR b 0 == $-1 c 0 == -1EUR 2013/1/3 ; This assertion fails as 'a' also contains 1EUR a 0 == $1 It's not yet possible to make a complete assertion about a balance that has multiple commodities. One workaround is to isolate each commodity into its own subaccount: 2013/1/1 a:usd $1 a:euro 1EUR b 2013/1/2 a 0 == 0 a:usd 0 == $1 a:euro 0 == 1EUR Assertions and prices Balance assertions ignore transaction prices, and should normally be written without one: 2019/1/1 (a) $1 @ EUR1 = $1 We do allow prices to be written there, however, and print shows them, even though they don't affect whether the assertion passes or fails. This is for backward compatibility (hledger's close command used to generate balance assertions with prices), and because balance assign- ments do use them (see below). Assertions and subaccounts The balance assertions above (= and ==) do not count the balance from subaccounts; they check the account's exclusive balance only. You can assert the balance including subaccounts by writing =* or ==*, eg: 2019/1/1 equity:opening balances checking:a 5 checking:b 5 checking 1 ==* 11 Assertions and virtual postings Balance assertions are checked against all postings, both real and vir- tual. They are not affected by the --real/-R flag or real: query. Assertions and precision Balance assertions compare the exactly calculated amounts, which are not always what is shown by reports. Eg a commodity directive may limit the display precision, but this will not affect balance asser- tions. Balance assertion failure messages show exact amounts. Balance assignments Ledger-style balance assignments are also supported. These are like balance assertions, but with no posting amount on the left side of the equals sign; instead it is calculated automatically so as to satisfy the assertion. This can be a convenience during data entry, eg when setting opening balances: ; starting a new journal, set asset account balances 2016/1/1 opening balances assets:checking = $409.32 assets:savings = $735.24 assets:cash = $42 equity:opening balances or when adjusting a balance to reality: ; no cash left; update balance, record any untracked spending as a generic expense 2016/1/15 assets:cash = $0 expenses:misc The calculated amount depends on the account's balance in the commodity at that point (which depends on the previously-dated postings of the commodity to that account since the last balance assertion or assign- ment). Note that using balance assignments makes your journal a little less explicit; to know the exact amount posted, you have to run hledger or do the calculations yourself, instead of just reading it. Balance assignments and prices A transaction price in a balance assignment will cause the calculated amount to have that price attached: 2019/1/1 (a) = $1 @ EUR2 $ hledger print --explicit 2019-01-01 (a) $1 @ EUR2 = $1 @ EUR2 Directives A directive is a line in the journal beginning with a special keyword, that influences how the journal is processed. hledger's directives are based on a subset of Ledger's, but there are many differences (and also some differences between hledger versions). Directives' behaviour and interactions can get a little bit complex, so here is a table summarising the directives and their effects, with links to more detailed docs. direc- end di- subdi- purpose can affect (as of tive rective rec- 2018/06) tives ------------------------------------------------------------------------------------ account any document account names, de- all entries in all text clare account types & dis- files, before or play order after alias end rewrite account names following in- aliases line/included en- tries until end of current file or end directive apply end apply prepend a common parent to following in- account account account names line/included en- tries until end of current file or end directive comment end com- ignore part of journal following in- ment line/included en- tries until end of current file or end directive commod- format declare a commodity and its number notation: ity number notation & display following entries style in that commodity in all files; dis- play style: amounts of that commodity in reports D declare a commodity to be default commodity: used for commodityless following commod- amounts, and its number no- ityless entries un- tation & display style til end of current file; number nota- tion: following en- tries in that com- modity until end of current file; dis- play style: amounts of that commodity in reports include include entries/directives what the included from another file directives affect P declare a market price for a amounts of that commodity commodity in re- ports, when -V is used Y declare a year for yearless following in- dates line/included en- tries until end of current file = declare an auto posting all entries in par- rule, adding postings to ent/current/child other transactions files (but not sib- ling files, see #1212) And some definitions: subdi- optional indented directive line immediately following a parent rec- directive tive number how to interpret numbers when parsing journal entries (the iden- nota- tity of the decimal separator character). (Currently each com- tion modity can have its own notation, even in the same file.) dis- how to display amounts of a commodity in reports (symbol side play and spacing, digit groups, decimal separator, decimal places) style direc- which entries and (when there are multiple files) which files tive are affected by a directive scope As you can see, directives vary in which journal entries and files they affect, and whether they are focussed on input (parsing) or output (re- ports). Some directives have multiple effects. Directives and multiple files If you use multiple -f/--file options, or the include directive, hledger will process multiple input files. But note that directives which affect input (see above) typically last only until the end of the file in which they occur. This may seem inconvenient, but it's intentional; it makes reports sta- ble and deterministic, independent of the order of input. Otherwise you could see different numbers if you happened to write -f options in a different order, or if you moved includes around while cleaning up your files. It can be surprising though; for example, it means that alias direc- tives do not affect parent or sibling files (see below). Comment blocks A line containing just comment starts a commented region of the file, and a line containing just end comment (or the end of the current file) ends it. See also comments. Including other files You can pull in the content of additional files by writing an include directive, like this: include FILEPATH Only journal files can include, and only journal, timeclock or timedot files can be included (not CSV files, currently). If the file path does not begin with a slash, it is relative to the current file's folder. A tilde means home directory, eg: include ~/main.journal. The path may contain glob patterns to match multiple files, eg: include *.journal. There is limited support for recursive wildcards: **/ (the slash is re- quired) matches 0 or more subdirectories. It's not super convenient since you have to avoid include cycles and including directories, but this can be done, eg: include */**/*.journal. The path may also be prefixed to force a specific file format, overrid- ing the file extension (as described in hledger.1 -> Input files): in- clude timedot:~/notes/2020*.md. Default year You can set a default year to be used for subsequent dates which don't specify a year. This is a line beginning with Y followed by the year. Eg: Y2009 ; set default year to 2009 12/15 ; equivalent to 2009/12/15 expenses 1 assets Y2010 ; change default year to 2010 2009/1/30 ; specifies the year, not affected expenses 1 assets 1/31 ; equivalent to 2010/1/31 expenses 1 assets Declaring commodities The commodity directive has several functions: 1. It declares commodities which may be used in the journal. This is currently not enforced, but can serve as documentation. 2. It declares what decimal mark character (period or comma) to expect when parsing input - useful to disambiguate international number formats in your data. (Without this, hledger will parse both 1,000 and 1.000 as 1). 3. It declares the amount display style to use in output - decimal and digit group marks, number of decimal places, symbol placement etc. You are likely to run into one of the problems solved by commodity di- rectives, sooner or later, so it's a good idea to just always use them to declare your commodities. A commodity directive is just the word commodity followed by an amount. It may be written on a single line, like this: ; commodity EXAMPLEAMOUNT ; display AAAA amounts with the symbol on the right, space-separated, ; using period as decimal point, with four decimal places, and ; separating thousands with comma. commodity 1,000.0000 AAAA or on multiple lines, using the "format" subdirective. (In this case the commodity symbol appears twice and should be the same in both places.): ; commodity SYMBOL ; format EXAMPLEAMOUNT ; display indian rupees with currency name on the left, ; thousands, lakhs and crores comma-separated, ; period as decimal point, and two decimal places. commodity INR format INR 1,00,00,000.00 The quantity of the amount does not matter; only the format is signifi- cant. The number must include a decimal mark: either a period or a comma, followed by 0 or more decimal digits. Note hledger normally uses banker's rounding, so 0.5 displayed with zero decimal digits is "0". (More at Amount display style.) Default commodity The D directive sets a default commodity, to be used for amounts with- out a commodity symbol (ie, plain numbers). This commodity will be ap- plied to all subsequent commodity-less amounts, or until the next D di- rective. (Note, this is different from Ledger's D.) For compatibility/historical reasons, D also acts like a commodity di- rective, setting the commodity's display style (for output) and decimal mark (for parsing input). As with commodity, the amount must always be written with a decimal mark (period or comma). If both directives are used, commodity's style takes precedence. The syntax is D AMOUNT. Eg: ; commodity-less amounts should be treated as dollars ; (and displayed with the dollar sign on the left, thousands separators and two decimal places) D $1,000.00 1/1 a 5 ; <- commodity-less amount, parsed as $5 and displayed as $5.00 b Declaring market prices The P directive declares a market price, which is an exchange rate be- tween two commodities on a certain date. (In Ledger, they are called "historical prices".) These are often obtained from a stock exchange, cryptocurrency exchange, or the foreign exchange market. Here is the format: P DATE COMMODITYA COMMODITYBAMOUNT o DATE is a simple date o COMMODITYA is the symbol of the commodity being priced o COMMODITYBAMOUNT is an amount (symbol and quantity) in a second com- modity, giving the price in commodity B of one unit of commodity A. These two market price directives say that one euro was worth 1.35 US dollars during 2009, and $1.40 from 2010 onward: P 2009/1/1 EUR $1.35 P 2010/1/1 EUR $1.40 The -V, -X and --value flags use these market prices to show amount values in another commodity. See Valuation. Declaring accounts account directives can be used to pre-declare accounts. Though not re- quired, they can provide several benefits: o They can document your intended chart of accounts, providing a refer- ence. o They can store extra information about accounts (account numbers, notes, etc.) o They can help hledger know your accounts' types (asset, liability, equity, revenue, expense), useful for reports like balancesheet and incomestatement. o They control account display order in reports, allowing non-alpha- betic sorting (eg Revenues to appear above Expenses). o They help with account name completion in the add command, hledger- iadd, hledger-web, ledger-mode etc. The simplest form is just the word account followed by a hledger-style account name, eg: account assets:bank:checking Account comments Comments, beginning with a semicolon, can be added: o on the same line, after two or more spaces (because ; is allowed in account names) o on the next lines, indented An example of both: account assets:bank:checking ; same-line comment, note 2+ spaces before ; ; next-line comment ; another with tag, acctno:12345 (not used yet) Same-line comments are not supported by Ledger, or hledger <1.13. Account subdirectives We also allow (and ignore) Ledger-style indented subdirectives, just for compatibility.: account assets:bank:checking format blah blah ; <- subdirective, ignored Here is the full syntax of account directives: account ACCTNAME [ACCTTYPE] [;COMMENT] [;COMMENTS] [LEDGER-STYLE SUBDIRECTIVES, IGNORED] Account types hledger recognises five main types of account, corresponding to the ac- count classes in the accounting equation: Asset, Liability, Equity, Revenue, Expense. These account types are important for controlling which accounts appear in the balancesheet, balancesheetequity, incomestatement reports (and probably for other things in future). Additionally, we recognise the Cash type, which is also an Asset, and which causes accounts to appear in the cashflow report. ("Cash" here means liquid assets, eg bank balances but typically not investments or receivables.) Declaring account types Generally, to make these reports work you should declare your top-level accounts and their types, using account directives with type: tags. The tag's value should be one of: Asset, Liability, Equity, Revenue, Expense, Cash, A, L, E, R, X, C (all case insensitive). The type is inherited by all subaccounts except where they override it. Here's a complete example: account assets ; type: Asset account assets:bank ; type: Cash account assets:cash ; type: Cash account liabilities ; type: Liability account equity ; type: Equity account revenues ; type: Revenue account expenses ; type: Expense Auto-detected account types If you happen to use common english top-level account names, you may not need to declare account types, as they will be detected automati- cally using the following rules: If name matches regular account type is: expression: ---------------------------------------------- ^assets?(:|$) Asset ^(debts?|lia- Liability bilit(y|ies))(:|$) ^equity(:|$) Equity ^(income|revenue)s?(:|$) Revenue ^expenses?(:|$) Expense If account type is Asset and name does not contain regu- account type lar expression: is: -------------------------------------------------------------------------- (investment|receivable|:A/R|:fixed) Cash Even so, explicit declarations may be a good idea, for clarity and pre- dictability. Interference from auto-detected account types If you assign any account type, it's a good idea to assign all of them, to prevent any confusion from mixing declared and auto-detected types. Although it's unlikely to happen in real life, here's an example: with the following journal, balancesheetequity shows "liabilities" in both Liabilities and Equity sections. Declaring another account as type:Li- ability would fix it: account liabilities ; type:Equity 2020-01-01 assets 1 liabilities 1 equity -2 Old account type syntax In some hledger journals you might instead see this old syntax (the letters ALERX, separated from the account name by two or more spaces); this is deprecated and may be removed soon: account assets A account liabilities L account equity E account revenues R account expenses X Account display order Account directives also set the order in which accounts are displayed, eg in reports, the hledger-ui accounts screen, and the hledger-web sidebar. By default accounts are listed in alphabetical order. But if you have these account directives in the journal: account assets account liabilities account equity account revenues account expenses you'll see those accounts displayed in declaration order, not alphabet- ically: $ hledger accounts -1 assets liabilities equity revenues expenses Undeclared accounts, if any, are displayed last, in alphabetical order. Note that sorting is done at each level of the account tree (within each group of sibling accounts under the same parent). And currently, this directive: account other:zoo would influence the position of zoo among other's subaccounts, but not the position of other among the top-level accounts. This means: o you will sometimes declare parent accounts (eg account other above) that you don't intend to post to, just to customize their display or- der o sibling accounts stay together (you couldn't display x:y in between a:b and a:c). Rewriting accounts You can define account alias rules which rewrite your account names, or parts of them, before generating reports. This can be useful for: o expanding shorthand account names to their full form, allowing easier data entry and a less verbose journal o adapting old journals to your current chart of accounts o experimenting with new account organisations, like a new hierarchy or combining two accounts into one o customising reports Account aliases also rewrite account names in account directives. They do not affect account names being entered via hledger add or hledger- web. See also Rewrite account names. Basic aliases To set an account alias, use the alias directive in your journal file. This affects all subsequent journal entries in the current file or its included files. The spaces around the = are optional: alias OLD = NEW Or, you can use the --alias 'OLD=NEW' option on the command line. This affects all entries. It's useful for trying out aliases interactively. OLD and NEW are case sensitive full account names. hledger will re- place any occurrence of the old account name with the new one. Subac- counts are also affected. Eg: alias checking = assets:bank:wells fargo:checking ; rewrites "checking" to "assets:bank:wells fargo:checking", or "checking:a" to "assets:bank:wells fargo:checking:a" Regex aliases There is also a more powerful variant that uses a regular expression, indicated by the forward slashes: alias /REGEX/ = REPLACEMENT or --alias '/REGEX/=REPLACEMENT'. REGEX is a case-insensitive regular expression. Anywhere it matches inside an account name, the matched part will be replaced by REPLACE- MENT. If REGEX contains parenthesised match groups, these can be ref- erenced by the usual numeric backreferences in REPLACEMENT. Eg: alias /^(.+):bank:([^:]+):(.*)/ = \1:\2 \3 ; rewrites "assets:bank:wells fargo:checking" to "assets:wells fargo checking" Also note that REPLACEMENT continues to the end of line (or on command line, to end of option argument), so it can contain trailing white- space. Combining aliases You can define as many aliases as you like, using journal directives and/or command line options. Recursive aliases - where an account name is rewritten by one alias, then by another alias, and so on - are allowed. Each alias sees the effect of previously applied aliases. In such cases it can be important to understand which aliases will be applied and in which order. For (each account name in) each journal entry, we apply: 1. alias directives preceding the journal entry, most recently parsed first (ie, reading upward from the journal entry, bottom to top) 2. --alias options, in the order they appeared on the command line (left to right). In other words, for (an account name in) a given journal entry: o the nearest alias declaration before/above the entry is applied first o the next alias before/above that will be be applied next, and so on o aliases defined after/below the entry do not affect it. This gives nearby aliases precedence over distant ones, and helps pro- vide semantic stability - aliases will keep working the same way inde- pendent of which files are being read and in which order. In case of trouble, adding --debug=6 to the command line will show which aliases are being applied when. Aliases and multiple files As explained at Directives and multiple files, alias directives do not affect parent or sibling files. Eg in this command, hledger -f a.aliases -f b.journal account aliases defined in a.aliases will not affect b.journal. In- cluding the aliases doesn't work either: include a.aliases 2020-01-01 ; not affected by a.aliases foo 1 bar This means that account aliases should usually be declared at the start of your top-most file, like this: alias foo=Foo alias bar=Bar 2020-01-01 ; affected by aliases above foo 1 bar include c.journal ; also affected end aliases You can clear (forget) all currently defined aliases with the end aliases directive: end aliases Default parent account You can specify a parent account which will be prepended to all ac- counts within a section of the journal. Use the apply account and end apply account directives like so: apply account home 2010/1/1 food $10 cash end apply account which is equivalent to: 2010/01/01 home:food $10 home:cash $-10 If end apply account is omitted, the effect lasts to the end of the file. Included files are also affected, eg: apply account business include biz.journal end apply account apply account personal include personal.journal Prior to hledger 1.0, legacy account and end spellings were also sup- ported. A default parent account also affects account directives. It does not affect account names being entered via hledger add or hledger-web. If account aliases are present, they are applied after the default parent account. Periodic transactions Periodic transaction rules describe transactions that recur. They al- low hledger to generate temporary future transactions to help with forecasting, so you don't have to write out each one in the journal, and it's easy to try out different forecasts. Secondly, they are also used to define the budgets shown in budget reports. Periodic transactions can be a little tricky, so before you use them, read this whole section - or at least these tips: 1. Two spaces accidentally added or omitted will cause you trouble - read about this below. 2. For troubleshooting, show the generated transactions with hledger print --forecast tag:generated or hledger register --forecast tag:generated. 3. Forecasted transactions will begin only after the last non-fore- casted transaction's date. 4. Forecasted transactions will end 6 months from today, by default. See below for the exact start/end rules. 5. period expressions can be tricky. Their documentation needs im- provement, but is worth studying. 6. Some period expressions with a repeating interval must begin on a natural boundary of that interval. Eg in weekly from DATE, DATE must be a monday. ~ weekly from 2019/10/1 (a tuesday) will give an error. 7. Other period expressions with an interval are automatically expanded to cover a whole number of that interval. (This is done to improve reports, but it also affects periodic transactions. Yes, it's a bit inconsistent with the above.) Eg: ~ every 10th day of month from 2020/01, which is equivalent to ~ every 10th day of month from 2020/01/01, will be adjusted to start on 2019/12/10. Periodic rule syntax A periodic transaction rule looks like a normal journal entry, with the date replaced by a tilde (~) followed by a period expression (mnemonic: ~ looks like a recurring sine wave.): ~ monthly expenses:rent $2000 assets:bank:checking There is an additional constraint on the period expression: the start date must fall on a natural boundary of the interval. Eg monthly from 2018/1/1 is valid, but monthly from 2018/1/15 is not. Partial or relative dates (M/D, D, tomorrow, last week) in the period expression can work (useful or not). They will be relative to today's date, unless a Y default year directive is in effect, in which case they will be relative to Y/1/1. Two spaces between period expression and description! If the period expression is followed by a transaction description, these must be separated by two or more spaces. This helps hledger know where the period expression ends, so that descriptions can not acciden- tally alter their meaning, as in this example: ; 2 or more spaces needed here, so the period is not understood as "every 2 months in 2020" ; || ; vv ~ every 2 months in 2020, we will review assets:bank:checking $1500 income:acme inc So, o Do write two spaces between your period expression and your transac- tion description, if any. o Don't accidentally write two spaces in the middle of your period ex- pression. Forecasting with periodic transactions The --forecast flag activates any periodic transaction rules in the journal. They will generate temporary recurring transactions, which are not saved in the journal, but will appear in all reports (eg print). This can be useful for estimating balances into the future, or experimenting with different scenarios. Or, it can be used as a data entry aid: describe recurring transactions, and every so often copy the output of print --forecast into the journal. These transactions will have an extra tag indicating which periodic rule generated them: generated-transaction:~ PERIODICEXPR. And a simi- lar, hidden tag (beginning with an underscore) which, because it's never displayed by print, can be used to match transactions generated "just now": _generated-transaction:~ PERIODICEXPR. Periodic transactions are generated within some forecast period. By default, this o begins on the later of o the report start date if specified with -b/-p/date: o the day after the latest normal (non-periodic) transaction in the journal, or today if there are no normal transactions. o ends on the report end date if specified with -e/-p/date:, or 6 months (180 days) from today. This means that periodic transactions will begin only after the latest recorded transaction. And a recorded transaction dated in the future can prevent generation of periodic transactions. (You can avoid that by writing the future transaction as a one-time periodic rule instead - put tilde before the date, eg ~ YYYY-MM-DD ...). Or, you can set your own arbitrary "forecast period", which can overlap recorded transactions, and need not be in the future, by providing an option argument, like --forecast=PERIODEXPR. Note the equals sign is required, a space won't work. PERIODEXPR is a period expression, which can specify the start date, end date, or both, like in a date: query. (See also hledger.1 -> Report start & end date). Some examples: --forecast=202001-202004, --forecast=jan-, --forecast=2020. Budgeting with periodic transactions With the --budget flag, currently supported by the balance command, each periodic transaction rule declares recurring budget goals for the specified accounts. Eg the first example above declares a goal of spending $2000 on rent (and also, a goal of depositing $2000 into checking) every month. Goals and actual performance can then be com- pared in budget reports. For more details, see: balance: Budget report and Budgeting and Fore- casting. Auto postings "Automated postings" or "auto postings" are extra postings which get added automatically to transactions which match certain queries, de- fined by "auto posting rules", when you use the --auto flag. An auto posting rule looks a bit like a transaction: = QUERY ACCOUNT AMOUNT ... ACCOUNT [AMOUNT] except the first line is an equals sign (mnemonic: = suggests match- ing), followed by a query (which matches existing postings), and each "posting" line describes a posting to be generated, and the posting amounts can be: o a normal amount with a commodity symbol, eg $2. This will be used as-is. o a number, eg 2. The commodity symbol (if any) from the matched post- ing will be added to this. o a numeric multiplier, eg *2 (a star followed by a number N). The matched posting's amount (and total price, if any) will be multiplied by N. o a multiplier with a commodity symbol, eg *$2 (a star, number N, and symbol S). The matched posting's amount will be multiplied by N, and its commodity symbol will be replaced with S. Any query term containing spaces must be enclosed in single or double quotes, as on the command line. Eg, note the quotes around the second query term below: = expenses:groceries 'expenses:dining out' (budget:funds:dining out) *-1 Some examples: ; every time I buy food, schedule a dollar donation = expenses:food (liabilities:charity) $-1 ; when I buy a gift, also deduct that amount from a budget envelope subaccount = expenses:gifts assets:checking:gifts *-1 assets:checking *1 2017/12/1 expenses:food $10 assets:checking 2017/12/14 expenses:gifts $20 assets:checking $ hledger print --auto 2017-12-01 expenses:food $10 assets:checking (liabilities:charity) $-1 2017-12-14 expenses:gifts $20 assets:checking assets:checking:gifts -$20 assets:checking $20 Auto postings and multiple files An auto posting rule can affect any transaction in the current file, or in any parent file or child file. Note, currently it will not affect sibling files (when multiple -f/--file are used - see #1212). Auto postings and dates A posting date (or secondary date) in the matched posting, or (taking precedence) a posting date in the auto posting rule itself, will also be used in the generated posting. Auto postings and transaction balancing / inferred amounts / balance asser- tions Currently, auto postings are added: o after missing amounts are inferred, and transactions are checked for balancedness, o but before balance assertions are checked. Note this means that journal entries must be balanced both before and after auto postings are added. This changed in hledger 1.12+; see #893 for background. Auto posting tags Automated postings will have some extra tags: o generated-posting:= QUERY - shows this was generated by an auto post- ing rule, and the query o _generated-posting:= QUERY - a hidden tag, which does not appear in hledger's output. This can be used to match postings generated "just now", rather than generated in the past and saved to the journal. Also, any transaction that has been changed by auto posting rules will have these tags added: o modified: - this transaction was modified o _modified: - a hidden tag not appearing in the comment; this transac- tion was modified "just now". REPORTING BUGS Report bugs at http://bugs.hledger.org (or on the #hledger IRC channel or hledger mail list) AUTHORS Simon Michael and contributors COPYRIGHT Copyright (C) 2007-2019 Simon Michael. Released under GNU GPL v3 or later. SEE ALSO hledger(1), hledger-ui(1), hledger-web(1), hledger-api(1), hledger_csv(5), hledger_journal(5), hledger_timeclock(5), hledger_time- dot(5), ledger(1) http://hledger.org hledger 1.18.99 September 2020 hledger_journal(5) hledger-lib-1.19.1/hledger_journal.info0000644000000000000000000021617613725533425016216 0ustar0000000000000000This is hledger_journal.info, produced by makeinfo version 6.7 from stdin.  File: hledger_journal.info, Node: Top, Up: (dir) hledger_journal(5) hledger 1.18.99 ********************************** Journal - hledger's default file format, representing a General Journal hledger's usual data source is a plain text file containing journal entries in hledger journal format. This file represents a standard accounting general journal. I use file names ending in '.journal', but that's not required. The journal file contains a number of transaction entries, each describing a transfer of money (or any commodity) between two or more named accounts, in a simple format readable by both hledger and humans. hledger's journal format is a compatible subset, mostly, of ledger's journal format, so hledger can work with compatible ledger journal files as well. It's safe, and encouraged, to run both hledger and ledger on the same journal file, eg to validate the results you're getting. You can use hledger without learning any more about this file; just use the add or web or import commands to create and update it. Many users, though, edit the journal file with a text editor, and track changes with a version control system such as git. Editor addons such as ledger-mode or hledger-mode for Emacs, vim-ledger for Vim, and hledger-vscode for Visual Studio Code, make this easier, adding colour, formatting, tab completion, and useful commands. See Editor configuration at hledger.org for the full list. Here's a description of each part of the file format (and hledger's data model). These are mostly in the order you'll use them, but in some cases related concepts have been grouped together for easy reference, or linked before they are introduced, so feel free to skip over anything that looks unnecessary right now. * Menu: * Transactions::  File: hledger_journal.info, Node: Transactions, Up: Top 1 Transactions ************** Transactions are the main unit of information in a journal file. They represent events, typically a movement of some quantity of commodities between two or more named accounts. Each transaction is recorded as a journal entry, beginning with a simple date in column 0. This can be followed by any of the following optional fields, separated by spaces: * a status character (empty, '!', or '*') * a code (any short number or text, enclosed in parentheses) * a description (any remaining text until end of line or a semicolon) * a comment (any remaining text following a semicolon until end of line, and any following indented lines beginning with a semicolon) * 0 or more indented _posting_ lines, describing what was transferred and the accounts involved (indented comment lines are also allowed, but not blank lines or non-indented lines). Here's a simple journal file containing one transaction: 2008/01/01 income assets:bank:checking $1 income:salary $-1 * Menu: * Dates:: * Status:: * Description:: * Comments:: * Tags:: * Postings:: * Account names:: * Amounts:: * Transaction prices:: * Lot prices and lot dates:: * Balance assertions:: * Balance assignments:: * Directives:: * Periodic transactions:: * Auto postings::  File: hledger_journal.info, Node: Dates, Next: Status, Up: Transactions 1.1 Dates ========= * Menu: * Simple dates:: * Secondary dates:: * Posting dates::  File: hledger_journal.info, Node: Simple dates, Next: Secondary dates, Up: Dates 1.1.1 Simple dates ------------------ Dates in the journal file use _simple dates_ format: 'YYYY-MM-DD' or 'YYYY/MM/DD' or 'YYYY.MM.DD', with leading zeros optional. The year may be omitted, in which case it will be inferred from the context: the current transaction, the default year set with a default year directive, or the current date when the command is run. Some examples: '2010-01-31', '2010/01/31', '2010.1.31', '1/31'. (The UI also accepts simple dates, as well as the more flexible smart dates documented in the hledger manual.)  File: hledger_journal.info, Node: Secondary dates, Next: Posting dates, Prev: Simple dates, Up: Dates 1.1.2 Secondary dates --------------------- Real-life transactions sometimes involve more than one date - eg the date you write a cheque, and the date it clears in your bank. When you want to model this, for more accurate daily balances, you can specify individual posting dates. Or, you can use the older _secondary date_ feature (Ledger calls it auxiliary date or effective date). Note: we support this for compatibility, but I usually recommend avoiding this feature; posting dates are almost always clearer and simpler. A secondary date is written after the primary date, following an equals sign. If the year is omitted, the primary date's year is assumed. When running reports, the primary (left) date is used by default, but with the '--date2' flag (or '--aux-date' or '--effective'), the secondary (right) date will be used instead. The meaning of secondary dates is up to you, but it's best to follow a consistent rule. Eg "primary = the bank's clearing date, secondary = date the transaction was initiated, if different", as shown here: 2010/2/23=2/19 movie ticket expenses:cinema $10 assets:checking $ hledger register checking 2010-02-23 movie ticket assets:checking $-10 $-10 $ hledger register checking --date2 2010-02-19 movie ticket assets:checking $-10 $-10  File: hledger_journal.info, Node: Posting dates, Prev: Secondary dates, Up: Dates 1.1.3 Posting dates ------------------- You can give individual postings a different date from their parent transaction, by adding a posting comment containing a tag (see below) like 'date:DATE'. This is probably the best way to control posting dates precisely. Eg in this example the expense should appear in May reports, and the deduction from checking should be reported on 6/1 for easy bank reconciliation: 2015/5/30 expenses:food $10 ; food purchased on saturday 5/30 assets:checking ; bank cleared it on monday, date:6/1 $ hledger -f t.j register food 2015-05-30 expenses:food $10 $10 $ hledger -f t.j register checking 2015-06-01 assets:checking $-10 $-10 DATE should be a simple date; if the year is not specified it will use the year of the transaction's date. You can set the secondary date similarly, with 'date2:DATE2'. The 'date:' or 'date2:' tags must have a valid simple date value if they are present, eg a 'date:' tag with no value is not allowed. Ledger's earlier, more compact bracketed date syntax is also supported: '[DATE]', '[DATE=DATE2]' or '[=DATE2]'. hledger will attempt to parse any square-bracketed sequence of the '0123456789/-.=' characters in this way. With this syntax, DATE infers its year from the transaction and DATE2 infers its year from DATE.  File: hledger_journal.info, Node: Status, Next: Description, Prev: Dates, Up: Transactions 1.2 Status ========== Transactions, or individual postings within a transaction, can have a status mark, which is a single character before the transaction description or posting account name, separated from it by a space, indicating one of three statuses: mark status ----------------- unmarked '!' pending '*' cleared When reporting, you can filter by status with the '-U/--unmarked', '-P/--pending', and '-C/--cleared' flags; or the 'status:', 'status:!', and 'status:*' queries; or the U, P, C keys in hledger-ui. Note, in Ledger and in older versions of hledger, the "unmarked" state is called "uncleared". As of hledger 1.3 we have renamed it to unmarked for clarity. To replicate Ledger and old hledger's behaviour of also matching pending, combine -U and -P. Status marks are optional, but can be helpful eg for reconciling with real-world accounts. Some editor modes provide highlighting and shortcuts for working with status. Eg in Emacs ledger-mode, you can toggle transaction status with C-c C-e, or posting status with C-c C-c. What "uncleared", "pending", and "cleared" actually mean is up to you. Here's one suggestion: status meaning -------------------------------------------------------------------------- uncleared recorded but not yet reconciled; needs review pending tentatively reconciled (if needed, eg during a big reconciliation) cleared complete, reconciled as far as possible, and considered correct With this scheme, you would use '-PC' to see the current balance at your bank, '-U' to see things which will probably hit your bank soon (like uncashed checks), and no flags to see the most up-to-date state of your finances.  File: hledger_journal.info, Node: Description, Next: Comments, Prev: Status, Up: Transactions 1.3 Description =============== A transaction's description is the rest of the line following the date and status mark (or until a comment begins). Sometimes called the "narration" in traditional bookkeeping, it can be used for whatever you wish, or left blank. Transaction descriptions can be queried, unlike comments. * Menu: * Payee and note::  File: hledger_journal.info, Node: Payee and note, Up: Description 1.3.1 Payee and note -------------------- You can optionally include a '|' (pipe) character in descriptions to subdivide the description into separate fields for payee/payer name on the left (up to the first '|') and an additional note field on the right (after the first '|'). This may be worthwhile if you need to do more precise querying and pivoting by payee or by note.  File: hledger_journal.info, Node: Comments, Next: Tags, Prev: Description, Up: Transactions 1.4 Comments ============ Lines in the journal beginning with a semicolon (';') or hash ('#') or star ('*') are comments, and will be ignored. (Star comments cause org-mode nodes to be ignored, allowing emacs users to fold and navigate their journals with org-mode or orgstruct-mode.) You can attach comments to a transaction by writing them after the description and/or indented on the following lines (before the postings). Similarly, you can attach comments to an individual posting by writing them after the amount and/or indented on the following lines. Transaction and posting comments must begin with a semicolon (';'). Some examples: # a file comment ; another file comment * also a file comment, useful in org/orgstruct mode comment A multiline file comment, which continues until a line containing just "end comment" (or end of file). end comment 2012/5/14 something ; a transaction comment ; the transaction comment, continued posting1 1 ; a comment for posting 1 posting2 ; a comment for posting 2 ; another comment line for posting 2 ; a file comment (because not indented) You can also comment larger regions of a file using 'comment' and 'end comment' directives.  File: hledger_journal.info, Node: Tags, Next: Postings, Prev: Comments, Up: Transactions 1.5 Tags ======== Tags are a way to add extra labels or labelled data to postings and transactions, which you can then search or pivot on. A simple tag is a word (which may contain hyphens) followed by a full colon, written inside a transaction or posting comment line: 2017/1/16 bought groceries ; sometag: Tags can have a value, which is the text after the colon, up to the next comma or end of line, with leading/trailing whitespace removed: expenses:food $10 ; a-posting-tag: the tag value Note this means hledger's tag values can not contain commas or newlines. Ending at commas means you can write multiple short tags on one line, comma separated: assets:checking ; a comment containing tag1:, tag2: some value ... Here, * "'a comment containing'" is just comment text, not a tag * "'tag1'" is a tag with no value * "'tag2'" is another tag, whose value is "'some value ...'" Tags in a transaction comment affect the transaction and all of its postings, while tags in a posting comment affect only that posting. For example, the following transaction has three tags ('A', 'TAG2', 'third-tag') and the posting has four (those plus 'posting-tag'): 1/1 a transaction ; A:, TAG2: ; third-tag: a third transaction tag, <- with a value (a) $1 ; posting-tag: Tags are like Ledger's metadata feature, except hledger's tag values are simple strings.  File: hledger_journal.info, Node: Postings, Next: Account names, Prev: Tags, Up: Transactions 1.6 Postings ============ A posting is an addition of some amount to, or removal of some amount from, an account. Each posting line begins with at least one space or tab (2 or 4 spaces is common), followed by: * (optional) a status character (empty, '!', or '*'), followed by a space * (required) an account name (any text, optionally containing *single spaces*, until end of line or a double space) * (optional) *two or more spaces* or tabs followed by an amount. Positive amounts are being added to the account, negative amounts are being removed. The amounts within a transaction must always sum up to zero. As a convenience, one amount may be left blank; it will be inferred so as to balance the transaction. Be sure to note the unusual two-space delimiter between account name and amount. This makes it easy to write account names containing spaces. But if you accidentally leave only one space (or tab) before the amount, the amount will be considered part of the account name. * Menu: * Virtual postings::  File: hledger_journal.info, Node: Virtual postings, Up: Postings 1.6.1 Virtual postings ---------------------- A posting with a parenthesised account name is called a _virtual posting_ or _unbalanced posting_, which means it is exempt from the usual rule that a transaction's postings must balance add up to zero. This is not part of double entry accounting, so you might choose to avoid this feature. Or you can use it sparingly for certain special cases where it can be convenient. Eg, you could set opening balances without using a balancing equity account: 1/1 opening balances (assets:checking) $1000 (assets:savings) $2000 A posting with a bracketed account name is called a _balanced virtual posting_. The balanced virtual postings in a transaction must add up to zero (separately from other postings). Eg: 1/1 buy food with cash, update budget envelope subaccounts, & something else assets:cash $-10 ; <- these balance expenses:food $7 ; <- expenses:food $3 ; <- [assets:checking:budget:food] $-10 ; <- and these balance [assets:checking:available] $10 ; <- (something:else) $5 ; <- not required to balance Ordinary non-parenthesised, non-bracketed postings are called _real postings_. You can exclude virtual postings from reports with the '-R/--real' flag or 'real:1' query.  File: hledger_journal.info, Node: Account names, Next: Amounts, Prev: Postings, Up: Transactions 1.7 Account names ================= Account names typically have several parts separated by a full colon, from which hledger derives a hierarchical chart of accounts. They can be anything you like, but in finance there are traditionally five top-level accounts: 'assets', 'liabilities', 'income', 'expenses', and 'equity'. Account names may contain single spaces, eg: 'assets:accounts receivable'. Because of this, they must always be followed by *two or more spaces* (or newline). Account names can be aliased.  File: hledger_journal.info, Node: Amounts, Next: Transaction prices, Prev: Account names, Up: Transactions 1.8 Amounts =========== After the account name, there is usually an amount. (Important: between account name and amount, there must be *two or more spaces*.) hledger's amount format is flexible, supporting several international formats. Here are some examples. Amounts have a number (the "quantity"): 1 ..and usually a currency or commodity name (the "commodity"). This is a symbol, word, or phrase, to the left or right of the quantity, with or without a separating space: $1 4000 AAPL If the commodity name contains spaces, numbers, or punctuation, it must be enclosed in double quotes: 3 "no. 42 green apples" Amounts can be preceded by a minus sign (or a plus sign, though plus is the default), The sign can be written before or after a left-side commodity symbol: -$1 $-1 One or more spaces between the sign and the number are acceptable when parsing (but they won't be displayed in output): + $1 $- 1 Scientific E notation is allowed: 1E-6 EUR 1E3 A decimal mark can be written as a period or a comma: 1.23 1,23456780000009 * Menu: * Digit group marks:: * Amount display style::  File: hledger_journal.info, Node: Digit group marks, Next: Amount display style, Up: Amounts 1.8.1 Digit group marks ----------------------- In the integer part of the quantity (left of the decimal mark), groups of digits can optionally be separated by a "digit group mark" - a space, comma, or period (different from the decimal mark): $1,000,000.00 EUR 2.000.000,00 INR 9,99,99,999.00 1 000 000.9455 Note, a number containing a single group mark and no decimal mark is ambiguous. Are these group marks or decimal marks ? 1,000 1.000 hledger will treat them both as decimal marks by default (cf #793). If you use digit group marks, to prevent confusion and undetected typos we recommend you write commodity directives at the top of the file to explicitly declare the decimal mark (and optionally a digit group mark). Note, these formats ("amount styles") are specific to each commodity, so if your data uses multiple formats, hledger can handle it: commodity $1,000.00 commodity EUR 1.000,00 commodity INR 9,99,99,999.00 commodity 1 000 000.9455  File: hledger_journal.info, Node: Amount display style, Prev: Digit group marks, Up: Amounts 1.8.2 Amount display style -------------------------- For each commodity, hledger chooses a consistent format to use when displaying amounts. (Except price amounts, which are always displayed as written). The display style is chosen as follows: * If there is a commodity directive (or default commodity directive) for the commodity, that format is used (see examples above). * Otherwise the format of the first posting amount in that commodity seen in the journal is used. But the number of decimal places ("precision") will be the maximum from all posting amounts in that commodity. * Or if there are no such amounts in the journal, a default format is used (like '$1000.00'). Transaction prices don't affect the amount display style directly, but occasionally they can do so indirectly (eg when an posting's amount is inferred using a transaction price). If you find this causing problems, use a commodity directive to fix the display style. In summary: amounts will be displayed much as they appear in your journal, with the max observed number of decimal places. If you want to see fewer decimal places in reports, use a commodity directive to override that. hledger uses banker's rounding: it rounds to the nearest even number, eg 0.5 displayed with zero decimal places is "0"). (Note, prior to hledger 1.17.1 this could vary if hledger happened to be built with an old version of Decimal (<0.5.1); since 1.17.1 it's guaranteed.)  File: hledger_journal.info, Node: Transaction prices, Next: Lot prices and lot dates, Prev: Amounts, Up: Transactions 1.9 Transaction prices ====================== Within a transaction, you can note an amount's price in another commodity. This can be used to document the cost (in a purchase) or selling price (in a sale). For example, transaction prices are useful to record purchases of a foreign currency. Note transaction prices are fixed at the time of the transaction, and do not change over time. See also market prices, which represent prevailing exchange rates on a certain date. There are several ways to record a transaction price: 1. Write the price per unit, as '@ UNITPRICE' after the amount: 2009/1/1 assets:euros €100 @ $1.35 ; one hundred euros purchased at $1.35 each assets:dollars ; balancing amount is -$135.00 2. Write the total price, as '@@ TOTALPRICE' after the amount: 2009/1/1 assets:euros €100 @@ $135 ; one hundred euros purchased at $135 for the lot assets:dollars 3. Specify amounts for all postings, using exactly two commodities, and let hledger infer the price that balances the transaction: 2009/1/1 assets:euros €100 ; one hundred euros purchased assets:dollars $-135 ; for $135 4. Like 1, but the '@' is parenthesised, i.e. '(@)'; this is for compatibility with Ledger journals (Virtual posting costs), and is equivalent to 1 in hledger. 5. Like 2, but as in 4 the '@@' is parenthesised, i.e. '(@@)'; in hledger, this is equivalent to 2. Use the '-B/--cost' flag to convert amounts to their transaction price's commodity, if any. (mnemonic: "B" is from "cost Basis", as in Ledger). Eg here is how -B affects the balance report for the example above: $ hledger bal -N --flat $-135 assets:dollars €100 assets:euros $ hledger bal -N --flat -B $-135 assets:dollars $135 assets:euros # <- the euros' cost Note -B is sensitive to the order of postings when a transaction price is inferred: the inferred price will be in the commodity of the last amount. So if example 3's postings are reversed, while the transaction is equivalent, -B shows something different: 2009/1/1 assets:dollars $-135 ; 135 dollars sold assets:euros €100 ; for 100 euros $ hledger bal -N --flat -B €-100 assets:dollars # <- the dollars' selling price €100 assets:euros  File: hledger_journal.info, Node: Lot prices and lot dates, Next: Balance assertions, Prev: Transaction prices, Up: Transactions 1.10 Lot prices and lot dates ============================= Ledger allows another kind of price, lot price (four variants: '{UNITPRICE}', '{{TOTALPRICE}}', '{=FIXEDUNITPRICE}', '{{=FIXEDTOTALPRICE}}'), and/or a lot date ('[DATE]') to be specified. These are normally used to select a lot when selling investments. hledger will parse these, for compatibility with Ledger journals, but currently ignores them. A transaction price, lot price and/or lot date may appear in any order, after the posting amount and before the balance assertion if any.  File: hledger_journal.info, Node: Balance assertions, Next: Balance assignments, Prev: Lot prices and lot dates, Up: Transactions 1.11 Balance assertions ======================= hledger supports Ledger-style balance assertions in journal files. These look like, for example, '= EXPECTEDBALANCE' following a posting's amount. Eg here we assert the expected dollar balance in accounts a and b after each posting: 2013/1/1 a $1 =$1 b =$-1 2013/1/2 a $1 =$2 b $-1 =$-2 After reading a journal file, hledger will check all balance assertions and report an error if any of them fail. Balance assertions can protect you from, eg, inadvertently disrupting reconciled balances while cleaning up old entries. You can disable them temporarily with the '-I/--ignore-assertions' flag, which can be useful for troubleshooting or for reading Ledger files. (Note: this flag currently does not disable balance assignments, below). * Menu: * Assertions and ordering:: * Assertions and included files:: * Assertions and multiple -f options:: * Assertions and commodities:: * Assertions and prices:: * Assertions and subaccounts:: * Assertions and virtual postings:: * Assertions and precision::  File: hledger_journal.info, Node: Assertions and ordering, Next: Assertions and included files, Up: Balance assertions 1.11.1 Assertions and ordering ------------------------------ hledger sorts an account's postings and assertions first by date and then (for postings on the same day) by parse order. Note this is different from Ledger, which sorts assertions only by parse order. (Also, Ledger assertions do not see the accumulated effect of repeated postings to the same account within a transaction.) So, hledger balance assertions keep working if you reorder differently-dated transactions within the journal. But if you reorder same-dated transactions or postings, assertions might break and require updating. This order dependence does bring an advantage: precise control over the order of postings and assertions within a day, so you can assert intra-day balances.  File: hledger_journal.info, Node: Assertions and included files, Next: Assertions and multiple -f options, Prev: Assertions and ordering, Up: Balance assertions 1.11.2 Assertions and included files ------------------------------------ With included files, things are a little more complicated. Including preserves the ordering of postings and assertions. If you have multiple postings to an account on the same day, split across different files, and you also want to assert the account's balance on the same day, you'll have to put the assertion in the right file.  File: hledger_journal.info, Node: Assertions and multiple -f options, Next: Assertions and commodities, Prev: Assertions and included files, Up: Balance assertions 1.11.3 Assertions and multiple -f options ----------------------------------------- Balance assertions don't work well across files specified with multiple -f options. Use include or concatenate the files instead.  File: hledger_journal.info, Node: Assertions and commodities, Next: Assertions and prices, Prev: Assertions and multiple -f options, Up: Balance assertions 1.11.4 Assertions and commodities --------------------------------- The asserted balance must be a simple single-commodity amount, and in fact the assertion checks only this commodity's balance within the (possibly multi-commodity) account balance. This is how assertions work in Ledger also. We could call this a "partial" balance assertion. To assert the balance of more than one commodity in an account, you can write multiple postings, each asserting one commodity's balance. You can make a stronger "total" balance assertion by writing a double equals sign ('== EXPECTEDBALANCE'). This asserts that there are no other unasserted commodities in the account (or, that their balance is 0). 2013/1/1 a $1 a 1€ b $-1 c -1€ 2013/1/2 ; These assertions succeed a 0 = $1 a 0 = 1€ b 0 == $-1 c 0 == -1€ 2013/1/3 ; This assertion fails as 'a' also contains 1€ a 0 == $1 It's not yet possible to make a complete assertion about a balance that has multiple commodities. One workaround is to isolate each commodity into its own subaccount: 2013/1/1 a:usd $1 a:euro 1€ b 2013/1/2 a 0 == 0 a:usd 0 == $1 a:euro 0 == 1€  File: hledger_journal.info, Node: Assertions and prices, Next: Assertions and subaccounts, Prev: Assertions and commodities, Up: Balance assertions 1.11.5 Assertions and prices ---------------------------- Balance assertions ignore transaction prices, and should normally be written without one: 2019/1/1 (a) $1 @ €1 = $1 We do allow prices to be written there, however, and print shows them, even though they don't affect whether the assertion passes or fails. This is for backward compatibility (hledger's close command used to generate balance assertions with prices), and because balance _assignments_ do use them (see below).  File: hledger_journal.info, Node: Assertions and subaccounts, Next: Assertions and virtual postings, Prev: Assertions and prices, Up: Balance assertions 1.11.6 Assertions and subaccounts --------------------------------- The balance assertions above ('=' and '==') do not count the balance from subaccounts; they check the account's exclusive balance only. You can assert the balance including subaccounts by writing '=*' or '==*', eg: 2019/1/1 equity:opening balances checking:a 5 checking:b 5 checking 1 ==* 11  File: hledger_journal.info, Node: Assertions and virtual postings, Next: Assertions and precision, Prev: Assertions and subaccounts, Up: Balance assertions 1.11.7 Assertions and virtual postings -------------------------------------- Balance assertions are checked against all postings, both real and virtual. They are not affected by the '--real/-R' flag or 'real:' query.  File: hledger_journal.info, Node: Assertions and precision, Prev: Assertions and virtual postings, Up: Balance assertions 1.11.8 Assertions and precision ------------------------------- Balance assertions compare the exactly calculated amounts, which are not always what is shown by reports. Eg a commodity directive may limit the display precision, but this will not affect balance assertions. Balance assertion failure messages show exact amounts.  File: hledger_journal.info, Node: Balance assignments, Next: Directives, Prev: Balance assertions, Up: Transactions 1.12 Balance assignments ======================== Ledger-style balance assignments are also supported. These are like balance assertions, but with no posting amount on the left side of the equals sign; instead it is calculated automatically so as to satisfy the assertion. This can be a convenience during data entry, eg when setting opening balances: ; starting a new journal, set asset account balances 2016/1/1 opening balances assets:checking = $409.32 assets:savings = $735.24 assets:cash = $42 equity:opening balances or when adjusting a balance to reality: ; no cash left; update balance, record any untracked spending as a generic expense 2016/1/15 assets:cash = $0 expenses:misc The calculated amount depends on the account's balance in the commodity at that point (which depends on the previously-dated postings of the commodity to that account since the last balance assertion or assignment). Note that using balance assignments makes your journal a little less explicit; to know the exact amount posted, you have to run hledger or do the calculations yourself, instead of just reading it. * Menu: * Balance assignments and prices::  File: hledger_journal.info, Node: Balance assignments and prices, Up: Balance assignments 1.12.1 Balance assignments and prices ------------------------------------- A transaction price in a balance assignment will cause the calculated amount to have that price attached: 2019/1/1 (a) = $1 @ €2 $ hledger print --explicit 2019-01-01 (a) $1 @ €2 = $1 @ €2  File: hledger_journal.info, Node: Directives, Next: Periodic transactions, Prev: Balance assignments, Up: Transactions 1.13 Directives =============== A directive is a line in the journal beginning with a special keyword, that influences how the journal is processed. hledger's directives are based on a subset of Ledger's, but there are many differences (and also some differences between hledger versions). Directives' behaviour and interactions can get a little bit complex, so here is a table summarising the directives and their effects, with links to more detailed docs. directiveend subdirectivespurpose can affect (as of directive 2018/06) ----------------------------------------------------------------------------- 'account' any document account names, all entries in text declare account types & all files, before display order or after 'alias' 'end rewrite account names following aliases' inline/included entries until end of current file or end directive 'apply 'end prepend a common parent to following account' apply account names inline/included account' entries until end of current file or end directive 'comment''end ignore part of journal following comment' inline/included entries until end of current file or end directive 'commodity' 'format'declare a commodity and its number notation: number notation & display following entries style in that commodity in all files; display style: amounts of that commodity in reports 'D' declare a commodity to be default used for commodityless commodity: amounts, and its number following notation & display style commodityless entries until end of current file; number notation: following entries in that commodity until end of current file; display style: amounts of that commodity in reports 'include' include entries/directives what the included from another file directives affect 'P' declare a market price for amounts of that a commodity commodity in reports, when -V is used 'Y' declare a year for yearless following dates inline/included entries until end of current file '=' declare an auto posting all entries in rule, adding postings to parent/current/child other transactions files (but not sibling files, see #1212) And some definitions: subdirectiveoptional indented directive line immediately following a parent directive number how to interpret numbers when parsing journal entries (the notationidentity of the decimal separator character). (Currently each commodity can have its own notation, even in the same file.) displayhow to display amounts of a commodity in reports (symbol side style and spacing, digit groups, decimal separator, decimal places) directivewhich entries and (when there are multiple files) which files scope are affected by a directive As you can see, directives vary in which journal entries and files they affect, and whether they are focussed on input (parsing) or output (reports). Some directives have multiple effects. * Menu: * Directives and multiple files:: * Comment blocks:: * Including other files:: * Default year:: * Declaring commodities:: * Default commodity:: * Declaring market prices:: * Declaring accounts:: * Rewriting accounts:: * Default parent account::  File: hledger_journal.info, Node: Directives and multiple files, Next: Comment blocks, Up: Directives 1.13.1 Directives and multiple files ------------------------------------ If you use multiple '-f'/'--file' options, or the 'include' directive, hledger will process multiple input files. But note that directives which affect input (see above) typically last only until the end of the file in which they occur. This may seem inconvenient, but it's intentional; it makes reports stable and deterministic, independent of the order of input. Otherwise you could see different numbers if you happened to write -f options in a different order, or if you moved includes around while cleaning up your files. It can be surprising though; for example, it means that 'alias' directives do not affect parent or sibling files (see below).  File: hledger_journal.info, Node: Comment blocks, Next: Including other files, Prev: Directives and multiple files, Up: Directives 1.13.2 Comment blocks --------------------- A line containing just 'comment' starts a commented region of the file, and a line containing just 'end comment' (or the end of the current file) ends it. See also comments.  File: hledger_journal.info, Node: Including other files, Next: Default year, Prev: Comment blocks, Up: Directives 1.13.3 Including other files ---------------------------- You can pull in the content of additional files by writing an include directive, like this: include FILEPATH Only journal files can include, and only journal, timeclock or timedot files can be included (not CSV files, currently). If the file path does not begin with a slash, it is relative to the current file's folder. A tilde means home directory, eg: 'include ~/main.journal'. The path may contain glob patterns to match multiple files, eg: 'include *.journal'. There is limited support for recursive wildcards: '**/' (the slash is required) matches 0 or more subdirectories. It's not super convenient since you have to avoid include cycles and including directories, but this can be done, eg: 'include */**/*.journal'. The path may also be prefixed to force a specific file format, overriding the file extension (as described in hledger.1 -> Input files): 'include timedot:~/notes/2020*.md'.  File: hledger_journal.info, Node: Default year, Next: Declaring commodities, Prev: Including other files, Up: Directives 1.13.4 Default year ------------------- You can set a default year to be used for subsequent dates which don't specify a year. This is a line beginning with 'Y' followed by the year. Eg: Y2009 ; set default year to 2009 12/15 ; equivalent to 2009/12/15 expenses 1 assets Y2010 ; change default year to 2010 2009/1/30 ; specifies the year, not affected expenses 1 assets 1/31 ; equivalent to 2010/1/31 expenses 1 assets  File: hledger_journal.info, Node: Declaring commodities, Next: Default commodity, Prev: Default year, Up: Directives 1.13.5 Declaring commodities ---------------------------- The 'commodity' directive has several functions: 1. It declares commodities which may be used in the journal. This is currently not enforced, but can serve as documentation. 2. It declares what decimal mark character (period or comma) to expect when parsing input - useful to disambiguate international number formats in your data. (Without this, hledger will parse both '1,000' and '1.000' as 1). 3. It declares the amount display style to use in output - decimal and digit group marks, number of decimal places, symbol placement etc. You are likely to run into one of the problems solved by commodity directives, sooner or later, so it's a good idea to just always use them to declare your commodities. A commodity directive is just the word 'commodity' followed by an amount. It may be written on a single line, like this: ; commodity EXAMPLEAMOUNT ; display AAAA amounts with the symbol on the right, space-separated, ; using period as decimal point, with four decimal places, and ; separating thousands with comma. commodity 1,000.0000 AAAA or on multiple lines, using the "format" subdirective. (In this case the commodity symbol appears twice and should be the same in both places.): ; commodity SYMBOL ; format EXAMPLEAMOUNT ; display indian rupees with currency name on the left, ; thousands, lakhs and crores comma-separated, ; period as decimal point, and two decimal places. commodity INR format INR 1,00,00,000.00 The quantity of the amount does not matter; only the format is significant. The number must include a decimal mark: either a period or a comma, followed by 0 or more decimal digits. Note hledger normally uses banker's rounding, so 0.5 displayed with zero decimal digits is "0". (More at Amount display style.)  File: hledger_journal.info, Node: Default commodity, Next: Declaring market prices, Prev: Declaring commodities, Up: Directives 1.13.6 Default commodity ------------------------ The 'D' directive sets a default commodity, to be used for amounts without a commodity symbol (ie, plain numbers). This commodity will be applied to all subsequent commodity-less amounts, or until the next 'D' directive. (Note, this is different from Ledger's 'D'.) For compatibility/historical reasons, 'D' also acts like a 'commodity' directive, setting the commodity's display style (for output) and decimal mark (for parsing input). As with 'commodity', the amount must always be written with a decimal mark (period or comma). If both directives are used, 'commodity''s style takes precedence. The syntax is 'D AMOUNT'. Eg: ; commodity-less amounts should be treated as dollars ; (and displayed with the dollar sign on the left, thousands separators and two decimal places) D $1,000.00 1/1 a 5 ; <- commodity-less amount, parsed as $5 and displayed as $5.00 b  File: hledger_journal.info, Node: Declaring market prices, Next: Declaring accounts, Prev: Default commodity, Up: Directives 1.13.7 Declaring market prices ------------------------------ The 'P' directive declares a market price, which is an exchange rate between two commodities on a certain date. (In Ledger, they are called "historical prices".) These are often obtained from a stock exchange, cryptocurrency exchange, or the foreign exchange market. Here is the format: P DATE COMMODITYA COMMODITYBAMOUNT * DATE is a simple date * COMMODITYA is the symbol of the commodity being priced * COMMODITYBAMOUNT is an amount (symbol and quantity) in a second commodity, giving the price in commodity B of one unit of commodity A. These two market price directives say that one euro was worth 1.35 US dollars during 2009, and $1.40 from 2010 onward: P 2009/1/1 € $1.35 P 2010/1/1 € $1.40 The '-V', '-X' and '--value' flags use these market prices to show amount values in another commodity. See Valuation.  File: hledger_journal.info, Node: Declaring accounts, Next: Rewriting accounts, Prev: Declaring market prices, Up: Directives 1.13.8 Declaring accounts ------------------------- 'account' directives can be used to pre-declare accounts. Though not required, they can provide several benefits: * They can document your intended chart of accounts, providing a reference. * They can store extra information about accounts (account numbers, notes, etc.) * They can help hledger know your accounts' types (asset, liability, equity, revenue, expense), useful for reports like balancesheet and incomestatement. * They control account display order in reports, allowing non-alphabetic sorting (eg Revenues to appear above Expenses). * They help with account name completion in the add command, hledger-iadd, hledger-web, ledger-mode etc. The simplest form is just the word 'account' followed by a hledger-style account name, eg: account assets:bank:checking * Menu: * Account comments:: * Account subdirectives:: * Account types:: * Account display order::  File: hledger_journal.info, Node: Account comments, Next: Account subdirectives, Up: Declaring accounts 1.13.8.1 Account comments ......................... Comments, beginning with a semicolon, can be added: * on the same line, *after two or more spaces* (because ; is allowed in account names) * on the next lines, indented An example of both: account assets:bank:checking ; same-line comment, note 2+ spaces before ; ; next-line comment ; another with tag, acctno:12345 (not used yet) Same-line comments are not supported by Ledger, or hledger <1.13.  File: hledger_journal.info, Node: Account subdirectives, Next: Account types, Prev: Account comments, Up: Declaring accounts 1.13.8.2 Account subdirectives .............................. We also allow (and ignore) Ledger-style indented subdirectives, just for compatibility.: account assets:bank:checking format blah blah ; <- subdirective, ignored Here is the full syntax of account directives: account ACCTNAME [ACCTTYPE] [;COMMENT] [;COMMENTS] [LEDGER-STYLE SUBDIRECTIVES, IGNORED]  File: hledger_journal.info, Node: Account types, Next: Account display order, Prev: Account subdirectives, Up: Declaring accounts 1.13.8.3 Account types ...................... hledger recognises five main types of account, corresponding to the account classes in the accounting equation: 'Asset', 'Liability', 'Equity', 'Revenue', 'Expense'. These account types are important for controlling which accounts appear in the balancesheet, balancesheetequity, incomestatement reports (and probably for other things in future). Additionally, we recognise the 'Cash' type, which is also an 'Asset', and which causes accounts to appear in the cashflow report. ("Cash" here means liquid assets, eg bank balances but typically not investments or receivables.) Declaring account types Generally, to make these reports work you should declare your top-level accounts and their types, using account directives with 'type:' tags. The tag's value should be one of: 'Asset', 'Liability', 'Equity', 'Revenue', 'Expense', 'Cash', 'A', 'L', 'E', 'R', 'X', 'C' (all case insensitive). The type is inherited by all subaccounts except where they override it. Here's a complete example: account assets ; type: Asset account assets:bank ; type: Cash account assets:cash ; type: Cash account liabilities ; type: Liability account equity ; type: Equity account revenues ; type: Revenue account expenses ; type: Expense Auto-detected account types If you happen to use common english top-level account names, you may not need to declare account types, as they will be detected automatically using the following rules: If name matches regular account expression: type is: ------------------------------------------------- '^assets?(:|$)' 'Asset' '^(debts?|liabilit(y|ies))(:|$)' 'Liability' '^equity(:|$)' 'Equity' '^(income|revenue)s?(:|$)' 'Revenue' '^expenses?(:|$)' 'Expense' If account type is 'Asset' and name does not contain account type regular expression: is: -------------------------------------------------------------------------- '(investment|receivable|:A/R|:fixed)' 'Cash' Even so, explicit declarations may be a good idea, for clarity and predictability. Interference from auto-detected account types If you assign any account type, it's a good idea to assign all of them, to prevent any confusion from mixing declared and auto-detected types. Although it's unlikely to happen in real life, here's an example: with the following journal, 'balancesheetequity' shows "liabilities" in both Liabilities and Equity sections. Declaring another account as 'type:Liability' would fix it: account liabilities ; type:Equity 2020-01-01 assets 1 liabilities 1 equity -2 Old account type syntax In some hledger journals you might instead see this old syntax (the letters ALERX, separated from the account name by two or more spaces); this is deprecated and may be removed soon: account assets A account liabilities L account equity E account revenues R account expenses X  File: hledger_journal.info, Node: Account display order, Prev: Account types, Up: Declaring accounts 1.13.8.4 Account display order .............................. Account directives also set the order in which accounts are displayed, eg in reports, the hledger-ui accounts screen, and the hledger-web sidebar. By default accounts are listed in alphabetical order. But if you have these account directives in the journal: account assets account liabilities account equity account revenues account expenses you'll see those accounts displayed in declaration order, not alphabetically: $ hledger accounts -1 assets liabilities equity revenues expenses Undeclared accounts, if any, are displayed last, in alphabetical order. Note that sorting is done at each level of the account tree (within each group of sibling accounts under the same parent). And currently, this directive: account other:zoo would influence the position of 'zoo' among 'other''s subaccounts, but not the position of 'other' among the top-level accounts. This means: * you will sometimes declare parent accounts (eg 'account other' above) that you don't intend to post to, just to customize their display order * sibling accounts stay together (you couldn't display 'x:y' in between 'a:b' and 'a:c').  File: hledger_journal.info, Node: Rewriting accounts, Next: Default parent account, Prev: Declaring accounts, Up: Directives 1.13.9 Rewriting accounts ------------------------- You can define account alias rules which rewrite your account names, or parts of them, before generating reports. This can be useful for: * expanding shorthand account names to their full form, allowing easier data entry and a less verbose journal * adapting old journals to your current chart of accounts * experimenting with new account organisations, like a new hierarchy or combining two accounts into one * customising reports Account aliases also rewrite account names in account directives. They do not affect account names being entered via hledger add or hledger-web. See also Rewrite account names. * Menu: * Basic aliases:: * Regex aliases:: * Combining aliases:: * Aliases and multiple files:: * end aliases::  File: hledger_journal.info, Node: Basic aliases, Next: Regex aliases, Up: Rewriting accounts 1.13.9.1 Basic aliases ...................... To set an account alias, use the 'alias' directive in your journal file. This affects all subsequent journal entries in the current file or its included files. The spaces around the = are optional: alias OLD = NEW Or, you can use the '--alias 'OLD=NEW'' option on the command line. This affects all entries. It's useful for trying out aliases interactively. OLD and NEW are case sensitive full account names. hledger will replace any occurrence of the old account name with the new one. Subaccounts are also affected. Eg: alias checking = assets:bank:wells fargo:checking ; rewrites "checking" to "assets:bank:wells fargo:checking", or "checking:a" to "assets:bank:wells fargo:checking:a"  File: hledger_journal.info, Node: Regex aliases, Next: Combining aliases, Prev: Basic aliases, Up: Rewriting accounts 1.13.9.2 Regex aliases ...................... There is also a more powerful variant that uses a regular expression, indicated by the forward slashes: alias /REGEX/ = REPLACEMENT or '--alias '/REGEX/=REPLACEMENT''. REGEX is a case-insensitive regular expression. Anywhere it matches inside an account name, the matched part will be replaced by REPLACEMENT. If REGEX contains parenthesised match groups, these can be referenced by the usual numeric backreferences in REPLACEMENT. Eg: alias /^(.+):bank:([^:]+):(.*)/ = \1:\2 \3 ; rewrites "assets:bank:wells fargo:checking" to "assets:wells fargo checking" Also note that REPLACEMENT continues to the end of line (or on command line, to end of option argument), so it can contain trailing whitespace.  File: hledger_journal.info, Node: Combining aliases, Next: Aliases and multiple files, Prev: Regex aliases, Up: Rewriting accounts 1.13.9.3 Combining aliases .......................... You can define as many aliases as you like, using journal directives and/or command line options. Recursive aliases - where an account name is rewritten by one alias, then by another alias, and so on - are allowed. Each alias sees the effect of previously applied aliases. In such cases it can be important to understand which aliases will be applied and in which order. For (each account name in) each journal entry, we apply: 1. 'alias' directives preceding the journal entry, most recently parsed first (ie, reading upward from the journal entry, bottom to top) 2. '--alias' options, in the order they appeared on the command line (left to right). In other words, for (an account name in) a given journal entry: * the nearest alias declaration before/above the entry is applied first * the next alias before/above that will be be applied next, and so on * aliases defined after/below the entry do not affect it. This gives nearby aliases precedence over distant ones, and helps provide semantic stability - aliases will keep working the same way independent of which files are being read and in which order. In case of trouble, adding '--debug=6' to the command line will show which aliases are being applied when.  File: hledger_journal.info, Node: Aliases and multiple files, Next: end aliases, Prev: Combining aliases, Up: Rewriting accounts 1.13.9.4 Aliases and multiple files ................................... As explained at Directives and multiple files, 'alias' directives do not affect parent or sibling files. Eg in this command, hledger -f a.aliases -f b.journal account aliases defined in a.aliases will not affect b.journal. Including the aliases doesn't work either: include a.aliases 2020-01-01 ; not affected by a.aliases foo 1 bar This means that account aliases should usually be declared at the start of your top-most file, like this: alias foo=Foo alias bar=Bar 2020-01-01 ; affected by aliases above foo 1 bar include c.journal ; also affected  File: hledger_journal.info, Node: end aliases, Prev: Aliases and multiple files, Up: Rewriting accounts 1.13.9.5 'end aliases' ...................... You can clear (forget) all currently defined aliases with the 'end aliases' directive: end aliases  File: hledger_journal.info, Node: Default parent account, Prev: Rewriting accounts, Up: Directives 1.13.10 Default parent account ------------------------------ You can specify a parent account which will be prepended to all accounts within a section of the journal. Use the 'apply account' and 'end apply account' directives like so: apply account home 2010/1/1 food $10 cash end apply account which is equivalent to: 2010/01/01 home:food $10 home:cash $-10 If 'end apply account' is omitted, the effect lasts to the end of the file. Included files are also affected, eg: apply account business include biz.journal end apply account apply account personal include personal.journal Prior to hledger 1.0, legacy 'account' and 'end' spellings were also supported. A default parent account also affects account directives. It does not affect account names being entered via hledger add or hledger-web. If account aliases are present, they are applied after the default parent account.  File: hledger_journal.info, Node: Periodic transactions, Next: Auto postings, Prev: Directives, Up: Transactions 1.14 Periodic transactions ========================== Periodic transaction rules describe transactions that recur. They allow hledger to generate temporary future transactions to help with forecasting, so you don't have to write out each one in the journal, and it's easy to try out different forecasts. Secondly, they are also used to define the budgets shown in budget reports. Periodic transactions can be a little tricky, so before you use them, read this whole section - or at least these tips: 1. Two spaces accidentally added or omitted will cause you trouble - read about this below. 2. For troubleshooting, show the generated transactions with 'hledger print --forecast tag:generated' or 'hledger register --forecast tag:generated'. 3. Forecasted transactions will begin only after the last non-forecasted transaction's date. 4. Forecasted transactions will end 6 months from today, by default. See below for the exact start/end rules. 5. period expressions can be tricky. Their documentation needs improvement, but is worth studying. 6. Some period expressions with a repeating interval must begin on a natural boundary of that interval. Eg in 'weekly from DATE', DATE must be a monday. '~ weekly from 2019/10/1' (a tuesday) will give an error. 7. Other period expressions with an interval are automatically expanded to cover a whole number of that interval. (This is done to improve reports, but it also affects periodic transactions. Yes, it's a bit inconsistent with the above.) Eg: '~ every 10th day of month from 2020/01', which is equivalent to '~ every 10th day of month from 2020/01/01', will be adjusted to start on 2019/12/10. * Menu: * Periodic rule syntax:: * Two spaces between period expression and description!:: * Forecasting with periodic transactions:: * Budgeting with periodic transactions::  File: hledger_journal.info, Node: Periodic rule syntax, Next: Two spaces between period expression and description!, Up: Periodic transactions 1.14.1 Periodic rule syntax --------------------------- A periodic transaction rule looks like a normal journal entry, with the date replaced by a tilde ('~') followed by a period expression (mnemonic: '~' looks like a recurring sine wave.): ~ monthly expenses:rent $2000 assets:bank:checking There is an additional constraint on the period expression: the start date must fall on a natural boundary of the interval. Eg 'monthly from 2018/1/1' is valid, but 'monthly from 2018/1/15' is not. Partial or relative dates (M/D, D, tomorrow, last week) in the period expression can work (useful or not). They will be relative to today's date, unless a Y default year directive is in effect, in which case they will be relative to Y/1/1.  File: hledger_journal.info, Node: Two spaces between period expression and description!, Next: Forecasting with periodic transactions, Prev: Periodic rule syntax, Up: Periodic transactions 1.14.2 Two spaces between period expression and description! ------------------------------------------------------------ If the period expression is followed by a transaction description, these must be separated by *two or more spaces*. This helps hledger know where the period expression ends, so that descriptions can not accidentally alter their meaning, as in this example: ; 2 or more spaces needed here, so the period is not understood as "every 2 months in 2020" ; || ; vv ~ every 2 months in 2020, we will review assets:bank:checking $1500 income:acme inc So, * Do write two spaces between your period expression and your transaction description, if any. * Don't accidentally write two spaces in the middle of your period expression.  File: hledger_journal.info, Node: Forecasting with periodic transactions, Next: Budgeting with periodic transactions, Prev: Two spaces between period expression and description!, Up: Periodic transactions 1.14.3 Forecasting with periodic transactions --------------------------------------------- The '--forecast' flag activates any periodic transaction rules in the journal. They will generate temporary recurring transactions, which are not saved in the journal, but will appear in all reports (eg print). This can be useful for estimating balances into the future, or experimenting with different scenarios. Or, it can be used as a data entry aid: describe recurring transactions, and every so often copy the output of 'print --forecast' into the journal. These transactions will have an extra tag indicating which periodic rule generated them: 'generated-transaction:~ PERIODICEXPR'. And a similar, hidden tag (beginning with an underscore) which, because it's never displayed by print, can be used to match transactions generated "just now": '_generated-transaction:~ PERIODICEXPR'. Periodic transactions are generated within some forecast period. By default, this * begins on the later of * the report start date if specified with -b/-p/date: * the day after the latest normal (non-periodic) transaction in the journal, or today if there are no normal transactions. * ends on the report end date if specified with -e/-p/date:, or 6 months (180 days) from today. This means that periodic transactions will begin only after the latest recorded transaction. And a recorded transaction dated in the future can prevent generation of periodic transactions. (You can avoid that by writing the future transaction as a one-time periodic rule instead - put tilde before the date, eg '~ YYYY-MM-DD ...'). Or, you can set your own arbitrary "forecast period", which can overlap recorded transactions, and need not be in the future, by providing an option argument, like '--forecast=PERIODEXPR'. Note the equals sign is required, a space won't work. PERIODEXPR is a period expression, which can specify the start date, end date, or both, like in a 'date:' query. (See also hledger.1 -> Report start & end date). Some examples: '--forecast=202001-202004', '--forecast=jan-', '--forecast=2020'.  File: hledger_journal.info, Node: Budgeting with periodic transactions, Prev: Forecasting with periodic transactions, Up: Periodic transactions 1.14.4 Budgeting with periodic transactions ------------------------------------------- With the '--budget' flag, currently supported by the balance command, each periodic transaction rule declares recurring budget goals for the specified accounts. Eg the first example above declares a goal of spending $2000 on rent (and also, a goal of depositing $2000 into checking) every month. Goals and actual performance can then be compared in budget reports. For more details, see: balance: Budget report and Budgeting and Forecasting.  File: hledger_journal.info, Node: Auto postings, Prev: Periodic transactions, Up: Transactions 1.15 Auto postings ================== "Automated postings" or "auto postings" are extra postings which get added automatically to transactions which match certain queries, defined by "auto posting rules", when you use the '--auto' flag. An auto posting rule looks a bit like a transaction: = QUERY ACCOUNT AMOUNT ... ACCOUNT [AMOUNT] except the first line is an equals sign (mnemonic: '=' suggests matching), followed by a query (which matches existing postings), and each "posting" line describes a posting to be generated, and the posting amounts can be: * a normal amount with a commodity symbol, eg '$2'. This will be used as-is. * a number, eg '2'. The commodity symbol (if any) from the matched posting will be added to this. * a numeric multiplier, eg '*2' (a star followed by a number N). The matched posting's amount (and total price, if any) will be multiplied by N. * a multiplier with a commodity symbol, eg '*$2' (a star, number N, and symbol S). The matched posting's amount will be multiplied by N, and its commodity symbol will be replaced with S. Any query term containing spaces must be enclosed in single or double quotes, as on the command line. Eg, note the quotes around the second query term below: = expenses:groceries 'expenses:dining out' (budget:funds:dining out) *-1 Some examples: ; every time I buy food, schedule a dollar donation = expenses:food (liabilities:charity) $-1 ; when I buy a gift, also deduct that amount from a budget envelope subaccount = expenses:gifts assets:checking:gifts *-1 assets:checking *1 2017/12/1 expenses:food $10 assets:checking 2017/12/14 expenses:gifts $20 assets:checking $ hledger print --auto 2017-12-01 expenses:food $10 assets:checking (liabilities:charity) $-1 2017-12-14 expenses:gifts $20 assets:checking assets:checking:gifts -$20 assets:checking $20 * Menu: * Auto postings and multiple files:: * Auto postings and dates:: * Auto postings and transaction balancing / inferred amounts / balance assertions:: * Auto posting tags::  File: hledger_journal.info, Node: Auto postings and multiple files, Next: Auto postings and dates, Up: Auto postings 1.15.1 Auto postings and multiple files --------------------------------------- An auto posting rule can affect any transaction in the current file, or in any parent file or child file. Note, currently it will not affect sibling files (when multiple '-f'/'--file' are used - see #1212).  File: hledger_journal.info, Node: Auto postings and dates, Next: Auto postings and transaction balancing / inferred amounts / balance assertions, Prev: Auto postings and multiple files, Up: Auto postings 1.15.2 Auto postings and dates ------------------------------ A posting date (or secondary date) in the matched posting, or (taking precedence) a posting date in the auto posting rule itself, will also be used in the generated posting.  File: hledger_journal.info, Node: Auto postings and transaction balancing / inferred amounts / balance assertions, Next: Auto posting tags, Prev: Auto postings and dates, Up: Auto postings 1.15.3 Auto postings and transaction balancing / inferred amounts / ------------------------------------------------------------------- balance assertions Currently, auto postings are added: * after missing amounts are inferred, and transactions are checked for balancedness, * but before balance assertions are checked. Note this means that journal entries must be balanced both before and after auto postings are added. This changed in hledger 1.12+; see #893 for background.  File: hledger_journal.info, Node: Auto posting tags, Prev: Auto postings and transaction balancing / inferred amounts / balance assertions, Up: Auto postings 1.15.4 Auto posting tags ------------------------ Automated postings will have some extra tags: * 'generated-posting:= QUERY' - shows this was generated by an auto posting rule, and the query * '_generated-posting:= QUERY' - a hidden tag, which does not appear in hledger's output. This can be used to match postings generated "just now", rather than generated in the past and saved to the journal. Also, any transaction that has been changed by auto posting rules will have these tags added: * 'modified:' - this transaction was modified * '_modified:' - a hidden tag not appearing in the comment; this transaction was modified "just now".  Tag Table: Node: Top76 Node: Transactions1875 Ref: #transactions1967 Node: Dates3251 Ref: #dates3350 Node: Simple dates3415 Ref: #simple-dates3541 Node: Secondary dates4050 Ref: #secondary-dates4204 Node: Posting dates5540 Ref: #posting-dates5669 Node: Status7041 Ref: #status7162 Node: Description8870 Ref: #description9004 Node: Payee and note9324 Ref: #payee-and-note9438 Node: Comments9773 Ref: #comments9899 Node: Tags11093 Ref: #tags11208 Node: Postings12601 Ref: #postings12729 Node: Virtual postings13755 Ref: #virtual-postings13872 Node: Account names15177 Ref: #account-names15318 Node: Amounts15805 Ref: #amounts15944 Node: Digit group marks17052 Ref: #digit-group-marks17200 Node: Amount display style18138 Ref: #amount-display-style18292 Node: Transaction prices19729 Ref: #transaction-prices19901 Node: Lot prices and lot dates22332 Ref: #lot-prices-and-lot-dates22529 Node: Balance assertions23017 Ref: #balance-assertions23203 Node: Assertions and ordering24236 Ref: #assertions-and-ordering24424 Node: Assertions and included files25124 Ref: #assertions-and-included-files25367 Node: Assertions and multiple -f options25700 Ref: #assertions-and-multiple--f-options25956 Node: Assertions and commodities26088 Ref: #assertions-and-commodities26320 Node: Assertions and prices27477 Ref: #assertions-and-prices27691 Node: Assertions and subaccounts28131 Ref: #assertions-and-subaccounts28360 Node: Assertions and virtual postings28684 Ref: #assertions-and-virtual-postings28926 Node: Assertions and precision29068 Ref: #assertions-and-precision29261 Node: Balance assignments29528 Ref: #balance-assignments29702 Node: Balance assignments and prices30866 Ref: #balance-assignments-and-prices31038 Node: Directives31262 Ref: #directives31421 Node: Directives and multiple files37112 Ref: #directives-and-multiple-files37295 Node: Comment blocks37959 Ref: #comment-blocks38142 Node: Including other files38318 Ref: #including-other-files38498 Node: Default year39422 Ref: #default-year39591 Node: Declaring commodities39998 Ref: #declaring-commodities40181 Node: Default commodity41987 Ref: #default-commodity42173 Node: Declaring market prices43062 Ref: #declaring-market-prices43257 Node: Declaring accounts44114 Ref: #declaring-accounts44300 Node: Account comments45225 Ref: #account-comments45388 Node: Account subdirectives45812 Ref: #account-subdirectives46007 Node: Account types46320 Ref: #account-types46504 Node: Account display order49550 Ref: #account-display-order49720 Node: Rewriting accounts50871 Ref: #rewriting-accounts51056 Node: Basic aliases51813 Ref: #basic-aliases51959 Node: Regex aliases52663 Ref: #regex-aliases52835 Node: Combining aliases53554 Ref: #combining-aliases53747 Node: Aliases and multiple files55023 Ref: #aliases-and-multiple-files55232 Node: end aliases55811 Ref: #end-aliases55968 Node: Default parent account56069 Ref: #default-parent-account56237 Node: Periodic transactions57121 Ref: #periodic-transactions57296 Node: Periodic rule syntax59168 Ref: #periodic-rule-syntax59374 Node: Two spaces between period expression and description!60078 Ref: #two-spaces-between-period-expression-and-description60397 Node: Forecasting with periodic transactions61081 Ref: #forecasting-with-periodic-transactions61386 Node: Budgeting with periodic transactions63441 Ref: #budgeting-with-periodic-transactions63680 Node: Auto postings64129 Ref: #auto-postings64269 Node: Auto postings and multiple files66448 Ref: #auto-postings-and-multiple-files66652 Node: Auto postings and dates66861 Ref: #auto-postings-and-dates67135 Node: Auto postings and transaction balancing / inferred amounts / balance assertions67310 Ref: #auto-postings-and-transaction-balancing-inferred-amounts-balance-assertions67661 Node: Auto posting tags68003 Ref: #auto-posting-tags68218  End Tag Table  Local Variables: coding: utf-8 End: hledger-lib-1.19.1/hledger_timedot.50000644000000000000000000001176213725533425015414 0ustar0000000000000000 .TH "hledger_timedot" "5" "September 2020" "hledger 1.18.99" "hledger User Manuals" .SH NAME .PP Timedot - hledger\[aq]s human-friendly time logging format .SH DESCRIPTION .PP Timedot is a plain text format for logging dated, categorised quantities (of time, usually), supported by hledger. It is convenient for approximate and retroactive time logging, eg when the real-time clock-in/out required with a timeclock file is too precise or too interruptive. It can be formatted like a bar chart, making clear at a glance where time was spent. .PP Though called \[dq]timedot\[dq], this format is read by hledger as commodityless quantities, so it could be used to represent dated quantities other than time. In the docs below we\[aq]ll assume it\[aq]s time. .PP A timedot file contains a series of day entries. A day entry begins with a non-indented hledger-style simple date (Y-M-D, Y/M/D, Y.M.D..) Any additional text on the same line is used as a transaction description for this day. .PP This is followed by optionally-indented timelog items for that day, one per line. Each timelog item is a note, usually a hledger:style:account:name representing a time category, followed by two or more spaces, and a quantity. Each timelog item generates a hledger transaction. .PP Quantities can be written as: .IP \[bu] 2 dots: a sequence of dots (.) representing quarter hours. Spaces may optionally be used for grouping. Eg: .... \&.. .IP \[bu] 2 an integral or decimal number, representing hours. Eg: 1.5 .IP \[bu] 2 an integral or decimal number immediately followed by a unit symbol \f[C]s\f[R], \f[C]m\f[R], \f[C]h\f[R], \f[C]d\f[R], \f[C]w\f[R], \f[C]mo\f[R], or \f[C]y\f[R], representing seconds, minutes, hours, days weeks, months or years respectively. Eg: 90m. The following equivalencies are assumed, currently: 1m = 60s, 1h = 60m, 1d = 24h, 1w = 7d, 1mo = 30d, 1y=365d. .PP There is some flexibility allowing notes and todo lists to be kept right in the time log, if needed: .IP \[bu] 2 Blank lines and lines beginning with \f[C]#\f[R] or \f[C];\f[R] are ignored. .IP \[bu] 2 Lines not ending with a double-space and quantity are parsed as items taking no time, which will not appear in balance reports by default. (Add -E to see them.) .IP \[bu] 2 Org mode headlines (lines beginning with one or more \f[C]*\f[R] followed by a space) can be used as date lines or timelog items (the stars are ignored). Also all org headlines before the first date line are ignored. This means org users can manage their timelog as an org outline (eg using org-mode/orgstruct-mode in Emacs), for organisation, faster navigation, controlling visibility etc. .PP Examples: .IP .nf \f[C] # on this day, 6h was spent on client work, 1.5h on haskell FOSS work, etc. 2016/2/1 inc:client1 .... .... .... .... .... .... fos:haskell .... .. biz:research . 2016/2/2 inc:client1 .... .... biz:research . \f[R] .fi .IP .nf \f[C] 2016/2/3 inc:client1 4 fos:hledger 3 biz:research 1 \f[R] .fi .IP .nf \f[C] * Time log ** 2020-01-01 *** adm:time . *** adm:finance . \f[R] .fi .IP .nf \f[C] * 2020 Work Diary ** Q1 *** 2020-02-29 **** DONE 0700 yoga **** UNPLANNED **** BEGUN hom:chores cleaning ... water plants outdoor - one full watering can indoor - light watering **** TODO adm:planning: trip *** LATER \f[R] .fi .PP Reporting: .IP .nf \f[C] $ hledger -f t.timedot print date:2016/2/2 2016-02-02 * (inc:client1) 2.00 2016-02-02 * (biz:research) 0.25 \f[R] .fi .IP .nf \f[C] $ hledger -f t.timedot bal --daily --tree Balance changes in 2016-02-01-2016-02-03: || 2016-02-01d 2016-02-02d 2016-02-03d ============++======================================== biz || 0.25 0.25 1.00 research || 0.25 0.25 1.00 fos || 1.50 0 3.00 haskell || 1.50 0 0 hledger || 0 0 3.00 inc || 6.00 2.00 4.00 client1 || 6.00 2.00 4.00 ------------++---------------------------------------- || 7.75 2.25 8.00 \f[R] .fi .PP I prefer to use period for separating account components. We can make this work with an account alias: .IP .nf \f[C] 2016/2/4 fos.hledger.timedot 4 fos.ledger .. \f[R] .fi .IP .nf \f[C] $ hledger -f t.timedot --alias /\[rs]\[rs]./=: bal date:2016/2/4 4.50 fos 4.00 hledger:timedot 0.50 ledger -------------------- 4.50 \f[R] .fi .PP Here is a sample.timedot. .SH "REPORTING BUGS" Report bugs at http://bugs.hledger.org (or on the #hledger IRC channel or hledger mail list) .SH AUTHORS Simon Michael and contributors .SH COPYRIGHT Copyright (C) 2007-2019 Simon Michael. .br Released under GNU GPL v3 or later. .SH SEE ALSO hledger(1), hledger\-ui(1), hledger\-web(1), hledger\-api(1), hledger_csv(5), hledger_journal(5), hledger_timeclock(5), hledger_timedot(5), ledger(1) http://hledger.org hledger-lib-1.19.1/hledger_timedot.txt0000644000000000000000000001366113725533425016067 0ustar0000000000000000 hledger_timedot(5) hledger User Manuals hledger_timedot(5) NAME Timedot - hledger's human-friendly time logging format DESCRIPTION Timedot is a plain text format for logging dated, categorised quanti- ties (of time, usually), supported by hledger. It is convenient for approximate and retroactive time logging, eg when the real-time clock- in/out required with a timeclock file is too precise or too interrup- tive. It can be formatted like a bar chart, making clear at a glance where time was spent. Though called "timedot", this format is read by hledger as commodity- less quantities, so it could be used to represent dated quantities other than time. In the docs below we'll assume it's time. A timedot file contains a series of day entries. A day entry begins with a non-indented hledger-style simple date (Y-M-D, Y/M/D, Y.M.D..) Any additional text on the same line is used as a transaction descrip- tion for this day. This is followed by optionally-indented timelog items for that day, one per line. Each timelog item is a note, usually a hledger:style:ac- count:name representing a time category, followed by two or more spa- ces, and a quantity. Each timelog item generates a hledger transac- tion. Quantities can be written as: o dots: a sequence of dots (.) representing quarter hours. Spaces may optionally be used for grouping. Eg: .... .. o an integral or decimal number, representing hours. Eg: 1.5 o an integral or decimal number immediately followed by a unit symbol s, m, h, d, w, mo, or y, representing seconds, minutes, hours, days weeks, months or years respectively. Eg: 90m. The following equiva- lencies are assumed, currently: 1m = 60s, 1h = 60m, 1d = 24h, 1w = 7d, 1mo = 30d, 1y=365d. There is some flexibility allowing notes and todo lists to be kept right in the time log, if needed: o Blank lines and lines beginning with # or ; are ignored. o Lines not ending with a double-space and quantity are parsed as items taking no time, which will not appear in balance reports by default. (Add -E to see them.) o Org mode headlines (lines beginning with one or more * followed by a space) can be used as date lines or timelog items (the stars are ig- nored). Also all org headlines before the first date line are ig- nored. This means org users can manage their timelog as an org out- line (eg using org-mode/orgstruct-mode in Emacs), for organisation, faster navigation, controlling visibility etc. Examples: # on this day, 6h was spent on client work, 1.5h on haskell FOSS work, etc. 2016/2/1 inc:client1 .... .... .... .... .... .... fos:haskell .... .. biz:research . 2016/2/2 inc:client1 .... .... biz:research . 2016/2/3 inc:client1 4 fos:hledger 3 biz:research 1 * Time log ** 2020-01-01 *** adm:time . *** adm:finance . * 2020 Work Diary ** Q1 *** 2020-02-29 **** DONE 0700 yoga **** UNPLANNED **** BEGUN hom:chores cleaning ... water plants outdoor - one full watering can indoor - light watering **** TODO adm:planning: trip *** LATER Reporting: $ hledger -f t.timedot print date:2016/2/2 2016-02-02 * (inc:client1) 2.00 2016-02-02 * (biz:research) 0.25 $ hledger -f t.timedot bal --daily --tree Balance changes in 2016-02-01-2016-02-03: || 2016-02-01d 2016-02-02d 2016-02-03d ============++======================================== biz || 0.25 0.25 1.00 research || 0.25 0.25 1.00 fos || 1.50 0 3.00 haskell || 1.50 0 0 hledger || 0 0 3.00 inc || 6.00 2.00 4.00 client1 || 6.00 2.00 4.00 ------------++---------------------------------------- || 7.75 2.25 8.00 I prefer to use period for separating account components. We can make this work with an account alias: 2016/2/4 fos.hledger.timedot 4 fos.ledger .. $ hledger -f t.timedot --alias /\\./=: bal date:2016/2/4 4.50 fos 4.00 hledger:timedot 0.50 ledger -------------------- 4.50 Here is a sample.timedot. REPORTING BUGS Report bugs at http://bugs.hledger.org (or on the #hledger IRC channel or hledger mail list) AUTHORS Simon Michael and contributors COPYRIGHT Copyright (C) 2007-2019 Simon Michael. Released under GNU GPL v3 or later. SEE ALSO hledger(1), hledger-ui(1), hledger-web(1), hledger-api(1), hledger_csv(5), hledger_journal(5), hledger_timeclock(5), hledger_time- dot(5), ledger(1) http://hledger.org hledger 1.18.99 September 2020 hledger_timedot(5) hledger-lib-1.19.1/hledger_timedot.info0000644000000000000000000001072013725533425016174 0ustar0000000000000000This is hledger_timedot.info, produced by makeinfo version 6.7 from stdin.  File: hledger_timedot.info, Node: Top, Up: (dir) hledger_timedot(5) hledger 1.18.99 ********************************** Timedot - hledger's human-friendly time logging format Timedot is a plain text format for logging dated, categorised quantities (of time, usually), supported by hledger. It is convenient for approximate and retroactive time logging, eg when the real-time clock-in/out required with a timeclock file is too precise or too interruptive. It can be formatted like a bar chart, making clear at a glance where time was spent. Though called "timedot", this format is read by hledger as commodityless quantities, so it could be used to represent dated quantities other than time. In the docs below we'll assume it's time. A timedot file contains a series of day entries. A day entry begins with a non-indented hledger-style simple date (Y-M-D, Y/M/D, Y.M.D..) Any additional text on the same line is used as a transaction description for this day. This is followed by optionally-indented timelog items for that day, one per line. Each timelog item is a note, usually a hledger:style:account:name representing a time category, followed by two or more spaces, and a quantity. Each timelog item generates a hledger transaction. Quantities can be written as: * dots: a sequence of dots (.) representing quarter hours. Spaces may optionally be used for grouping. Eg: .... .. * an integral or decimal number, representing hours. Eg: 1.5 * an integral or decimal number immediately followed by a unit symbol 's', 'm', 'h', 'd', 'w', 'mo', or 'y', representing seconds, minutes, hours, days weeks, months or years respectively. Eg: 90m. The following equivalencies are assumed, currently: 1m = 60s, 1h = 60m, 1d = 24h, 1w = 7d, 1mo = 30d, 1y=365d. There is some flexibility allowing notes and todo lists to be kept right in the time log, if needed: * Blank lines and lines beginning with '#' or ';' are ignored. * Lines not ending with a double-space and quantity are parsed as items taking no time, which will not appear in balance reports by default. (Add -E to see them.) * Org mode headlines (lines beginning with one or more '*' followed by a space) can be used as date lines or timelog items (the stars are ignored). Also all org headlines before the first date line are ignored. This means org users can manage their timelog as an org outline (eg using org-mode/orgstruct-mode in Emacs), for organisation, faster navigation, controlling visibility etc. Examples: # on this day, 6h was spent on client work, 1.5h on haskell FOSS work, etc. 2016/2/1 inc:client1 .... .... .... .... .... .... fos:haskell .... .. biz:research . 2016/2/2 inc:client1 .... .... biz:research . 2016/2/3 inc:client1 4 fos:hledger 3 biz:research 1 * Time log ** 2020-01-01 *** adm:time . *** adm:finance . * 2020 Work Diary ** Q1 *** 2020-02-29 **** DONE 0700 yoga **** UNPLANNED **** BEGUN hom:chores cleaning ... water plants outdoor - one full watering can indoor - light watering **** TODO adm:planning: trip *** LATER Reporting: $ hledger -f t.timedot print date:2016/2/2 2016-02-02 * (inc:client1) 2.00 2016-02-02 * (biz:research) 0.25 $ hledger -f t.timedot bal --daily --tree Balance changes in 2016-02-01-2016-02-03: || 2016-02-01d 2016-02-02d 2016-02-03d ============++======================================== biz || 0.25 0.25 1.00 research || 0.25 0.25 1.00 fos || 1.50 0 3.00 haskell || 1.50 0 0 hledger || 0 0 3.00 inc || 6.00 2.00 4.00 client1 || 6.00 2.00 4.00 ------------++---------------------------------------- || 7.75 2.25 8.00 I prefer to use period for separating account components. We can make this work with an account alias: 2016/2/4 fos.hledger.timedot 4 fos.ledger .. $ hledger -f t.timedot --alias /\\./=: bal date:2016/2/4 4.50 fos 4.00 hledger:timedot 0.50 ledger -------------------- 4.50 Here is a sample.timedot.  Tag Table: Node: Top76  End Tag Table  Local Variables: coding: utf-8 End: hledger-lib-1.19.1/hledger_timeclock.50000644000000000000000000000535313725533425015720 0ustar0000000000000000 .TH "hledger_timeclock" "5" "September 2020" "hledger 1.18.99" "hledger User Manuals" .SH NAME .PP Timeclock - the time logging format of timeclock.el, as read by hledger .SH DESCRIPTION .PP hledger can read timeclock files. As with Ledger, these are (a subset of) timeclock.el\[aq]s format, containing clock-in and clock-out entries as in the example below. The date is a simple date. The time format is HH:MM[:SS][+-ZZZZ]. Seconds and timezone are optional. The timezone, if present, must be four digits and is ignored (currently the time is always interpreted as a local time). .IP .nf \f[C] i 2015/03/30 09:00:00 some:account name optional description after two spaces o 2015/03/30 09:20:00 i 2015/03/31 22:21:45 another account o 2015/04/01 02:00:34 \f[R] .fi .PP hledger treats each clock-in/clock-out pair as a transaction posting some number of hours to an account. Or if the session spans more than one day, it is split into several transactions, one for each day. For the above time log, \f[C]hledger print\f[R] generates these journal entries: .IP .nf \f[C] $ hledger -f t.timeclock print 2015-03-30 * optional description after two spaces (some:account name) 0.33h 2015-03-31 * 22:21-23:59 (another account) 1.64h 2015-04-01 * 00:00-02:00 (another account) 2.01h \f[R] .fi .PP Here is a sample.timeclock to download and some queries to try: .IP .nf \f[C] $ hledger -f sample.timeclock balance # current time balances $ hledger -f sample.timeclock register -p 2009/3 # sessions in march 2009 $ hledger -f sample.timeclock register -p weekly --depth 1 --empty # time summary by week \f[R] .fi .PP To generate time logs, ie to clock in and clock out, you could: .IP \[bu] 2 use emacs and the built-in timeclock.el, or the extended timeclock-x.el and perhaps the extras in ledgerutils.el .IP \[bu] 2 at the command line, use these bash aliases: \f[C]shell alias ti=\[dq]echo i \[ga]date \[aq]+%Y-%m-%d %H:%M:%S\[aq]\[ga] \[rs]$* >>$TIMELOG\[dq] alias to=\[dq]echo o \[ga]date \[aq]+%Y-%m-%d %H:%M:%S\[aq]\[ga] >>$TIMELOG\[dq]\f[R] .IP \[bu] 2 or use the old \f[C]ti\f[R] and \f[C]to\f[R] scripts in the ledger 2.x repository. These rely on a \[dq]timeclock\[dq] executable which I think is just the ledger 2 executable renamed. .SH "REPORTING BUGS" Report bugs at http://bugs.hledger.org (or on the #hledger IRC channel or hledger mail list) .SH AUTHORS Simon Michael and contributors .SH COPYRIGHT Copyright (C) 2007-2019 Simon Michael. .br Released under GNU GPL v3 or later. .SH SEE ALSO hledger(1), hledger\-ui(1), hledger\-web(1), hledger\-api(1), hledger_csv(5), hledger_journal(5), hledger_timeclock(5), hledger_timedot(5), ledger(1) http://hledger.org hledger-lib-1.19.1/hledger_timeclock.txt0000644000000000000000000000601313725533425016365 0ustar0000000000000000 hledger_timeclock(5) hledger User Manuals hledger_timeclock(5) NAME Timeclock - the time logging format of timeclock.el, as read by hledger DESCRIPTION hledger can read timeclock files. As with Ledger, these are (a subset of) timeclock.el's format, containing clock-in and clock-out entries as in the example below. The date is a simple date. The time format is HH:MM[:SS][+-ZZZZ]. Seconds and timezone are optional. The timezone, if present, must be four digits and is ignored (currently the time is always interpreted as a local time). i 2015/03/30 09:00:00 some:account name optional description after two spaces o 2015/03/30 09:20:00 i 2015/03/31 22:21:45 another account o 2015/04/01 02:00:34 hledger treats each clock-in/clock-out pair as a transaction posting some number of hours to an account. Or if the session spans more than one day, it is split into several transactions, one for each day. For the above time log, hledger print generates these journal entries: $ hledger -f t.timeclock print 2015-03-30 * optional description after two spaces (some:account name) 0.33h 2015-03-31 * 22:21-23:59 (another account) 1.64h 2015-04-01 * 00:00-02:00 (another account) 2.01h Here is a sample.timeclock to download and some queries to try: $ hledger -f sample.timeclock balance # current time balances $ hledger -f sample.timeclock register -p 2009/3 # sessions in march 2009 $ hledger -f sample.timeclock register -p weekly --depth 1 --empty # time summary by week To generate time logs, ie to clock in and clock out, you could: o use emacs and the built-in timeclock.el, or the extended timeclock- x.el and perhaps the extras in ledgerutils.el o at the command line, use these bash aliases: shell alias ti="echo i `date '+%Y-%m-%d %H:%M:%S'` \$* >>$TIMELOG" alias to="echo o `date '+%Y-%m-%d %H:%M:%S'` >>$TIMELOG" o or use the old ti and to scripts in the ledger 2.x repository. These rely on a "timeclock" executable which I think is just the ledger 2 executable renamed. REPORTING BUGS Report bugs at http://bugs.hledger.org (or on the #hledger IRC channel or hledger mail list) AUTHORS Simon Michael and contributors COPYRIGHT Copyright (C) 2007-2019 Simon Michael. Released under GNU GPL v3 or later. SEE ALSO hledger(1), hledger-ui(1), hledger-web(1), hledger-api(1), hledger_csv(5), hledger_journal(5), hledger_timeclock(5), hledger_time- dot(5), ledger(1) http://hledger.org hledger 1.18.99 September 2020 hledger_timeclock(5) hledger-lib-1.19.1/hledger_timeclock.info0000644000000000000000000000445613725533425016512 0ustar0000000000000000This is hledger_timeclock.info, produced by makeinfo version 6.7 from stdin.  File: hledger_timeclock.info, Node: Top, Up: (dir) hledger_timeclock(5) hledger 1.18.99 ************************************ Timeclock - the time logging format of timeclock.el, as read by hledger hledger can read timeclock files. As with Ledger, these are (a subset of) timeclock.el's format, containing clock-in and clock-out entries as in the example below. The date is a simple date. The time format is HH:MM[:SS][+-ZZZZ]. Seconds and timezone are optional. The timezone, if present, must be four digits and is ignored (currently the time is always interpreted as a local time). i 2015/03/30 09:00:00 some:account name optional description after two spaces o 2015/03/30 09:20:00 i 2015/03/31 22:21:45 another account o 2015/04/01 02:00:34 hledger treats each clock-in/clock-out pair as a transaction posting some number of hours to an account. Or if the session spans more than one day, it is split into several transactions, one for each day. For the above time log, 'hledger print' generates these journal entries: $ hledger -f t.timeclock print 2015-03-30 * optional description after two spaces (some:account name) 0.33h 2015-03-31 * 22:21-23:59 (another account) 1.64h 2015-04-01 * 00:00-02:00 (another account) 2.01h Here is a sample.timeclock to download and some queries to try: $ hledger -f sample.timeclock balance # current time balances $ hledger -f sample.timeclock register -p 2009/3 # sessions in march 2009 $ hledger -f sample.timeclock register -p weekly --depth 1 --empty # time summary by week To generate time logs, ie to clock in and clock out, you could: * use emacs and the built-in timeclock.el, or the extended timeclock-x.el and perhaps the extras in ledgerutils.el * at the command line, use these bash aliases: 'shell alias ti="echo i `date '+%Y-%m-%d %H:%M:%S'` \$* >>$TIMELOG" alias to="echo o `date '+%Y-%m-%d %H:%M:%S'` >>$TIMELOG"' * or use the old 'ti' and 'to' scripts in the ledger 2.x repository. These rely on a "timeclock" executable which I think is just the ledger 2 executable renamed.  Tag Table: Node: Top78  End Tag Table  Local Variables: coding: utf-8 End: