From 1fa5e09dfdde1ff48df4ea0de6a87edc53747909 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 9 Feb 2007 01:23:12 +0000 Subject: [PATCH] split into modules --- Options.hs | 9 + Parse.hs | 245 +++++++++++++++++++++++++++ Tests.hs | 153 +++++++++++++++++ Types.hs | 83 +++++++++ hledger.hs | 490 ++--------------------------------------------------- 5 files changed, 502 insertions(+), 478 deletions(-) create mode 100644 Parse.hs create mode 100644 Tests.hs create mode 100644 Types.hs diff --git a/Options.hs b/Options.hs index e301bc955..837a4ca42 100644 --- a/Options.hs +++ b/Options.hs @@ -2,6 +2,8 @@ module Options where import System.Console.GetOpt import Data.Maybe ( fromMaybe ) +import System.Environment (getEnv) +--import TildeExpand -- confuses my ghc 6.7 data Flag = File String | Version deriving Show @@ -23,3 +25,10 @@ getOptions argv = get_content :: Flag -> Maybe String get_content (File s) = Just s + +--defaultLedgerFile = tildeExpand "~/ledger.dat" +defaultLedgerFile = "ledger.dat" + +ledgerFile :: IO String +ledgerFile = do + getEnv "LEDGER" `catch` \_ -> return defaultLedgerFile >>= return diff --git a/Parse.hs b/Parse.hs new file mode 100644 index 000000000..46aaffed5 --- /dev/null +++ b/Parse.hs @@ -0,0 +1,245 @@ +{- +Here's the ledger 2.5 grammar: +"The ledger file format is quite simple, but also very flexible. It supports +many options, though typically the user can ignore most of them. They are +summarized below. The initial character of each line determines what the +line means, and how it should be interpreted. Allowable initial characters +are: + +NUMBER A line beginning with a number denotes an entry. It may be followed by any + number of lines, each beginning with whitespace, to denote the entry’s account + transactions. The format of the first line is: + + DATE[=EDATE] [*|!] [(CODE)] DESC + + If ‘*’ appears after the date (with optional effective date), it indicates the entry + is “cleared”, which can mean whatever the user wants it t omean. If ‘!’ appears + after the date, it indicates d the entry is “pending”; i.e., tentatively cleared from + the user’s point of view, but not yet actually cleared. If a ‘CODE’ appears in + parentheses, it may be used to indicate a check number, or the type of the + transaction. Following these is the payee, or a description of the transaction. + The format of each following transaction is: + + ACCOUNT AMOUNT [; NOTE] + + The ‘ACCOUNT’ may be surrounded by parentheses if it is a virtual + transactions, or square brackets if it is a virtual transactions that must + balance. The ‘AMOUNT’ can be followed by a per-unit transaction cost, + by specifying ‘ AMOUNT’, or a complete transaction cost with ‘@ AMOUNT’. + Lastly, the ‘NOTE’ may specify an actual and/or effective date for the + transaction by using the syntax ‘[ACTUAL_DATE]’ or ‘[=EFFECTIVE_DATE]’ or + ‘[ACTUAL_DATE=EFFECtIVE_DATE]’. + += An automated entry. A value expression must appear after the equal sign. + After this initial line there should be a set of one or more transactions, just as + if it were normal entry. If the amounts of the transactions have no commodity, + they will be applied as modifiers to whichever real transaction is matched by + the value expression. + +~ A period entry. A period expression must appear after the tilde. + After this initial line there should be a set of one or more transactions, just as + if it were normal entry. + + +! A line beginning with an exclamation mark denotes a command directive. It + must be immediately followed by the command word. The supported commands + are: + + ‘!include’ + Include the stated ledger file. + ‘!account’ + The account name is given is taken to be the parent of all transac- + tions that follow, until ‘!end’ is seen. + ‘!end’ Ends an account block. + +; A line beginning with a colon indicates a comment, and is ignored. + +Y If a line begins with a capital Y, it denotes the year used for all subsequent + entries that give a date without a year. The year should appear immediately + after the Y, for example: ‘Y2004’. This is useful at the beginning of a file, to + specify the year for that file. If all entries specify a year, however, this command + has no effect. + + +P Specifies a historical price for a commodity. These are usually found in a pricing + history file (see the ‘-Q’ option). The syntax is: + + P DATE SYMBOL PRICE + +N SYMBOL Indicates that pricing information is to be ignored for a given symbol, nor will + quotes ever be downloaded for that symbol. Useful with a home currency, such + as the dollar ($). It is recommended that these pricing options be set in the price + database file, which defaults to ‘~/.pricedb’. The syntax for this command is: + + N SYMBOL + + +D AMOUNT Specifies the default commodity to use, by specifying an amount in the expected + format. The entry command will use this commodity as the default when none + other can be determined. This command may be used multiple times, to set + the default flags for different commodities; whichever is seen last is used as the + default commodity. For example, to set US dollars as the default commodity, + while also setting the thousands flag and decimal flag for that commodity, use: + + D $1,000.00 + +C AMOUNT1 = AMOUNT2 + Specifies a commodity conversion, where the first amount is given to be equiv- + alent to the second amount. The first amount should use the decimal precision + desired during reporting: + + C 1.00 Kb = 1024 bytes + +i, o, b, h + These four relate to timeclock support, which permits ledger to read timelog + files. See the timeclock’s documentation for more info on the syntax of its + timelog files." +-} +-- parsec example: http://pandoc.googlecode.com/svn/trunk/src/Text/Pandoc/Readers/RST.hs + +module Parse where + +import Text.ParserCombinators.Parsec +import qualified Text.ParserCombinators.Parsec.Token as P +import Text.ParserCombinators.Parsec.Language + +import Types + +-- see sample data in Tests.hs + +-- set up token parsers, though we're not using these heavily yet +ledgerLanguageDef = LanguageDef { + commentStart = "" + , commentEnd = "" + , commentLine = ";" + , nestedComments = False + , identStart = letter <|> char '_' + , identLetter = alphaNum <|> oneOf "_':" + , opStart = opLetter emptyDef + , opLetter = oneOf "!#$%&*+./<=>?@\\^|-~" + , reservedOpNames= [] + , reservedNames = [] + , caseSensitive = False + } +lexer = P.makeTokenParser ledgerLanguageDef +whiteSpace = P.whiteSpace lexer +lexeme = P.lexeme lexer +symbol = P.symbol lexer +natural = P.natural lexer +parens = P.parens lexer +semi = P.semi lexer +identifier = P.identifier lexer +reserved = P.reserved lexer +reservedOp = P.reservedOp lexer + +-- ledger file parsers + +ledger :: Parser Ledger +ledger = do + ledgernondatalines + -- for now these must come first, unlike ledger + modifier_entries <- many ledgermodifierentry + periodic_entries <- many ledgerperiodicentry + -- + entries <- (many ledgerentry) "entry" + eof + return (Ledger modifier_entries periodic_entries entries) + +ledgernondatalines :: Parser [String] +ledgernondatalines = many (ledgerdirective <|> ledgercomment <|> do {whiteSpace1; return []}) + +ledgercomment :: Parser String +ledgercomment = char ';' >> restofline "comment" + +ledgerdirective :: Parser String +ledgerdirective = char '!' >> restofline "directive" + +ledgermodifierentry :: Parser ModifierEntry +ledgermodifierentry = do + char '=' "entry" + many spacenonewline + valueexpr <- restofline + transactions <- ledgertransactions + ledgernondatalines + return (ModifierEntry valueexpr transactions) + +ledgerperiodicentry :: Parser PeriodicEntry +ledgerperiodicentry = do + char '~' "entry" + many spacenonewline + periodexpr <- restofline + transactions <- ledgertransactions + ledgernondatalines + return (PeriodicEntry periodexpr transactions) + +ledgerentry :: Parser Entry +ledgerentry = do + date <- ledgerdate + status <- ledgerstatus + code <- ledgercode + description <- anyChar `manyTill` ledgereol + transactions <- ledgertransactions + ledgernondatalines + return (Entry date status code description transactions) + +ledgerdate :: Parser String +ledgerdate = do date <- many1 (digit <|> char '/'); many1 spacenonewline; return date + +ledgerstatus :: Parser Bool +ledgerstatus = try (do { char '*'; many1 spacenonewline; return True } ) <|> return False + +ledgercode :: Parser String +ledgercode = try (do { char '('; code <- anyChar `manyTill` char ')'; many1 spacenonewline; return code } ) <|> return "" + +ledgertransactions :: Parser [Transaction] +ledgertransactions = (ledgertransaction "transaction") `manyTill` (newline "blank line") + -- => unlike ledger, we need to end the file with a blank line + +ledgertransaction :: Parser Transaction +ledgertransaction = do + many1 spacenonewline + account <- ledgeraccount "account" + amount <- ledgeramount "amount" + many spacenonewline + ledgereol + many ledgercomment + return (Transaction account amount) + +-- account names may have single spaces in them, and are terminated by two or more spaces +ledgeraccount :: Parser String +ledgeraccount = many1 (alphaNum <|> char ':' <|> try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})) + +ledgeramount :: Parser Amount +ledgeramount = try (do + many1 spacenonewline + currency <- many (noneOf "-.0123456789\n") "currency" + quantity <- many1 (oneOf "-.0123456789") "quantity" + return (Amount currency (read quantity)) + ) <|> + return (Amount "" 0) + +ledgereol :: Parser String +ledgereol = ledgercomment <|> do {newline; return []} + +spacenonewline :: Parser Char +spacenonewline = satisfy (\c -> c `elem` " \v\f\t") + +restofline :: Parser String +restofline = anyChar `manyTill` newline + +whiteSpace1 :: Parser () +whiteSpace1 = do space; whiteSpace + + +-- ok, what can we do with it ? + +printParseResult r = + case r of + Left err -> do putStr "ledger parse error at "; print err + Right x -> do print x + +parseLedgerFile :: IO String -> IO (Either ParseError Ledger) +parseLedgerFile filepath = do + f <- filepath + parseFromFile ledger f >>= return + diff --git a/Tests.hs b/Tests.hs new file mode 100644 index 000000000..ea66d036f --- /dev/null +++ b/Tests.hs @@ -0,0 +1,153 @@ +module Tests where + +import Test.QuickCheck +import Test.HUnit +import Text.ParserCombinators.Parsec +--import Control.Exception (assert) + +import Parse +import Options + +-- sample data + +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_entry3 = "\ +\2007/01/01 * opening balance\n\ +\ assets:cash $4.82\n\ +\ equity:opening balances\n\ +\\n\ +\2007/01/01 * opening balance\n\ +\ assets:cash $4.82\n\ +\ equity:opening balances\n\ +\\n\ +\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_periodic_entry3 = "\ +\~ monthly from 2007/01/01\n\ +\ assets:cash $4.82\n\ +\ equity:opening balances\n\ +\\n\ +\~ monthly from 2007/01/01\n\ +\ assets:cash $4.82\n\ +\ equity:opening balances\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 = "" + +sample_ledger6 = "\ +\~ monthly from 2007/1/21\n\ +\ expenses:entertainment $16.23 ;netflix\n\ +\ assets:checking\n\ +\\n\ +\; 2007/01/01 * opening balance\n\ +\; assets:saving $200.04\n\ +\; equity:opening balances \n\ +\\n" --" + +-- hunit tests + +test1 = TestCase (assertEqual "1==1" 1 1) +sometests = TestList [TestLabel "test1" test1] + +tests = Test.HUnit.test [ + "test1" ~: "1==1" ~: 1 ~=? 1, + "test2" ~: assertEqual "2==2" 2 2 + ] + +-- quickcheck tests + +prop_test1 = 1 == 1 +prop2 = 1 == 1 + +-- commands + +test :: IO () +test = do + parseTest ledgertransaction sample_transaction + parseTest ledgertransaction sample_transaction2 + parseTest ledgerentry sample_entry + parseTest ledgerentry sample_entry2 + parseTest ledgerentry sample_entry3 + parseTest ledgerperiodicentry sample_periodic_entry + parseTest ledgerperiodicentry sample_periodic_entry2 + parseTest ledgerperiodicentry sample_periodic_entry3 + parseTest ledger sample_ledger + parseTest ledger sample_ledger2 + parseTest ledger sample_ledger3 + parseTest ledger sample_ledger4 + parseTest ledger sample_ledger5 + parseTest ledger sample_ledger6 + parseTest ledger sample_periodic_entry + parseTest ledger sample_periodic_entry2 + parseLedgerFile ledgerFile >>= printParseResult + return () +-- assert_ $ amount t1 == 8.50 +-- putStrLn "ok" +-- where assert_ e = assert e return () + diff --git a/Types.hs b/Types.hs new file mode 100644 index 000000000..071970c8c --- /dev/null +++ b/Types.hs @@ -0,0 +1,83 @@ +-- a data model +module Types where + +import Text.Printf + +data Ledger = Ledger { + modifier_entries :: [ModifierEntry], + periodic_entries :: [PeriodicEntry], + entries :: [Entry] + } deriving (Show, Eq) +data ModifierEntry = ModifierEntry { -- aka automated entry + valueexpr :: String, + m_transactions :: [Transaction] + } deriving (Eq) +data PeriodicEntry = PeriodicEntry { + periodexpr :: String, + p_transactions :: [Transaction] + } deriving (Eq) +data Entry = Entry { + date :: Date, + status :: Bool, + code :: String, + description :: String, + transactions :: [Transaction] + } deriving (Eq) +data Transaction = Transaction { + account :: Account, + amount :: Amount + } deriving (Eq) +data Amount = Amount { + currency :: String, + quantity :: Float + } deriving (Read, Eq) +type Date = String +type Account = String + +-- show methods + +showLedger :: Ledger -> String +showLedger l = "Ledger has\n" + ++ (showModifierEntries $ modifier_entries l) + ++ (showPeriodicEntries $ periodic_entries l) + ++ (showEntries $ entries l) + +showModifierEntries :: [ModifierEntry] -> String +showModifierEntries [] = "" +showModifierEntries es = + (show n) ++ " modifier " ++ (inflectEntries n) ++ ":\n" ++ unlines (map show es) + where n = length es + +showPeriodicEntries :: [PeriodicEntry] -> String +showPeriodicEntries [] = "" +showPeriodicEntries es = + (show n) ++ " periodic " ++ (inflectEntries n) ++ ":\n" ++ unlines (map show es) + where n = length es + +showEntries :: [Entry] -> String +showEntries [] = "" +showEntries es = + (show n) ++ " " ++ (inflectEntries n) ++ ":\n" ++ unlines (map show es) + where n = length es + +inflectEntries 1 = "entry" +inflectEntries _ = "entries" + +instance Show ModifierEntry where + show e = "= " ++ (valueexpr e) ++ "\n" ++ unlines (map show (m_transactions e)) + +instance Show PeriodicEntry where + show e = "~ " ++ (periodexpr e) ++ "\n" ++ unlines (map show (p_transactions e)) + +instance Show Entry where + show e = date e ++ " " ++ s ++ c ++ d ++ "\n" ++ unlines (map show (transactions e)) + where + d = description e + s = case (status e) of {True -> "* "; False -> ""} + c = case (length(code e) > 0) of {True -> (code e ++ " "); False -> ""} + +instance Show Transaction where + show t = printf " %-40s %20.2s" (take 40 $ account t) (show $ amount t) + +instance Show Amount where show a = (currency a) ++ (show $ quantity a) + diff --git a/hledger.hs b/hledger.hs index fd2d8557b..967a5edc4 100644 --- a/hledger.hs +++ b/hledger.hs @@ -1,497 +1,31 @@ #!/usr/bin/runhaskell --- hledger - ledger-compatible money management utilities (& haskell study) +-- hledger - ledger-compatible money management utilities (& haskell workout) -- GPLv3, (c) Simon Michael & contributors, --- -- John Wiegley's ledger is at http://newartisans.com/ledger.html . --- Here's the v2.5 grammar: -{- -"The ledger file format is quite simple, but also very flexible. It supports -many options, though typically the user can ignore most of them. They are -summarized below. The initial character of each line determines what the -line means, and how it should be interpreted. Allowable initial characters -are: -NUMBER A line beginning with a number denotes an entry. It may be followed by any - number of lines, each beginning with whitespace, to denote the entry’s account - transactions. The format of the first line is: - - DATE[=EDATE] [*|!] [(CODE)] DESC - - If ‘*’ appears after the date (with optional effective date), it indicates the entry - is “cleared”, which can mean whatever the user wants it t omean. If ‘!’ appears - after the date, it indicates d the entry is “pending”; i.e., tentatively cleared from - the user’s point of view, but not yet actually cleared. If a ‘CODE’ appears in - parentheses, it may be used to indicate a check number, or the type of the - transaction. Following these is the payee, or a description of the transaction. - The format of each following transaction is: - - ACCOUNT AMOUNT [; NOTE] - - The ‘ACCOUNT’ may be surrounded by parentheses if it is a virtual - transactions, or square brackets if it is a virtual transactions that must - balance. The ‘AMOUNT’ can be followed by a per-unit transaction cost, - by specifying ‘ AMOUNT’, or a complete transaction cost with ‘@ AMOUNT’. - Lastly, the ‘NOTE’ may specify an actual and/or effective date for the - transaction by using the syntax ‘[ACTUAL_DATE]’ or ‘[=EFFECTIVE_DATE]’ or - ‘[ACTUAL_DATE=EFFECtIVE_DATE]’. - -= An automated entry. A value expression must appear after the equal sign. - After this initial line there should be a set of one or more transactions, just as - if it were normal entry. If the amounts of the transactions have no commodity, - they will be applied as modifiers to whichever real transaction is matched by - the value expression. - -~ A period entry. A period expression must appear after the tilde. - After this initial line there should be a set of one or more transactions, just as - if it were normal entry. - - -! A line beginning with an exclamation mark denotes a command directive. It - must be immediately followed by the command word. The supported commands - are: - - ‘!include’ - Include the stated ledger file. - ‘!account’ - The account name is given is taken to be the parent of all transac- - tions that follow, until ‘!end’ is seen. - ‘!end’ Ends an account block. - -; A line beginning with a colon indicates a comment, and is ignored. - -Y If a line begins with a capital Y, it denotes the year used for all subsequent - entries that give a date without a year. The year should appear immediately - after the Y, for example: ‘Y2004’. This is useful at the beginning of a file, to - specify the year for that file. If all entries specify a year, however, this command - has no effect. - - -P Specifies a historical price for a commodity. These are usually found in a pricing - history file (see the ‘-Q’ option). The syntax is: - - P DATE SYMBOL PRICE - -N SYMBOL Indicates that pricing information is to be ignored for a given symbol, nor will - quotes ever be downloaded for that symbol. Useful with a home currency, such - as the dollar ($). It is recommended that these pricing options be set in the price - database file, which defaults to ‘~/.pricedb’. The syntax for this command is: - - N SYMBOL - - -D AMOUNT Specifies the default commodity to use, by specifying an amount in the expected - format. The entry command will use this commodity as the default when none - other can be determined. This command may be used multiple times, to set - the default flags for different commodities; whichever is seen last is used as the - default commodity. For example, to set US dollars as the default commodity, - while also setting the thousands flag and decimal flag for that commodity, use: - - D $1,000.00 - -C AMOUNT1 = AMOUNT2 - Specifies a commodity conversion, where the first amount is given to be equiv- - alent to the second amount. The first amount should use the decimal precision - desired during reporting: - - C 1.00 Kb = 1024 bytes - -i, o, b, h - These four relate to timeclock support, which permits ledger to read timelog - files. See the timeclock’s documentation for more info on the syntax of its - timelog files." --} --- parsec example: http://pandoc.googlecode.com/svn/trunk/src/Text/Pandoc/Readers/RST.hs - -import Debug.Trace -import Test.QuickCheck -import Test.HUnit - ---import TildeExpand -- confuses my ghc 6.7 import System (getArgs) -import System.Directory (getHomeDirectory) -import System.Environment (getEnv) -import Control.Exception (assert) -import Text.ParserCombinators.Parsec -import qualified Text.ParserCombinators.Parsec.Token as P -import Text.ParserCombinators.Parsec.Language -import Text.Printf import Options - --- sample data - -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_entry3 = "\ -\2007/01/01 * opening balance\n\ -\ assets:cash $4.82\n\ -\ equity:opening balances\n\ -\\n\ -\2007/01/01 * opening balance\n\ -\ assets:cash $4.82\n\ -\ equity:opening balances\n\ -\\n\ -\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_periodic_entry3 = "\ -\~ monthly from 2007/01/01\n\ -\ assets:cash $4.82\n\ -\ equity:opening balances\n\ -\\n\ -\~ monthly from 2007/01/01\n\ -\ assets:cash $4.82\n\ -\ equity:opening balances\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 = "" - -sample_ledger6 = "\ -\~ monthly from 2007/1/21\n\ -\ expenses:entertainment $16.23 ;netflix\n\ -\ assets:checking\n\ -\\n\ -\; 2007/01/01 * opening balance\n\ -\; assets:saving $200.04\n\ -\; equity:opening balances \n\ -\\n" --" - --- a data model - -data Ledger = Ledger { - modifier_entries :: [ModifierEntry], - periodic_entries :: [PeriodicEntry], - entries :: [Entry] - } deriving (Show, Eq) -data ModifierEntry = ModifierEntry { -- aka automated entry - valueexpr :: String, - m_transactions :: [Transaction] - } deriving (Eq) -data PeriodicEntry = PeriodicEntry { - periodexpr :: String, - p_transactions :: [Transaction] - } deriving (Eq) -data Entry = Entry { - date :: Date, - status :: Bool, - code :: String, - description :: String, - transactions :: [Transaction] - } deriving (Eq) -data Transaction = Transaction { - account :: Account, - amount :: Amount - } deriving (Eq) -data Amount = Amount { - currency :: String, - quantity :: Float - } deriving (Read, Eq) -type Date = String -type Account = String - --- ledger file parsing - --- set up token parsing, though we're not using it heavily yet -ledgerLanguageDef = LanguageDef { - commentStart = "" - , commentEnd = "" - , commentLine = ";" - , nestedComments = False - , identStart = letter <|> char '_' - , identLetter = alphaNum <|> oneOf "_':" - , opStart = opLetter emptyDef - , opLetter = oneOf "!#$%&*+./<=>?@\\^|-~" - , reservedOpNames= [] - , reservedNames = [] - , caseSensitive = False - } -lexer = P.makeTokenParser ledgerLanguageDef -whiteSpace = P.whiteSpace lexer -lexeme = P.lexeme lexer -symbol = P.symbol lexer -natural = P.natural lexer -parens = P.parens lexer -semi = P.semi lexer -identifier = P.identifier lexer -reserved = P.reserved lexer -reservedOp = P.reservedOp lexer - --- parsers - -ledger :: Parser Ledger -ledger = do - ledgernondatalines - -- for now these must come first, unlike ledger - modifier_entries <- many ledgermodifierentry - periodic_entries <- many ledgerperiodicentry - -- - entries <- (many ledgerentry) "entry" - eof - return (Ledger modifier_entries periodic_entries entries) - -ledgernondatalines :: Parser [String] -ledgernondatalines = many (ledgerdirective <|> ledgercomment <|> do {whiteSpace1; return []}) - -ledgercomment :: Parser String -ledgercomment = char ';' >> restofline "comment" - -ledgerdirective :: Parser String -ledgerdirective = char '!' >> restofline "directive" - -ledgermodifierentry :: Parser ModifierEntry -ledgermodifierentry = do - char '=' "entry" - many spacenonewline - valueexpr <- restofline - transactions <- ledgertransactions - ledgernondatalines - return (ModifierEntry valueexpr transactions) - -ledgerperiodicentry :: Parser PeriodicEntry -ledgerperiodicentry = do - char '~' "entry" - many spacenonewline - periodexpr <- restofline - transactions <- ledgertransactions - ledgernondatalines - return (PeriodicEntry periodexpr transactions) - -ledgerentry :: Parser Entry -ledgerentry = do - date <- ledgerdate - status <- ledgerstatus - code <- ledgercode - description <- anyChar `manyTill` ledgereol - transactions <- ledgertransactions - ledgernondatalines - return (Entry date status code description transactions) - -ledgerdate :: Parser String -ledgerdate = do date <- many1 (digit <|> char '/'); many1 spacenonewline; return date - -ledgerstatus :: Parser Bool -ledgerstatus = try (do { char '*'; many1 spacenonewline; return True } ) <|> return False - -ledgercode :: Parser String -ledgercode = try (do { char '('; code <- anyChar `manyTill` char ')'; many1 spacenonewline; return code } ) <|> return "" - -ledgertransactions :: Parser [Transaction] -ledgertransactions = (ledgertransaction "transaction") `manyTill` (newline "blank line") - -- => unlike ledger, we need to end the file with a blank line - -ledgertransaction :: Parser Transaction -ledgertransaction = do - many1 spacenonewline - account <- ledgeraccount "account" - amount <- ledgeramount "amount" - many spacenonewline - ledgereol - many ledgercomment - return (Transaction account amount) - --- account names may have single spaces in them, and are terminated by two or more spaces -ledgeraccount :: Parser String -ledgeraccount = many1 (alphaNum <|> char ':' <|> try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})) - -ledgeramount :: Parser Amount -ledgeramount = try (do - many1 spacenonewline - currency <- many (noneOf "-.0123456789\n") "currency" - quantity <- many1 (oneOf "-.0123456789") "quantity" - return (Amount currency (read quantity)) - ) <|> - return (Amount "" 0) - -ledgereol :: Parser String -ledgereol = ledgercomment <|> do {newline; return []} - -spacenonewline :: Parser Char -spacenonewline = satisfy (\c -> c `elem` " \v\f\t") - -restofline :: Parser String -restofline = anyChar `manyTill` newline - -whiteSpace1 :: Parser () -whiteSpace1 = do space; whiteSpace - --- tests - -test1 = TestCase (assertEqual "1==1" 1 1) -sometests = TestList [TestLabel "test1" test1] - -tests = Test.HUnit.test [ - "test1" ~: "1==1" ~: 1 ~=? 1, - "test2" ~: assertEqual "2==2" 2 2 - ] - -prop_test1 = 1 == 1 -prop2 = 1 == 1 - -test :: IO () -test = do - parseTest ledgertransaction sample_transaction - parseTest ledgertransaction sample_transaction2 - parseTest ledgerentry sample_entry - parseTest ledgerentry sample_entry2 - parseTest ledgerentry sample_entry3 - parseTest ledgerperiodicentry sample_periodic_entry - parseTest ledgerperiodicentry sample_periodic_entry2 - parseTest ledgerperiodicentry sample_periodic_entry3 - parseTest ledger sample_ledger - parseTest ledger sample_ledger2 - parseTest ledger sample_ledger3 - parseTest ledger sample_ledger4 - parseTest ledger sample_ledger5 - parseTest ledger sample_ledger6 - parseTest ledger sample_periodic_entry - parseTest ledger sample_periodic_entry2 - parseMyLedgerFile >>= printParseResult - return () --- assert_ $ amount t1 == 8.50 --- putStrLn "ok" --- where assert_ e = assert e return () - -printParseResult r = - case r of - Left err -> do putStr "ledger parse error at "; print err - Right x -> do print x - --- ok, what can we do with it ? - -showLedger :: Ledger -> String -showLedger l = "Ledger has\n" - ++ (showModifierEntries $ modifier_entries l) - ++ (showPeriodicEntries $ periodic_entries l) - ++ (showEntries $ entries l) - -showModifierEntries :: [ModifierEntry] -> String -showModifierEntries [] = "" -showModifierEntries es = - (show n) ++ " modifier " ++ (inflectEntries n) ++ ":\n" ++ unlines (map show es) - where n = length es - -showPeriodicEntries :: [PeriodicEntry] -> String -showPeriodicEntries [] = "" -showPeriodicEntries es = - (show n) ++ " periodic " ++ (inflectEntries n) ++ ":\n" ++ unlines (map show es) - where n = length es - -showEntries :: [Entry] -> String -showEntries [] = "" -showEntries es = - (show n) ++ " " ++ (inflectEntries n) ++ ":\n" ++ unlines (map show es) - where n = length es - -inflectEntries 1 = "entry" -inflectEntries _ = "entries" - -instance Show ModifierEntry where - show e = "= " ++ (valueexpr e) ++ "\n" ++ unlines (map show (m_transactions e)) - -instance Show PeriodicEntry where - show e = "~ " ++ (periodexpr e) ++ "\n" ++ unlines (map show (p_transactions e)) - -instance Show Entry where - show e = date e ++ " " ++ s ++ c ++ d ++ "\n" ++ unlines (map show (transactions e)) - where - d = description e - s = case (status e) of {True -> "* "; False -> ""} - c = case (length(code e) > 0) of {True -> (code e ++ " "); False -> ""} - -instance Show Transaction where - show t = printf " %-40s %20.2s" (take 40 $ account t) (show $ amount t) - -instance Show Amount where show a = (currency a) ++ (show $ quantity a) - -parseMyLedgerFile :: IO (Either ParseError Ledger) -parseMyLedgerFile = do - ledgerFile >>= parseFromFile ledger >>= return - where - ledgerFile = 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 +import Types +import Parse +import Tests -- commands register :: IO () register = do - p <- parseMyLedgerFile + p <- parseLedgerFile ledgerFile case p of - Left err -> do putStr "ledger parse error at "; print err + Left e -> do putStr "ledger parse error at "; print e Right l -> putStr $ showLedger l main :: IO () main = do (opts, args) <- getArgs >>= getOptions - putStr "options: "; print opts - putStr "arguments: "; print args + --putStr "options: "; print opts + --putStr "arguments: "; print args if "reg" `elem` args - then register - else return () + then register + else if "test" `elem` args + then test + else return ()