hledger-lib-1.12/Hledger/0000755000000000000000000000000013373103562013356 5ustar0000000000000000hledger-lib-1.12/Hledger/Data/0000755000000000000000000000000013401047234014222 5ustar0000000000000000hledger-lib-1.12/Hledger/Read/0000755000000000000000000000000013401076725014233 5ustar0000000000000000hledger-lib-1.12/Hledger/Reports/0000755000000000000000000000000013401044253015005 5ustar0000000000000000hledger-lib-1.12/Hledger/Utils/0000755000000000000000000000000013401044253014447 5ustar0000000000000000hledger-lib-1.12/Text/0000755000000000000000000000000013317136630012730 5ustar0000000000000000hledger-lib-1.12/Text/Megaparsec/0000755000000000000000000000000013401044253014770 5ustar0000000000000000hledger-lib-1.12/Text/Tabular/0000755000000000000000000000000013363322116014317 5ustar0000000000000000hledger-lib-1.12/test/0000755000000000000000000000000013372610345012764 5ustar0000000000000000hledger-lib-1.12/Hledger.hs0000644000000000000000000000061113372610345013711 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.12/Hledger/Data.hs0000644000000000000000000000355213372610345014571 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.Ledger, module Hledger.Data.MarketPrice, 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, 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.Ledger import Hledger.Data.MarketPrice 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.Utils.Test tests_Data = tests "Data" [ tests_AccountName ,tests_Amount ,tests_Journal ,tests_Ledger ,tests_Posting ,tests_StringFormat ,tests_Timeclock ,tests_Transaction ] hledger-lib-1.12/Hledger/Data/Account.hs0000644000000000000000000002442413372610345016166 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 import Data.List.Extra (groupSort, groupOn) import Data.Maybe import Data.Ord import qualified Data.Map as M import Data.Text (pack,unpack) 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)" (pack $ regexReplace ":" "_" $ unpack aname) -- hide : so pretty-show doesn't break line (if aboring then "y" else "n" :: String) anumpostings (showMixedAmount aebalance) (showMixedAmount aibalance) 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 = "" , adeclarationorder = Nothing , aparent = Nothing , asubs = [] , anumpostings = 0 , aebalance = nullmixedamt , aibalance = nullmixedamt , aboring = False } -- | 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). clipAccountsAndAggregate :: Int -> [Account] -> [Account] clipAccountsAndAggregate d as = combined where clipped = [a{aname=clipOrEllipsifyAccountName 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 a | null $ asubs a = a | otherwise = a{asubs= sortBy (maybeflip $ comparing (normaliseMixedAmountSquashPricesForDisplay . aibalance)) $ map (sortAccountTreeByAmount normalsign) $ asubs a} where maybeflip | normalsign==NormallyNegative = id | otherwise = flip -- | Look up an account's declaration order, if any, from the Journal and set it. -- This is the relative position of its account directive -- among the other account directives. accountSetDeclarationOrder :: Journal -> Account -> Account accountSetDeclarationOrder j a@Account{..} = a{adeclarationorder = findIndex (==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 (accountSetDeclarationOrder 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= sortBy (comparing accountDeclarationOrderAndName) $ map sortAccountTreeByDeclaration $ asubs a } accountDeclarationOrderAndName a = (adeclarationorder', aname a) where adeclarationorder' = fromMaybe maxBound (adeclarationorder 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.12/Hledger/Data/AccountName.hs0000644000000000000000000002307513372610345016770 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 ,accountNameToAccountRegex ,accountNameTreeFrom ,accountRegexToAccountName ,accountSummarisedName ,acctsep ,acctsepchar ,clipAccountName ,clipOrEllipsifyAccountName ,elideAccountName ,escapeName ,expandAccountName ,expandAccountNames ,isAccountNamePrefixOf -- ,isAccountRegex ,isSubAccountNameOf ,parentAccountName ,parentAccountNames ,subAccountNamesFrom ,topAccountNames ,unbudgetedAccountName ,tests_AccountName ) where 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 Data.Tree import Text.Printf 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 = accountNameFromComponents $ drop n $ accountNameComponents a where unbudgetedAccountAndSep = unbudgetedAccountName <> acctsep -- | 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 = nub $ sort $ concatMap expandAccountName as -- | "a:b:c" -> ["a","a:b","a:b:c"] expandAccountName :: AccountName -> [AccountName] expandAccountName = map accountNameFromComponents . tail . 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 0, returns the empty string. clipAccountName :: Int -> AccountName -> AccountName clipAccountName n = accountNameFromComponents . take n . accountNameComponents -- | Keep only the first n components of an account name, where n -- is a positive integer. If n is 0, returns "...". clipOrEllipsifyAccountName :: Int -> AccountName -> AccountName clipOrEllipsifyAccountName 0 = const "..." clipOrEllipsifyAccountName n = accountNameFromComponents . take n . accountNameComponents -- | Escape an AccountName for use within a regular expression. -- >>> putStr $ escapeName "First?!#$*?$(*) !@^#*? %)*!@#" -- First\?!#\$\*\?\$\(\*\) !@\^#\*\? %\)\*!@# escapeName :: AccountName -> Regexp escapeName = regexReplaceBy "[[?+|()*\\\\^$]" ("\\" <>) . T.unpack -- | Convert an account name to a regular expression matching it and its subaccounts. accountNameToAccountRegex :: AccountName -> Regexp accountNameToAccountRegex "" = "" accountNameToAccountRegex a = printf "^%s(:|$)" (escapeName a) -- | Convert an account name to a regular expression matching it but not its subaccounts. accountNameToAccountOnlyRegex :: AccountName -> Regexp accountNameToAccountOnlyRegex "" = "" accountNameToAccountOnlyRegex a = printf "^%s$" $ escapeName a -- XXX pack -- | Convert an exact account-matching regular expression to a plain account name. accountRegexToAccountName :: Regexp -> AccountName accountRegexToAccountName = T.pack . regexReplace "^\\^(.*?)\\(:\\|\\$\\)$" "\\1" -- XXX pack -- -- | 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" [ tests "accountNameTreeFrom" [ accountNameTreeFrom ["a"] `is` Node "root" [Node "a" []] ,accountNameTreeFrom ["a","b"] `is` Node "root" [Node "a" [], Node "b" []] ,accountNameTreeFrom ["a","a:b"] `is` Node "root" [Node "a" [Node "a:b" []]] ,accountNameTreeFrom ["a:b:c"] `is` Node "root" [Node "a" [Node "a:b" [Node "a:b:c" []]]] ] ,tests "expandAccountNames" [ expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] `is` ["assets","assets:cash","assets:checking","expenses","expenses:vacation"] ] ,tests "isAccountNamePrefixOf" [ "assets" `isAccountNamePrefixOf` "assets" `is` False ,"assets" `isAccountNamePrefixOf` "assets:bank" `is` True ,"assets" `isAccountNamePrefixOf` "assets:bank:checking" `is` True ,"my assets" `isAccountNamePrefixOf` "assets:bank" `is` False ] ,tests "isSubAccountNameOf" [ "assets" `isSubAccountNameOf` "assets" `is` False ,"assets:bank" `isSubAccountNameOf` "assets" `is` True ,"assets:bank:checking" `isSubAccountNameOf` "assets" `is` False ,"assets:bank" `isSubAccountNameOf` "my assets" `is` False ] ] hledger-lib-1.12/Hledger/Data/Amount.hs0000644000000000000000000010205313401044253016020 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, hrs, at, (@@), amountWithCommodity, -- ** arithmetic costOfAmount, divideAmount, multiplyAmount, divideAmountAndPrice, multiplyAmountAndPrice, amountValue, amountTotalPriceToUnitPrice, -- ** rendering amountstyle, styleAmount, showAmount, cshowAmount, showAmountWithZeroCommodity, showAmountDebug, showAmountWithoutPrice, maxprecision, maxprecisionwithpoint, setAmountPrecision, withPrecision, setAmountInternalPrecision, withInternalPrecision, setAmountDecimalPoint, withDecimalPoint, canonicaliseAmount, -- * MixedAmount nullmixedamt, missingmixedamt, mixed, amounts, filterMixedAmount, filterMixedAmountByCommodity, normaliseMixedAmountSquashPricesForDisplay, normaliseMixedAmount, -- ** arithmetic costOfMixedAmount, divideMixedAmount, multiplyMixedAmount, divideMixedAmountAndPrice, multiplyMixedAmountAndPrice, averageMixedAmounts, isNegativeAmount, isNegativeMixedAmount, isZeroAmount, isReallyZeroAmount, isZeroMixedAmount, isReallyZeroMixedAmount, isReallyZeroMixedAmountCost, mixedAmountValue, mixedAmountTotalPriceToUnitPrice, -- ** rendering styleMixedAmount, showMixedAmount, showMixedAmountOneLine, showMixedAmountDebug, showMixedAmountWithoutPrice, showMixedAmountOneLineWithoutPrice, cshowMixedAmountWithoutPrice, cshowMixedAmountOneLineWithoutPrice, showMixedAmountWithZeroCommodity, showMixedAmountWithPrecision, setMixedAmountPrecision, canonicaliseMixedAmount, -- * misc. ltraceamount, tests_Amount ) where import Data.Char (isDigit) import Data.Decimal (roundTo) import Data.Function (on) import Data.List import Data.Map (findWithDefault) import Data.Maybe import Data.Time.Calendar (Day) import Data.Ord (comparing) -- import Data.Text (Text) import qualified Data.Text as T import Safe (maximumDef) import Text.Printf import qualified Data.Map as M import Hledger.Data.Types import Hledger.Data.Commodity import Hledger.Utils deriving instance Show MarketPrice ------------------------------------------------------------------------------- -- Amount styles -- | Default amount style amountstyle = AmountStyle L False 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=NoPrice, astyle=amountstyle, amultiplier=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=2, ascommodityside=R}} usd n = amount{acommodity="$", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}} eur n = amount{acommodity="€", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}} gbp n = amount{acommodity="£", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}} amt `at` priceamt = amt{aprice=UnitPrice priceamt} amt @@ priceamt = amt{aprice=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=NoPrice} -- | Convert an amount to the commodity of its assigned price, if any. 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 not currently enforced costOfAmount :: Amount -> Amount costOfAmount a@Amount{aquantity=q, aprice=price} = case price of NoPrice -> a UnitPrice p@Amount{aquantity=pq} -> p{aquantity=pq * q} 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=TotalPrice pa@Amount{aquantity=pq, astyle=ps@AmountStyle{asprecision=pp}}} = a{aprice = UnitPrice pa{aquantity=abs (pq/q), astyle=ps{asprecision=pp+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 digits = "123456789" :: String -- | Does this amount appear to be zero when displayed with its given precision ? isZeroAmount :: Amount -> Bool isZeroAmount -- a==missingamt = False = not . any (`elem` digits) . showAmountWithoutPriceOrCommodity -- | Is this amount "really" zero, regardless of the display precision ? isReallyZeroAmount :: Amount -> Bool isReallyZeroAmount 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 :: Int -> Amount -> String showAmountWithPrecision p = showAmount . setAmountPrecision p -- | Set an amount's display precision. setAmountPrecision :: Int -> Amount -> Amount setAmountPrecision p a@Amount{astyle=s} = a{astyle=s{asprecision=p}} -- | Set an amount's display precision, flipped. withPrecision :: Amount -> Int -> Amount withPrecision = flip setAmountPrecision -- | 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) (showPriceDebug aprice) (show astyle) -- | Get the string representation of an amount, without any \@ price. showAmountWithoutPrice :: Amount -> String showAmountWithoutPrice a = showAmount a{aprice=NoPrice} -- | 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 :: Int -> Amount -> Amount setAmountInternalPrecision p a@Amount{ aquantity=q, astyle=s } = a{ astyle=s{asprecision=p} ,aquantity=roundTo (fromIntegral p) q } -- | Set an amount's internal precision, flipped. -- Intended only for internal use, eg when comparing amounts in tests. withInternalPrecision :: Amount -> Int -> 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 -- | Colour version. cshowAmountWithoutPrice :: Amount -> String cshowAmountWithoutPrice a = cshowAmount a{aprice=NoPrice} -- | Get the string representation of an amount, without any price or commodity symbol. showAmountWithoutPriceOrCommodity :: Amount -> String showAmountWithoutPriceOrCommodity a = showAmount a{acommodity="", aprice=NoPrice} showPrice :: Price -> String showPrice NoPrice = "" showPrice (UnitPrice pa) = " @ " ++ showAmount pa showPrice (TotalPrice pa) = " @@ " ++ showAmount pa showPriceDebug :: Price -> String showPriceDebug NoPrice = "" showPriceDebug (UnitPrice pa) = " @ " ++ showAmountDebug pa showPriceDebug (TotalPrice pa) = " @@ " ++ showAmountDebug pa -- | Given a map of standard amount 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 -- | 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=p, 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 displayingzero = not (any (`elem` digits) quantity) (quantity',c') | displayingzero && not showzerocommodity = ("0","") | otherwise = (quantity, quoteCommoditySymbolIfNeeded c) space = if not (T.null c') && ascommodityspaced then " " else "" :: String price = showPrice p -- | 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 Amount{aquantity=q, astyle=AmountStyle{asprecision=p, asdecimalpoint=mdec, asdigitgroups=mgrps}} = punctuatenumber (fromMaybe '.' mdec) mgrps qstr where -- isint n = fromIntegral (round n) == n qstr -- p == maxprecision && isint q = printf "%d" (round q::Integer) | p == maxprecisionwithpoint = show q | p == maxprecision = chopdotzero $ show q | otherwise = show $ roundTo (fromIntegral p) q -- | Replace a number string's decimal point with the specified character, -- and add the specified digit group separators. 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 | length s <= g = s | otherwise = let (part,rest) = splitAt g s in part ++ [c] ++ addseps gs rest repeatLast [] = [] repeatLast gs = init gs ++ repeat (last gs) chopdotzero str = reverse $ case reverse str of '0':'.':s -> s s -> s -- | For rendering: a special precision value which means show all available digits. maxprecision :: Int maxprecision = 999998 -- | For rendering: a special precision value which forces display of a decimal point. maxprecisionwithpoint :: Int maxprecisionwithpoint = 999999 -- 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 -- | Find the market value of this amount on the given date, in it's -- default valuation commodity, based on recorded market prices. -- If no default valuation commodity can be found, the amount is left -- unchanged. amountValue :: Journal -> Day -> Amount -> Amount amountValue j d a = case commodityValue j d (acommodity a) of Just v -> v{aquantity=aquantity v * aquantity a} Nothing -> a -- This is here not in Commodity.hs to use the Amount Show instance above for debugging. -- | Find the market value, if known, of one unit of this commodity (A) on -- the given valuation date, in the commodity (B) mentioned in the latest -- applicable market price. The latest applicable market price is the market -- price directive for commodity A with the latest date that is on or before -- the valuation date; or if there are multiple such prices with the same date, -- the last parsed. commodityValue :: Journal -> Day -> CommoditySymbol -> Maybe Amount commodityValue j valuationdate c | null applicableprices = dbg Nothing | otherwise = dbg $ Just $ mpamount $ last applicableprices where dbg = dbg8 ("using market price for "++T.unpack c) applicableprices = [p | p <- sortBy (comparing mpdate) $ jmarketprices j , mpcommodity p == c , mpdate p <= valuationdate ] ------------------------------------------------------------------------------- -- 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" 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 = case filter (/= "") (map acommodity zeros) of _:_ -> last zeros _ -> nullamt (zeros, nonzeros) = partition isReallyZeroAmount $ 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=NoPrice} Amount{aprice=NoPrice} = True combinableprices Amount{aprice=UnitPrice p1} Amount{aprice=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 -- | 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 a mixed amount's component amounts to the commodity of their -- assigned price, if any. costOfMixedAmount :: MixedAmount -> MixedAmount costOfMixedAmount (Mixed as) = Mixed $ map costOfAmount 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 it can be normalised to a single commodity ? isNegativeMixedAmount :: MixedAmount -> Maybe Bool isNegativeMixedAmount m = case as of [a] -> Just $ isNegativeAmount a _ -> Nothing where as = amounts $ normaliseMixedAmountSquashPricesForDisplay m -- | Does this mixed amount appear to be zero when displayed with its given precision ? isZeroMixedAmount :: MixedAmount -> Bool isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmountSquashPricesForDisplay -- | Is this mixed amount "really" zero ? See isReallyZeroAmount. isReallyZeroMixedAmount :: MixedAmount -> Bool isReallyZeroMixedAmount = all isReallyZeroAmount . amounts . normaliseMixedAmountSquashPricesForDisplay -- | Is this mixed amount "really" zero, after converting to cost -- commodities where possible ? isReallyZeroMixedAmountCost :: MixedAmount -> Bool isReallyZeroMixedAmountCost = isReallyZeroMixedAmount . costOfMixedAmount -- -- | 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' || (isZeroMixedAmount a' && isZeroMixedAmount b') -- where a' = normaliseMixedAmountSquashPricesForDisplay a -- b' = normaliseMixedAmountSquashPricesForDisplay b -- | Given a map of standard amount display styles, apply the appropriate ones 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 :: Int -> 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 :: Int -> 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. showMixedAmountWithoutPrice :: MixedAmount -> String showMixedAmountWithoutPrice m = intercalate "\n" $ map showamt as where Mixed as = normaliseMixedAmountSquashPricesForDisplay $ mixedAmountStripPrices m showamt = printf (printf "%%%ds" width) . showAmountWithoutPrice where width = maximumDef 0 $ map (length . showAmount) as -- | Colour version of showMixedAmountWithoutPrice. Any individual Amount -- which is negative is wrapped in ANSI codes to make it display in red. cshowMixedAmountWithoutPrice :: MixedAmount -> String cshowMixedAmountWithoutPrice m = intercalate "\n" $ map showamt as where Mixed as = normaliseMixedAmountSquashPricesForDisplay $ mixedAmountStripPrices m showamt a = (if isNegativeAmount a then color Dull Red else id) $ printf (printf "%%%ds" width) $ showAmountWithoutPrice a where width = maximumDef 0 $ map (length . showAmount) as mixedAmountStripPrices :: MixedAmount -> MixedAmount mixedAmountStripPrices (Mixed as) = Mixed $ map (\a -> a{aprice=NoPrice}) as -- | Get the one-line string representation of a mixed amount, but without -- any \@ prices. showMixedAmountOneLineWithoutPrice :: MixedAmount -> String showMixedAmountOneLineWithoutPrice m = intercalate ", " $ map showAmountWithoutPrice as where (Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=NoPrice} -- | Colour version. cshowMixedAmountOneLineWithoutPrice :: MixedAmount -> String cshowMixedAmountOneLineWithoutPrice m = intercalate ", " $ map cshowAmountWithoutPrice as where (Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=NoPrice} -- | 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 mixedAmountValue :: Journal -> Day -> MixedAmount -> MixedAmount mixedAmountValue j d (Mixed as) = Mixed $ map (amountValue j d) 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" [ tests "costOfAmount" [ costOfAmount (eur 1) `is` eur 1 ,costOfAmount (eur 2){aprice=UnitPrice $ usd 2} `is` usd 4 ,costOfAmount (eur 1){aprice=TotalPrice $ usd 2} `is` usd 2 ,costOfAmount (eur (-1)){aprice=TotalPrice $ usd 2} `is` usd (-2) ] ,tests "isZeroAmount" [ expect $ isZeroAmount amount ,expect $ isZeroAmount $ usd 0 ] ,tests "negating amounts" [ negate (usd 1) `is` (usd 1){aquantity= -1} ,let b = (usd 1){aprice=UnitPrice $ eur 2} in negate b `is` b{aquantity= -1} ] ,tests "adding amounts without prices" [ (usd 1.23 + usd (-1.23)) `is` usd 0 ,(usd 1.23 + usd (-1.23)) `is` usd 0 ,(usd (-1.23) + usd (-1.23)) `is` usd (-2.46) ,sum [usd 1.23,usd (-1.23),usd (-1.23),-(usd (-1.23))] `is` usd 0 -- highest precision is preserved ,asprecision (astyle $ sum [usd 1 `withPrecision` 1, usd 1 `withPrecision` 3]) `is` 3 ,asprecision (astyle $ sum [usd 1 `withPrecision` 3, usd 1 `withPrecision` 1]) `is` 3 -- adding different commodities assumes conversion rate 1 ,expect $ isZeroAmount (usd 1.23 - eur 1.23) ] ,tests "showAmount" [ showAmount (usd 0 + gbp 0) `is` "0" ] ] ,tests "MixedAmount" [ tests "adding mixed amounts to zero, the commodity and amount style are preserved" [ sum (map (Mixed . (:[])) [usd 1.25 ,usd (-1) `withPrecision` 3 ,usd (-0.25) ]) `is` Mixed [usd 0 `withPrecision` 3] ] ,tests "adding mixed amounts with total prices" [ sum (map (Mixed . (:[])) [usd 1 @@ eur 1 ,usd (-2) @@ eur 1 ]) `is` Mixed [usd 1 @@ eur 1 ,usd (-2) @@ eur 1 ] ] ,tests "showMixedAmount" [ showMixedAmount (Mixed [usd 1]) `is` "$1.00" ,showMixedAmount (Mixed [usd 1 `at` eur 2]) `is` "$1.00 @ €2.00" ,showMixedAmount (Mixed [usd 0]) `is` "0" ,showMixedAmount (Mixed []) `is` "0" ,showMixedAmount missingmixedamt `is` "" ] ,tests "showMixedAmountWithoutPrice" $ let a = usd 1 `at` eur 2 in [ showMixedAmountWithoutPrice (Mixed [a]) `is` "$1.00" ,showMixedAmountWithoutPrice (Mixed [a, -a]) `is` "0" ] ,tests "normaliseMixedAmount" [ test "a missing amount overrides any other amounts" $ normaliseMixedAmount (Mixed [usd 1, missingamt]) `is` missingmixedamt ,test "unpriced same-commodity amounts are combined" $ normaliseMixedAmount (Mixed [usd 0, usd 2]) `is` Mixed [usd 2] ,test "amounts with same unit price are combined" $ normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) `is` 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]) `is` 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]) `is` Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1] ] ,tests "normaliseMixedAmountSquashPricesForDisplay" [ normaliseMixedAmountSquashPricesForDisplay (Mixed []) `is` Mixed [nullamt] ,expect $ isZeroMixedAmount $ normaliseMixedAmountSquashPricesForDisplay (Mixed [usd 10 ,usd 10 @@ eur 7 ,usd (-10) ,usd (-10) @@ eur 7 ]) ] ] ] hledger-lib-1.12/Hledger/Data/Commodity.hs0000644000000000000000000000464713372610345016543 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 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 nonsimplecommoditychars = "0123456789-+.@*;\n \"{}=" :: [Char] isNonsimpleCommodityChar :: Char -> Bool isNonsimpleCommodityChar c = isDigit c || c `textElem` otherChars where otherChars = "-+.@*;\n \"{}=" :: T.Text textElem = T.any . (==) 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") (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.12/Hledger/Data/Dates.hs0000644000000000000000000012154013401044253015617 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# 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, parsedate, showDate, showDateSpan, showDateSpanMonthAbbrev, elapsedSeconds, prevday, periodexprp, parsePeriodExpr, parsePeriodExpr', nulldatespan, emptydatespan, failIfInvalidYear, failIfInvalidMonth, failIfInvalidDay, datesepchar, datesepchars, isDateSepChar, spanStart, spanEnd, spansSpan, spanIntersect, spansIntersect, spanIntervalIntersect, spanDefaultsFrom, spanUnion, spansUnion, smartdate, splitSpan, fixSmartDate, fixSmartDateStr, fixSmartDateStrEither, fixSmartDateStrEither', daysInSpan, maybePeriod, mkdatespan, ) where import Prelude () import "base-compat-batteries" Prelude.Compat import Control.Applicative.Permutations import Control.Monad import "base-compat-batteries" Data.List.Compat import Data.Default import Data.Maybe import Data.Text (Text) import qualified Data.Text as T #if MIN_VERSION_time(1,5,0) import Data.Time.Format hiding (months) #else import Data.Time.Format import System.Locale (TimeLocale, defaultTimeLocale) #endif import Data.Time.Calendar import Data.Time.Calendar.OrdinalDate import Data.Time.Clock import Data.Time.LocalTime import Safe (headMay, lastMay, readMay) import Text.Megaparsec import Text.Megaparsec.Char 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 = formatTime defaultTimeLocale "%0C%y/%m/%d" -- | 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 = do t <- getZonedTime return $ localDay (zonedTimeToLocalTime t) -- | Get the current local month number. getCurrentMonth :: IO Int getCurrentMonth = do (_,m,_) <- toGregorian `fmap` getCurrentDay return m -- | Get the current local year. getCurrentYear :: IO Integer getCurrentYear = do (y,_,_) <- toGregorian `fmap` getCurrentDay return y 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 -- 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 d1 d2 = splitSpan i $ mkdatespan d1 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" -- | 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 s = case daysInSpan s of Just n -> n < 1 Nothing -> 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: -- >>> mkdatespan "2018-01-01" "2018-01-03" `spanIntersect` mkdatespan "2018-01-03" "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 -- | Calculate the intersection of two DateSpans, adjusting the start date so -- the interval is preserved. -- -- >>> let intervalIntersect = spanIntervalIntersect (Days 3) -- >>> mkdatespan "2018-01-01" "2018-01-03" `intervalIntersect` mkdatespan "2018-01-01" "2018-01-05" -- DateSpan 2018/01/01-2018/01/02 -- >>> mkdatespan "2018-01-01" "2018-01-05" `intervalIntersect` mkdatespan "2018-01-02" "2018-01-05" -- DateSpan 2018/01/04 -- >>> mkdatespan "2018-01-01" "2018-01-05" `intervalIntersect` mkdatespan "2018-01-03" "2018-01-05" -- DateSpan 2018/01/04 -- >>> mkdatespan "2018-01-01" "2018-01-05" `intervalIntersect` mkdatespan "2018-01-04" "2018-01-05" -- DateSpan 2018/01/04 -- >>> mkdatespan "2018-01-01" "2018-01-05" `intervalIntersect` mkdatespan "2017-12-01" "2018-01-05" -- DateSpan 2018/01/01-2018/01/04 spanIntervalIntersect :: Interval -> DateSpan -> DateSpan -> DateSpan spanIntervalIntersect (Days n) (DateSpan (Just b1) e1) sp2@(DateSpan (Just b2) _) = DateSpan (Just b) e1 `spanIntersect` sp2 where b = if b1 < b2 then addDays (diffDays b1 b2 `mod` toInteger n) b2 else b1 spanIntervalIntersect _ sp1 sp2 = sp1 `spanIntersect` sp2 -- | 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 -- | 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 $ 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 ("","","today") = (refdate, nextday refdate) span ("","this","day") = (refdate, nextday refdate) span ("","","yesterday") = (prevday refdate, refdate) span ("","last","day") = (prevday refdate, refdate) span ("","","tomorrow") = (nextday refdate, addDays 2 refdate) span ("","next","day") = (nextday refdate, addDays 2 refdate) span ("","last","week") = (prevweek refdate, thisweek refdate) span ("","this","week") = (thisweek refdate, nextweek refdate) span ("","next","week") = (nextweek refdate, startofweek $ addDays 14 refdate) span ("","last","month") = (prevmonth refdate, thismonth refdate) span ("","this","month") = (thismonth refdate, nextmonth refdate) span ("","next","month") = (nextmonth refdate, startofmonth $ addGregorianMonthsClip 2 refdate) span ("","last","quarter") = (prevquarter refdate, thisquarter refdate) span ("","this","quarter") = (thisquarter refdate, nextquarter refdate) span ("","next","quarter") = (nextquarter refdate, startofquarter $ addGregorianMonthsClip 6 refdate) span ("","last","year") = (prevyear refdate, thisyear refdate) span ("","this","year") = (thisyear refdate, nextyear refdate) span ("","next","year") = (nextyear refdate, startofyear $ addGregorianYearsClip 2 refdate) span ("","",d) = (day, nextday day) where day = fromGregorian ry rm (read d) span ("",m,"") = (startofmonth day, nextmonth day) where day = fromGregorian ry (read m) 1 span ("",m,d) = (day, nextday day) where day = fromGregorian ry (read m) (read d) span (y,"","") = (startofyear day, nextyear day) where day = fromGregorian (read y) 1 1 span (y,m,"") = (startofmonth day, nextmonth day) where day = fromGregorian (read y) (read m) 1 span (y,m,d) = (day, nextday day) where day = fromGregorian (read y) (read m) (read d) -- 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 (\e->error' $ printf "could not parse date %s %s" (show s) (show e)) id $ (fixSmartDateStrEither d s :: Either (ParseErrorBundle Text CustomErr) String) -- | A safe version of fixSmartDateStr. fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) String fixSmartDateStrEither d = either Left (Right . 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 (parsedate "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 sdate = fix sdate where fix :: SmartDate -> Day fix ("","","today") = fromGregorian ry rm rd fix ("","this","day") = fromGregorian ry rm rd fix ("","","yesterday") = prevday refdate fix ("","last","day") = prevday refdate fix ("","","tomorrow") = nextday refdate fix ("","next","day") = nextday refdate fix ("","last","week") = prevweek refdate fix ("","this","week") = thisweek refdate fix ("","next","week") = nextweek refdate fix ("","last","month") = prevmonth refdate fix ("","this","month") = thismonth refdate fix ("","next","month") = nextmonth refdate fix ("","last","quarter") = prevquarter refdate fix ("","this","quarter") = thisquarter refdate fix ("","next","quarter") = nextquarter refdate fix ("","last","year") = prevyear refdate fix ("","this","year") = thisyear refdate fix ("","next","year") = nextyear refdate fix ("","",d) = fromGregorian ry rm (read d) fix ("",m,"") = fromGregorian ry (read m) 1 fix ("",m,d) = fromGregorian ry (read m) (read d) fix (y,"","") = fromGregorian (read y) 1 1 fix (y,m,"") = fromGregorian (read y) (read m) 1 fix (y,m,d) = fromGregorian (read y) (read m) (read d) (ry,rm,rd) = 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 = parsedate "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 | not (validMonth $ show m) = error' $ "nthdayofyearcontaining: invalid month "++show m | not (validDay $ show md) = error' $ "nthdayofyearcontaining: invalid day " ++show md | mmddOfSameYear <= date = mmddOfSameYear | otherwise = mmddOfPrevYear where mmddOfSameYear = addDays (fromIntegral md-1) $ applyN (m-1) nextmonth s mmddOfPrevYear = addDays (fromIntegral 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 = parsedate "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 | not (validDay $ show 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 = parsedate "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 (fromIntegral n-1) s nthOfPrevWeek = addDays (fromIntegral 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 = parsedate "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 advancetonthweekday :: Int -> WeekDay -> Day -> Day advancetonthweekday n wd s = maybe err (addWeeks (n-1)) $ firstMatch (>=s) $ iterate (addWeeks 1) $ firstweekday s where err = error' "advancetonthweekday: should not happen" addWeeks k = addDays (7 * fromIntegral k) firstMatch p = headMay . dropWhile (not . p) firstweekday = addDays (fromIntegral wd-1) . startofweek ---------------------------------------------------------------------- -- parsing -- -- | Parse a couple of date-time string formats to a time type. -- parsedatetimeM :: String -> Maybe LocalTime -- parsedatetimeM s = firstJust [ -- parseTime defaultTimeLocale "%Y/%m/%d %H:%M:%S" s, -- parseTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" s -- ] parsetime :: ParseTime t => TimeLocale -> String -> String -> Maybe t parsetime = #if MIN_VERSION_time(1,5,0) parseTimeM True #else parseTime #endif -- | Parse a couple of date string formats to a time type. parsedateM :: String -> Maybe Day parsedateM s = firstJust [ parsetime defaultTimeLocale "%Y/%m/%d" s, parsetime defaultTimeLocale "%Y-%m-%d" s ] -- -- | Parse a date-time string to a time type, or raise an error. -- parsedatetime :: String -> LocalTime -- parsedatetime s = fromMaybe (error' $ "could not parse timestamp \"" ++ s ++ "\"") -- (parsedatetimeM s) -- | Parse a YYYY-MM-DD or YYYY/MM/DD date string to a Day, or raise an error. For testing/debugging. -- -- >>> parsedate "2008/02/03" -- 2008-02-03 parsedate :: String -> Day parsedate s = fromMaybe (error' $ "could not parse date \"" ++ s ++ "\"") (parsedateM s) -- doctests I haven't been able to make compatible with both GHC 7 and 8 -- -- >>> parsedate "2008/02/03/" -- -- *** Exception: could not parse date "2008/02/03/" -- #if MIN_VERSION_base(4,9,0) -- -- ... -- #endif -- #if MIN_VERSION_time(1,6,0) -- -- >>> parsedate "2008/02/30" -- with time >= 1.6, invalid dates are rejected -- -- *** Exception: could not parse date "2008/02/30" -- #if MIN_VERSION_base(4,9,0) -- -- ... -- #endif -- #else -- -- >>> parsedate "2008/02/30" -- with time < 1.6, they are silently adjusted -- -- 2008-02-29 -- #endif {-| 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 ("2018","12","01") YYYYMM is parsed as year-month-01 if year and month are valid: >>> parsewith (smartdate <* eof) "201804" Right ("2018","04","01") With an invalid month, it's parsed as a year: >>> parsewith (smartdate <* eof) "201813" Right ("201813","","") 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 ("201813012","","") -} smartdate :: TextParser m SmartDate smartdate = do -- XXX maybe obscures date errors ? see ledgerdate (y,m,d) <- choice' [yyyymmdd, yyyymm, ymd, ym, md, y, d, month, mon, today, yesterday, tomorrow, lastthisnextthing] return (y,m,d) -- | Like smartdate, but there must be nothing other than whitespace after the date. smartdateonly :: TextParser m SmartDate smartdateonly = do d <- smartdate skipMany spacenonewline eof return d datesepchars :: [Char] datesepchars = "/-." datesepchar :: TextParser m Char datesepchar = satisfy isDateSepChar isDateSepChar :: Char -> Bool isDateSepChar c = c == '/' || c == '-' || c == '.' validYear, validMonth, validDay :: String -> Bool validYear s = length s >= 4 && isJust (readMay s :: Maybe Year) validMonth s = maybe False (\n -> n>=1 && n<=12) $ readMay s validDay s = maybe False (\n -> n>=1 && n<=31) $ readMay s failIfInvalidYear, failIfInvalidMonth, failIfInvalidDay :: (Monad m) => String -> m () failIfInvalidYear s = unless (validYear s) $ fail $ "bad year number: " ++ s failIfInvalidMonth s = unless (validMonth s) $ fail $ "bad month number: " ++ s failIfInvalidDay s = unless (validDay s) $ fail $ "bad day number: " ++ s yyyymmdd :: TextParser m SmartDate yyyymmdd = do y <- count 4 digitChar m <- count 2 digitChar failIfInvalidMonth m d <- count 2 digitChar failIfInvalidDay d return (y,m,d) yyyymm :: TextParser m SmartDate yyyymm = do y <- count 4 digitChar m <- count 2 digitChar failIfInvalidMonth m return (y,m,"01") ymd :: TextParser m SmartDate ymd = do y <- some digitChar failIfInvalidYear y sep <- datesepchar m <- some digitChar failIfInvalidMonth m char sep d <- some digitChar failIfInvalidDay d return $ (y,m,d) ym :: TextParser m SmartDate ym = do y <- some digitChar failIfInvalidYear y datesepchar m <- some digitChar failIfInvalidMonth m return (y,m,"") y :: TextParser m SmartDate y = do y <- some digitChar failIfInvalidYear y return (y,"","") d :: TextParser m SmartDate d = do d <- some digitChar failIfInvalidDay d return ("","",d) md :: TextParser m SmartDate md = do m <- some digitChar failIfInvalidMonth m datesepchar d <- some digitChar failIfInvalidDay d return ("",m,d) -- 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"] -- | Convert a case insensitive english month name to a month number. monthIndex name = maybe 0 (+1) $ T.toLower name `elemIndex` months -- | Convert a case insensitive english three-letter month abbreviation to a month number. monIndex name = maybe 0 (+1) $ T.toLower name `elemIndex` monthabbrevs month :: TextParser m SmartDate month = do m <- choice $ map (try . string') months let i = monthIndex m return ("",show i,"") mon :: TextParser m SmartDate mon = do m <- choice $ map (try . string') monthabbrevs let i = monIndex m return ("",show i,"") 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 $ "weekday: should not happen: attempted to find " <> show wday <> " in " <> show (weekdays ++ weekdayabbrevs) today,yesterday,tomorrow :: TextParser m SmartDate today = string' "today" >> return ("","","today") yesterday = string' "yesterday" >> return ("","","yesterday") tomorrow = string' "tomorrow" >> return ("","","tomorrow") lastthisnextthing :: TextParser m SmartDate lastthisnextthing = do r <- choice $ map string' [ "last" ,"this" ,"next" ] skipMany spacenonewline -- make the space optional for easier scripting p <- choice $ map string' [ "day" ,"week" ,"month" ,"quarter" ,"year" ] -- XXX support these in fixSmartDate -- ++ (map string' $ months ++ monthabbrevs ++ weekdays ++ weekdayabbrevs) return ("", T.unpack r, T.unpack p) -- | -- >>> let p = parsePeriodExpr (parsedate "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 "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 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 skipMany spacenonewline choice $ map try [ intervalanddateperiodexprp rdate, (,) NoInterval <$> periodexprdatespanp rdate ] intervalanddateperiodexprp :: Day -> TextParser m (Interval, DateSpan) intervalanddateperiodexprp rdate = do i <- reportingintervalp s <- option def . try $ do skipMany spacenonewline 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, do string' "biweekly" return $ Weeks 2, do string' "bimonthly" return $ Months 2, do string' "every" skipMany spacenonewline n <- nth skipMany spacenonewline string' "day" of_ "week" return $ DayOfWeek n, do string' "every" skipMany spacenonewline n <- weekday return $ DayOfWeek n, do string' "every" skipMany spacenonewline n <- nth skipMany spacenonewline string' "day" optOf_ "month" return $ DayOfMonth n, do string' "every" let mnth = choice' [month, mon] >>= \(_,m,_) -> return (read m) d_o_y <- runPermutation $ DayOfYear <$> toPermutation (try (skipMany spacenonewline *> mnth)) <*> toPermutation (try (skipMany spacenonewline *> nth)) optOf_ "year" return d_o_y, do string' "every" skipMany spacenonewline ("",m,d) <- md optOf_ "year" return $ DayOfYear (read m) (read d), do string' "every" skipMany spacenonewline n <- nth skipMany spacenonewline wd <- weekday optOf_ "month" return $ WeekdayOfMonth n wd ] where of_ period = do skipMany spacenonewline string' "of" skipMany spacenonewline string' period optOf_ period = optional $ try $ of_ period nth = do n <- some digitChar choice' $ map string' ["st","nd","rd","th"] return $ read n -- 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 = choice' [ do string' compact' return $ intcons 1, do string' "every" skipMany spacenonewline string' singular' return $ intcons 1, do string' "every" skipMany spacenonewline n <- fmap read $ some digitChar skipMany spacenonewline string' plural' return $ intcons n ] 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, fromdatespanp rdate, todatespanp rdate, justdatespanp rdate ] -- | -- -- >>> parsewith (doubledatespan (parsedate "2018/01/01") <* eof) "20180101-201804" -- Right DateSpan 2018/01/01-2018/04/01 doubledatespanp :: Day -> TextParser m DateSpan doubledatespanp rdate = do optional (string' "from" >> skipMany spacenonewline) b <- smartdate skipMany spacenonewline optional (choice [string' "to", string' "-"] >> skipMany spacenonewline) e <- smartdate return $ DateSpan (Just $ fixSmartDate rdate b) (Just $ fixSmartDate rdate e) fromdatespanp :: Day -> TextParser m DateSpan fromdatespanp rdate = do b <- choice [ do string' "from" >> skipMany spacenonewline smartdate , do d <- smartdate string' "-" return d ] return $ DateSpan (Just $ fixSmartDate rdate b) Nothing todatespanp :: Day -> TextParser m DateSpan todatespanp rdate = do choice [string' "to", string' "-"] >> skipMany spacenonewline e <- smartdate return $ DateSpan Nothing (Just $ fixSmartDate rdate e) justdatespanp :: Day -> TextParser m DateSpan justdatespanp rdate = do optional (string' "in" >> skipMany spacenonewline) d <- smartdate return $ spanFromSmartDate rdate d -- | Make a datespan from two valid date strings parseable by parsedate -- (or raise an error). Eg: mkdatespan \"2011/1/1\" \"2011/12/31\". mkdatespan :: String -> String -> DateSpan mkdatespan b = DateSpan (Just $ parsedate b) . Just . parsedate 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.12/Hledger/Data/Journal.hs0000644000000000000000000014462413401047234016203 0ustar0000000000000000{-# LANGUAGE Rank2Types #-} {-# LANGUAGE StandaloneDeriving, OverloadedStrings #-} {-# LANGUAGE CPP #-} {-| 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 addMarketPrice, addTransactionModifier, addPeriodicTransaction, addTransaction, journalBalanceTransactions, journalApplyCommodityStyles, commodityStylesFromAmounts, journalCommodityStyles, journalConvertAmountsToCost, journalReverse, journalSetLastReadTime, journalPivot, -- * Filtering filterJournalTransactions, filterJournalPostings, filterJournalAmounts, filterTransactionAmounts, filterTransactionPostings, filterPostingAmount, -- * Querying journalAccountNamesUsed, journalAccountNamesImplied, journalAccountNamesDeclared, journalAccountNamesDeclaredOrUsed, journalAccountNamesDeclaredOrImplied, journalAccountNames, -- journalAmountAndPriceCommodities, journalAmounts, overJournalAmounts, traverseJournalAmounts, -- journalCanonicalCommodities, journalDateSpan, journalDescriptions, journalFilePath, journalFilePaths, journalTransactionAt, journalNextTransaction, journalPrevTransaction, journalPostings, -- * Standard account types journalBalanceSheetAccountQuery, journalProfitAndLossAccountQuery, journalRevenueAccountQuery, journalExpenseAccountQuery, journalAssetAccountQuery, journalLiabilityAccountQuery, journalEquityAccountQuery, journalCashAccountQuery, -- * Misc canonicalStyleFrom, matchpats, nulljournal, journalCheckBalanceAssertions, journalNumberAndTieTransactions, journalUntieTransactions, -- * Tests samplejournal, tests_Journal, ) where import Control.Applicative (Const(..)) import Control.Arrow import Control.Monad import Control.Monad.Except import qualified Control.Monad.Reader as R import Control.Monad.ST import Data.Array.ST import Data.Functor.Identity (Identity(..)) import qualified Data.HashTable.ST.Cuckoo as HT import Data.List import Data.List.Extra (groupSort) import Data.Maybe #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif import Data.Ord import qualified Data.Semigroup as Sem 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 qualified Data.Map as M import qualified Data.Set as S 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.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 $ jmarketprices j -- ,show $ jfinalcommentlines j -- ,show $ jparsestate j -- ,show $ map fst $ jfiles j -- ] -- The monoid 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. -- instance Sem.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 ,jmarketprices = jmarketprices j1 <> jmarketprices 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 Monoid Journal where mempty = nulljournal #if !(MIN_VERSION_base(4,11,0)) -- This is redundant starting with base-4.11 / GHC 8.4. mappend = (Sem.<>) #endif nulljournal :: Journal nulljournal = Journal { jparsedefaultyear = Nothing ,jparsedefaultcommodity = Nothing ,jparseparentaccounts = [] ,jparsealiases = [] -- ,jparsetransactioncount = 0 ,jparsetimeclockentries = [] ,jincludefilestack = [] ,jdeclaredaccounts = [] ,jdeclaredaccounttypes = M.empty ,jcommodities = M.empty ,jinferredcommodities = M.empty ,jmarketprices = [] ,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 } addMarketPrice :: MarketPrice -> Journal -> Journal addMarketPrice h j = j { jmarketprices = h : jmarketprices j } -- | 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 = nub . sort . 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 = nub . sort . jdeclaredaccounts -- | Sorted unique account names declared by account directives or posted to -- by transactions in this journal. journalAccountNamesDeclaredOrUsed :: Journal -> [AccountName] journalAccountNamesDeclaredOrUsed j = nub $ sort $ 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 = nub $ sort $ 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 -- | Get a query for accounts of a certain type (Asset, Liability..) in this journal. -- The query will match all accounts which were declared as that type by account directives, -- plus all their subaccounts which have not been declared as a different type. -- If no accounts were declared as this type, the query will instead match accounts -- with names matched by the provided case-insensitive regular expression. journalAccountTypeQuery :: AccountType -> Regexp -> Journal -> Query journalAccountTypeQuery atype fallbackregex j = case M.lookup atype (jdeclaredaccounttypes j) of Nothing -> Acct fallbackregex Just as -> -- 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. And [ Or $ map (Acct . accountNameToAccountRegex) as ,Not $ Or $ map (Acct . accountNameToAccountRegex) differentlytypedsubs ] where differentlytypedsubs = concat [subs | (t,bs) <- M.toList (jdeclaredaccounttypes j) , t /= atype , let subs = [b | b <- bs, any (`isAccountNamePrefixOf` b) as] ] -- | A query for accounts in this journal which have been -- declared as Asset by account directives, or otherwise for -- accounts with names matched by the case-insensitive regular expression -- @^assets?(:|$)@. journalAssetAccountQuery :: Journal -> Query journalAssetAccountQuery = journalAccountTypeQuery Asset "^assets?(:|$)" -- | 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 "^(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 "^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 "^(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 -- @^(income|revenue)s?(:|$)@. journalExpenseAccountQuery :: Journal -> Query journalExpenseAccountQuery = journalAccountTypeQuery Expense "^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 ] -- | A query for Cash (-equivalent) accounts in this journal (ie, -- accounts which appear on the cashflow statement.) This is currently -- hard-coded to be all the Asset accounts except for those with names -- containing the case-insensitive regular expression @(receivable|:A/R|:fixed)@. journalCashAccountQuery :: Journal -> Query journalCashAccountQuery j = And [journalAssetAccountQuery j, Not $ Acct "(receivable|:A/R|:fixed)"] -- 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} {- ------------------------------------------------------------------------------- -- 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 parsed data to normal order. This is used for post-parse -- processing, since data is added to the head of the list during -- parsing. 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 ,jmarketprices = reverse $ jmarketprices 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} -- | Check any balance assertions in the journal and return an error -- message if any of them fail. journalCheckBalanceAssertions :: Journal -> Either String Journal journalCheckBalanceAssertions j = runST $ journalBalanceTransactionsST True j (return ()) (\_ _ -> return ()) (const $ return j) -- | Check a posting's balance assertion and return an error if it -- fails. checkBalanceAssertion :: Posting -> MixedAmount -> Either String () checkBalanceAssertion p@Posting{ pbalanceassertion = Just ass } bal = foldl' fold (Right ()) amts where fold (Right _) cass = checkBalanceAssertionCommodity p cass bal fold err _ = err amt = baamount ass amts = amt : if baexact ass then map (\a -> a{ aquantity = 0 }) $ amounts $ filterMixedAmount (\a -> acommodity a /= assertedcomm) bal else [] assertedcomm = acommodity amt checkBalanceAssertion _ _ = Right () checkBalanceAssertionCommodity :: Posting -> Amount -> MixedAmount -> Either String () checkBalanceAssertionCommodity p amt bal | isReallyZeroAmount diff = Right () | True = Left err where assertedcomm = acommodity amt actualbal = fromMaybe nullamt $ find ((== assertedcomm) . acommodity) (amounts bal) diff = amt - actualbal diffplus | isNegativeAmount diff == False = "+" | otherwise = "" err = printf (unlines [ "balance assertion error%s", "after posting:", "%s", "balance assertion details:", "date: %s", "account: %s", "commodity: %s", "calculated: %s", "asserted: %s (difference: %s)" ]) (case ptransaction p of Nothing -> ":" -- shouldn't happen Just t -> printf " in %s:\nin transaction:\n%s" (showGenericSourcePos pos) (chomp $ showTransaction t) :: String where pos = baposition $ fromJust $ pbalanceassertion p) (showPostingLine p) (showDate $ postingDate p) (T.unpack $ paccount p) -- XXX pack assertedcomm (showAmount actualbal) (showAmount amt) (diffplus ++ showAmount diff) -- | Fill in any missing amounts and check that all journal transactions -- balance, or return an error message. This is done after parsing all -- amounts and applying canonical commodity styles, since balancing -- depends on display precision. Reports only the first error encountered. journalBalanceTransactions :: Bool -> Journal -> Either String Journal journalBalanceTransactions assrt j = runST $ journalBalanceTransactionsST assrt -- check balance assertions also ? (journalNumberTransactions j) -- journal to process (newArray_ (1, genericLength $ jtxns j) :: forall s. ST s (STArray s Integer Transaction)) -- initialise state (\arr tx -> writeArray arr (tindex tx) tx) -- update state (fmap (\txns -> j{ jtxns = txns}) . getElems) -- summarise state -- | Helper used by 'journalBalanceTransactions' and 'journalCheckBalanceAssertions'. journalBalanceTransactionsST :: Bool -> Journal -> ST s txns -- ^ initialise state -> (txns -> Transaction -> ST s ()) -- ^ update state -> (txns -> ST s a) -- ^ summarise state -> ST s (Either String a) journalBalanceTransactionsST assrt j createStore storeIn extract = runExceptT $ do bals <- lift $ HT.newSized size txStore <- lift $ createStore let env = Env bals (storeIn txStore) assrt (Just $ journalCommodityStyles j) (getModifierAccountNames j) flip R.runReaderT env $ do dated <- fmap snd . sortBy (comparing fst) . concat <$> mapM' discriminateByDate (jtxns j) mapM' checkInferAndRegisterAmounts dated lift $ extract txStore where size = genericLength $ journalPostings j -- | Collect account names in account modifiers into a set getModifierAccountNames :: Journal -> S.Set AccountName getModifierAccountNames j = S.fromList $ map paccount $ concatMap tmpostingrules $ jtxnmodifiers j -- | Monad transformer stack with a reference to a mutable hashtable -- of current account balances and a mutable array of finished -- transactions in original parsing order. type CurrentBalancesModifier s = R.ReaderT (Env s) (ExceptT String (ST s)) -- | Environment for 'CurrentBalancesModifier' data Env s = Env { eBalances :: HT.HashTable s AccountName MixedAmount , eStoreTx :: Transaction -> ST s () , eAssrt :: Bool , eStyles :: Maybe (M.Map CommoditySymbol AmountStyle) , eUnassignable :: S.Set AccountName } -- | This converts a transaction into a list of transactions or -- postings whose dates have to be considered when checking -- balance assertions and handled by 'checkInferAndRegisterAmounts'. -- -- Transaction without balance assignments can be balanced and stored -- immediately and their (possibly) dated postings are returned. -- -- Transaction with balance assignments are only supported if no -- posting has a 'pdate' value. Supported transactions will be -- returned unchanged and balanced and stored later in 'checkInferAndRegisterAmounts'. discriminateByDate :: Transaction -> CurrentBalancesModifier s [(Day, Either Posting Transaction)] discriminateByDate tx | null (assignmentPostings tx) = do styles <- R.reader $ eStyles balanced <- lift $ ExceptT $ return $ balanceTransaction styles tx storeTransaction balanced return $ fmap (postingDate &&& (Left . removePrices)) $ tpostings $ balanced | True = do when (any (isJust . pdate) $ tpostings tx) $ throwError $ unlines $ ["postings may not have both a custom date and a balance assignment." ,"Write the posting amount explicitly, or remove the posting date:\n" , showTransaction tx] return [(tdate tx, Right $ tx { tpostings = removePrices <$> tpostings tx })] -- | Throw an error if a posting is in the unassignable set. checkUnassignablePosting :: Posting -> CurrentBalancesModifier s () checkUnassignablePosting p = do unassignable <- R.asks eUnassignable if (isAssignment p && paccount p `S.member` unassignable) then throwError $ unlines $ [ "cannot assign amount to account " , "" , " " ++ (T.unpack $ paccount p) , "" , "because it is also included in transaction modifiers." ] else return () -- | This function takes an object describing changes to -- account balances on a single day - either a single posting -- (from an already balanced transaction without assignments) -- or a whole transaction with assignments (which is required to -- have no posting with pdate set). -- -- For a single posting, there is not much to do. Only add its amount -- to its account and check the assertion, if there is one. This -- functionality is provided by 'addAmountAndCheckBalance'. -- -- For a whole transaction, it loops over all postings, and performs -- 'addAmountAndCheckBalance', if there is an amount. If there is no -- amount, the amount is inferred by the assertion or left empty if -- there is no assertion. Then, the transaction is balanced, the -- inferred amount added to the balance (all in 'balanceTransactionUpdate') -- and the resulting transaction with no missing amounts is stored -- in the array, for later retrieval. -- -- Again in short: -- -- 'Left Posting': Check the balance assertion and update the -- account balance. If the amount is empty do nothing. this can be -- the case e.g. for virtual postings -- -- 'Right Transaction': Loop over all postings, infer their amounts -- and then balance and store the transaction. checkInferAndRegisterAmounts :: Either Posting Transaction -> CurrentBalancesModifier s () checkInferAndRegisterAmounts (Left p) = do checkUnassignablePosting p void $ addAmountAndCheckBalance return p checkInferAndRegisterAmounts (Right oldTx) = do let ps = tpostings oldTx mapM_ checkUnassignablePosting ps styles <- R.reader $ eStyles newPostings <- forM ps $ addAmountAndCheckBalance inferFromAssignment storeTransaction =<< balanceTransactionUpdate (fmap void . addToBalance) styles oldTx { tpostings = newPostings } where inferFromAssignment :: Posting -> CurrentBalancesModifier s Posting inferFromAssignment p = do let acc = paccount p case pbalanceassertion p of Just ba | baexact ba -> do diff <- setMixedBalance acc $ Mixed [baamount ba] fullPosting diff p Just ba | otherwise -> do old <- liftModifier $ \Env{ eBalances = bals } -> HT.lookup bals acc let amt = baamount ba assertedcomm = acommodity amt diff <- setMixedBalance acc $ Mixed [amt] + filterMixedAmount (\a -> acommodity a /= assertedcomm) (fromMaybe nullmixedamt old) fullPosting diff p Nothing -> return p fullPosting amt p = return p { pamount = amt , porigin = Just $ originalPosting p } -- | Adds a posting's amount to the posting's account balance and -- checks a possible balance assertion. Or if there is no amount, -- runs the supplied fallback action. addAmountAndCheckBalance :: (Posting -> CurrentBalancesModifier s Posting) -- ^ action if posting has no amount -> Posting -> CurrentBalancesModifier s Posting addAmountAndCheckBalance _ p | hasAmount p = do newAmt <- addToBalance (paccount p) $ pamount p assrt <- R.reader eAssrt lift $ when assrt $ ExceptT $ return $ checkBalanceAssertion p newAmt return p addAmountAndCheckBalance fallback p = fallback p -- | Sets all commodities comprising an account's balance to the given -- amounts and returns the difference from the previous balance. setMixedBalance :: AccountName -> MixedAmount -> CurrentBalancesModifier s MixedAmount setMixedBalance acc amt = liftModifier $ \Env{ eBalances = bals } -> do old <- HT.lookup bals acc HT.insert bals acc amt return $ maybe amt (amt -) old -- | Adds an amount to an account's balance and returns the resulting balance. addToBalance :: AccountName -> MixedAmount -> CurrentBalancesModifier s MixedAmount addToBalance acc amt = liftModifier $ \Env{ eBalances = bals } -> do new <- maybe amt (+ amt) <$> HT.lookup bals acc HT.insert bals acc new return new -- | Stores a transaction in the transaction array in original parsing order. storeTransaction :: Transaction -> CurrentBalancesModifier s () storeTransaction tx = liftModifier $ ($tx) . eStoreTx -- | Helper function. liftModifier :: (Env s -> ST s a) -> CurrentBalancesModifier s a liftModifier f = R.ask >>= lift . lift . f -- | Choose and apply a consistent display format to the posting -- amounts in each commodity. Each commodity's format is specified by -- a commodity format directive, or otherwise inferred from posting -- amounts as in hledger < 0.28. journalApplyCommodityStyles :: Journal -> Journal journalApplyCommodityStyles j@Journal{jtxns=ts, jmarketprices=mps} = j'' where j' = journalInferCommodityStyles j styles = journalCommodityStyles j' j'' = j'{jtxns=map fixtransaction ts, jmarketprices=map fixmarketprice mps} fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps} fixposting p@Posting{pamount=a} = p{pamount=styleMixedAmount styles a} fixmarketprice mp@MarketPrice{mpamount=a} = mp{mpamount=styleAmount styles a} -- | Get all the amount styles defined in this journal, either declared by -- a commodity directive or inferred from amounts, as a map from symbol to style. -- Styles declared by commodity directives take precedence, and these also are -- guaranteed to know their decimal point character. journalCommodityStyles :: Journal -> M.Map CommoditySymbol AmountStyle journalCommodityStyles j = declaredstyles <> inferredstyles where declaredstyles = M.mapMaybe cformat $ jcommodities 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". journalInferCommodityStyles :: Journal -> Journal journalInferCommodityStyles j = j{jinferredcommodities = commodityStylesFromAmounts $ dbg8 "journalInferCommmodityStyles using amounts" $ journalAmounts j} -- | Given a list of amounts in parse order, build a map from their commodity names -- to standard commodity display formats. commodityStylesFromAmounts :: [Amount] -> M.Map CommoditySymbol AmountStyle commodityStylesFromAmounts amts = M.fromList commstyles where commamts = groupSort [(acommodity as, as) | as <- amts] commstyles = [(c, canonicalStyleFrom $ map astyle as) | (c,as) <- commamts] -- | Given an ordered list of amount styles, choose a canonical style. -- That is: the style of the first, and the maximum precision of all. canonicalStyleFrom :: [AmountStyle] -> AmountStyle canonicalStyleFrom [] = amountstyle canonicalStyleFrom ss@(first:_) = first{asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} where mgrps = maybe Nothing Just $ headMay $ catMaybes $ map asdigitgroups ss -- precision is maximum of all precisions prec = maximumStrict $ map asprecision ss mdec = Just $ headDef '.' $ catMaybes $ map asdecimalpoint ss -- precision is that of first amount with a decimal point -- (mdec, prec) = -- case filter (isJust . asdecimalpoint) ss of -- (s:_) -> (asdecimalpoint s, asprecision s) -- [] -> (Just '.', 0) -- -- | Apply this journal's historical price records to unpriced amounts where possible. -- journalApplyMarketPrices :: Journal -> Journal -- journalApplyMarketPrices 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) $ journalMarketPriceFor 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. -- journalMarketPriceFor :: Journal -> Day -> CommoditySymbol -> Maybe MixedAmount -- journalMarketPriceFor j d CommoditySymbol{symbol=s} = do -- let ps = reverse $ filter ((<= d).mpdate) $ filter ((s==).hsymbol) $ sortBy (comparing mpdate) $ jmarketprices j -- case ps of (MarketPrice{mpamount=a}:_) -> Just a -- _ -> Nothing -- | Convert all this journal's amounts to cost by applying their prices, if any. journalConvertAmountsToCost :: Journal -> Journal journalConvertAmountsToCost j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts} where -- similar to journalApplyCommodityStyles fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps} fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a} fixmixedamount (Mixed as) = Mixed $ map fixamount as fixamount = styleAmount styles . costOfAmount 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 the amounts in this journal which will -- influence amount style canonicalisation. These are: -- -- * amounts in market price directives (in parse order) -- * amounts in postings (in parse order) -- -- Amounts in default commodity directives also influence -- canonicalisation, but earlier, as amounts are parsed. -- Amounts in posting prices are not used for canonicalisation. -- journalAmounts :: Journal -> [Amount] journalAmounts = getConst . traverseJournalAmounts (Const . (:[])) -- | Maps over all of the amounts in the journal overJournalAmounts :: (Amount -> Amount) -> Journal -> Journal overJournalAmounts f = runIdentity . traverseJournalAmounts (Identity . f) -- | Traverses over all ofthe amounts in the journal, in the order -- indicated by 'journalAmounts'. traverseJournalAmounts :: Applicative f => (Amount -> f Amount) -> Journal -> f Journal traverseJournalAmounts f j = recombine <$> (traverse . mpa) f (jmarketprices j) <*> (traverse . tp . traverse . pamt . maa . traverse) f (jtxns j) where recombine mps txns = j { jmarketprices = mps, jtxns = txns } -- a bunch of traversals mpa g mp = (\amt -> mp { mpamount = amt }) <$> g (mpamount mp) tp g t = (\ps -> t { tpostings = ps }) <$> g (tpostings t) pamt g p = (\amt -> p { pamount = amt }) <$> g (pamount p) maa 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 (catMaybes . map (if secondary then (Just . postingDate2) else pdate) . tpostings) ts ts = jtxns 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, porigin = Just $ originalPosting p} where pivotedacct | Just t <- ptransaction p, fieldortagname == "code" = tcode t | Just t <- ptransaction p, fieldortagname == "description" = tdescription t | Just t <- ptransaction p, fieldortagname == "payee" = transactionPayee t | Just t <- ptransaction p, fieldortagname == "note" = transactionNote t | Just (_, value) <- postingFindTag fieldortagname p = value | otherwise = "" postingFindTag :: TagName -> Posting -> Maybe (TagName, TagValue) postingFindTag tagname p = find ((tagname==) . fst) $ postingAllTags p -- Misc helpers -- | Check if a set of hledger account/description filter patterns matches the -- given account name or entry description. Patterns are case-insensitive -- regular expressions. Prefixed with not:, they become anti-patterns. matchpats :: [String] -> String -> Bool matchpats pats str = (null positives || any match positives) && (null negatives || not (any match negatives)) where (negatives,positives) = partition isnegativepat pats match "" = True match pat = regexMatchesCI (abspat pat) str negateprefix = "not:" isnegativepat = (negateprefix `isPrefixOf`) abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat -- 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=parsedate "2008/01/01", tdate2=Nothing, tstatus=Unmarked, tcode="", tdescription="income", tcomment="", ttags=[], tpostings= ["assets:bank:checking" `post` usd 1 ,"income:salary" `post` missingamt ], tpreceding_comment_lines="" } , txnTieKnot $ Transaction { tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2008/06/01", tdate2=Nothing, tstatus=Unmarked, tcode="", tdescription="gift", tcomment="", ttags=[], tpostings= ["assets:bank:checking" `post` usd 1 ,"income:gifts" `post` missingamt ], tpreceding_comment_lines="" } , txnTieKnot $ Transaction { tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "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) ], tpreceding_comment_lines="" } , txnTieKnot $ Transaction { tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "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 ], tpreceding_comment_lines="" } , txnTieKnot $ Transaction { tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "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) ], tpreceding_comment_lines="" } , txnTieKnot $ Transaction { tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "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) ], tpreceding_comment_lines="" } ] } tests_Journal = tests "Journal" [ test "journalDateSpan" $ journalDateSpan True nulljournal{ jtxns = [nulltransaction{tdate = parsedate "2014/02/01" ,tpostings = [posting{pdate=Just (parsedate "2014/01/10")}] } ,nulltransaction{tdate = parsedate "2014/09/01" ,tpostings = [posting{pdate2=Just (parsedate "2014/10/10")}] } ] } `is` (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" $ expectEq (namesfrom journalAssetAccountQuery) ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"] ,test "liabilities" $ expectEq (namesfrom journalLiabilityAccountQuery) ["liabilities","liabilities:debts"] ,test "equity" $ expectEq (namesfrom journalEquityAccountQuery) [] ,test "income" $ expectEq (namesfrom journalRevenueAccountQuery) ["income","income:gifts","income:salary"] ,test "expenses" $ expectEq (namesfrom journalExpenseAccountQuery) ["expenses","expenses:food","expenses:supplies"] ] ] hledger-lib-1.12/Hledger/Data/Ledger.hs0000644000000000000000000000757613372610345016005 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 ,ledgerAccountsMatching ,ledgerPostings ,ledgerDateSpan ,ledgerCommodities ,tests_Ledger ) where import qualified Data.Map as M -- import Data.Text (Text) import qualified Data.Text as T import Safe (headDef) import Text.Printf import Hledger.Utils.Test import Hledger.Data.Types import Hledger.Data.Account import Hledger.Data.Journal import Hledger.Data.Posting 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 derive -- a ledger containing the chart of accounts and balances. If the -- query includes a depth limit, that will affect the ledger's -- journal but not the ledger's account tree. 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 -- | Accounts in ledger whose name matches the pattern, in tree order. ledgerAccountsMatching :: [String] -> Ledger -> [Account] ledgerAccountsMatching pats = filter (matchpats pats . T.unpack . aname) . laccounts -- XXX pack -- | 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 = postingsDateSpan . ledgerPostings -- | All commodities used in this ledger. ledgerCommodities :: Ledger -> [CommoditySymbol] ledgerCommodities = M.keys . jinferredcommodities . ljournal -- tests tests_Ledger = tests "Ledger" [ tests "ledgerFromJournal" [ (length $ ledgerPostings $ ledgerFromJournal Any nulljournal) `is` 0 ,(length $ ledgerPostings $ ledgerFromJournal Any samplejournal) `is` 13 ,(length $ ledgerPostings $ ledgerFromJournal (Depth 2) samplejournal) `is` 7 ] ] hledger-lib-1.12/Hledger/Data/MarketPrice.hs0000644000000000000000000000150313372610345016771 0ustar0000000000000000{-| A 'MarketPrice' represents a historical exchange rate between two commodities. (Ledger calls them historical prices.) For example, prices published by a stock exchange or the foreign exchange market. Some commands (balance, currently) can use this information to show the market value of things at a given date. -} {-# LANGUAGE OverloadedStrings, LambdaCase #-} module Hledger.Data.MarketPrice where import qualified Data.Text as T import Hledger.Data.Amount import Hledger.Data.Dates import Hledger.Data.Types -- | Get the string representation of an market price, based on its -- commodity's display settings. showMarketPrice :: MarketPrice -> String showMarketPrice mp = unwords [ "P" , showDate (mpdate mp) , T.unpack (mpcommodity mp) , (showAmount . setAmountPrecision maxprecision) (mpamount mp) ] hledger-lib-1.12/Hledger/Data/Period.hs0000644000000000000000000003031313327555450016013 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 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 "%0C%y/%m/%d" b -- DATE showPeriod (WeekPeriod b) = formatTime defaultTimeLocale "%0C%y/%m/%dw%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 "%0C%y/%m/%d" b ++ formatTime defaultTimeLocale "-%0C%y/%m/%d" (addDays (-1) e) -- STARTDATE-INCLUSIVEENDDATE showPeriod (PeriodFrom b) = formatTime defaultTimeLocale "%0C%y/%m/%d-" b -- STARTDATE- showPeriod (PeriodTo e) = formatTime defaultTimeLocale "-%0C%y/%m/%d" (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 (fromIntegral (1 - 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.12/Hledger/Data/PeriodicTransaction.hs0000644000000000000000000001777613372610345020552 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-} {-| A 'PeriodicTransaction' is a rule describing recurring transactions. -} module Hledger.Data.PeriodicTransaction ( runPeriodicTransaction , checkPeriodicTransactionStartDate ) where #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #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) 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 Nothing -> mapM_ (putStr . showTransaction) $ runPeriodicTransaction nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] } nulldatespan --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. -- -- >>> _ptgen "monthly from 2017/1 to 2017/4" -- 2017/01/01 -- ; recur: monthly from 2017/1 to 2017/4 -- a $1.00 -- -- 2017/02/01 -- ; recur: monthly from 2017/1 to 2017/4 -- a $1.00 -- -- 2017/03/01 -- ; recur: monthly from 2017/1 to 2017/4 -- a $1.00 -- -- -- >>> _ptgen "monthly from 2017/1 to 2017/5" -- 2017/01/01 -- ; recur: monthly from 2017/1 to 2017/5 -- a $1.00 -- -- 2017/02/01 -- ; recur: monthly from 2017/1 to 2017/5 -- a $1.00 -- -- 2017/03/01 -- ; recur: monthly from 2017/1 to 2017/5 -- a $1.00 -- -- 2017/04/01 -- ; recur: 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 -- ; recur: every 2nd day of month from 2017/02 to 2017/04 -- a $1.00 -- -- 2017/02/02 -- ; recur: every 2nd day of month from 2017/02 to 2017/04 -- a $1.00 -- -- 2017/03/02 -- ; recur: 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 -- ; recur: every 30th day of month from 2017/1 to 2017/5 -- a $1.00 -- -- 2017/01/30 -- ; recur: every 30th day of month from 2017/1 to 2017/5 -- a $1.00 -- -- 2017/02/28 -- ; recur: every 30th day of month from 2017/1 to 2017/5 -- a $1.00 -- -- 2017/03/30 -- ; recur: every 30th day of month from 2017/1 to 2017/5 -- a $1.00 -- -- 2017/04/30 -- ; recur: 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 -- ; recur: every 2nd Thursday of month from 2017/1 to 2017/4 -- a $1.00 -- -- 2017/01/12 -- ; recur: every 2nd Thursday of month from 2017/1 to 2017/4 -- a $1.00 -- -- 2017/02/09 -- ; recur: every 2nd Thursday of month from 2017/1 to 2017/4 -- a $1.00 -- -- 2017/03/09 -- ; recur: 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 -- ; recur: every nov 29th from 2017 to 2019 -- a $1.00 -- -- 2017/11/29 -- ; recur: every nov 29th from 2017 to 2019 -- a $1.00 -- -- 2018/11/29 -- ; recur: every nov 29th from 2017 to 2019 -- a $1.00 -- -- -- >>> _ptgen "2017/1" -- 2017/01/01 -- ; recur: 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 $ parsedate "2018-01-01") (Just $ parsedate "2018-01-03")) -- [] -- runPeriodicTransaction :: PeriodicTransaction -> DateSpan -> [Transaction] runPeriodicTransaction PeriodicTransaction{..} requestedspan = [ t{tdate=d} | (DateSpan (Just d) _) <- ptinterval `splitSpan` spantofill ] where spantofill = spanIntervalIntersect ptinterval ptspan requestedspan t = nulltransaction{ tstatus = ptstatus ,tcode = ptcode ,tdescription = ptdescription ,tcomment = (if T.null ptcomment then "\n" else ptcomment) <> "recur: " <> ptperiodexpr ,ttags = ("recur", ptperiodexpr) : pttags ,tpostings = ptpostings } -- | 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 ("","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 "++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.12/Hledger/Data/StringFormat.hs0000644000000000000000000002145513372610345017212 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 && (not $ 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 (some digitChar >>= (\s -> return $ FieldNo $ read s)) ---------------------------------------------------------------------- formatStringTester fs value expected = actual `is` 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" [ tests "formatStringHelper" [ 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" ] ,tests "parseStringFormat" $ let s `gives` expected = test (T.pack s) $ parseStringFormat s `is` Right expected in [ "" `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" $ expectLeft $ parseStringFormat "\n" ] ] hledger-lib-1.12/Hledger/Data/Posting.hs0000644000000000000000000002750713401044253016212 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, nullsourcepos, nullassertion, assertion, -- * operations originalPosting, postingStatus, isReal, isVirtual, isBalancedVirtual, isEmptyPosting, isAssignment, hasAmount, postingAllTags, transactionAllTags, relatedPostings, removePrices, -- * date operations postingDate, postingDate2, isPostingInDateSpan, isPostingInDateSpan', postingsDateSpan, postingsDateSpan', -- * account name operations accountNamesFromPostings, accountNamePostingType, accountNameWithoutPostingType, accountNameWithPostingType, joinAccountNames, concatAccountNames, accountNameApplyAliases, accountNameApplyAliasesMemo, -- * transaction description operations transactionPayee, transactionNote, payeeAndNoteFromDescription, -- * arithmetic sumPostings, -- * rendering showPosting, -- * misc. showComment, tests_Posting ) where import Data.List import Data.Maybe import Data.MemoUgly (memo) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif import Data.Ord 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) nullposting, posting :: Posting nullposting = Posting {pdate=Nothing ,pdate2=Nothing ,pstatus=Unmarked ,paccount="" ,pamount=nullmixedamt ,pcomment="" ,ptype=RegularPosting ,ptags=[] ,pbalanceassertion=Nothing ,ptransaction=Nothing ,porigin=Nothing } posting = nullposting post :: AccountName -> Amount -> Posting post acct amt = posting {paccount=acct, pamount=Mixed [amt]} nullsourcepos :: GenericSourcePos nullsourcepos = JournalSourcePos "" (1,1) nullassertion, assertion :: BalanceAssertion nullassertion = BalanceAssertion {baamount=nullamt ,baexact=False ,baposition=nullsourcepos } assertion = nullassertion -- Get the original posting, if any. originalPosting :: Posting -> Posting originalPosting p = fromMaybe p $ porigin 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 isAssignment :: Posting -> Bool isAssignment p = not (hasAmount p) && isJust (pbalanceassertion p) -- | Sorted unique account names referenced by these postings. accountNamesFromPostings :: [Posting] -> [AccountName] accountNamesFromPostings = nub . sort . 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 = NoPrice } -- | 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 txndate $ pdate p where txndate = maybe nulldate 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 = headDef nulldate $ catMaybes dates where dates = [pdate2 p ,maybe Nothing tdate2 $ ptransaction p ,pdate p ,maybe Nothing (Just . 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 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 = (textstrip p, textstrip $ T.drop 1 n) where (p, n) = T.span (/= '|') t -- | 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 s = spanContainsDate s . postingDate -- --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 = isZeroMixedAmount . pamount -- | Get the minimal date span which contains all the postings, or the -- null date span if there are none. postingsDateSpan :: [Posting] -> DateSpan postingsDateSpan [] = DateSpan Nothing Nothing postingsDateSpan ps = DateSpan (Just $ postingDate $ head ps') (Just $ addDays 1 $ postingDate $ last ps') where ps' = sortBy (comparing postingDate) ps -- --date2-sensitive version, as above. postingsDateSpan' :: WhichDate -> [Posting] -> DateSpan postingsDateSpan' _ [] = DateSpan Nothing Nothing postingsDateSpan' wd ps = DateSpan (Just $ postingdate $ head ps') (Just $ addDays 1 $ postingdate $ last ps') where ps' = sortBy (comparing postingdate) ps postingdate = if wd == PrimaryDate then postingDate else postingDate2 -- 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. accountNameApplyAliases :: [AccountAlias] -> AccountName -> AccountName accountNameApplyAliases aliases a = accountNameWithPostingType atype aname' where (aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a) aname' = foldl (\acct alias -> dbg6 "result" $ aliasReplace (dbg6 "alias" alias) (dbg6 "account" acct)) aname aliases -- | Memoising version of accountNameApplyAliases, maybe overkill. accountNameApplyAliasesMemo :: [AccountAlias] -> AccountName -> AccountName accountNameApplyAliasesMemo aliases = memo (accountNameApplyAliases aliases) -- aliasMatches :: AccountAlias -> AccountName -> Bool -- aliasMatches (BasicAlias old _) a = old `isAccountNamePrefixOf` a -- aliasMatches (RegexAlias re _) a = regexMatchesCI re a aliasReplace :: AccountAlias -> AccountName -> AccountName aliasReplace (BasicAlias old new) a | old `isAccountNamePrefixOf` a || old == a = new <> T.drop (T.length old) a | otherwise = a aliasReplace (RegexAlias re repl) a = T.pack $ regexReplaceCIMemo re repl $ T.unpack a -- XXX -- tests tests_Posting = tests "Posting" [ tests "accountNamePostingType" [ accountNamePostingType "a" `is` RegularPosting ,accountNamePostingType "(a)" `is` VirtualPosting ,accountNamePostingType "[a]" `is` BalancedVirtualPosting ] ,tests "accountNameWithoutPostingType" [ accountNameWithoutPostingType "(a)" `is` "a" ] ,tests "accountNameWithPostingType" [ accountNameWithPostingType VirtualPosting "[a]" `is` "(a)" ] ,tests "joinAccountNames" [ "a" `joinAccountNames` "b:c" `is` "a:b:c" ,"a" `joinAccountNames` "(b:c)" `is` "(a:b:c)" ,"[a]" `joinAccountNames` "(b:c)" `is` "[a:b:c]" ,"" `joinAccountNames` "a" `is` "a" ] ,tests "concatAccountNames" [ concatAccountNames [] `is` "" ,concatAccountNames ["a","(b)","[c:d]"] `is` "(a:b:c:d)" ] ] hledger-lib-1.12/Hledger/Data/RawOptions.hs0000644000000000000000000000344313372610345016675 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, stringopt, maybestringopt, listofstringopt, intopt, maybeintopt, maybecharopt ) where import Data.Maybe import qualified Data.Text as T import Safe import Hledger.Utils -- | The result of running cmdargs: an association list of option names to string values. type RawOpts = [(String,String)] setopt :: String -> String -> RawOpts -> RawOpts setopt name val = (++ [(name, quoteIfNeeded $ val)]) setboolopt :: String -> RawOpts -> RawOpts setboolopt name = (++ [(name,"")]) -- | Is the named option present ? inRawOpts :: String -> RawOpts -> Bool inRawOpts name = isJust . lookup name boolopt :: String -> RawOpts -> Bool boolopt = inRawOpts maybestringopt :: String -> RawOpts -> Maybe String maybestringopt name = maybe Nothing (Just . T.unpack . stripquotes . T.pack) . lookup name . reverse stringopt :: String -> RawOpts -> String stringopt name = fromMaybe "" . maybestringopt name maybecharopt :: String -> RawOpts -> Maybe Char maybecharopt name rawopts = lookup name rawopts >>= headMay listofstringopt :: String -> RawOpts -> [String] listofstringopt name rawopts = [v | (k,v) <- rawopts, k==name] maybeintopt :: String -> RawOpts -> Maybe Int maybeintopt name rawopts = let ms = maybestringopt name rawopts in case ms of Nothing -> Nothing Just s -> Just $ readDef (usageError $ "could not parse "++name++" number: "++s) s intopt :: String -> RawOpts -> Int intopt name = fromMaybe 0 . maybeintopt name hledger-lib-1.12/Hledger/Data/Timeclock.hs0000644000000000000000000001306213372610345016500 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 CPP, 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 #if !(MIN_VERSION_time(1,5,0)) import System.Locale (defaultTimeLocale) #endif 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] | 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) | 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}} -- | 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 where t = Transaction { tindex = 0, tsourcepos = tlsourcepos i, tdate = idate, tdate2 = Nothing, tstatus = Cleared, tcode = "", tdescription = desc, tcomment = "", ttags = [], tpostings = ps, tpreceding_comment_lines="" } 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" [ do today <- io getCurrentDay now' <- io getCurrentTime tz <- io getCurrentTimeZone let now = utcToLocalTime tz now' nowstr = showtime now yesterday = prevday today clockin = TimeclockEntry nullsourcepos In mktime d = LocalTime d . fromMaybe midnight . #if MIN_VERSION_time(1,5,0) parseTimeM True defaultTimeLocale "%H:%M:%S" #else parseTime defaultTimeLocale "%H:%M:%S" #endif showtime = formatTime defaultTimeLocale "%H:%M" txndescs = map (T.unpack . tdescription) . timeclockEntriesToTransactions now future = utcToLocalTime tz $ addUTCTime 100 now' futurestr = showtime future tests "timeclockEntriesToTransactions" [ test "started yesterday, split session at midnight" $ txndescs [clockin (mktime yesterday "23:00:00") "" ""] `is` ["23:00-23:59","00:00-"++nowstr] ,test "split multi-day sessions at each midnight" $ txndescs [clockin (mktime (addDays (-2) today) "23:00:00") "" ""] `is `["23:00-23:59","00:00-23:59","00:00-"++nowstr] ,test "auto-clock-out if needed" $ txndescs [clockin (mktime today "00:00:00") "" ""] `is` ["00:00-"++nowstr] ,test "use the clockin time for auto-clockout if it's in the future" $ txndescs [clockin future "" ""] `is` [printf "%s-%s" futurestr futurestr] ] ] hledger-lib-1.12/Hledger/Data/Transaction.hs0000644000000000000000000011117213401044253017044 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-| 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 OverloadedStrings, LambdaCase #-} module Hledger.Data.Transaction ( -- * Transaction nulltransaction, txnTieKnot, txnUntieKnot, -- * operations showAccountName, hasRealPostings, realPostings, assignmentPostings, virtualPostings, balancedVirtualPostings, transactionsPostings, isTransactionBalanced, -- nonzerobalanceerror, -- * date operations transactionDate2, -- * arithmetic transactionPostingBalances, balanceTransaction, balanceTransactionUpdate, -- * rendering showTransaction, showTransactionUnelided, showTransactionUnelidedOneLineAmounts, showPostingLine, showPostingLines, -- * GenericSourcePos sourceFilePath, sourceFirstLine, showGenericSourcePos, -- * tests tests_Transaction ) where import Data.List import Control.Monad.Except import Control.Monad.Identity 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 Map import Hledger.Utils import Hledger.Data.Types import Hledger.Data.Dates import Hledger.Data.Posting import Hledger.Data.Amount 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=[], tpreceding_comment_lines="" } {-| Render a journal transaction as text in the style of Ledger's print command. Ledger 2.x's standard format looks like this: @ 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). If there are multiple postings, all with explicit amounts, and the transaction appears obviously balanced (postings sum to 0, without needing to infer conversion prices), the last posting's amount will not be shown. -} -- XXX why that logic ? -- XXX where is/should this be still used ? -- XXX rename these, after amount expressions/mixed posting amounts lands -- eg showTransactionSimpleAmountsElidingLast, showTransactionSimpleAmounts, showTransaction showTransaction :: Transaction -> String showTransaction = showTransactionHelper True False -- | Like showTransaction, but does not change amounts' explicitness. -- Explicit amounts are shown and implicit amounts are not. -- 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. -- Most often, this is the one you want to use. showTransactionUnelided :: Transaction -> String showTransactionUnelided = showTransactionHelper False False -- | Like showTransactionUnelided, but explicit multi-commodity amounts -- are shown on one line, comma-separated. In this case the output will -- not be parseable journal syntax. showTransactionUnelidedOneLineAmounts :: Transaction -> String showTransactionUnelidedOneLineAmounts = showTransactionHelper False True -- | Helper for showTransaction*. showTransactionHelper :: Bool -> Bool -> Transaction -> String showTransactionHelper elide onelineamounts t = unlines $ [descriptionline] ++ newlinecomments ++ (postingsAsLines elide onelineamounts t (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. renderCommentLines :: Text -> [String] renderCommentLines t = case lines $ T.unpack t of ("":ls) -> "":map commentprefix ls ls -> map commentprefix ls where commentprefix = indent . ("; "++) -- | 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. -- -- Setting elide to true forces the last posting's amount to be implicit, if: -- there are other postings, all with explicit amounts, and the transaction -- appears balanced. -- -- 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 -> Bool -> Transaction -> [Posting] -> [String] postingsAsLines elide onelineamounts t ps | elide && length ps > 1 && all hasAmount ps && isTransactionBalanced Nothing t -- imprecise balanced check = (concatMap (postingAsLines False onelineamounts ps) $ init ps) ++ postingAsLines True onelineamounts ps (last ps) | otherwise = 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, " ", amount, assertion, samelinecomment] | amount <- shownAmounts] assertion = maybe "" ((" = " ++) . showAmountWithZeroCommodity . baamount) $ pbalanceassertion p statusandaccount = indent $ 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) -- | Show a posting's status, account name and amount on one line. -- Used in balance assertion errors. showPostingLine p = indent $ if pstatus p == Cleared then "* " else "" ++ showAccountName Nothing (ptype p) (paccount p) ++ " " ++ showMixedAmountOneLine (pamount 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] indent :: String -> String indent = (" "++) -- | 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 = take w' . T.unpack fmt VirtualPosting = parenthesise . reverse . take (w'-2) . reverse . T.unpack fmt BalancedVirtualPosting = bracket . reverse . take (w'-2) . reverse . T.unpack w' = fromMaybe 999999 w 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 isAssignment . tpostings virtualPostings :: Transaction -> [Posting] virtualPostings = filter isVirtual . tpostings balancedVirtualPostings :: Transaction -> [Posting] balancedVirtualPostings = filter isBalancedVirtual . tpostings transactionsPostings :: [Transaction] -> [Posting] transactionsPostings = concat . map tpostings -- | Get the sums of a transaction's real, virtual, and balanced virtual postings. transactionPostingBalances :: Transaction -> (MixedAmount,MixedAmount,MixedAmount) transactionPostingBalances t = (sumPostings $ realPostings t ,sumPostings $ virtualPostings t ,sumPostings $ balancedVirtualPostings t) -- | Does this transaction appear balanced when rendered, optionally with the -- given commodity display styles ? More precisely: -- after converting amounts to cost using explicit transaction prices if any; -- and summing the real postings, and summing the balanced virtual postings; -- and applying the given display styles if any (maybe affecting decimal places); -- do both totals appear to be zero when rendered ? isTransactionBalanced :: Maybe (Map.Map CommoditySymbol AmountStyle) -> Transaction -> Bool isTransactionBalanced styles t = -- isReallyZeroMixedAmountCost rsum && isReallyZeroMixedAmountCost bvsum isZeroMixedAmount rsum' && isZeroMixedAmount bvsum' where (rsum, _, bvsum) = transactionPostingBalances t rsum' = canonicalise $ costOfMixedAmount rsum bvsum' = canonicalise $ costOfMixedAmount bvsum canonicalise = maybe id canonicaliseMixedAmount styles -- | Ensure this transaction is balanced, possibly inferring a missing -- amount or conversion price(s), or return an error message. -- Balancing is affected by commodity display precisions, so those can -- (optionally) be provided. -- -- this fails for example, if there are several missing amounts -- (possibly with balance assignments) balanceTransaction :: Maybe (Map.Map CommoditySymbol AmountStyle) -> Transaction -> Either String Transaction balanceTransaction stylemap = runIdentity . runExceptT . balanceTransactionUpdate (\_ _ -> return ()) stylemap -- | More general version of 'balanceTransaction' that takes an update -- function balanceTransactionUpdate :: MonadError String m => (AccountName -> MixedAmount -> m ()) -- ^ update function -> Maybe (Map.Map CommoditySymbol AmountStyle) -> Transaction -> m Transaction balanceTransactionUpdate update mstyles t = (finalize =<< inferBalancingAmount update (fromMaybe Map.empty mstyles) t) `catchError` (throwError . annotateErrorWithTxn t) where finalize t' = let t'' = inferBalancingPrices t' in if isTransactionBalanced mstyles t'' then return $ txnTieKnot t'' else throwError $ nonzerobalanceerror t'' nonzerobalanceerror :: Transaction -> String nonzerobalanceerror t = printf "could not balance this transaction (%s%s%s)" rmsg sep bvmsg where (rsum, _, bvsum) = transactionPostingBalances t rmsg | isReallyZeroMixedAmountCost rsum = "" | otherwise = "real postings are off by " ++ showMixedAmount (costOfMixedAmount rsum) bvmsg | isReallyZeroMixedAmountCost bvsum = "" | otherwise = "balanced virtual postings are off by " ++ showMixedAmount (costOfMixedAmount bvsum) sep = if not (null rmsg) && not (null bvmsg) then "; " else "" :: String annotateErrorWithTxn t e = intercalate "\n" [showGenericSourcePos $ tsourcepos t, e, showTransactionUnelided 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. -- -- 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 :: MonadError String m => (AccountName -> MixedAmount -> m ()) -- ^ update function -> Map.Map CommoditySymbol AmountStyle -- ^ standard amount styles -> Transaction -> m Transaction inferBalancingAmount update styles t@Transaction{tpostings=ps} | length amountlessrealps > 1 = throwError "could not balance this transaction - can't have more than one real posting with no amount (remember to put 2 or more spaces before amounts)" | length amountlessbvps > 1 = throwError "could not balance this transaction - can't have more than one balanced virtual posting with no amount (remember to put 2 or more spaces before amounts)" | otherwise = do postings <- mapM inferamount ps return t{tpostings=postings} where (amountfulrealps, amountlessrealps) = partition hasAmount (realPostings t) realsum = sumStrict $ map pamount amountfulrealps (amountfulbvps, amountlessbvps) = partition hasAmount (balancedVirtualPostings t) bvsum = sumStrict $ map pamount amountfulbvps inferamount p@Posting{ptype=RegularPosting} | not (hasAmount p) = updateAmount p realsum inferamount p@Posting{ptype=BalancedVirtualPosting} | not (hasAmount p) = updateAmount p bvsum inferamount p = return p updateAmount p amt = update (paccount p) amt' >> return p { pamount=amt', porigin=Just $ originalPosting p } where -- Inferred amounts are converted to cost. -- Also, ensure the new amount has the standard style for its commodity -- (the main amount styling pass happened before this balancing pass). amt' = styleMixedAmount styles $ normaliseMixedAmount $ costOfMixedAmount (-amt) -- | 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) $ map (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 (/=NoPrice) $ 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=conversionprice}], porigin=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` maxprecision | otherwise = UnitPrice $ abs unitprice `withPrecision` unitprecision where fromcount = length $ filter ((==fromcommodity).acommodity) pamounts fromamount = head $ filter ((==fromcommodity).acommodity) sumamounts tocommodity = head $ filter (/=fromcommodity) sumcommodities toamount = head $ filter ((==tocommodity).acommodity) sumamounts unitprice = (aquantity fromamount) `divideAmount` toamount unitprecision = max 2 ((asprecision $ astyle $ toamount) + (asprecision $ astyle $ fromamount)) 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} -- tests tests_Transaction = tests "Transaction" [ tests "showTransactionUnelided" [ showTransactionUnelided nulltransaction `is` "0000/01/01\n\n" ,showTransactionUnelided nulltransaction{ tdate=parsedate "2012/05/14", tdate2=Just $ parsedate "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")] } ] } `is` unlines [ "2012/05/14=2012/05/15 (code) desc ; tcomment1", " ; tcomment2", " * a $1.00", " ; pcomment2", " * a 2.00h", " ; pcomment2", "" ] ] ,tests "postingAsLines" [ postingAsLines False False [posting] posting `is` [""] ,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 `is` [ " * a $1.00 ; pcomment1", " ; pcomment2", " ; tag3: val3 ", " * a 2.00h ; pcomment1", " ; pcomment2", " ; tag3: val3 " ] ] -- postingsAsLines ,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" $ let t = nulltransaction in postingsAsLines True False t (tpostings t) `is` [] ,test "implicit-amount-elide-false" $ let t = timp in postingsAsLines False False t (tpostings t) `is` [ " a $1.00" ," b" -- implicit amount remains implicit ] ,test "implicit-amount-elide-true" $ let t = timp in postingsAsLines True False t (tpostings t) `is` [ " a $1.00" ," b" -- implicit amount remains implicit ] ,test "explicit-amounts-elide-false" $ let t = texp in postingsAsLines False False t (tpostings t) `is` [ " a $1.00" ," b $-1.00" -- both amounts remain explicit ] ,test "explicit-amounts-elide-true" $ let t = texp in postingsAsLines True False t (tpostings t) `is` [ " a $1.00" ," b" -- explicit amount is made implicit ] ,test "one-explicit-amount-elide-true" $ let t = texp1 in postingsAsLines True False t (tpostings t) `is` [ " (a) $1.00" -- explicit amount remains explicit since only one posting ] ,test "explicit-amounts-two-commodities-elide-true" $ let t = texp2 in postingsAsLines True False t (tpostings t) `is` [ " a $1.00" ," b" -- explicit amount is made implicit since txn is explicitly balanced ] ,test "explicit-amounts-not-explicitly-balanced-elide-true" $ let t = texp2b in postingsAsLines True False t (tpostings t) `is` [ " a $1.00" ," b -1.00h" -- explicit amount remains explicit since a conversion price would have be inferred to balance ] ,test "implicit-amount-not-last" $ let t = t3 in postingsAsLines True False t (tpostings t) `is` [ " a $1.00" ," b" ," c $-1.00" ] ,_test "ensure-visibly-balanced" $ let t = t4 in postingsAsLines False False t (tpostings t) `is` [ " a $-0.01" ," b $0.005" ," c $0.005" ] ] ,do let inferTransaction :: Transaction -> Either String Transaction inferTransaction = runIdentity . runExceptT . inferBalancingAmount (\_ _ -> return ()) Map.empty tests "inferBalancingAmount" [ inferTransaction nulltransaction `is` Right nulltransaction ,inferTransaction nulltransaction{ tpostings=[ "a" `post` usd (-5), "b" `post` missingamt ]} `is` Right nulltransaction{ tpostings=[ "a" `post` usd (-5), "b" `post` usd 5 ]} ,inferTransaction nulltransaction{ tpostings=[ "a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` missingamt ]} `is` Right nulltransaction{ tpostings=[ "a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` usd 1 ]} ] ,tests "showTransaction" [ test "show a balanced transaction, eliding last amount" $ let t = Transaction 0 nullsourcepos (parsedate "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 `is` unlines ["2007/01/28 coopportunity" ," expenses:food:groceries $47.18" ," assets:checking" ,"" ] ,test "show a balanced transaction, no eliding" $ (let t = Transaction 0 nullsourcepos (parsedate "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 showTransactionUnelided t) `is` (unlines ["2007/01/28 coopportunity" ," expenses:food:groceries $47.18" ," assets:checking $-47.18" ,"" ]) -- document some cases that arise in debug/testing: ,test "show an unbalanced transaction, should not elide" $ (showTransaction (txnTieKnot $ Transaction 0 nullsourcepos (parsedate "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)]} ] "")) `is` (unlines ["2007/01/28 coopportunity" ," expenses:food:groceries $47.18" ," assets:checking $-47.19" ,"" ]) ,test "show an unbalanced transaction with one posting, should not elide" $ (showTransaction (txnTieKnot $ Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" [] [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18]} ] "")) `is` (unlines ["2007/01/28 coopportunity" ," expenses:food:groceries $47.18" ,"" ]) ,test "show a transaction with one posting and a missing amount" $ (showTransaction (txnTieKnot $ Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" [] [posting{paccount="expenses:food:groceries", pamount=missingmixedamt} ] "")) `is` (unlines ["2007/01/28 coopportunity" ," expenses:food:groceries" ,"" ]) ,test "show a transaction with a priced commodityless amount" $ (showTransaction (txnTieKnot $ Transaction 0 nullsourcepos (parsedate "2010/01/01") Nothing Unmarked "" "x" "" [] [posting{paccount="a", pamount=Mixed [num 1 `at` (usd 2 `withPrecision` 0)]} ,posting{paccount="b", pamount= missingmixedamt} ] "")) `is` (unlines ["2010/01/01 x" ," a 1 @ $2" ," b" ,"" ]) ] ,tests "balanceTransaction" [ test "detect unbalanced entry, sign error" $ (expectLeft $ balanceTransaction Nothing (Transaction 0 nullsourcepos (parsedate "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" $ (expectLeft $ balanceTransaction Nothing (Transaction 0 nullsourcepos (parsedate "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 (parsedate "2007/01/28") Nothing Unmarked "" "" "" [] [posting{paccount="a", pamount=Mixed [usd 1]} ,posting{paccount="b", pamount=missingmixedamt} ] "")) `is` Right (Mixed [usd (-1)]) ,test "conversion price is inferred" $ (pamount . head . tpostings <$> balanceTransaction Nothing (Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "" "" [] [posting{paccount="a", pamount=Mixed [usd 1.35]} ,posting{paccount="b", pamount=Mixed [eur (-1)]} ] "")) `is` Right (Mixed [usd 1.35 @@ (eur 1 `withPrecision` maxprecision)]) ,test "balanceTransaction balances based on cost if there are unit prices" $ expectRight $ balanceTransaction Nothing (Transaction 0 nullsourcepos (parsedate "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" $ expectRight $ balanceTransaction Nothing (Transaction 0 nullsourcepos (parsedate "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" $ expect $ isTransactionBalanced Nothing $ Transaction 0 nullsourcepos (parsedate "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" $ expect $ not $ isTransactionBalanced Nothing $ Transaction 0 nullsourcepos (parsedate "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" $ expect $ not $ isTransactionBalanced Nothing $ Transaction 0 nullsourcepos (parsedate "2009/01/01") Nothing Unmarked "" "a" "" [] [posting{paccount="b", pamount=Mixed [usd 1.00]} ] "" ,test "one zero posting is considered balanced for now" $ expect $ isTransactionBalanced Nothing $ Transaction 0 nullsourcepos (parsedate "2009/01/01") Nothing Unmarked "" "a" "" [] [posting{paccount="b", pamount=Mixed [usd 0]} ] "" ,test "virtual postings don't need to balance" $ expect $ isTransactionBalanced Nothing $ Transaction 0 nullsourcepos (parsedate "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" $ expect $ not $ isTransactionBalanced Nothing $ Transaction 0 nullsourcepos (parsedate "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)" $ expect $ isTransactionBalanced Nothing $ Transaction 0 nullsourcepos (parsedate "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.12/Hledger/Data/TransactionModifier.hs0000644000000000000000000001276513401044253020533 0ustar0000000000000000{-# 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 ( transactionModifierToFunction ) where 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.Utils.UTF8IOCompat (error') import Hledger.Utils.Debug -- $setup -- >>> :set -XOverloadedStrings -- >>> import Hledger.Data.Posting -- >>> import Hledger.Data.Transaction -- >>> import Hledger.Data.Journal -- | Converts a 'TransactionModifier' to a 'Transaction'-transforming function, -- which applies the modification(s) specified by the TransactionModifier. -- Currently this means adding automated postings when certain other postings are present. -- The postings of the transformed transaction will reference it in the usual -- way (ie, 'txnTieKnot' is called). -- -- >>> putStr $ showTransaction $ transactionModifierToFunction (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} -- 0000/01/01 -- ping $1.00 -- pong $2.00 -- -- >>> putStr $ showTransaction $ transactionModifierToFunction (TransactionModifier "miss" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} -- 0000/01/01 -- ping $1.00 -- -- >>> putStr $ showTransaction $ transactionModifierToFunction (TransactionModifier "ping" ["pong" `post` amount{amultiplier=True, aquantity=3}]) nulltransaction{tpostings=["ping" `post` usd 2]} -- 0000/01/01 -- ping $2.00 -- pong $6.00 -- -- transactionModifierToFunction :: TransactionModifier -> (Transaction -> Transaction) transactionModifierToFunction mt = \t@(tpostings -> ps) -> txnTieKnot t{ tpostings=generatePostings ps } -- TODO add modifier txn comment/tags ? where q = simplifyQuery $ tmParseQuery mt (error' "a transaction modifier's query cannot depend on current date") mods = map tmPostingRuleToFunction $ tmpostingrules mt generatePostings ps = [p' | p <- ps , p' <- if q `matchesPosting` p then p:[ m p | m <- mods] else [p]] -- | Parse the 'Query' from a 'TransactionModifier's 'tmquerytxt', -- and return it as a function requiring the current date. -- -- >>> tmParseQuery (TransactionModifier "" []) undefined -- Any -- >>> tmParseQuery (TransactionModifier "ping" []) undefined -- Acct "ping" -- >>> tmParseQuery (TransactionModifier "date:2016" []) undefined -- Date (DateSpan 2016) -- >>> tmParseQuery (TransactionModifier "date:today" []) (read "2017-01-01") -- Date (DateSpan 2017/01/01) tmParseQuery :: TransactionModifier -> (Day -> Query) tmParseQuery mt = fst . flip parseQuery (tmquerytxt mt) -- | 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. tmPostingRuleToFunction :: TMPostingRule -> (Posting -> Posting) tmPostingRuleToFunction pr = \p -> renderPostingCommentDates $ pr { pdate = pdate p , pdate2 = pdate2 p , pamount = amount' p } where 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] | amultiplier a -> Just $ aquantity a _ -> Nothing renderPostingCommentDates :: Posting -> Posting renderPostingCommentDates p = p { pcomment = comment' } where datesComment = T.concat $ catMaybes [T.pack . showDate <$> pdate p, ("=" <>) . T.pack . showDate <$> pdate2 p] comment' | T.null datesComment = pcomment p | otherwise = T.intercalate "\n" $ filter (not . T.null) [T.strip $ pcomment p, "[" <> datesComment <> "]"] hledger-lib-1.12/Hledger/Data/Types.hs0000644000000000000000000005046313401044253015670 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, DeriveGeneric, TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-| 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. -} module Hledger.Data.Types where import GHC.Generics (Generic) import Control.DeepSeq (NFData) import Data.Data import Data.Decimal import Data.Default 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 System.Time (ClockTime(..)) import Text.Printf import Hledger.Utils.Regex -- | A possibly incomplete date, whose missing parts will be filled from a reference date. -- A numeric year, month, and day of month, or the empty string for any of these. -- See the smartdate parser. type SmartDate = (String,String,String) data WhichDate = PrimaryDate | SecondaryDate deriving (Eq,Show) data DateSpan = DateSpan (Maybe Day) (Maybe Day) deriving (Eq,Ord,Data,Generic,Typeable) instance Default DateSpan where def = DateSpan Nothing Nothing instance NFData DateSpan -- 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,Data,Generic,Typeable) 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,Data,Generic,Typeable) -- 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,Data,Generic,Typeable) instance Default Interval where def = NoInterval instance NFData Interval type AccountName = Text data AccountType = Asset | Liability | Equity | Revenue | Expense deriving (Show,Eq,Ord,Data,Generic) instance NFData AccountType -- 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, Data, Generic, Typeable) instance NFData AccountAlias data Side = L | R deriving (Eq,Show,Read,Ord,Typeable,Data,Generic) instance NFData Side -- | The basic numeric type used in amounts. type Quantity = Decimal deriving instance Data Quantity -- 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 price (none, per unit, or total) in another commodity. -- The price amount should always be positive. data Price = NoPrice | UnitPrice Amount | TotalPrice Amount deriving (Eq,Ord,Typeable,Data,Generic,Show) instance NFData Price -- | 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 :: !Int, -- ^ 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,Typeable,Data,Generic) instance NFData AmountStyle instance Show AmountStyle where show AmountStyle{..} = printf "AmountStylePP \"%s %s %s %s %s..\"" (show ascommodityside) (show ascommodityspaced) (show asprecision) (show asdecimalpoint) (show asdigitgroups) -- | 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 [Int] deriving (Eq,Ord,Read,Show,Typeable,Data,Generic) instance NFData DigitGroupStyle type CommoditySymbol = Text data Commodity = Commodity { csymbol :: CommoditySymbol, cformat :: Maybe AmountStyle } deriving (Show,Eq,Data,Generic) --,Ord,Typeable,Data,Generic) instance NFData Commodity data Amount = Amount { acommodity :: CommoditySymbol, aquantity :: Quantity, aprice :: Price, -- ^ the (fixed) price for this amount, if any astyle :: AmountStyle, amultiplier :: Bool -- ^ kludge: a flag marking this amount and posting as a multiplier -- in a TMPostingRule. In a regular Posting, should always be false. } deriving (Eq,Ord,Typeable,Data,Generic,Show) instance NFData Amount newtype MixedAmount = Mixed [Amount] deriving (Eq,Ord,Typeable,Data,Generic,Show) instance NFData MixedAmount data PostingType = RegularPosting | VirtualPosting | BalancedVirtualPosting deriving (Eq,Show,Typeable,Data,Generic) instance NFData PostingType 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,Typeable,Data,Generic) instance NFData Status instance Show Status where -- custom show.. bad idea.. don't do it.. show Unmarked = "" show Pending = "!" show Cleared = "*" -- | The amount to compare an account's balance to, to verify that the history -- leading to a given point is correct or to set the account to a known value. data BalanceAssertion = BalanceAssertion { baamount :: Amount, -- ^ the expected value of a particular commodity baexact :: Bool, -- ^ whether the assertion is exclusive, and doesn't allow other commodities alongside 'baamount' baposition :: GenericSourcePos } deriving (Eq,Typeable,Data,Generic,Show) instance NFData BalanceAssertion 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, -- ^ optional: the expected balance in this commodity in the account after this posting ptransaction :: Maybe Transaction, -- ^ this posting's parent transaction (co-recursive types). -- Tying this knot gets tedious, Maybe makes it easier/optional. porigin :: 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 (Typeable,Data,Generic) instance NFData Posting -- The equality test for postings ignores the parent transaction's -- identity, to avoid recuring 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 (const "" <$> ptransaction)) ,("porigin=" ++ show porigin) ] ++ "}" -- 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, Data, Generic, Typeable) instance NFData GenericSourcePos --{-# 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 input stream, or 0 when not available tsourcepos :: GenericSourcePos, 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 tpreceding_comment_lines :: Text -- ^ any comment lines immediately preceding this transaction } deriving (Eq,Typeable,Data,Generic,Show) instance NFData Transaction -- | 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,Typeable,Data,Generic,Show) instance NFData TransactionModifier 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 amultiplier 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,Typeable,Data,Generic) -- , Show in PeriodicTransaction.hs nullperiodictransaction = PeriodicTransaction{ ptperiodexpr = "" ,ptinterval = def ,ptspan = def ,ptstatus = Unmarked ,ptcode = "" ,ptdescription = "" ,ptcomment = "" ,pttags = [] ,ptpostings = [] } instance NFData PeriodicTransaction data TimeclockCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord,Typeable,Data,Generic) instance NFData TimeclockCode data TimeclockEntry = TimeclockEntry { tlsourcepos :: GenericSourcePos, tlcode :: TimeclockCode, tldatetime :: LocalTime, tlaccount :: AccountName, tldescription :: Text } deriving (Eq,Ord,Typeable,Data,Generic) instance NFData TimeclockEntry data MarketPrice = MarketPrice { mpdate :: Day, mpcommodity :: CommoditySymbol, mpamount :: Amount } deriving (Eq,Ord,Typeable,Data,Generic) -- , Show in Amount.hs instance NFData MarketPrice -- | 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] -- ^ 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 - jusedstyles ,jmarketprices :: [MarketPrice] ,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, Typeable, Data, Generic) deriving instance Data ClockTime deriving instance Typeable ClockTime deriving instance Generic ClockTime instance NFData ClockTime instance NFData Journal -- | 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 -- | An account, with name, balances and links to parent/subaccounts -- which let you walk up or down the account tree. data Account = Account { aname :: AccountName, -- ^ this account's full name adeclarationorder :: Maybe Int , -- ^ the relative position of this account's account directive, if any. Normally a natural number. aebalance :: MixedAmount, -- ^ this account's balance, excluding subaccounts asubs :: [Account], -- ^ sub-accounts anumpostings :: Int, -- ^ number of postings to this account -- derived from the above : aibalance :: MixedAmount, -- ^ this account's balance, including subaccounts aparent :: Maybe Account, -- ^ parent account aboring :: Bool -- ^ used in the accounts report to label elidable parents } deriving (Typeable, Data, 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, Data, 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.12/Hledger/Query.hs0000644000000000000000000011236413372610345015027 0ustar0000000000000000{-| A general query system for matching things (accounts, postings, transactions..) by various criteria, and a SimpleTextParser for query expressions. -} {-# LANGUAGE DeriveDataTypeable, OverloadedStrings, ViewPatterns #-} {-# LANGUAGE CPP #-} module Hledger.Query ( -- * Query and QueryOpt Query(..), QueryOpt(..), -- * 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, matchesMarketPrice, words'', -- * tests tests_Query ) where import Data.Data import Data.Either import Data.List 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 Safe (readDef, headDef) import Text.Megaparsec import Text.Megaparsec.Char 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,Data,Typeable) -- custom Show implementation to show strings more accurately, eg for debugging regexps instance Show Query where show Any = "Any" show None = "None" show (Not q) = "Not (" ++ show q ++ ")" show (Or qs) = "Or (" ++ show qs ++ ")" show (And qs) = "And (" ++ show qs ++ ")" show (Code r) = "Code " ++ show r show (Desc r) = "Desc " ++ show r show (Acct r) = "Acct " ++ show r show (Date ds) = "Date (" ++ show ds ++ ")" show (Date2 ds) = "Date2 (" ++ show ds ++ ")" show (StatusQ b) = "StatusQ " ++ show b show (Real b) = "Real " ++ show b show (Amt ord qty) = "Amt " ++ show ord ++ " " ++ show qty show (Sym r) = "Sym " ++ show r show (Empty b) = "Empty " ++ show b show (Depth n) = "Depth " ++ show n show (Tag s ms) = "Tag " ++ show s ++ " (" ++ show ms ++ ")" -- | 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,Data,Typeable) -- | 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, Data, Typeable) -- 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. 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 :: Day -> T.Text -> (Query,[QueryOpt]) parseQuery d s = (q, opts) where terms = words'' prefixes s (pats, opts) = partitionEithers $ map (parseQueryTerm d) terms (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 -- 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` skipSome spacenonewline 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 raise an error if it has invalid syntax. parseQueryTerm :: Day -> T.Text -> Either Query QueryOpt parseQueryTerm _ (T.stripPrefix "inacctonly:" -> Just s) = Right $ QueryOptInAcctOnly s parseQueryTerm _ (T.stripPrefix "inacct:" -> Just s) = Right $ QueryOptInAcct s parseQueryTerm d (T.stripPrefix "not:" -> Just s) = case parseQueryTerm d s of Left m -> Left $ Not m Right _ -> Left Any -- not:somequeryoption will be ignored parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Left $ Code $ T.unpack s parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Left $ Desc $ T.unpack s parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Left $ Tag "payee" $ Just $ T.unpack s parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Left $ Tag "note" $ Just $ T.unpack s parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left $ Acct $ T.unpack s parseQueryTerm d (T.stripPrefix "date2:" -> Just s) = case parsePeriodExpr d s of Left e -> error' $ "\"date2:"++T.unpack s++"\" gave a "++showDateParseError e Right (_,span) -> Left $ Date2 span parseQueryTerm d (T.stripPrefix "date:" -> Just s) = case parsePeriodExpr d s of Left e -> error' $ "\"date:"++T.unpack s++"\" gave a "++showDateParseError e Right (_,span) -> Left $ Date span parseQueryTerm _ (T.stripPrefix "status:" -> Just s) = case parseStatus s of Left e -> error' $ "\"status:"++T.unpack s++"\" gave a parse error: " ++ e Right st -> Left $ StatusQ st parseQueryTerm _ (T.stripPrefix "real:" -> Just s) = Left $ Real $ parseBool s || T.null s parseQueryTerm _ (T.stripPrefix "amt:" -> Just s) = Left $ Amt ord q where (ord, q) = parseAmountQueryTerm s parseQueryTerm _ (T.stripPrefix "empty:" -> Just s) = Left $ Empty $ parseBool s parseQueryTerm _ (T.stripPrefix "depth:" -> Just s) | n >= 0 = Left $ Depth n | otherwise = error' "depth: should have a positive number" where n = readDef 0 (T.unpack s) parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Left $ Sym (T.unpack s) -- support cur: as an alias parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = Left $ Tag n v where (n,v) = parseTag s parseQueryTerm _ "" = Left $ Any parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s -- | Parse what comes after amt: . parseAmountQueryTerm :: T.Text -> (OrdPlus, Quantity) parseAmountQueryTerm s' = case s' of -- feel free to do this a smarter way "" -> err (T.stripPrefix "<+" -> Just s) -> (Lt, readDef err (T.unpack s)) (T.stripPrefix "<=+" -> Just s) -> (LtEq, readDef err (T.unpack s)) (T.stripPrefix ">+" -> Just s) -> (Gt, readDef err (T.unpack s)) (T.stripPrefix ">=+" -> Just s) -> (GtEq, readDef err (T.unpack s)) (T.stripPrefix "=+" -> Just s) -> (Eq, readDef err (T.unpack s)) (T.stripPrefix "+" -> Just s) -> (Eq, readDef err (T.unpack s)) (T.stripPrefix "<-" -> Just s) -> (Lt, negate $ readDef err (T.unpack s)) (T.stripPrefix "<=-" -> Just s) -> (LtEq, negate $ readDef err (T.unpack s)) (T.stripPrefix ">-" -> Just s) -> (Gt, negate $ readDef err (T.unpack s)) (T.stripPrefix ">=-" -> Just s) -> (GtEq, negate $ readDef err (T.unpack s)) (T.stripPrefix "=-" -> Just s) -> (Eq, negate $ readDef err (T.unpack s)) (T.stripPrefix "-" -> Just s) -> (Eq, negate $ readDef err (T.unpack s)) (T.stripPrefix "<=" -> Just s) -> let n = readDef err (T.unpack s) in case n of 0 -> (LtEq, 0) _ -> (AbsLtEq, n) (T.stripPrefix "<" -> Just s) -> let n = readDef err (T.unpack s) in case n of 0 -> (Lt, 0) _ -> (AbsLt, n) (T.stripPrefix ">=" -> Just s) -> let n = readDef err (T.unpack s) in case n of 0 -> (GtEq, 0) _ -> (AbsGtEq, n) (T.stripPrefix ">" -> Just s) -> let n = readDef err (T.unpack s) in case n of 0 -> (Gt, 0) _ -> (AbsGt, n) (T.stripPrefix "=" -> Just s) -> (AbsEq, readDef err (T.unpack s)) s -> (AbsEq, readDef err (T.unpack s)) where err = error' $ "could not parse as '=', '<', or '>' (optional) followed by a (optionally signed) numeric quantity: " ++ T.unpack s' parseTag :: T.Text -> (Regexp, Maybe Regexp) parseTag s | "=" `T.isInfixOf` s = (T.unpack n, Just $ tail $ T.unpack v) | otherwise = (T.unpack s, Nothing) 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 latest ? earliestMaybeDate :: [Maybe Day] -> Maybe Day earliestMaybeDate mds = head $ sortBy compareMaybeDates mds ++ [Nothing] -- | What is the latest of these dates, where Nothing is earliest ? latestMaybeDate :: [Maybe Day] -> Maybe Day latestMaybeDate = headDef Nothing . sortBy (flip compareMaybeDates) -- | What is the earliest of these dates, ignoring Nothings ? earliestMaybeDate' :: [Maybe Day] -> Maybe Day earliestMaybeDate' = headDef Nothing . sortBy compareMaybeDates . filter isJust -- | What is the latest of these dates, ignoring Nothings ? latestMaybeDate' :: [Maybe Day] -> Maybe Day latestMaybeDate' = headDef Nothing . sortBy (flip compareMaybeDates) . filter isJust -- | Compare two maybe dates, Nothing is earliest. compareMaybeDates :: Maybe Day -> Maybe Day -> Ordering compareMaybeDates Nothing Nothing = EQ compareMaybeDates Nothing (Just _) = LT compareMaybeDates (Just _) Nothing = GT compareMaybeDates (Just a) (Just b) = compare a b -- | The depth limit this query specifies, or a large number if none. queryDepth :: Query -> Int queryDepth q = case queryDepth' q of [] -> 99999 ds -> minimum ds 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. 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 = regexMatchesCI 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) s = regexMatchesCI ("^" ++ r ++ "$") (T.unpack s) matchesCommodity _ _ = 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 = regexMatchesCI r $ maybe "" (T.unpack . tcode) $ ptransaction p matchesPosting (Desc r) p = regexMatchesCI r $ maybe "" (T.unpack . tdescription) $ ptransaction p matchesPosting (Acct r) p = matchesPosting p || matchesPosting (originalPosting p) where matchesPosting p = regexMatchesCI 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 == isZeroMixedAmount a -- matchesPosting (Empty False) Posting{pamount=a} = True -- matchesPosting (Empty True) Posting{pamount=a} = isZeroMixedAmount a matchesPosting (Empty _) _ = True matchesPosting (Sym r) Posting{pamount=Mixed as} = any (matchesCommodity (Sym r)) $ map acommodity as matchesPosting (Tag n v) p = case (n, v) of ("payee", Just v) -> maybe False (regexMatchesCI v . T.unpack . transactionPayee) $ ptransaction p ("note", Just v) -> maybe False (regexMatchesCI v . T.unpack . transactionNote) $ ptransaction p (n, 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 = regexMatchesCI r $ T.unpack $ tcode t matchesTransaction (Desc r) t = regexMatchesCI 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 (n, v) of ("payee", Just v) -> regexMatchesCI v . T.unpack . transactionPayee $ t ("note", Just v) -> regexMatchesCI v . T.unpack . transactionNote $ t (n, v) -> matchesTags n v $ transactionAllTags t -- | Filter a list of tags by matching against their names and -- optionally also their values. matchesTags :: Regexp -> Maybe Regexp -> [Tag] -> Bool matchesTags namepat valuepat = not . null . filter (match namepat valuepat) where match npat Nothing (n,_) = regexMatchesCI npat (T.unpack n) -- XXX match npat (Just vpat) (n,v) = regexMatchesCI npat (T.unpack n) && regexMatchesCI vpat (T.unpack v) -- | Does the query match this market price ? matchesMarketPrice :: Query -> MarketPrice -> Bool matchesMarketPrice (None) _ = False matchesMarketPrice (Not q) p = not $ matchesMarketPrice q p matchesMarketPrice (Or qs) p = any (`matchesMarketPrice` p) qs matchesMarketPrice (And qs) p = all (`matchesMarketPrice` p) qs matchesMarketPrice q@(Amt _ _) p = matchesAmount q (mpamount p) matchesMarketPrice q@(Sym _) p = matchesCommodity q (mpcommodity p) matchesMarketPrice (Date span) p = spanContainsDate span (mpdate p) matchesMarketPrice _ _ = True -- tests tests_Query = tests "Query" [ tests "simplifyQuery" [ (simplifyQuery $ Or [Acct "a"]) `is` (Acct "a") ,(simplifyQuery $ Or [Any,None]) `is` (Any) ,(simplifyQuery $ And [Any,None]) `is` (None) ,(simplifyQuery $ And [Any,Any]) `is` (Any) ,(simplifyQuery $ And [Acct "b",Any]) `is` (Acct "b") ,(simplifyQuery $ And [Any,And [Date (DateSpan Nothing Nothing)]]) `is` (Any) ,(simplifyQuery $ And [Date (DateSpan Nothing (Just $ parsedate "2013-01-01")), Date (DateSpan (Just $ parsedate "2012-01-01") Nothing)]) `is` (Date (DateSpan (Just $ parsedate "2012-01-01") (Just $ parsedate "2013-01-01"))) ,(simplifyQuery $ And [Or [],Or [Desc "b b"]]) `is` (Desc "b b") ] ,tests "parseQuery" [ (parseQuery nulldate "acct:'expenses:autres d\233penses' desc:b") `is` (And [Acct "expenses:autres d\233penses", Desc "b"], []) ,parseQuery nulldate "inacct:a desc:\"b b\"" `is` (Desc "b b", [QueryOptInAcct "a"]) ,parseQuery nulldate "inacct:a inacct:b" `is` (Any, [QueryOptInAcct "a", QueryOptInAcct "b"]) ,parseQuery nulldate "desc:'x x'" `is` (Desc "x x", []) ,parseQuery nulldate "'a a' 'b" `is` (Or [Acct "a a",Acct "'b"], []) ,parseQuery nulldate "\"" `is` (Acct "\"", []) ] ,tests "words''" [ (words'' [] "a b") `is` ["a","b"] , (words'' [] "'a b'") `is` ["a b"] , (words'' [] "not:a b") `is` ["not:a","b"] , (words'' [] "not:'a b'") `is` ["not:a b"] , (words'' [] "'not:a b'") `is` ["not:a b"] , (words'' ["desc:"] "not:desc:'a b'") `is` ["not:desc:a b"] , (words'' prefixes "\"acct:expenses:autres d\233penses\"") `is` ["acct:expenses:autres d\233penses"] , (words'' prefixes "\"") `is` ["\""] ] ,tests "filterQuery" [ filterQuery queryIsDepth Any `is` Any ,filterQuery queryIsDepth (Depth 1) `is` Depth 1 ,filterQuery (not.queryIsDepth) (And [And [StatusQ Cleared,Depth 1]]) `is` StatusQ Cleared ,filterQuery queryIsDepth (And [Date nulldatespan, Not (Or [Any, Depth 1])]) `is` Any -- XXX unclear ] ,tests "parseQueryTerm" [ parseQueryTerm nulldate "a" `is` (Left $ Acct "a") ,parseQueryTerm nulldate "acct:expenses:autres d\233penses" `is` (Left $ Acct "expenses:autres d\233penses") ,parseQueryTerm nulldate "not:desc:a b" `is` (Left $ Not $ Desc "a b") ,parseQueryTerm nulldate "status:1" `is` (Left $ StatusQ Cleared) ,parseQueryTerm nulldate "status:*" `is` (Left $ StatusQ Cleared) ,parseQueryTerm nulldate "status:!" `is` (Left $ StatusQ Pending) ,parseQueryTerm nulldate "status:0" `is` (Left $ StatusQ Unmarked) ,parseQueryTerm nulldate "status:" `is` (Left $ StatusQ Unmarked) ,parseQueryTerm nulldate "payee:x" `is` (Left $ Tag "payee" (Just "x")) ,parseQueryTerm nulldate "note:x" `is` (Left $ Tag "note" (Just "x")) ,parseQueryTerm nulldate "real:1" `is` (Left $ Real True) ,parseQueryTerm nulldate "date:2008" `is` (Left $ Date $ DateSpan (Just $ parsedate "2008/01/01") (Just $ parsedate "2009/01/01")) ,parseQueryTerm nulldate "date:from 2012/5/17" `is` (Left $ Date $ DateSpan (Just $ parsedate "2012/05/17") Nothing) ,parseQueryTerm nulldate "date:20180101-201804" `is` (Left $ Date $ DateSpan (Just $ parsedate "2018/01/01") (Just $ parsedate "2018/04/01")) ,parseQueryTerm nulldate "inacct:a" `is` (Right $ QueryOptInAcct "a") ,parseQueryTerm nulldate "tag:a" `is` (Left $ Tag "a" Nothing) ,parseQueryTerm nulldate "tag:a=some value" `is` (Left $ Tag "a" (Just "some value")) ,parseQueryTerm nulldate "amt:<0" `is` (Left $ Amt Lt 0) ,parseQueryTerm nulldate "amt:>10000.10" `is` (Left $ Amt AbsGt 10000.1) ] ,tests "parseAmountQueryTerm" [ parseAmountQueryTerm "<0" `is` (Lt,0) -- special case for convenience, since AbsLt 0 would be always false ,parseAmountQueryTerm ">0" `is` (Gt,0) -- special case for convenience and consistency with above ,parseAmountQueryTerm ">10000.10" `is` (AbsGt,10000.1) ,parseAmountQueryTerm "=0.23" `is` (AbsEq,0.23) ,parseAmountQueryTerm "0.23" `is` (AbsEq,0.23) ,parseAmountQueryTerm "<=+0.23" `is` (LtEq,0.23) ,parseAmountQueryTerm "-0.23" `is` (Eq,(-0.23)) ,_test "number beginning with decimal mark" $ parseAmountQueryTerm "=.23" `is` (AbsEq,0.23) -- XXX ] ,tests "matchesAccount" [ expect $ (Acct "b:c") `matchesAccount` "a:bb:c:d" ,expect $ not $ (Acct "^a:b") `matchesAccount` "c:a:b" ,expect $ Depth 2 `matchesAccount` "a" ,expect $ Depth 2 `matchesAccount` "a:b" ,expect $ not $ Depth 2 `matchesAccount` "a:b:c" ,expect $ Date nulldatespan `matchesAccount` "a" ,expect $ Date2 nulldatespan `matchesAccount` "a" ,expect $ not $ (Tag "a" Nothing) `matchesAccount` "a" ] ,tests "matchesPosting" [ test "positive match on cleared posting status" $ expect $ (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared} ,test "negative match on cleared posting status" $ expect $ not $ (Not $ StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared} ,test "positive match on unmarked posting status" $ expect $ (StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked} ,test "negative match on unmarked posting status" $ expect $ not $ (Not $ StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked} ,test "positive match on true posting status acquired from transaction" $ expect $ (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Unmarked,ptransaction=Just nulltransaction{tstatus=Cleared}} ,test "real:1 on real posting" $ expect $ (Real True) `matchesPosting` nullposting{ptype=RegularPosting} ,test "real:1 on virtual posting fails" $ expect $ not $ (Real True) `matchesPosting` nullposting{ptype=VirtualPosting} ,test "real:1 on balanced virtual posting fails" $ expect $ not $ (Real True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting} ,test "a" $ expect $ (Acct "'b") `matchesPosting` nullposting{paccount="'b"} ,test "b" $ expect $ not $ (Tag "a" (Just "r$")) `matchesPosting` nullposting ,test "c" $ expect $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","")]} ,test "d" $ expect $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","baz")]} ,test "e" $ expect $ (Tag "foo" (Just "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]} ,test "f" $ expect $ not $ (Tag "foo" (Just "a$")) `matchesPosting` nullposting{ptags=[("foo","bar")]} ,test "g" $ expect $ not $ (Tag " foo " (Just "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]} ,test "h" $ expect $ not $ (Tag "foo foo" (Just " ar ba ")) `matchesPosting` nullposting{ptags=[("foo foo","bar bar")]} -- a tag match on a posting also sees inherited tags ,test "i" $ expect $ (Tag "txntag" Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}} ,test "j" $ expect $ not $ (Sym "$") `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- becomes "^$$", ie testing for null symbol ,test "k" $ expect $ (Sym "\\$") `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- have to quote $ for regexpr ,test "l" $ expect $ (Sym "shekels") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]} ,test "m" $ expect $ not $ (Sym "shek") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]} ] ,tests "matchesTransaction" [ expect $ Any `matchesTransaction` nulltransaction ,expect $ not $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x"} ,expect $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x x"} -- see posting for more tag tests ,expect $ (Tag "foo" (Just "a")) `matchesTransaction` nulltransaction{ttags=[("foo","bar")]} ,expect $ (Tag "payee" (Just "payee")) `matchesTransaction` nulltransaction{tdescription="payee|note"} ,expect $ (Tag "note" (Just "note")) `matchesTransaction` nulltransaction{tdescription="payee|note"} -- a tag match on a transaction also matches posting tags ,expect $ (Tag "postingtag" Nothing) `matchesTransaction` nulltransaction{tpostings=[nullposting{ptags=[("postingtag","")]}]} ] ] hledger-lib-1.12/Hledger/Read.hs0000644000000000000000000003147613372610345014601 0ustar0000000000000000{-| 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 ScopedTypeVariables, OverloadedStrings #-} module Hledger.Read ( -- * Journal files PrefixedFilePath, defaultJournal, defaultJournalPath, readJournalFiles, readJournalFile, requireJournalFileExists, ensureJournalFileExists, splitReaderPrefix, -- * Journal parsing readJournal, readJournal', -- * Re-exported JournalReader.postingp, module Hledger.Read.Common, -- * Tests tests_Read, ) where import Control.Arrow (right) import qualified Control.Exception as C import Control.Monad.Except import Data.Default import Data.List import Data.Maybe import Data.Ord import Data.Text (Text) import qualified Data.Text as T import Data.Time (Day) import Safe import System.Directory (doesFileExist, getHomeDirectory) import System.Environment (getEnv) import System.Exit (exitFailure) import System.FilePath import System.IO import Text.Printf import Hledger.Data.Dates (getCurrentDay, parsedate, showDate) import Hledger.Data.Types import Hledger.Read.Common import Hledger.Read.JournalReader as JournalReader -- import qualified Hledger.Read.LedgerReader as LedgerReader import qualified Hledger.Read.TimedotReader as TimedotReader import qualified Hledger.Read.TimeclockReader as TimeclockReader import Hledger.Read.CsvReader as CsvReader import Hledger.Utils import Prelude hiding (getContents, writeFile) journalEnvVar = "LEDGER_FILE" journalEnvVar2 = "LEDGER" journalDefaultFilename = ".hledger.journal" -- The available journal readers, each one handling a particular data format. readers :: [Reader] readers = [ JournalReader.reader ,TimeclockReader.reader ,TimedotReader.reader ,CsvReader.reader -- ,LedgerReader.reader ] readerNames :: [String] readerNames = map rFormat readers -- | A file path optionally prefixed by a reader name and colon -- (journal:, csv:, timedot:, etc.). type PrefixedFilePath = FilePath -- | Read the default journal file specified by the environment, or raise an error. defaultJournal :: IO Journal defaultJournal = defaultJournalPath >>= readJournalFile def >>= either error' return -- | 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 -- | 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] -- | 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. ensureJournalFileExists :: FilePath -> IO () ensureJournalFileExists f = do 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 -- | 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) -- | Read a Journal from the given text trying all readers in turn, or throw an error. readJournal' :: Text -> IO Journal readJournal' t = readJournal def Nothing t >>= either error' return -- | @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 :: Maybe StorageFormat -> Maybe FilePath -> Maybe Reader 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 = drop 1 $ takeExtension path' -- | 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 -> [FilePath] -> IO (Either String Journal) readJournalFiles iopts = (right mconcat1 . sequence <$>) . mapM (readJournalFile iopts) where mconcat1 :: Monoid t => [t] -> t mconcat1 [] = mempty mconcat1 x = foldr1 mappend x -- | 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, all built-in readers are tried in turn. -- -- 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_=firstJust [mfmt, mformat_ iopts]} requireJournalFileExists f t <- readFileOrStdinPortably f 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 -- 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 exists <- doesFileExist latestfile if exists then map (parsedate . strip) . lines . strip . T.unpack <$> 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 -- | @readJournal iopts mfile txt@ -- -- Read a Journal from some text, or return an error message. -- -- The reader (data format) is chosen based on a recognised file name extension in @mfile@ (if provided). -- If it does not identify a known reader, all built-in readers are tried in turn -- (returning the first one's error message if none of them succeed). -- -- Input ioptions (@iopts@) specify CSV conversion rules file to help convert CSV data, -- enable or disable balance assertion checking and automated posting generation. -- readJournal :: InputOpts -> Maybe FilePath -> Text -> IO (Either String Journal) readJournal iopts mfile txt = tryReaders iopts mfile specifiedorallreaders txt where specifiedorallreaders = maybe stablereaders (:[]) $ findReader (mformat_ iopts) mfile stablereaders = filter (not.rExperimental) readers -- | @tryReaders iopts readers path t@ -- -- Try to parse the given text to a Journal using each reader in turn, -- returning the first success, or if all of them fail, the first error message. -- -- Input ioptions (@iopts@) specify CSV conversion rules file to help convert CSV data, -- enable or disable balance assertion checking and automated posting generation. -- tryReaders :: InputOpts -> Maybe FilePath -> [Reader] -> Text -> IO (Either String Journal) tryReaders iopts mpath readers txt = firstSuccessOrFirstError [] readers where firstSuccessOrFirstError :: [String] -> [Reader] -> IO (Either String Journal) firstSuccessOrFirstError [] [] = return $ Left "no readers found" firstSuccessOrFirstError errs (r:rs) = do dbg1IO "trying reader" (rFormat r) result <- (runExceptT . (rParser r) iopts path) txt dbg1IO "reader result" $ either id show result case result of Right j -> return $ Right j -- success! Left e -> firstSuccessOrFirstError (errs++[e]) rs -- keep trying firstSuccessOrFirstError (e:_) [] = return $ Left e -- none left, return first error path = fromMaybe "(string)" mpath --- -- tests tests_Read = tests "Read" [ tests_Common ,tests_CsvReader ,tests_JournalReader ] --samplejournal = readJournal' $ T.unlines -- ["2008/01/01 income" -- ," assets:bank:checking $1" -- ," income:salary" -- ,"" -- ,"comment" -- ,"multi line comment here" -- ,"for testing purposes" -- ,"end comment" -- ,"" -- ,"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/12/31 * pay off" -- ," liabilities:debts $1" -- ," assets:bank:checking" -- ] hledger-lib-1.12/Hledger/Read/Common.hs0000644000000000000000000014472213401076725016031 0ustar0000000000000000--- * doc -- Lines beginning "--- *" are collapsible orgstruct nodes. Emacs users, -- (add-hook 'haskell-mode-hook -- (lambda () (set-variable 'orgstruct-heading-prefix-regexp "--- " t)) -- 'orgstruct-mode) -- and press TAB on nodes to expand/collapse. {-| Some common parsers and helpers used by several readers. Some of these might belong in Hledger.Read.JournalReader or Hledger.Read. -} --- * module {-# LANGUAGE CPP, BangPatterns, DeriveDataTypeable, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections, OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE PackageImports #-} module Hledger.Read.Common ( Reader (..), InputOpts (..), definputopts, rawOptsToInputOpts, -- * parsing utilities runTextParser, rtp, runJournalParser, rjp, runErroringJournalParser, rejp, genericSourcePos, journalSourcePos, applyTransactionModifiers, parseAndFinaliseJournal, parseAndFinaliseJournal', setYear, getYear, setDefaultCommodityAndStyle, getDefaultCommodityAndStyle, getDefaultAmountStyle, getAmountStyle, pushDeclaredAccount, 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, fixedlotpricep, numberp, fromRawNumber, rawnumberp, -- ** comments multilinecommentp, emptyorcommentlinep, followingcommentp, transactioncommentp, postingcommentp, -- ** bracketed dates bracketeddatetagsp, -- ** misc singlespacedtextp, singlespacedtextsatisfyingp, singlespacep, -- * tests tests_Common, ) where --- * imports import Prelude () import "base-compat-batteries" Prelude.Compat hiding (readFile) import "base-compat-batteries" Control.Monad.Compat import Control.Monad.Except (ExceptT(..), runExceptT, throwError) import Control.Monad.State.Strict import Data.Bifunctor (bimap, second) import Data.Char import Data.Data import Data.Decimal (DecimalRaw (Decimal), Decimal) import Data.Default import Data.Functor.Identity import "base-compat-batteries" Data.List.Compat import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe 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 import Data.Time.LocalTime import System.Time (getClockTime) import Text.Megaparsec import Text.Megaparsec.Char import Text.Megaparsec.Char.Lexer (decimal) import Text.Megaparsec.Custom import Hledger.Data import Hledger.Utils -- $setup -- >>> :set -XOverloadedStrings -- | A hledger journal reader is a triple of storage format name, a -- detector of that format, and a parser from that format to Journal. data Reader = Reader { -- The canonical name of the format handled by this reader rFormat :: StorageFormat -- The file extensions recognised as containing this format ,rExtensions :: [String] -- A text parser for this format, accepting input options, file -- path for error messages and file contents, producing an exception-raising IO -- action that returns a journal or error message. ,rParser :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal -- Experimental readers are never tried automatically. ,rExperimental :: Bool } instance Show Reader 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) ,separator_ :: Char -- ^ the separator 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, Data) --, Typeable) 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_ = map (T.unpack . stripquotes . T.pack) $ listofstringopt "file" rawopts mformat_ = Nothing ,mrules_file_ = maybestringopt "rules-file" rawopts ,separator_ = fromMaybe ',' (maybecharopt "separator" rawopts) ,aliases_ = map (T.unpack . stripquotes . T.pack) $ 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 mempty) "" 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 mempty) "" t rejp = runErroringJournalParser genericSourcePos :: SourcePos -> GenericSourcePos genericSourcePos p = GenericSourcePos (sourceName p) (fromIntegral . unPos $ sourceLine p) (fromIntegral . 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) (fromIntegral . unPos $ sourceLine p, fromIntegral $ 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 -- | Apply any transaction modifier rules in the journal -- (adding automated postings to transactions, eg). applyTransactionModifiers :: Journal -> Journal applyTransactionModifiers j = j { jtxns = map applyallmodifiers $ jtxns j } where applyallmodifiers = foldr (flip (.) . transactionModifierToFunction) id (jtxnmodifiers j) -- | Given a megaparsec ParsedJournal parser, input options, file -- path and file content: parse and post-process a Journal, or give an error. parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> InputOpts -> FilePath -> Text -> ExceptT String IO Journal parseAndFinaliseJournal parser iopts f txt = do t <- liftIO getClockTime y <- liftIO getCurrentYear let initJournal = nulljournal { jparsedefaultyear = Just y , jincludefilestack = [f] } eep <- liftIO $ runExceptT $ runParserT (evalStateT parser initJournal) f txt case eep of Left finalParseError -> throwError $ finalErrorBundlePretty $ attachSource f txt finalParseError Right ep -> case ep of Left e -> throwError $ customErrorBundlePretty e Right pj -> -- If we are using automated transactions, we finalize twice: -- once before and once after. However, if we are running it -- twice, we don't check assertions the first time (they might -- be false pending modifiers) and we don't reorder the second -- time. If we are only running once, we reorder and follow -- the options for checking assertions. let fj = if auto_ iopts && (not . null . jtxnmodifiers) pj then applyTransactionModifiers <$> (journalBalanceTransactions False $ journalReverse $ journalApplyCommodityStyles pj) >>= (\j -> journalBalanceTransactions (not $ ignore_assertions_ iopts) $ journalAddFile (f, txt) $ journalSetLastReadTime t $ j) else journalBalanceTransactions (not $ ignore_assertions_ iopts) $ journalReverse $ journalAddFile (f, txt) $ journalApplyCommodityStyles $ journalSetLastReadTime t $ pj in case fj of Right j -> return j Left e -> throwError e parseAndFinaliseJournal' :: JournalParser IO ParsedJournal -> InputOpts -> FilePath -> Text -> ExceptT String IO Journal parseAndFinaliseJournal' parser iopts f txt = do t <- liftIO getClockTime y <- liftIO getCurrentYear let initJournal = nulljournal { jparsedefaultyear = Just y , jincludefilestack = [f] } ep <- liftIO $ runParserT (evalStateT parser initJournal) f txt case ep of Left e -> throwError $ customErrorBundlePretty e Right pj -> -- If we are using automated transactions, we finalize twice: -- once before and once after. However, if we are running it -- twice, we don't check assertions the first time (they might -- be false pending modifiers) and we don't reorder the second -- time. If we are only running once, we reorder and follow the -- options for checking assertions. let fj = if auto_ iopts && (not . null . jtxnmodifiers) pj then applyTransactionModifiers <$> (journalBalanceTransactions False $ journalReverse $ journalApplyCommodityStyles pj) >>= (\j -> journalBalanceTransactions (not $ ignore_assertions_ iopts) $ journalAddFile (f, txt) $ journalSetLastReadTime t $ j) else journalBalanceTransactions (not $ ignore_assertions_ iopts) $ journalReverse $ journalAddFile (f, txt) $ journalApplyCommodityStyles $ journalSetLastReadTime t $ pj in case fj of Right j -> return j Left e -> throwError e 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 pushDeclaredAccount :: AccountName -> JournalParser m () pushDeclaredAccount acct = modify' (\j -> j{jdeclaredaccounts = acct : jdeclaredaccounts j}) 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@Journal{..}) -> 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 --- * parsers --- ** transaction bits statusp :: TextParser m Status statusp = choice' [ skipMany spacenonewline >> char '*' >> return Cleared , skipMany spacenonewline >> char '!' >> return Pending , return Unmarked ] codep :: TextParser m Text codep = option "" $ do try $ do skipSome spacenonewline 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. -- 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. datep :: JournalParser m Day datep = do mYear <- getYear lift $ datep' mYear datep' :: Maybe Year -> TextParser m Day datep' mYear = do startOffset <- getOffset d1 <- decimal "year or month" sep <- satisfy isDateSepChar "date separator" d2 <- decimal "month or day" fullDate startOffset d1 sep d2 <|> partialDate startOffset mYear d1 sep d2 "full or partial date" where fullDate :: Int -> Integer -> Char -> Int -> 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 -> Integer -> Char -> Int -> TextParser m Day partialDate startOffset mYear month sep day = do endOffset <- getOffset case mYear of Just year -> case fromGregorianValid year (fromIntegral 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. -- Hyphen (-) 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 skipSome spacenonewline 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 --- ** 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). modifiedaccountnamep :: JournalParser m AccountName modifiedaccountnamep = do parent <- getParentAccount aliases <- getAccountAliases a <- lift accountnamep return $! accountNameApplyAliases aliases $ -- XXX accountNameApplyAliasesMemo ? doesn't seem to make a difference joinAccountNames parent a -- | 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. 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 = void 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 $ skipSome spacenonewline Mixed . (:[]) <$> amountp -- | Parse a single-commodity amount, with optional symbol on the left or -- right, optional unit or total price, and optional (ignored) -- ledger-style balance assertion or fixed lot price declaration. amountp :: JournalParser m Amount amountp = label "amount" $ do amount <- amountwithoutpricep lift $ skipMany spacenonewline price <- priceamountp pure $ amount { aprice = price } 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 $ skipMany' spacenonewline 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 $ Amount c (sign (sign2 q)) NoPrice s mult 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 $ (,) <$> skipMany' spacenonewline <*> 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 $ Amount c (sign q) NoPrice s mult -- 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 $ Amount c (sign q) NoPrice s mult -- 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 Int -> TextParser m (Quantity, Int, 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 res -> pure res -- | Parse an amount from a string, or get an error. amountp' :: String -> Amount amountp' s = case runParser (evalStateT (amountp <* eof) mempty) "" (T.pack s) of Right amt -> amt Left err -> error' $ show err -- XXX should throwError -- | Parse a mixed amount from a string, or get an error. mamountp' :: String -> MixedAmount mamountp' = Mixed . (:[]) . amountp' signp :: Num a => TextParser m (a -> a) signp = char '-' *> pure negate <|> char '+' *> pure id <|> pure id multiplierp :: TextParser m Bool multiplierp = option False $ char '*' *> pure True -- | This is like skipMany but it returns True if at least one element -- was skipped. This is helpful if you’re just using many to check if -- the resulting list is empty or not. skipMany' :: MonadPlus m => m a -> m Bool skipMany' p = go False where go !isNull = do more <- option False (True <$ p) if more then go True else pure isNull 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 Price priceamountp = option NoPrice $ do char '@' priceConstructor <- char '@' *> pure TotalPrice <|> pure UnitPrice lift (skipMany spacenonewline) priceAmount <- amountwithoutpricep "amount (as a price)" pure $ priceConstructor priceAmount balanceassertionp :: JournalParser m BalanceAssertion balanceassertionp = do sourcepos <- genericSourcePos <$> lift getSourcePos char '=' exact <- optional $ try $ char '=' lift (skipMany spacenonewline) a <- amountp "amount (for a balance assertion or assignment)" -- XXX should restrict to a simple amount return BalanceAssertion { baamount = a , baexact = isJust exact , baposition = sourcepos } -- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices fixedlotpricep :: JournalParser m (Maybe Amount) fixedlotpricep = optional $ do try $ do lift (skipMany spacenonewline) char '{' lift (skipMany spacenonewline) char '=' lift (skipMany spacenonewline) a <- amountp -- XXX should restrict to a simple amount lift (skipMany spacenonewline) char '}' return a -- | 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 point, 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 point), the decimal point character used if any, -- and the digit group style if any. -- numberp :: Maybe AmountStyle -> TextParser m (Quantity, Int, 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 dbg8 "numberp suggestedStyle" suggestedStyle `seq` return () case dbg8 "numberp quantity,precision,mdecimalpoint,mgrps" $ fromRawNumber rawNum mExp of Left errMsg -> fail errMsg Right (q, p, d, g) -> pure (sign q, p, d, g) exponentp :: TextParser m Int 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 Int -> Either String (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) fromRawNumber raw mExp = case raw of NoSeparators digitGrp mDecimals -> let mDecPt = fmap fst mDecimals decimalGrp = maybe mempty snd mDecimals (quantity, precision) = maybe id applyExp mExp $ toQuantity digitGrp decimalGrp in Right (quantity, precision, mDecPt, Nothing) WithSeparators digitSep digitGrps mDecimals -> case mExp of Nothing -> let mDecPt = fmap fst mDecimals decimalGrp = maybe mempty snd mDecimals digitGroupStyle = DigitGroups digitSep (groupSizes digitGrps) (quantity, precision) = toQuantity (mconcat digitGrps) decimalGrp in Right (quantity, precision, mDecPt, Just digitGroupStyle) Just _ -> Left "invalid number: mixing digit separators with exponents is not allowed" where -- Outputs digit group sizes from least significant to most significant groupSizes :: [DigitGrp] -> [Int] groupSizes digitGrps = reverse $ case map digitGroupLength digitGrps of (a:b:cs) | a < b -> b:cs gs -> gs toQuantity :: DigitGrp -> DigitGrp -> (Quantity, Int) toQuantity preDecimalGrp postDecimalGrp = (quantity, precision) where quantity = Decimal (fromIntegral precision) (digitGroupNumber $ preDecimalGrp <> postDecimalGrp) precision = digitGroupLength postDecimalGrp applyExp :: Int -> (Decimal, Int) -> (Decimal, Int) applyExp exponent (quantity, precision) = (quantity * 10^^exponent, max 0 (precision - exponent)) 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 = 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 -- point, which may be either a period or comma. (2) Numbers may -- optionally contain digit group separators, which must all be either a -- period, a comma, or a space. -- -- It is our task to deduce the identities of the decimal point and digit -- separator characters, based on the allowed syntax. For instance, we -- make use of the fact that a decimal point can occur at most once and -- must succeed all digit group separators. -- -- >>> 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 "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 $ dbg8 "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 == ' ' data DigitGrp = DigitGrp { digitGroupLength :: !Int, digitGroupNumber :: !Integer } deriving (Eq) instance Show DigitGrp where show (DigitGrp len num) | len > 0 = "\"" ++ padding ++ numStr ++ "\"" | otherwise = "\"\"" where numStr = show num padding = replicate (len - 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)) data RawNumber = NoSeparators DigitGrp (Maybe (Char, DigitGrp)) -- 100 or 100. or .100 or 100.50 | WithSeparators Char [DigitGrp] (Maybe (Char, DigitGrp)) -- 1,000,000 or 1,000.50 deriving (Show, Eq) data AmbiguousNumber = AmbiguousNumber DigitGrp Char DigitGrp -- 1,000 deriving (Show, Eq) --- ** comments multilinecommentp :: TextParser m () multilinecommentp = startComment *> anyLine `skipManyTill` endComment where startComment = string "comment" *> trailingSpaces endComment = eof <|> string "end comment" *> trailingSpaces trailingSpaces = skipMany spacenonewline <* newline anyLine = void $ takeWhileP Nothing (\c -> c /= '\n') *> newline {-# INLINABLE multilinecommentp #-} emptyorcommentlinep :: TextParser m () emptyorcommentlinep = do skipMany spacenonewline skiplinecommentp <|> void newline where -- A line (file-level) comment can start with a semicolon, hash, or star -- (allowing org nodes). 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 -- preceeded 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 skipMany spacenonewline -- there can be 0 or 1 sameLine sameLine <- try headerp *> ((:[]) <$> match' contentp) <|> pure [] _ <- eolof -- there can be 0 or more nextLines nextLines <- many $ try (skipSome spacenonewline *> 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 ';' *> skipMany spacenonewline {-# 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')) {-# 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 preceeded 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 skipMany spacenonewline 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 preceeded 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 skipMany spacenonewline (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 #-} --- ** bracketed dates -- | 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 "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 #-} --- ** helper parsers -- 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) --- * tests tests_Common = tests "Common" [ tests "amountp" [ test "basic" $ expectParseEq amountp "$47.18" (usd 47.18) ,test "ends with decimal mark" $ expectParseEq amountp "$1." (usd 1 `withPrecision` 0) ,test "unit price" $ expectParseEq 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=0, asdecimalpoint=Nothing} ,aprice=UnitPrice $ amount{ acommodity="€" ,aquantity=0.5 ,astyle=amountstyle{asprecision=1, asdecimalpoint=Just '.'} } } ,test "total price" $ expectParseEq amountp "$10 @@ €5" amount{ acommodity="$" ,aquantity=10 ,astyle=amountstyle{asprecision=0, asdecimalpoint=Nothing} ,aprice=TotalPrice $ amount{ acommodity="€" ,aquantity=5 ,astyle=amountstyle{asprecision=0, asdecimalpoint=Nothing} } } ] ,let p = lift (numberp Nothing) :: JournalParser IO (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) in tests "numberp" [ test "." $ expectParseEq p "0" (0, 0, Nothing, Nothing) ,test "." $ expectParseEq p "1" (1, 0, Nothing, Nothing) ,test "." $ expectParseEq p "1.1" (1.1, 1, Just '.', Nothing) ,test "." $ expectParseEq p "1,000.1" (1000.1, 1, Just '.', Just $ DigitGroups ',' [3]) ,test "." $ expectParseEq p "1.00.000,1" (100000.1, 1, Just ',', Just $ DigitGroups '.' [3,2]) ,test "." $ expectParseEq p "1,000,000" (1000000, 0, Nothing, Just $ DigitGroups ',' [3,3]) -- could be simplified to [3] ,test "." $ expectParseEq p "1." (1, 0, Just '.', Nothing) ,test "." $ expectParseEq p "1," (1, 0, Just ',', Nothing) ,test "." $ expectParseEq p ".1" (0.1, 1, Just '.', Nothing) ,test "." $ expectParseEq p ",1" (0.1, 1, Just ',', Nothing) ,test "." $ expectParseError p "" "" ,test "." $ expectParseError p "1,000.000,1" "" ,test "." $ expectParseError p "1.000,000.1" "" ,test "." $ expectParseError p "1,000.000.1" "" ,test "." $ expectParseError p "1,,1" "" ,test "." $ expectParseError p "1..1" "" ,test "." $ expectParseError p ".1," "" ,test "." $ expectParseError p ",1." "" ] ,tests "spaceandamountormissingp" [ test "space and amount" $ expectParseEq spaceandamountormissingp " $47.18" (Mixed [usd 47.18]) ,test "empty string" $ expectParseEq spaceandamountormissingp "" missingmixedamt ,_test "just space" $ expectParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ? -- ,test "just amount" $ expectParseError spaceandamountormissingp "$47.18" "" -- succeeds, consuming nothing ] ] hledger-lib-1.12/Hledger/Read/CsvReader.hs0000644000000000000000000010337613401076725016457 0ustar0000000000000000{-| A reader for CSV data, using an extra rules file to help interpret the data. -} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PackageImports #-} module Hledger.Read.CsvReader ( -- * Reader reader, -- * Misc. CsvRecord, CSV, Record, Field, -- rules, rulesFileFor, parseRulesFile, parseAndValidateCsvRules, expandIncludes, transactionFromCsvRecord, printCSV, -- * Tests tests_CsvReader, ) where import Prelude () import "base-compat-batteries" Prelude.Compat import Control.Exception hiding (try) import Control.Monad import Control.Monad.Except import Control.Monad.State.Strict (StateT, get, modify', evalStateT) import Data.Char (toLower, isDigit, isSpace, ord) import "base-compat-batteries" Data.List.Compat import Data.Maybe import Data.Ord 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) #if MIN_VERSION_time(1,5,0) import Data.Time.Format (parseTimeM, defaultTimeLocale) #else import Data.Time.Format (parseTime) import System.Locale (defaultTimeLocale) #endif import Safe import System.Directory (doesFileExist) import System.FilePath 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 import Text.Megaparsec hiding (parse) import Text.Megaparsec.Char import Text.Megaparsec.Custom import Text.Printf (printf) import Hledger.Data import Hledger.Utils import Hledger.Read.Common (Reader(..),InputOpts(..),amountp, statusp, genericSourcePos) type CSV = [Record] type Record = [Field] type Field = String data CSVError = CSVError (ParseErrorBundle BL.ByteString CassavaMP.ConversionError) deriving Show reader :: Reader reader = Reader {rFormat = "csv" ,rExtensions = ["csv"] ,rParser = parse ,rExperimental = False } -- | Parse and post-process a "Journal" from CSV data, or give an error. -- XXX currently ignores the string and reads from the file path parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal parse iopts f t = do let rulesfile = mrules_file_ iopts let separator = separator_ iopts r <- liftIO $ readJournalFromCsv separator rulesfile f t case r of Left e -> throwError e Right j -> return $ journalNumberAndTieTransactions j -- XXX does not use parseAndFinaliseJournal like the other readers -- | 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 :: Char -> Maybe FilePath -> FilePath -> Text -> IO (Either String Journal) readJournalFromCsv _ Nothing "-" _ = return $ Left "please use --rules-file when reading CSV from stdin" readJournalFromCsv separator mrulesfile csvfile csvdata = handle (\e -> return $ Left $ show (e :: IOException)) $ do let throwerr = throw.userError -- parse rules let rulesfile = fromMaybe (rulesFileFor csvfile) mrulesfile rulesfileexists <- doesFileExist rulesfile rulestext <- if rulesfileexists then do dbg1IO "using conversion rules file" rulesfile liftIO $ (readFilePortably rulesfile >>= expandIncludes (takeDirectory rulesfile)) else return $ defaultRulesText rulesfile rules <- liftIO (runExceptT $ parseAndValidateCsvRules rulesfile rulestext) >>= either throwerr return dbg2IO "rules" rules -- apply skip directive let skip = maybe 0 oneorerror $ getDirective "skip" rules where oneorerror "" = 1 oneorerror s = readDef (throwerr $ "could not parse skip value: " ++ show s) s -- parse csv -- parsec seems to fail if you pass it "-" here XXX try again with megaparsec let parsecfilename = if csvfile == "-" then "(stdin)" else csvfile records <- (either throwerr id . dbg2 "validateCsv" . validateCsv skip . dbg2 "parseCsv") `fmap` parseCsv separator parsecfilename csvdata dbg1IO "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, reverse them to get same-date transactions ordered chronologically, -- if the CSV records seem to be most-recent-first, ie if there's an explicit -- "newest-first" directive, or if there's more than one date and the first date -- is more recent than the last. txns' = (if newestfirst || mseemsnewestfirst == Just True then reverse else id) txns where newestfirst = dbg3 "newestfirst" $ isJust $ getDirective "newest-first" rules mseemsnewestfirst = dbg3 "mseemsnewestfirst" $ 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''} parseCsv :: Char -> FilePath -> Text -> IO (Either CSVError CSV) parseCsv separator filePath csvdata = case filePath of "-" -> liftM (parseCassava separator "(stdin)") T.getContents _ -> return $ parseCassava separator filePath csvdata parseCassava :: Char -> FilePath -> Text -> Either CSVError CSV parseCassava separator path content = case parseResult of Left msg -> Left $ CSVError msg Right a -> Right a where parseResult = fmap parseResultToCsv $ CassavaMP.decodeWith (decodeOptions separator) Cassava.NoHeader path lazyContent lazyContent = 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 :: Int -> Either CSVError CSV -> Either String [CsvRecord] validateCsv _ (Left e) = Left $ show e validateCsv numhdrlines (Right rs) = validate $ drop numhdrlines $ filternulls rs where filternulls = filter (/=[""]) validate [] = Right [] validate rs@(first:_) | isJust lessthan2 = let r = fromJust lessthan2 in Left $ printf "CSV record %s has less than two fields" (show r) | isJust different = let r = fromJust different in Left $ printf "the first CSV record %s has %d fields but %s has %d" (show first) length1 (show r) (length r) | otherwise = Right rs where length1 = length first lessthan2 = headMay $ filter ((<2).length) rs different = headMay $ filter ((/=length1).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 -- ] -- rulesFileFor :: CliOpts -> FilePath -> FilePath -- rulesFileFor CliOpts{rules_file_=Just f} _ = f -- rulesFileFor CliOpts{rules_file_=Nothing} csvfile = replaceExtension csvfile ".rules" rulesFileFor :: FilePath -> FilePath rulesFileFor = (++ ".rules") 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, amount" ,"" ,"#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" ] -------------------------------------------------------------------------------- -- Conversion rules parsing {- 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 -} {- | A set of data definitions and account-matching patterns sufficient to convert a particular CSV data file into meaningful journal transactions. -} data CsvRules = CsvRules { rdirectives :: [(DirectiveName,String)], rcsvfieldindexes :: [(CsvFieldName, CsvFieldIndex)], rassignments :: [(JournalFieldName, FieldTemplate)], rconditionalblocks :: [ConditionalBlock] } deriving (Show, Eq) type CsvRulesParser a = StateT CsvRules SimpleTextParser a type DirectiveName = String type CsvFieldName = String type CsvFieldIndex = Int type JournalFieldName = String type FieldTemplate = String type ConditionalBlock = ([RecordMatcher], [(JournalFieldName, FieldTemplate)]) -- block matches if all RecordMatchers match type RecordMatcher = [RegexpPattern] -- match if any regexps match any of the csv fields -- type FieldMatcher = (CsvFieldName, [RegexpPattern]) -- match if any regexps match this csv field type DateFormat = String type RegexpPattern = String rules = CsvRules { rdirectives=[], rcsvfieldindexes=[], rassignments=[], rconditionalblocks=[] } addDirective :: (DirectiveName, String) -> CsvRules -> CsvRules addDirective d r = r{rdirectives=d:rdirectives r} addAssignment :: (JournalFieldName, FieldTemplate) -> CsvRules -> CsvRules addAssignment a r = r{rassignments=a:rassignments r} setIndexesAndAssignmentsFromList :: [CsvFieldName] -> CsvRules -> CsvRules setIndexesAndAssignmentsFromList fs r = addAssignmentsFromList fs . setCsvFieldIndexesFromList fs $ r setCsvFieldIndexesFromList :: [CsvFieldName] -> CsvRules -> CsvRules setCsvFieldIndexesFromList fs r = r{rcsvfieldindexes=zip fs [1..]} addAssignmentsFromList :: [CsvFieldName] -> CsvRules -> CsvRules 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 -> CsvRules -> CsvRules addConditionalBlock b r = r{rconditionalblocks=b:rconditionalblocks r} getDirective :: DirectiveName -> CsvRules -> Maybe FieldTemplate getDirective directivename = lookup directivename . rdirectives instance ShowErrorComponent String where showErrorComponent = id -- | An error-throwing 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)) >>= parseAndValidateCsvRules f -- | 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 a cheap hack to avoid rewriting the CSV rules parser. 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 action that parses this text as CSV conversion rules -- and runs some extra validation checks. The file path is for error messages. parseAndValidateCsvRules :: FilePath -> T.Text -> ExceptT String IO CsvRules parseAndValidateCsvRules rulesfile s = do let rules = parseCsvRules rulesfile s case rules of Left e -> ExceptT $ return $ Left $ customErrorBundlePretty e Right r -> do r_ <- liftIO $ runExceptT $ validateRules r ExceptT $ case r_ of Left s -> return $ Left $ parseErrorPretty $ makeParseError s Right r -> return $ Right r where makeParseError :: String -> ParseError T.Text String makeParseError s = FancyError 0 (S.singleton $ ErrorFail s) -- | 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 rules) rulesfile s -- | Return the validated rules, or an error. validateRules :: CsvRules -> ExceptT String IO CsvRules validateRules rules = do unless (isAssigned "date") $ ExceptT $ return $ Left "Please specify (at top level) the date field. Eg: date %1\n" unless ((amount && not (amountin || amountout)) || (not amount && (amountin && amountout))) $ ExceptT $ return $ Left "Please specify (at top level) either the amount field, or both the amount-in and amount-out fields. Eg: amount %2\n" ExceptT $ return $ Right rules where amount = isAssigned "amount" amountin = isAssigned "amount-in" amountout = isAssigned "amount-out" isAssigned f = isJust $ getEffectiveAssignment rules [] f -- parsers rulesp :: CsvRulesParser CsvRules rulesp = do many $ choiceInState [blankorcommentlinep "blank or comment line" ,(directivep >>= modify' . addDirective) "directive" ,(fieldnamelistp >>= modify' . setIndexesAndAssignmentsFromList) "field name list" ,(fieldassignmentp >>= modify' . addAssignment) "field assignment" ,(conditionalblockp >>= modify' . addConditionalBlock) "conditional block" ] eof r <- get return r{rdirectives=reverse $ rdirectives r ,rassignments=reverse $ rassignments r ,rconditionalblocks=reverse $ rconditionalblocks r } blankorcommentlinep :: CsvRulesParser () blankorcommentlinep = lift (dbgparse 3 "trying blankorcommentlinep") >> choiceInState [blanklinep, commentlinep] blanklinep :: CsvRulesParser () blanklinep = lift (skipMany spacenonewline) >> newline >> return () "blank line" commentlinep :: CsvRulesParser () commentlinep = lift (skipMany spacenonewline) >> commentcharp >> lift restofline >> return () "comment line" commentcharp :: CsvRulesParser Char commentcharp = oneOf (";#*" :: [Char]) directivep :: CsvRulesParser (DirectiveName, String) directivep = (do lift $ dbgparse 3 "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 (skipMany spacenonewline) >> lift eolof >> return "") return (d, v) ) "directive" directives = ["date-format" -- ,"default-account1" -- ,"default-currency" -- ,"skip-lines" -- old ,"skip" ,"newest-first" -- ,"base-account" -- ,"base-currency" ] directivevalp :: CsvRulesParser String directivevalp = anySingle `manyTill` lift eolof fieldnamelistp :: CsvRulesParser [CsvFieldName] fieldnamelistp = (do lift $ dbgparse 3 "trying fieldnamelist" string "fields" optional $ char ':' lift (skipSome spacenonewline) let separator = lift (skipMany spacenonewline) >> char ',' >> lift (skipMany spacenonewline) 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 (JournalFieldName, FieldTemplate) fieldassignmentp = do lift $ dbgparse 3 "trying fieldassignmentp" f <- journalfieldnamep assignmentseparatorp v <- fieldvalp return (f,v) "field assignment" journalfieldnamep :: CsvRulesParser String journalfieldnamep = do lift (dbgparse 2 "trying journalfieldnamep") T.unpack <$> choiceInState (map (lift . string . T.pack) journalfieldnames) -- 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 = [ "account1" ,"account2" ,"amount-in" ,"amount-out" ,"amount" ,"balance" ,"code" ,"comment" ,"currency" ,"date2" ,"date" ,"description" ,"status" ] assignmentseparatorp :: CsvRulesParser () assignmentseparatorp = do lift $ dbgparse 3 "trying assignmentseparatorp" choice [ -- try (lift (skipMany spacenonewline) >> oneOf ":="), try (lift (skipMany spacenonewline) >> char ':'), spaceChar ] _ <- lift (skipMany spacenonewline) return () fieldvalp :: CsvRulesParser String fieldvalp = do lift $ dbgparse 2 "trying fieldvalp" anySingle `manyTill` lift eolof conditionalblockp :: CsvRulesParser ConditionalBlock conditionalblockp = do lift $ dbgparse 3 "trying conditionalblockp" string "if" >> lift (skipMany spacenonewline) >> optional newline ms <- some recordmatcherp as <- many (lift (skipSome spacenonewline) >> fieldassignmentp) when (null as) $ fail "start of conditional block found, but no assignment rules afterward\n(assignment rules in a conditional block should be indented)\n" return (ms, as) "conditional block" recordmatcherp :: CsvRulesParser [String] recordmatcherp = do lift $ dbgparse 2 "trying recordmatcherp" -- pos <- currentPos _ <- optional (matchoperatorp >> lift (skipMany spacenonewline) >> optional newline) ps <- patternsp when (null ps) $ fail "start of record matcher found, but no patterns afterward\n(patterns should not be indented)\n" return ps "record matcher" matchoperatorp :: CsvRulesParser String matchoperatorp = fmap T.unpack $ choiceInState $ map string ["~" -- ,"!~" -- ,"=" -- ,"!=" ] patternsp :: CsvRulesParser [String] patternsp = do lift $ dbgparse 3 "trying patternsp" ps <- many regexp return ps regexp :: CsvRulesParser String regexp = do lift $ dbgparse 3 "trying regexp" notFollowedBy matchoperatorp c <- lift nonspace cs <- anySingle `manyTill` lift eolof return $ strip $ c:cs -- fieldmatcher = do -- dbgparse 2 "trying fieldmatcher" -- f <- fromMaybe "all" `fmap` (optional $ do -- f' <- fieldname -- lift (skipMany spacenonewline) -- return f') -- char '~' -- lift (skipMany spacenonewline) -- ps <- patterns -- let r = "(" ++ intercalate "|" ps ++ ")" -- return (f,r) -- "field matcher" -------------------------------------------------------------------------------- -- Converting CSV records to journal transactions type CsvRecord = [String] -- Convert a CSV record to a transaction using the rules, or raise an -- error if the data can not be parsed. transactionFromCsvRecord :: SourcePos -> CsvRules -> CsvRecord -> Transaction transactionFromCsvRecord sourcepos rules record = t where mdirective = (`getDirective` rules) mfieldtemplate = getEffectiveAssignment rules record render = renderTemplate rules record mskip = mdirective "skip" mdefaultcurrency = mdirective "default-currency" mparsedate = parseDateWithFormatOrDefaultFormats (mdirective "date-format") -- render each field using its template and the csv record, and -- in some cases parse the rendered string (eg dates and amounts) mdateformat = mdirective "date-format" date = render $ fromMaybe "" $ mfieldtemplate "date" date' = fromMaybe (error' $ dateerror "date" date mdateformat) $ mparsedate date mdate2 = maybe Nothing (Just . render) $ mfieldtemplate "date2" mdate2' = maybe Nothing (maybe (error' $ dateerror "date2" (fromMaybe "" mdate2) mdateformat) Just . mparsedate) mdate2 dateerror datefield value mdateformat = unlines ["error: could not parse \""++value++"\" as a date using date format "++maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" show mdateformat ,"the CSV record is: "++intercalate ", " (map show record) ,"the "++datefield++" rule is: "++(fromMaybe "required, but missing" $ mfieldtemplate 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" ] status = case mfieldtemplate "status" of Nothing -> Unmarked Just str -> either statuserror id . runParser (statusp <* eof) "" . T.pack $ render str where statuserror err = error' $ unlines ["error: could not parse \""++str++"\" as a cleared status (should be *, ! or empty)" ,"the parse error is: "++show err ] code = maybe "" render $ mfieldtemplate "code" description = maybe "" render $ mfieldtemplate "description" comment = maybe "" render $ mfieldtemplate "comment" precomment = maybe "" render $ mfieldtemplate "precomment" currency = maybe (fromMaybe "" mdefaultcurrency) render $ mfieldtemplate "currency" amountstr = (currency++) <$> simplifySign <$> getAmountStr rules record maybeamount = either amounterror (Mixed . (:[])) <$> runParser (evalStateT (amountp <* eof) mempty) "" <$> T.pack <$> amountstr amounterror err = error' $ unlines ["error: could not parse \""++fromJust amountstr++"\" as an amount" ,showRecord record ,"the amount rule is: "++(fromMaybe "" $ mfieldtemplate "amount") ,"the currency rule is: "++(fromMaybe "unspecified" $ mfieldtemplate "currency") ,"the default-currency is: "++fromMaybe "unspecified" mdefaultcurrency ,"the parse error is: "++show err ,"you may need to " ++"change your amount or currency rules, " ++"or "++maybe "add a" (const "change your") mskip++" skip rule" ] amount1 = case maybeamount of Just a -> a Nothing | balance /= Nothing -> nullmixedamt Nothing -> error' $ "amount and balance have no value\n"++showRecord record -- convert balancing amount to cost like hledger print, so eg if -- amount1 is "10 GBP @@ 15 USD", amount2 will be "-15 USD". amount2 = costOfMixedAmount (-amount1) s `or` def = if null s then def else s defaccount1 = fromMaybe "unknown" $ mdirective "default-account1" defaccount2 = case isNegativeMixedAmount amount2 of Just True -> "income:unknown" _ -> "expenses:unknown" account1 = T.pack $ maybe "" render (mfieldtemplate "account1") `or` defaccount1 account2 = T.pack $ maybe "" render (mfieldtemplate "account2") `or` defaccount2 balance = maybe Nothing (parsebalance.render) $ mfieldtemplate "balance" parsebalance str | all isSpace str = Nothing | otherwise = Just $ (either (balanceerror str) id $ runParser (evalStateT (amountp <* eof) mempty) "" $ T.pack $ (currency++) $ simplifySign str, nullsourcepos) balanceerror str err = error' $ unlines ["error: could not parse \""++str++"\" as balance amount" ,showRecord record ,"the balance rule is: "++(fromMaybe "" $ mfieldtemplate "balance") ,"the currency rule is: "++(fromMaybe "unspecified" $ mfieldtemplate "currency") ,"the default-currency is: "++fromMaybe "unspecified" mdefaultcurrency ,"the parse error is: "++show err ] -- build the transaction t = nulltransaction{ tsourcepos = genericSourcePos sourcepos, tdate = date', tdate2 = mdate2', tstatus = status, tcode = T.pack code, tdescription = T.pack description, tcomment = T.pack comment, tpreceding_comment_lines = T.pack precomment, tpostings = [posting {paccount=account1, pamount=amount1, ptransaction=Just t, pbalanceassertion=toAssertion <$> balance} ,posting {paccount=account2, pamount=amount2, ptransaction=Just t} ] } toAssertion (a, b) = assertion{ baamount = a, baposition = b } getAmountStr :: CsvRules -> CsvRecord -> Maybe String getAmountStr rules record = let mamount = getEffectiveAssignment rules record "amount" mamountin = getEffectiveAssignment rules record "amount-in" mamountout = getEffectiveAssignment rules record "amount-out" render = fmap (strip . renderTemplate rules record) in case (render mamount, render mamountin, render mamountout) of (Just "", Nothing, Nothing) -> Nothing (Just a, Nothing, Nothing) -> Just a (Nothing, Just "", Just "") -> error' $ "neither amount-in or amount-out has a value\n" ++ " record: " ++ showRecord record (Nothing, Just i, Just "") -> Just i (Nothing, Just "", Just o) -> Just $ negateStr o (Nothing, Just i, Just o) -> error' $ "both amount-in and amount-out have a value\n" ++ " amount-in: " ++ i ++ "\n" ++ " amount-out: " ++ o ++ "\n" ++ " record: " ++ showRecord record _ -> error' $ "found values for amount and for amount-in/amount-out\n" ++ "please use either amount or amount-in/amount-out\n" ++ " record: " ++ showRecord record 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 = "the CSV record is: "++intercalate ", " (map show r) -- | Given the conversion rules, a CSV record and a journal entry field name, find -- the template value ultimately assigned to this field, either at top -- level or in a matching conditional block. Conditional blocks' -- patterns are matched against an approximation of the original CSV -- record: all the field values with commas intercalated. getEffectiveAssignment :: CsvRules -> CsvRecord -> JournalFieldName -> Maybe FieldTemplate getEffectiveAssignment rules record f = lastMay $ assignmentsFor f where assignmentsFor f = map snd $ filter ((==f).fst) $ toplevelassignments ++ conditionalassignments where toplevelassignments = rassignments rules conditionalassignments = concatMap snd $ filter blockMatches $ blocksAssigning f where blocksAssigning f = filter (any ((==f).fst) . snd) $ rconditionalblocks rules blockMatches :: ConditionalBlock -> Bool blockMatches (matchers,_) = all matcherMatches matchers where matcherMatches :: RecordMatcher -> Bool -- matcherMatches pats = any patternMatches pats matcherMatches pats = patternMatches $ "(" ++ intercalate "|" pats ++ ")" where patternMatches :: RegexpPattern -> Bool patternMatches pat = regexMatchesCI pat csvline where csvline = intercalate "," record renderTemplate :: CsvRules -> CsvRecord -> FieldTemplate -> String renderTemplate rules record t = regexReplaceBy "%[A-z0-9]+" replace t where replace ('%':pat) = maybe pat (\i -> atDef "" record (i-1)) mindex where mindex | all isDigit pat = readMay pat | otherwise = lookup (map toLower pat) $ rcsvfieldindexes rules replace pat = pat -- Parse the date string using the specified date-format, or if unspecified try these default formats: -- YYYY/MM/DD, YYYY-MM-DD, YYYY.MM.DD, MM/DD/YYYY (month and day can be 1 or 2 digits, year must be 4). parseDateWithFormatOrDefaultFormats :: Maybe DateFormat -> String -> Maybe Day parseDateWithFormatOrDefaultFormats mformat s = firstJust $ map parsewith formats where parsetime = #if MIN_VERSION_time(1,5,0) parseTimeM True #else parseTime #endif parsewith = flip (parsetime 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" "" `is` Right rules ] ,tests "rulesp" [ test "trailing comments" $ parseWithState' rules rulesp "skip\n# \n#\n" `is` Right rules{rdirectives = [("skip","")]} ,test "trailing blank lines" $ parseWithState' rules rulesp "skip\n\n \n" `is` (Right rules{rdirectives = [("skip","")]}) ,test "no final newline" $ parseWithState' rules rulesp "skip" `is` (Right rules{rdirectives=[("skip","")]}) ,test "assignment with empty value" $ parseWithState' rules rulesp "account1 \nif foo\n account2 foo\n" `is` (Right rules{rassignments = [("account1","")], rconditionalblocks = [([["foo"]],[("account2","foo")])]}) ] ] hledger-lib-1.12/Hledger/Read/JournalReader.hs0000644000000000000000000007423213401075574017335 0ustar0000000000000000--- * doc -- Lines beginning "--- *" are collapsible orgstruct nodes. Emacs users, -- (add-hook 'haskell-mode-hook -- (lambda () (set-variable 'orgstruct-heading-prefix-regexp "--- " t)) -- 'orgstruct-mode) -- and press TAB on nodes to expand/collapse. {-| 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 here. Some low-level journal syntax parsers which those readers also use are therefore defined separately in Hledger.Read.Common, avoiding import cycles. -} --- * module {-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections, OverloadedStrings, PackageImports #-} module Hledger.Read.JournalReader ( --- * exports -- * Reader reader, -- * Parsing utils genericSourcePos, parseAndFinaliseJournal, runJournalParser, rjp, -- * Parsers used elsewhere getParentAccount, journalp, directivep, defaultyeardirectivep, marketpricedirectivep, datetimep, datep, modifiedaccountnamep, postingp, statusp, emptyorcommentlinep, followingcommentp -- * Tests ,tests_JournalReader ) where --- * imports import Prelude () import "base-compat-batteries" Prelude.Compat hiding (readFile) import qualified Control.Exception as C import Control.Monad import Control.Monad.Except (ExceptT(..)) import Control.Monad.State.Strict import Data.Maybe import qualified Data.Map.Strict as M import Data.Text (Text) import Data.String import Data.List 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.Read.TimeclockReader (timeclockfilep) import Hledger.Read.TimedotReader (timedotfilep) import Hledger.Utils -- $setup -- >>> :set -XOverloadedStrings --- * reader reader :: Reader reader = Reader {rFormat = "journal" ,rExtensions = ["journal", "j", "hledger", "ledger"] ,rParser = parse ,rExperimental = False } -- | 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' . addMarketPrice , 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" includedirectivep :: MonadIO m => ErroringJournalParser m () includedirectivep = do string "include" lift (skipSome spacenonewline) filename <- T.unpack <$> takeWhileP Nothing (/= '\n') -- don't consume newline yet parentoff <- getOffset parentpos <- getSourcePos filepaths <- getFilePaths parentoff parentpos filename forM_ filepaths $ 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 -> FilePath -> ErroringJournalParser m () parseChild parentpos filepath = do parentj <- get let parentfilestack = jincludefilestack parentj when (filepath `elem` parentfilestack) $ fail ("Cyclic include: " ++ filepath) childInput <- lift $ readFilePortably filepath `orRethrowIOError` (show parentpos ++ " reading " ++ filepath) let initChildj = newJournalWithParseStateFrom filepath parentj let parser = choiceInState [ journalp , timeclockfilep , timedotfilep ] -- can't include a csv file yet, that reader is special 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 = mempty{ 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 errMsg accountdirectivep :: JournalParser m () accountdirectivep = do string "account" lift (skipSome spacenonewline) -- the account name, possibly modified by preceding alias or apply account directives acct <- modifiedaccountnamep -- and maybe something else after two or more spaces ? matype :: Maybe AccountType <- lift $ fmap (fromMaybe Nothing) $ optional $ try $ do skipSome spacenonewline -- at least one more space in addition to the one consumed by modifiedaccountp choice [ -- a numeric account code, as supported in 1.9-1.10 ? currently ignored some digitChar >> return Nothing -- a letter account type code (ALERX), as added in 1.11 ? ,char 'A' >> return (Just Asset) ,char 'L' >> return (Just Liability) ,char 'E' >> return (Just Equity) ,char 'R' >> return (Just Revenue) ,char 'X' >> return (Just Expense) ] -- and maybe a comment on this and/or following lines ? (ignore for now) (_cmt, _tags) <- lift transactioncommentp -- and maybe Ledger-style subdirectives ? (ignore) skipMany indentedlinep -- update the journal case matype of Nothing -> return () Just atype -> addDeclaredAccountType acct atype pushDeclaredAccount acct indentedlinep :: JournalParser m String indentedlinep = lift (skipSome spacenonewline) >> (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 (skipSome spacenonewline) off <- getOffset amount <- amountp pure $ (off, amount) lift (skipMany spacenonewline) _ <- lift followingcommentp let comm = Commodity{csymbol=acommodity, cformat=Just $ dbg2 "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 = "to avoid ambiguity, please include a decimal separator in commodity directives" -- | 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 (skipSome spacenonewline) 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 (skipSome spacenonewline) >>) -- | 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 (skipSome spacenonewline) off <- getOffset Amount{acommodity,astyle} <- amountp _ <- lift followingcommentp if acommodity==expectedsym then if asdecimalpoint astyle == Nothing then customFailure $ parseErrorAt off pleaseincludedecimalpoint else return $ dbg2 "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 (skipSome spacenonewline) -- | 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 (skipSome spacenonewline) 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 (skipSome spacenonewline) 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 '=' skipMany spacenonewline 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 '/' re <- some $ noneOf ("/\n\r" :: [Char]) -- paranoid: don't try to read past line end char '/' skipMany spacenonewline char '=' skipMany spacenonewline repl <- anySingle `manyTill` eolof return $ RegexAlias re repl endaliasesdirectivep :: JournalParser m () endaliasesdirectivep = do keywordsp "end aliases" "end aliases directive" clearAccountAliases tagdirectivep :: JournalParser m () tagdirectivep = do string "tag" "tag directive" lift (skipSome spacenonewline) _ <- 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 (skipMany spacenonewline) y <- some digitChar let y' = read y failIfInvalidYear y setYear y' defaultcommoditydirectivep :: JournalParser m () defaultcommoditydirectivep = do char 'D' "default commodity" lift (skipSome spacenonewline) off <- getOffset Amount{acommodity,astyle} <- amountp lift restofline if asdecimalpoint astyle == Nothing then customFailure $ parseErrorAt off pleaseincludedecimalpoint else setDefaultCommodityAndStyle (acommodity, astyle) marketpricedirectivep :: JournalParser m MarketPrice marketpricedirectivep = do char 'P' "market price" lift (skipMany spacenonewline) date <- try (do {LocalTime d _ <- datetimep; return d}) <|> datep -- a time is ignored lift (skipSome spacenonewline) symbol <- lift commoditysymbolp lift (skipMany spacenonewline) price <- amountp lift restofline return $ MarketPrice date symbol price ignoredpricecommoditydirectivep :: JournalParser m () ignoredpricecommoditydirectivep = do char 'N' "ignored-price commodity" lift (skipSome spacenonewline) lift commoditysymbolp lift restofline return () commodityconversiondirectivep :: JournalParser m () commodityconversiondirectivep = do char 'C' "commodity conversion" lift (skipSome spacenonewline) amountp lift (skipMany spacenonewline) char '=' lift (skipMany spacenonewline) amountp lift restofline return () --- ** transactions transactionmodifierp :: JournalParser m TransactionModifier transactionmodifierp = do char '=' "modifier transaction" lift (skipMany spacenonewline) 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 -- -- 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 $ skipMany spacenonewline -- 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?" 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 () -- The line can end here, or it can continue with one or more spaces -- and then zero or more of the following fields. A bit awkward. (status, code, description, (comment, tags)) <- lift $ (<|>) (eolof >> return (Unmarked, "", "", ("", []))) $ do skipSome spacenonewline s <- statusp c <- codep desc <- T.strip <$> descriptionp (cmt, ts) <- transactioncommentp return (s,c,desc,(cmt,ts)) -- 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 (skipSome spacenonewline) -- 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 (skipSome spacenonewline) status <- lift statusp lift (skipMany spacenonewline) account <- modifiedaccountnamep return (status, account) let (ptype, account') = (accountNamePostingType account, textUnbracket account) lift (skipMany spacenonewline) amount <- option missingmixedamt $ Mixed . (:[]) <$> amountp lift (skipMany spacenonewline) massertion <- optional $ balanceassertionp _ <- fixedlotpricep lift (skipMany spacenonewline) (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" $ expectParse p "a:b:c" ,_test "empty inner component" $ expectParseError p "a::c" "" -- TODO ,_test "empty leading component" $ expectParseError p ":b:c" "x" ,_test "empty trailing component" $ expectParseError 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." ,test "datep" $ do test "YYYY/MM/DD" $ expectParseEq datep "2018/01/01" (fromGregorian 2018 1 1) test "YYYY-MM-DD" $ expectParse datep "2018-01-01" test "YYYY.MM.DD" $ expectParse datep "2018.01.01" test "yearless date with no default year" $ expectParseError datep "1/1" "current year is unknown" test "yearless date with default year" $ do let s = "1/1" ep <- parseWithState mempty{jparsedefaultyear=Just 2018} datep s either (fail.("parse error at "++).customErrorBundlePretty) (const ok) ep test "no leading zero" $ expectParse datep "2018/1/1" ,test "datetimep" $ do let good = expectParse datetimep bad = (\t -> expectParseError 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" test "timezone is parsed but ignored" $ do let t = LocalTime (fromGregorian 2018 1 1) (TimeOfDay 0 0 (fromIntegral 0)) expectParseEq datetimep "2018/1/1 00:00-0800" t expectParseEq datetimep "2018/1/1 00:00+1234" t ,tests "periodictransactionp" [ test "more period text in comment after one space" $ expectParseEq 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" $ expectParseEq 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" $ expectParseEq periodictransactionp "~ monthly Next year blah blah\n" nullperiodictransaction { ptperiodexpr = "monthly" ,ptinterval = Months 1 ,ptspan = DateSpan Nothing Nothing ,ptdescription = "Next year blah blah" ,ptcomment = "" } ] ,tests "postingp" [ test "basic" $ expectParseEq (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" $ expectParseEq (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" $ expectParseEq (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" $ expectParse (postingp Nothing) " a 1 \"DE123\"\n" ,test "balance assertion and fixed lot price" $ expectParse (postingp Nothing) " a 1 \"DE123\" =$1 { =2.2 EUR} \n" ,test "balance assertion over entire contents of account" $ expectParse (postingp Nothing) " a $1 == $1\n" ] ,tests "transactionmodifierp" [ test "basic" $ expectParseEq 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" $ expectParseEq transactionp "2015/1/1\n" nulltransaction{tdate=fromGregorian 2015 1 1} ,test "more complex" $ expectParseEq 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 ? tpreceding_comment_lines="", 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" $ expect $ 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" $ expectParseEqOn transactionp "2009/1/1 a ;comment\n b 1\n" tdescription "a" ,test "transactionp parses a following whitespace line" $ expect $ isRight $ rjp transactionp $ T.unlines ["2012/1/1" ," a 1" ," b" ," " ] ,test "comments everywhere, two postings parsed" $ expectParseEqOn 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 expectParseE directivep "!account a\n" expectParseE directivep "!D 1.0\n" ] ,test "accountdirectivep" $ do test "with-comment" $ expectParse accountdirectivep "account a:b ; a comment\n" test "does-not-support-!" $ expectParseError accountdirectivep "!account a:b\n" "" test "account-sort-code" $ expectParse accountdirectivep "account a:b 1000\n" test "account-type-code" $ expectParse accountdirectivep "account a:b A\n" test "account-type-tag" $ expectParse accountdirectivep "account a:b ; type:asset\n" ,test "commodityconversiondirectivep" $ do expectParse commodityconversiondirectivep "C 1h = $50.00\n" ,test "defaultcommoditydirectivep" $ do expectParse defaultcommoditydirectivep "D $1,000.0\n" expectParseError defaultcommoditydirectivep "D $1000\n" "please include a decimal separator" ,test "defaultyeardirectivep" $ do test "1000" $ expectParse defaultyeardirectivep "Y 1000" -- XXX no \n like the others test "999" $ expectParseError defaultyeardirectivep "Y 999" "bad year number" test "12345" $ expectParse defaultyeardirectivep "Y 12345" ,test "ignoredpricecommoditydirectivep" $ do expectParse ignoredpricecommoditydirectivep "N $\n" ,test "includedirectivep" $ do test "include" $ expectParseErrorE includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile" test "glob" $ expectParseErrorE includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*" ,test "marketpricedirectivep" $ expectParseEq marketpricedirectivep "P 2017/01/30 BTC $922.83\n" MarketPrice{ mpdate = fromGregorian 2017 1 30, mpcommodity = "BTC", mpamount = usd 922.83 } ,test "tagdirectivep" $ do expectParse tagdirectivep "tag foo \n" ,test "endtagdirectivep" $ do expectParse endtagdirectivep "end tag \n" expectParse endtagdirectivep "pop \n" ,tests "journalp" [ test "empty file" $ expectParseEqE journalp "" nulljournal ] ] hledger-lib-1.12/Hledger/Read/TimedotReader.hs0000644000000000000000000001135313373103562017320 0ustar0000000000000000{-| 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 OverloadedStrings, PackageImports #-} module Hledger.Read.TimedotReader ( -- * Reader reader, -- * Misc other exports timedotfilep, ) where 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.Maybe import Data.Text (Text) import Text.Megaparsec hiding (parse) import Text.Megaparsec.Char import Hledger.Data import Hledger.Read.Common import Hledger.Utils hiding (traceParse) -- easier to toggle this here sometimes -- import qualified Hledger.Utils (parsertrace) -- parsertrace = Hledger.Utils.parsertrace traceParse :: Monad m => a -> m a traceParse = return reader :: Reader reader = Reader {rFormat = "timedot" ,rExtensions = ["timedot"] ,rParser = parse ,rExperimental = False } -- | Parse and post-process a "Journal" from the timedot format, or give an error. parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal parse = parseAndFinaliseJournal' timedotfilep timedotfilep :: JournalParser m ParsedJournal timedotfilep = do many timedotfileitemp eof get where timedotfileitemp :: JournalParser m () timedotfileitemp = do traceParse "timedotfileitemp" choice [ void $ lift emptyorcommentlinep ,timedotdayp >>= \ts -> modify' (addTransactions ts) ] "timedot day entry, or default year or comment line or blank line" addTransactions :: [Transaction] -> Journal -> Journal addTransactions ts j = foldl' (flip ($)) j (map addTransaction ts) -- | Parse timedot day entries to zero or more time transactions for that day. -- @ -- 2/1 -- fos.haskell .... .. -- biz.research . -- inc.client1 .... .... .... .... .... .... -- @ timedotdayp :: JournalParser m [Transaction] timedotdayp = do traceParse " timedotdayp" d <- datep <* lift eolof es <- catMaybes <$> many (const Nothing <$> try (lift emptyorcommentlinep) <|> Just <$> (notFollowedBy datep >> timedotentryp)) return $ map (\t -> t{tdate=d}) es -- <$> many timedotentryp -- | Parse a single timedot entry to one (dateless) transaction. -- @ -- fos.haskell .... .. -- @ timedotentryp :: JournalParser m Transaction timedotentryp = do traceParse " timedotentryp" pos <- genericSourcePos <$> getSourcePos lift (skipMany spacenonewline) a <- modifiedaccountnamep lift (skipMany spacenonewline) hours <- try (lift followingcommentp >> return 0) <|> (timedotdurationp <* (try (lift followingcommentp) <|> (newline >> return ""))) let t = nulltransaction{ tsourcepos = pos, tstatus = Cleared, tpostings = [ nullposting{paccount=a ,pamount=Mixed [setAmountPrecision 2 $ num hours] -- don't assume hours; do set precision to 2 ,ptype=VirtualPosting ,ptransaction=Just t } ] } return t timedotdurationp :: JournalParser m Quantity timedotdurationp = try timedotnumericp <|> timedotdotsp -- | 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 -- @ timedotnumericp :: JournalParser m Quantity timedotnumericp = do (q, _, _, _) <- lift $ numberp Nothing msymbol <- optional $ choice $ map (string . fst) timeUnits lift (skipMany spacenonewline) 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. -- @ -- .... .. -- @ timedotdotsp :: JournalParser m Quantity timedotdotsp = do dots <- filter (not.isSpace) <$> many (oneOf (". " :: [Char])) return $ (/4) $ fromIntegral $ length dots hledger-lib-1.12/Hledger/Read/TimeclockReader.hs0000644000000000000000000001024313373103562017622 0ustar0000000000000000{-| 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 OverloadedStrings, PackageImports #-} module Hledger.Read.TimeclockReader ( -- * Reader reader, -- * Misc other exports timeclockfilep, ) where 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 reader :: Reader reader = Reader {rFormat = "timeclock" ,rExtensions = ["timeclock"] ,rParser = parse ,rExperimental = False } -- | 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 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, or default year or historical price directive" -- | Parse a timeclock entry. timeclockentryp :: JournalParser m TimeclockEntry timeclockentryp = do sourcepos <- genericSourcePos <$> lift getSourcePos code <- oneOf ("bhioO" :: [Char]) lift (skipSome spacenonewline) datetime <- datetimep account <- fromMaybe "" <$> optional (lift (skipSome spacenonewline) >> modifiedaccountnamep) description <- T.pack . fromMaybe "" <$> lift (optional (skipSome spacenonewline >> restofline)) return $ TimeclockEntry sourcepos (read [code]) datetime account description hledger-lib-1.12/Hledger/Reports.hs0000644000000000000000000000253113372610345015352 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable, 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.TransactionsReports, module Hledger.Reports.BalanceReport, module Hledger.Reports.MultiBalanceReports, module Hledger.Reports.BudgetReport, -- module Hledger.Reports.BalanceHistoryReport, -- * Tests tests_Reports ) where import Hledger.Reports.ReportOptions import Hledger.Reports.ReportTypes import Hledger.Reports.EntriesReport import Hledger.Reports.PostingsReport import Hledger.Reports.TransactionsReports import Hledger.Reports.BalanceReport import Hledger.Reports.MultiBalanceReports import Hledger.Reports.BudgetReport -- import Hledger.Reports.BalanceHistoryReport import Hledger.Utils.Test tests_Reports = tests "Reports" [ tests_BalanceReport ,tests_BudgetReport ,tests_EntriesReport ,tests_MultiBalanceReports ,tests_PostingsReport ,tests_ReportOptions ,tests_TransactionsReports ] hledger-lib-1.12/Hledger/Reports/ReportOptions.hs0000644000000000000000000004116613373103562020207 0ustar0000000000000000{-| Options common to most hledger reports. -} {-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable #-} module Hledger.Reports.ReportOptions ( ReportOpts(..), BalanceType(..), AccountListMode(..), FormatStr, defreportopts, rawOptsToReportOpts, checkReportOpts, flat_, tree_, reportOptsToggleStatus, simplifyStatuses, whichDateFromOpts, journalSelectingAmountFromOpts, intervalFromRawOpts, queryFromOpts, queryFromOptsOnly, queryOptsFromOpts, transactionDateFn, postingDateFn, reportSpan, reportStartDate, reportEndDate, specifiedStartEndDates, specifiedStartDate, specifiedEndDate, tests_ReportOptions ) where import Control.Applicative ((<|>)) import Data.Data (Data) import Data.List import Data.Maybe import qualified Data.Text as T import Data.Typeable (Typeable) import Data.Time.Calendar import Data.Default import Safe import System.Console.ANSI (hSupportsANSI) 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,Data,Typeable) instance Default BalanceType where def = PeriodChange -- | Should accounts be displayed: in the command's default style, hierarchically, or as a flat list ? data AccountListMode = ALDefault | ALTree | ALFlat deriving (Eq, Show, Data, Typeable) instance Default AccountListMode where def = ALDefault -- | 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 { period_ :: Period ,interval_ :: Interval ,statuses_ :: [Status] -- ^ Zero, one, or two statuses to be matched ,cost_ :: Bool ,depth_ :: Maybe Int ,display_ :: Maybe DisplayExp ,date2_ :: Bool ,empty_ :: Bool ,no_elide_ :: Bool ,real_ :: Bool ,format_ :: Maybe FormatStr ,query_ :: String -- all arguments, as a string -- register command only ,average_ :: Bool ,related_ :: Bool -- balance-type commands only ,balancetype_ :: BalanceType ,accountlistmode_ :: AccountListMode ,drop_ :: Int ,row_total_ :: Bool ,no_total_ :: Bool ,value_ :: Bool ,pretty_tables_ :: Bool ,sort_amount_ :: 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 ,forecast_ :: Bool } deriving (Show, Data, Typeable) 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 rawOptsToReportOpts :: RawOpts -> IO ReportOpts rawOptsToReportOpts rawopts = checkReportOpts <$> do let rawopts' = checkRawOpts rawopts d <- getCurrentDay color <- hSupportsANSI stdout return defreportopts{ period_ = periodFromRawOpts d rawopts' ,interval_ = intervalFromRawOpts rawopts' ,statuses_ = statusesFromRawOpts rawopts' ,cost_ = boolopt "cost" rawopts' ,depth_ = maybeintopt "depth" rawopts' ,display_ = maybedisplayopt d 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 $ listofstringopt "args" rawopts' -- doesn't handle an arg like "" right ,average_ = boolopt "average" rawopts' ,related_ = boolopt "related" rawopts' ,balancetype_ = balancetypeopt rawopts' ,accountlistmode_ = accountlistmodeopt rawopts' ,drop_ = intopt "drop" rawopts' ,row_total_ = boolopt "row-total" rawopts' ,no_total_ = boolopt "no-total" rawopts' ,value_ = boolopt "value" rawopts' ,sort_amount_ = boolopt "sort-amount" rawopts' ,invert_ = boolopt "invert" rawopts' ,pretty_tables_ = boolopt "pretty-tables" rawopts' ,color_ = color ,forecast_ = boolopt "forecast" 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 rawopts = case reverse $ filter (`elem` ["tree","flat"]) $ map fst rawopts of ("tree":_) -> ALTree ("flat":_) -> ALFlat _ -> ALDefault balancetypeopt :: RawOpts -> BalanceType balancetypeopt rawopts = case reverse $ filter (`elem` ["change","cumulative","historical"]) $ map fst rawopts of ("historical":_) -> HistoricalBalance ("cumulative":_) -> CumulativeChange _ -> PeriodChange -- Get the period specified by the intersection of -b/--begin, -e/--end and/or -- -p/--period options, using the given date to interpret relative date expressions. periodFromRawOpts :: Day -> RawOpts -> Period periodFromRawOpts d rawopts = case (mearliestb, mlateste) of (Nothing, Nothing) -> PeriodAll (Just b, Nothing) -> PeriodFrom b (Nothing, Just e) -> PeriodTo e (Just b, Just e) -> simplifyPeriod $ PeriodBetween b e where mearliestb = case beginDatesFromRawOpts d rawopts of [] -> Nothing bs -> Just $ minimum bs mlateste = case endDatesFromRawOpts d rawopts of [] -> Nothing es -> Just $ maximum 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 = catMaybes . map (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 = catMaybes . map (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. intervalFromRawOpts :: RawOpts -> Interval intervalFromRawOpts = lastDef NoInterval . catMaybes . map intervalfromrawopt where intervalfromrawopt (n,v) | n == "period" = either (\e -> usageError $ "could not parse period option: "++customErrorBundlePretty e) (Just . fst) $ parsePeriodExpr nulldate (stripquotes $ T.pack v) -- reference date does not affect the interval | 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 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 . catMaybes . map 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' = nub $ sort 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)} type DisplayExp = String maybedisplayopt :: Day -> RawOpts -> Maybe DisplayExp maybedisplayopt d rawopts = maybe Nothing (Just . regexReplaceBy "\\[.+?\\]" fixbracketeddatestr) $ maybestringopt "display" rawopts where fixbracketeddatestr "" = "" fixbracketeddatestr s = "[" ++ fixSmartDateStr d (T.pack $ init $ tail s) ++ "]" -- | 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_ = (==ALTree) . accountlistmode_ flat_ :: ReportOpts -> Bool flat_ = (==ALFlat) . accountlistmode_ -- depthFromOpts :: ReportOpts -> Int -- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts) -- | Convert this journal's postings' amounts to the cost basis amounts if -- specified by options. journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal journalSelectingAmountFromOpts opts | cost_ opts = journalConvertAmountsToCost | otherwise = id -- | Convert report options and arguments to a query. queryFromOpts :: Day -> ReportOpts -> Query queryFromOpts d ReportOpts{..} = simplifyQuery $ And $ [flagsq, argsq] where flagsq = And $ [(if date2_ then Date2 else Date) $ periodAsDateSpan period_] ++ (if real_ then [Real True] else []) ++ (if empty_ then [Empty True] else []) -- ? ++ [Or $ map StatusQ statuses_] ++ (maybe [] ((:[]) . Depth) depth_) argsq = fst $ parseQuery d (T.pack query_) -- | Convert report options to a query, ignoring any non-flag command line arguments. queryFromOptsOnly :: Day -> ReportOpts -> Query queryFromOptsOnly _d ReportOpts{..} = simplifyQuery flagsq where flagsq = And $ [(if date2_ then Date2 else Date) $ periodAsDateSpan period_] ++ (if real_ then [Real True] else []) ++ (if empty_ then [Empty True] else []) -- ? ++ [Or $ map StatusQ statuses_] ++ (maybe [] ((:[]) . Depth) depth_) -- | Convert report options and arguments to query options. queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt] queryOptsFromOpts d ReportOpts{..} = flagsqopts ++ argsqopts where flagsqopts = [] argsqopts = snd $ parseQuery d (T.pack query_) -- | 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) <- dbg2 "specifieddates" <$> specifiedStartEndDates ropts let DateSpan mjournalstartdate mjournalenddate = dbg2 "journalspan" $ journalDateSpan False j -- ignore secondary dates mstartdate = mspecifiedstartdate <|> mjournalstartdate menddate = mspecifiedenddate <|> mjournalenddate return $ dbg1 "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 -- tests tests_ReportOptions = tests "ReportOptions" [ tests "queryFromOpts" [ (queryFromOpts nulldate defreportopts) `is` Any ,(queryFromOpts nulldate defreportopts{query_="a"}) `is` (Acct "a") ,(queryFromOpts nulldate defreportopts{query_="desc:'a a'"}) `is` (Desc "a a") ,(queryFromOpts nulldate defreportopts{period_=PeriodFrom (parsedate "2012/01/01"),query_="date:'to 2013'" }) `is` (Date $ mkdatespan "2012/01/01" "2013/01/01") ,(queryFromOpts nulldate defreportopts{query_="date2:'in 2012'"}) `is` (Date2 $ mkdatespan "2012/01/01" "2013/01/01") ,(queryFromOpts nulldate defreportopts{query_="'a a' 'b"}) `is` (Or [Acct "a a", Acct "'b"]) ] ,tests "queryOptsFromOpts" [ (queryOptsFromOpts nulldate defreportopts) `is` [] ,(queryOptsFromOpts nulldate defreportopts{query_="a"}) `is` [] ,(queryOptsFromOpts nulldate defreportopts{period_=PeriodFrom (parsedate "2012/01/01") ,query_="date:'to 2013'" }) `is` [] ] ] hledger-lib-1.12/Hledger/Reports/ReportTypes.hs0000644000000000000000000000366213363322116017654 0ustar0000000000000000{- | New common report types, used by the BudgetReport for now, perhaps all reports later. -} module Hledger.Reports.ReportTypes where import Data.Decimal import Hledger.Data 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 generic tabular report of some value, where each row corresponds to an account -- and each column is a date period. The column periods are usually consecutive subperiods -- formed by splitting the overall report period by some report interval (daily, weekly, etc.) -- Depending on the value type, this can be a report of balance changes, ending balances, -- budget performance, etc. Successor to MultiBalanceReport. data PeriodicReport a = PeriodicReport ( [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. , [PeriodicReportRow a] -- One row per account in the report. , PeriodicReportRow a -- The grand totals row. The account name in this row is always empty. ) deriving (Show) type PeriodicReportRow a = ( AccountName -- A full account name. , AccountName -- Shortened form of the account name to display in tree mode. Usually the leaf name, possibly with parent accounts prefixed. , Int -- Indent level for displaying this account name in tree mode. 0, 1, 2... , [a] -- The data value for each subperiod. , a -- The total of this row's values. , a -- The average of this row's values. ) hledger-lib-1.12/Hledger/Reports/BalanceHistoryReport.hs0000644000000000000000000000161613372610345021460 0ustar0000000000000000{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances #-} {-| Account balance history report. -} -- XXX not used module Hledger.Reports.BalanceHistoryReport ( accountBalanceHistory ) where import Data.Time.Calendar import Hledger.Data import Hledger.Query import Hledger.Reports.ReportOptions import Hledger.Reports.TransactionsReports -- | Get the historical running inclusive balance of a particular account, -- from earliest to latest posting date. accountBalanceHistory :: ReportOpts -> Journal -> Account -> [(Day, MixedAmount)] accountBalanceHistory ropts j a = [(getdate t, bal) | (t,_,_,_,_,bal) <- items] where (_,items) = journalTransactionsReport ropts j acctquery inclusivebal = True acctquery = Acct $ (if inclusivebal then accountNameToAccountRegex else accountNameToAccountOnlyRegex) $ aname a getdate = if date2_ ropts then transactionDate2 else tdate hledger-lib-1.12/Hledger/Reports/BalanceReport.hs0000644000000000000000000003707413372610345020105 0ustar0000000000000000{-| Balance report, used by the balance command. -} {-# LANGUAGE FlexibleInstances, ScopedTypeVariables, OverloadedStrings #-} module Hledger.Reports.BalanceReport ( BalanceReport, BalanceReportItem, balanceReport, flatShowsExclusiveBalance, sortAccountItemsLike, -- * Tests tests_BalanceReport ) where import Data.List import Data.Ord import Data.Maybe import Data.Time.Calendar import Hledger.Data import Hledger.Read (mamountp') import Hledger.Query import Hledger.Utils import Hledger.Reports.ReportOptions -- | 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. -- This is like PeriodChangeReport with a single column (but more mature, -- eg this can do hierarchical display). balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport balanceReport opts q j = (if invert_ opts then brNegate else id) $ (sorteditems, total) where -- dbg1 = const id -- exclude from debug output dbg1 s = let p = "balanceReport" in Hledger.Utils.dbg1 (p++" "++s) -- add prefix in debug output accts = ledgerRootAccount $ ledgerFromJournal q $ journalSelectingAmountFromOpts opts j accts' :: [Account] | queryDepth q == 0 = dbg1 "accts" $ take 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts accts | flat_ opts = dbg1 "accts" $ filterzeros $ filterempty $ drop 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts accts | otherwise = dbg1 "accts" $ filter (not.aboring) $ drop 1 $ flattenAccounts $ markboring $ prunezeros $ sortAccountTreeByAmount (fromMaybe NormallyPositive $ normalbalance_ opts) $ clipAccounts (queryDepth q) accts where balance = if flat_ opts then aebalance else aibalance filterzeros = if empty_ opts then id else filter (not . isZeroMixedAmount . balance) filterempty = filter (\a -> anumpostings a > 0 || not (isZeroMixedAmount (balance a))) prunezeros = if empty_ opts then id else fromMaybe nullacct . pruneAccounts (isZeroMixedAmount . balance) markboring = if no_elide_ opts then id else markBoringParentAccounts items = dbg1 "items" $ map (balanceReportItem opts q) accts' -- now sort items like MultiBalanceReport, except -- sorting a tree by amount was more easily done above sorteditems | sort_amount_ opts && tree_ opts = items | sort_amount_ opts = sortFlatBRByAmount items | otherwise = sortBRByAccountDeclaration items where -- Sort the report rows, representing a flat account list, by row total. sortFlatBRByAmount :: [BalanceReportItem] -> [BalanceReportItem] sortFlatBRByAmount = sortBy (maybeflip $ comparing (normaliseMixedAmountSquashPricesForDisplay . fourth4)) where maybeflip = if normalbalance_ opts == Just NormallyNegative then id else flip -- Sort the report rows by account declaration order then account name. sortBRByAccountDeclaration :: [BalanceReportItem] -> [BalanceReportItem] sortBRByAccountDeclaration rows = sortedrows where anamesandrows = [(first4 r, r) | r <- rows] anames = map fst anamesandrows sortedanames = sortAccountNamesByDeclaration j (tree_ opts) anames sortedrows = sortAccountItemsLike sortedanames anamesandrows total | not (flat_ opts) = dbg1 "total" $ sum [amt | (_,_,indent,amt) <- items, indent == 0] | otherwise = dbg1 "total" $ if flatShowsExclusiveBalance then sum $ map fourth4 items else sum $ map aebalance $ clipAccountsAndAggregate 1 accts' -- | 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. sortAccountItemsLike :: [AccountName] -> [(AccountName, b)] -> [b] sortAccountItemsLike sortedas items = concatMap (\a -> maybe [] (:[]) $ lookup a items) sortedas -- | In an account tree with zero-balance leaves removed, mark the -- elidable parent accounts (those with one subaccount and no balance -- of their own). markBoringParentAccounts :: Account -> Account markBoringParentAccounts = tieAccountParents . mapAccounts mark where mark a | length (asubs a) == 1 && isZeroMixedAmount (aebalance a) = a{aboring=True} | otherwise = a balanceReportItem :: ReportOpts -> Query -> Account -> BalanceReportItem balanceReportItem opts q a | flat_ opts = (name, name, 0, (if flatShowsExclusiveBalance then aebalance else aibalance) a) | otherwise = (name, elidedname, indent, aibalance a) where name | queryDepth q > 0 = aname a | otherwise = "..." elidedname = accountNameFromComponents (adjacentboringparentnames ++ [accountLeafName name]) adjacentboringparentnames = reverse $ map (accountLeafName.aname) $ takeWhile aboring parents indent = length $ filter (not.aboring) parents -- parents exclude the tree's root node parents = case parentAccounts a of [] -> [] as -> init as -- -- the above using the newer multi balance report code: -- balanceReport' opts q j = (items, total) -- where -- MultiBalanceReport (_,mbrrows,mbrtotals) = PeriodChangeReport opts q j -- items = [(a,a',n, headDef 0 bs) | ((a,a',n), bs) <- mbrrows] -- total = headDef 0 mbrtotals -- | Flip the sign of all amounts in a BalanceReport. brNegate :: BalanceReport -> BalanceReport brNegate (is, tot) = (map brItemNegate is, -tot) where brItemNegate (a, a', d, amt) = (a, a', d, -amt) Right samplejournal2 = journalBalanceTransactions False nulljournal{ jtxns = [ txnTieKnot Transaction{ tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2008/01/01", tdate2=Just $ parsedate "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} ], tpreceding_comment_lines="" } ] } -- tests tests_BalanceReport = 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 eitems) `is` (map showw aitems) (showMixedAmountDebug etotal) `is` (showMixedAmountDebug atotal) usd0 = usd 0 in [ test "balanceReport with no args on null journal" $ (defreportopts, nulljournal) `gives` ([], Mixed [nullamt]) ,test "balanceReport with no args on sample journal" $ (defreportopts, 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 [usd0]) ,test "balanceReport with --depth=N" $ (defreportopts{depth_=Just 1}, samplejournal) `gives` ([ ("expenses", "expenses", 0, mamountp' "$2.00") ,("income", "income", 0, mamountp' "$-2.00") ], Mixed [usd0]) ,test "balanceReport with depth:N" $ (defreportopts{query_="depth:1"}, samplejournal) `gives` ([ ("expenses", "expenses", 0, mamountp' "$2.00") ,("income", "income", 0, mamountp' "$-2.00") ], Mixed [usd0]) ,tests "balanceReport with a date or secondary date span" [ (defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives` ([], Mixed [nullamt]) ,(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 [usd0]) ] ,test "balanceReport 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 [usd0]) ,test "balanceReport with not:desc:" $ (defreportopts{query_="not:desc:income"}, samplejournal) `gives` ([ ("assets","assets",0, mamountp' "$-1.00") ,("assets:bank:saving","bank:saving",1, 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:gifts","income:gifts",0, mamountp' "$-1.00") ], Mixed [usd0]) ,test "balanceReport 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 [usd0]) ,test "balanceReport with period on an unpopulated period" $ (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}, samplejournal) `gives` ([],Mixed [nullamt]) {- ,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 $ journalConvertAmountsToCost j -- enable cost basis adjustment balanceReportAsText defreportopts (balanceReport defreportopts Any j') `is` [" $500 a:b" ," $-500 c:d" ,"--------------------" ," 0" ] -} ] ] hledger-lib-1.12/Hledger/Reports/BudgetReport.hs0000644000000000000000000004004413373103562017760 0ustar0000000000000000{- | -} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Hledger.Reports.BudgetReport where import Data.Decimal import Data.List import Data.Maybe #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif import Data.Ord 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 Text.Tabular.AsciiWide import Hledger.Data --import Hledger.Query import Hledger.Utils --import Hledger.Read (mamountp') import Hledger.Reports.ReportOptions import Hledger.Reports.ReportTypes import Hledger.Reports.BalanceReport (sortAccountItemsLike) import Hledger.Reports.MultiBalanceReports -- for reference: -- --type MultiBalanceReportRow = (AccountName, AccountName, Int, [MixedAmount], MixedAmount, MixedAmount) --type MultiBalanceReportTotals = ([MixedAmount], MixedAmount, MixedAmount) -- (Totals list, sum of totals, average of totals) -- --type PeriodicReportRow a = -- ( AccountName -- ^ A full account name. -- , [a] -- ^ The data value for each subperiod. -- , a -- ^ The total of this row's values. -- , a -- ^ The average of this row's values. -- ) 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 BudgetReport = PeriodicReport BudgetCell type BudgetReportRow = PeriodicReportRow 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 -> Bool -> DateSpan -> Day -> Journal -> BudgetReport budgetReport ropts assrt showunbudgeted reportspan d j = let q = queryFromOpts d ropts budgetedaccts = dbg2 "budgetedacctsinperiod" $ accountNamesFromPostings $ concatMap tpostings $ concatMap (flip runPeriodicTransaction reportspan) $ jperiodictxns j actualj = dbg1 "actualj" $ budgetRollUp budgetedaccts showunbudgeted j budgetj = dbg1 "budgetj" $ budgetJournal assrt ropts reportspan j actualreport@(MultiBalanceReport (actualspans, _, _)) = dbg1 "actualreport" $ multiBalanceReport ropts q actualj budgetgoalreport@(MultiBalanceReport (_, budgetgoalitems, budgetgoaltotals)) = dbg1 "budgetgoalreport" $ multiBalanceReport ropts q 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 = MultiBalanceReport (actualspans, budgetgoalitems, budgetgoaltotals) | otherwise = budgetgoalreport budgetreport = combineBudgetAndActual budgetgoalreport' actualreport sortedbudgetreport = sortBudgetReport ropts j budgetreport in dbg1 "sortedbudgetreport" sortedbudgetreport -- | Sort a budget report's rows according to options. sortBudgetReport :: ReportOpts -> Journal -> BudgetReport -> BudgetReport sortBudgetReport ropts j (PeriodicReport (ps, rows, trow)) = PeriodicReport (ps, sortedrows, trow) where sortedrows | sort_amount_ ropts && tree_ ropts = sortTreeBURByActualAmount rows | sort_amount_ ropts = sortFlatBURByActualAmount rows | otherwise = sortByAccountDeclaration rows -- Sort a tree-mode budget report's rows by total actual amount at each level. sortTreeBURByActualAmount :: [BudgetReportRow] -> [BudgetReportRow] sortTreeBURByActualAmount rows = sortedrows where anamesandrows = [(first6 r, r) | r <- rows] anames = map fst anamesandrows atotals = [(a,tot) | (a,_,_,_,(tot,_),_) <- rows] accounttree = accountTree "root" anames accounttreewithbals = mapAccounts setibalance accounttree where setibalance a = a{aibalance= fromMaybe 0 $ -- when there's no actual amount, assume 0; will mess up with negative amounts ? TODO fromMaybe (error "sortTreeByAmount 1") $ -- should not happen, but it's ugly; TODO lookup (aname a) atotals } sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive $ normalbalance_ ropts) accounttreewithbals sortedanames = map aname $ drop 1 $ flattenAccounts sortedaccounttree sortedrows = sortAccountItemsLike sortedanames anamesandrows -- Sort a flat-mode budget report's rows by total actual amount. sortFlatBURByActualAmount :: [BudgetReportRow] -> [BudgetReportRow] sortFlatBURByActualAmount = sortBy (maybeflip $ comparing (fst . fifth6)) where maybeflip = if normalbalance_ ropts == Just NormallyNegative then id else flip -- Sort the report rows by account declaration order then account name. -- remains at the top. sortByAccountDeclaration rows = sortedrows where (unbudgetedrow,rows') = partition ((=="").first6) rows anamesandrows = [(first6 r, r) | r <- rows'] anames = map fst anamesandrows sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames sortedrows = unbudgetedrow ++ sortAccountItemsLike sortedanames anamesandrows -- | 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 } 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 --show-unbudgeted. -- 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, porigin = Just . fromMaybe p $ porigin 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 :: MultiBalanceReport -> MultiBalanceReport -> BudgetReport combineBudgetAndActual (MultiBalanceReport (budgetperiods, budgetrows, (budgettots, budgetgrandtot, budgetgrandavg))) (MultiBalanceReport (actualperiods, actualrows, (actualtots, actualgrandtot, actualgrandavg))) = let periods = nub $ sort $ filter (/= nulldatespan) $ budgetperiods ++ actualperiods -- first, combine any corresponding budget goals with actual changes rows1 = [ (acct, treeacct, treeindent, amtandgoals, totamtandgoal, avgamtandgoal) | (acct, treeacct, treeindent, actualamts, actualtot, actualavg) <- actualrows , let mbudgetgoals = Map.lookup acct budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage) , let budgetmamts = maybe (replicate (length periods) Nothing) (map Just . first3) mbudgetgoals :: [Maybe BudgetGoal] , let mbudgettot = maybe Nothing (Just . second3) mbudgetgoals :: Maybe BudgetTotal , let mbudgetavg = maybe Nothing (Just . 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 ] :: [(Maybe Change, Maybe BudgetGoal)] , let totamtandgoal = (Just actualtot, mbudgettot) , let avgamtandgoal = (Just actualavg, mbudgetavg) ] where budgetGoalsByAcct :: Map AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) = Map.fromList [ (acct, (amts, tot, avg)) | (acct, _, _, amts, tot, avg) <- budgetrows ] -- next, make rows for budget goals with no actual changes rows2 = [ (acct, treeacct, treeindent, amtandgoals, totamtandgoal, avgamtandgoal) | (acct, treeacct, treeindent, budgetgoals, budgettot, budgetavg) <- budgetrows , not $ acct `elem` acctsdone , let acctBudgetByPeriod = Map.fromList $ zip budgetperiods budgetgoals :: Map DateSpan BudgetGoal , let amtandgoals = [ (Nothing, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [(Maybe Change, Maybe BudgetGoal)] , let totamtandgoal = (Nothing, Just budgettot) , let avgamtandgoal = (Nothing, Just budgetavg) ] where acctsdone = map first6 rows1 -- combine and re-sort rows -- TODO: use MBR code -- TODO: respect --sort-amount -- TODO: add --sort-budget to sort by budget goal amount rows :: [PeriodicReportRow (Maybe Change, Maybe BudgetGoal)] = sortBy (comparing first6) $ rows1 ++ rows2 -- TODO: grand total & average shows 0% when there are no actual amounts, inconsistent with other cells totalrow = ( "" , "" , 0 , [ (Map.lookup p totActualByPeriod, Map.lookup p totBudgetByPeriod) | p <- periods ] :: [(Maybe Total, Maybe BudgetTotal)] , ( Just actualgrandtot, Just budgetgrandtot ) :: (Maybe Total, Maybe BudgetTotal) , ( Just actualgrandavg, Just budgetgrandavg ) :: (Maybe Total, Maybe BudgetTotal) ) where totBudgetByPeriod = Map.fromList $ zip budgetperiods budgettots :: Map DateSpan BudgetTotal totActualByPeriod = Map.fromList $ zip actualperiods actualtots :: Map DateSpan Change in PeriodicReport ( periods , rows , totalrow ) -- | Figure out the overall period of a BudgetReport. budgetReportSpan :: BudgetReport -> DateSpan budgetReportSpan (PeriodicReport ([], _, _)) = DateSpan Nothing Nothing budgetReportSpan (PeriodicReport (spans, _, _)) = DateSpan (spanStart $ head spans) (spanEnd $ last spans) -- | Render a budget report as plain text suitable for console output. budgetReportAsText :: ReportOpts -> BudgetReport -> String budgetReportAsText ropts budgetr = printf "Budget performance in %s:\n\n" (showDateSpan $ budgetReportSpan budgetr) ++ tableAsText ropts showcell (budgetReportAsTable ropts budgetr) where -- XXX lay out actual, percentage and/or goal in the single table cell for now, should probably use separate cells showcell :: (Maybe Change, Maybe BudgetGoal) -> String showcell (mactual, mbudget) = actualstr ++ " " ++ budgetstr where actualwidth = 7 percentwidth = 4 budgetwidth = 5 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) (showbudgetamt budget) Nothing -> printf ("["++replicate (percentwidth+5) ' '++"%"++show budgetwidth++"s]") (showbudgetamt budget) -- | Calculate the percentage of actual change to budget goal to show, if any. -- Both amounts are converted to cost, if possible, 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 (toCost actual, toCost budget) of (Mixed [a], Mixed [b]) | (acommodity a == acommodity b || isZeroAmount a) && not (isZeroAmount b) -> Just $ 100 * aquantity a / aquantity b _ -> Nothing where toCost = normaliseMixedAmount . costOfMixedAmount showamt :: MixedAmount -> String showamt | color_ ropts = cshowMixedAmountOneLineWithoutPrice | otherwise = showMixedAmountOneLineWithoutPrice -- don't show the budget amount in color, it messes up alignment showbudgetamt = showMixedAmountOneLineWithoutPrice -- | Build a 'Table' from a multi-column balance report. budgetReportAsTable :: ReportOpts -> BudgetReport -> Table String String (Maybe MixedAmount, Maybe MixedAmount) budgetReportAsTable ropts (PeriodicReport ( periods , rows , (_, _, _, coltots, grandtot, grandavg) )) = addtotalrow $ Table (T.Group NoLine $ map Header accts) (T.Group NoLine $ map Header colheadings) (map rowvals rows) where colheadings = map showDateSpanMonthAbbrev periods ++ (if row_total_ ropts then [" Total"] else []) ++ (if average_ ropts then ["Average"] else []) accts = map renderacct rows renderacct (a,a',i,_,_,_) | tree_ ropts = replicate ((i-1)*2) ' ' ++ T.unpack a' | otherwise = T.unpack $ maybeAccountNameDrop ropts a rowvals (_,_,_,as,rowtot,rowavg) = as ++ (if row_total_ ropts then [rowtot] else []) ++ (if average_ ropts then [rowavg] else []) addtotalrow | no_total_ ropts = id | otherwise = (+----+ (row "" $ coltots ++ (if row_total_ ropts && not (null coltots) then [grandtot] else []) ++ (if average_ ropts && not (null coltots) then [grandavg] else []) )) -- XXX here for now -- TODO: does not work for flat-by-default reports with --flat not specified explicitly -- | Drop leading components of accounts names as specified by --drop, but only in --flat mode. maybeAccountNameDrop :: ReportOpts -> AccountName -> AccountName maybeAccountNameDrop opts a | flat_ opts = accountNameDrop (drop_ opts) a | otherwise = a -- tests tests_BudgetReport = tests "BudgetReport" [ ] hledger-lib-1.12/Hledger/Reports/EntriesReport.hs0000644000000000000000000000244413372610345020162 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable, FlexibleInstances #-} {-| Journal entries report, used by the print command. -} module Hledger.Reports.EntriesReport ( EntriesReport, EntriesReportItem, entriesReport, -- * Tests tests_EntriesReport ) where import Data.List import Data.Ord 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 opts q j = sortBy (comparing date) $ filter (q `matchesTransaction`) ts where date = transactionDateFn opts ts = jtxns $ journalSelectingAmountFromOpts opts j tests_EntriesReport = tests "EntriesReport" [ tests "entriesReport" [ test "not acct" $ (length $ entriesReport defreportopts (Not $ Acct "bank") samplejournal) `is` 1 ,test "date" $ (length $ entriesReport defreportopts (Date $ mkdatespan "2008/06/01" "2008/07/01") samplejournal) `is` 3 ] ] hledger-lib-1.12/Hledger/Reports/MultiBalanceReports.hs0000644000000000000000000004336513401044253021273 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, OverloadedStrings #-} {-| Multi-column balance reports, used by the balance command. -} module Hledger.Reports.MultiBalanceReports ( MultiBalanceReport(..), MultiBalanceReportRow, multiBalanceReport, balanceReportFromMultiBalanceReport, mbrNegate, mbrNormaliseSign, multiBalanceReportSpan, tableAsText, -- -- * Tests tests_MultiBalanceReports ) where import Data.List import Data.Maybe import Data.Ord import Data.Time.Calendar import Safe import Text.Tabular as T import Text.Tabular.AsciiWide import Hledger.Data import Hledger.Query import Hledger.Utils import Hledger.Read (mamountp') import Hledger.Reports.ReportOptions import Hledger.Reports.BalanceReport -- | A multi balance report is a balance report with one or more columns. It has: -- -- 1. a list of each column's period (date span) -- -- 2. a list of rows, each containing: -- -- * the full account name -- -- * the leaf account name -- -- * the account's depth -- -- * a list of amounts, one for each column -- -- * the total of the row's amounts -- -- * the average of the row's amounts -- -- 3. the column totals and the overall total and average -- -- The meaning of the amounts depends on the type of multi balance -- report, of which there are three: periodic, cumulative and historical -- (see 'BalanceType' and "Hledger.Cli.Commands.Balance"). newtype MultiBalanceReport = MultiBalanceReport ([DateSpan] ,[MultiBalanceReportRow] ,MultiBalanceReportTotals ) type MultiBalanceReportRow = (AccountName, AccountName, Int, [MixedAmount], MixedAmount, MixedAmount) type MultiBalanceReportTotals = ([MixedAmount], MixedAmount, MixedAmount) -- (Totals list, sum of totals, average of totals) instance Show MultiBalanceReport where -- use pshow (pretty-show's ppShow) to break long lists onto multiple lines -- we add some bogus extra shows here to help it parse the output -- and wrap tuples and lists properly show (MultiBalanceReport (spans, items, totals)) = "MultiBalanceReport (ignore extra quotes):\n" ++ pshow (show spans, map show items, totals) -- 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. Does not support tree-mode boring parent eliding. -- If the normalbalance_ option is set, it adjusts the sorting and sign of amounts -- (see ReportOpts and CompoundBalanceCommand). multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport multiBalanceReport opts q j = (if invert_ opts then mbrNegate else id) $ MultiBalanceReport (displayspans, sorteditems, totalsrow) where symq = dbg1 "symq" $ filterQuery queryIsSym $ dbg1 "requested q" q depthq = dbg1 "depthq" $ filterQuery queryIsDepth q depth = queryDepth depthq depthless = dbg1 "depthless" . filterQuery (not . queryIsDepth) datelessq = dbg1 "datelessq" $ filterQuery (not . queryIsDateOrDate2) q dateqcons = if date2_ opts then Date2 else Date -- The date span specified by -b/-e/-p options and query args if any. requestedspan = dbg1 "requestedspan" $ queryDateSpan (date2_ opts) 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' = dbg1 "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan (date2_ opts) 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 = dbg1 "intervalspans" $ splitSpan (interval_ opts) requestedspan' -- The requested span enlarged to enclose a whole number of intervals. -- This can be the null span if there were no intervals. reportspan = dbg1 "reportspan" $ DateSpan (maybe Nothing spanStart $ headMay intervalspans) (maybe Nothing spanEnd $ lastMay intervalspans) -- 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 = dbg1 "reportq" $ depthless $ if reportspan == nulldatespan then q else And [datelessq, reportspandatesq] where reportspandatesq = dbg1 "reportspandatesq" $ dateqcons reportspan -- q projected back before the report start date, to calculate starting balances. -- 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 = dbg1 "startbalq" $ And [datelessq, dateqcons precedingspan] where precedingspan = case spanStart reportspan of Just d -> DateSpan Nothing (Just d) Nothing -> emptydatespan ps :: [Posting] = dbg1 "ps" $ journalPostings $ filterJournalAmounts symq $ -- remove amount parts excluded by cur: filterJournalPostings reportq $ -- remove postings not matched by (adjusted) query journalSelectingAmountFromOpts opts j displayspans = dbg1 "displayspans" $ splitSpan (interval_ opts) displayspan where displayspan | empty_ opts = dbg1 "displayspan (-E)" reportspan -- all the requested intervals | otherwise = dbg1 "displayspan" $ requestedspan `spanIntersect` matchedspan -- exclude leading/trailing empty intervals matchedspan = dbg1 "matchedspan" $ postingsDateSpan' (whichDateFromOpts opts) ps psPerSpan :: [[Posting]] = dbg1 "psPerSpan" [filter (isPostingInDateSpan' (whichDateFromOpts opts) s) ps | s <- displayspans] postedAcctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] = dbg1 "postedAcctBalChangesPerSpan" $ map postingAcctBals psPerSpan where postingAcctBals :: [Posting] -> [(ClippedAccountName, MixedAmount)] postingAcctBals ps = [(aname a, (if tree_ opts then aibalance else aebalance) a) | a <- as] where as = depthLimit $ (if tree_ opts then id else filter ((>0).anumpostings)) $ drop 1 $ accountsFromPostings ps depthLimit | tree_ opts = filter ((depthq `matchesAccount`).aname) -- exclude deeper balances | otherwise = clipAccountsAndAggregate depth -- aggregate deeper balances at the depth limit postedAccts :: [AccountName] = dbg1 "postedAccts" $ sort $ accountNamesFromPostings ps -- starting balances and accounts from transactions before the report start date startacctbals = dbg1 "startacctbals" $ map (\(a,_,_,b) -> (a,b)) startbalanceitems where (startbalanceitems,_) = dbg1 "starting balance report" $ balanceReport opts' startbalq j where opts' | tree_ opts = opts{no_elide_=True} | otherwise = opts{accountlistmode_=ALFlat} startingBalanceFor a = fromMaybe nullmixedamt $ lookup a startacctbals startAccts = dbg1 "startAccts" $ map fst startacctbals displayedAccts :: [ClippedAccountName] = dbg1 "displayedAccts" $ (if tree_ opts then expandAccountNames else id) $ nub $ map (clipOrEllipsifyAccountName depth) $ if empty_ opts || (balancetype_ opts) == HistoricalBalance then nub $ sort $ startAccts ++ postedAccts else postedAccts acctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] = dbg1 "acctBalChangesPerSpan" [sortBy (comparing fst) $ unionBy (\(a,_) (a',_) -> a == a') postedacctbals zeroes | postedacctbals <- postedAcctBalChangesPerSpan] where zeroes = [(a, nullmixedamt) | a <- displayedAccts] acctBalChanges :: [(ClippedAccountName, [MixedAmount])] = dbg1 "acctBalChanges" [(a, map snd abs) | abs@((a,_):_) <- transpose acctBalChangesPerSpan] -- never null, or used when null... items :: [MultiBalanceReportRow] = dbg1 "items" $ [(a, accountLeafName a, accountNameLevel a, displayedBals, rowtot, rowavg) | (a,changes) <- acctBalChanges , let displayedBals = case balancetype_ opts of HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes CumulativeChange -> drop 1 $ scanl (+) nullmixedamt changes _ -> changes , let rowtot = sum displayedBals , let rowavg = averageMixedAmounts displayedBals , empty_ opts || depth == 0 || any (not . isZeroMixedAmount) displayedBals ] -- TODO TBD: is it always ok to sort report rows after report has been generated ? -- Or does sorting sometimes need to be done as part of the report generation ? sorteditems :: [MultiBalanceReportRow] = dbg1 "sorteditems" $ sortitems items where sortitems | sort_amount_ opts && accountlistmode_ opts == ALTree = sortTreeMBRByAmount | sort_amount_ opts = sortFlatMBRByAmount | otherwise = sortMBRByAccountDeclaration where -- Sort the report rows, representing a tree of accounts, by row total at each level. -- Similar to sortMBRByAccountDeclaration/sortAccountNamesByDeclaration. sortTreeMBRByAmount rows = sortedrows where anamesandrows = [(first6 r, r) | r <- rows] anames = map fst anamesandrows atotals = [(a,tot) | (a,_,_,_,tot,_) <- rows] accounttree = accountTree "root" anames accounttreewithbals = mapAccounts setibalance accounttree where -- should not happen, but it's dangerous; TODO setibalance a = a{aibalance=fromMaybe (error "sortTreeMBRByAmount 1") $ lookup (aname a) atotals} sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive $ normalbalance_ opts) accounttreewithbals sortedanames = map aname $ drop 1 $ flattenAccounts sortedaccounttree sortedrows = sortAccountItemsLike sortedanames anamesandrows -- Sort the report rows, representing a flat account list, by row total. sortFlatMBRByAmount = sortBy (maybeflip $ comparing (normaliseMixedAmountSquashPricesForDisplay . fifth6)) where maybeflip = if normalbalance_ opts == Just NormallyNegative then id else flip -- Sort the report rows by account declaration order then account name. sortMBRByAccountDeclaration rows = sortedrows where anamesandrows = [(first6 r, r) | r <- rows] anames = map fst anamesandrows sortedanames = sortAccountNamesByDeclaration j (tree_ opts) anames sortedrows = sortAccountItemsLike sortedanames anamesandrows totals :: [MixedAmount] = -- dbg1 "totals" $ map sum balsbycol where balsbycol = transpose [bs | (a,_,_,bs,_,_) <- sorteditems, not (tree_ opts) || a `elem` highestlevelaccts] highestlevelaccts = dbg1 "highestlevelaccts" [a | a <- displayedAccts, not $ any (`elem` displayedAccts) $ init $ expandAccountName a] totalsrow :: MultiBalanceReportTotals = dbg1 "totalsrow" (totals, sum totals, averageMixedAmounts totals) dbg1 s = let p = "multiBalanceReport" in Hledger.Utils.dbg1 (p++" "++s) -- add prefix in this function's debug output -- dbg1 = const id -- exclude this function from debug output -- | Given a MultiBalanceReport and its normal balance sign, -- if it is known to be normally negative, convert it to normally positive. mbrNormaliseSign :: NormalSign -> MultiBalanceReport -> MultiBalanceReport mbrNormaliseSign NormallyNegative = mbrNegate mbrNormaliseSign _ = id -- | Flip the sign of all amounts in a MultiBalanceReport. mbrNegate (MultiBalanceReport (colspans, rows, totalsrow)) = MultiBalanceReport (colspans, map mbrRowNegate rows, mbrTotalsRowNegate totalsrow) where mbrRowNegate (acct,shortacct,indent,amts,tot,avg) = (acct,shortacct,indent,map negate amts,-tot,-avg) mbrTotalsRowNegate (amts,tot,avg) = (map negate amts,-tot,-avg) -- | Figure out the overall date span of a multicolumn balance report. multiBalanceReportSpan :: MultiBalanceReport -> DateSpan multiBalanceReportSpan (MultiBalanceReport ([], _, _)) = DateSpan Nothing Nothing multiBalanceReportSpan (MultiBalanceReport (colspans, _, _)) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans) -- | Generates a simple non-columnar BalanceReport, but using multiBalanceReport, -- in order to support --historical. Does not support tree-mode boring parent eliding. -- If the normalbalance_ option is set, it adjusts the sorting and sign of amounts -- (see ReportOpts and CompoundBalanceCommand). balanceReportFromMultiBalanceReport :: ReportOpts -> Query -> Journal -> BalanceReport balanceReportFromMultiBalanceReport opts q j = (rows', total) where MultiBalanceReport (_, rows, (totals, _, _)) = multiBalanceReport opts q j rows' = [(a ,if flat_ opts then a else a' -- BalanceReport expects full account name here with --flat ,if tree_ opts then d-1 else 0 -- BalanceReport uses 0-based account depths , headDef nullmixedamt amts -- 0 columns is illegal, should not happen, return zeroes if it does ) | (a,a',d, amts, _, _) <- rows] total = headDef nullmixedamt totals -- 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_MultiBalanceReports = tests "MultiBalanceReports" [ let (opts,journal) `gives` r = do let (eitems, etotal) = r (MultiBalanceReport (_, aitems, atotal)) = multiBalanceReport opts (queryFromOpts nulldate opts) journal showw (acct,acct',indent,lAmt,amt,amt') = (acct, acct', indent, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt') (map showw aitems) `is` (map showw eitems) ((\(_, b, _) -> showMixedAmountDebug b) atotal) `is` (showMixedAmountDebug etotal) -- we only check the sum of the totals usd0 = usd 0 amount0 = Amount {acommodity="$", aquantity=0, aprice=NoPrice, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, amultiplier=False} 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` ( [ ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}]) ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}]) ], Mixed [usd0]) ,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 [amount0 {aquantity=1}]) ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {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 [amount0 {aquantity=1}]) ,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}]) ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",Mixed [amount0 {aquantity=(-2)}]) ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}]) ,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}]) ,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}]) ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}]) ], Mixed [usd0]) ] ] hledger-lib-1.12/Hledger/Reports/PostingsReport.hs0000644000000000000000000005737313401044253020362 0ustar0000000000000000{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances, TupleSections, OverloadedStrings #-} {-| Postings report, used by the register command. -} module Hledger.Reports.PostingsReport ( PostingsReport, PostingsReportItem, postingsReport, mkpostingsReportItem, -- * Tests tests_PostingsReport ) where import Data.List import Data.Maybe import Data.Ord (comparing) -- 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. ) -- | 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 opts q j = (totallabel, items) where reportspan = adjustReportDates opts q j whichdate = whichDateFromOpts opts depth = queryDepth q -- postings to be included in the report, and similarly-matched postings before the report start date (precedingps, reportps) = matchedPostingsBeforeAndDuring opts q j reportspan -- postings or pseudo postings to be displayed displayps | interval == NoInterval = map (,Nothing) reportps | otherwise = summarisePostingsByInterval interval whichdate depth showempty reportspan reportps where interval = interval_ opts -- XXX showempty = empty_ opts || average_ opts -- posting report items ready for display items = dbg1 "postingsReport items" $ postingsReportItems displayps (nullposting,Nothing) whichdate depth startbal runningcalc startnum where historical = balancetype_ opts == HistoricalBalance precedingsum = sumPostings precedingps precedingavg | null precedingps = 0 | otherwise = divideMixedAmount (fromIntegral $ length precedingps) precedingsum startbal | average_ opts = if historical then precedingavg else 0 | otherwise = if historical then precedingsum else 0 startnum = if historical then length precedingps + 1 else 1 runningcalc | average_ opts = \i avg amt -> divideMixedAmount (fromIntegral i) avg + amt - avg -- running average | otherwise = \_ bal amt -> bal + amt -- running total 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 = dbg1 "requestedspan" $ queryDateSpan' q -- span specified by -b/-e/-p options and query args journalspan = dbg1 "journalspan" $ dates `spanUnion` date2s -- earliest and latest dates (or date2s) in the journal where dates = journalDateSpan False j date2s = journalDateSpan True j requestedspanclosed = dbg1 "requestedspanclosed" $ requestedspan `spanDefaultsFrom` journalspan -- if open-ended, close it using the journal's dates (if any) intervalspans = dbg1 "intervalspans" $ splitSpan (interval_ opts) requestedspanclosed -- get the whole intervals enclosing that mreportstart = dbg1 "reportstart" $ maybe Nothing spanStart $ headMay intervalspans -- start of the first interval, or open ended mreportend = dbg1 "reportend" $ maybe Nothing spanEnd $ lastMay intervalspans -- end of the last interval, or open ended reportspan = dbg1 "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) = dbg1 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps where beforestartq = dbg1 "beforestartq" $ dateqtype $ DateSpan Nothing mstart beforeandduringps = dbg1 "ps4" $ sortBy (comparing sortdate) $ -- sort postings by date or date2 dbg1 "ps3" $ map (filterPostingAmount symq) $ -- remove amount parts which the query's cur: terms would exclude dbg1 "ps2" $ (if related_ opts then concatMap relatedPostings else id) $ -- with -r, replace each with its sibling postings dbg1 "ps1" $ filter (beforeandduringq `matchesPosting`) $ -- filter postings by the query, with no start date or depth limit journalPostings $ journalSelectingAmountFromOpts opts j where beforeandduringq = dbg1 "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 = dbg1 "symq" $ filterQuery queryIsSym q dateqtype | queryIsDate2 dateq || (queryIsDate dateq && date2_ opts) = Date2 | otherwise = Date where dateq = dbg1 "dateq" $ filterQuery queryIsDateOrDate2 $ dbg1 "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 -> 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. summarisePostingsByInterval :: Interval -> WhichDate -> Int -> Bool -> DateSpan -> [Posting] -> [SummaryPosting] summarisePostingsByInterval interval wd depth showempty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan where summarisespan s = summarisePostingsInDateSpan s wd depth showempty (postingsinspan s) postingsinspan s = filter (isPostingInDateSpan' wd s) ps -- | A summary posting summarises the activity in one account within a report -- interval. It is currently 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, Maybe Day) -- | Given a date span (representing a report interval) and a list of -- postings within it, aggregate the postings into one summary posting per -- account. -- -- 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 -> Int -> Bool -> [Posting] -> [SummaryPosting] summarisePostingsInDateSpan (DateSpan b e) wd depth showempty ps | null ps && (isNothing b || isNothing e) = [] | null ps && showempty = [(summaryp, Just 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 | depth > 0 = nub $ map (clipAccountName depth) anames | otherwise = ["..."] summaryps | depth > 0 = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames] | otherwise = [summaryp{paccount="...",pamount=sum $ map pamount ps}] summarypes = map (, Just e') $ (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps anames = sort $ nub $ 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 = accountNameLevel a >= depth -- tests tests_PostingsReport = tests "PostingsReport" [ tests "postingsReport" $ let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts query journal) `is` n in [ -- 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 "expenses"], samplejournal) `gives` 2 ,(And [And [Depth 1, StatusQ Cleared], Acct "expenses"], samplejournal) `gives` 2 -- with query and/or command-line options ,(length $ snd $ postingsReport defreportopts Any samplejournal) `is` 13 ,(length $ snd $ postingsReport defreportopts{interval_=Months 1} Any samplejournal) `is` 11 ,(length $ snd $ postingsReport defreportopts{interval_=Months 1, empty_=True} Any samplejournal) `is` 20 ,(length $ snd $ postingsReport defreportopts (Acct "assets:bank:checking") samplejournal) `is` 5 -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0 -- [(Just (parsedate "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{display_=Just displayexpr} "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" ] -} ] ,tests "summarisePostingsByInterval" [ tests "summarisePostingsByInterval" [ summarisePostingsByInterval (Quarters 1) PrimaryDate 99999 False (DateSpan Nothing Nothing) [] `is` [] ] ] -- ,tests_summarisePostingsInDateSpan = [ -- "summarisePostingsInDateSpan" ~: do -- let gives (b,e,depth,showempty,ps) = -- (summarisePostingsInDateSpan (mkdatespan 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=parsedate "2008/01/01",lpdescription="- 2008/12/31"} -- ] -- ("2008/01/01","2009/01/01",0,9999,False,ts) `gives` -- [ -- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food", lpamount=Mixed [usd 4]} -- ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:dining", lpamount=Mixed [usd 10]} -- ,nullposting{lpdate=parsedate "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=parsedate "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=parsedate "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=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [usd 15]} -- ] ] hledger-lib-1.12/Hledger/Reports/TransactionsReports.hs0000644000000000000000000003311113372610345021377 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable, FlexibleInstances #-} {-| Here are several variants of a transactions report. Transactions reports are like a postings report, but more transaction-oriented, and (in the account-centric variant) relative to a some base account. They are used by hledger-web. -} module Hledger.Reports.TransactionsReports ( TransactionsReport, TransactionsReportItem, AccountTransactionsReport, AccountTransactionsReportItem, triOrigTransaction, triDate, triAmount, triBalance, triCommodityAmount, triCommodityBalance, journalTransactionsReport, accountTransactionsReport, transactionsReportByCommodity, transactionRegisterDate, tests_TransactionsReports ) where import Data.List import Data.Ord -- import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar import Hledger.Data import Hledger.Query import Hledger.Reports.ReportOptions import Hledger.Utils -- | A transactions report includes a list of transactions -- (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 journalTransactionsReport -- 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 ------------------------------------------------------------------------------- -- | 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. journalTransactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport journalTransactionsReport 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 ------------------------------------------------------------------------------- -- | 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 account -- register view, 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 ) accountTransactionsReport :: ReportOpts -> Journal -> Query -> Query -> AccountTransactionsReport accountTransactionsReport opts j reportq thisacctq = (label, items) where -- a depth limit does not affect the account transactions report -- seems unnecessary for some reason XXX reportq' = -- filterQuery (not . queryIsDepth) reportq -- get all transactions, with amounts converted to cost basis if -B ts1 = jtxns $ journalSelectingAmountFromOpts opts j -- apply any cur:SYM filters in reportq' symq = filterQuery queryIsSym reportq' ts2 = (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 = filter (matchesTransaction thisacctq . filterTransactionPostings (And [realq, statusq])) ts2 -- sort by the transaction's register date, for accurate starting balance ts = sortBy (comparing (transactionRegisterDate reportq' thisacctq)) ts3 (startbal,label) | balancetype_ opts == HistoricalBalance = (sumPostings priorps, balancelabel) | otherwise = (nullmixedamt, totallabel) where priorps = dbg1 "priorps" $ filter (matchesPosting (dbg1 "priorq" $ And [thisacctq, tostartdateq, datelessreportq])) $ transactionsPostings ts tostartdateq = case mstartdate of Just _ -> Date (DateSpan Nothing mstartdate) Nothing -> None -- no start date specified, there are no prior postings mstartdate = queryStartDate (date2_ opts) reportq' datelessreportq = filterQuery (not . queryIsDateOrDate2) reportq' items = reverse $ -- see also registerChartHtml accountTransactionsReportItems reportq' thisacctq startbal negate ts totallabel = "Period Total" balancelabel = "Historical Total" -- | 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 journalTransactionsReport. accountTransactionsReportItems :: Query -> Query -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [TransactionsReportItem] accountTransactionsReportItems _ _ _ _ [] = [] accountTransactionsReportItems reportq thisacctq bal signfn (torig:ts) = case i of Just i' -> i':is Nothing -> is -- 201403: This is used for both accountTransactionsReport and journalTransactionsReport, 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} (i,bal') = case reportps of [] -> (Nothing,bal) -- no matched postings in this transaction, skip it _ -> (Just (torig, tacct, numotheraccts > 1, otheracctstr, a, b), 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 is = accountTransactionsReportItems reportq thisacctq bal' signfn ts -- | 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 ------------------------------------------------------------------------------- -- | 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) = nub $ sort $ 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_TransactionsReports = tests "TransactionsReports" [ ] hledger-lib-1.12/Hledger/Utils.hs0000644000000000000000000001604213373103562015015 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 SystemString,fromSystemString,toSystemString,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.List -- import Data.Maybe -- import Data.PPrint 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 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 (SystemString,fromSystemString,toSystemString,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 -- 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 isLeft :: Either a b -> Bool isLeft (Left _) = True isLeft _ = False isRight :: Either a b -> Bool isRight = not . isLeft -- | 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 -- | 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 firstJust ms = case dropWhile (==Nothing) ms of [] -> Nothing (md:_) -> md -- | Read text from a file, -- handling any of the usual line ending conventions, -- 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 {-# INLINABLE mapM' #-} mapM' :: Monad f => (a -> f b) -> [a] -> f [b] mapM' f = sequence' . map f tests_Utils = tests "Utils" [ tests_Text ] hledger-lib-1.12/Hledger/Utils/Color.hs0000644000000000000000000000116313302271455016070 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.12/Hledger/Utils/Debug.hs0000644000000000000000000002011113401044253016024 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, TypeFamilies #-} -- | Debugging helpers -- 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 ,debugLevel ,ptraceAt ,dbg0 ,dbgExit ,dbg1 ,dbg2 ,dbg3 ,dbg4 ,dbg5 ,dbg6 ,dbg7 ,dbg8 ,dbg9 ,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 -- | Trace (print to stderr) a showable value using a custom show function. traceWith :: (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 -- | 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 -- | Pretty-print a message and the showable value to the console, then return it. dbg0 :: Show a => String -> a -> a dbg0 = ptraceAt 0 -- "dbg" would clash with megaparsec -- | Like dbg0, but also exit the program. Uses unsafePerformIO. dbgExit :: Show a => String -> a -> a dbgExit msg = const (unsafePerformIO exitFailure) . dbg0 msg -- | Pretty-print a message 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 ptraceAt, but convenient to insert in an IO monad (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 message 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 message 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.12/Hledger/Utils/Parse.hs0000644000000000000000000000725513373103562016075 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, spacenonewline, restofline, eolof, -- * 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 in some monad. type TextParser m a = ParsecT CustomErr Text m a -- | A parser of text in some monad, with a journal as state. type JournalParser m a = StateT Journal (ParsecT CustomErr Text m) a -- | A parser of text in some monad, with a journal as state, that can throw a -- "final" parse error that does not backtrack. 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 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 spacenonewline :: (Stream s, Char ~ Token s) => ParsecT CustomErr s m Char spacenonewline = satisfy isNonNewlineSpace restofline :: TextParser m String restofline = anySingle `manyTill` newline eolof :: TextParser m () eolof = (newline >> return ()) <|> eof hledger-lib-1.12/Hledger/Utils/Regex.hs0000644000000000000000000001142413302271455016065 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-| 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. Current limitations: - (?i) and similar are not supported -} module Hledger.Utils.Regex ( -- * type aliases Regexp ,Replacement -- * standard regex operations ,regexMatches ,regexMatchesCI ,regexReplace ,regexReplaceCI ,regexReplaceMemo ,regexReplaceCIMemo ,regexReplaceBy ,regexReplaceByCI ) where import Data.Array import Data.Char import Data.List (foldl') import Data.MemoUgly (memo) import Text.Regex.TDFA ( Regex, CompOption(..), ExecOption(..), defaultCompOpt, defaultExecOpt, makeRegexOpts, AllMatches(getAllMatches), match, (=~), MatchText ) -- import Hledger.Utils.Debug import Hledger.Utils.UTF8IOCompat (error') -- | Regular expression. Extended regular expression-ish syntax ? But does not support eg (?i) syntax. type Regexp = String -- | A replacement pattern. May include numeric backreferences (\N). type Replacement = String -- | Convert our string-based regexps to real ones. Can fail if the -- string regexp is malformed. toRegex :: Regexp -> Regex toRegex = memo (makeRegexOpts compOpt execOpt) toRegexCI :: Regexp -> Regex toRegexCI = memo (makeRegexOpts compOpt{caseSensitive=False} execOpt) compOpt :: CompOption compOpt = defaultCompOpt execOpt :: ExecOption execOpt = defaultExecOpt -- regexMatch' :: RegexContext Regexp String a => Regexp -> String -> a -- regexMatch' r s = s =~ (toRegex r) regexMatches :: Regexp -> String -> Bool regexMatches = flip (=~) regexMatchesCI :: Regexp -> String -> Bool regexMatchesCI r = match (toRegexCI r) -- | Replace all occurrences of the regexp, transforming each match with the given function. regexReplaceBy :: Regexp -> (String -> String) -> String -> String regexReplaceBy r = replaceAllBy (toRegex r) regexReplaceByCI :: Regexp -> (String -> String) -> String -> String regexReplaceByCI r = replaceAllBy (toRegexCI r) -- | Replace all occurrences of the regexp with the replacement -- pattern. The replacement pattern supports numeric backreferences -- (\N) but no other RE syntax. regexReplace :: Regexp -> Replacement -> String -> String regexReplace re = replaceRegex (toRegex re) regexReplaceCI :: Regexp -> Replacement -> String -> String regexReplaceCI re = replaceRegex (toRegexCI re) -- | A memoising version of regexReplace. Caches the result for each -- search pattern, replacement pattern, target string tuple. regexReplaceMemo :: Regexp -> Replacement -> String -> String regexReplaceMemo re repl = memo (regexReplace re repl) regexReplaceCIMemo :: Regexp -> Replacement -> String -> String regexReplaceCIMemo re repl = memo (regexReplaceCI re repl) -- replaceRegex :: Regex -> Replacement -> String -> String replaceRegex re repl s = foldl (replaceMatch repl) s (reverse $ match re s :: [MatchText String]) 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 = replaceAllBy (toRegex "\\\\[0-9]+") (replaceBackReference matchgroups) replpat replaceBackReference :: MatchText String -> String -> String replaceBackReference grps ('\\':s@(_:_)) | all isDigit s = case read s of n | n `elem` indices grps -> fst (grps ! n) _ -> error' $ "no match group exists for backreference \"\\"++s++"\"" replaceBackReference _ s = error' $ "replaceBackReference called on non-numeric-backreference \""++s++"\", shouldn't happen" -- -- 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 function. replaceAllBy :: Regex -> (String -> String) -> String -> String replaceAllBy re f s = start end where (_, end, start) = foldl' go (0, s, id) $ (getAllMatches $ match re s :: [(Int, Int)]) go (ind,read,write) (off,len) = let (skip, start) = splitAt (off - ind) read (matched, remaining) = splitAt len start in (off + len, remaining, write . (skip++) . (f matched ++)) hledger-lib-1.12/Hledger/Utils/String.hs0000644000000000000000000003372513363322116016267 0ustar0000000000000000-- | String formatting helpers, starting to get a bit out of control. module Hledger.Utils.String ( -- * misc lowercase, uppercase, underline, stripbrackets, unbracket, -- quoting quoteIfNeeded, singleQuoteIfNeeded, -- quotechars, -- whitespacechars, escapeQuotes, words', unwords', stripAnsi, -- * single-line layout strip, lstrip, rstrip, chomp, 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 import Data.List import Text.Megaparsec import Text.Megaparsec.Char import Text.Printf (printf) import Hledger.Utils.Parse import Hledger.Utils.Regex 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 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 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) = "\"" ++ 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 :: String -> String escapeDoubleQuotes = regexReplace "\"" "\"" 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 $ parsewithString p s where p = do ss <- (singleQuotedPattern <|> doubleQuotedPattern <|> pattern) `sepBy` skipSome 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' :: [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 "" = 0 strWidth s = maximum $ map (foldr (\a b -> charWidth a + b) 0) $ lines s' where s' = stripAnsi s stripAnsi :: String -> String stripAnsi = regexReplace "\ESC\\[([0-9]+;)*([0-9]+)?[ABCDHJKfmsu]" "" -- | 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.12/Hledger/Utils/Test.hs0000644000000000000000000001710513373103562015735 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Hledger.Utils.Test ( HasCallStack ,module EasyTest ,runEasytests ,tests ,_tests ,test ,_test ,it ,_it ,is ,expectEqPP ,expectParse ,expectParseE ,expectParseError ,expectParseErrorE ,expectParseEq ,expectParseEqE ,expectParseEqOn ,expectParseEqOnE ) where import Control.Exception import Control.Monad.Except (ExceptT, runExceptT) import Control.Monad.State.Strict (StateT, evalStateT) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif import Data.CallStack import Data.List import qualified Data.Text as T import Safe import System.Exit import Text.Megaparsec import Text.Megaparsec.Custom import EasyTest hiding (char, char', tests) -- reexported import qualified EasyTest as E -- used here import Hledger.Utils.Debug (pshow) import Hledger.Utils.UTF8IOCompat (error') -- * easytest helpers -- | Name the given test(s). A readability synonym for easytest's "scope". test :: T.Text -> E.Test a -> E.Test a test = E.scope -- | Skip the given test(s), with the same type signature as "test". -- If called in a monadic sequence of tests, also skips following tests. _test :: T.Text -> E.Test a -> E.Test a _test _name = (E.skip >>) -- | Name the given test(s). A synonym for "test". it :: T.Text -> E.Test a -> E.Test a it = test -- | Skip the given test(s), and any following tests in a monadic sequence. -- A synonym for "_test". _it :: T.Text -> E.Test a -> E.Test a _it = _test -- | Name and group a list of tests. Combines easytest's "scope" and "tests". tests :: T.Text -> [E.Test ()] -> E.Test () tests name = E.scope name . E.tests -- | Skip the given list of tests, and any following tests in a monadic sequence, -- with the same type signature as "group". _tests :: T.Text -> [E.Test ()] -> E.Test () _tests _name = (E.skip >>) . E.tests -- | Run some easytest tests, catching easytest's ExitCode exception, -- returning True if there was a problem. -- With arguments, runs only the scope (or single test) named by the first argument -- (exact, case sensitive). -- If there is a second argument, it should be an integer and will be used -- as the seed for randomness. runEasytests :: [String] -> E.Test () -> IO Bool runEasytests args tests = (do case args of [] -> E.run tests [a] -> E.runOnly (T.pack a) tests a:b:_ -> do case readMay b :: Maybe Int of Nothing -> error' "the second argument should be an integer (a seed for easytest)" Just seed -> E.rerunOnly seed (T.pack a) tests return False ) `catch` (\(_::ExitCode) -> return True) -- | Like easytest's expectEq (asserts the second (actual) value equals the first (expected) value) -- but pretty-prints the values in the failure output. expectEqPP :: (Eq a, Show a, HasCallStack) => a -> a -> E.Test () expectEqPP expected actual = if expected == actual then E.ok else E.crash $ "\nexpected:\n" <> T.pack (pshow expected) <> "\nbut got:\n" <> T.pack (pshow actual) <> "\n" -- | Shorter and flipped version of expectEqPP. The expected value goes last. is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () is = flip expectEqPP -- | Test 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. expectParse :: (Monoid st, Eq a, Show a, HasCallStack) => StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> E.Test () expectParse parser input = do ep <- E.io (runParserT (evalStateT (parser <* eof) mempty) "" input) either (fail.(++"\n").("\nparse error at "++).customErrorBundlePretty) (const ok) ep -- Suitable for hledger's ErroringJournalParser parsers. expectParseE :: (Monoid st, Eq a, Show a, HasCallStack) => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text -> E.Test () expectParseE parser input = do let filepath = "" eep <- E.io $ runExceptT $ runParserT (evalStateT (parser <* eof) mempty) filepath input case eep of Left finalErr -> let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr in fail $ "parse error at " <> prettyErr Right ep -> either (fail.(++"\n").("\nparse error at "++).customErrorBundlePretty) (const ok) ep -- | Test that this stateful parser runnable in IO fails to parse -- the given input text, with a parse error containing the given string. expectParseError :: (Monoid st, Eq a, Show a, HasCallStack) => StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> String -> E.Test () expectParseError parser input errstr = do ep <- E.io (runParserT (evalStateT parser mempty) "" input) case ep of Right v -> fail $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n" Left e -> do let e' = customErrorBundlePretty e if errstr `isInfixOf` e' then ok else fail $ "\nparse error is not as expected:\n" ++ e' ++ "\n" expectParseErrorE :: (Monoid st, Eq a, Show a, HasCallStack) => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text -> String -> E.Test () expectParseErrorE parser input errstr = do let filepath = "" eep <- E.io $ runExceptT $ runParserT (evalStateT parser mempty) filepath input case eep of Left finalErr -> do let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr if errstr `isInfixOf` prettyErr then ok else fail $ "\nparse error is not as expected:\n" ++ prettyErr ++ "\n" Right ep -> case ep of Right v -> fail $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n" Left e -> do let e' = customErrorBundlePretty e if errstr `isInfixOf` e' then ok else fail $ "\nparse error is not as expected:\n" ++ e' ++ "\n" -- | Like expectParse, but also test the parse result is an expected value, -- pretty-printing both if it fails. expectParseEq :: (Monoid st, Eq a, Show a, HasCallStack) => StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> E.Test () expectParseEq parser input expected = expectParseEqOn parser input id expected expectParseEqE :: (Monoid st, Eq a, Show a, HasCallStack) => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text -> a -> E.Test () expectParseEqE parser input expected = expectParseEqOnE parser input id expected -- | Like expectParseEq, but transform the parse result with the given function -- before comparing it. expectParseEqOn :: (Monoid st, Eq b, Show b, HasCallStack) => StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (a -> b) -> b -> E.Test () expectParseEqOn parser input f expected = do ep <- E.io $ runParserT (evalStateT (parser <* eof) mempty) "" input either (fail . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty) (expectEqPP expected . f) ep expectParseEqOnE :: (Monoid st, Eq b, Show b, HasCallStack) => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text -> (a -> b) -> b -> E.Test () expectParseEqOnE parser input f expected = do let filepath = "" eep <- E.io $ runExceptT $ runParserT (evalStateT (parser <* eof) mempty) filepath input case eep of Left finalErr -> let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr in fail $ "parse error at " <> prettyErr Right ep -> either (fail . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty) (expectEqPP expected . f) ep hledger-lib-1.12/Hledger/Utils/Text.hs0000644000000000000000000004066213372610345015747 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, -- quoteIfNeeded, -- singleQuoteIfNeeded, -- -- quotechars, -- -- whitespacechars, escapeDoubleQuotes, -- escapeSingleQuotes, -- escapeQuotes, -- words', -- unwords', stripquotes, -- isSingleQuoted, -- isDoubleQuoted, -- -- * single-line layout textstrip, textlstrip, textrstrip, -- chomp, -- 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, -- -- * tests tests_Text ) where -- import Data.Char 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 -- | Remove leading and trailing whitespace. textstrip :: Text -> Text textstrip = textlstrip . textrstrip -- | Remove leading whitespace. textlstrip :: Text -> Text textlstrip = T.dropWhile (`elem` (" \t" :: String)) :: Text -> Text -- XXX isSpace ? -- | Remove trailing whitespace. textrstrip = T.reverse . textlstrip . T.reverse textrstrip :: Text -> Text -- -- | Remove trailing newlines/carriage returns. -- chomp :: String -> String -- chomp = reverse . dropWhile (`elem` "\r\n") . reverse -- 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 = quoteIfNeeded 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. quoteIfNeeded :: T.Text -> T.Text quoteIfNeeded 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 tests_Text = tests "Text" [ tests "quoteIfSpaced" [ quoteIfSpaced "a'a" `is` "a'a" ,quoteIfSpaced "a\"a" `is` "a\"a" ,quoteIfSpaced "a a" `is` "\"a a\"" ,quoteIfSpaced "mimi's cafe" `is` "\"mimi's cafe\"" ,quoteIfSpaced "\"alex\" cafe" `is` "\"\\\"alex\\\" cafe\"" ,quoteIfSpaced "le'shan's cafe" `is` "\"le'shan's cafe\"" ,quoteIfSpaced "\"be'any's\" cafe" `is` "\"\\\"be'any's\\\" cafe\"" ] ] hledger-lib-1.12/Hledger/Utils/Tree.hs0000644000000000000000000000525613302271455015720 0ustar0000000000000000module Hledger.Utils.Tree where -- import Data.Char import Data.List (foldl') import qualified Data.Map as M import Data.Tree -- import Text.Megaparsec -- import Text.Printf import Hledger.Utils.Regex -- import Hledger.Utils.UTF8IOCompat (error') -- standard tree helpers root = rootLabel subs = subForest branches = subForest -- | List just the leaf nodes of a tree leaves :: Tree a -> [a] leaves (Node v []) = [v] leaves (Node _ branches) = concatMap leaves branches -- | get the sub-tree rooted at the first (left-most, depth-first) occurrence -- of the specified node value subtreeat :: Eq a => a -> Tree a -> Maybe (Tree a) subtreeat v t | root t == v = Just t | otherwise = subtreeinforest v $ subs t -- | get the sub-tree for the specified node value in the first tree in -- forest in which it occurs. subtreeinforest :: Eq a => a -> [Tree a] -> Maybe (Tree a) subtreeinforest _ [] = Nothing subtreeinforest v (t:ts) = case (subtreeat v t) of Just t' -> Just t' Nothing -> subtreeinforest v ts -- | remove all nodes past a certain depth treeprune :: Int -> Tree a -> Tree a treeprune 0 t = Node (root t) [] treeprune d t = Node (root t) (map (treeprune $ d-1) $ branches t) -- | apply f to all tree nodes treemap :: (a -> b) -> Tree a -> Tree b treemap f t = Node (f $ root t) (map (treemap f) $ branches t) -- | remove all subtrees whose nodes do not fulfill predicate treefilter :: (a -> Bool) -> Tree a -> Tree a treefilter f t = Node (root t) (map (treefilter f) $ filter (treeany f) $ branches t) -- | is predicate true in any node of tree ? treeany :: (a -> Bool) -> Tree a -> Bool treeany f t = f (root t) || any (treeany f) (branches t) -- treedrop -- remove the leaves which do fulfill predicate. -- treedropall -- do this repeatedly. -- | show a compact ascii representation of a tree showtree :: Show a => Tree a -> String showtree = unlines . filter (regexMatches "[^ \\|]") . lines . drawTree . treemap show -- | show a compact ascii representation of a forest showforest :: Show a => Forest a -> String showforest = concatMap showtree -- | 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 = 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.12/Hledger/Utils/UTF8IOCompat.hs0000644000000000000000000000716213302271455017141 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. -} -- TODO obsolete ? module Hledger.Utils.UTF8IOCompat ( readFile, writeFile, appendFile, getContents, hGetContents, putStr, putStrLn, hPutStr, hPutStrLn, -- SystemString, fromSystemString, toSystemString, 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 string received from or being passed to the operating system, such -- as a file path, command-line argument, or environment variable name or -- value. With GHC versions before 7.2 on some platforms (posix) these are -- typically encoded. When converting, we assume the encoding is UTF-8 (cf -- ). type SystemString = String -- | Convert a system string to an ordinary string, decoding from UTF-8 if -- it appears to be UTF8-encoded and GHC version is less than 7.2. fromSystemString :: SystemString -> String fromSystemString = id -- | Convert a unicode string to a system string, encoding with UTF-8 if -- we are on a posix platform with GHC < 7.2. toSystemString :: String -> SystemString toSystemString = id -- | A SystemString-aware version of error. error' :: String -> a error' = #if __GLASGOW_HASKELL__ < 800 -- (easier than if base < 4.9) error . toSystemString #else errorWithoutStackTrace . toSystemString #endif -- | A SystemString-aware version of userError. userError' :: String -> IOError userError' = userError . toSystemString -- | A SystemString-aware version of error that adds a usage hint. usageError :: String -> a usageError = error' . (++ " (use -h to see usage)") hledger-lib-1.12/Text/Tabular/AsciiWide.hs0000644000000000000000000000762713363322116016530 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 SingleLine -- +--------------------------------------+ , renderColumns pretty sizes ch2 , bar DoubleLine -- +======================================+ ] ++ (renderRs $ fmap renderR $ zipHeader [] cells $ fmap fr rh) ++ [ bar SingleLine ] -- +--------------------------------------+ where bar = concat . renderHLine pretty sizes ch2 -- 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 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 " || " horizontalBar :: Bool -> Char horizontalBar pretty = if pretty then '─' else '-' doubleHorizontalBar :: Bool -> Char doubleHorizontalBar 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 :: Bool -- ^ pretty -> [Int] -- ^ width specifications -> Header String -> Properties -> [String] renderHLine _ _ _ NoLine = [] renderHLine pretty w h SingleLine = [renderHLine' pretty SingleLine w (horizontalBar pretty) h] renderHLine pretty w h DoubleLine = [renderHLine' pretty DoubleLine w (doubleHorizontalBar pretty) h] doubleCross :: Bool -> String doubleCross pretty = if pretty then "╬" else "++" doubleVerticalCross :: Bool -> String doubleVerticalCross pretty = if pretty then "╫" else "++" cross :: Bool -> Char cross pretty = if pretty then '┼' else '+' renderHLine' :: Bool -> Properties -> [Int] -> Char -> Header String -> String renderHLine' pretty prop is sep h = [ cross pretty, sep ] ++ coreLine ++ [sep, cross pretty] where coreLine = concatMap helper $ flattenHeader $ zipHeader 0 is h helper = either vsep dashes dashes (i,_) = replicate i sep vsep NoLine = replicate 2 sep -- match the double space sep in renderColumns vsep SingleLine = sep : cross pretty : [sep] vsep DoubleLine = sep : cross' ++ [sep] cross' = case prop of DoubleLine -> doubleCross pretty _ -> doubleVerticalCross pretty -- padLeft :: Int -> String -> String -- padLeft l s = padding ++ s -- where padding = replicate (l - length s) ' ' hledger-lib-1.12/Text/Megaparsec/Custom.hs0000644000000000000000000003551113401044253016603 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# 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 -> State s offsetInitialState initialOffset s = State { stateInput = s , stateOffset = initialOffset , statePosState = PosState { pstateInput = s , pstateOffset = initialOffset , pstateSourcePos = initialPos "" , pstateTabWidth = defaultTabWidth , pstateLinePrefix = "" } } --- * 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.12/test/easytests.hs0000644000000000000000000000015213372610345015342 0ustar0000000000000000{- Run hledger-lib's easytest tests using the easytest runner. -} import Hledger main = run tests_Hledger hledger-lib-1.12/test/doctests.hs0000644000000000000000000000354113372610345015153 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]'] -} {-# LANGUAGE PackageImports #-} import Control.Monad import Data.Char import Data.List import System.Environment import "Glob" System.FilePath.Glob import Test.DocTest 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.12/LICENSE0000644000000000000000000010451313302271455013014 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.12/Setup.hs0000644000000000000000000000005613302271455013440 0ustar0000000000000000import Distribution.Simple main = defaultMain hledger-lib-1.12/hledger-lib.cabal0000644000000000000000000002207513401102140015133 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.31.0. -- -- see: https://github.com/sol/hpack -- -- hash: 8e0ce73c7c86c909a78d4d06e8566f8b66bc1df89f508da0b05df073c4ecd7c9 name: hledger-lib version: 1.12 synopsis: Core data types, parsers and functionality for the hledger accounting tools description: This is a reusable library containing hledger's core functionality. . hledger is a cross-platform program for tracking money, time, or any other commodity, using double-entry accounting and a simple, editable file format. It is inspired by and largely compatible with ledger(1). hledger provides command-line, curses and web interfaces, and aims to be a reliable, practical tool for daily use. 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==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3 build-type: Simple extra-source-files: CHANGES README 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.Ledger Hledger.Data.MarketPrice 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.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.BalanceHistoryReport Hledger.Reports.BalanceReport Hledger.Reports.BudgetReport Hledger.Reports.EntriesReport Hledger.Reports.MultiBalanceReports Hledger.Reports.PostingsReport Hledger.Reports.TransactionsReports 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 , Glob >=0.9 , ansi-terminal >=0.6.2.3 , array , base >=4.8 && <4.13 , base-compat-batteries >=0.10.1 && <0.11 , blaze-markup >=0.5.1 , bytestring , call-stack , cassava , cassava-megaparsec , cmdargs >=0.10 , containers , data-default >=0.5 , deepseq , directory , easytest , extra , filepath , hashtables >=1.2.3.1 , megaparsec >=7.0.0 && <8 , mtl , mtl-compat , 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 , text >=1.2 , time >=1.5 , transformers >=0.2 , uglymemo , utf8-string >=0.3.5 if (!impl(ghc >= 8.0)) build-depends: semigroups ==0.18.* default-language: Haskell2010 test-suite doctests type: exitcode-stdio-1.0 main-is: doctests.hs other-modules: Hledger Hledger.Data Hledger.Data.Account Hledger.Data.AccountName Hledger.Data.Amount Hledger.Data.Commodity Hledger.Data.Dates Hledger.Data.Journal Hledger.Data.Ledger Hledger.Data.MarketPrice Hledger.Data.Period Hledger.Data.PeriodicTransaction Hledger.Data.Posting Hledger.Data.RawOptions Hledger.Data.StringFormat Hledger.Data.Timeclock Hledger.Data.Transaction Hledger.Data.TransactionModifier Hledger.Data.Types Hledger.Query Hledger.Read Hledger.Read.Common Hledger.Read.CsvReader Hledger.Read.JournalReader Hledger.Read.TimeclockReader Hledger.Read.TimedotReader Hledger.Reports Hledger.Reports.BalanceHistoryReport Hledger.Reports.BalanceReport Hledger.Reports.BudgetReport Hledger.Reports.EntriesReport Hledger.Reports.MultiBalanceReports Hledger.Reports.PostingsReport Hledger.Reports.ReportOptions Hledger.Reports.ReportTypes Hledger.Reports.TransactionsReports 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.Megaparsec.Custom Text.Tabular.AsciiWide Paths_hledger_lib 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 , Glob >=0.7 , ansi-terminal >=0.6.2.3 , array , base >=4.8 && <4.13 , base-compat-batteries >=0.10.1 && <0.11 , blaze-markup >=0.5.1 , bytestring , call-stack , cassava , cassava-megaparsec , cmdargs >=0.10 , containers , data-default >=0.5 , deepseq , directory , doctest >=0.16 , easytest , extra , filepath , hashtables >=1.2.3.1 , megaparsec >=7.0.0 && <8 , mtl , mtl-compat , 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 , text >=1.2 , time >=1.5 , transformers >=0.2 , uglymemo , utf8-string >=0.3.5 if (!impl(ghc >= 8.0)) build-depends: semigroups ==0.18.* default-language: Haskell2010 test-suite easytests type: exitcode-stdio-1.0 main-is: easytests.hs other-modules: Hledger Hledger.Data Hledger.Data.Account Hledger.Data.AccountName Hledger.Data.Amount Hledger.Data.Commodity Hledger.Data.Dates Hledger.Data.Journal Hledger.Data.Ledger Hledger.Data.MarketPrice Hledger.Data.Period Hledger.Data.PeriodicTransaction Hledger.Data.Posting Hledger.Data.RawOptions Hledger.Data.StringFormat Hledger.Data.Timeclock Hledger.Data.Transaction Hledger.Data.TransactionModifier Hledger.Data.Types Hledger.Query Hledger.Read Hledger.Read.Common Hledger.Read.CsvReader Hledger.Read.JournalReader Hledger.Read.TimeclockReader Hledger.Read.TimedotReader Hledger.Reports Hledger.Reports.BalanceHistoryReport Hledger.Reports.BalanceReport Hledger.Reports.BudgetReport Hledger.Reports.EntriesReport Hledger.Reports.MultiBalanceReports Hledger.Reports.PostingsReport Hledger.Reports.ReportOptions Hledger.Reports.ReportTypes Hledger.Reports.TransactionsReports 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.Megaparsec.Custom Text.Tabular.AsciiWide Paths_hledger_lib 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 , Glob >=0.9 , ansi-terminal >=0.6.2.3 , array , base >=4.8 && <4.13 , base-compat-batteries >=0.10.1 && <0.11 , blaze-markup >=0.5.1 , bytestring , call-stack , cassava , cassava-megaparsec , cmdargs >=0.10 , containers , data-default >=0.5 , deepseq , directory , easytest , extra , filepath , hashtables >=1.2.3.1 , hledger-lib , megaparsec >=7.0.0 && <8 , mtl , mtl-compat , 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 , text >=1.2 , time >=1.5 , transformers >=0.2 , uglymemo , utf8-string >=0.3.5 if (!impl(ghc >= 8.0)) build-depends: semigroups ==0.18.* default-language: Haskell2010 hledger-lib-1.12/CHANGES0000644000000000000000000005402513401071754013004 0ustar0000000000000000Developer-ish changes in the hledger-lib package. User-visible changes are noted in the hledger package changelog instead. # 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 implcit, 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.12/README0000644000000000000000000000025113302271455012661 0ustar0000000000000000A reusable library containing hledger's core functionality. This is used by most hledger* packages for common data parsing, command line option handling, reporting etc. hledger-lib-1.12/hledger_csv.50000644000000000000000000002214713401102735014356 0ustar0000000000000000 .TH "hledger_csv" "5" "December 2018" "hledger 1.12" "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 (comma\-separated value) files as if they were journal files, automatically converting each CSV record into a transaction. (To learn about \f[I]writing\f[] CSV, see CSV output.) .PP Converting CSV to transactions requires some special conversion rules. These do several things: .IP \[bu] 2 they describe the layout and format of the CSV data .IP \[bu] 2 they can customize the generated journal entries using a simple templating language .IP \[bu] 2 they can add refinements based on patterns in the CSV data, eg categorizing transactions with more detailed account names. .PP When reading a CSV file named \f[C]FILE.csv\f[], hledger looks for a conversion rules file named \f[C]FILE.csv.rules\f[] in the same directory. You can override this with the \f[C]\-\-rules\-file\f[] option. If the rules file does not exist, hledger will auto\-create one with some example rules, which you'll need to adjust. .PP At minimum, the rules file must identify the \f[C]date\f[] and \f[C]amount\f[] fields. It may also be necessary to specify the date format, and the number of header lines to skip. Eg: .IP .nf \f[C] fields\ date,\ _,\ _,\ amount date\-format\ \ %d/%m/%Y skip\ 1 \f[] .fi .PP A more complete example: .IP .nf \f[C] #\ hledger\ CSV\ rules\ for\ amazon.com\ order\ history #\ sample: #\ "Date","Type","To/From","Name","Status","Amount","Fees","Transaction\ ID" #\ "Jul\ 29,\ 2012","Payment","To","Adapteva,\ Inc.","Completed","$25.00","$0.00","17LA58JSK6PRD4HDGLNJQPI1PB9N8DKPVHL" #\ skip\ one\ header\ line skip\ 1 #\ name\ the\ csv\ fields\ (and\ assign\ the\ transaction\[aq]s\ date,\ amount\ and\ code) fields\ date,\ _,\ toorfrom,\ name,\ amzstatus,\ amount,\ fees,\ code #\ how\ to\ parse\ the\ date date\-format\ %b\ %\-d,\ %Y #\ combine\ two\ fields\ to\ make\ the\ description description\ %toorfrom\ %name #\ save\ these\ fields\ as\ tags comment\ \ \ \ \ status:%amzstatus,\ fees:%fees #\ set\ the\ base\ account\ for\ all\ transactions account1\ \ \ \ assets:amazon #\ flip\ the\ sign\ on\ the\ amount amount\ \ \ \ \ \ \-%amount \f[] .fi .PP For more examples, see Convert CSV files. .SH CSV RULES .PP The following seven kinds of rule can appear in the rules file, in any order. Blank lines and lines beginning with \f[C]#\f[] or \f[C];\f[] are ignored. .SS skip .PP \f[C]skip\f[]\f[I]\f[CI]N\f[I]\f[] .PP Skip this number of CSV records at the beginning. You'll need this whenever your CSV data contains header lines. Eg: .IP .nf \f[C] #\ ignore\ the\ first\ CSV\ line skip\ 1 \f[] .fi .SS date\-format .PP \f[C]date\-format\f[]\f[I]\f[CI]DATEFMT\f[I]\f[] .PP When your CSV date fields are not formatted like \f[C]YYYY/MM/DD\f[] (or \f[C]YYYY\-MM\-DD\f[] or \f[C]YYYY.MM.DD\f[]), you'll need to specify the format. DATEFMT is a strptime\-like date parsing pattern, which must parse the date field values completely. Examples: .IP .nf \f[C] #\ for\ dates\ like\ "6/11/2013": date\-format\ %\-d/%\-m/%Y \f[] .fi .IP .nf \f[C] #\ for\ dates\ like\ "11/06/2013": date\-format\ %m/%d/%Y \f[] .fi .IP .nf \f[C] #\ for\ dates\ like\ "2013\-Nov\-06": date\-format\ %Y\-%h\-%d \f[] .fi .IP .nf \f[C] #\ for\ dates\ like\ "11/6/2013\ 11:32\ PM": date\-format\ %\-m/%\-d/%Y\ %l:%M\ %p \f[] .fi .SS field list .PP \f[C]fields\f[]\f[I]\f[CI]FIELDNAME1\f[I]\f[], \f[I]\f[CI]FIELDNAME2\f[I]\f[]\&... .PP This (a) names the CSV fields, in order (names may not contain whitespace; uninteresting names may be left blank), and (b) assigns them to journal entry fields if you use any of these standard field names: \f[C]date\f[], \f[C]date2\f[], \f[C]status\f[], \f[C]code\f[], \f[C]description\f[], \f[C]comment\f[], \f[C]account1\f[], \f[C]account2\f[], \f[C]amount\f[], \f[C]amount\-in\f[], \f[C]amount\-out\f[], \f[C]currency\f[], \f[C]balance\f[]. Eg: .IP .nf \f[C] #\ use\ the\ 1st,\ 2nd\ and\ 4th\ CSV\ fields\ as\ the\ entry\[aq]s\ date,\ description\ and\ amount, #\ and\ give\ the\ 7th\ and\ 8th\ fields\ meaningful\ names\ for\ later\ reference: # #\ CSV\ field: #\ \ \ \ \ \ 1\ \ \ \ \ 2\ \ \ \ \ \ \ \ \ \ \ \ 3\ 4\ \ \ \ \ \ \ 5\ 6\ 7\ \ \ \ \ \ \ \ \ \ 8 #\ entry\ field: fields\ date,\ description,\ ,\ amount,\ ,\ ,\ somefield,\ anotherfield \f[] .fi .SS field assignment .PP \f[I]\f[CI]ENTRYFIELDNAME\f[I]\f[] \f[I]\f[CI]FIELDVALUE\f[I]\f[] .PP This sets a journal entry field (one of the standard names above) to the given text value, which can include CSV field values interpolated by name (\f[C]%CSVFIELDNAME\f[]) or 1\-based position (\f[C]%N\f[]). Eg: .IP .nf \f[C] #\ set\ the\ amount\ to\ the\ 4th\ CSV\ field\ with\ "USD\ "\ prepended amount\ USD\ %4 \f[] .fi .IP .nf \f[C] #\ combine\ three\ fields\ to\ make\ a\ comment\ (containing\ two\ tags) comment\ note:\ %somefield\ \-\ %anotherfield,\ date:\ %1 \f[] .fi .PP Field assignments can be used instead of or in addition to a field list. .SS conditional block .PP \f[C]if\f[] \f[I]\f[CI]PATTERN\f[I]\f[] .PD 0 .P .PD \ \ \ \ \f[I]\f[CI]FIELDASSIGNMENTS\f[I]\f[]\&... .PP \f[C]if\f[] .PD 0 .P .PD \f[I]\f[CI]PATTERN\f[I]\f[] .PD 0 .P .PD \f[I]\f[CI]PATTERN\f[I]\f[]\&... .PD 0 .P .PD \ \ \ \ \f[I]\f[CI]FIELDASSIGNMENTS\f[I]\f[]\&... .PP This applies one or more field assignments, only to those CSV records matched by one of the PATTERNs. The patterns are case\-insensitive regular expressions which match anywhere within the whole CSV record (it's not yet possible to match within a specific field). When there are multiple patterns they can be written on separate lines, unindented. The field assignments are on separate lines indented by at least one space. Examples: .IP .nf \f[C] #\ if\ the\ CSV\ record\ contains\ "groceries",\ set\ account2\ to\ "expenses:groceries" if\ groceries \ account2\ expenses:groceries \f[] .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[] .fi .SS include .PP \f[C]include\f[]\f[I]\f[CI]RULESFILE\f[I]\f[] .PP Include another rules file at this point. \f[C]RULESFILE\f[] is either an absolute file path or a path relative to the current file's directory. Eg: .IP .nf \f[C] #\ rules\ reused\ with\ several\ CSV\ files include\ common.rules \f[] .fi .SS newest\-first .PP \f[C]newest\-first\f[] .PP Consider adding this rule if all of the following are true: you might be processing just one day of data, your CSV records are in reverse chronological order (newest first), and you care about preserving the order of same\-day transactions. It usually isn't needed, because hledger autodetects the CSV order, but when all CSV records have the same date it will assume they are oldest first. .SH CSV TIPS .SS CSV ordering .PP The generated journal entries will be sorted by date. The order of same\-day entries will be preserved (except in the special case where you might need \f[C]newest\-first\f[], see above). .SS CSV accounts .PP Each journal entry will have two postings, to \f[C]account1\f[] and \f[C]account2\f[] respectively. It's not yet possible to generate entries with more than two postings. It's conventional and recommended to use \f[C]account1\f[] for the account whose CSV we are reading. .SS CSV amounts .PP The \f[C]amount\f[] field sets the amount of the \f[C]account1\f[] posting. .PP If the CSV has debit/credit amounts in separate fields, assign to the \f[C]amount\-in\f[] and \f[C]amount\-out\f[] pseudo fields instead. (Whichever one has a value will be used, with appropriate sign. If both contain a value, it may not work so well.) .PP If an amount value is parenthesised, it will be de\-parenthesised and sign\-flipped. .PP If an amount value begins with a double minus sign, those will cancel out and be removed. .PP If the CSV has the currency symbol in a separate field, assign that to the \f[C]currency\f[] pseudo field to have it prepended to the amount. Or, you can use a field assignment to \f[C]amount\f[] that interpolates both CSV fields (giving more control, eg to put the currency symbol on the right). .SS CSV balance assertions .PP If the CSV includes a running balance, you can assign that to the \f[C]balance\f[] pseudo field; whenever the running balance value is non\-empty, it will be asserted as the balance after the \f[C]account1\f[] posting. .SS Reading multiple CSV files .PP You can read multiple CSV files at once using multiple \f[C]\-f\f[] arguments on the command line, and hledger will look for a correspondingly\-named rules file for each. Note if you use the \f[C]\-\-rules\-file\f[] option, this one rules file will be used for all the CSV files being read. .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-2016 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.12/hledger_csv.txt0000644000000000000000000002245713401102736015036 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 (comma-separated value) files as if they were journal files, automatically converting each CSV record into a transac- tion. (To learn about writing CSV, see CSV output.) Converting CSV to transactions requires some special conversion rules. These do several things: o they describe the layout and format of the CSV data o they can customize the generated journal entries using a simple tem- plating language o they can add refinements based on patterns in the CSV data, eg cate- gorizing transactions with more detailed account names. When reading a CSV file named FILE.csv, hledger looks for a conversion rules file named FILE.csv.rules in the same directory. You can over- ride this with the --rules-file option. If the rules file does not exist, hledger will auto-create one with some example rules, which you'll need to adjust. At minimum, the rules file must identify the date and amount fields. It may also be necessary to specify the date format, and the number of header lines to skip. Eg: fields date, _, _, amount date-format %d/%m/%Y skip 1 A more complete example: # hledger CSV rules for amazon.com order history # sample: # "Date","Type","To/From","Name","Status","Amount","Fees","Transaction ID" # "Jul 29, 2012","Payment","To","Adapteva, Inc.","Completed","$25.00","$0.00","17LA58JSK6PRD4HDGLNJQPI1PB9N8DKPVHL" # skip one header line skip 1 # name the csv fields (and assign the transaction's date, amount and code) fields date, _, toorfrom, name, amzstatus, amount, fees, code # how to parse the date date-format %b %-d, %Y # combine two fields to make the description description %toorfrom %name # save these fields as tags comment status:%amzstatus, fees:%fees # set the base account for all transactions account1 assets:amazon # flip the sign on the amount amount -%amount For more examples, see Convert CSV files. CSV RULES The following seven kinds of rule can appear in the rules file, in any order. Blank lines and lines beginning with # or ; are ignored. skip skipN Skip this number of CSV records at the beginning. You'll need this whenever your CSV data contains header lines. Eg: # ignore the first CSV line skip 1 date-format date-formatDATEFMT When your CSV date fields are not formatted like YYYY/MM/DD (or YYYY-MM-DD or YYYY.MM.DD), you'll need to specify the format. DATEFMT is a strptime-like date parsing pattern, which must parse the date field values completely. Examples: # for dates like "6/11/2013": date-format %-d/%-m/%Y # for dates like "11/06/2013": date-format %m/%d/%Y # for dates like "2013-Nov-06": date-format %Y-%h-%d # for dates like "11/6/2013 11:32 PM": date-format %-m/%-d/%Y %l:%M %p field list fieldsFIELDNAME1, FIELDNAME2... This (a) names the CSV fields, in order (names may not contain white- space; uninteresting names may be left blank), and (b) assigns them to journal entry fields if you use any of these standard field names: date, date2, status, code, description, comment, account1, account2, amount, amount-in, amount-out, currency, balance. Eg: # use the 1st, 2nd and 4th CSV fields as the entry's date, description and amount, # and give the 7th and 8th fields meaningful names for later reference: # # CSV field: # 1 2 3 4 5 6 7 8 # entry field: fields date, description, , amount, , , somefield, anotherfield field assignment ENTRYFIELDNAME FIELDVALUE This sets a journal entry field (one of the standard names above) to the given text value, which can include CSV field values interpolated by name (%CSVFIELDNAME) or 1-based position (%N). Eg: # set the amount to the 4th CSV field with "USD " prepended amount USD %4 # combine three fields to make a comment (containing two tags) comment note: %somefield - %anotherfield, date: %1 Field assignments can be used instead of or in addition to a field list. conditional block if PATTERN FIELDASSIGNMENTS... if PATTERN PATTERN... FIELDASSIGNMENTS... This applies one or more field assignments, only to those CSV records matched by one of the PATTERNs. The patterns are case-insensitive reg- ular expressions which match anywhere within the whole CSV record (it's not yet possible to match within a specific field). When there are multiple patterns they can be written on separate lines, unindented. The field assignments are on separate lines indented by at least one space. 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 include includeRULESFILE Include another rules file at this point. RULESFILE is either an abso- lute file path or a path relative to the current file's directory. Eg: # rules reused with several CSV files include common.rules newest-first newest-first Consider adding this rule if all of the following are true: you might be processing just one day of data, your CSV records are in reverse chronological order (newest first), and you care about preserving the order of same-day transactions. It usually isn't needed, because hledger autodetects the CSV order, but when all CSV records have the same date it will assume they are oldest first. CSV TIPS CSV ordering The generated journal entries will be sorted by date. The order of same-day entries will be preserved (except in the special case where you might need newest-first, see above). CSV accounts Each journal entry will have two postings, to account1 and account2 respectively. It's not yet possible to generate entries with more than two postings. It's conventional and recommended to use account1 for the account whose CSV we are reading. CSV amounts The amount field sets the amount of the account1 posting. If the CSV has debit/credit amounts in separate fields, assign to the amount-in and amount-out pseudo fields instead. (Whichever one has a value will be used, with appropriate sign. If both contain a value, it may not work so well.) 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 will cancel out and be removed. If the CSV has the currency symbol in a separate field, assign that to the currency pseudo field to have it prepended to the amount. Or, you can use a field assignment to amount that interpolates both CSV fields (giving more control, eg to put the currency symbol on the right). CSV balance assertions If the CSV includes a running balance, you can assign that to the bal- ance pseudo field; whenever the running balance value is non-empty, it will be asserted as the balance after the account1 posting. Reading multiple CSV files You can read multiple CSV files at once using multiple -f arguments on the command line, and hledger will look for a correspondingly-named rules file for each. Note if you use the --rules-file option, this one rules file will be used for all the CSV files being read. 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-2016 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.12 December 2018 hledger_csv(5) hledger-lib-1.12/hledger_csv.info0000644000000000000000000002402013401102730015130 0ustar0000000000000000This is hledger_csv.info, produced by makeinfo version 6.5 from stdin.  File: hledger_csv.info, Node: Top, Next: CSV RULES, Up: (dir) hledger_csv(5) hledger 1.12 *************************** hledger can read CSV (comma-separated value) files as if they were journal files, automatically converting each CSV record into a transaction. (To learn about _writing_ CSV, see CSV output.) Converting CSV to transactions requires some special conversion rules. These do several things: * they describe the layout and format of the CSV data * they can customize the generated journal entries using a simple templating language * they can add refinements based on patterns in the CSV data, eg categorizing transactions with more detailed account names. When reading a CSV file named 'FILE.csv', hledger looks for a conversion rules file named 'FILE.csv.rules' in the same directory. You can override this with the '--rules-file' option. If the rules file does not exist, hledger will auto-create one with some example rules, which you'll need to adjust. At minimum, the rules file must identify the 'date' and 'amount' fields. It may also be necessary to specify the date format, and the number of header lines to skip. Eg: fields date, _, _, amount date-format %d/%m/%Y skip 1 A more complete example: # hledger CSV rules for amazon.com order history # sample: # "Date","Type","To/From","Name","Status","Amount","Fees","Transaction ID" # "Jul 29, 2012","Payment","To","Adapteva, Inc.","Completed","$25.00","$0.00","17LA58JSK6PRD4HDGLNJQPI1PB9N8DKPVHL" # skip one header line skip 1 # name the csv fields (and assign the transaction's date, amount and code) fields date, _, toorfrom, name, amzstatus, amount, fees, code # how to parse the date date-format %b %-d, %Y # combine two fields to make the description description %toorfrom %name # save these fields as tags comment status:%amzstatus, fees:%fees # set the base account for all transactions account1 assets:amazon # flip the sign on the amount amount -%amount For more examples, see Convert CSV files. * Menu: * CSV RULES:: * CSV TIPS::  File: hledger_csv.info, Node: CSV RULES, Next: CSV TIPS, Prev: Top, Up: Top 1 CSV RULES *********** The following seven kinds of rule can appear in the rules file, in any order. Blank lines and lines beginning with '#' or ';' are ignored. * Menu: * skip:: * date-format:: * field list:: * field assignment:: * conditional block:: * include:: * newest-first::  File: hledger_csv.info, Node: skip, Next: date-format, Up: CSV RULES 1.1 skip ======== 'skip'_'N'_ Skip this number of CSV records at the beginning. You'll need this whenever your CSV data contains header lines. Eg: # ignore the first CSV line skip 1  File: hledger_csv.info, Node: date-format, Next: field list, Prev: skip, Up: CSV RULES 1.2 date-format =============== 'date-format'_'DATEFMT'_ When your CSV date fields are not formatted like 'YYYY/MM/DD' (or 'YYYY-MM-DD' or 'YYYY.MM.DD'), you'll need to specify the format. DATEFMT is a strptime-like date parsing pattern, which must parse the date field values completely. Examples: # for dates like "6/11/2013": date-format %-d/%-m/%Y # for dates like "11/06/2013": date-format %m/%d/%Y # for dates like "2013-Nov-06": date-format %Y-%h-%d # for dates like "11/6/2013 11:32 PM": date-format %-m/%-d/%Y %l:%M %p  File: hledger_csv.info, Node: field list, Next: field assignment, Prev: date-format, Up: CSV RULES 1.3 field list ============== 'fields'_'FIELDNAME1'_, _'FIELDNAME2'_... This (a) names the CSV fields, in order (names may not contain whitespace; uninteresting names may be left blank), and (b) assigns them to journal entry fields if you use any of these standard field names: 'date', 'date2', 'status', 'code', 'description', 'comment', 'account1', 'account2', 'amount', 'amount-in', 'amount-out', 'currency', 'balance'. Eg: # use the 1st, 2nd and 4th CSV fields as the entry's date, description and amount, # and give the 7th and 8th fields meaningful names for later reference: # # CSV field: # 1 2 3 4 5 6 7 8 # entry field: fields date, description, , amount, , , somefield, anotherfield  File: hledger_csv.info, Node: field assignment, Next: conditional block, Prev: field list, Up: CSV RULES 1.4 field assignment ==================== _'ENTRYFIELDNAME'_ _'FIELDVALUE'_ This sets a journal entry field (one of the standard names above) to the given text value, which can include CSV field values interpolated by name ('%CSVFIELDNAME') or 1-based position ('%N'). Eg: # set the amount to the 4th CSV field with "USD " prepended amount USD %4 # combine three fields to make a comment (containing two tags) comment note: %somefield - %anotherfield, date: %1 Field assignments can be used instead of or in addition to a field list.  File: hledger_csv.info, Node: conditional block, Next: include, Prev: field assignment, Up: CSV RULES 1.5 conditional block ===================== 'if' _'PATTERN'_ _'FIELDASSIGNMENTS'_... 'if' _'PATTERN'_ _'PATTERN'_... _'FIELDASSIGNMENTS'_... This applies one or more field assignments, only to those CSV records matched by one of the PATTERNs. The patterns are case-insensitive regular expressions which match anywhere within the whole CSV record (it's not yet possible to match within a specific field). When there are multiple patterns they can be written on separate lines, unindented. The field assignments are on separate lines indented by at least one space. 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: include, Next: newest-first, Prev: conditional block, Up: CSV RULES 1.6 include =========== 'include'_'RULESFILE'_ Include another rules file at this point. 'RULESFILE' is either an absolute file path or a path relative to the current file's directory. Eg: # rules reused with several CSV files include common.rules  File: hledger_csv.info, Node: newest-first, Prev: include, Up: CSV RULES 1.7 newest-first ================ 'newest-first' Consider adding this rule if all of the following are true: you might be processing just one day of data, your CSV records are in reverse chronological order (newest first), and you care about preserving the order of same-day transactions. It usually isn't needed, because hledger autodetects the CSV order, but when all CSV records have the same date it will assume they are oldest first.  File: hledger_csv.info, Node: CSV TIPS, Prev: CSV RULES, Up: Top 2 CSV TIPS ********** * Menu: * CSV ordering:: * CSV accounts:: * CSV amounts:: * CSV balance assertions:: * Reading multiple CSV files::  File: hledger_csv.info, Node: CSV ordering, Next: CSV accounts, Up: CSV TIPS 2.1 CSV ordering ================ The generated journal entries will be sorted by date. The order of same-day entries will be preserved (except in the special case where you might need 'newest-first', see above).  File: hledger_csv.info, Node: CSV accounts, Next: CSV amounts, Prev: CSV ordering, Up: CSV TIPS 2.2 CSV accounts ================ Each journal entry will have two postings, to 'account1' and 'account2' respectively. It's not yet possible to generate entries with more than two postings. It's conventional and recommended to use 'account1' for the account whose CSV we are reading.  File: hledger_csv.info, Node: CSV amounts, Next: CSV balance assertions, Prev: CSV accounts, Up: CSV TIPS 2.3 CSV amounts =============== The 'amount' field sets the amount of the 'account1' posting. If the CSV has debit/credit amounts in separate fields, assign to the 'amount-in' and 'amount-out' pseudo fields instead. (Whichever one has a value will be used, with appropriate sign. If both contain a value, it may not work so well.) 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 will cancel out and be removed. If the CSV has the currency symbol in a separate field, assign that to the 'currency' pseudo field to have it prepended to the amount. Or, you can use a field assignment to 'amount' that interpolates both CSV fields (giving more control, eg to put the currency symbol on the right).  File: hledger_csv.info, Node: CSV balance assertions, Next: Reading multiple CSV files, Prev: CSV amounts, Up: CSV TIPS 2.4 CSV balance assertions ========================== If the CSV includes a running balance, you can assign that to the 'balance' pseudo field; whenever the running balance value is non-empty, it will be asserted as the balance after the 'account1' posting.  File: hledger_csv.info, Node: Reading multiple CSV files, Prev: CSV balance assertions, Up: CSV TIPS 2.5 Reading multiple CSV files ============================== You can read multiple CSV files at once using multiple '-f' arguments on the command line, and hledger will look for a correspondingly-named rules file for each. Note if you use the '--rules-file' option, this one rules file will be used for all the CSV files being read.  Tag Table: Node: Top72 Node: CSV RULES2163 Ref: #csv-rules2271 Node: skip2533 Ref: #skip2627 Node: date-format2799 Ref: #date-format2926 Node: field list3432 Ref: #field-list3569 Node: field assignment4274 Ref: #field-assignment4429 Node: conditional block4933 Ref: #conditional-block5087 Node: include5983 Ref: #include6113 Node: newest-first6344 Ref: #newest-first6458 Node: CSV TIPS6869 Ref: #csv-tips6963 Node: CSV ordering7081 Ref: #csv-ordering7199 Node: CSV accounts7380 Ref: #csv-accounts7518 Node: CSV amounts7772 Ref: #csv-amounts7918 Node: CSV balance assertions8693 Ref: #csv-balance-assertions8875 Node: Reading multiple CSV files9080 Ref: #reading-multiple-csv-files9250  End Tag Table hledger-lib-1.12/hledger_journal.50000644000000000000000000014406113401102735015235 0ustar0000000000000000.\"t .TH "hledger_journal" "5" "December 2018" "hledger 1.12" "hledger User Manuals" .SH NAME .PP Journal \- hledger's default file format, representing a General Journal .SH DESCRIPTION .PP 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 \f[C]\&.journal\f[], 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. .PP 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. .PP You can use hledger without learning any more about this file; just use the add or web commands to create and update it. Many users, though, also edit the journal file directly with a text editor, perhaps assisted by the helper modes for emacs or vim. .PP Here's an example: .IP .nf \f[C] ;\ A\ sample\ journal\ file.\ This\ is\ a\ comment. 2008/01/01\ income\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ;\ <\-\ transaction\[aq]s\ first\ line\ starts\ in\ column\ 0,\ contains\ date\ and\ description \ \ \ \ assets:bank:checking\ \ $1\ \ \ \ ;\ <\-\ posting\ lines\ start\ with\ whitespace,\ each\ contains\ an\ account\ name \ \ \ \ income:salary\ \ \ \ \ \ \ \ $\-1\ \ \ \ ;\ \ \ \ followed\ by\ at\ least\ two\ spaces\ and\ an\ amount 2008/06/01\ gift \ \ \ \ assets:bank:checking\ \ $1\ \ \ \ ;\ <\-\ at\ least\ two\ postings\ in\ a\ transaction \ \ \ \ income:gifts\ \ \ \ \ \ \ \ \ $\-1\ \ \ \ ;\ <\-\ their\ amounts\ must\ balance\ to\ 0 2008/06/02\ save \ \ \ \ assets:bank:saving\ \ \ \ $1 \ \ \ \ assets:bank:checking\ \ \ \ \ \ \ \ ;\ <\-\ one\ amount\ may\ be\ omitted;\ here\ $\-1\ is\ inferred 2008/06/03\ eat\ &\ shop\ \ \ \ \ \ \ \ \ \ \ ;\ <\-\ description\ can\ be\ anything \ \ \ \ expenses:food\ \ \ \ \ \ \ \ \ $1 \ \ \ \ expenses:supplies\ \ \ \ \ $1\ \ \ \ ;\ <\-\ this\ transaction\ debits\ two\ expense\ accounts \ \ \ \ assets:cash\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ;\ <\-\ $\-2\ inferred 2008/10/01\ take\ a\ loan \ \ \ \ assets:bank:checking\ \ $1 \ \ \ \ liabilities:debts\ \ \ \ $\-1 2008/12/31\ *\ pay\ off\ \ \ \ \ \ \ \ \ \ \ \ ;\ <\-\ an\ optional\ *\ or\ !\ after\ the\ date\ means\ "cleared"\ (or\ anything\ you\ want) \ \ \ \ liabilities:debts\ \ \ \ \ $1 \ \ \ \ assets:bank:checking \f[] .fi .SH FILE FORMAT .SS Transactions .PP Transactions are movements of some quantity of commodities between named accounts. Each transaction is represented by a journal entry beginning with a simple date in column 0. This can be followed by any of the following, separated by spaces: .IP \[bu] 2 (optional) a status character (empty, \f[C]!\f[], or \f[C]*\f[]) .IP \[bu] 2 (optional) a transaction code (any short number or text, enclosed in parentheses) .IP \[bu] 2 (optional) a transaction description (any remaining text until end of line or a semicolon) .IP \[bu] 2 (optional) a transaction comment (any remaining text following a semicolon until end of line) .PP Then comes zero or more (but usually at least 2) indented lines representing\&... .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[], or \f[C]*\f[]), followed by a space .IP \[bu] 2 (required) an account name (any text, optionally containing \f[B]single spaces\f[], until end of line or a double space) .IP \[bu] 2 (optional) \f[B]two or more spaces\f[] 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 Dates .SS Simple dates .PP Within a journal file, transaction dates use Y/M/D (or Y\-M\-D or Y.M.D) Leading zeros are 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[], \f[C]1/31\f[], \f[C]2010\-01\-31\f[], \f[C]2010.1.31\f[]. .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, eg for more accurate balances, you can specify individual posting dates, which I recommend. Or, you can use the secondary dates (aka auxiliary/effective dates) feature, supported for compatibility with Ledger. .PP A secondary date can be written after the primary date, separated by an equals sign. The primary date, on the left, is used by default; the secondary date, on the right, is used when the \f[C]\-\-date2\f[] flag is specified (\f[C]\-\-aux\-date\f[] or \f[C]\-\-effective\f[] also work). .PP The meaning of secondary dates is up to you, but it's best to follow a consistent rule. Eg write the bank's clearing date as primary, and when needed, the date the transaction was initiated as secondary. .PP Here's an example. Note that a secondary date will use the year of the primary date if unspecified. .IP .nf \f[C] 2010/2/23=2/19\ movie\ ticket \ \ expenses:cinema\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ $10 \ \ assets:checking \f[] .fi .IP .nf \f[C] $\ hledger\ register\ checking 2010/02/23\ movie\ ticket\ \ \ \ \ \ \ \ \ assets:checking\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ $\-10\ \ \ \ \ \ \ \ \ $\-10 \f[] .fi .IP .nf \f[C] $\ hledger\ register\ checking\ \-\-date2 2010/02/19\ movie\ ticket\ \ \ \ \ \ \ \ \ assets:checking\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ $\-10\ \ \ \ \ \ \ \ \ $\-10 \f[] .fi .PP Secondary dates require some effort; you must use them consistently in your journal entries and remember whether to use or not use the \f[C]\-\-date2\f[] flag for your reports. They are included in hledger for Ledger compatibility, but posting dates are a more powerful and less confusing alternative. .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[]. 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[] .fi .IP .nf \f[C] $\ hledger\ \-f\ t.j\ register\ food 2015/05/30\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ expenses:food\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ $10\ \ \ \ \ \ \ \ \ \ \ $10 \f[] .fi .IP .nf \f[C] $\ hledger\ \-f\ t.j\ register\ checking 2015/06/01\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ assets:checking\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ $\-10\ \ \ \ \ \ \ \ \ \ $\-10 \f[] .fi .PP 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 \f[C]date2:DATE2\f[]. The \f[C]date:\f[] or \f[C]date2:\f[] tags must have a valid simple date value if they are present, eg a \f[C]date:\f[] tag with no value is not allowed. .PP Ledger's earlier, more compact bracketed date syntax is also supported: \f[C][DATE]\f[], \f[C][DATE=DATE2]\f[] or \f[C][=DATE2]\f[]. hledger will attempt to parse any square\-bracketed sequence of the \f[C]0123456789/\-.=\f[] 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[] T}@T{ pending T} T{ \f[C]*\f[] T}@T{ cleared T} .TE .PP When reporting, you can filter by status with the \f[C]\-U/\-\-unmarked\f[], \f[C]\-P/\-\-pending\f[], and \f[C]\-C/\-\-cleared\f[] flags; or the \f[C]status:\f[], \f[C]status:!\f[], and \f[C]status:*\f[] queries; or the U, P, C keys in hledger\-ui. .PP Note, in Ledger and in older versions of hledger, the \[lq]unmarked\[rq] state is called \[lq]uncleared\[rq]. As of hledger 1.3 we have renamed it to unmarked for clarity. .PP To replicate Ledger and old hledger'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 \[lq]uncleared\[rq], \[lq]pending\[rq], and \[lq]cleared\[rq] actually mean is up to you. Here's one suggestion: .PP .TS tab(@); lw(9.9n) lw(60.1n). 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[] to see the current balance at your bank, \f[C]\-U\f[] 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's description is the rest of the line following the date and status mark (or until a comment begins). Sometimes called the \[lq]narration\[rq] 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[] (pipe) character in a description to subdivide it into a payee/payer name on the left and additional notes on the right. This may be worthwhile if you need to do more precise querying and pivoting by payee. .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[], \f[C]liabilities\f[], \f[C]income\f[], \f[C]expenses\f[], and \f[C]equity\f[]. .PP Account names may contain single spaces, eg: \f[C]assets:accounts\ receivable\f[]. Because of this, they must always be followed by \f[B]two or more spaces\f[] (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[]. .PP Amounts consist of a number and (usually) a currency symbol or commodity name. Some examples: .PP \f[C]2.00001\f[] .PD 0 .P .PD \f[C]$1\f[] .PD 0 .P .PD \f[C]4000\ AAPL\f[] .PD 0 .P .PD \f[C]3\ "green\ apples"\f[] .PD 0 .P .PD \f[C]\-$1,000,000.00\f[] .PD 0 .P .PD \f[C]INR\ 9,99,99,999.00\f[] .PD 0 .P .PD \f[C]EUR\ \-2.000.000,00\f[] .PD 0 .P .PD \f[C]1\ 999\ 999.9455\f[] .PD 0 .P .PD \f[C]EUR\ 1E3\f[] .PD 0 .P .PD \f[C]1000E\-6s\f[] .PP As you can see, the amount format is somewhat flexible: .IP \[bu] 2 amounts are a number (the \[lq]quantity\[rq]) and optionally a currency symbol/commodity name (the \[lq]commodity\[rq]). .IP \[bu] 2 the commodity is a symbol, word, or phrase, on the left or right, with or without a separating space. If the commodity contains numbers, spaces or non\-word punctuation it must be enclosed in double quotes. .IP \[bu] 2 negative amounts with a commodity on the left can have the minus sign before or after it .IP \[bu] 2 digit groups (thousands, or any other grouping) can be separated by space or comma or period and should be used as separator between all groups .IP \[bu] 2 decimal part can be separated by comma or period and should be different from digit groups separator .IP \[bu] 2 scientific E\-notation is allowed. Be careful not to use a digit group separator character in scientific notation, as it's not supported and it might get mistaken for a decimal point. (Declaring the digit group separator character explicitly with a commodity directive will prevent this.) .PP You can use any of these variations when recording data. However, there is some ambiguous way of representing numbers like \f[C]$1.000\f[] and \f[C]$1,000\f[] both may mean either one thousand or one dollar. By default hledger will assume that this is sole delimiter is used only for decimals. On the other hand commodity format declared prior to that line will help to resolve that ambiguity differently: .IP .nf \f[C] commodity\ $1,000.00 2017/12/25\ New\ life\ of\ Scrooge \ \ \ \ expenses:gifts\ \ $1,000 \ \ \ \ assets \f[] .fi .PP Though journal may contain mixed styles to represent amount, when hledger displays amounts, it will choose a consistent format for each commodity. (Except for price amounts, which are always formatted as written). The display format is chosen as follows: .IP \[bu] 2 if there is a commodity directive specifying the format, that is used .IP \[bu] 2 otherwise the format is inferred from the first posting amount in that commodity in the journal, and the precision (number of decimal places) will be the maximum from all posting amounts in that commmodity .IP \[bu] 2 or if there are no such amounts in the journal, a default format is used (like \f[C]$1000.00\f[]). .PP Price amounts and amounts in \f[C]D\f[] directives usually don't affect amount format inference, but in some situations they can do so indirectly. (Eg when D's default commodity is applied to a commodity\-less amount, or when an amountless posting is balanced using a price's commodity, or when \-V is used.) If you find this causing problems, set the desired format with a commodity directive. .SS Virtual Postings .PP When you parenthesise the account name in a posting, we call that a \f[I]virtual posting\f[], which means: .IP \[bu] 2 it is ignored when checking that the transaction is balanced .IP \[bu] 2 it is excluded from reports when the \f[C]\-\-real/\-R\f[] flag is used, or the \f[C]real:1\f[] query. .PP You could use this, eg, to set an account's opening balance without needing to use the \f[C]equity:opening\ balances\f[] account: .IP .nf \f[C] 1/1\ special\ unbalanced\ posting\ to\ set\ initial\ balance \ \ (assets:checking)\ \ \ $1000 \f[] .fi .PP When the account name is bracketed, we call it a \f[I]balanced virtual posting\f[]. This is like an ordinary virtual posting except the balanced virtual postings in a transaction must balance to 0, like the real postings (but separately from them). Balanced virtual postings are also excluded by \f[C]\-\-real/\-R\f[] or \f[C]real:1\f[]. .IP .nf \f[C] 1/1\ buy\ food\ with\ cash,\ and\ update\ some\ budget\-tracking\ subaccounts\ elsewhere \ \ expenses:food\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ $10 \ \ assets:cash\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ $\-10 \ \ [assets:checking:available]\ \ \ \ \ $10 \ \ [assets:checking:budget:food]\ \ $\-10 \f[] .fi .PP Virtual postings have some legitimate uses, but those are few. You can usually find an equivalent journal entry using real postings, which is more correct and provides better error checking. .SS Balance Assertions .PP hledger supports Ledger\-style balance assertions in journal files. These look like \f[C]=EXPECTEDBALANCE\f[] following a posting's amount. Eg in this example 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[] .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]\-\-ignore\-assertions\f[] flag, which can be useful for troubleshooting or for reading Ledger files. .SS Assertions and ordering .PP 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.) .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's balance on the same day, you'll have to put the assertion in the right file. .SS Assertions and multiple \-f options .PP Balance assertions don'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's balance within the (possibly multi\-commodity) account balance. .PD 0 .P .PD This is how assertions work in Ledger also. We could call this a \[lq]partial\[rq] balance assertion. .PP To assert the balance of more than one commodity in an account, you can write multiple postings, each asserting one commodity's balance. .PP You can make a stronger kind of balance assertion, by writing a double equals sign (\f[C]==EXPECTEDBALANCE\f[]). This \[lq]complete\[rq] balance assertion asserts the absence of other commodities (or, that their balance is 0, which to hledger is equivalent.) .IP .nf \f[C] 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\ \[aq]a\[aq]\ also\ contains\ 1€ \ \ a\ \ \ \ 0\ ==\ \ $1 \f[] .fi .PP 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: .IP .nf \f[C] 2013/1/1 \ \ a:usd\ \ \ $1 \ \ a:euro\ \ \ 1€ \ \ b 2013/1/2 \ \ a\ \ \ \ \ \ \ \ 0\ ==\ \ 0 \ \ a:usd\ \ \ \ 0\ ==\ $1 \ \ a:euro\ \ \ 0\ ==\ \ 1€ \f[] .fi .SS Assertions and subaccounts .PP Balance assertions do not count the balance from subaccounts; they check the posted account's exclusive balance. For example: .IP .nf \f[C] 1/1 \ \ checking:fund\ \ \ 1\ =\ 1\ \ ;\ post\ to\ this\ subaccount,\ its\ balance\ is\ now\ 1 \ \ checking\ \ \ \ \ \ \ \ 1\ =\ 1\ \ ;\ post\ to\ the\ parent\ account,\ its\ exclusive\ balance\ is\ now\ 1 \ \ equity \f[] .fi .PP The balance report's flat mode shows these exclusive balances more clearly: .IP .nf \f[C] $\ hledger\ bal\ checking\ \-\-flat \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 1\ \ checking \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 1\ \ checking:fund \-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\- \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 2 \f[] .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[] flag or \f[C]real:\f[] query. .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[] .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[] .fi .PP 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. .SS Transaction prices .PP 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. .PP There are several ways to record a transaction price: .IP "1." 3 Write the price per unit, as \f[C]\@\ UNITPRICE\f[] after the amount: .RS 4 .IP .nf \f[C] 2009/1/1 \ \ assets:euros\ \ \ \ \ €100\ \@\ $1.35\ \ ;\ one\ hundred\ euros\ purchased\ at\ $1.35\ each \ \ assets:dollars\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ;\ balancing\ amount\ is\ \-$135.00 \f[] .fi .RE .IP "2." 3 Write the total price, as \f[C]\@\@\ TOTALPRICE\f[] after the amount: .RS 4 .IP .nf \f[C] 2009/1/1 \ \ assets:euros\ \ \ \ \ €100\ \@\@\ $135\ \ ;\ one\ hundred\ euros\ purchased\ at\ $135\ for\ the\ lot \ \ assets:dollars \f[] .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\ \ \ \ \ €100\ \ \ \ \ \ \ \ \ \ ;\ one\ hundred\ euros\ purchased \ \ assets:dollars\ \ $\-135\ \ \ \ \ \ \ \ \ \ ;\ for\ $135 \f[] .fi .RE .PP (Ledger users: Ledger uses a different syntax for fixed prices, \f[C]{=UNITPRICE}\f[], which hledger currently ignores). .PP Use the \f[C]\-B/\-\-cost\f[] flag to convert amounts to their transaction price's commodity, if any. (mnemonic: \[lq]B\[rq] is from \[lq]cost Basis\[rq], 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 \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ €100\ \ assets:euros $\ hledger\ bal\ \-N\ \-\-flat\ \-B \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ $\-135\ \ assets:dollars \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ $135\ \ assets:euros\ \ \ \ #\ <\-\ the\ euros\[aq]\ cost \f[] .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'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\ \ \ \ \ €100\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ;\ for\ 100\ euros \f[] .fi .IP .nf \f[C] $\ hledger\ bal\ \-N\ \-\-flat\ \-B \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ €\-100\ \ assets:dollars\ \ #\ <\-\ the\ dollars\[aq]\ selling\ price \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ €100\ \ assets:euros \f[] .fi .SS Comments .PP Lines in the journal beginning with a semicolon (\f[C];\f[]) or hash (\f[C]#\f[]) or star (\f[C]*\f[]) 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[]). .PP Some examples: .IP .nf \f[C] #\ a\ file\ comment ;\ also\ a\ file\ comment comment This\ is\ a\ multiline\ file\ comment, which\ continues\ until\ a\ line where\ the\ "end\ comment"\ string appears\ on\ its\ own\ (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[] .fi .PP You can also comment larger regions of a file using \f[C]comment\f[] and \f[C]end\ comment\f[] 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[] .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[] .fi .PP 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: .IP .nf \f[C] \ \ \ \ assets:checking\ \ \ \ \ \ \ ;\ a\ comment\ containing\ tag1:,\ tag2:\ some\ value\ ... \f[] .fi .PP Here, .IP \[bu] 2 \[lq]\f[C]a\ comment\ containing\f[]\[rq] is just comment text, not a tag .IP \[bu] 2 \[lq]\f[C]tag1\f[]\[rq] is a tag with no value .IP \[bu] 2 \[lq]\f[C]tag2\f[]\[rq] is another tag, whose value is \[lq]\f[C]some\ value\ ...\f[]\[rq] .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[], \f[C]TAG2\f[], \f[C]third\-tag\f[]) and the posting has four (those plus \f[C]posting\-tag\f[]): .IP .nf \f[C] 1/1\ a\ transaction\ \ ;\ A:,\ TAG2: \ \ \ \ ;\ third\-tag:\ a\ third\ transaction\ tag,\ <\-\ with\ a\ value \ \ \ \ (a)\ \ $1\ \ ;\ posting\-tag: \f[] .fi .PP Tags are like Ledger's metadata feature, except hledger's tag values are simple strings. .SS Directives .PP 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). .PP 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. .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[] 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[] T}@T{ \f[C]end\ aliases\f[] 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[] T}@T{ \f[C]end\ apply\ account\f[] 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[] T}@T{ \f[C]end\ comment\f[] 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[] T}@T{ T}@T{ \f[C]format\f[] 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[] T}@T{ T}@T{ T}@T{ declare a commodity, number notation & display style for commodityless amounts T}@T{ commodity: all commodityless entries in all files; number notation: following commodityless entries and entries in that commodity in all files; display style: amounts of that commodity in reports T} T{ \f[C]include\f[] 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[] 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[] T}@T{ T}@T{ T}@T{ declare a year for yearless dates T}@T{ following inline/included entries until end of current file T} .TE .PP And some definitions: .PP .TS tab(@); lw(8.9n) lw(61.1n). 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. .PP If you have a journal made up of multiple files, or pass multiple \-f options on the command line, note that directives which affect input typically last only until the end of their defining file. This provides more simplicity and predictability, eg reports are not changed by writing file options in a different order. It can be surprising at times though. .SS Comment blocks .PP A line containing just \f[C]comment\f[] starts a commented region of the file, and a line containing just \f[C]end\ comment\f[] (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\ path/to/file.journal \f[] .fi .PP If the path does not begin with a slash, it is relative to the current file. The include file path may contain common glob patterns (e.g. \f[C]*\f[]). .PP The \f[C]include\f[] directive can only be used in journal files. It can include journal, timeclock or timedot files, but not CSV files. .SS Default year .PP You can set a default year to be used for subsequent dates which don't specify a year. This is a line beginning with \f[C]Y\f[] 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[] .fi .SS Declaring commodities .PP The \f[C]commodity\f[] directive declares commodities which may be used in the journal (though currently we do not enforce this). 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[] .fi .PP or on multiple lines, using the \[lq]format\[rq] 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\ 9,99,99,999.00 \f[] .fi .PP Commodity directives have a second purpose: they define the standard display format for amounts in the commodity. Normally the display format is inferred from journal entries, but this can be unpredictable; declaring it with a commodity directive overrides this and removes ambiguity. Towards this end, amounts in commodity directives must always be written with a decimal point (a period or comma, followed by 0 or more decimal digits). .SS Default commodity .PP The \f[C]D\f[] directive sets a default commodity (and display format), to be used for amounts without a commodity symbol (ie, plain numbers). (Note this differs from Ledger's default commodity directive.) The commodity and display format will be applied to all subsequent commodity\-less amounts, or until the next \f[C]D\f[] directive. .IP .nf \f[C] #\ commodity\-less\ amounts\ should\ be\ treated\ as\ dollars #\ (and\ displayed\ with\ symbol\ on\ the\ left,\ thousands\ separators\ and\ two\ decimal\ places) D\ $1,000.00 1/1 \ \ a\ \ \ \ \ 5\ \ \ \ ;\ <\-\ commodity\-less\ amount,\ becomes\ $1 \ \ b \f[] .fi .PP As with the \f[C]commodity\f[] directive, the amount must always be written with a decimal point. .SS Market prices .PP The \f[C]P\f[] directive declares a market price, which is an exchange rate between two commodities on a certain date. (In Ledger, they are called \[lq]historical prices\[rq].) 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[] .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\ €\ $1.35 P\ 2010/1/1\ €\ $1.40 \f[] .fi .PP The \f[C]\-V/\-\-value\f[] flag can be used to convert reported amounts to another commodity using these prices. .SS Declaring accounts .PP \f[C]account\f[] directives can be used to pre\-declare some or all 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' 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 Here is the full syntax: .IP .nf \f[C] account\ ACCTNAME\ \ [ACCTTYPE] \ \ [COMMENTS] \f[] .fi .PP The simplest form just declares a hledger\-style account name, eg: .IP .nf \f[C] account\ assets:bank:checking \f[] .fi .SS Account types .PP hledger recognises five types of account: asset, liability, equity, revenue, expense. This is useful for certain accounting\-aware reports, in particular balancesheet, incomestatement and cashflow. .PP If you name your top\-level accounts with some variation of \f[C]assets\f[], \f[C]liabilities\f[]/\f[C]debts\f[], \f[C]equity\f[], \f[C]revenues\f[]/\f[C]income\f[], or \f[C]expenses\f[], their types are detected automatically. .PP More generally, you can declare an account's type by adding one of the letters \f[C]ALERX\f[] to its account directive, separated from the account name by two or more spaces. Eg: .IP .nf \f[C] account\ assets\ \ \ \ \ \ \ A account\ liabilities\ \ L account\ equity\ \ \ \ \ \ \ E account\ revenues\ \ \ \ \ R account\ expenses\ \ \ \ \ X \f[] .fi .PP Note: if you ever override the types of those auto\-detected english account names mentioned above, you might need to help the reports a bit: .IP .nf \f[C] ;\ make\ "liabilities"\ not\ have\ the\ liability\ type,\ who\ knows\ why account\ liabilities\ \ \ E ;\ better\ ensure\ some\ other\ account\ has\ the\ liability\ type,\ ;\ otherwise\ balancesheet\ would\ still\ show\ "liabilities"\ under\ Liabilities\ account\ \-\ \ \ \ \ \ \ \ \ \ \ \ \ L \f[] .fi .PP ) .SS Account comments .PP An account directive can also have indented comments on following lines, eg: .IP .nf \f[C] account\ assets:bank:checking \ \ ;\ acctno:12345 \ \ ;\ a\ comment \f[] .fi .PP We also allow (and ignore) Ledger\-style subdirectives, with no leading semicolon, for compatibility. .PP Tags in account comments, like \f[C]acctno\f[] above, currently have no effect. .SS Account display order .PP Account directives also set the order in which accounts are displayed in reports, the hledger\-ui accounts screen, the hledger\-web sidebar, etc. Normally accounts are listed in alphabetical order, but if you have eg these account directives in the journal: .IP .nf \f[C] account\ assets account\ liabilities account\ equity account\ revenues account\ expenses \f[] .fi .PP you'll see those accounts listed in declaration order, not alphabetically: .IP .nf \f[C] $\ hledger\ accounts\ \-1 assets liabilities equity revenues expenses \f[] .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[] .fi .PP would influence the position of \f[C]zoo\f[] among \f[C]other\f[]'s subaccounts, but not the position of \f[C]other\f[] among the top\-level accounts. This means: \- you will sometimes declare parent accounts (eg \f[C]account\ other\f[] above) that you don't intend to post to, just to customize their display order \- sibling accounts stay together (you couldn't display \f[C]x:y\f[] in between \f[C]a:b\f[] and \f[C]a:c\f[]). .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 Cookbook: Rewrite account names. .SS Basic aliases .PP To set an account alias, use the \f[C]alias\f[] 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[] .fi .PP Or, you can use the \f[C]\-\-alias\ \[aq]OLD=NEW\[aq]\f[] option on the command line. This affects all entries. It'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\ "checking"\ to\ "assets:bank:wells\ fargo:checking",\ or\ "checking:a"\ to\ "assets:bank:wells\ fargo:checking:a" \f[] .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[] .fi .PP or \f[C]\-\-alias\ \[aq]/REGEX/=REPLACEMENT\[aq]\f[]. .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\ /^(.+):bank:([^:]+)(.*)/\ =\ \\1:\\2\ \\3 #\ rewrites\ "assets:bank:wells\ fargo:checking"\ to\ \ "assets:wells\ fargo\ checking" \f[] .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 Multiple aliases .PP You can define as many aliases as you like using directives or command\-line options. Aliases are recursive \- each alias sees the result of applying previous ones. (This is different from Ledger, where aliases are non\-recursive by default). Aliases are applied in the following order: .IP "1." 3 alias directives, most recently seen first (recent directives take precedence over earlier ones; directives not yet seen are ignored) .IP "2." 3 alias options, in the order they appear on the command line .SS \f[C]end\ aliases\f[] .PP You can clear (forget) all currently defined aliases with the \f[C]end\ aliases\f[] directive: .IP .nf \f[C] end\ aliases \f[] .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[] and \f[C]end\ apply\ account\f[] directives like so: .IP .nf \f[C] apply\ account\ home 2010/1/1 \ \ \ \ food\ \ \ \ $10 \ \ \ \ cash end\ apply\ account \f[] .fi .PP which is equivalent to: .IP .nf \f[C] 2010/01/01 \ \ \ \ home:food\ \ \ \ \ \ \ \ \ \ \ $10 \ \ \ \ home:cash\ \ \ \ \ \ \ \ \ \ $\-10 \f[] .fi .PP If \f[C]end\ apply\ account\f[] 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[] .fi .PP Prior to hledger 1.0, legacy \f[C]account\f[] and \f[C]end\f[] 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 you to generate future transactions for forecasting, without having to write them out explicitly in the journal (with \f[C]\-\-forecast\f[]). Secondly, they also can be used to define budget goals (with \f[C]\-\-budget\f[]). .PP A periodic transaction rule looks like a normal journal entry, with the date replaced by a tilde (\f[C]~\f[]) followed by a period expression (mnemonic: \f[C]~\f[] looks like a recurring sine wave.): .IP .nf \f[C] ~\ monthly \ \ \ \ expenses:rent\ \ \ \ \ \ \ \ \ \ $2000 \ \ \ \ assets:bank:checking \f[] .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[] is valid, but \f[C]monthly\ from\ 2018/1/15\f[] 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's date, unless a Y default year directive is in effect, in which case they will be relative to Y/1/1. .PP Period expressions must be terminated by \f[B]two or more spaces\f[] if followed by additional fields. For example, the periodic transaction given below includes a transaction description \[lq]paycheck\[rq], which is separated from the period expression by a double space. If not for the second space, hledger would attempt (and fail) to parse \[lq]paycheck\[rq] as a part of the period expression. .IP .nf \f[C] ;\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 2\ or\ more\ spaces ;\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ || ;\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ vv ~\ every\ 2\ weeks\ from\ 2018/6/4\ to\ 2018/9\ \ paycheck \ \ \ \ assets:bank:checking\ \ \ $1500 \ \ \ \ income:acme\ inc \f[] .fi .SS Forecasting with periodic transactions .PP With the \f[C]\-\-forecast\f[] flag, each periodic transaction rule generates future transactions recurring at the specified interval. These are not saved in the journal, but appear in all reports. They will look like normal transactions, but with an extra tag named \f[C]recur\f[], whose value is the generating period expression. .PP Forecast transactions start on the first occurrence, and end on the last occurrence, of their interval within the forecast period. The forecast period: .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 180 days from today. .PP where \[lq]today\[rq] means the current date at report time. The \[lq]later of\[rq] rule ensures that forecast transactions do not overlap normal transactions in time; they will begin only after normal transactions end. .PP Forecasting can be useful for estimating balances into the future, and experimenting with different scenarios. Note the start date logic means that forecasted transactions are automatically replaced by normal transactions as you add those. .PP Forecasting can also help with data entry: describe most of your transactions with periodic rules, and every so often copy the output of \f[C]print\ \-\-forecast\f[] to the journal. .PP You can generate one\-time transactions too: just write a period expression specifying a date with no report interval. (You could also write a normal transaction with a future date, but remember this disables forecast transactions on previous dates.) .SS Budgeting with periodic transactions .PP With the \f[C]\-\-budget\f[] 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 Cookbook: Budgeting and Forecasting. .PP .SS Transaction Modifiers .PP Transaction modifier rules describe changes that should be applied automatically to certain transactions. Currently, this means adding extra postings (also known as \[lq]automated postings\[rq]). Transaction modifiers are enabled by the \f[C]\-\-auto\f[] flag. .PP A transaction modifier rule looks quite like a normal transaction, except the first line is an equals sign followed by a query that matches certain postings (mnemonic: \f[C]=\f[] suggests matching). And each \[lq]posting\[rq] is actually a posting\-generating rule: .IP .nf \f[C] =\ QUERY \ \ \ \ ACCT\ \ AMT \ \ \ \ ACCT\ \ [AMT] \ \ \ \ ... \f[] .fi .PP The posting rules look just like normal postings, except the amount can be: .IP \[bu] 2 a normal amount with a commodity symbol, eg \f[C]$2\f[]. This will be used as\-is. .IP \[bu] 2 a number, eg \f[C]2\f[]. 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[] (a star followed by a number N). The matched posting'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[] (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. .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[] .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[] .fi .PP Postings added by transaction modifiers participate in transaction balancing, missing amount inference and balance assertions, like regular postings. .SH EDITOR SUPPORT .PP Add\-on modes exist for various text editors, to make working with journal files easier. They add colour, navigation aids and helpful commands. For hledger users who edit the journal file directly (the majority), using one of these modes is quite recommended. .PP These were written with Ledger in mind, but also work with hledger files: .PP .TS tab(@); lw(12.2n) lw(57.8n). T{ Editor T}@T{ T} _ T{ Emacs T}@T{ http://www.ledger\-cli.org/3.0/doc/ledger\-mode.html T} T{ Vim T}@T{ https://github.com/ledger/vim\-ledger T} T{ Sublime Text T}@T{ https://github.com/ledger/ledger/wiki/Editing\-Ledger\-files\-with\-Sublime\-Text\-or\-RubyMine T} T{ Textmate T}@T{ https://github.com/ledger/ledger/wiki/Using\-TextMate\-2 T} T{ Text Wrangler \ T}@T{ https://github.com/ledger/ledger/wiki/Editing\-Ledger\-files\-with\-TextWrangler T} T{ Visual Studio Code T}@T{ https://marketplace.visualstudio.com/items?itemName=mark\-hansen.hledger\-vscode T} .TE .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-2016 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.12/hledger_journal.txt0000644000000000000000000015774413401102737015726 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 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 get- ting. You can use hledger without learning any more about this file; just use the add or web commands to create and update it. Many users, though, also edit the journal file directly with a text editor, perhaps assisted by the helper modes for emacs or vim. Here's an example: ; A sample journal file. This is a comment. 2008/01/01 income ; <- transaction's first line starts in column 0, contains date and description assets:bank:checking $1 ; <- posting lines start with whitespace, each contains an account name income:salary $-1 ; followed by at least two spaces and an amount 2008/06/01 gift assets:bank:checking $1 ; <- at least two postings in a transaction income:gifts $-1 ; <- their amounts must balance to 0 2008/06/02 save assets:bank:saving $1 assets:bank:checking ; <- one amount may be omitted; here $-1 is inferred 2008/06/03 eat & shop ; <- description can be anything expenses:food $1 expenses:supplies $1 ; <- this transaction debits two expense accounts assets:cash ; <- $-2 inferred 2008/10/01 take a loan assets:bank:checking $1 liabilities:debts $-1 2008/12/31 * pay off ; <- an optional * or ! after the date means "cleared" (or anything you want) liabilities:debts $1 assets:bank:checking FILE FORMAT Transactions Transactions are movements of some quantity of commodities between named accounts. Each transaction is represented by a journal entry beginning with a simple date in column 0. This can be followed by any of the following, separated by spaces: o (optional) a status character (empty, !, or *) o (optional) a transaction code (any short number or text, enclosed in parentheses) o (optional) a transaction description (any remaining text until end of line or a semicolon) o (optional) a transaction comment (any remaining text following a semicolon until end of line) Then comes zero or more (but usually at least 2) indented lines repre- senting... 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. Dates Simple dates Within a journal file, transaction dates use Y/M/D (or Y-M-D or Y.M.D) Leading zeros are 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, 1/31, 2010-01-31, 2010.1.31. 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, eg for more accurate balances, you can specify individual posting dates, which I recommend. Or, you can use the sec- ondary dates (aka auxiliary/effective dates) feature, supported for compatibility with Ledger. A secondary date can be written after the primary date, separated by an equals sign. The primary date, on the left, is used by default; the secondary date, on the right, is used when the --date2 flag is speci- fied (--aux-date or --effective also work). The meaning of secondary dates is up to you, but it's best to follow a consistent rule. Eg write the bank's clearing date as primary, and when needed, the date the transaction was initiated as secondary. Here's an example. Note that a secondary date will use the year of the primary date if unspecified. 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 Secondary dates require some effort; you must use them consistently in your journal entries and remember whether to use or not use the --date2 flag for your reports. They are included in hledger for Ledger compat- ibility, but posting dates are a more powerful and less confusing alternative. 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. 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 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 uncashed 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 a description to subdivide it into a payee/payer name on the left and additional notes on the right. This may be worthwhile if you need to do more precise querying and pivoting by payee. 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: between account name and amount, there must be two or more spaces. Amounts consist of a number and (usually) a currency symbol or commod- ity name. Some examples: 2.00001 $1 4000 AAPL 3 "green apples" -$1,000,000.00 INR 9,99,99,999.00 EUR -2.000.000,00 1 999 999.9455 EUR 1E3 1000E-6s As you can see, the amount format is somewhat flexible: o amounts are a number (the "quantity") and optionally a currency sym- bol/commodity name (the "commodity"). o the commodity is a symbol, word, or phrase, on the left or right, with or without a separating space. If the commodity contains num- bers, spaces or non-word punctuation it must be enclosed in double quotes. o negative amounts with a commodity on the left can have the minus sign before or after it o digit groups (thousands, or any other grouping) can be separated by space or comma or period and should be used as separator between all groups o decimal part can be separated by comma or period and should be dif- ferent from digit groups separator o scientific E-notation is allowed. Be careful not to use a digit group separator character in scientific notation, as it's not sup- ported and it might get mistaken for a decimal point. (Declaring the digit group separator character explicitly with a commodity directive will prevent this.) You can use any of these variations when recording data. However, there is some ambiguous way of representing numbers like $1.000 and $1,000 both may mean either one thousand or one dollar. By default hledger will assume that this is sole delimiter is used only for deci- mals. On the other hand commodity format declared prior to that line will help to resolve that ambiguity differently: commodity $1,000.00 2017/12/25 New life of Scrooge expenses:gifts $1,000 assets Though journal may contain mixed styles to represent amount, when hledger displays amounts, it will choose a consistent format for each commodity. (Except for price amounts, which are always formatted as written). The display format is chosen as follows: o if there is a commodity directive specifying the format, that is used o otherwise the format is inferred from the first posting amount in that commodity in the journal, and the precision (number of decimal places) will be the maximum from all posting amounts in that commmod- ity o or if there are no such amounts in the journal, a default format is used (like $1000.00). Price amounts and amounts in D directives usually don't affect amount format inference, but in some situations they can do so indirectly. (Eg when D's default commodity is applied to a commodity-less amount, or when an amountless posting is balanced using a price's commodity, or when -V is used.) If you find this causing problems, set the desired format with a commodity directive. Virtual Postings When you parenthesise the account name in a posting, we call that a virtual posting, which means: o it is ignored when checking that the transaction is balanced o it is excluded from reports when the --real/-R flag is used, or the real:1 query. You could use this, eg, to set an account's opening balance without needing to use the equity:opening balances account: 1/1 special unbalanced posting to set initial balance (assets:checking) $1000 When the account name is bracketed, we call it a balanced virtual post- ing. This is like an ordinary virtual posting except the balanced vir- tual postings in a transaction must balance to 0, like the real post- ings (but separately from them). Balanced virtual postings are also excluded by --real/-R or real:1. 1/1 buy food with cash, and update some budget-tracking subaccounts elsewhere expenses:food $10 assets:cash $-10 [assets:checking:available] $10 [assets:checking:budget:food] $-10 Virtual postings have some legitimate uses, but those are few. You can usually find an equivalent journal entry using real postings, which is more correct and provides better error checking. Balance Assertions hledger supports Ledger-style balance assertions in journal files. These look like =EXPECTEDBALANCE following a posting's amount. Eg in this example 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 --ignore-assertions flag, which can be useful for troubleshooting or for reading Ledger files. 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 differ- ently-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 con- trol 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 "par- tial" 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 kind of balance assertion, by writing a double equals sign (==EXPECTEDBALANCE). This "complete" balance assertion asserts the absence of other commodities (or, that their balance is 0, which to hledger is equivalent.) 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 Assertions and subaccounts Balance assertions do not count the balance from subaccounts; they check the posted account's exclusive balance. For example: 1/1 checking:fund 1 = 1 ; post to this subaccount, its balance is now 1 checking 1 = 1 ; post to the parent account, its exclusive balance is now 1 equity The balance report's flat mode shows these exclusive balances more clearly: $ hledger bal checking --flat 1 checking 1 checking:fund -------------------- 2 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. 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. 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 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 (Ledger users: Ledger uses a different syntax for fixed prices, {=UNIT- PRICE}, which hledger currently ignores). 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 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 post- ings). 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 ; also a file comment comment This is a multiline file comment, which continues until a line where the "end comment" string appears on its own (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. 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 subdi- purpose can affect (as of tive directive rec- 2018/06) tives ------------------------------------------------------------------------------------------------- account any document account names, all entries in all text declare account types & dis- files, before or play order after alias end aliases rewrite account names following inline/included entries until end of current file or end directive apply account end apply account prepend a common parent to following account names inline/included entries until end of current file or end directive comment end comment ignore part of journal following 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; dis- play style: amounts of that commodity in reports D declare a commodity, number commodity: all com- notation & display style for modityless entries commodityless amounts in all files; num- ber notation: fol- lowing commodity- less entries and entries in that commodity in all files; 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 a amounts of that commodity commodity in reports, when -V is used Y declare a year for yearless following dates inline/included entries until end of current file And some definitions: subdirec- optional indented directive line immediately following a par- tive ent directive number how to interpret numbers when parsing journal entries (the notation identity of the decimal separator character). (Currently each commodity can have its own notation, even in the same file.) display how to display amounts of a commodity in reports (symbol side style and spacing, digit groups, decimal separator, decimal places) directive which 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. If you have a journal made up of multiple files, or pass multiple -f options on the command line, note that directives which affect input typically last only until the end of their defining file. This pro- vides more simplicity and predictability, eg reports are not changed by writing file options in a different order. It can be surprising at times though. 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 path/to/file.journal If the path does not begin with a slash, it is relative to the current file. The include file path may contain common glob patterns (e.g. *). The include directive can only be used in journal files. It can include journal, timeclock or timedot files, but not CSV files. 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 declares commodities which may be used in the journal (though currently we do not enforce this). 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 9,99,99,999.00 Commodity directives have a second purpose: they define the standard display format for amounts in the commodity. Normally the display for- mat is inferred from journal entries, but this can be unpredictable; declaring it with a commodity directive overrides this and removes ambiguity. Towards this end, amounts in commodity directives must always be written with a decimal point (a period or comma, followed by 0 or more decimal digits). Default commodity The D directive sets a default commodity (and display format), to be used for amounts without a commodity symbol (ie, plain numbers). (Note this differs from Ledger's default commodity directive.) The commodity and display format will be applied to all subsequent commodity-less amounts, or until the next D directive. # commodity-less amounts should be treated as dollars # (and displayed with symbol on the left, thousands separators and two decimal places) D $1,000.00 1/1 a 5 ; <- commodity-less amount, becomes $1 b As with the commodity directive, the amount must always be written with a decimal point. 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 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 $1.35 P 2010/1/1 $1.40 The -V/--value flag can be used to convert reported amounts to another commodity using these prices. Declaring accounts account directives can be used to pre-declare some or all accounts. Though not required, 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. Here is the full syntax: account ACCTNAME [ACCTTYPE] [COMMENTS] The simplest form just declares a hledger-style account name, eg: account assets:bank:checking Account types hledger recognises five types of account: asset, liability, equity, revenue, expense. This is useful for certain accounting-aware reports, in particular balancesheet, incomestatement and cashflow. If you name your top-level accounts with some variation of assets, lia- bilities/debts, equity, revenues/income, or expenses, their types are detected automatically. More generally, you can declare an account's type by adding one of the letters ALERX to its account directive, separated from the account name by two or more spaces. Eg: account assets A account liabilities L account equity E account revenues R account expenses X Note: if you ever override the types of those auto-detected english account names mentioned above, you might need to help the reports a bit: ; make "liabilities" not have the liability type, who knows why account liabilities E ; better ensure some other account has the liability type, ; otherwise balancesheet would still show "liabilities" under Liabilities account - L ) Account comments An account directive can also have indented comments on following lines, eg: account assets:bank:checking ; acctno:12345 ; a comment We also allow (and ignore) Ledger-style subdirectives, with no leading semicolon, for compatibility. Tags in account comments, like acctno above, currently have no effect. Account display order Account directives also set the order in which accounts are displayed in reports, the hledger-ui accounts screen, the hledger-web sidebar, etc. Normally accounts are listed in alphabetical order, but if you have eg these account directives in the journal: account assets account liabilities account equity account revenues account expenses you'll see those accounts listed in declaration order, not alphabeti- cally: $ 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). 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 Cookbook: 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 replace any occurrence of the old account name with the new one. Sub- accounts 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. Multiple aliases You can define as many aliases as you like using directives or com- mand-line options. Aliases are recursive - each alias sees the result of applying previous ones. (This is different from Ledger, where aliases are non-recursive by default). Aliases are applied in the fol- lowing order: 1. alias directives, most recently seen first (recent directives take precedence over earlier ones; directives not yet seen are ignored) 2. alias options, in the order they appear on the command line 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 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 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 allow you to generate future transactions for forecasting, without hav- ing to write them out explicitly in the journal (with --forecast). Secondly, they also can be used to define budget goals (with --budget). 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. Period expressions must be terminated by two or more spaces if followed by additional fields. For example, the periodic transaction given below includes a transaction description "paycheck", which is separated from the period expression by a double space. If not for the second space, hledger would attempt (and fail) to parse "paycheck" as a part of the period expression. ; 2 or more spaces ; || ; vv ~ every 2 weeks from 2018/6/4 to 2018/9 paycheck assets:bank:checking $1500 income:acme inc Forecasting with periodic transactions With the --forecast flag, each periodic transaction rule generates future transactions recurring at the specified interval. These are not saved in the journal, but appear in all reports. They will look like normal transactions, but with an extra tag named recur, whose value is the generating period expression. Forecast transactions start on the first occurrence, and end on the last occurrence, of their interval within the forecast period. The forecast period: 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 180 days from today. where "today" means the current date at report time. The "later of" rule ensures that forecast transactions do not overlap normal transac- tions in time; they will begin only after normal transactions end. Forecasting can be useful for estimating balances into the future, and experimenting with different scenarios. Note the start date logic means that forecasted transactions are automatically replaced by normal transactions as you add those. Forecasting can also help with data entry: describe most of your trans- actions with periodic rules, and every so often copy the output of print --forecast to the journal. You can generate one-time transactions too: just write a period expres- sion specifying a date with no report interval. (You could also write a normal transaction with a future date, but remember this disables forecast transactions on previous dates.) 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 Cookbook: Budgeting and Forecasting. Transaction Modifiers Transaction modifier rules describe changes that should be applied automatically to certain transactions. Currently, this means adding extra postings (also known as "automated postings"). Transaction modi- fiers are enabled by the --auto flag. A transaction modifier rule looks quite like a normal transaction, except the first line is an equals sign followed by a query that matches certain postings (mnemonic: = suggests matching). And each "posting" is actually a posting-generating rule: = QUERY ACCT AMT ACCT [AMT] ... The posting rules look just like normal postings, except the amount 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. 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 Postings added by transaction modifiers participate in transaction bal- ancing, missing amount inference and balance assertions, like regular postings. EDITOR SUPPORT Add-on modes exist for various text editors, to make working with jour- nal files easier. They add colour, navigation aids and helpful com- mands. For hledger users who edit the journal file directly (the majority), using one of these modes is quite recommended. These were written with Ledger in mind, but also work with hledger files: Editor -------------------------------------------------------------------------- Emacs http://www.ledger-cli.org/3.0/doc/ledger-mode.html Vim https://github.com/ledger/vim-ledger Sublime Text https://github.com/ledger/ledger/wiki/Edit- ing-Ledger-files-with-Sublime-Text-or-RubyMine Textmate https://github.com/ledger/ledger/wiki/Using-TextMate-2 Text Wran- https://github.com/ledger/ledger/wiki/Edit- gler ing-Ledger-files-with-TextWrangler Visual Stu- https://marketplace.visualstudio.com/items?item- dio Code Name=mark-hansen.hledger-vscode 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-2016 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.12 December 2018 hledger_journal(5) hledger-lib-1.12/hledger_journal.info0000644000000000000000000016144013401102731016020 0ustar0000000000000000This is hledger_journal.info, produced by makeinfo version 6.5 from stdin.  File: hledger_journal.info, Node: Top, Next: FILE FORMAT, Up: (dir) hledger_journal(5) hledger 1.12 ******************************* 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 commands to create and update it. Many users, though, also edit the journal file directly with a text editor, perhaps assisted by the helper modes for emacs or vim. Here's an example: ; A sample journal file. This is a comment. 2008/01/01 income ; <- transaction's first line starts in column 0, contains date and description assets:bank:checking $1 ; <- posting lines start with whitespace, each contains an account name income:salary $-1 ; followed by at least two spaces and an amount 2008/06/01 gift assets:bank:checking $1 ; <- at least two postings in a transaction income:gifts $-1 ; <- their amounts must balance to 0 2008/06/02 save assets:bank:saving $1 assets:bank:checking ; <- one amount may be omitted; here $-1 is inferred 2008/06/03 eat & shop ; <- description can be anything expenses:food $1 expenses:supplies $1 ; <- this transaction debits two expense accounts assets:cash ; <- $-2 inferred 2008/10/01 take a loan assets:bank:checking $1 liabilities:debts $-1 2008/12/31 * pay off ; <- an optional * or ! after the date means "cleared" (or anything you want) liabilities:debts $1 assets:bank:checking * Menu: * FILE FORMAT:: * EDITOR SUPPORT::  File: hledger_journal.info, Node: FILE FORMAT, Next: EDITOR SUPPORT, Prev: Top, Up: Top 1 FILE FORMAT ************* * Menu: * Transactions:: * Postings:: * Dates:: * Status:: * Description:: * Account names:: * Amounts:: * Virtual Postings:: * Balance Assertions:: * Balance Assignments:: * Transaction prices:: * Comments:: * Tags:: * Directives:: * Periodic transactions:: * Transaction Modifiers::  File: hledger_journal.info, Node: Transactions, Next: Postings, Up: FILE FORMAT 1.1 Transactions ================ Transactions are movements of some quantity of commodities between named accounts. Each transaction is represented by a journal entry beginning with a simple date in column 0. This can be followed by any of the following, separated by spaces: * (optional) a status character (empty, '!', or '*') * (optional) a transaction code (any short number or text, enclosed in parentheses) * (optional) a transaction description (any remaining text until end of line or a semicolon) * (optional) a transaction comment (any remaining text following a semicolon until end of line) Then comes zero or more (but usually at least 2) indented lines representing...  File: hledger_journal.info, Node: Postings, Next: Dates, Prev: Transactions, Up: FILE FORMAT 1.2 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.  File: hledger_journal.info, Node: Dates, Next: Status, Prev: Postings, Up: FILE FORMAT 1.3 Dates ========= * Menu: * Simple dates:: * Secondary dates:: * Posting dates::  File: hledger_journal.info, Node: Simple dates, Next: Secondary dates, Up: Dates 1.3.1 Simple dates ------------------ Within a journal file, transaction dates use Y/M/D (or Y-M-D or Y.M.D) Leading zeros are 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', '1/31', '2010-01-31', '2010.1.31'.  File: hledger_journal.info, Node: Secondary dates, Next: Posting dates, Prev: Simple dates, Up: Dates 1.3.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, eg for more accurate balances, you can specify individual posting dates, which I recommend. Or, you can use the secondary dates (aka auxiliary/effective dates) feature, supported for compatibility with Ledger. A secondary date can be written after the primary date, separated by an equals sign. The primary date, on the left, is used by default; the secondary date, on the right, is used when the '--date2' flag is specified ('--aux-date' or '--effective' also work). The meaning of secondary dates is up to you, but it's best to follow a consistent rule. Eg write the bank's clearing date as primary, and when needed, the date the transaction was initiated as secondary. Here's an example. Note that a secondary date will use the year of the primary date if unspecified. 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 Secondary dates require some effort; you must use them consistently in your journal entries and remember whether to use or not use the '--date2' flag for your reports. They are included in hledger for Ledger compatibility, but posting dates are a more powerful and less confusing alternative.  File: hledger_journal.info, Node: Posting dates, Prev: Secondary dates, Up: Dates 1.3.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: FILE FORMAT 1.4 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: Account names, Prev: Status, Up: FILE FORMAT 1.5 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.5.1 Payee and note -------------------- You can optionally include a '|' (pipe) character in a description to subdivide it into a payee/payer name on the left and additional notes on the right. This may be worthwhile if you need to do more precise querying and pivoting by payee.  File: hledger_journal.info, Node: Account names, Next: Amounts, Prev: Description, Up: FILE FORMAT 1.6 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: Virtual Postings, Prev: Account names, Up: FILE FORMAT 1.7 Amounts =========== After the account name, there is usually an amount. Important: between account name and amount, there must be *two or more spaces*. Amounts consist of a number and (usually) a currency symbol or commodity name. Some examples: '2.00001' '$1' '4000 AAPL' '3 "green apples"' '-$1,000,000.00' 'INR 9,99,99,999.00' 'EUR -2.000.000,00' '1 999 999.9455' 'EUR 1E3' '1000E-6s' As you can see, the amount format is somewhat flexible: * amounts are a number (the "quantity") and optionally a currency symbol/commodity name (the "commodity"). * the commodity is a symbol, word, or phrase, on the left or right, with or without a separating space. If the commodity contains numbers, spaces or non-word punctuation it must be enclosed in double quotes. * negative amounts with a commodity on the left can have the minus sign before or after it * digit groups (thousands, or any other grouping) can be separated by space or comma or period and should be used as separator between all groups * decimal part can be separated by comma or period and should be different from digit groups separator * scientific E-notation is allowed. Be careful not to use a digit group separator character in scientific notation, as it's not supported and it might get mistaken for a decimal point. (Declaring the digit group separator character explicitly with a commodity directive will prevent this.) You can use any of these variations when recording data. However, there is some ambiguous way of representing numbers like '$1.000' and '$1,000' both may mean either one thousand or one dollar. By default hledger will assume that this is sole delimiter is used only for decimals. On the other hand commodity format declared prior to that line will help to resolve that ambiguity differently: commodity $1,000.00 2017/12/25 New life of Scrooge expenses:gifts $1,000 assets Though journal may contain mixed styles to represent amount, when hledger displays amounts, it will choose a consistent format for each commodity. (Except for price amounts, which are always formatted as written). The display format is chosen as follows: * if there is a commodity directive specifying the format, that is used * otherwise the format is inferred from the first posting amount in that commodity in the journal, and the precision (number of decimal places) will be the maximum from all posting amounts in that commmodity * or if there are no such amounts in the journal, a default format is used (like '$1000.00'). Price amounts and amounts in 'D' directives usually don't affect amount format inference, but in some situations they can do so indirectly. (Eg when D's default commodity is applied to a commodity-less amount, or when an amountless posting is balanced using a price's commodity, or when -V is used.) If you find this causing problems, set the desired format with a commodity directive.  File: hledger_journal.info, Node: Virtual Postings, Next: Balance Assertions, Prev: Amounts, Up: FILE FORMAT 1.8 Virtual Postings ==================== When you parenthesise the account name in a posting, we call that a _virtual posting_, which means: * it is ignored when checking that the transaction is balanced * it is excluded from reports when the '--real/-R' flag is used, or the 'real:1' query. You could use this, eg, to set an account's opening balance without needing to use the 'equity:opening balances' account: 1/1 special unbalanced posting to set initial balance (assets:checking) $1000 When the account name is bracketed, we call it a _balanced virtual posting_. This is like an ordinary virtual posting except the balanced virtual postings in a transaction must balance to 0, like the real postings (but separately from them). Balanced virtual postings are also excluded by '--real/-R' or 'real:1'. 1/1 buy food with cash, and update some budget-tracking subaccounts elsewhere expenses:food $10 assets:cash $-10 [assets:checking:available] $10 [assets:checking:budget:food] $-10 Virtual postings have some legitimate uses, but those are few. You can usually find an equivalent journal entry using real postings, which is more correct and provides better error checking.  File: hledger_journal.info, Node: Balance Assertions, Next: Balance Assignments, Prev: Virtual Postings, Up: FILE FORMAT 1.9 Balance Assertions ====================== hledger supports Ledger-style balance assertions in journal files. These look like '=EXPECTEDBALANCE' following a posting's amount. Eg in this example 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 '--ignore-assertions' flag, which can be useful for troubleshooting or for reading Ledger files. * Menu: * Assertions and ordering:: * Assertions and included files:: * Assertions and multiple -f options:: * Assertions and commodities:: * Assertions and subaccounts:: * Assertions and virtual postings::  File: hledger_journal.info, Node: Assertions and ordering, Next: Assertions and included files, Up: Balance Assertions 1.9.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.9.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.9.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 subaccounts, Prev: Assertions and multiple -f options, Up: Balance Assertions 1.9.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 kind of balance assertion, by writing a double equals sign ('==EXPECTEDBALANCE'). This "complete" balance assertion asserts the absence of other commodities (or, that their balance is 0, which to hledger is equivalent.) 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 subaccounts, Next: Assertions and virtual postings, Prev: Assertions and commodities, Up: Balance Assertions 1.9.5 Assertions and subaccounts -------------------------------- Balance assertions do not count the balance from subaccounts; they check the posted account's exclusive balance. For example: 1/1 checking:fund 1 = 1 ; post to this subaccount, its balance is now 1 checking 1 = 1 ; post to the parent account, its exclusive balance is now 1 equity The balance report's flat mode shows these exclusive balances more clearly: $ hledger bal checking --flat 1 checking 1 checking:fund -------------------- 2  File: hledger_journal.info, Node: Assertions and virtual postings, Prev: Assertions and subaccounts, Up: Balance Assertions 1.9.6 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: Balance Assignments, Next: Transaction prices, Prev: Balance Assertions, Up: FILE FORMAT 1.10 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.  File: hledger_journal.info, Node: Transaction prices, Next: Comments, Prev: Balance Assignments, Up: FILE FORMAT 1.11 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 (Ledger users: Ledger uses a different syntax for fixed prices, '{=UNITPRICE}', which hledger currently ignores). 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: Comments, Next: Tags, Prev: Transaction prices, Up: FILE FORMAT 1.12 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 ; also a file comment comment This is a multiline file comment, which continues until a line where the "end comment" string appears on its own (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: Directives, Prev: Comments, Up: FILE FORMAT 1.13 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: Directives, Next: Periodic transactions, Prev: Tags, Up: FILE FORMAT 1.14 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, number commodity: all notation & display style commodityless for commodityless amounts entries in all files; number notation: following commodityless entries and entries in that commodity in all files; 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 And some definitions: subdirectiveoptional indented directive line immediately following a parent directive number how to interpret numbers when parsing journal entries (the notation identity of the decimal separator character). (Currently each commodity can have its own notation, even in the same file.) display how to display amounts of a commodity in reports (symbol side style and spacing, digit groups, decimal separator, decimal places) directive which 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. If you have a journal made up of multiple files, or pass multiple -f options on the command line, note that directives which affect input typically last only until the end of their defining file. This provides more simplicity and predictability, eg reports are not changed by writing file options in a different order. It can be surprising at times though. * Menu: * Comment blocks:: * Including other files:: * Default year:: * Declaring commodities:: * Default commodity:: * Market prices:: * Declaring accounts:: * Rewriting accounts:: * Default parent account::  File: hledger_journal.info, Node: Comment blocks, Next: Including other files, Up: Directives 1.14.1 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.14.2 Including other files ---------------------------- You can pull in the content of additional files by writing an include directive, like this: include path/to/file.journal If the path does not begin with a slash, it is relative to the current file. The include file path may contain common glob patterns (e.g. '*'). The 'include' directive can only be used in journal files. It can include journal, timeclock or timedot files, but not CSV files.  File: hledger_journal.info, Node: Default year, Next: Declaring commodities, Prev: Including other files, Up: Directives 1.14.3 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.14.4 Declaring commodities ---------------------------- The 'commodity' directive declares commodities which may be used in the journal (though currently we do not enforce this). 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 9,99,99,999.00 Commodity directives have a second purpose: they define the standard display format for amounts in the commodity. Normally the display format is inferred from journal entries, but this can be unpredictable; declaring it with a commodity directive overrides this and removes ambiguity. Towards this end, amounts in commodity directives must always be written with a decimal point (a period or comma, followed by 0 or more decimal digits).  File: hledger_journal.info, Node: Default commodity, Next: Market prices, Prev: Declaring commodities, Up: Directives 1.14.5 Default commodity ------------------------ The 'D' directive sets a default commodity (and display format), to be used for amounts without a commodity symbol (ie, plain numbers). (Note this differs from Ledger's default commodity directive.) The commodity and display format will be applied to all subsequent commodity-less amounts, or until the next 'D' directive. # commodity-less amounts should be treated as dollars # (and displayed with symbol on the left, thousands separators and two decimal places) D $1,000.00 1/1 a 5 ; <- commodity-less amount, becomes $1 b As with the 'commodity' directive, the amount must always be written with a decimal point.  File: hledger_journal.info, Node: Market prices, Next: Declaring accounts, Prev: Default commodity, Up: Directives 1.14.6 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/--value' flag can be used to convert reported amounts to another commodity using these prices.  File: hledger_journal.info, Node: Declaring accounts, Next: Rewriting accounts, Prev: Market prices, Up: Directives 1.14.7 Declaring accounts ------------------------- 'account' directives can be used to pre-declare some or all 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. Here is the full syntax: account ACCTNAME [ACCTTYPE] [COMMENTS] The simplest form just declares a hledger-style account name, eg: account assets:bank:checking * Menu: * Account types:: * Account comments:: * Account display order::  File: hledger_journal.info, Node: Account types, Next: Account comments, Up: Declaring accounts 1.14.7.1 Account types ...................... hledger recognises five types of account: asset, liability, equity, revenue, expense. This is useful for certain accounting-aware reports, in particular balancesheet, incomestatement and cashflow. If you name your top-level accounts with some variation of 'assets', 'liabilities'/'debts', 'equity', 'revenues'/'income', or 'expenses', their types are detected automatically. More generally, you can declare an account's type by adding one of the letters 'ALERX' to its account directive, separated from the account name by two or more spaces. Eg: account assets A account liabilities L account equity E account revenues R account expenses X Note: if you ever override the types of those auto-detected english account names mentioned above, you might need to help the reports a bit: ; make "liabilities" not have the liability type, who knows why account liabilities E ; better ensure some other account has the liability type, ; otherwise balancesheet would still show "liabilities" under Liabilities account - L )  File: hledger_journal.info, Node: Account comments, Next: Account display order, Prev: Account types, Up: Declaring accounts 1.14.7.2 Account comments ......................... An account directive can also have indented comments on following lines, eg: account assets:bank:checking ; acctno:12345 ; a comment We also allow (and ignore) Ledger-style subdirectives, with no leading semicolon, for compatibility. Tags in account comments, like 'acctno' above, currently have no effect.  File: hledger_journal.info, Node: Account display order, Prev: Account comments, Up: Declaring accounts 1.14.7.3 Account display order .............................. Account directives also set the order in which accounts are displayed in reports, the hledger-ui accounts screen, the hledger-web sidebar, etc. Normally accounts are listed in alphabetical order, but if you have eg these account directives in the journal: account assets account liabilities account equity account revenues account expenses you'll see those accounts listed 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.14.8 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 Cookbook: Rewrite account names. * Menu: * Basic aliases:: * Regex aliases:: * Multiple aliases:: * end aliases::  File: hledger_journal.info, Node: Basic aliases, Next: Regex aliases, Up: Rewriting accounts 1.14.8.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: Multiple aliases, Prev: Basic aliases, Up: Rewriting accounts 1.14.8.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: Multiple aliases, Next: end aliases, Prev: Regex aliases, Up: Rewriting accounts 1.14.8.3 Multiple aliases ......................... You can define as many aliases as you like using directives or command-line options. Aliases are recursive - each alias sees the result of applying previous ones. (This is different from Ledger, where aliases are non-recursive by default). Aliases are applied in the following order: 1. alias directives, most recently seen first (recent directives take precedence over earlier ones; directives not yet seen are ignored) 2. alias options, in the order they appear on the command line  File: hledger_journal.info, Node: end aliases, Prev: Multiple aliases, Up: Rewriting accounts 1.14.8.4 '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.14.9 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: Transaction Modifiers, Prev: Directives, Up: FILE FORMAT 1.15 Periodic transactions ========================== Periodic transaction rules describe transactions that recur. They allow you to generate future transactions for forecasting, without having to write them out explicitly in the journal (with '--forecast'). Secondly, they also can be used to define budget goals (with '--budget'). 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. Period expressions must be terminated by *two or more spaces* if followed by additional fields. For example, the periodic transaction given below includes a transaction description "paycheck", which is separated from the period expression by a double space. If not for the second space, hledger would attempt (and fail) to parse "paycheck" as a part of the period expression. ; 2 or more spaces ; || ; vv ~ every 2 weeks from 2018/6/4 to 2018/9 paycheck assets:bank:checking $1500 income:acme inc * Menu: * Forecasting with periodic transactions:: * Budgeting with periodic transactions::  File: hledger_journal.info, Node: Forecasting with periodic transactions, Next: Budgeting with periodic transactions, Up: Periodic transactions 1.15.1 Forecasting with periodic transactions --------------------------------------------- With the '--forecast' flag, each periodic transaction rule generates future transactions recurring at the specified interval. These are not saved in the journal, but appear in all reports. They will look like normal transactions, but with an extra tag named 'recur', whose value is the generating period expression. Forecast transactions start on the first occurrence, and end on the last occurrence, of their interval within the forecast period. The forecast period: * 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 180 days from today. where "today" means the current date at report time. The "later of" rule ensures that forecast transactions do not overlap normal transactions in time; they will begin only after normal transactions end. Forecasting can be useful for estimating balances into the future, and experimenting with different scenarios. Note the start date logic means that forecasted transactions are automatically replaced by normal transactions as you add those. Forecasting can also help with data entry: describe most of your transactions with periodic rules, and every so often copy the output of 'print --forecast' to the journal. You can generate one-time transactions too: just write a period expression specifying a date with no report interval. (You could also write a normal transaction with a future date, but remember this disables forecast transactions on previous dates.)  File: hledger_journal.info, Node: Budgeting with periodic transactions, Prev: Forecasting with periodic transactions, Up: Periodic transactions 1.15.2 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 Cookbook: Budgeting and Forecasting.  File: hledger_journal.info, Node: Transaction Modifiers, Prev: Periodic transactions, Up: FILE FORMAT 1.16 Transaction Modifiers ========================== Transaction modifier rules describe changes that should be applied automatically to certain transactions. Currently, this means adding extra postings (also known as "automated postings"). Transaction modifiers are enabled by the '--auto' flag. A transaction modifier rule looks quite like a normal transaction, except the first line is an equals sign followed by a query that matches certain postings (mnemonic: '=' suggests matching). And each "posting" is actually a posting-generating rule: = QUERY ACCT AMT ACCT [AMT] ... The posting rules look just like normal postings, except the amount 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. 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 Postings added by transaction modifiers participate in transaction balancing, missing amount inference and balance assertions, like regular postings.  File: hledger_journal.info, Node: EDITOR SUPPORT, Prev: FILE FORMAT, Up: Top 2 EDITOR SUPPORT **************** Add-on modes exist for various text editors, to make working with journal files easier. They add colour, navigation aids and helpful commands. For hledger users who edit the journal file directly (the majority), using one of these modes is quite recommended. These were written with Ledger in mind, but also work with hledger files: Editor -------------------------------------------------------------------------- Emacs http://www.ledger-cli.org/3.0/doc/ledger-mode.html Vim https://github.com/ledger/vim-ledger Sublime https://github.com/ledger/ledger/wiki/Editing-Ledger-files-with-Sublime-Text-or-RubyMine Text Textmate https://github.com/ledger/ledger/wiki/Using-TextMate-2 Text https://github.com/ledger/ledger/wiki/Editing-Ledger-files-with-TextWrangler Wrangler Visual https://marketplace.visualstudio.com/items?itemName=mark-hansen.hledger-vscode Studio Code  Tag Table: Node: Top76 Node: FILE FORMAT2372 Ref: #file-format2496 Node: Transactions2783 Ref: #transactions2904 Node: Postings3588 Ref: #postings3715 Node: Dates4710 Ref: #dates4825 Node: Simple dates4890 Ref: #simple-dates5016 Node: Secondary dates5382 Ref: #secondary-dates5536 Node: Posting dates7099 Ref: #posting-dates7228 Node: Status8602 Ref: #status8722 Node: Description10430 Ref: #description10568 Node: Payee and note10887 Ref: #payee-and-note11001 Node: Account names11243 Ref: #account-names11386 Node: Amounts11873 Ref: #amounts12009 Node: Virtual Postings15026 Ref: #virtual-postings15185 Node: Balance Assertions16405 Ref: #balance-assertions16580 Node: Assertions and ordering17476 Ref: #assertions-and-ordering17662 Node: Assertions and included files18362 Ref: #assertions-and-included-files18603 Node: Assertions and multiple -f options18936 Ref: #assertions-and-multiple--f-options19190 Node: Assertions and commodities19322 Ref: #assertions-and-commodities19557 Node: Assertions and subaccounts20745 Ref: #assertions-and-subaccounts20977 Node: Assertions and virtual postings21498 Ref: #assertions-and-virtual-postings21705 Node: Balance Assignments21847 Ref: #balance-assignments22028 Node: Transaction prices23148 Ref: #transaction-prices23317 Node: Comments25585 Ref: #comments25719 Node: Tags26889 Ref: #tags27007 Node: Directives28409 Ref: #directives28552 Node: Comment blocks34159 Ref: #comment-blocks34304 Node: Including other files34480 Ref: #including-other-files34660 Node: Default year35068 Ref: #default-year35237 Node: Declaring commodities35660 Ref: #declaring-commodities35843 Node: Default commodity37070 Ref: #default-commodity37246 Node: Market prices37882 Ref: #market-prices38047 Node: Declaring accounts38888 Ref: #declaring-accounts39064 Node: Account types40021 Ref: #account-types40170 Node: Account comments41244 Ref: #account-comments41429 Node: Account display order41750 Ref: #account-display-order41923 Node: Rewriting accounts43045 Ref: #rewriting-accounts43230 Node: Basic aliases43964 Ref: #basic-aliases44110 Node: Regex aliases44814 Ref: #regex-aliases44985 Node: Multiple aliases45703 Ref: #multiple-aliases45878 Node: end aliases46376 Ref: #end-aliases46523 Node: Default parent account46624 Ref: #default-parent-account46790 Node: Periodic transactions47674 Ref: #periodic-transactions47856 Node: Forecasting with periodic transactions49559 Ref: #forecasting-with-periodic-transactions49802 Node: Budgeting with periodic transactions51489 Ref: #budgeting-with-periodic-transactions51728 Node: Transaction Modifiers52187 Ref: #transaction-modifiers52350 Node: EDITOR SUPPORT54331 Ref: #editor-support54449  End Tag Table hledger-lib-1.12/hledger_timedot.50000644000000000000000000001067413401102734015231 0ustar0000000000000000 .TH "hledger_timedot" "5" "December 2018" "hledger 1.12" "hledger User Manuals" .SH NAME .PP Timedot \- hledger'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 \[lq]timedot\[rq], 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. .SH FILE FORMAT .PP A timedot file contains a series of day entries. A day entry begins with a date, and is followed by category/quantity pairs, one per line. Dates are hledger\-style simple dates (see hledger_journal(5)). Categories are hledger\-style account names, optionally indented. As in a hledger journal, there must be at least two spaces between the category (account name) and the quantity. .PP Quantities can be written as: .IP \[bu] 2 a sequence of dots (.) representing quarter hours. Spaces may optionally be used for grouping and readability. 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[], \f[C]m\f[], \f[C]h\f[], \f[C]d\f[], \f[C]w\f[], \f[C]mo\f[], or \f[C]y\f[], 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 Blank lines and lines beginning with #, ; or * are ignored. An example: .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[] .fi .PP Or with numbers: .IP .nf \f[C] 2016/2/3 inc:client1\ \ \ 4 fos:hledger\ \ \ 3 biz:research\ \ 1 \f[] .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[] .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[] .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[] .fi .IP .nf \f[C] $\ hledger\ \-f\ t.timedot\ \-\-alias\ /\\\\./=:\ bal\ date:2016/2/4 \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 4.50\ \ fos \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 4.00\ \ \ \ hledger:timedot \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 0.50\ \ \ \ ledger \-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\- \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 4.50 \f[] .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-2016 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.12/hledger_timedot.txt0000644000000000000000000001106313401102736015677 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 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 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. FILE FORMAT A timedot file contains a series of day entries. A day entry begins with a date, and is followed by category/quantity pairs, one per line. Dates are hledger-style simple dates (see hledger_journal(5)). Cate- gories are hledger-style account names, optionally indented. As in a hledger journal, there must be at least two spaces between the category (account name) and the quantity. Quantities can be written as: o a sequence of dots (.) representing quarter hours. Spaces may optionally be used for grouping and readability. 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. Blank lines and lines beginning with #, ; or * are ignored. An exam- ple: # 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 . Or with numbers: 2016/2/3 inc:client1 4 fos:hledger 3 biz:research 1 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-2016 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.12 December 2018 hledger_timedot(5) hledger-lib-1.12/hledger_timedot.info0000644000000000000000000000674613401102727016027 0ustar0000000000000000This is hledger_timedot.info, produced by makeinfo version 6.5 from stdin.  File: hledger_timedot.info, Node: Top, Next: FILE FORMAT, Up: (dir) hledger_timedot(5) hledger 1.12 ******************************* 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. * Menu: * FILE FORMAT::  File: hledger_timedot.info, Node: FILE FORMAT, Prev: Top, Up: Top 1 FILE FORMAT ************* A timedot file contains a series of day entries. A day entry begins with a date, and is followed by category/quantity pairs, one per line. Dates are hledger-style simple dates (see hledger_journal(5)). Categories are hledger-style account names, optionally indented. As in a hledger journal, there must be at least two spaces between the category (account name) and the quantity. Quantities can be written as: * a sequence of dots (.) representing quarter hours. Spaces may optionally be used for grouping and readability. 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. Blank lines and lines beginning with #, ; or * are ignored. An example: # 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 . Or with numbers: 2016/2/3 inc:client1 4 fos:hledger 3 biz:research 1 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 Node: FILE FORMAT807 Ref: #file-format908  End Tag Table hledger-lib-1.12/hledger_timeclock.50000644000000000000000000000557613401102734015543 0ustar0000000000000000 .TH "hledger_timeclock" "5" "December 2018" "hledger 1.12" "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'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[] .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[] 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[] .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[] .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="echo\ i\ `date\ \[aq]+%Y\-%m\-%d\ %H:%M:%S\[aq]`\ \\$*\ >>$TIMELOG"\ \ \ alias\ to="echo\ o\ `date\ \[aq]+%Y\-%m\-%d\ %H:%M:%S\[aq]`\ >>$TIMELOG"\f[] .IP \[bu] 2 or use the old \f[C]ti\f[] and \f[C]to\f[] scripts in the ledger 2.x repository. These rely on a \[lq]timeclock\[rq] 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-2016 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.12/hledger_timeclock.txt0000644000000000000000000000603213401102736016204 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 time- clock-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-2016 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.12 December 2018 hledger_timeclock(5) hledger-lib-1.12/hledger_timeclock.info0000644000000000000000000000426413401102730016317 0ustar0000000000000000This is hledger_timeclock.info, produced by makeinfo version 6.5 from stdin.  File: hledger_timeclock.info, Node: Top, Up: (dir) hledger_timeclock(5) hledger 1.12 ********************************* 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