start a token parser

This commit is contained in:
Simon Michael 2007-01-28 09:32:24 +00:00
parent 55eb391f50
commit e4bfce8d21

View File

@ -7,7 +7,7 @@ import System.Environment (getEnv)
import Control.Exception (assert) import Control.Exception (assert)
import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec
import qualified Text.ParserCombinators.Parsec.Token as P import qualified Text.ParserCombinators.Parsec.Token as P
import Text.ParserCombinators.Parsec.Language (haskellDef) import Text.ParserCombinators.Parsec.Language
--import TildeExpand -- confuses my ghc 6.7 --import TildeExpand -- confuses my ghc 6.7
-- sample data -- sample data
@ -112,6 +112,35 @@ type Date = String
type Account = String type Account = String
-- ledger file parsing -- ledger file parsing
-- struggling.. easier with a token parser ?
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 = do ledger = do
ledgernondatalines ledgernondatalines
@ -124,6 +153,7 @@ ledger = do
return (Ledger modifier_entries periodic_entries entries) return (Ledger modifier_entries periodic_entries entries)
ledgernondatalines = many (ledgercomment <|> ledgerdirective <|> do {space; return []}) ledgernondatalines = many (ledgercomment <|> ledgerdirective <|> do {space; return []})
--ledgernondatalines = many (ledgerdirective <|> do {whiteSpace; return []})
ledgercomment = char ';' >> anyChar `manyTill` newline <?> "comment" ledgercomment = char ';' >> anyChar `manyTill` newline <?> "comment"
@ -168,23 +198,24 @@ ledgertransaction = do
many1 spacenonewline many1 spacenonewline
account <- ledgeraccount <?> "account" account <- ledgeraccount <?> "account"
amount <- ledgeramount <?> "amount" amount <- ledgeramount <?> "amount"
many spacenonewline
ledgereol
return (Transaction account amount) return (Transaction account amount)
--ledgeraccount = do {alphaNum; many (alphaNum <|> char ':' <|> try (do {spacenonewline; notFollowedBy spacenonewline; return ' '}))} --ledgeraccount = many1 (alphaNum <|> char ':')
ledgeraccount = many1 (alphaNum <|> char ':' <|> try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})) ledgeraccount = many1 (alphaNum <|> char ':' <|> try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}}))
twoormorespaces = do spacenonewline; many1 spacenonewline --twoormorespaces = do spacenonewline; many1 spacenonewline
ledgeramount = try (do ledgeramount = try (do
many1 spacenonewline --twoormorespaces many1 spacenonewline --twoormorespaces
currency <- many (noneOf "-.0123456789\n") <?> "currency" currency <- many (noneOf "-.0123456789\n") <?> "currency"
quantity <- (oneOf "-.0123456789") `manyTill` ledgereol <?> "quantity" quantity <- many1 (oneOf "-.0123456789") <?> "quantity"
return (Amount currency (read quantity)) return (Amount currency (read quantity))
) <|> do ) <|>
ledgereol return (Amount "" 0) -- change later to balance the entry
return (Amount "" 0) -- change later to balance entry
ledgereol = do {newline; return []} <|> ledgercomment ledgereol = ledgercomment <|> do {newline; return []}
spacenonewline = satisfy (\c -> c `elem` " \v\f\t") spacenonewline = satisfy (\c -> c `elem` " \v\f\t")