From 55eb391f50398b590b2484b2c82564b6b55ff71f Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 28 Jan 2007 08:26:25 +0000 Subject: [PATCH] a partly-working parser for the ledger file format --- hledger.hs | 244 ++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 224 insertions(+), 20 deletions(-) diff --git a/hledger.hs b/hledger.hs index b341904b2..c1bef4657 100644 --- a/hledger.hs +++ b/hledger.hs @@ -1,26 +1,230 @@ --- ledger-compatible money management tools --- (c) 2007 Simon Michael & contributors, released under GPL v3 or later +-- hledger - ledger-like money management utilities +-- GPLv3, (c) Simon Michael & contributors, +-- ledger is at http://newartisans.com/ledger.html +import System.Directory (getHomeDirectory) +import System.Environment (getEnv) import Control.Exception (assert) - --- data model -type Date = String -type Account = String -type Money = Float --- a transaction records a movement of money between two accounts -data Transaction = Transaction { - date :: Date, - account :: Account, -- debit this - other_account :: Account, -- credit this - description :: String, - amount :: Money - } +import Text.ParserCombinators.Parsec +import qualified Text.ParserCombinators.Parsec.Token as P +import Text.ParserCombinators.Parsec.Language (haskellDef) +--import TildeExpand -- confuses my ghc 6.7 -- sample data -t1 = Transaction "2007-01-01" "checking" "food" "joe's diner" 8.50 --- tests +sample_entry = "\ +\2007/01/27 * joes diner\n\ +\ expenses:food:dining $10.00\n\ +\ expenses:gifts $10.00\n\ +\ assets:checking $-20.00\n\ +\\n\" --" + +sample_entry2 = "\ +\2007/01/28 coopportunity\n\ +\ expenses:food:groceries $47.18\n\ +\ assets:checking\n\ +\\n" --" + +sample_periodic_entry = "\ +\~ monthly from 2007/2/2\n\ +\ assets:saving $200.00\n\ +\ assets:checking\n\ +\\n" --" + +sample_periodic_entry2 = "\ +\~ monthly from 2007/2/2\n\ +\ assets:saving $200.00 ;auto savings\n\ +\ assets:checking\n\ +\\n" --" + +sample_transaction = " expenses:food:dining $10.00\n" + +sample_transaction2 = " assets:checking\n" + +sample_ledger = "\ +\\n\ +\2007/01/27 * joes diner\n\ +\ expenses:food:dining $10.00\n\ +\ expenses:gifts $10.00\n\ +\ assets:checking $-20.00\n\ +\\n\ +\\n\ +\2007/01/28 coopportunity\n\ +\ expenses:food:groceries $47.18\n\ +\ assets:checking $-47.18\n\ +\\n\ +\" --" + +sample_ledger2 = "\ +\;comment\n\ +\2007/01/27 * joes diner\n\ +\ expenses:food:dining $10.00\n\ +\ assets:checking $-47.18\n\ +\\n" --" + +sample_ledger3 = "\ +\2007/01/27 * joes diner\n\ +\ expenses:food:dining $10.00\n\ +\;intra-entry comment\n\ +\ assets:checking $-47.18\n\ +\\n" --" + +sample_ledger4 = "\ +\!include \"somefile\"\n\ +\2007/01/27 * joes diner\n\ +\ expenses:food:dining $10.00\n\ +\ assets:checking $-47.18\n\ +\\n" --" + +sample_ledger5 = "" + +-- a data model + +data Ledger = Ledger { + modifier_entries :: [ModifierEntry], + periodic_entries :: [PeriodicEntry], + entries :: [Entry] + } deriving (Show, Eq) +data Entry = Entry { + date :: Date, + status :: Bool, + code :: String, + description :: String, + transactions :: [Transaction] + } deriving (Show, Eq) +data ModifierEntry = ModifierEntry { + valueexpr :: String, + m_transactions :: [Transaction] + } deriving (Show, Eq) +data PeriodicEntry = PeriodicEntry { + periodexpr :: String, + p_transactions :: [Transaction] + } deriving (Show, Eq) +data Transaction = Transaction { + account :: Account, + amount :: Amount + } deriving (Show, Eq) +data Amount = Amount { + currency :: String, + quantity :: Float + } deriving (Read, Show, Eq) +type Date = String +type Account = String + +-- ledger file parsing + +ledger = do + ledgernondatalines + -- unlike ledger these must be first for now + modifier_entries <- many ledgermodifierentry + periodic_entries <- many ledgerperiodicentry + -- + entries <- (many ledgerentry) "entry" + eof + return (Ledger modifier_entries periodic_entries entries) + +ledgernondatalines = many (ledgercomment <|> ledgerdirective <|> do {space; return []}) + +ledgercomment = char ';' >> anyChar `manyTill` newline "comment" + +ledgerdirective = char '!' >> anyChar `manyTill` newline "directive" + +ledgermodifierentry = do + ledgernondatalines + char '=' "entry" + valueexpr <- anyChar `manyTill` newline + transactions <- (ledgertransaction "transaction") `manyTill` (newline "blank line") + spaces + return (ModifierEntry valueexpr transactions) + +ledgerperiodicentry = do + ledgernondatalines + char '~' "entry" + periodexpr <- anyChar `manyTill` newline + transactions <- (ledgertransaction "transaction") `manyTill` (newline "blank line") + spaces + return (PeriodicEntry periodexpr transactions) + +ledgerentry = do + ledgernondatalines + date <- ledgerdate + many1 spacenonewline + status <- ledgerstatus + code <- ledgercode + description <- anyChar `manyTill` ledgereol + transactions <- (ledgertransaction "transaction") `manyTill` (newline "blank line") + -- unlike ledger, we need the file to end with a blank line + spaces + return (Entry date status code description transactions) + +ledgerdate = many1 (digit <|> char '/') + +ledgerstatus = try (do { char '*'; many1 spacenonewline; return True } ) <|> return False + +ledgercode = try (do { char '('; code <- anyChar `manyTill` char ')'; return code } ) <|> return "" + +ledgertransaction = do + many (ledgercomment <|> ledgerdirective) + many1 spacenonewline + account <- ledgeraccount "account" + amount <- ledgeramount "amount" + return (Transaction account amount) + +--ledgeraccount = do {alphaNum; many (alphaNum <|> char ':' <|> try (do {spacenonewline; notFollowedBy spacenonewline; return ' '}))} +ledgeraccount = many1 (alphaNum <|> char ':' <|> try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})) + +twoormorespaces = do spacenonewline; many1 spacenonewline + +ledgeramount = try (do + many1 spacenonewline --twoormorespaces + currency <- many (noneOf "-.0123456789\n") "currency" + quantity <- (oneOf "-.0123456789") `manyTill` ledgereol "quantity" + return (Amount currency (read quantity)) + ) <|> do + ledgereol + return (Amount "" 0) -- change later to balance entry + +ledgereol = do {newline; return []} <|> ledgercomment + +spacenonewline = satisfy (\c -> c `elem` " \v\f\t") + +-- run tests + +parseMyLedgerFile = do + fname <- ledgerFilePath + parsed <- parseFromFile ledger fname + return parsed + where + ledgerFilePath = do + filepath <- getEnv "LEDGER" `catch` \_ -> return "ledger.dat" + -- don't know how to accomplish this great feat + --ledger_file <- tildeExpand filepath + let ledger_file = filepath + return ledger_file + main = do - assert_ $ amount t1 == 8.50 - putStrLn "ok" - where assert_ e = assert e return () + showParseResult (parse ledgertransaction "" sample_transaction) + showParseResult (parse ledgertransaction "" sample_transaction2) + showParseResult (parse ledgerentry "" sample_entry) + showParseResult (parse ledgerentry "" sample_entry2) + showParseResult (parse ledgerperiodicentry "" sample_periodic_entry) + showParseResult (parse ledgerperiodicentry "" sample_periodic_entry2) + showParseResult (parse ledger "" sample_ledger) + showParseResult (parse ledger "" sample_ledger2) + showParseResult (parse ledger "" sample_ledger3) + showParseResult (parse ledger "" sample_ledger4) + showParseResult (parse ledger "" sample_ledger5) + showParseResult (parse ledger "" sample_periodic_entry) + showParseResult (parse ledger "" sample_periodic_entry2) + parseMyLedgerFile >>= showParseResult + where + showParseResult r = + case r of + Left err -> do putStr "ledger parse error at "; print err + Right x -> print x + + + +-- assert_ $ amount t1 == 8.50 +-- putStrLn "ok" +-- where assert_ e = assert e return ()