parsing: comments can also start with # in col 0
This commit is contained in:
		
							parent
							
								
									bab6ec041b
								
							
						
					
					
						commit
						762a1b4d74
					
				@ -34,7 +34,8 @@ module Hledger.Read.JournalReader (
 | 
				
			|||||||
  amountp',
 | 
					  amountp',
 | 
				
			||||||
  mamountp',
 | 
					  mamountp',
 | 
				
			||||||
  numberp,
 | 
					  numberp,
 | 
				
			||||||
  emptyline
 | 
					  emptyorcommentlinep,
 | 
				
			||||||
 | 
					  followingcommentp
 | 
				
			||||||
#ifdef TESTS
 | 
					#ifdef TESTS
 | 
				
			||||||
  -- * Tests
 | 
					  -- * Tests
 | 
				
			||||||
  -- disabled by default, HTF not available on windows
 | 
					  -- disabled by default, HTF not available on windows
 | 
				
			||||||
@ -160,7 +161,7 @@ journal = do
 | 
				
			|||||||
                           , liftM (return . addModifierTransaction) modifiertransaction
 | 
					                           , liftM (return . addModifierTransaction) modifiertransaction
 | 
				
			||||||
                           , liftM (return . addPeriodicTransaction) periodictransaction
 | 
					                           , liftM (return . addPeriodicTransaction) periodictransaction
 | 
				
			||||||
                           , liftM (return . addHistoricalPrice) historicalpricedirective
 | 
					                           , liftM (return . addHistoricalPrice) historicalpricedirective
 | 
				
			||||||
                           , emptyline >> return (return id)
 | 
					                           , emptyorcommentlinep >> return (return id)
 | 
				
			||||||
                           ] <?> "journal transaction or directive"
 | 
					                           ] <?> "journal transaction or directive"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- cf http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives
 | 
					-- cf http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives
 | 
				
			||||||
@ -326,7 +327,7 @@ transaction = do
 | 
				
			|||||||
  status <- status <?> "cleared flag"
 | 
					  status <- status <?> "cleared flag"
 | 
				
			||||||
  code <- codep <?> "transaction code"
 | 
					  code <- codep <?> "transaction code"
 | 
				
			||||||
  description <- descriptionp >>= return . strip
 | 
					  description <- descriptionp >>= return . strip
 | 
				
			||||||
  comment <- try followingcomment <|> (newline >> return "")
 | 
					  comment <- try followingcommentp <|> (newline >> return "")
 | 
				
			||||||
  let tags = tagsInComment comment
 | 
					  let tags = tagsInComment comment
 | 
				
			||||||
  postings <- postings
 | 
					  postings <- postings
 | 
				
			||||||
  return $ txnTieKnot $ Transaction date edate status code description comment tags postings ""
 | 
					  return $ txnTieKnot $ Transaction date edate status code description comment tags postings ""
 | 
				
			||||||
@ -514,7 +515,7 @@ postingp = do
 | 
				
			|||||||
  _ <- fixedlotprice
 | 
					  _ <- fixedlotprice
 | 
				
			||||||
  many spacenonewline
 | 
					  many spacenonewline
 | 
				
			||||||
  ctx <- getState
 | 
					  ctx <- getState
 | 
				
			||||||
  comment <- try followingcomment <|> (newline >> return "")
 | 
					  comment <- try followingcommentp <|> (newline >> return "")
 | 
				
			||||||
  let tags = tagsInComment comment
 | 
					  let tags = tagsInComment comment
 | 
				
			||||||
  -- oh boy
 | 
					  -- oh boy
 | 
				
			||||||
  d  <- maybe (return Nothing) (either (fail.show) (return.Just)) (parseWithCtx ctx date `fmap` dateValueFromTags tags)
 | 
					  d  <- maybe (return Nothing) (either (fail.show) (return.Just)) (parseWithCtx ctx date `fmap` dateValueFromTags tags)
 | 
				
			||||||
@ -810,23 +811,28 @@ test_numberp = do
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
-- comment parsers
 | 
					-- comment parsers
 | 
				
			||||||
 | 
					
 | 
				
			||||||
emptyline :: GenParser Char JournalContext ()
 | 
					emptyorcommentlinep :: GenParser Char JournalContext ()
 | 
				
			||||||
emptyline = do many spacenonewline
 | 
					emptyorcommentlinep = do
 | 
				
			||||||
               optional $ (char ';' <?> "comment") >> many (noneOf "\n")
 | 
					  many spacenonewline >> (comment <|> (many spacenonewline >> newline >> return ""))
 | 
				
			||||||
               newline
 | 
					 | 
				
			||||||
  return ()
 | 
					  return ()
 | 
				
			||||||
 | 
					
 | 
				
			||||||
followingcomment :: GenParser Char JournalContext String
 | 
					followingcommentp :: GenParser Char JournalContext String
 | 
				
			||||||
followingcomment =
 | 
					followingcommentp =
 | 
				
			||||||
  -- ptrace "followingcomment"
 | 
					  -- ptrace "followingcommentp"
 | 
				
			||||||
  do samelinecomment <- many spacenonewline >> (try commentline <|> (newline >> return ""))
 | 
					  do samelinecomment <- many spacenonewline >> (try semicoloncomment <|> (newline >> return ""))
 | 
				
			||||||
     newlinecomments <- many (try (many1 spacenonewline >> commentline))
 | 
					     newlinecomments <- many (try (many1 spacenonewline >> semicoloncomment))
 | 
				
			||||||
     return $ unlines $ samelinecomment:newlinecomments
 | 
					     return $ unlines $ samelinecomment:newlinecomments
 | 
				
			||||||
 | 
					
 | 
				
			||||||
commentline :: GenParser Char JournalContext String
 | 
					comment :: GenParser Char JournalContext String
 | 
				
			||||||
commentline = do
 | 
					comment = commentStartingWith "#;"
 | 
				
			||||||
  -- ptrace "commentline"
 | 
					
 | 
				
			||||||
  char ';'
 | 
					semicoloncomment :: GenParser Char JournalContext String
 | 
				
			||||||
 | 
					semicoloncomment = commentStartingWith ";"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					commentStartingWith :: String -> GenParser Char JournalContext String
 | 
				
			||||||
 | 
					commentStartingWith cs = do
 | 
				
			||||||
 | 
					  -- ptrace "commentStartingWith"
 | 
				
			||||||
 | 
					  oneOf cs
 | 
				
			||||||
  many spacenonewline
 | 
					  many spacenonewline
 | 
				
			||||||
  l <- anyChar `manyTill` eolof
 | 
					  l <- anyChar `manyTill` eolof
 | 
				
			||||||
  optional newline
 | 
					  optional newline
 | 
				
			||||||
@ -899,7 +905,7 @@ test_Hledger_Read_JournalReader = TestList $ concat [
 | 
				
			|||||||
    test_spaceandamountormissing,
 | 
					    test_spaceandamountormissing,
 | 
				
			||||||
    test_tagcomment,
 | 
					    test_tagcomment,
 | 
				
			||||||
    test_inlinecomment,
 | 
					    test_inlinecomment,
 | 
				
			||||||
    test_commentlines,
 | 
					    test_comments,
 | 
				
			||||||
    test_ledgerDateSyntaxToTags,
 | 
					    test_ledgerDateSyntaxToTags,
 | 
				
			||||||
    test_postingp,
 | 
					    test_postingp,
 | 
				
			||||||
    test_transaction,
 | 
					    test_transaction,
 | 
				
			||||||
@ -915,10 +921,10 @@ test_Hledger_Read_JournalReader = TestList $ concat [
 | 
				
			|||||||
     assertParse (parseWithCtx nullctx directive "account some:account\n")
 | 
					     assertParse (parseWithCtx nullctx directive "account some:account\n")
 | 
				
			||||||
     assertParse (parseWithCtx nullctx (directive >> directive) "!account a\nend\n")
 | 
					     assertParse (parseWithCtx nullctx (directive >> directive) "!account a\nend\n")
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  ,"commentline" ~: do
 | 
					  ,"comment" ~: do
 | 
				
			||||||
     assertParse (parseWithCtx nullctx commentline "; some comment \n")
 | 
					     assertParse (parseWithCtx nullctx comment "; some comment \n")
 | 
				
			||||||
     assertParse (parseWithCtx nullctx commentline " \t; x\n")
 | 
					     assertParse (parseWithCtx nullctx comment " \t; x\n")
 | 
				
			||||||
     assertParse (parseWithCtx nullctx commentline ";x")
 | 
					     assertParse (parseWithCtx nullctx comment "#x")
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  ,"date" ~: do
 | 
					  ,"date" ~: do
 | 
				
			||||||
     assertParse (parseWithCtx nullctx date "2011/1/1")
 | 
					     assertParse (parseWithCtx nullctx date "2011/1/1")
 | 
				
			||||||
 | 
				
			|||||||
@ -56,7 +56,7 @@ import System.FilePath
 | 
				
			|||||||
import Hledger.Data
 | 
					import Hledger.Data
 | 
				
			||||||
-- XXX too much reuse ?
 | 
					-- XXX too much reuse ?
 | 
				
			||||||
import Hledger.Read.JournalReader (
 | 
					import Hledger.Read.JournalReader (
 | 
				
			||||||
  directive, historicalpricedirective, defaultyeardirective, emptyline, datetimep,
 | 
					  directive, historicalpricedirective, defaultyeardirective, emptyorcommentlinep, datetimep,
 | 
				
			||||||
  parseJournalWith, getParentAccount
 | 
					  parseJournalWith, getParentAccount
 | 
				
			||||||
  )
 | 
					  )
 | 
				
			||||||
import Hledger.Utils
 | 
					import Hledger.Utils
 | 
				
			||||||
@ -91,7 +91,7 @@ timelogFile = do items <- many timelogItem
 | 
				
			|||||||
      timelogItem = choice [ directive
 | 
					      timelogItem = choice [ directive
 | 
				
			||||||
                          , liftM (return . addHistoricalPrice) historicalpricedirective
 | 
					                          , liftM (return . addHistoricalPrice) historicalpricedirective
 | 
				
			||||||
                          , defaultyeardirective
 | 
					                          , defaultyeardirective
 | 
				
			||||||
                          , emptyline >> return (return id)
 | 
					                          , emptyorcommentlinep >> return (return id)
 | 
				
			||||||
                          , liftM (return . addTimeLogEntry)  timelogentry
 | 
					                          , liftM (return . addTimeLogEntry)  timelogentry
 | 
				
			||||||
                          ] <?> "timelog entry, or default year or historical price directive"
 | 
					                          ] <?> "timelog entry, or default year or historical price directive"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
				
			|||||||
		Loading…
	
		Reference in New Issue
	
	Block a user