lib: Replace some regex functions with parsers.
This commit is contained in:
		
							parent
							
								
									20b39a5dd0
								
							
						
					
					
						commit
						b91b391d08
					
				| @ -41,6 +41,7 @@ where | ||||
| --- ** imports | ||||
| import Prelude () | ||||
| import "base-compat-batteries" Prelude.Compat hiding (fail) | ||||
| import Control.Applicative        (liftA2) | ||||
| import Control.Exception          (IOException, handle, throw) | ||||
| import Control.Monad              (liftM, unless, when) | ||||
| import Control.Monad.Except       (ExceptT, throwError) | ||||
| @ -48,13 +49,13 @@ import qualified Control.Monad.Fail as Fail | ||||
| import Control.Monad.IO.Class     (MonadIO, liftIO) | ||||
| import Control.Monad.State.Strict (StateT, get, modify', evalStateT) | ||||
| import Control.Monad.Trans.Class  (lift) | ||||
| import Data.Char                  (toLower, isDigit, isSpace, isAlphaNum, ord) | ||||
| import Data.Char                  (toLower, isDigit, isSpace, isAlphaNum, isAscii, ord) | ||||
| import Data.Bifunctor             (first) | ||||
| import "base-compat-batteries" Data.List.Compat | ||||
| import qualified Data.List.Split as LS (splitOn) | ||||
| import Data.Maybe | ||||
| import Data.Maybe (catMaybes, fromMaybe, isJust) | ||||
| import Data.MemoUgly (memo) | ||||
| import Data.Ord | ||||
| import Data.Ord (comparing) | ||||
| import qualified Data.Set as S | ||||
| import Data.Text (Text) | ||||
| import qualified Data.Text as T | ||||
| @ -62,17 +63,17 @@ import qualified Data.Text.Encoding as T | ||||
| import qualified Data.Text.IO as T | ||||
| import Data.Time.Calendar (Day) | ||||
| import Data.Time.Format (parseTimeM, defaultTimeLocale) | ||||
| import Safe | ||||
| import Safe (atMay, headMay, lastMay, readDef, readMay) | ||||
| import System.Directory (doesFileExist) | ||||
| import System.FilePath | ||||
| import System.FilePath ((</>), takeDirectory, takeExtension, takeFileName) | ||||
| import qualified Data.Csv as Cassava | ||||
| import qualified Data.Csv.Parser.Megaparsec as CassavaMP | ||||
| import qualified Data.ByteString as B | ||||
| import qualified Data.ByteString.Lazy as BL | ||||
| import Data.Foldable | ||||
| import Data.Foldable (asum, toList) | ||||
| import Text.Megaparsec hiding (match, parse) | ||||
| import Text.Megaparsec.Char | ||||
| import Text.Megaparsec.Custom | ||||
| import Text.Megaparsec.Char (char, newline, string) | ||||
| import Text.Megaparsec.Custom (customErrorBundlePretty, parseErrorAt) | ||||
| import Text.Printf (printf) | ||||
| 
 | ||||
| import Hledger.Data | ||||
| @ -834,10 +835,9 @@ validateCsv rules numhdrlines (Right rs) = validate $ applyConditionalSkips $ dr | ||||
|         Nothing -> r:(applyConditionalSkips rest) | ||||
|         Just cnt -> applyConditionalSkips (drop (cnt-1) rest) | ||||
|     validate [] = Right [] | ||||
|     validate rs@(_first:_) | ||||
|       | isJust lessthan2 = let r = fromJust lessthan2 in | ||||
|           Left $ printf "CSV record %s has less than two fields" (show r) | ||||
|       | otherwise        = Right rs | ||||
|     validate rs@(_first:_) = case lessthan2 of | ||||
|         Just r  -> Left $ printf "CSV record %s has less than two fields" (show r) | ||||
|         Nothing -> Right rs | ||||
|       where | ||||
|         lessthan2 = headMay $ filter ((<2).length) rs | ||||
| 
 | ||||
| @ -1199,7 +1199,13 @@ getEffectiveAssignment rules record f = lastMay $ map snd $ assignments | ||||
| -- | Render a field assignment's template, possibly interpolating referenced | ||||
| -- CSV field values. Outer whitespace is removed from interpolated values. | ||||
| renderTemplate ::  CsvRules -> CsvRecord -> FieldTemplate -> String | ||||
| renderTemplate rules record t = replaceAllBy (toRegex' "%[A-z0-9_-]+") (replaceCsvFieldReference rules record) t  -- PARTIAL: should not happen | ||||
| renderTemplate rules record t = maybe t concat $ parseMaybe | ||||
|     (many $ takeWhile1P Nothing (/='%') | ||||
|         <|> replaceCsvFieldReference rules record <$> referencep) | ||||
|     t | ||||
|   where | ||||
|     referencep = liftA2 (:) (char '%') (takeWhile1P (Just "reference") isDescriptorChar) :: Parsec CustomErr String String | ||||
|     isDescriptorChar c = isAscii c && (isAlphaNum c || c == '_' || c == '-') | ||||
| 
 | ||||
| -- | Replace something that looks like a reference to a csv field ("%date" or "%1) | ||||
| -- with that field's value. If it doesn't look like a field reference, or if we | ||||
|  | ||||
| @ -49,14 +49,14 @@ module Hledger.Utils.String ( | ||||
|  ) where | ||||
| 
 | ||||
| 
 | ||||
| import Data.Char | ||||
| import Data.List | ||||
| import Text.Megaparsec | ||||
| import Text.Megaparsec.Char | ||||
| import Data.Char (isDigit, isSpace, toLower, toUpper) | ||||
| import Data.List (intercalate, transpose) | ||||
| import Text.Megaparsec (Parsec, (<|>), (<?>), between, many, noneOf, oneOf, | ||||
|                         parseMaybe, sepBy, takeWhile1P) | ||||
| import Text.Megaparsec.Char (char, string) | ||||
| import Text.Printf (printf) | ||||
| 
 | ||||
| import Hledger.Utils.Parse | ||||
| import Hledger.Utils.Regex | ||||
| 
 | ||||
| 
 | ||||
| -- | Take elements from the end of a list. | ||||
| @ -341,12 +341,15 @@ takeWidth w (c:cs) | cw <= w   = c:takeWidth (w-cw) cs | ||||
| -- (not counted), and line breaks (in a multi-line string, the longest | ||||
| -- line determines the width). | ||||
| strWidth :: String -> Int | ||||
| strWidth "" = 0 | ||||
| strWidth s = maximum $ map (foldr (\a b -> charWidth a + b) 0) $ lines s' | ||||
|   where s' = stripAnsi s | ||||
| strWidth = maximum . (0:) . map (foldr (\a b -> charWidth a + b) 0) . lines . stripAnsi | ||||
| 
 | ||||
| stripAnsi :: String -> String | ||||
| stripAnsi = regexReplace (toRegex' "\ESC\\[([0-9]+;)*([0-9]+)?[ABCDHJKfmsu]") "" -- PARTIAL: should never happen, no backreferences | ||||
| stripAnsi s = maybe s concat $ parseMaybe (many $ takeWhile1P Nothing (/='\ESC') <|> "" <$ ansi) s | ||||
|   where | ||||
|     -- This parses lots of invalid ANSI escape codes, but that should be fine | ||||
|     ansi = string "\ESC[" *> digitSemicolons *> suffix <?> "ansi" :: Parsec CustomErr String Char | ||||
|     digitSemicolons = takeWhile1P Nothing (\c -> isDigit c || c == ';') | ||||
|     suffix = oneOf ['A', 'B', 'C', 'D', 'H', 'J', 'K', 'f', 'm', 's', 'u'] | ||||
| 
 | ||||
| -- | Get the designated render width of a character: 0 for a combining | ||||
| -- character, 1 for a regular character, 2 for a wide character. | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user