mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-19 18:29:36 +03:00
type signatures
This commit is contained in:
parent
a316e901e7
commit
b95709270b
72
hledger.hs
72
hledger.hs
@ -1,8 +1,9 @@
|
||||
#!/usr/bin/runhaskell
|
||||
-- hledger - ledger-compatible money management utilities
|
||||
-- hledger - ledger-compatible money management utilities (& haskell study)
|
||||
-- GPLv3, (c) Simon Michael & contributors,
|
||||
-- ledger is at http://newartisans.com/ledger.html
|
||||
-- here's the v2.5 grammar:
|
||||
--
|
||||
-- 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
|
||||
@ -99,6 +100,7 @@ i, o, b, h
|
||||
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
|
||||
@ -279,6 +281,8 @@ reserved = P.reserved lexer
|
||||
reservedOp = P.reservedOp lexer
|
||||
|
||||
-- parsers
|
||||
|
||||
ledger :: Parser Ledger
|
||||
ledger = do
|
||||
ledgernondatalines
|
||||
-- for now these must come first, unlike ledger
|
||||
@ -289,19 +293,16 @@ ledger = do
|
||||
eof
|
||||
return (Ledger modifier_entries periodic_entries entries)
|
||||
|
||||
ledgernondatalines :: Parser [String]
|
||||
ledgernondatalines = many (ledgerdirective <|> ledgercomment <|> do {whiteSpace1; return []})
|
||||
|
||||
whiteSpace1 = do space; whiteSpace
|
||||
|
||||
restofline = anyChar `manyTill` newline
|
||||
|
||||
ledgercomment :: Parser String
|
||||
ledgercomment = char ';' >> restofline <?> "comment"
|
||||
|
||||
ledgerdirective :: Parser String
|
||||
ledgerdirective = char '!' >> restofline <?> "directive"
|
||||
|
||||
ledgertransactions = (ledgertransaction <?> "transaction") `manyTill` (newline <?> "blank line")
|
||||
-- => unlike ledger, we need to end the file with a blank line
|
||||
|
||||
ledgermodifierentry :: Parser ModifierEntry
|
||||
ledgermodifierentry = do
|
||||
char '=' <?> "entry"
|
||||
many spacenonewline
|
||||
@ -310,6 +311,7 @@ ledgermodifierentry = do
|
||||
ledgernondatalines
|
||||
return (ModifierEntry valueexpr transactions)
|
||||
|
||||
ledgerperiodicentry :: Parser PeriodicEntry
|
||||
ledgerperiodicentry = do
|
||||
char '~' <?> "entry"
|
||||
many spacenonewline
|
||||
@ -318,6 +320,7 @@ ledgerperiodicentry = do
|
||||
ledgernondatalines
|
||||
return (PeriodicEntry periodexpr transactions)
|
||||
|
||||
ledgerentry :: Parser Entry
|
||||
ledgerentry = do
|
||||
date <- ledgerdate
|
||||
status <- ledgerstatus
|
||||
@ -327,12 +330,20 @@ ledgerentry = do
|
||||
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"
|
||||
@ -343,8 +354,10 @@ ledgertransaction = do
|
||||
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"
|
||||
@ -353,10 +366,18 @@ ledgeramount = try (do
|
||||
) <|>
|
||||
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)
|
||||
@ -370,6 +391,7 @@ tests = Test.HUnit.test [
|
||||
prop_test1 = 1 == 1
|
||||
prop2 = 1 == 1
|
||||
|
||||
test :: IO ()
|
||||
test = do
|
||||
parseTest ledgertransaction sample_transaction
|
||||
parseTest ledgertransaction sample_transaction2
|
||||
@ -400,31 +422,25 @@ printParseResult r =
|
||||
|
||||
-- ok, what can we do with it ?
|
||||
|
||||
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
|
||||
|
||||
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)
|
||||
@ -451,13 +467,27 @@ instance Show Transaction where
|
||||
|
||||
instance Show Amount where show a = (currency a) ++ (show $ quantity a)
|
||||
|
||||
r = register
|
||||
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
|
||||
|
||||
-- commands
|
||||
|
||||
register :: IO ()
|
||||
register = do
|
||||
p <- parseMyLedgerFile
|
||||
case p of
|
||||
Left err -> do putStr "ledger parse error at "; print err
|
||||
Right l -> putStr $ showLedger l
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
(opts, args) <- getArgs >>= getOptions
|
||||
putStr "options: "; print opts
|
||||
|
Loading…
Reference in New Issue
Block a user