-- |
-- Module:      System.FilePath.GlobPattern
-- Copyright:   Bryan O'Sullivan
-- License:     BSD3
-- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>
-- Stability:   unstable
-- Portability: everywhere
module System.FilePath.GlobPattern (
    -- * Glob patterns
    -- $syntax
      GlobPattern
    -- * Matching functions
    , (~~)
    , (/~)
    ) where

import Control.Arrow (second)
import Control.Monad (msum)
import Data.Ix (Ix, inRange)
import Data.List (nub)
import Data.Maybe (isJust)
import System.FilePath (pathSeparator)

-- $syntax
--
-- Basic glob pattern syntax is the same as for the Unix shell
-- environment.
-- 
-- * @*@ matches everything up to a directory separator or end of
-- string.
--
-- * @[/range/]@ matches any character in /range/.
-- 
-- * @[!/range/]@ matches any character /not/ in /range/.
-- 
-- There are three extensions to the traditional glob syntax, taken
-- from modern Unix shells.
--
-- * @\\@ escapes a character that might otherwise have special
-- meaning.  For a literal @\"\\\"@ character, use @\"\\\\\"@.
-- 
-- * @**@ matches everything, including a directory separator.
-- 
-- * @(/s1/|/s2/|/.../)@ matches any of the strings /s1/, /s2/, etc.

-- | Glob pattern type.
type GlobPattern = String

spanClass :: Char -> String -> (String, String)

spanClass :: Char -> [Char] -> ([Char], [Char])
spanClass Char
c = [Char] -> [Char] -> ([Char], [Char])
gs []
    where gs :: [Char] -> [Char] -> ([Char], [Char])
gs [Char]
_ [] = [Char] -> ([Char], [Char])
forall a. HasCallStack => [Char] -> a
error [Char]
"unterminated character class"
          gs [Char]
acc (Char
d:[Char]
ds) | Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c = ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
acc, [Char]
ds)
                        | Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' = case [Char]
ds of
                                     (Char
e:[Char]
es) -> [Char] -> [Char] -> ([Char], [Char])
gs (Char
eChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
'\\'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
acc) [Char]
es
                                     [Char]
_ -> [Char] -> ([Char], [Char])
forall a. HasCallStack => [Char] -> a
error [Char]
"unterminated escape"
                        | Bool
otherwise = [Char] -> [Char] -> ([Char], [Char])
gs (Char
dChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
acc) [Char]
ds

data Ix a => SRange a = SRange [a] [(a, a)]
                      deriving (Int -> SRange a -> [Char] -> [Char]
[SRange a] -> [Char] -> [Char]
SRange a -> [Char]
(Int -> SRange a -> [Char] -> [Char])
-> (SRange a -> [Char])
-> ([SRange a] -> [Char] -> [Char])
-> Show (SRange a)
forall a. (Ix a, Show a) => Int -> SRange a -> [Char] -> [Char]
forall a. (Ix a, Show a) => [SRange a] -> [Char] -> [Char]
forall a. (Ix a, Show a) => SRange a -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: forall a. (Ix a, Show a) => Int -> SRange a -> [Char] -> [Char]
showsPrec :: Int -> SRange a -> [Char] -> [Char]
$cshow :: forall a. (Ix a, Show a) => SRange a -> [Char]
show :: SRange a -> [Char]
$cshowList :: forall a. (Ix a, Show a) => [SRange a] -> [Char] -> [Char]
showList :: [SRange a] -> [Char] -> [Char]
Show)

inSRange :: Ix a => a -> SRange a -> Bool

inSRange :: forall a. Ix a => a -> SRange a -> Bool
inSRange a
c (SRange [a]
d [(a, a)]
s) = a
c a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
d Bool -> Bool -> Bool
|| ((a, a) -> Bool) -> [(a, a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (((a, a) -> a -> Bool) -> a -> (a, a) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a, a) -> a -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange a
c) [(a, a)]
s

type CharClass = SRange Char

makeClass :: String -> CharClass

makeClass :: [Char] -> CharClass
makeClass = [(Char, Char)] -> [Char] -> [Char] -> CharClass
makeClass' [] []
    where makeClass' :: [(Char, Char)] -> [Char] -> String -> CharClass
          makeClass' :: [(Char, Char)] -> [Char] -> [Char] -> CharClass
makeClass' [(Char, Char)]
dense [Char]
sparse [] = [Char] -> [(Char, Char)] -> CharClass
forall a. Ix a => [a] -> [(a, a)] -> SRange a
SRange [Char]
sparse [(Char, Char)]
dense
          makeClass' [(Char, Char)]
dense [Char]
sparse (Char
a:Char
'-':Char
b:[Char]
cs) =
              [(Char, Char)] -> [Char] -> [Char] -> CharClass
makeClass' ((Char
a,Char
b)(Char, Char) -> [(Char, Char)] -> [(Char, Char)]
forall a. a -> [a] -> [a]
:[(Char, Char)]
dense) [Char]
sparse [Char]
cs
          makeClass' [(Char, Char)]
dense [Char]
sparse (Char
c:[Char]
cs) = [(Char, Char)] -> [Char] -> [Char] -> CharClass
makeClass' [(Char, Char)]
dense (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
sparse) [Char]
cs

data MatchTerm = MatchLiteral String
               | MatchAny
               | MatchDir
               | MatchChar
               | MatchClass Bool CharClass
               | MatchGroup [String]
                 deriving (Int -> MatchTerm -> [Char] -> [Char]
[MatchTerm] -> [Char] -> [Char]
MatchTerm -> [Char]
(Int -> MatchTerm -> [Char] -> [Char])
-> (MatchTerm -> [Char])
-> ([MatchTerm] -> [Char] -> [Char])
-> Show MatchTerm
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> MatchTerm -> [Char] -> [Char]
showsPrec :: Int -> MatchTerm -> [Char] -> [Char]
$cshow :: MatchTerm -> [Char]
show :: MatchTerm -> [Char]
$cshowList :: [MatchTerm] -> [Char] -> [Char]
showList :: [MatchTerm] -> [Char] -> [Char]
Show)

parseGlob :: GlobPattern -> [MatchTerm]
             
parseGlob :: [Char] -> [MatchTerm]
parseGlob [] = []
parseGlob (Char
'*':Char
'*':[Char]
cs) = MatchTerm
MatchAny MatchTerm -> [MatchTerm] -> [MatchTerm]
forall a. a -> [a] -> [a]
: [Char] -> [MatchTerm]
parseGlob [Char]
cs
parseGlob (Char
'*':[Char]
cs) = MatchTerm
MatchDir MatchTerm -> [MatchTerm] -> [MatchTerm]
forall a. a -> [a] -> [a]
: [Char] -> [MatchTerm]
parseGlob [Char]
cs
parseGlob (Char
'?':[Char]
cs) = MatchTerm
MatchChar MatchTerm -> [MatchTerm] -> [MatchTerm]
forall a. a -> [a] -> [a]
: [Char] -> [MatchTerm]
parseGlob [Char]
cs
parseGlob (Char
'[':[Char]
cs) = let ([Char]
cc, [Char]
ccs) = Char -> [Char] -> ([Char], [Char])
spanClass Char
']' [Char]
cs
                         cls :: MatchTerm
cls = case [Char]
cc of
                               (Char
'!':[Char]
ccs') -> Bool -> CharClass -> MatchTerm
MatchClass Bool
False (CharClass -> MatchTerm) -> CharClass -> MatchTerm
forall a b. (a -> b) -> a -> b
$ [Char] -> CharClass
makeClass [Char]
ccs'
                               [Char]
_ -> Bool -> CharClass -> MatchTerm
MatchClass Bool
True (CharClass -> MatchTerm) -> CharClass -> MatchTerm
forall a b. (a -> b) -> a -> b
$ [Char] -> CharClass
makeClass [Char]
cc
                     in MatchTerm
cls MatchTerm -> [MatchTerm] -> [MatchTerm]
forall a. a -> [a] -> [a]
: [Char] -> [MatchTerm]
parseGlob [Char]
ccs
parseGlob (Char
'(':[Char]
cs) = let ([Char]
gg, [Char]
ggs) = Char -> [Char] -> ([Char], [Char])
spanClass Char
')' [Char]
cs
                     in [[Char]] -> MatchTerm
MatchGroup ([Char] -> [Char] -> [[Char]]
breakGroup [] [Char]
gg) MatchTerm -> [MatchTerm] -> [MatchTerm]
forall a. a -> [a] -> [a]
: [Char] -> [MatchTerm]
parseGlob [Char]
ggs
    where breakGroup :: String -> String -> [String]
          breakGroup :: [Char] -> [Char] -> [[Char]]
breakGroup [Char]
acc [] = [[Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
acc]
          breakGroup [Char]
_ [Char
'\\'] = [Char] -> [[Char]]
forall a. HasCallStack => [Char] -> a
error [Char]
"group: unterminated escape"
          breakGroup [Char]
acc (Char
'\\':Char
c:[Char]
cs') = [Char] -> [Char] -> [[Char]]
breakGroup (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
acc) [Char]
cs'
          breakGroup [Char]
acc (Char
'|':[Char]
cs') = [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
acc [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char] -> [Char] -> [[Char]]
breakGroup [] [Char]
cs'
          breakGroup [Char]
acc (Char
c:[Char]
cs') = [Char] -> [Char] -> [[Char]]
breakGroup (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
acc) [Char]
cs'
parseGlob [Char
'\\'] = [Char] -> [MatchTerm]
forall a. HasCallStack => [Char] -> a
error [Char]
"glob: unterminated escape"
parseGlob (Char
'\\':Char
c:[Char]
cs) = [Char] -> MatchTerm
MatchLiteral [Char
c] MatchTerm -> [MatchTerm] -> [MatchTerm]
forall a. a -> [a] -> [a]
: [Char] -> [MatchTerm]
parseGlob [Char]
cs
parseGlob (Char
c:[Char]
cs) = [Char] -> MatchTerm
MatchLiteral [Char
c] MatchTerm -> [MatchTerm] -> [MatchTerm]
forall a. a -> [a] -> [a]
: [Char] -> [MatchTerm]
parseGlob [Char]
cs

simplifyTerms :: [MatchTerm] -> [MatchTerm]
simplifyTerms :: [MatchTerm] -> [MatchTerm]
simplifyTerms [] = []
simplifyTerms (MatchLiteral []:[MatchTerm]
as) = [MatchTerm] -> [MatchTerm]
simplifyTerms [MatchTerm]
as
simplifyTerms (m :: MatchTerm
m@(MatchLiteral [Char]
a):[MatchTerm]
as) =
    case [MatchTerm] -> [MatchTerm]
simplifyTerms [MatchTerm]
as of
    (MatchLiteral [Char]
b:[MatchTerm]
bs) -> [Char] -> MatchTerm
MatchLiteral ([Char]
a [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
b) MatchTerm -> [MatchTerm] -> [MatchTerm]
forall a. a -> [a] -> [a]
: [MatchTerm]
bs
    [MatchTerm]
bs -> MatchTerm
m MatchTerm -> [MatchTerm] -> [MatchTerm]
forall a. a -> [a] -> [a]
: [MatchTerm]
bs
simplifyTerms (MatchClass Bool
True (SRange [] []):[MatchTerm]
as) = [MatchTerm] -> [MatchTerm]
simplifyTerms [MatchTerm]
as
simplifyTerms (MatchClass Bool
True (SRange a :: [Char]
a@[Char
_] []):[MatchTerm]
as) =
    [MatchTerm] -> [MatchTerm]
simplifyTerms ([MatchTerm] -> [MatchTerm]) -> [MatchTerm] -> [MatchTerm]
forall a b. (a -> b) -> a -> b
$ [Char] -> MatchTerm
MatchLiteral [Char]
a MatchTerm -> [MatchTerm] -> [MatchTerm]
forall a. a -> [a] -> [a]
: [MatchTerm]
as
simplifyTerms (MatchGroup []:[MatchTerm]
as) = [MatchTerm] -> [MatchTerm]
simplifyTerms [MatchTerm]
as
simplifyTerms (MatchGroup [[Char]]
gs:[MatchTerm]
as) =
    case [[Char]] -> ([Char], [[Char]])
commonPrefix [[Char]]
gs of
    ([Char]
p ,[]) -> [MatchTerm] -> [MatchTerm]
simplifyTerms ([Char] -> MatchTerm
MatchLiteral [Char]
p MatchTerm -> [MatchTerm] -> [MatchTerm]
forall a. a -> [a] -> [a]
: [MatchTerm]
as)
    ([Char]
"",[[Char]]
ss) -> [[Char]] -> MatchTerm
MatchGroup [[Char]]
ss MatchTerm -> [MatchTerm] -> [MatchTerm]
forall a. a -> [a] -> [a]
: [MatchTerm] -> [MatchTerm]
simplifyTerms [MatchTerm]
as
    ([Char]
p ,[[Char]]
ss) -> [MatchTerm] -> [MatchTerm]
simplifyTerms ([Char] -> MatchTerm
MatchLiteral [Char]
p MatchTerm -> [MatchTerm] -> [MatchTerm]
forall a. a -> [a] -> [a]
: [[Char]] -> MatchTerm
MatchGroup [[Char]]
ss MatchTerm -> [MatchTerm] -> [MatchTerm]
forall a. a -> [a] -> [a]
: [MatchTerm]
as)
simplifyTerms (MatchTerm
a:[MatchTerm]
as) = MatchTerm
aMatchTerm -> [MatchTerm] -> [MatchTerm]
forall a. a -> [a] -> [a]
:[MatchTerm] -> [MatchTerm]
simplifyTerms [MatchTerm]
as

commonPrefix :: [String] -> (String, [String])
commonPrefix :: [[Char]] -> ([Char], [[Char]])
commonPrefix = ([[Char]] -> [[Char]]) -> ([Char], [[Char]]) -> ([Char], [[Char]])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub (([Char], [[Char]]) -> ([Char], [[Char]]))
-> ([[Char]] -> ([Char], [[Char]]))
-> [[Char]]
-> ([Char], [[Char]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> ([Char], [[Char]])
pfx [Char]
""
    where pfx :: [Char] -> [[Char]] -> ([Char], [[Char]])
pfx [Char]
_ [] = ([Char]
"", [])
          pfx [Char]
acc [[Char]]
ss | ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
ss = ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
acc, [[Char]]
ss)
                     | Bool
otherwise = let hs :: [Char]
hs = ([Char] -> Char) -> [[Char]] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Char
forall a. HasCallStack => [a] -> a
head [[Char]]
ss
                                       h :: Char
h = [Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
hs
                                   in if (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char
hChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
tail [Char]
hs
                                      then [Char] -> [[Char]] -> ([Char], [[Char]])
pfx (Char
hChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
acc) ([[Char]] -> ([Char], [[Char]])) -> [[Char]] -> ([Char], [[Char]])
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
tail [[Char]]
ss
                                      else ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
acc, [[Char]]
ss)

matchTerms :: [MatchTerm] -> String -> Maybe ()

matchTerms :: [MatchTerm] -> [Char] -> Maybe ()
matchTerms [] [] = () -> Maybe ()
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
matchTerms [] [Char]
_ = [Char] -> Maybe ()
forall a. [Char] -> Maybe a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"residual string"
matchTerms (MatchLiteral [Char]
m:[MatchTerm]
ts) [Char]
cs = [Char] -> [Char] -> Maybe [Char]
forall {a} {m :: * -> *}.
(Eq a, MonadFail m) =>
[a] -> [a] -> m [a]
matchLiteral [Char]
m [Char]
cs Maybe [Char] -> ([Char] -> Maybe ()) -> Maybe ()
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [MatchTerm] -> [Char] -> Maybe ()
matchTerms [MatchTerm]
ts
    where matchLiteral :: [a] -> [a] -> m [a]
matchLiteral (a
a:[a]
as) (a
b:[a]
bs) | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b = [a] -> [a] -> m [a]
matchLiteral [a]
as [a]
bs
          matchLiteral [] [a]
as = [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
as
          matchLiteral [a]
_ [a]
_ = [Char] -> m [a]
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"not a prefix"
matchTerms (MatchClass Bool
k CharClass
c:[MatchTerm]
ts) [Char]
cs = [Char] -> Maybe [Char]
forall {m :: * -> *}. MonadFail m => [Char] -> m [Char]
matchClass [Char]
cs Maybe [Char] -> ([Char] -> Maybe ()) -> Maybe ()
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [MatchTerm] -> [Char] -> Maybe ()
matchTerms [MatchTerm]
ts
    where matchClass :: [Char] -> m [Char]
matchClass (Char
b:[Char]
bs) | (Bool
inClass Bool -> Bool -> Bool
&& Bool
k) Bool -> Bool -> Bool
|| Bool -> Bool
not (Bool
inClass Bool -> Bool -> Bool
|| Bool
k) = [Char] -> m [Char]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
bs
                            where inClass :: Bool
inClass = Char
b Char -> CharClass -> Bool
forall a. Ix a => a -> SRange a -> Bool
`inSRange` CharClass
c
          matchClass [Char]
_ = [Char] -> m [Char]
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"no match"
matchTerms (MatchGroup [[Char]]
g:[MatchTerm]
ts) [Char]
cs = [Maybe ()] -> Maybe ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (([Char] -> Maybe ()) -> [[Char]] -> [Maybe ()]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Maybe ()
matchGroup [[Char]]
g)
    where matchGroup :: [Char] -> Maybe ()
matchGroup [Char]
g = [MatchTerm] -> [Char] -> Maybe ()
matchTerms ([Char] -> MatchTerm
MatchLiteral [Char]
g MatchTerm -> [MatchTerm] -> [MatchTerm]
forall a. a -> [a] -> [a]
: [MatchTerm]
ts) [Char]
cs
matchTerms [MatchTerm
MatchAny] [Char]
_ = () -> Maybe ()
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
matchTerms (MatchTerm
MatchAny:[MatchTerm]
ts) [Char]
cs = [Char] -> Maybe [Char]
forall {m :: * -> *}. MonadFail m => [Char] -> m [Char]
matchAny [Char]
cs Maybe [Char] -> ([Char] -> Maybe ()) -> Maybe ()
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [MatchTerm] -> [Char] -> Maybe ()
matchTerms [MatchTerm]
ts
    where matchAny :: [Char] -> m [Char]
matchAny [] = [Char] -> m [Char]
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"no match"
          matchAny [Char]
cs' = case [MatchTerm] -> [Char] -> Maybe ()
matchTerms [MatchTerm]
ts [Char]
cs' of
                          Maybe ()
Nothing -> [Char] -> m [Char]
matchAny ([Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
tail [Char]
cs')
                          Maybe ()
_ -> [Char] -> m [Char]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
cs'
matchTerms [MatchTerm
MatchDir] [Char]
cs | Char
pathSeparator Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
cs = [Char] -> Maybe ()
forall a. [Char] -> Maybe a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"path separator"
                         | Bool
otherwise = () -> Maybe ()
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
matchTerms (MatchTerm
MatchDir:[MatchTerm]
ts) [Char]
cs = [Char] -> Maybe [Char]
forall {m :: * -> *}. MonadFail m => [Char] -> m [Char]
matchDir [Char]
cs Maybe [Char] -> ([Char] -> Maybe ()) -> Maybe ()
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [MatchTerm] -> [Char] -> Maybe ()
matchTerms [MatchTerm]
ts
    where matchDir :: [Char] -> m [Char]
matchDir [] = [Char] -> m [Char]
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"no match"
          matchDir (Char
c:[Char]
_) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
pathSeparator = [Char] -> m [Char]
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"path separator"
          matchDir [Char]
cs' = case [MatchTerm] -> [Char] -> Maybe ()
matchTerms [MatchTerm]
ts [Char]
cs' of
                         Maybe ()
Nothing -> [Char] -> m [Char]
matchDir ([Char] -> m [Char]) -> [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
tail [Char]
cs'
                         Maybe ()
_ -> [Char] -> m [Char]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
cs'
matchTerms (MatchTerm
MatchChar:[MatchTerm]
_) [] = [Char] -> Maybe ()
forall a. [Char] -> Maybe a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"end of input"
matchTerms (MatchTerm
MatchChar:[MatchTerm]
ts) (Char
_:[Char]
cs) = [MatchTerm] -> [Char] -> Maybe ()
matchTerms [MatchTerm]
ts [Char]
cs

-- | Match a file name against a glob pattern.
(~~) :: FilePath -> GlobPattern -> Bool

[Char]
name ~~ :: [Char] -> [Char] -> Bool
~~ [Char]
pat = let terms :: [MatchTerm]
terms = [MatchTerm] -> [MatchTerm]
simplifyTerms ([Char] -> [MatchTerm]
parseGlob [Char]
pat)
              in (Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (Maybe () -> Bool) -> ([Char] -> Maybe ()) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MatchTerm] -> [Char] -> Maybe ()
matchTerms [MatchTerm]
terms) [Char]
name

-- | Match a file name against a glob pattern, but return 'True' if
-- the match /fail/s.
(/~) :: FilePath -> GlobPattern -> Bool

/~ :: [Char] -> [Char] -> Bool
(/~) = (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ) (([Char] -> Bool) -> [Char] -> Bool)
-> ([Char] -> [Char] -> Bool) -> [Char] -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> Bool
(~~)