lib: refine date parser error messages
This commit is contained in:
		
							parent
							
								
									132f8706d7
								
							
						
					
					
						commit
						39e7ef0311
					
				| @ -352,36 +352,43 @@ datep = do | |||||||
| 
 | 
 | ||||||
| datep' :: Maybe Year -> TextParser m Day | datep' :: Maybe Year -> TextParser m Day | ||||||
| datep' mYear = do | datep' mYear = do | ||||||
|  |   startPos <- getPosition | ||||||
|   d1 <- decimal <?> "year or month" |   d1 <- decimal <?> "year or month" | ||||||
|   sep <- satisfy isDateSepChar <?> "date separator" |   sep <- satisfy isDateSepChar <?> "date separator" | ||||||
|   d2 <- decimal <?> "month or day" |   d2 <- decimal <?> "month or day" | ||||||
|   fullDate d1 sep d2 <|> partialDate mYear d1 sep d2 |   fullDate startPos d1 sep d2 <|> partialDate startPos mYear d1 sep d2 | ||||||
|   <?> "full or partial date" |   <?> "full or partial date" | ||||||
| 
 | 
 | ||||||
|   where |   where | ||||||
| 
 | 
 | ||||||
|   fullDate :: Integer -> Char -> Int -> TextParser m Day |   fullDate :: SourcePos -> Integer -> Char -> Int -> TextParser m Day | ||||||
|   fullDate year sep1 month = do |   fullDate startPos year sep1 month = do | ||||||
|     sep2 <- satisfy isDateSepChar <?> "date separator" |     sep2 <- satisfy isDateSepChar <?> "date separator" | ||||||
|     day <- decimal <?> "day" |     day <- decimal <?> "day" | ||||||
|  |     endPos <- getPosition | ||||||
|     let dateStr = show year ++ [sep1] ++ show month ++ [sep2] ++ show day |     let dateStr = show year ++ [sep1] ++ show month ++ [sep2] ++ show day | ||||||
| 
 | 
 | ||||||
|     when (sep1 /= sep2) $ fail $ |     when (sep1 /= sep2) $ parseErrorAtRegion startPos endPos $ | ||||||
|       "invalid date (mixing date separators is not allowed): " ++ dateStr |       "invalid date (mixing date separators is not allowed): " ++ dateStr | ||||||
| 
 | 
 | ||||||
|     case fromGregorianValid year month day of |     case fromGregorianValid year month day of | ||||||
|       Nothing -> fail $ "well-formed but invalid date: " ++ dateStr |       Nothing -> parseErrorAtRegion startPos endPos $ | ||||||
|  |                    "well-formed but invalid date: " ++ dateStr | ||||||
|       Just date -> pure $! date |       Just date -> pure $! date | ||||||
| 
 | 
 | ||||||
|   partialDate :: Maybe Year -> Integer -> Char -> Int -> TextParser m Day |   partialDate | ||||||
|   partialDate mYear month sep day = case mYear of |     :: SourcePos -> Maybe Year -> Integer -> Char -> Int -> TextParser m Day | ||||||
|  |   partialDate startPos mYear month sep day = do | ||||||
|  |     endPos <- getPosition | ||||||
|  |     case mYear of | ||||||
|       Just year -> |       Just year -> | ||||||
|         case fromGregorianValid year (fromIntegral month) day of |         case fromGregorianValid year (fromIntegral month) day of | ||||||
|         Nothing -> fail $ "well-formed but invalid date: " ++ dateStr |           Nothing -> parseErrorAtRegion startPos endPos $ | ||||||
|  |                       "well-formed but invalid date: " ++ dateStr | ||||||
|           Just date -> pure $! date |           Just date -> pure $! date | ||||||
|         where dateStr = show year ++ [sep] ++ show month ++ [sep] ++ show day |         where dateStr = show year ++ [sep] ++ show month ++ [sep] ++ show day | ||||||
| 
 | 
 | ||||||
|     Nothing -> fail $ |       Nothing -> parseErrorAtRegion startPos endPos $ | ||||||
|         "partial date "++dateStr++" found, but the current year is unknown" |         "partial date "++dateStr++" found, but the current year is unknown" | ||||||
|         where dateStr = show month ++ [sep] ++ show day |         where dateStr = show month ++ [sep] ++ show day | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -2,7 +2,7 @@ | |||||||
| -- | -- | ||||||
| -- see: https://github.com/sol/hpack | -- see: https://github.com/sol/hpack | ||||||
| -- | -- | ||||||
| -- hash: fbcc49317255a91cf8d9795d99203ce5e9930e4981b2fc246349a6ea8d23af74 | -- hash: 86a93717a2fa0b215398b09da43e823e40cbf65bdd62a40ef0473549b2d5900c | ||||||
| 
 | 
 | ||||||
| name:           hledger-lib | name:           hledger-lib | ||||||
| version:        1.9.99 | version:        1.9.99 | ||||||
|  | |||||||
| @ -23,7 +23,7 @@ end comment | |||||||
|    b  0 |    b  0 | ||||||
|        ; date: 3.32 |        ; date: 3.32 | ||||||
| 
 | 
 | ||||||
| >>>2 /10:19/ | >>>2 /10:16/ | ||||||
| >>>=1 | >>>=1 | ||||||
| 
 | 
 | ||||||
| # 3. Ledger's bracketed date syntax is also supported: `[DATE]`, | # 3. Ledger's bracketed date syntax is also supported: `[DATE]`, | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user