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