diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 88361af9f..bca6b5a05 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -123,7 +123,7 @@ nullfilterspec = FilterSpec { ,acctpats=[] ,descpats=[] ,depth=Nothing - ,metadata=[] + ,fMetadata=[] } journalFilePath :: Journal -> FilePath @@ -235,7 +235,7 @@ filterJournalTransactions FilterSpec{datespan=datespan ,acctpats=apats ,descpats=dpats ,depth=depth - ,metadata=md + ,fMetadata=md } = filterJournalTransactionsByClearedStatus cleared . filterJournalPostingsByDepth depth . @@ -254,7 +254,7 @@ filterJournalPostings FilterSpec{datespan=datespan ,acctpats=apats ,descpats=dpats ,depth=depth - ,metadata=md + ,fMetadata=md } = filterJournalPostingsByRealness real . filterJournalPostingsByClearedStatus cleared . diff --git a/hledger-lib/Hledger/Data/Ledger.hs b/hledger-lib/Hledger/Data/Ledger.hs index d737b7e1c..caab59276 100644 --- a/hledger-lib/Hledger/Data/Ledger.hs +++ b/hledger-lib/Hledger/Data/Ledger.hs @@ -25,24 +25,24 @@ import Hledger.Data.Query instance Show Ledger where show l = printf "Ledger with %d transactions, %d accounts\n%s" - (length (jtxns $ journal l) + - length (jmodifiertxns $ journal l) + - length (jperiodictxns $ journal l)) - (length $ accountnames l) - (showtree $ accountnametree l) + (length (jtxns $ ledgerJournal l) + + length (jmodifiertxns $ ledgerJournal l) + + length (jperiodictxns $ ledgerJournal l)) + (length $ ledgerAccountNames l) + (showtree $ ledgerAccountNameTree l) nullledger :: Ledger nullledger = Ledger{ - journal = nulljournal, - accountnametree = nullaccountnametree, - accountmap = fromList [] + ledgerJournal = nulljournal, + ledgerAccountNameTree = nullaccountnametree, + ledgerAccountMap = fromList [] } -- | Filter a journal's transactions as specified, and then process them -- to derive a ledger containing all balances, the chart of accounts, -- canonicalised commodities etc. journalToLedger :: FilterSpec -> Journal -> Ledger -journalToLedger fs j = nullledger{journal=j',accountnametree=t,accountmap=m} +journalToLedger fs j = nullledger{ledgerJournal=j',ledgerAccountNameTree=t,ledgerAccountMap=m} where j' = filterJournalPostings fs{depth=Nothing} j (t, m) = journalAccountInfo j' @@ -51,17 +51,17 @@ journalToLedger fs j = nullledger{journal=j',accountnametree=t,accountmap=m} -- canonicalised commodities etc. -- Like journalToLedger but uses the new queries. journalToLedger2 :: Query -> Journal -> Ledger -journalToLedger2 m j = nullledger{journal=j',accountnametree=t,accountmap=amap} +journalToLedger2 m j = nullledger{ledgerJournal=j',ledgerAccountNameTree=t,ledgerAccountMap=amap} where j' = filterJournalPostings2 m j (t, amap) = journalAccountInfo j' -- | List a ledger's account names. ledgerAccountNames :: Ledger -> [AccountName] -ledgerAccountNames = drop 1 . flatten . accountnametree +ledgerAccountNames = drop 1 . flatten . ledgerAccountNameTree -- | Get the named account from a ledger. ledgerAccount :: Ledger -> AccountName -> Account -ledgerAccount l a = findWithDefault nullacct a $ accountmap l +ledgerAccount l a = findWithDefault nullacct a $ ledgerAccountMap l -- | List a ledger's accounts, in tree order ledgerAccounts :: Ledger -> [Account] @@ -77,20 +77,20 @@ ledgerLeafAccounts = leaves . ledgerAccountTree 9999 -- | Accounts in ledger whose name matches the pattern, in tree order. ledgerAccountsMatching :: [String] -> Ledger -> [Account] -ledgerAccountsMatching pats = filter (matchpats pats . aname) . accounts +ledgerAccountsMatching pats = filter (matchpats pats . aname) . ledgerAccounts -- | List a ledger account's immediate subaccounts ledgerSubAccounts :: Ledger -> Account -> [Account] ledgerSubAccounts l Account{aname=a} = - map (ledgerAccount l) $ filter (`isSubAccountNameOf` a) $ accountnames l + map (ledgerAccount l) $ filter (`isSubAccountNameOf` a) $ ledgerAccountNames l -- | List a ledger's postings, in the order parsed. ledgerPostings :: Ledger -> [Posting] -ledgerPostings = journalPostings . journal +ledgerPostings = journalPostings . ledgerJournal -- | Get a ledger's tree of accounts to the specified depth. ledgerAccountTree :: Int -> Ledger -> Tree Account -ledgerAccountTree depth l = treemap (ledgerAccount l) $ treeprune depth $ accountnametree l +ledgerAccountTree depth l = treemap (ledgerAccount l) $ treeprune depth $ ledgerAccountNameTree l -- | Get a ledger's tree of accounts rooted at the specified account. ledgerAccountTreeAt :: Ledger -> Account -> Maybe (Tree Account) @@ -101,6 +101,9 @@ ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l ledgerDateSpan :: Ledger -> DateSpan ledgerDateSpan = postingsDateSpan . ledgerPostings +-- | All commodities used in this ledger, as a map keyed by symbol. +ledgerCommodities :: Ledger -> Map String Commodity +ledgerCommodities = journalCanonicalCommodities . ledgerJournal tests_Hledger_Data_Ledger = TestList [ diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 6135f8564..d3de8a9b6 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -69,6 +69,8 @@ data Commodity = Commodity { separatorpositions :: [Int] -- ^ positions of separators, counting leftward from decimal point } deriving (Eq,Ord,Show,Read) +type Quantity = Double + -- | An amount's price in another commodity may be written as \@ unit -- price or \@\@ total price. Note although a MixedAmount is used, it -- should be in a single commodity, also the amount should be positive; @@ -78,7 +80,7 @@ data Price = UnitPrice MixedAmount | TotalPrice MixedAmount data Amount = Amount { commodity :: Commodity, - quantity :: Double, + quantity :: Quantity, price :: Maybe Price -- ^ the price for this amount at posting time } deriving (Eq,Ord) @@ -243,9 +245,9 @@ data FormatString = data Ledger = Ledger { - journal :: Journal, - accountnametree :: Tree AccountName, - accountmap :: Map.Map AccountName Account + ledgerJournal :: Journal, + ledgerAccountNameTree :: Tree AccountName, + ledgerAccountMap :: Map.Map AccountName Account } data Account = Account { @@ -263,6 +265,6 @@ data FilterSpec = FilterSpec { ,acctpats :: [String] -- ^ only include if matching these account patterns ,descpats :: [String] -- ^ only include if matching these description patterns ,depth :: Maybe Int - ,metadata :: [(String,String)] -- ^ only include if matching these metadata + ,fMetadata :: [(String,String)] -- ^ only include if matching these metadata } deriving (Show) diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index 5ab57dc9f..59654c1f2 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -16,8 +16,8 @@ module Hledger.Read ( requireJournalFileExists, ensureJournalFileExists, -- * Parsers used elsewhere - ledgeraccountname, - someamount, + accountname, + amount, -- * Tests tests_Hledger_Read, ) @@ -178,9 +178,9 @@ tests_Hledger_Read = TestList tests_Hledger_Read_TimelogReader, tests_Hledger_Read_CsvReader, - "journalFile" ~: do - assertBool "journalFile should parse an empty file" (isRight $ parseWithCtx nullctx JournalReader.journalFile "") - jE <- readJournal Nothing Nothing Nothing "" -- don't know how to get it from journalFile - either error' (assertBool "journalFile parsing an empty file should give an empty journal" . null . jtxns) jE + "journal" ~: do + assertBool "journal should parse an empty file" (isRight $ parseWithCtx nullctx JournalReader.journal "") + jE <- readJournal Nothing Nothing Nothing "" -- don't know how to get it from journal + either error' (assertBool "journal parsing an empty file should give an empty journal" . null . jtxns) jE ] diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 898fff8f4..a8700c53d 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -54,7 +54,7 @@ import Prelude hiding (getContents) import Hledger.Utils.UTF8IOCompat (getContents) import Hledger.Utils import Hledger.Data.FormatStrings as FormatStrings -import Hledger.Read.JournalReader (ledgeraccountname, someamount) +import Hledger.Read.JournalReader (accountname, amount) reader :: Reader @@ -339,7 +339,7 @@ basecurrency = do baseaccount = do string "base-account" many1 spacenonewline - v <- ledgeraccountname + v <- accountname optional newline updateState (\r -> r{baseAccount=v}) @@ -349,7 +349,7 @@ accountrule = do pats <- many1 matchreplacepattern guard $ length pats >= 2 let pats' = init pats - acct = either (fail.show) id $ runParser ledgeraccountname () "" $ fst $ last pats + acct = either (fail.show) id $ runParser accountname () "" $ fst $ last pats many blankorcommentline return (pats',acct) "account rule" @@ -419,11 +419,11 @@ transactionFromCsvRecord rules fields = strnegate s = '-':s currency = maybe (fromMaybe "" $ baseCurrency rules) (atDef "" fields) (currencyField rules) amountstr'' = currency ++ amountstr' - amountparse = runParser someamount nullctx "" amountstr'' - amount = either (const nullmixedamt) id amountparse + amountparse = runParser amount nullctx "" amountstr'' + a = either (const nullmixedamt) id amountparse -- Using costOfMixedAmount here to allow complex costs like "10 GBP @@ 15 USD". -- Aim is to have "10 GBP @@ 15 USD" applied to account "acct", but have "-15USD" applied to "baseacct" - baseamount = costOfMixedAmount amount + baseamount = costOfMixedAmount a unknownacct | (readDef 0 amountstr' :: Double) < 0 = "income:unknown" | otherwise = "expenses:unknown" (acct',newdesc) = identify (accountRules rules) unknownacct desc @@ -441,7 +441,7 @@ transactionFromCsvRecord rules fields = Posting { pstatus=False, paccount=acct, - pamount=amount, + pamount=a, pcomment="", ptype=RegularPosting, pmetadata=[], diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index d5f40afee..bfc9d2219 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -19,16 +19,16 @@ module Hledger.Read.JournalReader ( -- * Reader reader, -- * Parsers used elsewhere - emptyLine, - journalFile, - ledgeraccountname, - ledgerdatetime, - ledgerDefaultYear, - ledgerDirective, - ledgerHistoricalPrice, - someamount, parseJournalWith, getParentAccount, + journal, + directive, + defaultyeardirective, + historicalpricedirective, + datetime, + accountname, + amount, + emptyline, -- * Tests tests_Hledger_Read_JournalReader ) @@ -40,11 +40,8 @@ import Data.List import Data.List.Split (wordsBy) import Data.Maybe import Data.Time.Calendar --- import Data.Time.Clock --- import Data.Time.Format import Data.Time.LocalTime import Safe (headDef) --- import System.Locale (defaultTimeLocale) import Test.HUnit import Text.ParserCombinators.Parsec hiding (parse) import Text.Printf @@ -57,7 +54,7 @@ import Prelude hiding (readFile) import Hledger.Utils.UTF8IOCompat (readFile) --- let's get to it +-- standard reader exports reader :: Reader reader = Reader format detect parse @@ -72,7 +69,7 @@ detect f _ = takeExtension f == format -- | Parse and post-process a "Journal" from hledger's journal file -- format, or give an error. parse :: Maybe FilePath -> FilePath -> String -> ErrorT String IO Journal -parse _ = parseJournalWith journalFile +parse _ = parseJournalWith journal -- parsing utils @@ -129,13 +126,13 @@ getAccountAliases = liftM ctxAliases getState clearAccountAliases :: GenParser tok JournalContext () clearAccountAliases = updateState (\(ctx@Ctx{..}) -> ctx{ctxAliases=[]}) --- +-- parsers -- | Top-level journal parser. Returns a single composite, I/O performing, -- error-raising "JournalUpdate" (and final "JournalContext") which can be -- applied to an empty journal to get the final result. -journalFile :: GenParser Char JournalContext (JournalUpdate,JournalContext) -journalFile = do +journal :: GenParser Char JournalContext (JournalUpdate,JournalContext) +journal = do journalupdates <- many journalItem eof finalctx <- getState @@ -144,56 +141,57 @@ journalFile = do -- As all journal line types can be distinguished by the first -- character, excepting transactions versus empty (blank or -- comment-only) lines, can use choice w/o try - journalItem = choice [ ledgerDirective - , liftM (return . addTransaction) ledgerTransaction - , liftM (return . addModifierTransaction) ledgerModifierTransaction - , liftM (return . addPeriodicTransaction) ledgerPeriodicTransaction - , liftM (return . addHistoricalPrice) ledgerHistoricalPrice - , emptyLine >> return (return id) + journalItem = choice [ directive + , liftM (return . addTransaction) transaction + , liftM (return . addModifierTransaction) modifiertransaction + , liftM (return . addPeriodicTransaction) periodictransaction + , liftM (return . addHistoricalPrice) historicalpricedirective + , emptyline >> return (return id) ] "journal transaction or directive" -emptyLine :: GenParser Char JournalContext () -emptyLine = do many spacenonewline +emptyline :: GenParser Char JournalContext () +emptyline = do many spacenonewline optional $ (char ';' "comment") >> many (noneOf "\n") newline return () -ledgercomment :: GenParser Char JournalContext String -ledgercomment = do +comment :: GenParser Char JournalContext String +comment = do many1 $ char ';' many spacenonewline many (noneOf "\n") "comment" -ledgercommentline :: GenParser Char JournalContext String -ledgercommentline = do +commentline :: GenParser Char JournalContext String +commentline = do many spacenonewline - s <- ledgercomment + s <- comment optional newline eof return s "comment" -ledgerDirective :: GenParser Char JournalContext JournalUpdate -ledgerDirective = do +-- cf http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives +directive :: GenParser Char JournalContext JournalUpdate +directive = do optional $ char '!' choice' [ - ledgerInclude - ,ledgerAlias - ,ledgerEndAliases - ,ledgerAccountBegin - ,ledgerAccountEnd - ,ledgerTagDirective - ,ledgerEndTagDirective - ,ledgerDefaultYear - ,ledgerDefaultCommodity - ,ledgerCommodityConversion - ,ledgerIgnoredPriceCommodity + includedirective + ,aliasdirective + ,endaliasesdirective + ,accountdirective + ,enddirective + ,tagdirective + ,endtagdirective + ,defaultyeardirective + ,defaultcommoditydirective + ,commodityconversiondirective + ,ignoredpricecommoditydirective ] "directive" -ledgerInclude :: GenParser Char JournalContext JournalUpdate -ledgerInclude = do +includedirective :: GenParser Char JournalContext JournalUpdate +includedirective = do string "include" many1 spacenonewline filename <- restofline @@ -202,7 +200,7 @@ ledgerInclude = do return $ do filepath <- expandPath outerPos filename txt <- readFileOrError outerPos filepath let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n" - case runParser journalFile outerState filepath txt of + case runParser journal outerState filepath txt of Right (ju,_) -> combineJournalUpdates [return $ journalAddFile (filepath,txt), ju] `catchError` (throwError . (inIncluded ++)) Left err -> throwError $ inIncluded ++ show err where readFileOrError pos fp = @@ -212,23 +210,23 @@ ledgerInclude = do journalAddFile :: (FilePath,String) -> Journal -> Journal journalAddFile f j@Journal{files=fs} = j{files=fs++[f]} -ledgerAccountBegin :: GenParser Char JournalContext JournalUpdate -ledgerAccountBegin = do +accountdirective :: GenParser Char JournalContext JournalUpdate +accountdirective = do string "account" many1 spacenonewline - parent <- ledgeraccountname + parent <- accountname newline pushParentAccount parent return $ return id -ledgerAccountEnd :: GenParser Char JournalContext JournalUpdate -ledgerAccountEnd = do +enddirective :: GenParser Char JournalContext JournalUpdate +enddirective = do string "end" popParentAccount return (return id) -ledgerAlias :: GenParser Char JournalContext JournalUpdate -ledgerAlias = do +aliasdirective :: GenParser Char JournalContext JournalUpdate +aliasdirective = do string "alias" many1 spacenonewline orig <- many1 $ noneOf "=" @@ -238,28 +236,28 @@ ledgerAlias = do ,accountNameWithoutPostingType $ strip alias) return $ return id -ledgerEndAliases :: GenParser Char JournalContext JournalUpdate -ledgerEndAliases = do +endaliasesdirective :: GenParser Char JournalContext JournalUpdate +endaliasesdirective = do string "end aliases" clearAccountAliases return (return id) -ledgerTagDirective :: GenParser Char JournalContext JournalUpdate -ledgerTagDirective = do +tagdirective :: GenParser Char JournalContext JournalUpdate +tagdirective = do string "tag" "tag directive" many1 spacenonewline _ <- many1 nonspace restofline return $ return id -ledgerEndTagDirective :: GenParser Char JournalContext JournalUpdate -ledgerEndTagDirective = do +endtagdirective :: GenParser Char JournalContext JournalUpdate +endtagdirective = do (string "end tag" <|> string "pop") "end tag or pop directive" restofline return $ return id -ledgerDefaultYear :: GenParser Char JournalContext JournalUpdate -ledgerDefaultYear = do +defaultyeardirective :: GenParser Char JournalContext JournalUpdate +defaultyeardirective = do char 'Y' "default year" many spacenonewline y <- many1 digit @@ -268,84 +266,84 @@ ledgerDefaultYear = do setYear y' return $ return id -ledgerDefaultCommodity :: GenParser Char JournalContext JournalUpdate -ledgerDefaultCommodity = do +defaultcommoditydirective :: GenParser Char JournalContext JournalUpdate +defaultcommoditydirective = do char 'D' "default commodity" many1 spacenonewline - a <- someamount - -- someamount always returns a MixedAmount containing one Amount, but let's be safe + a <- amount + -- amount always returns a MixedAmount containing one Amount, but let's be safe let as = amounts a when (not $ null as) $ setCommodity $ commodity $ head as restofline return $ return id -ledgerHistoricalPrice :: GenParser Char JournalContext HistoricalPrice -ledgerHistoricalPrice = do +historicalpricedirective :: GenParser Char JournalContext HistoricalPrice +historicalpricedirective = do char 'P' "historical price" many spacenonewline - date <- try (do {LocalTime d _ <- ledgerdatetime; return d}) <|> ledgerdate -- a time is ignored + date <- try (do {LocalTime d _ <- datetime; return d}) <|> date -- a time is ignored many1 spacenonewline symbol <- commoditysymbol many spacenonewline - price <- someamount + price <- amount restofline return $ HistoricalPrice date symbol price -ledgerIgnoredPriceCommodity :: GenParser Char JournalContext JournalUpdate -ledgerIgnoredPriceCommodity = do +ignoredpricecommoditydirective :: GenParser Char JournalContext JournalUpdate +ignoredpricecommoditydirective = do char 'N' "ignored-price commodity" many1 spacenonewline commoditysymbol restofline return $ return id -ledgerCommodityConversion :: GenParser Char JournalContext JournalUpdate -ledgerCommodityConversion = do +commodityconversiondirective :: GenParser Char JournalContext JournalUpdate +commodityconversiondirective = do char 'C' "commodity conversion" many1 spacenonewline - someamount + amount many spacenonewline char '=' many spacenonewline - someamount + amount restofline return $ return id -ledgerModifierTransaction :: GenParser Char JournalContext ModifierTransaction -ledgerModifierTransaction = do +modifiertransaction :: GenParser Char JournalContext ModifierTransaction +modifiertransaction = do char '=' "modifier transaction" many spacenonewline valueexpr <- restofline - postings <- ledgerpostings + postings <- postings return $ ModifierTransaction valueexpr postings -ledgerPeriodicTransaction :: GenParser Char JournalContext PeriodicTransaction -ledgerPeriodicTransaction = do +periodictransaction :: GenParser Char JournalContext PeriodicTransaction +periodictransaction = do char '~' "periodic transaction" many spacenonewline periodexpr <- restofline - postings <- ledgerpostings + postings <- postings return $ PeriodicTransaction periodexpr postings -- | Parse a (possibly unbalanced) ledger transaction. -ledgerTransaction :: GenParser Char JournalContext Transaction -ledgerTransaction = do - date <- ledgerdate "transaction" - edate <- optionMaybe (ledgereffectivedate date) "effective date" - status <- ledgerstatus "cleared flag" - code <- ledgercode "transaction code" +transaction :: GenParser Char JournalContext Transaction +transaction = do + date <- date "transaction" + edate <- optionMaybe (effectivedate date) "effective date" + status <- status "cleared flag" + code <- code "transaction code" (description, comment) <- - (do {many1 spacenonewline; d <- liftM rstrip (many (noneOf ";\n")); c <- ledgercomment <|> return ""; newline; return (d, c)} <|> - do {many spacenonewline; c <- ledgercomment <|> return ""; newline; return ("", c)} + (do {many1 spacenonewline; d <- liftM rstrip (many (noneOf ";\n")); c <- comment <|> return ""; newline; return (d, c)} <|> + do {many spacenonewline; c <- comment <|> return ""; newline; return ("", c)} ) "description and/or comment" - md <- try ledgermetadata <|> return [] - postings <- ledgerpostings + md <- try metadata <|> return [] + postings <- postings return $ txnTieKnot $ Transaction date edate status code description comment md postings "" -- | Parse a date in YYYY/MM/DD format. Fewer digits are allowed. The year -- may be omitted if a default year has already been set. -ledgerdate :: GenParser Char JournalContext Day -ledgerdate = do +date :: GenParser Char JournalContext Day +date = do -- hacky: try to ensure precise errors for invalid dates -- XXX reported error position is not too good -- pos <- getPosition @@ -367,9 +365,9 @@ ledgerdate = do -- timezone will be ignored; the time is treated as local time. Fewer -- digits are allowed, except in the timezone. The year may be omitted if -- a default year has already been set. -ledgerdatetime :: GenParser Char JournalContext LocalTime -ledgerdatetime = do - day <- ledgerdate +datetime :: GenParser Char JournalContext LocalTime +datetime = do + day <- date many1 spacenonewline h <- many1 digit let h' = read h @@ -395,8 +393,8 @@ ledgerdatetime = do -- return $ localTimeToUTC tz' $ LocalTime day $ TimeOfDay h' m' (fromIntegral s') return $ LocalTime day $ TimeOfDay h' m' (fromIntegral s') -ledgereffectivedate :: Day -> GenParser Char JournalContext Day -ledgereffectivedate actualdate = do +effectivedate :: Day -> GenParser Char JournalContext Day +effectivedate actualdate = do char '=' -- kludgy way to use actual date for default year let withDefaultYear d p = do @@ -405,22 +403,22 @@ ledgereffectivedate actualdate = do r <- p when (isJust y) $ setYear $ fromJust y return r - edate <- withDefaultYear actualdate ledgerdate + edate <- withDefaultYear actualdate date return edate -ledgerstatus :: GenParser Char JournalContext Bool -ledgerstatus = try (do { many spacenonewline; char '*' "status"; return True } ) <|> return False +status :: GenParser Char JournalContext Bool +status = try (do { many spacenonewline; char '*' "status"; return True } ) <|> return False -ledgercode :: GenParser Char JournalContext String -ledgercode = try (do { many1 spacenonewline; char '(' "code"; code <- anyChar `manyTill` char ')'; return code } ) <|> return "" +code :: GenParser Char JournalContext String +code = try (do { many1 spacenonewline; char '(' "code"; code <- anyChar `manyTill` char ')'; return code } ) <|> return "" -ledgermetadata :: GenParser Char JournalContext [(String,String)] -ledgermetadata = many $ try ledgermetadataline +metadata :: GenParser Char JournalContext [(String,String)] +metadata = many $ try metadataline -- a comment line containing a metadata declaration, eg: -- ; name: value -ledgermetadataline :: GenParser Char JournalContext (String,String) -ledgermetadataline = do +metadataline :: GenParser Char JournalContext (String,String) +metadataline = do many1 spacenonewline many1 $ char ';' many spacenonewline @@ -435,22 +433,22 @@ ledgermetadataline = do -- Parse the following whitespace-beginning lines as postings, posting metadata, and/or comments. -- complicated to handle intermixed comment and metadata lines.. make me better ? -ledgerpostings :: GenParser Char JournalContext [Posting] -ledgerpostings = do +postings :: GenParser Char JournalContext [Posting] +postings = do ctx <- getState -- we'll set the correct position for sub-parses for more useful errors pos <- getPosition ls <- many1 $ try linebeginningwithspaces let lsnumbered = zip ls [0..] parses p = isRight . parseWithCtx ctx p - postinglines = filter (not . (ledgercommentline `parses`) . fst) lsnumbered + postinglines = filter (not . (commentline `parses`) . fst) lsnumbered -- group any metadata lines with the posting line above postinglinegroups :: [(String,Line)] -> [(String,Line)] postinglinegroups [] = [] postinglinegroups ((pline,num):ls) = (unlines (pline:(map fst mdlines)), num):postinglinegroups rest - where (mdlines,rest) = span ((ledgermetadataline `parses`) . fst) ls + where (mdlines,rest) = span ((metadataline `parses`) . fst) ls pstrs = postinglinegroups postinglines - parseNumberedPostingLine (str,num) = fromparse $ parseWithCtx ctx (setPosition (incSourceLine pos num) >> ledgerposting) str + parseNumberedPostingLine (str,num) = fromparse $ parseWithCtx ctx (setPosition (incSourceLine pos num) >> posting) str when (null pstrs) $ fail "no postings" return $ map parseNumberedPostingLine pstrs "postings" @@ -462,24 +460,24 @@ linebeginningwithspaces = do cs <- restofline return $ sp ++ (c:cs) ++ "\n" -ledgerposting :: GenParser Char JournalContext Posting -ledgerposting = do +posting :: GenParser Char JournalContext Posting +posting = do many1 spacenonewline - status <- ledgerstatus + status <- status many spacenonewline account <- modifiedaccountname let (ptype, account') = (accountNamePostingType account, unbracket account) - amount <- postingamount + amount <- spaceandamountormissing many spacenonewline - comment <- ledgercomment <|> return "" + comment <- comment <|> return "" newline - md <- ledgermetadata + md <- metadata return (Posting status account' amount comment ptype md Nothing) --- Parse an account name, then apply any parent account prefix and/or account aliases currently in effect. +-- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect. modifiedaccountname :: GenParser Char JournalContext AccountName modifiedaccountname = do - a <- ledgeraccountname + a <- accountname prefix <- getParentAccount let prefixed = prefix `joinAccountNames` a aliases <- getAccountAliases @@ -489,8 +487,8 @@ modifiedaccountname = do -- them, and are terminated by two or more spaces. They should have one or -- more components of at least one character, separated by the account -- separator char. -ledgeraccountname :: GenParser Char st AccountName -ledgeraccountname = do +accountname :: GenParser Char st AccountName +accountname = do a <- many1 (nonspace <|> singlespace) let a' = striptrailingspace a when (accountNameFromComponents (accountNameComponents a') /= a') @@ -504,17 +502,51 @@ ledgeraccountname = do -- accountnamechar = notFollowedBy (oneOf "()[]") >> nonspace -- "account name character (non-bracket, non-parenthesis, non-whitespace)" --- | Parse an amount, with an optional left or right currency symbol and --- optional price. -postingamount :: GenParser Char JournalContext MixedAmount -postingamount = +-- | Parse whitespace then an amount, with an optional left or right +-- currency symbol and optional price, or return the special +-- "missing"" marker amount. +spaceandamountormissing :: GenParser Char JournalContext MixedAmount +spaceandamountormissing = try (do many1 spacenonewline - someamount <|> return missingamt + amount <|> return missingamt ) <|> return missingamt -someamount :: GenParser Char JournalContext MixedAmount -someamount = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount +tests_spaceandamountormissing = [ + "spaceandamountormissing" ~: do + assertParseEqual (parseWithCtx nullctx spaceandamountormissing " $47.18") (Mixed [dollars 47.18]) + assertParseEqual (parseWithCtx nullctx spaceandamountormissing "$47.18") missingamt + assertParseEqual (parseWithCtx nullctx spaceandamountormissing " ") missingamt + assertParseEqual (parseWithCtx nullctx spaceandamountormissing "") missingamt + ] + +-- | Parse an amount, with an optional left or right currency symbol and +-- optional price. +amount :: GenParser Char JournalContext MixedAmount +amount = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount + +tests_amount = [ + "amount" ~: do + assertParseEqual (parseWithCtx nullctx amount "$47.18") (Mixed [dollars 47.18]) + assertParseEqual (parseWithCtx nullctx amount "$1.") + (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,decimalpoint='.',precision=0,separator=',',separatorpositions=[]} 1 Nothing]) + ,"amount with unit price" ~: do + assertParseEqual + (parseWithCtx nullctx amount "$10 @ €0.5") + (Mixed [Amount{commodity=dollar{precision=0}, + quantity=10, + price=(Just $ UnitPrice $ Mixed [Amount{commodity=euro{precision=1}, + quantity=0.5, + price=Nothing}])}]) + ,"amount with total price" ~: do + assertParseEqual + (parseWithCtx nullctx amount "$10 @@ €5") + (Mixed [Amount{commodity=dollar{precision=0}, + quantity=10, + price=(Just $ TotalPrice $ Mixed [Amount{commodity=euro{precision=0}, + quantity=5, + price=Nothing}])}]) + ] leftsymbolamount :: GenParser Char JournalContext MixedAmount leftsymbolamount = do @@ -568,56 +600,14 @@ priceamount = try (do char '@' many spacenonewline - a <- someamount -- XXX can parse more prices ad infinitum, shouldn't + a <- amount -- XXX can parse more prices ad infinitum, shouldn't return $ Just $ TotalPrice a) <|> (do many spacenonewline - a <- someamount -- XXX can parse more prices ad infinitum, shouldn't + a <- amount -- XXX can parse more prices ad infinitum, shouldn't return $ Just $ UnitPrice a)) <|> return Nothing --- gawd.. trying to parse a ledger number without error: - -type Quantity = Double - --- -- | Parse a ledger-style numeric quantity and also return the number of --- -- digits to the right of the decimal point and whether thousands are --- -- separated by comma. --- amountquantity :: GenParser Char JournalContext (Quantity, Int, Bool) --- amountquantity = do --- sign <- optionMaybe $ string "-" --- (intwithcommas,frac) <- numberparts --- let comma = ',' `elem` intwithcommas --- let precision = length frac --- -- read the actual value. We expect this read to never fail. --- let int = filter (/= ',') intwithcommas --- let int' = if null int then "0" else int --- let frac' = if null frac then "0" else frac --- let sign' = fromMaybe "" sign --- let quantity = read $ sign'++int'++"."++frac' --- return (quantity, precision, comma) --- "commodity quantity" - --- -- | parse the two strings of digits before and after a possible decimal --- -- point. The integer part may contain commas, or either part may be --- -- empty, or there may be no point. --- numberparts :: GenParser Char JournalContext (String,String) --- numberparts = numberpartsstartingwithdigit <|> numberpartsstartingwithpoint - --- numberpartsstartingwithdigit :: GenParser Char JournalContext (String,String) --- numberpartsstartingwithdigit = do --- let digitorcomma = digit <|> char ',' --- first <- digit --- rest <- many digitorcomma --- frac <- try (do {char '.'; many digit}) <|> return "" --- return (first:rest,frac) - --- numberpartsstartingwithpoint :: GenParser Char JournalContext (String,String) --- numberpartsstartingwithpoint = do --- char '.' --- frac <- many1 digit --- return ("",frac) - -- | Parse a numeric quantity for its value and display attributes. Some -- international number formats (cf -- http://en.wikipedia.org/wiki/Decimal_separator) are accepted: either @@ -667,8 +657,10 @@ number = do return (quantity,precision,decimalpoint,separator,separatorpositions) "number" -tests_Hledger_Read_JournalReader = TestList [ - +tests_Hledger_Read_JournalReader = TestList $ concat [ + tests_amount, + tests_spaceandamountormissing, + [ "number" ~: do let s `is` n = assertParseEqual (parseWithCtx nullctx number s) n assertFails = assertBool "" . isLeft . parseWithCtx nullctx number @@ -691,39 +683,39 @@ tests_Hledger_Read_JournalReader = TestList [ assertFails ".1," assertFails ",1." - ,"ledgerTransaction" ~: do - assertParseEqual (parseWithCtx nullctx ledgerTransaction entry1_str) entry1 - assertBool "ledgerTransaction should not parse just a date" - $ isLeft $ parseWithCtx nullctx ledgerTransaction "2009/1/1\n" - assertBool "ledgerTransaction should require some postings" - $ isLeft $ parseWithCtx nullctx ledgerTransaction "2009/1/1 a\n" - let t = parseWithCtx nullctx ledgerTransaction "2009/1/1 a ;comment\n b 1\n" - assertBool "ledgerTransaction should not include a comment in the description" + ,"transaction" ~: do + assertParseEqual (parseWithCtx nullctx transaction entry1_str) entry1 + assertBool "transaction should not parse just a date" + $ isLeft $ parseWithCtx nullctx transaction "2009/1/1\n" + assertBool "transaction should require some postings" + $ isLeft $ parseWithCtx nullctx transaction "2009/1/1 a\n" + let t = parseWithCtx nullctx transaction "2009/1/1 a ;comment\n b 1\n" + assertBool "transaction should not include a comment in the description" $ either (const False) ((== "a") . tdescription) t - ,"ledgerModifierTransaction" ~: do - assertParse (parseWithCtx nullctx ledgerModifierTransaction "= (some value expr)\n some:postings 1\n") + ,"modifiertransaction" ~: do + assertParse (parseWithCtx nullctx modifiertransaction "= (some value expr)\n some:postings 1\n") - ,"ledgerPeriodicTransaction" ~: do - assertParse (parseWithCtx nullctx ledgerPeriodicTransaction "~ (some period expr)\n some:postings 1\n") + ,"periodictransaction" ~: do + assertParse (parseWithCtx nullctx periodictransaction "~ (some period expr)\n some:postings 1\n") - ,"ledgerDirective" ~: do - assertParse (parseWithCtx nullctx ledgerDirective "!include /some/file.x\n") - assertParse (parseWithCtx nullctx ledgerDirective "account some:account\n") - assertParse (parseWithCtx nullctx (ledgerDirective >> ledgerDirective) "!account a\nend\n") + ,"directive" ~: do + assertParse (parseWithCtx nullctx directive "!include /some/file.x\n") + assertParse (parseWithCtx nullctx directive "account some:account\n") + assertParse (parseWithCtx nullctx (directive >> directive) "!account a\nend\n") - ,"ledgercommentline" ~: do - assertParse (parseWithCtx nullctx ledgercommentline "; some comment \n") - assertParse (parseWithCtx nullctx ledgercommentline " \t; x\n") - assertParse (parseWithCtx nullctx ledgercommentline ";x") + ,"commentline" ~: do + assertParse (parseWithCtx nullctx commentline "; some comment \n") + assertParse (parseWithCtx nullctx commentline " \t; x\n") + assertParse (parseWithCtx nullctx commentline ";x") - ,"ledgerdate" ~: do - assertParse (parseWithCtx nullctx ledgerdate "2011/1/1") - assertParseFailure (parseWithCtx nullctx ledgerdate "1/1") - assertParse (parseWithCtx nullctx{ctxYear=Just 2011} ledgerdate "1/1") + ,"date" ~: do + assertParse (parseWithCtx nullctx date "2011/1/1") + assertParseFailure (parseWithCtx nullctx date "1/1") + assertParse (parseWithCtx nullctx{ctxYear=Just 2011} date "1/1") - ,"ledgerdatetime" ~: do - let p = do {t <- ledgerdatetime; eof; return t} + ,"datetime" ~: do + let p = do {t <- datetime; eof; return t} bad = assertParseFailure . parseWithCtx nullctx p good = assertParse . parseWithCtx nullctx p bad "2011/1/1" @@ -738,70 +730,49 @@ tests_Hledger_Read_JournalReader = TestList [ assertParseEqual (parseWithCtx nullctx p "2011/1/1 00:00-0800") startofday assertParseEqual (parseWithCtx nullctx p "2011/1/1 00:00+1234") startofday - ,"ledgerDefaultYear" ~: do - assertParse (parseWithCtx nullctx ledgerDefaultYear "Y 2010\n") - assertParse (parseWithCtx nullctx ledgerDefaultYear "Y 10001\n") + ,"defaultyeardirective" ~: do + assertParse (parseWithCtx nullctx defaultyeardirective "Y 2010\n") + assertParse (parseWithCtx nullctx defaultyeardirective "Y 10001\n") - ,"ledgerHistoricalPrice" ~: - assertParseEqual (parseWithCtx nullctx ledgerHistoricalPrice "P 2004/05/01 XYZ $55.00\n") (HistoricalPrice (parsedate "2004/05/01") "XYZ" $ Mixed [dollars 55]) + ,"historicalpricedirective" ~: + assertParseEqual (parseWithCtx nullctx historicalpricedirective "P 2004/05/01 XYZ $55.00\n") (HistoricalPrice (parsedate "2004/05/01") "XYZ" $ Mixed [dollars 55]) - ,"ledgerIgnoredPriceCommodity" ~: do - assertParse (parseWithCtx nullctx ledgerIgnoredPriceCommodity "N $\n") + ,"ignoredpricecommoditydirective" ~: do + assertParse (parseWithCtx nullctx ignoredpricecommoditydirective "N $\n") - ,"ledgerDefaultCommodity" ~: do - assertParse (parseWithCtx nullctx ledgerDefaultCommodity "D $1,000.0\n") + ,"defaultcommoditydirective" ~: do + assertParse (parseWithCtx nullctx defaultcommoditydirective "D $1,000.0\n") - ,"ledgerCommodityConversion" ~: do - assertParse (parseWithCtx nullctx ledgerCommodityConversion "C 1h = $50.00\n") + ,"commodityconversiondirective" ~: do + assertParse (parseWithCtx nullctx commodityconversiondirective "C 1h = $50.00\n") - ,"ledgerTagDirective" ~: do - assertParse (parseWithCtx nullctx ledgerTagDirective "tag foo \n") + ,"tagdirective" ~: do + assertParse (parseWithCtx nullctx tagdirective "tag foo \n") - ,"ledgerEndTagDirective" ~: do - assertParse (parseWithCtx nullctx ledgerEndTagDirective "end tag \n") - ,"ledgerEndTagDirective" ~: do - assertParse (parseWithCtx nullctx ledgerEndTagDirective "pop \n") + ,"endtagdirective" ~: do + assertParse (parseWithCtx nullctx endtagdirective "end tag \n") + ,"endtagdirective" ~: do + assertParse (parseWithCtx nullctx endtagdirective "pop \n") - ,"ledgeraccountname" ~: do - assertBool "ledgeraccountname parses a normal accountname" (isRight $ parsewith ledgeraccountname "a:b:c") - assertBool "ledgeraccountname rejects an empty inner component" (isLeft $ parsewith ledgeraccountname "a::c") - assertBool "ledgeraccountname rejects an empty leading component" (isLeft $ parsewith ledgeraccountname ":b:c") - assertBool "ledgeraccountname rejects an empty trailing component" (isLeft $ parsewith ledgeraccountname "a:b:") + ,"accountname" ~: do + assertBool "accountname parses a normal accountname" (isRight $ parsewith accountname "a:b:c") + assertBool "accountname rejects an empty inner component" (isLeft $ parsewith accountname "a::c") + assertBool "accountname rejects an empty leading component" (isLeft $ parsewith accountname ":b:c") + assertBool "accountname rejects an empty trailing component" (isLeft $ parsewith accountname "a:b:") - ,"ledgerposting" ~: do - assertParseEqual (parseWithCtx nullctx ledgerposting " expenses:food:dining $10.00\n") + ,"posting" ~: do + assertParseEqual (parseWithCtx nullctx posting " expenses:food:dining $10.00\n") (Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting [] Nothing) - assertBool "ledgerposting parses a quoted commodity with numbers" - (isRight $ parseWithCtx nullctx ledgerposting " a 1 \"DE123\"\n") + assertBool "posting parses a quoted commodity with numbers" + (isRight $ parseWithCtx nullctx posting " a 1 \"DE123\"\n") - ,"someamount" ~: do + ,"amount" ~: do let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity assertMixedAmountParse parseresult mixedamount = (either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount) - assertMixedAmountParse (parseWithCtx nullctx someamount "1 @ $2") + assertMixedAmountParse (parseWithCtx nullctx amount "1 @ $2") (Mixed [Amount unknown 1 (Just $ UnitPrice $ Mixed [Amount dollar{precision=0} 2 Nothing])]) - ,"postingamount" ~: do - assertParseEqual (parseWithCtx nullctx postingamount " $47.18") (Mixed [dollars 47.18]) - assertParseEqual (parseWithCtx nullctx postingamount " $1.") - (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,decimalpoint='.',precision=0,separator=',',separatorpositions=[]} 1 Nothing]) - ,"postingamount with unit price" ~: do - assertParseEqual - (parseWithCtx nullctx postingamount " $10 @ €0.5") - (Mixed [Amount{commodity=dollar{precision=0}, - quantity=10, - price=(Just $ UnitPrice $ Mixed [Amount{commodity=euro{precision=1}, - quantity=0.5, - price=Nothing}])}]) - ,"postingamount with total price" ~: do - assertParseEqual - (parseWithCtx nullctx postingamount " $10 @@ €5") - (Mixed [Amount{commodity=dollar{precision=0}, - quantity=10, - price=(Just $ TotalPrice $ Mixed [Amount{commodity=euro{precision=0}, - quantity=5, - price=Nothing}])}]) - ,"leftsymbolamount" ~: do assertParseEqual (parseWithCtx nullctx leftsymbolamount "$1") (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,decimalpoint='.',precision=0,separator=',',separatorpositions=[]} 1 Nothing]) @@ -810,7 +781,7 @@ tests_Hledger_Read_JournalReader = TestList [ assertParseEqual (parseWithCtx nullctx leftsymbolamount "-$1") (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,decimalpoint='.',precision=0,separator=',',separatorpositions=[]} (-1) Nothing]) - ] + ]] entry1_str = unlines ["2007/01/28 coopportunity" diff --git a/hledger-lib/Hledger/Read/TimelogReader.hs b/hledger-lib/Hledger/Read/TimelogReader.hs index 75d872298..51f13dad3 100644 --- a/hledger-lib/Hledger/Read/TimelogReader.hs +++ b/hledger-lib/Hledger/Read/TimelogReader.hs @@ -54,8 +54,9 @@ import Text.ParserCombinators.Parsec hiding (parse) import System.FilePath import Hledger.Data +-- XXX too much reuse ? import Hledger.Read.JournalReader ( - ledgerDirective, ledgerHistoricalPrice, ledgerDefaultYear, emptyLine, ledgerdatetime, + directive, historicalpricedirective, defaultyeardirective, emptyline, datetime, parseJournalWith, getParentAccount ) import Hledger.Utils @@ -86,10 +87,10 @@ timelogFile = do items <- many timelogItem -- 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 - timelogItem = choice [ ledgerDirective - , liftM (return . addHistoricalPrice) ledgerHistoricalPrice - , ledgerDefaultYear - , emptyLine >> return (return id) + timelogItem = choice [ directive + , liftM (return . addHistoricalPrice) historicalpricedirective + , defaultyeardirective + , emptyline >> return (return id) , liftM (return . addTimeLogEntry) timelogentry ] "timelog entry, or default year or historical price directive" @@ -98,7 +99,7 @@ timelogentry :: GenParser Char JournalContext TimeLogEntry timelogentry = do code <- oneOf "bhioO" many1 spacenonewline - datetime <- ledgerdatetime + datetime <- datetime comment <- optionMaybe (many1 spacenonewline >> liftM2 (++) getParentAccount restofline) return $ TimeLogEntry (read [code]) datetime (maybe "" rstrip comment) diff --git a/hledger-lib/Hledger/Reports.hs b/hledger-lib/Hledger/Reports.hs index 86493c135..9d0a42eb5 100644 --- a/hledger-lib/Hledger/Reports.hs +++ b/hledger-lib/Hledger/Reports.hs @@ -177,7 +177,7 @@ filterSpecFromOpts opts@ReportOpts{..} d = FilterSpec { ,acctpats=apats ,descpats=dpats ,depth = depth_ - ,metadata = mds + ,fMetadata = mds } where (apats,dpats,mds) = parsePatternArgs patterns_ diff --git a/hledger-web/Hledger/Web/Handlers.hs b/hledger-web/Hledger/Web/Handlers.hs index 697481307..faa6f8f25 100644 --- a/hledger-web/Hledger/Web/Handlers.hs +++ b/hledger-web/Hledger/Web/Handlers.hs @@ -484,8 +484,8 @@ handleAdd = do maybeNonNull = maybe Nothing (\t -> if Data.Text.null t then Nothing else Just t) acct1E = maybe (Left "to account required") (Right . unpack) $ maybeNonNull acct1M acct2E = maybe (Left "from account required") (Right . unpack) $ maybeNonNull acct2M - amt1E = maybe (Left "amount required") (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx someamount . unpack) amt1M - amt2E = maybe (Right missingamt) (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx someamount . unpack) amt2M + amt1E = maybe (Left "amount required") (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amount . unpack) amt1M + amt2E = maybe (Right missingamt) (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amount . unpack) amt2M journalE = maybe (Right $ journalFilePath j) (\f -> let f' = unpack f in if f' `elem` journalFilePaths j diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index b001387f2..b3b26e4c0 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -259,7 +259,7 @@ tests_Hledger_Cli = TestList (map precision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) `is` [2,2] ,"commodities" ~: - Map.elems (commodities ledger7) `is` [Commodity {symbol="$", side=L, spaced=False, decimalpoint='.', precision=2, separator=',', separatorpositions=[]}] + Map.elems (ledgerCommodities ledger7) `is` [Commodity {symbol="$", side=L, spaced=False, decimalpoint='.', precision=2, separator=',', separatorpositions=[]}] -- don't know what this should do -- ,"elideAccountName" ~: do @@ -910,4 +910,4 @@ journalWithAmounts as = nullctx [] (TOD 0 0) - where parse = fromparse . parseWithCtx nullctx someamount + where parse = fromparse . parseWithCtx nullctx amount diff --git a/hledger/Hledger/Cli/Add.hs b/hledger/Hledger/Cli/Add.hs index d2ce9fd94..ed729cdbe 100644 --- a/hledger/Hledger/Cli/Add.hs +++ b/hledger/Hledger/Cli/Add.hs @@ -150,16 +150,16 @@ getPostings st enteredps = do -- I think 1 or 4, whichever would show the most decimal places p = maxprecisionwithpoint amountstr <- runInteractionDefault $ askFor (printf "amount %d" n) defaultamountstr validateamount - let amount = fromparse $ runParser (someamount <|> return missingamt) ctx "" amountstr - amount' = fromparse $ runParser (someamount <|> return missingamt) nullctx "" amountstr - defaultamtused = Just (showMixedAmount amount) == defaultamountstr + let a = fromparse $ runParser (amount <|> return missingamt) ctx "" amountstr + a' = fromparse $ runParser (amount <|> return missingamt) nullctx "" amountstr + defaultamtused = Just (showMixedAmount a) == defaultamountstr commodityadded | c == cwithnodef = Nothing | otherwise = c - where c = maybemixedamountcommodity amount - cwithnodef = maybemixedamountcommodity amount' + where c = maybemixedamountcommodity a + cwithnodef = maybemixedamountcommodity a' maybemixedamountcommodity = maybe Nothing (Just . commodity) . headMay . amounts p = nullposting{paccount=stripbrackets account, - pamount=amount, + pamount=a, ptype=postingtype account} st' = if defaultamtused then st else st{psHistory = historicalps', @@ -181,7 +181,7 @@ getPostings st enteredps = do postingtype _ = RegularPosting stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse validateamount = Just $ \s -> (null s && not (null enteredrealps)) - || isRight (runParser (someamount>>many spacenonewline>>eof) ctx "" s) + || isRight (runParser (amount>>many spacenonewline>>eof) ctx "" s) -- | Prompt for and read a string value, optionally with a default value -- and a validator. A validator causes the prompt to repeat until the diff --git a/hledger/Hledger/Cli/Stats.hs b/hledger/Hledger/Cli/Stats.hs index 3bac82d96..a8123ee83 100644 --- a/hledger/Hledger/Cli/Stats.hs +++ b/hledger/Hledger/Cli/Stats.hs @@ -40,7 +40,7 @@ showLedgerStats l today span = w1 = maximum $ map (length . fst) stats w2 = maximum $ map (length . show . snd) stats stats = [ - ("Journal file", journalFilePath $ journal l) + ("Journal file", journalFilePath $ ledgerJournal l) ,("Transactions span", printf "%s to %s (%d days)" (start span) (end span) days) ,("Last transaction", maybe "none" show lastdate ++ showelapsed lastelapsed) ,("Transactions", printf "%d (%0.1f per day)" tnum txnrate) @@ -55,7 +55,7 @@ showLedgerStats l today span = -- Days since last transaction : %(recentelapsed)s ] where - ts = sortBy (comparing tdate) $ filter (spanContainsDate span . tdate) $ jtxns $ journal l + ts = sortBy (comparing tdate) $ filter (spanContainsDate span . tdate) $ jtxns $ ledgerJournal l as = nub $ map paccount $ concatMap tpostings ts cs = Map.keys $ canonicaliseCommodities $ nub $ map commodity $ concatMap amounts $ map pamount $ concatMap tpostings ts lastdate | null ts = Nothing