simple currency handling

BasicTypes.hs

@@ -4,40 +4,80 @@ where
 import Utils
 
 
-type Date = String
-type Status = Bool
+type Date     = String
+
+-- generic tree. each node is a tuple of the node type and a
+-- list of subtrees
+newtype Tree a = Tree { node :: (a, [Tree a]) } deriving (Show,Eq)
+branches = snd . node
 
 -- amounts
--- amount arithmetic currently ignores currency conversion
+{- a simple amount is a currency, quantity pair:
+   0 
+   $1 
+   £-50
+   EUR 3.44 
+   HRS 1.5
+   DAYS 3
+   GOOG 500
+
+   a mixed amount is one or more simple amounts:
+   $50, EUR 3, APPL 500
+   HRS 16, $13.55, oranges 6
+
+   arithmetic:
+   $1 - $5 = $-4
+   $1 + EUR 0.76 = $2
+   EUR0.76 + $1 = EUR 1.52
+   EUR0.76 - $1 = 0
+   ($5, HRS 2) + $1 = ($6, HRS 2)
+   ($50, EUR 3, APPL 500) + ($13.55, oranges 6) = $67.51, APPL 500, oranges 6
+   ($50, EUR 3) * $-1 = $-53.96
+   ($50, APPL 500) * $-1 = error
+   
+-}
+
+type Currency = String
 
 data Amount = Amount {
-                      currency :: String,
+                      currency :: Currency,
                       quantity :: Double
                      } deriving (Eq,Ord)
 
+instance Show Amount where show = showAmountRoundedOrZero
+
+showAmountRoundedOrZero :: Amount -> String
+showAmountRoundedOrZero (Amount cur qty) =
+    let rounded = printf "%.2f" qty in
+    case rounded of
+      "0.00"    -> "0"
+      "-0.00"   -> "0"
+      otherwise -> cur ++ rounded
+
 instance Num Amount where
     abs (Amount c q) = Amount c (abs q)
     signum (Amount c q) = Amount c (signum q)
     fromInteger i = Amount "$" (fromInteger i)
     (+) = amountAdd
     (-) = amountSub
-    (*) = amountMult
-Amount ca qa `amountAdd` Amount cb qb = Amount ca (qa + qb)
-Amount ca qa `amountSub` Amount cb qb = Amount ca (qa - qb)
-Amount ca qa `amountMult` Amount cb qb = Amount ca (qa * qb)
+    (*) = amountMul
+Amount ac aq `amountAdd` b = Amount ac (aq + (quantity $ toCurrency ac b))
+Amount ac aq `amountSub` b = Amount ac (aq - (quantity $ toCurrency ac b))
+Amount ac aq `amountMul` b = Amount ac (aq * (quantity $ toCurrency ac b))
 
-instance Show Amount where show = amountRoundedOrZero
+toCurrency :: Currency -> Amount -> Amount
+toCurrency newc (Amount oldc q) =
+    Amount newc (q * (conversionRate oldc newc))
 
-amountRoundedOrZero :: Amount -> String
-amountRoundedOrZero (Amount cur qty) =
-    let rounded = printf "%.2f" qty in
-    case rounded of
-      "0.00"    -> "0"
-      "-0.00"   -> "0"
-      otherwise -> cur ++ rounded
+conversionRate :: Currency -> Currency -> Double
+conversionRate oldc newc = (rate newc) / (rate oldc)
 
--- generic tree. each node is a tuple of the node type and a
--- list of subtrees
-newtype Tree a = Tree { node :: (a, [Tree a]) } deriving (Show,Eq)
-branches = snd . node
+rate :: Currency -> Double
+rate "$"   = 1.0
+rate "EUR" = 0.760383
+rate "£"   = 0.512527
+rate _     = 1
+
+
+data MixedAmount = MixedAmount [Amount] deriving (Eq,Ord)
 

Entry.hs

@@ -6,6 +6,8 @@ import BasicTypes
 import Transaction
 
 
+type EntryStatus   = Bool
+
 -- a register entry is displayed as two or more lines like this:
 -- date       description          account                 amount       balance
 -- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA
@@ -19,7 +21,7 @@ import Transaction
 
 data Entry = Entry {
                     edate :: Date,
-                    estatus :: Status,
+                    estatus :: EntryStatus,
                     ecode :: String,
                     edescription :: String,
                     etransactions :: [Transaction]

EntryTransaction.hs

@@ -68,5 +68,5 @@ showTransactionAndBalance t b =
     (replicate 32 ' ') ++ (showTransaction $ transaction t) ++ (showBalance b)
 
 showBalance :: Amount -> String
-showBalance b = printf " %12s" (amountRoundedOrZero b)
+showBalance b = printf " %12s" (showAmountRoundedOrZero b)
 

TODO

@@ -1,15 +1,17 @@
+make it fast
+ profile
+
 basic features
- handle mixed amounts and currencies
+ balance report account matching
+ -f -
  print
  entry
  -j and -J graph data output
  !include
  read timelog files
 
-make it fast
- profile
-
 more features
+ handle mixed amounts
  3.0-style elision
  -p period expressions
  -d display expressions

hledger.hs

@@ -86,13 +86,6 @@ printRegister opts args ledger = do
 
 printBalance :: [Flag] -> [String] -> Ledger -> IO ()
 printBalance opts args ledger = do
---   putStr $ showLedgerAccounts ledger acctpats depth
---       where 
---         (acctpats,_) = ledgerPatternArgs args
---         showsubs = (ShowSubs `elem` opts)
---         depth = case showsubs of
---                   True -> 999
---                   False -> depthOption opts
   putStr $ case showsubs of
              True -> showLedgerAccounts ledger 999
              False -> showLedgerAccounts ledger 1