regex-tdfa 1.3.1.1 → 1.3.1.2
raw patch · 17 files changed
+392/−100 lines, 17 filesdep ~base
Dependency ranges changed: base
Files
- CHANGELOG.md +26/−2
- README.md +202/−0
- lib/Data/IntMap/EnumMap2.hs +1/−1
- lib/Text/Regex/TDFA.hs +1/−1
- lib/Text/Regex/TDFA/Common.hs +3/−3
- lib/Text/Regex/TDFA/CorePattern.hs +7/−6
- lib/Text/Regex/TDFA/NewDFA/Engine.hs +21/−14
- lib/Text/Regex/TDFA/NewDFA/Engine_FA.hs +66/−20
- lib/Text/Regex/TDFA/NewDFA/Engine_NC.hs +2/−2
- lib/Text/Regex/TDFA/NewDFA/Tester.hs +1/−1
- lib/Text/Regex/TDFA/Pattern.hs +8/−8
- lib/Text/Regex/TDFA/ReadRegex.hs +7/−7
- lib/Text/Regex/TDFA/String.hs +1/−1
- lib/Text/Regex/TDFA/TDFA.hs +4/−4
- lib/Text/Regex/TDFA/TNFA.hs +15/−15
- regex-tdfa.cabal +20/−13
- test/Main.hs +7/−2
CHANGELOG.md view
@@ -1,5 +1,29 @@ For the package version policy (PVP), see http://pvp.haskell.org/faq . +### 1.3.1.2++_2022-02-19, Andreas Abel_+- No longer rely on the `MonadFail` instance for `ST`+ (future `base` library change, see [#29](https://github.com/haskell-hvr/regex-tdfa/pull/29)).+- Silence warning `incomplete-uni-patterns` (GHC >= 9.2).+- Import from `Data.List` explicitly or qualified (warning `compat-unqualified-imports`).+- Import from `Control.Monad` to allow `mtl-2.3` in its `rc3` incarnation.++### 1.3.1.1 Revision 3++_2022-01-31, Andreas Abel_+- Speculatively allow unreleased `mtl-2.3` (works with release candidate `mtl-2.3-rc4`).++### 1.3.1.1 Revision 2++_2021-12-26, Andreas Abel_+- Allow `text-2.0`.++### 1.3.1.1 Revision 1++_2021-08-12, Andreas Abel_+- Compatibility with `base-4.16` (GHC 9.2).+ ### 1.3.1.1 _2021-06-03, Andreas Abel_@@ -9,12 +33,12 @@ ### 1.3.1.0 Revision 2 _2021-02-20, Andreas Abel_-- Compatibility with `base-4.15` (GHC 9.0) and `bytestring-0.11`+- Compatibility with `base-4.15` (GHC 9.0) and `bytestring-0.11`. ### 1.3.1.0 Revision 1 _2020-03-26, phadej_-- Compatibility with `base-4.14` (GHC 8.10)+- Compatibility with `base-4.14` (GHC 8.10). ## 1.3.1.0
+ README.md view
@@ -0,0 +1,202 @@+# regex-tdfa++This is [`regex-tdfa`](http://hackage.haskell.org/package/regex-tdfa) which is a pure Haskell regular expression library (for POSIX extended regular expressions) originally written by Christopher Kuklewicz.++The name "tdfa" stands for Tagged-DFA.++## Getting started++### Importing and using++[Declare a dependency](https://www.haskell.org/cabal/users-guide/developing-packages.html#pkg-field-build-depends) on the `regex-tdfa` library in your `.cabal` file:++```+build-depends: regex-tdfa ^>= 1.3.1+```++In Haskell modules where you need to use regexes `import` the respective `regex-tdfa` module:++```haskell+import Text.Regex.TDFA+```++### Basics++```haskell+λ> emailRegex = "[a-zA-Z0-9+._-]+@[a-zA-Z-]+\\.[a-z]+"+λ> "my email is email@email.com" =~ emailRegex :: Bool+>>> True++-- non-monadic+<to-match-against> =~ <regex>++-- monadic, uses 'fail' on lack of match+<to-match-against> =~~ <regex>+```++`(=~)` and `(=~~)` are polymorphic in their return type. This is so that+regex-tdfa can pick the most efficient way to give you your result based on+what you need. For instance, if all you want is to check whether the regex+matched or not, there's no need to allocate a result string. If you only want+the first match, rather than all the matches, then the matching engine can stop+after finding a single hit.++This does mean, though, that you may sometimes have to explicitly specify the+type you want, especially if you're trying things out at the REPL.++### Common use cases++#### Get the first match++```haskell+-- returns empty string if no match+a =~ b :: String -- or ByteString, or Text...++λ> "alexis-de-tocqueville" =~ "[a-z]+" :: String+>>> "alexis"++λ> "alexis-de-tocqueville" =~ "[0-9]+" :: String+>>> ""+```++#### Check if it matched at all++```haskell+a =~ b :: Bool++λ> "alexis-de-tocqueville" =~ "[a-z]+" :: Bool+>>> True+```++#### Get first match + text before/after++```haskell+-- if no match, will just return whole+-- string in the first element of the tuple+a =~ b :: (String, String, String)++λ> "alexis-de-tocqueville" =~ "de" :: (String, String, String)+>>> ("alexis-", "de", "-tocqueville")++λ> "alexis-de-tocqueville" =~ "kant" :: (String, String, String)+>>> ("alexis-de-tocqueville", "", "")+```++#### Get first match + submatches++```haskell+-- same as above, but also returns a list of /just/ submatches+-- submatch list is empty if regex doesn't match at all+a =~ b :: (String, String, String, [String])++λ> "div[attr=1234]" =~ "div\\[([a-z]+)=([^]]+)\\]"+ :: (String, String, String, [String])+>>> ("", "div[attr=1234]", "", ["attr","1234"])+```++#### Get all non-overlapping matches++```haskell+-- can also return Data.Array instead of List+getAllTextMatches (a =~ b) :: [String]++λ> getAllTextMatches ("john anne yifan" =~ "[a-z]+") :: [String]+>>> ["john","anne","yifan"]++λ> getAllTextMatches ("0a0b0" =~ "0[a-z]0") :: [String]+>>> ["0a0"]+```+Note that `"0b0"` is not included in the result since it overlaps with `"0a0"`.++#### Special characters++`regex-tdfa` only supports a small set of special characters and is much less+featureful than some other regex engines you might be used to, such as PCRE.++* ``\` `` — Match start of entire text (similar to `^` in other regex engines)+* `\'` — Match end of entire text (similar to `$` in other regex engines)+* `\<` — Match beginning of word+* `\>` — Match end of word+* `\b` — Match beginning or end of word+* `\B` — Match neither beginning nor end of word++### Less common stuff++#### Get match indices++```haskell+-- can also return Data.Array instead of List+getAllMatches (a =~ b) :: [(Int, Int)] -- (index, length)++λ> getAllMatches ("john anne yifan" =~ "[a-z]+") :: [(Int, Int)]+>>> [(0,4), (5,4), (10,5)]+``````++#### Get submatch indices++```haskell+-- match of __entire__ regex is first element, not first capture+-- can also return Data.Array instead of List+getAllSubmatches (a =~ b) :: [(Int, Int)] -- (index, length)++λ> getAllSubmatches ("div[attr=1234]" =~ "div\\[([a-z]+)=([^]]+)\\]")+ :: [(Int, Int)]+>>> [(0,14), (4,4), (9,4)]+```++### Replacement++`regex-tdfa` does not provide find-and-replace.++## The relevant links++This documentation is also available in [Text.Regex.TDFA haddock](http://hackage.haskell.org/package/regex-tdfa-1.2.3.2/docs/Text-Regex-TDFA.html).++This was also documented at the [Haskell wiki](https://wiki.haskell.org/Regular_expressions#regex-tdfa). The original Darcs repository was at [code.haskell.org](http://code.haskell.org/regex-tdfa/). When not updated, this was forked and maintained by Roman Cheplyaka as [regex-tdfa-rc](http://hackage.haskell.org/package/regex-tdfa-rc).++Then the repository moved to <https://github.com/ChrisKuklewicz/regex-tdfa>, which was primarily maintained by [Artyom (neongreen)](https://github.com/neongreen).++Finally, maintainership was passed on again and the repository moved to its current location at <https://github.com/haskell-hvr/regex-tdfa>.++## Avoiding backslashes++If you find yourself writing a lot of regexes, take a look at+[raw-strings-qq](http://hackage.haskell.org/package/raw-strings-qq). It'll+let you write regexes without needing to escape all your backslashes.++```haskell+{-# LANGUAGE QuasiQuotes #-}++import Text.RawString.QQ+import Text.Regex.TDFA++λ> "2 * (3 + 1) / 4" =~ [r|\([^)]+\)|] :: String+>>> "(3 + 1)"+```++## Known bugs and infelicities++* Regexes with large character classes combined with `{m,n}` are very slow and memory-hungry ([#3][]).++ > An example of such a regex is `^[\x0020-\xD7FF]{1,255}$`.++* POSIX submatch semantics are broken in some rare cases ([#2][]).++[#2]: https://github.com/haskell-hvr/regex-tdfa/issues/2+[#3]: https://github.com/haskell-hvr/regex-tdfa/issues/3++## About this package++This was inspired by the algorithm (and Master's thesis) behind the regular expression library known as [TRE or libtre](https://github.com/laurikari/tre/). This was created by Ville Laurikari and tackled the difficult issue of efficient sub-match capture for POSIX regular expressions.++By building on this thesis and adding a few more optimizations, regex-tdfa matching input text of length N should have O(N) runtime, and should have a maximum memory bounded by the pattern size that does not scale with N. It should do this while returning well defined (and correct) values for the parenthesized sub-matches.++Regardless of performance, nearly every single OS and Libra for POSIX regular expressions has bugs in sub-matches. This was detailed on the [Regex POSIX Haskell wiki page](https://wiki.haskell.org/Regex_Posix), and can be demonstrated with the [regex-posix-unittest](http://hackage.haskell.org/package/regex-posix-unittest) suite of checks. Test [regex-tdfa-unittest](http://hackage.haskell.org/package/regex-tdfa-unittest) should show regex-tdfa passing these same checks. I owe my understanding of the correct behvior and many of these unit tests to Glenn Fowler at AT&T ("An Interpretation of the POSIX regex Standard").++## Other related packages++You can find several other related packages by searching for "tdfa" on [hackage](http://hackage.haskell.org/packages/search?terms=tdfa).++## Document notes++This was written 2016-04-30.
lib/Data/IntMap/EnumMap2.hs view
@@ -50,7 +50,7 @@ {-# INLINE lookup #-} lookup :: (Enum key) => key -> EnumMap key a -> Maybe a-lookup k (EnumMap m) = maybe (fail "EnumMap.lookup failed") return $ M.lookup (fromEnum k) m+lookup k (EnumMap m) = M.lookup (fromEnum k) m findWithDefault :: (Enum key) => a -> key -> EnumMap key a -> a findWithDefault a k (EnumMap m) = M.findWithDefault a (fromEnum k) m
lib/Text/Regex/TDFA.hs view
@@ -2,7 +2,7 @@ Module: Text.Regex.TDFA Copyright: (c) Chris Kuklewicz 2007-2009 SPDX-License-Identifier: BSD-3-Clause-Maintainer: hvr@gnu.org, Andreas Abel+Maintainer: Andreas Abel Stability: stable The "Text.Regex.TDFA" module provides a backend for regular
lib/Text/Regex/TDFA/Common.hs view
@@ -68,7 +68,7 @@ noWin :: WinTags -> Bool noWin = null --- | Used to track elements of the pattern that accept characters or +-- | Used to track elements of the pattern that accept characters or -- are anchors newtype DoPa = DoPa {dopaIndex :: Int} deriving (Eq,Ord) @@ -116,7 +116,7 @@ -- | GroupIndex is for indexing submatches from capturing -- parenthesized groups (PGroup\/Group) type GroupIndex = Int--- | GroupInfo collects the parent and tag information for an instance +-- | GroupInfo collects the parent and tag information for an instance -- of a group data GroupInfo = GroupInfo { thisIndex, parentIndex :: GroupIndex@@ -290,7 +290,7 @@ where foo :: CharMap QTrans -> [(Char,[(Index,[TagCommand])])] foo = mapSnd foo' . Map.toAscList foo' :: QTrans -> [(Index,[TagCommand])]- foo' = IMap.toList + foo' = IMap.toList showQT (Testing test dopas a b) = "{Testing "++show test++" "++show (Set.toList dopas) ++"\n"++indent' a ++"\n"++indent' b++"}"
lib/Text/Regex/TDFA/CorePattern.hs view
@@ -34,6 +34,7 @@ ,TestInfo,OP(..),SetTestInfo(..),NullView ,patternToQ,cleanNullView,cannotAccept,mustAccept) where +import Control.Monad (liftM2, forM, replicateM) import Control.Monad.RWS {- all -} import Data.Array.IArray(Array,(!),accumArray,listArray) import Data.List(sort)@@ -249,7 +250,7 @@ -- from the dfs of the children and simultaneously down in the form of -- pre and post HandleTag data. This bidirectional flow is handled -- declaratively by using the MonadFix (i.e. mdo).--- +-- -- Invariant: A tag should exist in Q in exactly one place (and will -- be in a preTag,postTag, or getOrbit field). This is partly because -- PGroup needs to know the tags are around precisely the expression@@ -264,10 +265,10 @@ -- -- There is a final "qwin of Q {postTag=ISet.singleton 1}" and an -- implied initial index tag of 0.--- +-- -- favoring pushing Apply into the child postTag makes PGroup happier -type PM = RWS (Maybe GroupIndex) [Either Tag GroupInfo] ([OP]->[OP],Tag) +type PM = RWS (Maybe GroupIndex) [Either Tag GroupInfo] ([OP]->[OP],Tag) type HHQ = HandleTag -- m1 : info about left boundaary / preTag -> HandleTag -- m2 : info about right boundary / postTag -> PM Q@@ -298,7 +299,7 @@ -- and lazily looks resetGroupTags from aGroups, the result of all writer (Right _) -- preReset stores the resetGroupTags result of the lookup in the tree -- makeOrbit sends some tags to the writer (Left _)--- withOrbit listens to children send orbit info to writer for resetOrbitTags +-- withOrbit listens to children send orbit info to writer for resetOrbitTags -- nullQ depends m1 m2 and resetOrbitTags and resetGroupTags and is sent up the tree patternToQ :: CompOption -> (Pattern,(GroupIndex,DoPa)) -> (Q,Array Tag OP,Array GroupIndex [GroupInfo]) patternToQ compOpt (pOrig,(maxGroupIndex,_)) = (tnfa,aTags,aGroups) where@@ -374,7 +375,7 @@ -- withParent uses MonadReader(local) to set getParentIndex to return (Just this) -- withParent uses MonadWriter(listens to makeGroup/Right) to return contained group indices (stopTag) -- withParent is only safe if getParentIndex has been checked to be not equal to Nothing (see PGroup below)- -- Note use of laziness: the immediate children's group index is used to look up all copies of the + -- Note use of laziness: the immediate children's group index is used to look up all copies of the -- group in aGroups, including copies that are not immediate children. withParent :: GroupIndex -> PM a -> PM (a,[Tag]) withParent this = local (const (Just this)) . listens childGroupInfo@@ -630,5 +631,5 @@ -- xxx todo--- +-- -- see of PNonEmpty -> NonEmpty -> TNFA is really smarter than POr about tags
lib/Text/Regex/TDFA/NewDFA/Engine.hs view
@@ -1,6 +1,12 @@+{-# LANGUAGE CPP #-}++#if __GLASGOW_HASKELL__ >= 902+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+#endif+ -- | This is the code for the main engine. This captures the posix subexpressions. This 'execMatch' -- also dispatches to "Engine_NC", "Engine_FA", and "Engine_FC_NA"--- +-- -- It is polymorphic over the internal Uncons type class, and specialized to produce the needed -- variants. module Text.Regex.TDFA.NewDFA.Engine(execMatch) where@@ -69,7 +75,7 @@ {-# INLINE set #-} set :: (MArray a e (S.ST s),Ix i) => a i e -> Int -> e -> S.ST s () set = unsafeWrite- + {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> ([] Char) -> [MatchArray] #-} {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> (Seq Char) -> [MatchArray] #-} {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> SBS.ByteString -> [MatchArray] #-}@@ -100,7 +106,7 @@ orbitTags :: [Tag] !orbitTags = map fst . filter ((Orbit==).snd) . assocs $ aTags - !test = mkTest newline + !test = mkTest newline comp :: C s comp = {-# SCC "matchHere.comp" #-} ditzyComp'3 aTags@@ -237,7 +243,7 @@ _ -> return Nothing ) let compressGroup [((state,_),orbit)] | Seq.null (getOrbits orbit) = return () | otherwise =- set (m_orbit s1) state + set (m_orbit s1) state . (IMap.insert tag $! (orbit { ordinal = Nothing, getOrbits = mempty})) =<< m_orbit s1 !! state @@ -285,7 +291,8 @@ challenge x1@((_si1,ins1),_p1,_o1) x2@((_si2,ins2),_p2,_o2) = {-# SCC "goNext.findTrans.challenge" #-} do check <- comp offset x1 (newPos ins1) x2 (newPos ins2) if check==LT then return x2 else return x1- (first:rest) <- mapM prep (IMap.toList sources)+ first_rest <- mapM prep (IMap.toList sources)+ let first:rest = first_rest set which destIndex =<< foldM challenge first rest let dl = IMap.toList dtrans mapM_ findTransTo dl@@ -298,7 +305,7 @@ earlyStart <- fmap minimum $ mapM performTransTo dl -- findTrans part 3 earlyWin <- readSTRef (mq_earliest winQ)- if earlyWin < earlyStart + if earlyWin < earlyStart then do winners <- fmap (foldl' (\ rest ws -> ws : rest) []) $ getMQ earlyStart winQ@@ -376,7 +383,7 @@ set newerPos 0 preTag doActions preTag newerPos (newPos winInstructions) putMQ (WScratch newerPos) winQ- + newWinner preTag ((_sourceIndex,winInstructions),oldPos,_newOrbit) = {-# SCC "goNext.newWinner" #-} do newerPos <- newA_ b_tags copySTU oldPos newerPos@@ -437,7 +444,7 @@ then writeSTRef earliest start >> writeSTRef list [mqa] else do old <- readSTRef list- let !rest = dropWhile (\ m -> start <= mqa_start m) old + let !rest = dropWhile (\ m -> start <= mqa_start m) old !new = mqa : rest writeSTRef list new @@ -498,7 +505,7 @@ showWS :: WScratch s -> ST s String showWS (WScratch pos) = do a <- getAssocs pos- return $ unlines [ "WScratch" + return $ unlines [ "WScratch" , indent (show a)] -} {- CREATING INITIAL MUTABLE SCRATCH DATA STRUCTURES -}@@ -560,7 +567,7 @@ allcomps :: Tag -> [F s] allcomps tag | tag > top = [F (\ _ _ _ _ _ _ -> return EQ)]- | otherwise = + | otherwise = case aTagOP ! tag of Orbit -> F (challenge_Orb tag) : allcomps (succ tag) Maximize -> F (challenge_Max tag) : allcomps (succ tag)@@ -609,7 +616,7 @@ else return (compare p1 p2) challenge_Max _ [] _ _ _ _ _ = err "impossible 9384324" - challenge_Orb !tag (F next:comps) preTag x1@(_state1,_pos1,orbit1') np1 x2@(_state2,_pos2,orbit2') np2 = + challenge_Orb !tag (F next:comps) preTag x1@(_state1,_pos1,orbit1') np1 x2@(_state2,_pos2,orbit2') np2 = let s1 = IMap.lookup tag orbit1' s2 = IMap.lookup tag orbit2' in case (s1,s2) of@@ -630,7 +637,7 @@ comparePos EmptyL EmptyL = EQ comparePos EmptyL _ = GT comparePos _ EmptyL = LT-comparePos (p1 :< ps1) (p2 :< ps2) = +comparePos (p1 :< ps1) (p2 :< ps2) = compare p1 p2 `mappend` comparePos (viewl ps1) (viewl ps2) {- CONVERT WINNERS TO MATCHARRAY -}@@ -718,7 +725,7 @@ case unsafeCoerce# memcpy mdest msource n# s1# of { (# s2#, () #) -> (# s2#, () #) }} {--#else /* !__GLASGOW_HASKELL__ */+-- #else /* !__GLASGOW_HASKELL__ */ copySTU :: (MArray (STUArray s) e (S.ST s))=> STUArray s Tag e -> STUArray s Tag e -> S.ST s (STUArray s i e) copySTU source destination = do@@ -729,5 +736,5 @@ forM_ (range b) $ \index -> set destination index =<< source !! index return destination-#endif /* !__GLASGOW_HASKELL__ */+-- #endif /* !__GLASGOW_HASKELL__ */ -}
lib/Text/Regex/TDFA/NewDFA/Engine_FA.hs view
@@ -1,22 +1,23 @@+{-# LANGUAGE CPP #-}++#if __GLASGOW_HASKELL__ >= 902+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+#endif+ -- | This is the code for the main engine. This captures the posix -- subexpressions. There is also a non-capturing engine, and a -- testing engine.--- +-- -- It is polymorphic over the internal Uncons type class, and -- specialized to produce the needed variants.+ module Text.Regex.TDFA.NewDFA.Engine_FA(execMatch) where import Data.Array.Base(unsafeRead,unsafeWrite,STUArray(..))--- #ifdef __GLASGOW_HASKELL__+ import GHC.Arr(STArray(..)) import GHC.ST(ST(..)) import GHC.Exts(MutableByteArray#,RealWorld,Int#,sizeofMutableByteArray#,unsafeCoerce#)-{---- #else-import Control.Monad.ST(ST)-import Data.Array.ST(STArray)--- #endif--} import Prelude hiding ((!!)) import Control.Monad(when,unless,forM,forM_,liftM2,foldM)@@ -28,6 +29,7 @@ import qualified Data.IntMap as IMap(null,toList,lookup,insert) import Data.Maybe(catMaybes) import Data.Monoid as Mon(Monoid(..))+import Data.IntSet(IntSet) import qualified Data.IntSet as ISet(toAscList,null) import Data.Array.IArray((!)) import Data.List(sortBy,groupBy)@@ -60,12 +62,12 @@ noSource :: ((Index, Instructions),STUArray s Tag Position,OrbitLog) noSource = ((-1,err "noSource"),err "noSource",err "noSource")- + {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> ([] Char) -> [MatchArray] #-} {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> (Seq Char) -> [MatchArray] #-} {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> SBS.ByteString -> [MatchArray] #-} {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> LBS.ByteString -> [MatchArray] #-}-execMatch :: Uncons text => Regex -> Position -> Char -> text -> [MatchArray]+execMatch :: forall text. Uncons text => Regex -> Position -> Char -> text -> [MatchArray] execMatch (Regex { regex_dfa = DFA {d_id=didIn,d_dt=dtIn} , regex_init = startState , regex_b_index = b_index@@ -81,12 +83,13 @@ orbitTags :: [Tag] !orbitTags = map fst . filter ((Orbit==).snd) . assocs $ aTags - !test = mkTest newline + test :: WhichTest -> Index -> Char -> text -> Bool+ !test = mkTest newline comp :: C s comp = {-# SCC "matchHere.comp" #-} ditzyComp'3 aTags - goNext :: ST s [MatchArray]+ goNext :: forall s. ST s [MatchArray] goNext = {-# SCC "goNext" #-} do (SScratch s1In s2In (winQ,blank,which)) <- newScratch b_index b_tags spawnAt b_tags blank startState s1In offsetIn@@ -170,6 +173,7 @@ -- The updated Orbits get the new ordinal value and an empty (Seq -- Position). + compressOrbits :: MScratch s -> IntSet -> Position -> ST s () compressOrbits s1 did offset = do let getStart state = do start <- maybe (err "compressOrbit,1") (!! 0) =<< m_pos s1 !! state return (state,start)@@ -184,7 +188,7 @@ _ -> return Nothing ) let compressGroup [((state,_),orbit)] | Seq.null (getOrbits orbit) = return () | otherwise =- set (m_orbit s1) state + set (m_orbit s1) state . (IMap.insert tag $! (orbit { ordinal = Nothing, getOrbits = mempty})) =<< m_orbit s1 !! state @@ -214,6 +218,17 @@ -- "storeNext". If no winners are ready to be released then the -- computation continues immediately. + findTrans+ :: MScratch s+ -> MScratch s+ -> IntSet+ -> SetIndex+ -> DT+ -> DTrans+ -> Index+ -> Char+ -> text+ -> ST s [MatchArray] findTrans s1 s2 did did' dt' dtrans offset prev' input' = {-# SCC "goNext.findTrans" #-} do -- findTrans part 0 -- MAGIC TUNABLE CONSTANT 100 (and 100-1). TODO: (offset .&. 127 == 127) instead?@@ -231,7 +246,8 @@ challenge x1@((_si1,ins1),_p1,_o1) x2@((_si2,ins2),_p2,_o2) = {-# SCC "goNext.findTrans.challenge" #-} do check <- comp offset x1 (newPos ins1) x2 (newPos ins2) if check==LT then return x2 else return x1- (first:rest) <- mapM prep (IMap.toList sources)+ first_rest <- mapM prep (IMap.toList sources)+ let first:rest = first_rest set which destIndex =<< foldM challenge first rest let dl = IMap.toList dtrans mapM_ findTransTo dl@@ -256,6 +272,7 @@ -- (futher test "(.+|.+.)*" on "aa\n") {-# INLINE processWinner #-}+ processWinner :: MScratch s -> IntMap Instructions -> Position -> ST s () processWinner s1 w offset = {-# SCC "goNext.newWinnerThenProceed" #-} do let prep x@(sourceIndex,instructions) = {-# SCC "goNext.newWinnerThenProceed.prep" #-} do pos <- maybe (err "newWinnerThenProceed,1") return =<< m_pos s1 !! sourceIndex@@ -271,12 +288,14 @@ [] -> return () (first:rest) -> newWinner offset =<< foldM challenge first rest + newWinner :: Position -> ((a, Instructions), STUArray s Tag Position, c) -> ST s () newWinner preTag ((_sourceIndex,winInstructions),oldPos,_newOrbit) = {-# SCC "goNext.newWinner" #-} do newerPos <- newA_ b_tags copySTU oldPos newerPos doActions preTag newerPos (newPos winInstructions) putMQ (WScratch newerPos) winQ + finalizeWinner :: ST s [MatchArray] finalizeWinner = do mWinner <- readSTRef (mq_mWin winQ) case mWinner of@@ -357,7 +376,7 @@ showWS :: WScratch s -> ST s String showWS (WScratch pos) = do a <- getAssocs pos- return $ unlines [ "WScratch" + return $ unlines [ "WScratch" , indent (show a)] -} {- CREATING INITIAL MUTABLE SCRATCH DATA STRUCTURES -}@@ -419,7 +438,7 @@ allcomps :: Tag -> [F s] allcomps tag | tag > top = [F (\ _ _ _ _ _ _ -> return EQ)]- | otherwise = + | otherwise = case aTagOP ! tag of Orbit -> F (challenge_Orb tag) : allcomps (succ tag) Maximize -> F (challenge_Max tag) : allcomps (succ tag)@@ -427,6 +446,15 @@ Minimize -> err "allcomps Minimize" where top = snd (bounds aTagOP) + challenge_Ignore+ :: Int+ -> [F s1]+ -> Position+ -> ((Int, Instructions), STUArray s1 Tag Position, IntMap Orbits)+ -> [(Int, Action)]+ -> ((Int, Instructions), STUArray s1 Tag Position, IntMap Orbits)+ -> [(Int, Action)]+ -> ST s1 Ordering challenge_Ignore !tag (F next:comps) preTag x1 np1 x2 np2 = case np1 of ((t1,_):rest1) | t1==tag ->@@ -439,6 +467,15 @@ _ -> next comps preTag x1 np1 x2 np2 challenge_Ignore _ [] _ _ _ _ _ = err "impossible 2347867" + challenge_Max+ :: Int+ -> [F s1]+ -> Position+ -> ((Int, Instructions), STUArray s1 Tag Position, IntMap Orbits)+ -> [(Int, Action)]+ -> ((Int, Instructions), STUArray s1 Tag Position, IntMap Orbits)+ -> [(Int, Action)]+ -> ST s1 Ordering challenge_Max !tag (F next:comps) preTag x1@(_state1,pos1,_orbit1') np1 x2@(_state2,pos2,_orbit2') np2 = case np1 of ((t1,b1):rest1) | t1==tag ->@@ -468,7 +505,16 @@ else return (compare p1 p2) challenge_Max _ [] _ _ _ _ _ = err "impossible 9384324" - challenge_Orb !tag (F next:comps) preTag x1@(_state1,_pos1,orbit1') np1 x2@(_state2,_pos2,orbit2') np2 = + challenge_Orb+ :: Int+ -> [F s1]+ -> Position+ -> ((Int, Instructions), STUArray s1 Tag Position, IntMap Orbits)+ -> [(Int, Action)]+ -> ((Int, Instructions), STUArray s1 Tag Position, IntMap Orbits)+ -> [(Int, Action)]+ -> ST s1 Ordering+ challenge_Orb !tag (F next:comps) preTag x1@(_state1,_pos1,orbit1') np1 x2@(_state2,_pos2,orbit2') np2 = let s1 = IMap.lookup tag orbit1' s2 = IMap.lookup tag orbit2' in case (s1,s2) of@@ -489,7 +535,7 @@ comparePos EmptyL EmptyL = EQ comparePos EmptyL _ = GT comparePos _ EmptyL = LT-comparePos (p1 :< ps1) (p2 :< ps2) = +comparePos (p1 :< ps1) (p2 :< ps2) = compare p1 p2 `mappend` comparePos (viewl ps1) (viewl ps2) {- CONVERT WINNERS TO MATCHARRAY -}@@ -576,7 +622,7 @@ case unsafeCoerce# memcpy mdest msource n# s1# of { (# s2#, () #) -> (# s2#, () #) }} {--#else /* !__GLASGOW_HASKELL__ */+-- #else /* !__GLASGOW_HASKELL__ */ copySTU :: (MArray (STUArray s) e (S.ST s))=> STUArray s Tag e -> STUArray s Tag e -> S.ST s (STUArray s i e) copySTU source destination = do@@ -587,5 +633,5 @@ forM_ (range b) $ \index -> set destination index =<< source !! index return destination-#endif /* !__GLASGOW_HASKELL__ */+-- #endif /* !__GLASGOW_HASKELL__ */ -}
lib/Text/Regex/TDFA/NewDFA/Engine_NC.hs view
@@ -52,7 +52,7 @@ , regex_compOptions = CompOption { multiline = newline } } ) offsetIn prevIn inputIn = L.runST runCaptureGroup where - !test = mkTest newline + !test = mkTest newline runCaptureGroup = {-# SCC "runCaptureGroup" #-} do obtainNext <- L.strictToLazyST constructNewEngine@@ -199,7 +199,7 @@ then writeSTRef earliest start >> writeSTRef list [ws] else do old <- readSTRef list- let !rest = dropWhile (\ w -> start <= ws_start w) old + let !rest = dropWhile (\ w -> start <= ws_start w) old !new = ws : rest writeSTRef list new
lib/Text/Regex/TDFA/NewDFA/Tester.hs view
@@ -1,5 +1,5 @@ -- | Like Engine, but merely checks to see whether any match at all is found.--- +-- module Text.Regex.TDFA.NewDFA.Tester(matchTest) where import qualified Data.IntMap.CharMap2 as CMap(findWithDefault)
lib/Text/Regex/TDFA/Pattern.hs view
@@ -1,6 +1,6 @@ -- | This "Text.Regex.TDFA.Pattern" module provides the 'Pattern' data -- type and its subtypes. This 'Pattern' type is used to represent--- the parsed form of a Regular Expression. +-- the parsed form of a Regular Expression. module Text.Regex.TDFA.Pattern (Pattern(..) ,PatternSet(..)@@ -88,7 +88,7 @@ else x:'-':(toEnum (pred n+fromEnum x)):[] -} paren s = ('(':s)++")"- + data PatternSet = PatternSet (Maybe (Set Char)) (Maybe (Set PatternSetCharacterClass)) (Maybe (Set PatternSetCollatingElement))@@ -128,7 +128,7 @@ instance Show PatternSetEquivalenceClass where showsPrec _ p = showChar '[' . showChar '=' . shows (unSEC p) . showChar '=' . showChar ']' --- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == +-- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- | Do the transformation and simplification in a single traversal. -- This removes the PPlus, PQuest, and PBound values, changing to POr@@ -200,7 +200,7 @@ simplicity, only use ! when p can match 0 characters but not only 0 characters. - Call this (PNonEmpty p) in the Pattern type. + Call this (PNonEmpty p) in the Pattern type. p! is PNonEmpty p is POr [PEmpty,p] IS THIS TRUE? Use QuickCheck? @@ -225,8 +225,8 @@ if p can match 0 or non-zero characters then cases are p{0,0} is (), p{0,1} is (p)?, p{0,2} is (pp!)?, p{0,3} is (pp!p!)? p{1,1} is p, p{1,2} is pp!, p{1,3} is pp!p!, p{1,4} is pp!p!p!- p{2,2} is p'p, - p{2,3} is p'pp!, + p{2,2} is p'p,+ p{2,3} is p'pp!, p{2,4} is p'pp!p! or p'p(pp!)! p{2,5} is p'pp!p!p! or p'p(p(pp!)!)! p{3,3} is p'p'p, p{3,4} is p'p'pp!, p{3,5} is p'p'pp!p!, p{3,6} is p'p'pp!p!p!@@ -236,7 +236,7 @@ p{0,1} is p?, p{0,2} is (pp?)?, p{0,3} is (p(pp?)?)?, p{0,4} is (pp{0,3})? p{1,1} is p, p{1,j} is pp{0,pred j} p{2,2} is p'p, p{2,3} is p'pp?, p{2,4} is p'p(pp?)?, p{2,5} = p'p{1,4} = p'(pp{0,3})- p{3,3} is p'p'p, p{3,4} is p'p'pp?, p{3,5} is p'p'p(pp?)?, p{3,6} is + p{3,3} is p'p'p, p{3,4} is p'p'pp?, p{3,5} is p'p'p(pp?)?, p{3,6} is And by this logic, the PStar False is really p*! So p{0,} is p* and p{1,} is pp*! and p{2,} is p'pp*! and p{3,} is p'p'pp*!@@ -323,7 +323,7 @@ -- redundant form. Nested 'POr' and 'PConcat' are flattened. PEmpty -- is propagated. simplify' :: Pattern -> Pattern-simplify' x@(POr _) = +simplify' x@(POr _) = let ps' = case span notPEmpty (flatten x) of (notEmpty,[]) -> notEmpty (notEmpty,_:rest) -> notEmpty ++ (PEmpty:filter notPEmpty rest) -- keep 1st PEmpty only
lib/Text/Regex/TDFA/ReadRegex.hs view
@@ -56,14 +56,14 @@ p_post_atom atom = (char '?' >> return (PQuest atom)) <|> (char '+' >> return (PPlus atom)) <|> (char '*' >> return (PStar True atom))- <|> p_bound atom + <|> p_bound atom <|> return atom p_bound atom = try $ between (char '{') (char '}') (p_bound_spec atom) p_bound_spec atom = do lowS <- many1 digit let lowI = read lowS- highMI <- option (Just lowI) $ try $ do + highMI <- option (Just lowI) $ try $ do _ <- char ',' -- parsec note: if 'many digits' fails below then the 'try' ensures -- that the ',' will not match the closing '}' in p_bound, same goes@@ -78,9 +78,9 @@ -- An anchor cannot be modified by a repetition specifier p_anchor = (char '^' >> liftM PCarat char_index) <|> (char '$' >> liftM PDollar char_index)- <|> try (do _ <- string "()" + <|> try (do _ <- string "()" index <- group_index- return $ PGroup index PEmpty) + return $ PGroup index PEmpty) <?> "empty () or anchor ^ or $" char_index = do (gi,ci) <- getState@@ -92,7 +92,7 @@ p_dot = char '.' >> char_index >>= return . PDot p_left_brace = try $ (char '{' >> notFollowedBy digit >> char_index >>= return . (`PChar` '{')) p_escaped = char '\\' >> anyChar >>= \c -> char_index >>= return . (`PEscape` c)- p_other_char = noneOf specials >>= \c -> char_index >>= return . (`PChar` c) + p_other_char = noneOf specials >>= \c -> char_index >>= return . (`PChar` c) where specials = "^.[$()|*+?{\\" -- parse [bar] and [^bar] sets of characters@@ -127,7 +127,7 @@ p_set_elem_coll = liftM BEColl $ try (between (string "[.") (string ".]") (many1 $ noneOf ".]")) -p_set_elem_range = try $ do +p_set_elem_range = try $ do start <- noneOf "]-" _ <- char '-' end <- noneOf "]"@@ -136,7 +136,7 @@ then return (BEChars [start..end]) else unexpected "End point of dashed character range is less than starting point" -p_set_elem_char = do +p_set_elem_char = do c <- noneOf "]" when (c == '-') $ do atEnd <- (lookAhead (char ']') >> return True) <|> (return False)
lib/Text/Regex/TDFA/String.hs view
@@ -1,4 +1,4 @@-{- | +{- | This modules provides 'RegexMaker' and 'RegexLike' instances for using 'String' with the TDFA backend.
lib/Text/Regex/TDFA/TDFA.hs view
@@ -138,7 +138,7 @@ -> [(IMap.Key, Transition)] fuse [] y = fmap (fmap (mergeDTrans o1)) y fuse x [] = fmap (fmap (mergeDTrans o2)) x- fuse x@((xc,xa):xs) y@((yc,ya):ys) = + fuse x@((xc,xa):xs) y@((yc,ya):ys) = case compare xc yc of LT -> (xc,mergeDTrans o2 xa) : fuse xs y EQ -> (xc,mergeDTrans xa ya) : fuse xs ys@@ -211,7 +211,7 @@ -- is free to mutatate the old state. If the QTrans has only one -- entry then all we need to do is mutate that entry when making a -- transition.--- +-- pickQTrans :: Array Tag OP -> QTrans -> [({-Destination-}Index,(DoPa,Instructions))] pickQTrans op tr = mapSnd (bestTrans op) . IMap.toList $ tr @@ -246,7 +246,7 @@ mergeTagOrbit xx [] = xx mergeTagOrbit [] yy = yy- mergeTagOrbit xx@(x:xs) yy@(y:ys) = + mergeTagOrbit xx@(x:xs) yy@(y:ys) = case compare (fst x) (fst y) of GT -> y : mergeTagOrbit xx ys LT -> x : mergeTagOrbit xs yy@@ -293,7 +293,7 @@ cw xx [] = foldr (\x rest -> comp (Just x) Nothing `mappend` rest) mempty xx cw [] yy = foldr (\y rest -> comp Nothing (Just y) `mappend` rest) mempty yy - + isDFAFrontAnchored :: DFA -> Bool isDFAFrontAnchored = isDTFrontAnchored . d_dt where
lib/Text/Regex/TDFA/TNFA.hs view
@@ -8,7 +8,7 @@ -- | "Text.Regex.TDFA.TNFA" converts the CorePattern Q\/P data (and its -- Pattern leafs) to a QNFA tagged non-deterministic finite automata.--- +-- -- This holds every possible way to follow one state by another, while -- in the DFA these will be reduced by picking a single best -- transition for each (soure,destination) pair. The transitions are@@ -26,7 +26,7 @@ -- processing Star with optimizations. This compact design also means -- that tags are assigned not just to be updated before taking a -- transition (PreUpdate) but also after the transition (PostUpdate).--- +-- -- Uses recursive do notation. module Text.Regex.TDFA.TNFA(patternToNFA@@ -86,7 +86,7 @@ msg = unlines [ show q ] in debug msg (qToNFA compOpt q,tags,groups) --- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == +-- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- Query function on Q nullable :: Q -> Bool@@ -105,7 +105,7 @@ usesQNFA (Q {wants=WantsQNFA}) = True usesQNFA _ = False --- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == +-- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- Functions related to QT -- dumb smart constructor used by qToQNFA@@ -148,7 +148,7 @@ preferNullViews [] win = win preferNullViews nvs win = foldl' (dominate win) win (reverse $ cleanNullView nvs) where -{- +{- dominate is common to applyNullViews and preferNullViews above. Even I no longer understand it without study.@@ -171,7 +171,7 @@ dominate win lose x@(SetTestInfo sti,tags) = debug ("dominate "++show x) $ let -- The winning states are reached through the SetTag win' = prependTags' tags win- -- get the SetTestInfo + -- get the SetTestInfo winTests = listTestInfo win $ mempty allTests = (listTestInfo lose $ winTests) `mappend` (EMap.keysSet sti) -- The first and second arguments of useTest are sorted@@ -204,7 +204,7 @@ applyTest' q@(Simple {}) = mkTesting $ Testing {qt_test = wt ,qt_dopas = Set.singleton dopa- ,qt_a = q + ,qt_a = q ,qt_b = qtlose} applyTest' q@(Testing {qt_test=wt'}) = case compare wt wt' of@@ -302,7 +302,7 @@ , qt_other = prependQTrans o } where prependQTrans = fmap (map (\(d,tcs) -> (d,tcs' `mappend` tcs))) --- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == +-- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- define type S which is a State monad, this allows the creation of the uniq QNFA ids and storing the QNFA -- in an ascending order difference list for later placement in an array. @@ -330,7 +330,7 @@ put $! (futureI, oldQs . ((thisI,qnfa):)) return qnfa --- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == +-- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- E related functions fromQNFA :: QNFA -> E@@ -439,7 +439,7 @@ addWinTagsAC wtags (e,mE,mQNFA) = (addWinTags wtags e ,fmap (addWinTags wtags) mE ,fmap (addWinTags wtags) mQNFA)--- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == +-- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- Initial preTag of 0th tag is implied. No other general pre-tags would be expected. -- The qtwin contains the preTag of the 1st tag and is only set when a match is completed.@@ -530,7 +530,7 @@ | otherwise = debug (">< inStar/2 "++show qIn++" <>") $ return . fmap (prependGroupResets resets . prependPreTag pre) =<< inStarNullableTagless qIn (addTag post . addGroupSets sets $ eLoop)- + inStarNullableTagless qIn eLoop = debug (">< inStarNullableTagless "++show qIn++" <>") $ do case unQ qIn of Empty -> return Nothing -- with Or this discards () branch in "(^|foo|())*"@@ -619,7 +619,7 @@ actNullableTagless qIn ac@(eLoop,mAccepting,mQNFA) = debug (">< actNullableTagless "++show (qIn)++" <>") $ do case unQ qIn of Seq q1 q2 -> actNullable q1 =<< actNullable q2 ac -- We know q1 and q2 are nullable- + Or [] -> return ac Or [q] -> actNullableTagless q ac Or qs -> do@@ -660,7 +660,7 @@ in ((nQ eLoop,fmap nQ mAccepting,Nothing),False) if cannotAccept q then return ac0 else mdo mChildAccepting <- act q (this,Nothing,Nothing)- (thisAC@(this,_,_),ansAC) <- + (thisAC@(this,_,_),ansAC) <- case mChildAccepting of Nothing -> err $ "Weird pattern in getTransTagless/Star: " ++ show (qTop,qIn) Just childAccepting -> do@@ -761,13 +761,13 @@ toMap :: IntMap [(DoPa,[(Tag, TagUpdate)])] -> [Char] -> CharMap (IntMap [(DoPa,[(Tag, TagUpdate)])]) toMap dest | caseSensitive compOpt = CharMap . IMap.fromDistinctAscList . map (\c -> (ord c,dest))- | otherwise = CharMap . IMap.fromList . ($ []) + | otherwise = CharMap . IMap.fromList . ($ []) . foldr (\c dl -> if isAlpha c then (dl.((ord (toUpper c),dest):) .((ord (toLower c),dest):) ) else (dl.((ord c,dest):))- ) id + ) id addNewline | multiline compOpt = S.insert '\n' | otherwise = id dotTrans | multiline compOpt = Map.singleton '\n' mempty
regex-tdfa.cabal view
@@ -1,17 +1,15 @@ cabal-version: 1.12 name: regex-tdfa-version: 1.3.1.1+version: 1.3.1.2 build-Type: Simple license: BSD3 license-file: LICENSE copyright: Copyright (c) 2007-2009, Christopher Kuklewicz author: Christopher Kuklewicz-maintainer:- Herbert Valerio Riedel <hvr@gnu.org>,- Andreas Abel+maintainer: Andreas Abel homepage: https://wiki.haskell.org/Regular_expressions-bug-reports: https://github.com/hvr/regex-tdfa/issues+bug-reports: https://github.com/haskell-hvr/regex-tdfa/issues category: Text synopsis: Pure Haskell Tagged DFA Backend for "Text.Regex" (regex-base)@@ -23,6 +21,7 @@ extra-source-files: CHANGELOG.md+ README.md test/cases/*.txt tested-with:@@ -35,17 +34,18 @@ GHC == 8.4.4 GHC == 8.6.5 GHC == 8.8.4- GHC == 8.10.4- GHC == 9.0.1+ GHC == 8.10.7+ GHC == 9.0.2+ GHC == 9.2.1 source-repository head type: git- location: https://github.com/hvr/regex-tdfa.git+ location: https://github.com/haskell-hvr/regex-tdfa.git source-repository this type: git- location: https://github.com/hvr/regex-tdfa.git- tag: v1.3.1.1+ location: https://github.com/haskell-hvr/regex-tdfa.git+ tag: v1.3.1.2 flag force-O2 default: False@@ -97,13 +97,13 @@ build-depends: fail == 4.9.* , semigroups == 0.18.* || == 0.19.* build-depends: array >= 0.4 && < 0.6- , base >= 4.5 && < 4.16+ , base >= 4.5 && < 4.17 , bytestring >= 0.9.2 && < 0.12 , containers >= 0.4.2 && < 0.7- , mtl >= 2.1.3 && < 2.3+ , mtl >= 2.1.3 && < 2.4 , parsec == 3.1.* , regex-base == 0.94.*- , text >= 1.2.3 && < 1.3+ , text >= 1.2.3 && < 2.1 default-language: Haskell2010 default-extensions: BangPatterns@@ -116,6 +116,7 @@ MultiParamTypeClasses NondecreasingIndentation RecursiveDo+ ScopedTypeVariables TypeOperators TypeSynonymInstances UnboxedTuples@@ -124,6 +125,9 @@ ghc-options: -Wall -funbox-strict-fields -fspec-constr-count=10 -fno-warn-orphans + if impl(ghc >= 8.0)+ ghc-options: -Wcompat+ if flag(force-O2) ghc-options: -O2 @@ -162,6 +166,9 @@ other-extensions: GeneralizedNewtypeDeriving ghc-options: -Wall -funbox-strict-fields++ if impl(ghc >= 8.0)+ ghc-options: -Wcompat if flag(force-O2) ghc-options: -O2
test/Main.hs view
@@ -1,6 +1,11 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MonoLocalBinds #-} +#if __GLASGOW_HASKELL__ >= 902+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+#endif+ module Main where import Control.Applicative as App@@ -9,7 +14,7 @@ import Data.Array import qualified Data.ByteString as BS import qualified Data.ByteString.UTF8 as UTF8-import Data.List+import Data.List (isInfixOf, mapAccumL, sort) import Data.String import Data.Typeable import Data.Version ()@@ -115,7 +120,7 @@ readTestCases :: FilePath -> IO [(String, String)] readTestCases folder = do- fns <- filter (isSuffixOf ".txt") <$> getDirectoryContents folder+ fns <- filter (".txt" `isInfixOf`) <$> getDirectoryContents folder when (null fns) $ fail ("readTestCases: No test-cases found in " ++ show folder) forM (sort fns) $ \fn -> do