lib: refactor: make the bracketed date tags parser a SimpleTextParser
This commit is contained in:
		
							parent
							
								
									0cff1634be
								
							
						
					
					
						commit
						892a1c6434
					
				| @ -95,10 +95,10 @@ where | ||||
| --- * imports | ||||
| import Prelude () | ||||
| import Prelude.Compat hiding (readFile) | ||||
| import Control.Arrow ((***)) | ||||
| import Control.Monad.Compat | ||||
| import Control.Monad.Except (ExceptT(..), runExceptT, throwError) --, catchError) | ||||
| import Control.Monad.State.Strict | ||||
| import Data.Bifunctor | ||||
| import Data.Char | ||||
| import Data.Data | ||||
| import Data.Default | ||||
| @ -703,7 +703,7 @@ exponentp :: TextParser m ((Quantity, Int) -> (Quantity, Int)) | ||||
| exponentp = do | ||||
|     char' 'e' | ||||
|     exp <- liftM read $ (++) <$> signp <*> some digitChar | ||||
|     return $ (* 10^^exp) *** (0 `max`) . (+ (-exp)) | ||||
|     return $ bimap (* 10^^exp) (max 0 . subtract exp) | ||||
|     <?> "exponentp" | ||||
| 
 | ||||
| -- | Interpret the raw parts of a number, using the provided amount style if any, | ||||
| @ -886,12 +886,11 @@ followingcommentandtagsp mdefdate = do | ||||
| 
 | ||||
|   -- Reparse the comment for any bracketed style posting dates. | ||||
|   -- Use the transaction date for defaults, if provided. | ||||
|   eBracketedDates <- fmap sequence | ||||
|            $ traverse (runErroringJournalParserAt (bracketedpostingdatesp mdefdate)) | ||||
|                       commentLines | ||||
|   let eBracketedDates = | ||||
|         traverse (runTextParserAt (bracketedpostingdatesp mdefdate)) commentLines | ||||
|   bracketedDates <- case eBracketedDates of | ||||
|     Right dss -> pure $ concat dss | ||||
|     Left e    -> throwError e | ||||
|     Left e    -> throwError $ parseErrorPretty e | ||||
| 
 | ||||
|   let pdates = tagDates ++ bracketedDates | ||||
|   -- pdbg 0 $ "allDates: "++show pdates | ||||
| @ -908,9 +907,6 @@ followingcommentandtagsp mdefdate = do | ||||
|     runTextParserAt parser (pos, txt) = | ||||
|       runTextParser (setPosition pos *> parser) txt | ||||
| 
 | ||||
|     runErroringJournalParserAt parser (pos, txt) = | ||||
|       runErroringJournalParser (setPosition pos *> parser) txt | ||||
| 
 | ||||
|     tagDate :: (SourcePos, Tag) -> Either String (TagName, Day) | ||||
|     tagDate (pos, (name, value)) = | ||||
|       case runTextParserAt (datep' myear) (pos, value) of | ||||
| @ -1016,8 +1012,7 @@ tagswithvaluepositions = do | ||||
| -- parsed fully to give useful errors. Missing years can be inferred only | ||||
| -- if a default date is provided. | ||||
| -- | ||||
| bracketedpostingdatesp | ||||
|   :: Monad m => Maybe Day -> ErroringJournalParser m [(TagName,Day)] | ||||
| bracketedpostingdatesp :: Maybe Day -> SimpleTextParser [(TagName,Day)] | ||||
| bracketedpostingdatesp mdefdate = do | ||||
|   -- pdbg 0 $ "bracketedpostingdatesp" | ||||
|   skipMany $ noneOf ['['] | ||||
| @ -1043,23 +1038,23 @@ bracketedpostingdatesp mdefdate = do | ||||
| -- default date is provided. A missing year in DATE2 will be inferred | ||||
| -- from DATE. | ||||
| -- | ||||
| -- >>> rejp (bracketeddatetagsp Nothing) "[2016/1/2=3/4]" | ||||
| -- >>> first parseErrorPretty $ rtp (bracketeddatetagsp Nothing) "[2016/1/2=3/4]" | ||||
| -- Right [("date",2016-01-02),("date2",2016-03-04)] | ||||
| -- | ||||
| -- >>> rejp (bracketeddatetagsp Nothing) "[1]" | ||||
| -- >>> first parseErrorPretty $ rtp (bracketeddatetagsp Nothing) "[1]" | ||||
| -- Left ...not a bracketed date... | ||||
| -- | ||||
| -- >>> rejp (bracketeddatetagsp Nothing) "[2016/1/32]" | ||||
| -- >>> first parseErrorPretty $ rtp (bracketeddatetagsp Nothing) "[2016/1/32]" | ||||
| -- Left ...1:11:...bad date: 2016/1/32... | ||||
| -- | ||||
| -- >>> rejp (bracketeddatetagsp Nothing) "[1/31]" | ||||
| -- >>> first parseErrorPretty $ rtp (bracketeddatetagsp Nothing) "[1/31]" | ||||
| -- Left ...1:6:...partial date 1/31 found, but the current year is unknown... | ||||
| -- | ||||
| -- >>> rejp (bracketeddatetagsp Nothing) "[0123456789/-.=/-.=]" | ||||
| -- >>> first parseErrorPretty $ rtp (bracketeddatetagsp Nothing) "[0123456789/-.=/-.=]" | ||||
| -- Left ...1:15:...bad date, different separators... | ||||
| -- | ||||
| bracketeddatetagsp :: Monad m => Maybe Day -> ErroringJournalParser m [(TagName, Day)] | ||||
| bracketeddatetagsp mdefdate = lift $ do | ||||
| bracketeddatetagsp :: Maybe Day -> SimpleTextParser [(TagName, Day)] | ||||
| bracketeddatetagsp mdefdate = do | ||||
|   -- pdbg 0 "bracketeddatetagsp" | ||||
|   try $ do | ||||
|     let digits = "0123456789" | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user