222 lines
7.7 KiB
Haskell
222 lines
7.7 KiB
Haskell
|
|
module Models -- data types & behaviours
|
|
where
|
|
|
|
import Text.Printf
|
|
import Data.List
|
|
|
|
-- basic types
|
|
|
|
type Date = String
|
|
type Status = Bool
|
|
type Account = String
|
|
|
|
data Amount = Amount {
|
|
currency :: String,
|
|
quantity :: Double
|
|
} deriving (Eq)
|
|
|
|
-- amount arithmetic, ignores currency conversion
|
|
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)
|
|
|
|
instance Show Amount where
|
|
show (Amount cur qty) =
|
|
let roundedqty = printf "%.2f" qty in
|
|
case roundedqty of
|
|
"0.00" -> "0"
|
|
otherwise -> cur ++ roundedqty
|
|
|
|
-- modifier & periodic entries
|
|
|
|
data ModifierEntry = ModifierEntry { -- aka "automated entry"
|
|
valueexpr :: String,
|
|
m_transactions :: [Transaction]
|
|
} deriving (Eq)
|
|
|
|
instance Show ModifierEntry where
|
|
show e = "= " ++ (valueexpr e) ++ "\n" ++ unlines (map show (m_transactions e))
|
|
|
|
data PeriodicEntry = PeriodicEntry {
|
|
periodexpr :: String,
|
|
p_transactions :: [Transaction]
|
|
} deriving (Eq)
|
|
|
|
instance Show PeriodicEntry where
|
|
show e = "~ " ++ (periodexpr e) ++ "\n" ++ unlines (map show (p_transactions e))
|
|
|
|
-- entries
|
|
-- a register entry is displayed as two or more lines like this:
|
|
-- date description account amount balance
|
|
-- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAA AAAAAAAAAA
|
|
-- aaaaaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAA AAAAAAAAAA
|
|
-- ... ... ...
|
|
-- dateWidth = 10
|
|
-- descWidth = 20
|
|
-- acctWidth = 25
|
|
-- amtWidth = 10
|
|
-- balWidth = 10
|
|
|
|
data Entry = Entry {
|
|
edate :: Date,
|
|
estatus :: Status,
|
|
ecode :: String,
|
|
edescription :: String,
|
|
etransactions :: [Transaction]
|
|
} deriving (Eq)
|
|
|
|
instance Show Entry where show = showEntryDetails
|
|
|
|
showEntryDetails e = printf "%-10s %-20s " (edate e) (take 20 $ edescription e)
|
|
|
|
isEntryBalanced :: Entry -> Bool
|
|
isEntryBalanced e = (sumTransactions . etransactions) e == 0
|
|
|
|
autofillEntry :: Entry -> Entry
|
|
autofillEntry e =
|
|
Entry (edate e) (estatus e) (ecode e) (edescription e)
|
|
(autofillTransactions (etransactions e))
|
|
|
|
-- transactions
|
|
|
|
data Transaction = Transaction {
|
|
taccount :: Account,
|
|
tamount :: Amount
|
|
} deriving (Eq)
|
|
|
|
instance Show Transaction where
|
|
show t = printf "%-25s %10s" (take 25 $ taccount t) (show $ tamount t)
|
|
|
|
autofillTransactions :: [Transaction] -> [Transaction]
|
|
autofillTransactions ts =
|
|
let (ns, as) = normalAndAutoTransactions ts in
|
|
case (length as) of
|
|
0 -> ns
|
|
1 -> ns ++ [balanceTransaction $ head as]
|
|
where balanceTransaction t = t{tamount = -(sumTransactions ns)}
|
|
otherwise -> error "too many blank transactions in this entry"
|
|
|
|
normalAndAutoTransactions :: [Transaction] -> ([Transaction], [Transaction])
|
|
normalAndAutoTransactions ts =
|
|
partition isNormal ts
|
|
where isNormal t = (currency $ tamount t) /= "AUTO"
|
|
|
|
sumTransactions :: [Transaction] -> Amount
|
|
sumTransactions ts = sum [tamount t | t <- ts]
|
|
|
|
-- entrytransactions
|
|
-- the entry/transaction types used in app-level functions have morphed
|
|
-- through E->T; (T,E); ET; E<->T; (E,T). Currently, we parse Entries
|
|
-- containing Transactions and flatten them into (Entry,Transaction) pairs
|
|
-- (hereafter referred to as "transactions") for processing
|
|
|
|
type EntryTransaction = (Entry,Transaction)
|
|
|
|
entry (e,t) = e
|
|
transaction (e,t) = t
|
|
date (e,t) = edate e
|
|
status (e,t) = estatus e
|
|
code (e,t) = ecode e
|
|
description (e,t) = edescription e
|
|
account (e,t) = taccount t
|
|
amount (e,t) = tamount t
|
|
|
|
flattenEntry :: Entry -> [EntryTransaction]
|
|
flattenEntry e = [(e,t) | t <- etransactions e]
|
|
|
|
entryTransactionsFrom :: [Entry] -> [EntryTransaction]
|
|
entryTransactionsFrom es = concat $ map flattenEntry es
|
|
|
|
matchTransactionAccount :: String -> EntryTransaction -> Bool
|
|
matchTransactionAccount s t = s `isInfixOf` (account t)
|
|
|
|
matchTransactionDescription :: String -> EntryTransaction -> Bool
|
|
matchTransactionDescription s t = s `isInfixOf` (description t)
|
|
|
|
showTransactionsWithBalances :: [EntryTransaction] -> Amount -> String
|
|
showTransactionsWithBalances [] _ = []
|
|
showTransactionsWithBalances ts b =
|
|
unlines $ showTransactionsWithBalances' ts dummyt b
|
|
where
|
|
dummyt = (Entry "" False "" "" [], Transaction "" (Amount "" 0))
|
|
showTransactionsWithBalances' [] _ _ = []
|
|
showTransactionsWithBalances' (t:ts) tprev b =
|
|
(if (entry t /= (entry tprev))
|
|
then [showTransactionDescriptionAndBalance t b']
|
|
else [showTransactionAndBalance t b'])
|
|
++ (showTransactionsWithBalances' ts t b')
|
|
where b' = b + (amount t)
|
|
|
|
showTransactionDescriptionAndBalance :: EntryTransaction -> Amount -> String
|
|
showTransactionDescriptionAndBalance t b =
|
|
(showTransactionEntryDetails t) ++ (showTransactionDetails t) ++ (showBalance b)
|
|
|
|
showTransactionAndBalance :: EntryTransaction -> Amount -> String
|
|
showTransactionAndBalance t b =
|
|
(replicate 32 ' ') ++ (showTransactionDetails t) ++ (showBalance b)
|
|
|
|
-- like showEntryDetails
|
|
showTransactionEntryDetails t = printf "%-10s %-20s " (date t) (take 20 $ description t)
|
|
|
|
showTransactionDetails t = printf "%-25s %10s" (take 25 $ account t) (show $ amount t)
|
|
|
|
showBalance b = printf " %10.2s" (show b)
|
|
|
|
-- accounts
|
|
|
|
accountsFromTransactions :: [EntryTransaction] -> [Account]
|
|
accountsFromTransactions ts = nub $ map account ts
|
|
|
|
-- ["a:b:c","d:e"] -> ["a","a:b","a:b:c","d","d:e"]
|
|
expandAccounts :: [Account] -> [Account]
|
|
expandAccounts l = nub $ concat $ map expand l
|
|
where
|
|
expand l' = map (concat . intersperse ":") (tail $ inits $ splitAtElement ':' l')
|
|
|
|
splitAtElement :: Eq a => a -> [a] -> [[a]]
|
|
splitAtElement e l =
|
|
case dropWhile (e==) l of
|
|
[] -> []
|
|
l' -> first : splitAtElement e rest
|
|
where
|
|
(first,rest) = break (e==) l'
|
|
|
|
-- ledger
|
|
|
|
data Ledger = Ledger {
|
|
modifier_entries :: [ModifierEntry],
|
|
periodic_entries :: [PeriodicEntry],
|
|
entries :: [Entry]
|
|
} deriving (Eq)
|
|
|
|
instance Show Ledger where
|
|
show l = "Ledger with " ++ m ++ " modifier, " ++ p ++ " periodic, " ++ e ++ " normal entries:\n"
|
|
++ (concat $ map show (modifier_entries l))
|
|
++ (concat $ map show (periodic_entries l))
|
|
++ (concat $ map show (entries l))
|
|
where
|
|
m = show $ length $ modifier_entries l
|
|
p = show $ length $ periodic_entries l
|
|
e = show $ length $ entries l
|
|
|
|
ledgerAccountsUsed :: Ledger -> [Account]
|
|
ledgerAccountsUsed l = accountsFromTransactions $ entryTransactionsFrom $ entries l
|
|
|
|
ledgerAccountTree :: Ledger -> [Account]
|
|
ledgerAccountTree = sort . expandAccounts . ledgerAccountsUsed
|
|
|
|
ledgerTransactions :: Ledger -> [EntryTransaction]
|
|
ledgerTransactions l = entryTransactionsFrom $ entries l
|
|
|
|
ledgerTransactionsMatching :: String -> Ledger -> [EntryTransaction]
|
|
ledgerTransactionsMatching s l = filter (\t -> matchTransactionAccount s t) (ledgerTransactions l)
|
|
|