rhi
/
filemanip
1
0
Fork 0
Code Issues Pull Requests Releases Activity

Merge pull request #2 from silkapp/master 

Fixed two match group bugs
This commit is contained in:
Bryan O'Sullivan 2012-09-09 00:04:58 -07:00
parent 02ed4670d8 b2c11abf31
commit 147e01c893
1 changed files with 6 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
System/FilePath/GlobPattern.hs
View File

@ -15,6 +15,7 @@ module System.FilePath.GlobPattern (
) where
import Control.Arrow (second)
import Control.Monad (msum)
import Data.Ix (Ix, inRange)
import Data.List (nub)
import Data.Maybe (isJust)
@ -117,8 +118,9 @@ simplifyTerms (MatchClass True (SRange a@[_] []):as) =
simplifyTerms (MatchGroup []:as) = simplifyTerms as
simplifyTerms (MatchGroup gs:as) =
case commonPrefix gs of
(p,[]) -> simplifyTerms (MatchLiteral p : as)
(p,ss) -> simplifyTerms (MatchLiteral p : MatchGroup ss : as)
(p ,[]) -> simplifyTerms (MatchLiteral p : as)
("",ss) -> MatchGroup ss : simplifyTerms as
(p ,ss) -> simplifyTerms (MatchLiteral p : MatchGroup ss : as)
simplifyTerms (a:as) = a:simplifyTerms as
commonPrefix :: [String] -> (String, [String])
@ -143,11 +145,8 @@ matchTerms (MatchClass k c:ts) cs = matchClass cs >>= matchTerms ts
where matchClass (b:bs) | (inClass && k) || not (inClass || k) = return bs
where inClass = b `inSRange` c
matchClass _ = fail "no match"
matchTerms (MatchGroup g:ts) cs = matchGroup g cs >>= matchTerms ts
where matchGroup g' as | any null g' = return as
matchGroup g' (a:as) | a `elem` map head g' =
matchGroup (map tail g') as
matchGroup _ _ = fail "not in group"
matchTerms (MatchGroup g:ts) cs = msum (map matchGroup g)
where matchGroup g = matchTerms (MatchLiteral g : ts) cs
matchTerms [MatchAny] _ = return ()
matchTerms (MatchAny:ts) cs = matchAny cs >>= matchTerms ts
where matchAny [] = fail "no match"