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

Merge pull request #2 from silkapp/master

Browse source 
Fixed two match group bugs
This commit is contained in:
Bryan O'Sullivan 2012-09-09 00:04:58 -07:00
commit dec60f8a1f
1 changed files with 6 additions and 7 deletions
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 ) where
import Control.Arrow (second) import Control.Arrow (second)
import Control.Monad (msum)
import Data.Ix (Ix, inRange) import Data.Ix (Ix, inRange)
import Data.List (nub) import Data.List (nub)
import Data.Maybe (isJust) import Data.Maybe (isJust)
@ -117,8 +118,9 @@ simplifyTerms (MatchClass True (SRange a@[_] []):as) =
simplifyTerms (MatchGroup []:as) = simplifyTerms as simplifyTerms (MatchGroup []:as) = simplifyTerms as
simplifyTerms (MatchGroup gs:as) = simplifyTerms (MatchGroup gs:as) =
case commonPrefix gs of case commonPrefix gs of
(p,[]) -> simplifyTerms (MatchLiteral p : as) (p ,[]) -> simplifyTerms (MatchLiteral p : as)
(p,ss) -> simplifyTerms (MatchLiteral p : MatchGroup ss : as) ("",ss) -> MatchGroup ss : simplifyTerms as
(p ,ss) -> simplifyTerms (MatchLiteral p : MatchGroup ss : as)
simplifyTerms (a:as) = a:simplifyTerms as simplifyTerms (a:as) = a:simplifyTerms as
commonPrefix :: [String] -> (String, [String]) 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 matchClass (b:bs) | (inClass && k) || not (inClass || k) = return bs
where inClass = b `inSRange` c where inClass = b `inSRange` c
matchClass _ = fail "no match" matchClass _ = fail "no match"
matchTerms (MatchGroup g:ts) cs = matchGroup g cs >>= matchTerms ts matchTerms (MatchGroup g:ts) cs = msum (map matchGroup g)
where matchGroup g' as | any null g' = return as where matchGroup g = matchTerms (MatchLiteral g : ts) cs
matchGroup g' (a:as) | a `elem` map head g' =
matchGroup (map tail g') as
matchGroup _ _ = fail "not in group"
matchTerms [MatchAny] _ = return () matchTerms [MatchAny] _ = return ()
matchTerms (MatchAny:ts) cs = matchAny cs >>= matchTerms ts matchTerms (MatchAny:ts) cs = matchAny cs >>= matchTerms ts
where matchAny [] = fail "no match" where matchAny [] = fail "no match"