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