drop regexpr dependency

This commit is contained in:
Simon Michael 2015-05-17 08:32:45 -07:00
parent 64bc422b85
commit 9e2111106b
5 changed files with 4 additions and 19 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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.

View File

@ -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