drop regexpr dependency
This commit is contained in:
		
							parent
							
								
									64bc422b85
								
							
						
					
					
						commit
						9e2111106b
					
				| @ -1,8 +1,7 @@ | ||||
| {-# LANGUAGE ScopedTypeVariables #-} | ||||
| {-| | ||||
| 
 | ||||
| Easy regular expression helpers, based on regex-tdfa and (a little) on | ||||
| regexpr. These should: | ||||
| Easy regular expression helpers, currently based on regex-tdfa. These should: | ||||
| 
 | ||||
| - be cross-platform, not requiring C libraries | ||||
| 
 | ||||
| @ -30,22 +29,19 @@ module Hledger.Utils.Regex ( | ||||
|    -- * type aliases | ||||
|    Regexp | ||||
|   ,Replacement | ||||
|    -- * based on regex-tdfa | ||||
|    -- * standard regex operations | ||||
|   ,regexMatches | ||||
|   ,regexMatchesCI | ||||
|   ,regexReplace | ||||
|   ,regexReplaceCI | ||||
|   ,regexReplaceBy | ||||
|   ,regexReplaceByCI | ||||
|    -- * based on regexpr | ||||
|   ,regexSplit | ||||
|   ) | ||||
| where | ||||
| 
 | ||||
| import Data.Array | ||||
| import Data.Char | ||||
| import Data.List (foldl') | ||||
| import Text.RegexPR (splitRegexPR) | ||||
| import Text.Regex.TDFA ( | ||||
|   Regex, CompOption(..), ExecOption(..), defaultCompOpt, defaultExecOpt, | ||||
|   makeRegexOpts, AllMatches(getAllMatches), match, (=~), MatchText | ||||
| @ -132,8 +128,3 @@ replaceAllBy re f s = start end | ||||
|           (matched, remaining) = splitAt len start | ||||
|       in (off + len, remaining, write . (skip++) . (f matched ++)) | ||||
| 
 | ||||
| -- uses regexpr, may be slow: | ||||
| 
 | ||||
| regexSplit :: Regexp -> String -> [Regexp] | ||||
| regexSplit = splitRegexPR | ||||
| 
 | ||||
|  | ||||
| @ -105,7 +105,6 @@ library | ||||
|                  ,old-time | ||||
|                  ,parsec >= 3 | ||||
|                  ,regex-tdfa | ||||
|                  ,regexpr >= 0.5.1 | ||||
|                  ,safe >= 0.2 | ||||
|                  ,split >= 0.1 && < 0.3 | ||||
|                  ,transformers >= 0.2 && < 0.5 | ||||
| @ -144,7 +143,6 @@ test-suite tests | ||||
|                , old-time | ||||
|                , parsec >= 3 | ||||
|                , regex-tdfa | ||||
|                , regexpr | ||||
|                , safe | ||||
|                , split | ||||
|                , test-framework | ||||
|  | ||||
| @ -178,7 +178,6 @@ library | ||||
|                    , network-conduit | ||||
|                    , conduit-extra | ||||
|                    , parsec               >= 3 | ||||
|                    , regexpr              >= 0.5.1 | ||||
|                    , safe                 >= 0.2 | ||||
|                    , shakespeare          >= 2.0 | ||||
|                    , template-haskell | ||||
| @ -253,7 +252,6 @@ executable         hledger-web | ||||
|                    , network-conduit | ||||
|                    , conduit-extra | ||||
|                    , parsec               >= 3 | ||||
|                    , regexpr              >= 0.5.1 | ||||
|                    , safe                 >= 0.2 | ||||
|                    , shakespeare          >= 2.0 && < 2.1 | ||||
|                    , template-haskell | ||||
|  | ||||
| @ -64,6 +64,7 @@ import Prelude.Compat | ||||
| import qualified Control.Exception as C | ||||
| import Control.Monad (when) | ||||
| import Data.List.Compat | ||||
| import Data.List.Split (splitOneOf) | ||||
| import Data.Maybe | ||||
| import Safe | ||||
| import System.Console.CmdArgs | ||||
| @ -514,7 +515,7 @@ hledgerAddons = do | ||||
| -- directory) or whether it has execute permission. | ||||
| hledgerExecutablesInPath :: IO [String] | ||||
| hledgerExecutablesInPath = do | ||||
|   pathdirs <- regexSplit "[:;]" `fmap` getEnvSafe "PATH" | ||||
|   pathdirs <- splitOneOf "[:;]" `fmap` getEnvSafe "PATH" | ||||
|   pathfiles <- concat `fmap` mapM getDirectoryContentsSafe pathdirs | ||||
|   return $ nub $ sort $ filter isHledgerExeName pathfiles | ||||
|   -- XXX should exclude directories and files without execute permission. | ||||
|  | ||||
| @ -93,7 +93,6 @@ library | ||||
|                  ,parsec >= 3 | ||||
|                  ,process | ||||
|                  ,regex-tdfa | ||||
|                  ,regexpr >= 0.5.1 | ||||
|                  ,safe >= 0.2 | ||||
|                  ,split >= 0.1 && < 0.3 | ||||
|                  ,text >= 0.11 | ||||
| @ -148,7 +147,6 @@ executable hledger | ||||
|                  ,parsec >= 3 | ||||
|                  ,process | ||||
|                  ,regex-tdfa | ||||
|                  ,regexpr >= 0.5.1 | ||||
|                  ,safe >= 0.2 | ||||
|                  ,shakespeare-text >= 1.0 && < 1.2 | ||||
|                  ,shakespeare      >= 1.0 && < 2.1 | ||||
| @ -191,7 +189,6 @@ test-suite tests | ||||
|                , parsec >= 3 | ||||
|                , process | ||||
|                , regex-tdfa | ||||
|                , regexpr | ||||
|                , safe | ||||
|                , shakespeare-text >= 1.0 && < 1.2 | ||||
|                , shakespeare      >= 1.0 && < 2.1 | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user