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