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