slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

replace Currency with a more flexible, ledger-style Commodity

Browse Source
This commit is contained in:
Simon Michael 2008-10-12 21:52:48 +00:00
parent d2f741255d
commit 4efdda25b4
16 changed files with 180 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Ledger.hs
View File

@ -9,7 +9,7 @@ module Ledger (
module Ledger.Account,
module Ledger.AccountName,
module Ledger.Amount,
module Ledger.Currency,
module Ledger.Commodity,
module Ledger.Entry,
module Ledger.Ledger,
module Ledger.Parse,
@ -24,7 +24,7 @@ where
import Ledger.Account
import Ledger.AccountName
import Ledger.Amount
import Ledger.Currency
import Ledger.Commodity
import Ledger.Entry
import Ledger.Ledger
import Ledger.Parse

62
Ledger/Amount.hs
View File

@ -1,7 +1,7 @@
{-|
An 'Amount' is some quantity of money, shares, or anything else.
A simple amount is a currency, quantity pair (where currency can be anything):
A simple amount is a commodity, quantity pair (where commodity can be anything):
@
$1
@ -20,9 +20,9 @@ A mixed amount (not yet implemented) is one or more simple amounts:
16h, $13.55, oranges 6
@
Currencies may be convertible or not (eg, currencies representing
non-money commodities). A mixed amount containing only convertible
currencies can be converted to a simple amount. Arithmetic examples:
Commodities may be convertible or not. A mixed amount containing only
convertible commodities can be converted to a simple amount. Arithmetic
examples:
@
$1 - $5 = $-4
@ -40,7 +40,7 @@ module Ledger.Amount
where
import Ledger.Utils
import Ledger.Types
import Ledger.Currency
import Ledger.Commodity
amounttests = TestList [
@ -48,12 +48,16 @@ amounttests = TestList [
instance Show Amount where show = showAmountRounded
-- | Get the string representation of an amount, rounded to its native precision.
-- Unlike ledger, we show the decimal digits even if they are all 0, and
-- we always show currency symbols on the left.
-- | Get the string representation of an amount, based on its commodity's
-- display settings.
showAmountRounded :: Amount -> String
showAmountRounded (Amount c q p) =
(symbol c) ++ ({-punctuatethousands $ -}printf ("%."++show p++"f") q)
showAmountRounded (Amount (Commodity {symbol=sym,side=side,spaced=spaced,precision=p}) q)
| side==L = printf "%s%s%s" sym space quantity
| side==R = printf "%s%s%s" quantity space sym
where
space = if spaced then " " else ""
quantity = punctuatethousands $ printf ("%."++show p++"f") q :: String
punctuatethousands = id
-- | Get the string representation of an amount, rounded, or showing just "0" if it's zero.
showAmountRoundedOrZero :: Amount -> String
@ -63,11 +67,11 @@ showAmountRoundedOrZero a
-- | is this amount zero, when displayed with its given precision ?
isZeroAmount :: Amount -> Bool
isZeroAmount a@(Amount c _ _) = nonzerodigits == ""
isZeroAmount a@(Amount c _ ) = nonzerodigits == ""
where
nonzerodigits = filter (flip notElem "-+,.0") quantitystr
quantitystr = withoutcurrency $ showAmountRounded a
withoutcurrency = drop (length $ symbol c)
quantitystr = withoutsymbol $ showAmountRounded a
withoutsymbol = drop (length $ symbol c) -- XXX
punctuatethousands :: String -> String
punctuatethousands s =
@ -80,32 +84,30 @@ punctuatethousands s =
triples s = [take 3 s] ++ (triples $ drop 3 s)
instance Num Amount where
abs (Amount c q p) = Amount c (abs q) p
signum (Amount c q p) = Amount c (signum q) p
fromInteger i = Amount (getcurrency "") (fromInteger i) defaultprecision
abs (Amount c q) = Amount c (abs q)
signum (Amount c q) = Amount c (signum q)
fromInteger i = Amount (comm "") (fromInteger i)
(+) = amountop (+)
(-) = amountop (-)
(*) = amountop (*)
-- amounts converted from integers will have a default precision, and the
-- null currency.
defaultprecision = 2
-- | Apply a binary arithmetic operator to two amounts, converting to the
-- second one's currency and adopting the lowest precision. (Using the
-- second currency means that folds (like sum [Amount]) will preserve the
-- currency.)
-- second one's commodity and adopting the lowest precision. (Using the
-- second commodity means that folds (like sum [Amount]) will preserve the
-- commodity.)
amountop :: (Double -> Double -> Double) -> Amount -> Amount -> Amount
amountop op a@(Amount ac aq ap) b@(Amount bc bq bp) =
Amount bc ((quantity $ toCurrency bc a) `op` bq) (min ap bp)
amountop op a@(Amount ac aq) b@(Amount bc bq) =
Amount bc ((quantity $ toCommodity bc a) `op` bq)
-- | Sum a list of amounts. This is still needed because a final zero
-- amount will discard the sum's currency.
-- amount will discard the sum's commodity.
sumAmounts :: [Amount] -> Amount
sumAmounts = sum . filter (not . isZeroAmount)
toCurrency :: Currency -> Amount -> Amount
toCurrency newc (Amount oldc q p) =
Amount newc (q * (conversionRate oldc newc)) p
toCommodity :: Commodity -> Amount -> Amount
toCommodity newc (Amount oldc q) =
Amount newc (q * (conversionRate oldc newc))
nullamt = Amount (getcurrency "") 0 2
nullamt = Amount (comm "") 0
-- temporary value for partial entries
autoamt = Amount (Commodity {symbol="AUTO",rate=1,side=L,spaced=False,precision=0}) 0

41
Ledger/Commodity.hs Normal file
View File

@ -0,0 +1,41 @@
{-|
A 'Commodity' is a symbol and a conversion rate relative to the
dollar. Commodity symbols are parsed from the ledger file, rates are
currently hard-coded.
-}
module Ledger.Commodity
where
import qualified Data.Map as Map
import Ledger.Utils
import Ledger.Types
commoditytests = TestList [
]
unknown = Commodity {symbol="",rate=1,side=L,spaced=False,precision=0}
dollar = Commodity {symbol="$",rate=1,side=L,spaced=False,precision=2}
euro = Commodity {symbol="EUR",rate=0.760383,side=L,spaced=False,precision=2}
pound = Commodity {symbol="£",rate=0.512527,side=L,spaced=False,precision=2}
hour = Commodity {symbol="h",rate=100,side=R,spaced=False,precision=1}
-- | convenient amount constructors
unknowns = Amount unknown
dollars = Amount dollar
euros = Amount euro
pounds = Amount pound
hours = Amount hour
defaultcommodities = [unknown, dollar, euro, pound, hour]
defaultcommoditiesmap :: Map.Map String Commodity
defaultcommoditiesmap = Map.fromList [(symbol c :: String, c :: Commodity) | c <- defaultcommodities]
comm :: String -> Commodity
comm symbol = Map.findWithDefault (error "commodity lookup failed") symbol defaultcommoditiesmap
conversionRate :: Commodity -> Commodity -> Double
conversionRate oldc newc = (rate newc) / (rate oldc)

41
Ledger/Currency.hs
View File

@ -1,41 +0,0 @@
{-|
A 'Currency' is a symbol and a conversion rate relative to the
dollar. Currency symbols are parsed from the ledger file, rates are
currently hard-coded.
-}
module Ledger.Currency
where
import qualified Data.Map as Map
import Ledger.Utils
import Ledger.Types
currencytests = TestList [
]
currencies =
[
Currency "$" 1
,Currency "EUR" 0.760383
,Currency "£" 0.512527
,Currency "h" 60 -- hours
,Currency "m" 1 -- minutes
]
currencymap = Map.fromList [(sym, c) | c@(Currency sym rate) <- currencies]
getcurrency :: String -> Currency
getcurrency s = Map.findWithDefault (Currency s 1) s currencymap
conversionRate :: Currency -> Currency -> Double
conversionRate oldc newc = (rate newc) / (rate oldc)
-- | convenient amount constructors
dollars n = Amount (getcurrency "$") n 2
euro n = Amount (getcurrency "EUR") n 2
pounds n = Amount (getcurrency "£") n 2
hours n = Amount (getcurrency "h") n 2
minutes n = Amount (getcurrency "m") n 2

5
Ledger/Entry.hs
View File

@ -87,11 +87,6 @@ showEntry e =
showaccountname s = printf "%-34s" s
showcomment s = if (length s) > 0 then " ; "++s else ""
entrySetPrecision :: Int -> Entry -> Entry
entrySetPrecision p (Entry d s c desc comm ts prec) =
Entry d s c desc comm (map (ledgerTransactionSetPrecision p) ts) prec
-- modifier & periodic entries
instance Show ModifierEntry where

10
Ledger/Ledger.hs
View File

@ -48,12 +48,11 @@ cacheLedger l =
subacctsof a = filter (isAccountNamePrefixOf a) anames
subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a]
balmap = Map.union
(Map.fromList [(a, (sumTransactions $ subtxnsof a){precision=maxprecision}) | a <- anames])
(Map.fromList [(a, (sumTransactions $ subtxnsof a)) | a <- anames])
(Map.fromList [(a,nullamt) | a <- anames])
amap = Map.fromList [(a, Account a (txnmap ! a) (balmap ! a)) | a <- anames]
maxprecision = maximum $ map (precision . amount) ts
in
Ledger l ant amap maxprecision
Ledger l ant amap
-- | List a 'Ledger' 's account names.
accountnames :: Ledger -> [AccountName]
@ -90,10 +89,7 @@ subAccounts l a = map (ledgerAccount l) subacctnames
-- display functions, but those are far removed from the ledger. Keep in
-- mind if doing more arithmetic with these.
ledgerTransactions :: Ledger -> [Transaction]
ledgerTransactions l =
setprecisions $ rawLedgerTransactions $ rawledger l
where
setprecisions = map (transactionSetPrecision (lprecision l))
ledgerTransactions l = rawLedgerTransactions $ rawledger l
-- | Get a ledger's tree of accounts to the specified depth.
ledgerAccountTree :: Int -> Ledger -> Tree Account

67
Ledger/Parse.hs
View File

@ -10,10 +10,12 @@ import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Language
import qualified Text.ParserCombinators.Parsec.Token as P
import System.IO
import qualified Data.Map as Map
import Ledger.Utils
import Ledger.Types
import Ledger.Amount
import Ledger.Entry
import Ledger.Currency
import Ledger.Commodity
import Ledger.TimeLog
@ -255,7 +257,7 @@ ledgertransaction :: Parser RawTransaction
ledgertransaction = do
many1 spacenonewline
account <- ledgeraccountname
amount <- ledgeramount
amount <- transactionamount
many spacenonewline
comment <- ledgercomment
restofline
@ -272,22 +274,55 @@ ledgeraccountname = do
-- couldn't avoid consuming a final space sometimes, harmless
striptrailingspace s = if last s == ' ' then init s else s
ledgeramount :: Parser Amount
ledgeramount =
try (do
many1 spacenonewline
c <- many (noneOf "-.0123456789;\n") <?> "currency"
q <- many1 (oneOf "-.,0123456789") <?> "quantity"
let q' = stripcommas $ striptrailingpoint q
let (int,frac) = break (=='.') q'
let precision = length $ dropWhile (=='.') frac
return (Amount (getcurrency c) (read q') precision)
)
<|> return (Amount (Currency "AUTO" 0) 0 0)
where
transactionamount :: Parser Amount
transactionamount =
try (do
many1 spacenonewline
a <- try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount <|> return autoamt
return a
) <|> return autoamt
leftsymbolamount :: Parser Amount
leftsymbolamount = do
sym <- commoditysymbol
sp <- many spacenonewline
q <- commodityquantity
let newcommodity = Commodity {symbol=sym,rate=1,side=L,spaced=not $ null sp,precision=1}
let c = Map.findWithDefault newcommodity sym defaultcommoditiesmap
return $ Amount c q
<?> "left-symbol amount"
rightsymbolamount :: Parser Amount
rightsymbolamount = do
q <- commodityquantity
sp <- many spacenonewline
sym <- commoditysymbol
let newcommodity = Commodity {symbol=sym,rate=1,side=R,spaced=not $ null sp,precision=1}
let c = Map.findWithDefault newcommodity sym defaultcommoditiesmap
return $ Amount c q
<?> "right-symbol amount"
nosymbolamount :: Parser Amount
nosymbolamount = do
q <- commodityquantity
return $ unknowns q
<?> "no-symbol amount"
commoditysymbol :: Parser String
commoditysymbol = many1 (noneOf "-.0123456789;\n ") <?> "commodity symbol"
commodityquantity :: Parser Double
commodityquantity = do
q <- many1 (oneOf "-.,0123456789")
let q' = stripcommas $ striptrailingpoint q
let (int,frac) = break (=='.') q'
return $ read q'
<?> "commodity quantity"
where
stripcommas = filter (',' /=)
striptrailingpoint = reverse . dropWhile (=='.') . reverse
-- precision = length $ dropWhile (=='.') frac -- XXX
spacenonewline :: Parser Char
spacenonewline = satisfy (\c -> c `elem` " \v\f\t")

5
Ledger/RawTransaction.hs
View File

@ -36,11 +36,8 @@ autofillTransactions ts =
otherwise -> error "too many blank transactions in this entry"
where
(normals, blanks) = partition isnormal ts
isnormal t = (symbol $ currency $ tamount t) /= "AUTO"
isnormal t = (symbol $ commodity $ tamount t) /= "AUTO"
balance t = if isnormal t then t else t{tamount = -(sumLedgerTransactions normals)}
sumLedgerTransactions :: [RawTransaction] -> Amount
sumLedgerTransactions = sum . map tamount
ledgerTransactionSetPrecision :: Int -> RawTransaction -> RawTransaction
ledgerTransactionSetPrecision p (RawTransaction a amt c) = RawTransaction a amt{precision=p} c

5
Ledger/TimeLog.hs
View File

@ -10,7 +10,7 @@ module Ledger.TimeLog
where
import Ledger.Utils
import Ledger.Types
import Ledger.Currency
import Ledger.Commodity
import Ledger.Amount
@ -56,8 +56,7 @@ entryFromTimeLogInOut i o =
outdate = showDateFrom outtime
intime = parsedatetime $ tldatetime i
outtime = parsedatetime $ tldatetime o
hours = realToFrac (diffUTCTime outtime intime) / 3600
amount = Amount (getcurrency "h") hours 1
amount = hours $ realToFrac (diffUTCTime outtime intime) / 3600
txns = [RawTransaction acctname amount "", RawTransaction "assets:TIME" (-amount) ""]
showDateFrom :: UTCTime -> String

3
Ledger/Transaction.hs
View File

@ -28,9 +28,6 @@ flattenEntry :: (Entry, Int) -> [Transaction]
flattenEntry (Entry d _ _ desc _ ts _, e) =
[Transaction e d desc (taccount t) (tamount t) | t <- ts]
transactionSetPrecision :: Int -> Transaction -> Transaction
transactionSetPrecision p (Transaction e d desc a amt) = Transaction e d desc a amt{precision=p}
accountNamesFromTransactions :: [Transaction] -> [AccountName]
accountNamesFromTransactions ts = nub $ map account ts

19
Ledger/Types.hs
View File

@ -15,15 +15,19 @@ type Date = String
type DateTime = String
data Currency = Currency {
symbol :: String,
rate :: Double
data Side = L | R deriving (Eq,Show)
data Commodity = Commodity {
symbol :: String, -- ^ the commodity's symbol
side :: Side, -- ^ should the symbol appear on the left or the right
spaced :: Bool, -- ^ should there be a space between symbol and quantity
precision :: Int, -- ^ number of decimal places to display
rate :: Double -- ^ the current (hard-coded) conversion rate against the dollar
} deriving (Eq,Show)
data Amount = Amount {
currency :: Currency,
quantity :: Double,
precision :: Int -- ^ number of significant decimal places
commodity :: Commodity,
quantity :: Double
} deriving (Eq)
type AccountName = String
@ -90,7 +94,6 @@ data Account = Account {
data Ledger = Ledger {
rawledger :: RawLedger,
accountnametree :: Tree AccountName,
accountmap :: Map.Map AccountName Account,
lprecision :: Int -- the preferred display precision
accountmap :: Map.Map AccountName Account
}

2
Ledger/Utils.hs
View File

@ -150,6 +150,8 @@ p = putStr
assertequal e a = assertEqual "" e a
assertnotequal e a = assertBool "expected inequality, got equality" (e /= a)
-- parsewith :: Parser a
parsewith p ts = parse p "" ts
fromparse = either (\_ -> error "parse error") id

3
PrintCommand.hs
View File

@ -18,5 +18,4 @@ print' :: [Opt] -> [String] -> Ledger -> IO ()
print' opts args l = putStr $ showEntries opts args l
showEntries :: [Opt] -> [String] -> Ledger -> String
showEntries opts args l = concatMap showEntry $ setprecisions $ entries $ rawledger l
where setprecisions = map (entrySetPrecision (lprecision l))
showEntries opts args l = concatMap showEntry $ entries $ rawledger l

2
RegisterCommand.hs
View File

@ -24,7 +24,7 @@ showTransactionsWithBalances opts args l =
ts = filter matchtxn $ ledgerTransactions l
matchtxn (Transaction _ _ desc acct _) = (containsRegex (regexFor apats) acct)
pats@(apats,dpats) = parseAccountDescriptionArgs args
startingbalance = nullamt{precision=lprecision l}
startingbalance = nullamt
showTransactionsWithBalances' :: [Transaction] -> Transaction -> Amount -> [String]
showTransactionsWithBalances' [] _ _ = []
showTransactionsWithBalances' (t:ts) tprev b =

64
Tests.hs
View File

@ -23,7 +23,7 @@ alltests = concattests [
,accountnametests
,amounttests
,balancecommandtests
,currencytests
,commoditytests
,entrytests
,ledgertests
,parsertests
@ -41,20 +41,20 @@ tests =
[
"display dollar amount" ~: show (dollars 1) ~?= "$1.00"
-- ,"display time amount" ~: show (hours 1) ~?= "1.0h"
,"display time amount" ~: show (hours 1) ~?= "1.0h"
,"amount precision" ~: do
let a1 = Amount (getcurrency "$") 1.23 1
let a2 = Amount (getcurrency "$") (-1.23) 2
let a3 = Amount (getcurrency "$") (-1.23) 3
assertequal (Amount (getcurrency "$") 0 1) (a1 + a2)
assertequal (Amount (getcurrency "$") 0 1) (a1 + a3)
assertequal (Amount (getcurrency "$") (-2.46) 2) (a2 + a3)
assertequal (Amount (getcurrency "$") (-2.46) 3) (a3 + a3)
-- sum adds 0, with Amount fromIntegral's default precision of 2
assertequal (Amount (getcurrency "$") 0 1) (sum [a1,a2])
assertequal (Amount (getcurrency "$") (-2.46) 2) (sum [a2,a3])
assertequal (Amount (getcurrency "$") (-2.46) 2) (sum [a3,a3])
-- ,"amount precision" ~: do
-- let a1 = dollars 1.23
-- let a2 = Amount (comm "$") (-1.23) 2
-- let a3 = Amount (comm "$") (-1.23) 3
-- assertequal (Amount (comm "$") 0 1) (a1 + a2)
-- assertequal (Amount (comm "$") 0 1) (a1 + a3)
-- assertequal (Amount (comm "$") (-2.46) 2) (a2 + a3)
-- assertequal (Amount (comm "$") (-2.46) 3) (a3 + a3)
-- -- sum adds 0, with Amount fromIntegral's default precision of 2
-- assertequal (Amount (comm "$") 0 1) (sum [a1,a2])
-- assertequal (Amount (comm "$") (-2.46) 2) (sum [a2,a3])
-- assertequal (Amount (comm "$") (-2.46) 2) (sum [a3,a3])
,"ledgertransaction" ~: do
assertparseequal rawtransaction1 (parsewith ledgertransaction rawtransaction1_str)
@ -64,7 +64,7 @@ tests =
,"autofillEntry" ~: do
assertequal
(Amount (getcurrency "$") (-47.18) 2)
(dollars (-47.18))
(tamount $ last $ etransactions $ autofillEntry entry1)
,"punctuatethousands" ~: punctuatethousands "" @?= ""
@ -86,9 +86,9 @@ tests =
,"cacheLedger" ~: do
assertequal 15 (length $ Map.keys $ accountmap $ cacheLedger rawledger7 )
,"ledgeramount" ~: do
assertparseequal (Amount (getcurrency "$") 47.18 2) (parsewith ledgeramount " $47.18")
assertparseequal (Amount (getcurrency "$") 1 0) (parsewith ledgeramount " $1.")
,"transactionamount" ~: do
assertparseequal (dollars 47.18) (parsewith transactionamount " $47.18")
assertparseequal (Amount (Commodity {symbol="$",rate=1,side=L,spaced=False,precision=0}) 1) (parsewith transactionamount " $1.")
]
balancecommandtests =
@ -202,8 +202,8 @@ entry1_str = "\
entry1 =
(Entry "2007/01/28" False "" "coopportunity" ""
[RawTransaction "expenses:food:groceries" (Amount (getcurrency "$") 47.18 2) "",
RawTransaction "assets:checking" (Amount (getcurrency "$") (-47.18) 2) ""] "")
[RawTransaction "expenses:food:groceries" (dollars 47.18) "",
RawTransaction "assets:checking" (dollars (-47.18)) ""] "")
entry2_str = "\
@ -347,12 +347,12 @@ rawledger7 = RawLedger
etransactions=[
RawTransaction {
taccount="assets:cash",
tamount=Amount {currency=(getcurrency "$"), quantity=4.82, precision=2},
tamount=dollars 4.82,
tcomment=""
},
RawTransaction {
taccount="equity:opening balances",
tamount=Amount {currency=(getcurrency "$"), quantity=(-4.82), precision=2},
tamount=dollars (-4.82),
tcomment=""
}
],
@ -368,12 +368,12 @@ rawledger7 = RawLedger
etransactions=[
RawTransaction {
taccount="expenses:vacation",
tamount=Amount {currency=(getcurrency "$"), quantity=179.92, precision=2},
tamount=dollars 179.92,
tcomment=""
},
RawTransaction {
taccount="assets:checking",
tamount=Amount {currency=(getcurrency "$"), quantity=(-179.92), precision=2},
tamount=dollars (-179.92),
tcomment=""
}
],
@ -389,12 +389,12 @@ rawledger7 = RawLedger
etransactions=[
RawTransaction {
taccount="assets:saving",
tamount=Amount {currency=(getcurrency "$"), quantity=200, precision=2},
tamount=dollars 200,
tcomment=""
},
RawTransaction {
taccount="assets:checking",
tamount=Amount {currency=(getcurrency "$"), quantity=(-200), precision=2},
tamount=dollars (-200),
tcomment=""
}
],
@ -410,12 +410,12 @@ rawledger7 = RawLedger
etransactions=[
RawTransaction {
taccount="expenses:food:dining",
tamount=Amount {currency=(getcurrency "$"), quantity=4.82, precision=2},
tamount=dollars 4.82,
tcomment=""
},
RawTransaction {
taccount="assets:cash",
tamount=Amount {currency=(getcurrency "$"), quantity=(-4.82), precision=2},
tamount=dollars (-4.82),
tcomment=""
}
],
@ -431,12 +431,12 @@ rawledger7 = RawLedger
etransactions=[
RawTransaction {
taccount="expenses:phone",
tamount=Amount {currency=(getcurrency "$"), quantity=95.11, precision=2},
tamount=dollars 95.11,
tcomment=""
},
RawTransaction {
taccount="assets:checking",
tamount=Amount {currency=(getcurrency "$"), quantity=(-95.11), precision=2},
tamount=dollars (-95.11),
tcomment=""
}
],
@ -452,12 +452,12 @@ rawledger7 = RawLedger
etransactions=[
RawTransaction {
taccount="liabilities:credit cards:discover",
tamount=Amount {currency=(getcurrency "$"), quantity=80, precision=2},
tamount=dollars 80,
tcomment=""
},
RawTransaction {
taccount="assets:checking",
tamount=Amount {currency=(getcurrency "$"), quantity=(-80), precision=2},
tamount=dollars (-80),
tcomment=""
}
],

1
hledger.hs
View File

@ -32,6 +32,7 @@ or ghci:
-}
module Main (
module Main,
module Utils,
module Options,
module BalanceCommand,