-- File created: 2008-10-16 12:12:50


module System.FilePath.Glob.Directory
   ( GlobOptions(..), globDefault
   , globDir, globDirWith, globDir1, glob
   , commonDirectory
   ) where

import Control.Arrow    (first, second)
import Control.Monad    (forM)
import qualified Data.DList as DL
import Data.DList       (DList)
import Data.List        ((\\), find)
import System.Directory ( doesDirectoryExist, getDirectoryContents
                        , getCurrentDirectory
                        )
import System.FilePath  ( (</>), takeDrive, splitDrive
                        , isExtSeparator
                        , pathSeparator, isPathSeparator
                        , takeDirectory
                        )

import System.FilePath.Glob.Base  ( Pattern(..), Token(..)
                                  , MatchOptions, matchDefault
                                  , compile
                                  )
import System.FilePath.Glob.Match (matchWith)
import System.FilePath.Glob.Utils ( getRecursiveContents
                                  , nubOrd
                                  , pathParts
                                  , partitionDL, tailDL
                                  , catchIO
                                  )
-- |Options which can be passed to the 'globDirWith' function.

data GlobOptions = GlobOptions
  { GlobOptions -> MatchOptions
matchOptions :: MatchOptions
  -- ^Options controlling how matching is performed; see 'MatchOptions'.

  , GlobOptions -> Bool
includeUnmatched :: Bool
  -- ^Whether to include unmatched files in the result.

  }

-- |The default set of globbing options: uses the default matching options, and

-- does not include unmatched files.

globDefault :: GlobOptions
globDefault :: GlobOptions
globDefault = MatchOptions -> Bool -> GlobOptions
GlobOptions MatchOptions
matchDefault Bool
False

-- The Patterns in TypedPattern don't contain PathSeparator or AnyDirectory

--

-- We store the number of PathSeparators that Dir and AnyDir were followed by

-- so that "foo////*" can match "foo/bar" but return "foo////bar". It's the

-- exact number for convenience: (</>) doesn't add a path separator if one is

-- already there. This way, '\(Dir n _) -> replicate n pathSeparator </> "bar"'

-- results in the correct amount of slashes.

data TypedPattern
   = Any Pattern        -- pattern

   | Dir Int Pattern    -- pattern/

   | AnyDir Int Pattern -- pattern**/

   deriving Int -> TypedPattern -> ShowS
[TypedPattern] -> ShowS
TypedPattern -> String
(Int -> TypedPattern -> ShowS)
-> (TypedPattern -> String)
-> ([TypedPattern] -> ShowS)
-> Show TypedPattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypedPattern] -> ShowS
$cshowList :: [TypedPattern] -> ShowS
show :: TypedPattern -> String
$cshow :: TypedPattern -> String
showsPrec :: Int -> TypedPattern -> ShowS
$cshowsPrec :: Int -> TypedPattern -> ShowS
Show

-- |Matches each given 'Pattern' against the contents of the given 'FilePath',

-- recursively. The result contains the matched paths, grouped for each given

-- 'Pattern'. The results are not in any defined order.

--

-- The given directory is prepended to all the matches: the returned paths are

-- all valid from the point of view of the current working directory.

--

-- If multiple 'Pattern's match a single 'FilePath', that path will be included

-- in multiple groups.

--

-- Two 'FilePath's which can be canonicalized to the same file (e.g. @\"foo\"@

-- and @\"./foo\"@) may appear separately if explicit matching on paths

-- beginning with @\".\"@ is done. Looking for @\".*/*\"@, for instance, will

-- cause @\"./foo\"@ to return as a match but @\"foo\"@ to not be matched.

--

-- This function is different from a simple 'filter' over all the contents of

-- the directory: the matching is performed relative to the directory, so that

-- for instance the following is true:

--

-- > fmap head (globDir [compile "*"] dir) == getDirectoryContents dir

--

-- (With the exception that that glob won't match anything beginning with @.@.)

--

-- If the given 'FilePath' is @[]@, 'getCurrentDirectory' will be used.

--

-- If the given 'Pattern' starts with a drive (as defined by

-- 'System.FilePath'), it is not relative to the given directory and the

-- 'FilePath' parameter is completely ignored! Similarly, if the given

-- 'Pattern' starts with a path separator, only the drive part of the

-- 'FilePath' is used. On Posix systems these behaviours are equivalent:

-- 'Pattern's starting with @\/@ work relative to @\/@. On Windows, 'Pattern's

-- starting with @\/@ or @\\@ work relative only to the drive part of the

-- 'FilePath' and 'Pattern's starting with absolute paths ignore the

-- 'FilePath'.

--

-- Note that in some cases results outside the given directory may be returned:

-- for instance the @.*@ pattern matches the @..@ directory.

--

-- Any results deeper than in the given directory are enumerated lazily, using

-- 'unsafeInterleaveIO'.

--

-- Directories without read permissions are returned as entries but their

-- contents, of course, are not.

globDir :: [Pattern] -> FilePath -> IO [[FilePath]]
globDir :: [Pattern] -> String -> IO [[String]]
globDir [Pattern]
pats String
dir = (([[String]], Maybe [String]) -> [[String]])
-> IO ([[String]], Maybe [String]) -> IO [[String]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([[String]], Maybe [String]) -> [[String]]
forall a b. (a, b) -> a
fst (GlobOptions
-> [Pattern] -> String -> IO ([[String]], Maybe [String])
globDirWith GlobOptions
globDefault [Pattern]
pats String
dir)

-- |Like 'globDir', but applies the given 'GlobOptions' instead of the

-- defaults when matching. The first component of the returned tuple contains

-- the matched paths, grouped for each given 'Pattern', and the second contains

-- Just the unmatched paths if the given 'GlobOptions' specified that unmatched

-- files should be included, or otherwise Nothing.

globDirWith :: GlobOptions -> [Pattern] -> FilePath
            -> IO ([[FilePath]], Maybe [FilePath])
globDirWith :: GlobOptions
-> [Pattern] -> String -> IO ([[String]], Maybe [String])
globDirWith GlobOptions
opts [Pattern
pat] String
dir | Bool -> Bool
not (GlobOptions -> Bool
includeUnmatched GlobOptions
opts) =
   -- This is an optimization for the case where only one pattern has been

   -- passed and we are not including unmatched files: we can use

   -- 'commonDirectory' to avoid some calls to 'getDirectoryContents'.

   let (String
prefix, Pattern
pat') = Pattern -> (String, Pattern)
commonDirectory Pattern
pat
    in GlobOptions
-> [Pattern] -> String -> IO ([[String]], Maybe [String])
globDirWith' GlobOptions
opts [Pattern
pat'] (String
dir String -> ShowS
</> String
prefix)

globDirWith GlobOptions
opts [Pattern]
pats String
dir =
   GlobOptions
-> [Pattern] -> String -> IO ([[String]], Maybe [String])
globDirWith' GlobOptions
opts [Pattern]
pats String
dir

-- See 'globDirWith'.

globDirWith' :: GlobOptions -> [Pattern] -> FilePath
            -> IO ([[FilePath]], Maybe [FilePath])
globDirWith' :: GlobOptions
-> [Pattern] -> String -> IO ([[String]], Maybe [String])
globDirWith' GlobOptions
opts []   String
dir =
   if GlobOptions -> Bool
includeUnmatched GlobOptions
opts
      then do
         String
dir' <- if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
dir then IO String
getCurrentDirectory else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
dir
         DList String
c <- String -> IO (DList String)
getRecursiveContents String
dir'
         ([[String]], Maybe [String]) -> IO ([[String]], Maybe [String])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [String] -> Maybe [String]
forall a. a -> Maybe a
Just (DList String -> [String]
forall a. DList a -> [a]
DL.toList DList String
c))
      else
         ([[String]], Maybe [String]) -> IO ([[String]], Maybe [String])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe [String]
forall a. Maybe a
Nothing)

globDirWith' GlobOptions
opts pats :: [Pattern]
pats@(Pattern
_:[Pattern]
_) String
dir = do
   [(DList String, DList String)]
results <- (Pattern -> IO (DList String, DList String))
-> [Pattern] -> IO [(DList String, DList String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Pattern
p -> GlobOptions -> Pattern -> String -> IO (DList String, DList String)
globDir'0 GlobOptions
opts Pattern
p String
dir) [Pattern]
pats

   let ([DList String]
matches, [DList String]
others) = [(DList String, DList String)] -> ([DList String], [DList String])
forall a b. [(a, b)] -> ([a], [b])
unzip [(DList String, DList String)]
results
       allMatches :: [String]
allMatches        = DList String -> [String]
forall a. DList a -> [a]
DL.toList (DList String -> [String])
-> ([DList String] -> DList String) -> [DList String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DList String] -> DList String
forall a. [DList a] -> DList a
DL.concat ([DList String] -> [String]) -> [DList String] -> [String]
forall a b. (a -> b) -> a -> b
$ [DList String]
matches
       allOthers :: [String]
allOthers         = DList String -> [String]
forall a. DList a -> [a]
DL.toList (DList String -> [String])
-> ([DList String] -> DList String) -> [DList String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DList String] -> DList String
forall a. [DList a] -> DList a
DL.concat ([DList String] -> [String]) -> [DList String] -> [String]
forall a b. (a -> b) -> a -> b
$ [DList String]
others

   ([[String]], Maybe [String]) -> IO ([[String]], Maybe [String])
forall (m :: * -> *) a. Monad m => a -> m a
return ( (DList String -> [String]) -> [DList String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map DList String -> [String]
forall a. DList a -> [a]
DL.toList [DList String]
matches
          , if GlobOptions -> Bool
includeUnmatched GlobOptions
opts
               then [String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd [String]
allOthers [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
allMatches)
               else Maybe [String]
forall a. Maybe a
Nothing
          )

-- |A convenience wrapper on top of 'globDir', for when you only have one

-- 'Pattern' you care about. Returns only the matched paths.

globDir1 :: Pattern -> FilePath -> IO [FilePath]
globDir1 :: Pattern -> String -> IO [String]
globDir1 Pattern
p = ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[String]] -> [String]
forall a. [a] -> a
head (IO [[String]] -> IO [String])
-> (String -> IO [[String]]) -> String -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern] -> String -> IO [[String]]
globDir [Pattern
p]

-- |The simplest IO function. Finds matches to the given pattern in the current

-- working directory. Takes a 'String' instead of a 'Pattern' to avoid the need

-- for a call to 'compile', simplifying usage further.

--

-- Can also be seen as a convenience wrapper on top of 'globDir1', for when you

-- want to work in the current directory or have a pattern referring to an

-- absolute path.

glob :: String -> IO [FilePath]
glob :: String -> IO [String]
glob = (Pattern -> String -> IO [String])
-> String -> Pattern -> IO [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Pattern -> String -> IO [String]
globDir1 String
"" (Pattern -> IO [String])
-> (String -> Pattern) -> String -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Pattern
compile

globDir'0 :: GlobOptions -> Pattern -> FilePath
          -> IO (DList FilePath, DList FilePath)
globDir'0 :: GlobOptions -> Pattern -> String -> IO (DList String, DList String)
globDir'0 GlobOptions
opts Pattern
pat String
dir = do
   let (Pattern
pat', Maybe String
drive) = Pattern -> (Pattern, Maybe String)
driveSplit Pattern
pat
   String
dir' <- case Maybe String
drive of
                Just String
"" -> ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
takeDrive IO String
getCurrentDirectory
                Just String
d  -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
d
                Maybe String
Nothing -> if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
dir then IO String
getCurrentDirectory else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
dir
   GlobOptions
-> [TypedPattern] -> String -> IO (DList String, DList String)
globDir' GlobOptions
opts (Pattern -> [TypedPattern]
separate Pattern
pat') String
dir'

globDir' :: GlobOptions -> [TypedPattern] -> FilePath
         -> IO (DList FilePath, DList FilePath)
globDir' :: GlobOptions
-> [TypedPattern] -> String -> IO (DList String, DList String)
globDir' GlobOptions
opts pats :: [TypedPattern]
pats@(TypedPattern
_:[TypedPattern]
_) String
dir = do
   [String]
entries <- String -> IO [String]
getDirectoryContents String
dir IO [String] -> (IOException -> IO [String]) -> IO [String]
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` IO [String] -> IOException -> IO [String]
forall a b. a -> b -> a
const ([String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [])

   [(DList String, DList String)]
results <- [String]
-> (String -> IO (DList String, DList String))
-> IO [(DList String, DList String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
entries ((String -> IO (DList String, DList String))
 -> IO [(DList String, DList String)])
-> (String -> IO (DList String, DList String))
-> IO [(DList String, DList String)]
forall a b. (a -> b) -> a -> b
$ \String
e -> GlobOptions
-> [TypedPattern]
-> String
-> String
-> IO (DList String, DList String)
matchTypedAndGo GlobOptions
opts [TypedPattern]
pats String
e (String
dir String -> ShowS
</> String
e)

   let ([DList String]
matches, [DList String]
others) = [(DList String, DList String)] -> ([DList String], [DList String])
forall a b. [(a, b)] -> ([a], [b])
unzip [(DList String, DList String)]
results

   (DList String, DList String) -> IO (DList String, DList String)
forall (m :: * -> *) a. Monad m => a -> m a
return ([DList String] -> DList String
forall a. [DList a] -> DList a
DL.concat [DList String]
matches, [DList String] -> DList String
forall a. [DList a] -> DList a
DL.concat [DList String]
others)

globDir' GlobOptions
_ [] String
dir =
   -- We can only get here from matchTypedAndGo getting a [Dir _]: it means the

   -- original pattern had a trailing PathSeparator. Reproduce it here.

   (DList String, DList String) -> IO (DList String, DList String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> DList String
forall a. a -> DList a
DL.singleton (String
dir String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
pathSeparator]), DList String
forall a. DList a
DL.empty)

matchTypedAndGo :: GlobOptions
                -> [TypedPattern]
                -> FilePath -> FilePath
                -> IO (DList FilePath, DList FilePath)

-- (Any p) is always the last element

matchTypedAndGo :: GlobOptions
-> [TypedPattern]
-> String
-> String
-> IO (DList String, DList String)
matchTypedAndGo GlobOptions
opts [Any Pattern
p] String
path String
absPath =
   if MatchOptions -> Pattern -> String -> Bool
matchWith (GlobOptions -> MatchOptions
matchOptions GlobOptions
opts) Pattern
p String
path
      then (DList String, DList String) -> IO (DList String, DList String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> DList String
forall a. a -> DList a
DL.singleton String
absPath, DList String
forall a. DList a
DL.empty)
      else String -> IO Bool
doesDirectoryExist String
absPath IO Bool
-> (Bool -> IO (DList String, DList String))
-> IO (DList String, DList String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GlobOptions
-> String -> String -> Bool -> IO (DList String, DList String)
didNotMatch GlobOptions
opts String
path String
absPath

matchTypedAndGo GlobOptions
opts (Dir Int
n Pattern
p:[TypedPattern]
ps) String
path String
absPath = do
   Bool
isDir <- String -> IO Bool
doesDirectoryExist String
absPath
   if Bool
isDir Bool -> Bool -> Bool
&& MatchOptions -> Pattern -> String -> Bool
matchWith (GlobOptions -> MatchOptions
matchOptions GlobOptions
opts) Pattern
p String
path
      then GlobOptions
-> [TypedPattern] -> String -> IO (DList String, DList String)
globDir' GlobOptions
opts [TypedPattern]
ps (String
absPath String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
pathSeparator)
      else GlobOptions
-> String -> String -> Bool -> IO (DList String, DList String)
didNotMatch GlobOptions
opts String
path String
absPath Bool
isDir

matchTypedAndGo GlobOptions
opts (AnyDir Int
n Pattern
p:[TypedPattern]
ps) String
path String
absPath =
   if String
path String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".",String
".."]
      then GlobOptions
-> String -> String -> Bool -> IO (DList String, DList String)
didNotMatch GlobOptions
opts String
path String
absPath Bool
True
      else do
         Bool
isDir <- String -> IO Bool
doesDirectoryExist String
absPath
         let m :: String -> Bool
m = MatchOptions -> Pattern -> String -> Bool
matchWith (GlobOptions -> MatchOptions
matchOptions GlobOptions
opts) ([TypedPattern] -> Pattern
unseparate [TypedPattern]
ps)
             unconditionalMatch :: Bool
unconditionalMatch =
                [Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Pattern -> [Token]
unPattern Pattern
p) Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isExtSeparator (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Char
forall a. [a] -> a
head String
path)
             p' :: Pattern
p' = [Token] -> Pattern
Pattern (Pattern -> [Token]
unPattern Pattern
p [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token
AnyNonPathSeparator])

         case Bool
unconditionalMatch Bool -> Bool -> Bool
|| MatchOptions -> Pattern -> String -> Bool
matchWith (GlobOptions -> MatchOptions
matchOptions GlobOptions
opts) Pattern
p' String
path of
              Bool
True | Bool
isDir -> do
                 DList String
contents <- String -> IO (DList String)
getRecursiveContents String
absPath
                 (DList String, DList String) -> IO (DList String, DList String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((DList String, DList String) -> IO (DList String, DList String))
-> (DList String, DList String) -> IO (DList String, DList String)
forall a b. (a -> b) -> a -> b
$
                    -- foo**/ should match foo/ and nothing below it

                    -- relies on head contents == absPath

                    if [TypedPattern] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypedPattern]
ps
                       then ( String -> DList String
forall a. a -> DList a
DL.singleton (String -> DList String) -> String -> DList String
forall a b. (a -> b) -> a -> b
$
                                DList String -> String
forall a. DList a -> a
DL.head DList String
contents
                                String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
pathSeparator
                            , DList String -> DList String
forall a. DList a -> DList a
tailDL DList String
contents
                            )
                       else let (DList (Bool, String)
matches, DList (Bool, String)
nonMatches) =
                                   ((Bool, String) -> Bool)
-> DList (Bool, String)
-> (DList (Bool, String), DList (Bool, String))
forall a. (a -> Bool) -> DList a -> (DList a, DList a)
partitionDL (Bool, String) -> Bool
forall a b. (a, b) -> a
fst
                                      ((String -> (Bool, String)) -> DList String -> DList (Bool, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> (String -> Bool) -> String -> (Bool, String)
recursiveMatch Int
n String -> Bool
m) DList String
contents)
                             in (((Bool, String) -> String) -> DList (Bool, String) -> DList String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool, String) -> String
forall a b. (a, b) -> b
snd DList (Bool, String)
matches, ((Bool, String) -> String) -> DList (Bool, String) -> DList String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool, String) -> String
forall a b. (a, b) -> b
snd DList (Bool, String)
nonMatches)

              Bool
True | String -> Bool
m String
path ->
                 (DList String, DList String) -> IO (DList String, DList String)
forall (m :: * -> *) a. Monad m => a -> m a
return ( String -> DList String
forall a. a -> DList a
DL.singleton (String -> DList String) -> String -> DList String
forall a b. (a -> b) -> a -> b
$
                             ShowS
takeDirectory String
absPath
                             String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
pathSeparator
                             String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path
                        , DList String
forall a. DList a
DL.empty
                        )
              Bool
_ ->
                 GlobOptions
-> String -> String -> Bool -> IO (DList String, DList String)
didNotMatch GlobOptions
opts String
path String
absPath Bool
isDir

matchTypedAndGo GlobOptions
_ [TypedPattern]
_ String
_ String
_ = String -> IO (DList String, DList String)
forall a. HasCallStack => String -> a
error String
"Glob.matchTypedAndGo :: internal error"

-- To be called to check whether a filepath matches the part of a pattern

-- following an **/ (AnyDirectory) token and reconstruct the filepath with the

-- correct number of slashes. Arguments are:

--

-- * Int: number of slashes in the AnyDirectory token, i.e. 1 for **/, 2 for

--   **//, and so on

--

-- * FilePath -> Bool: matching function for the remainder of the pattern, to

--   determine whether the rest of the filepath following the AnyDirectory token

--   matches

--

-- * FilePath: the (entire) filepath to be checked: some file which is in a

--   subdirectory of a directory which matches the prefix of the pattern up to

--   the AnyDirectory token.

--

-- The returned tuple contains both the result, where True means the filepath

-- matches and should be included in the resulting list of matching files, and

-- False otherwise. We also include the filepath in the returned tuple, because

-- this function also takes care of including the correct number of slashes

-- in the result. For example, with a pattern **//foo/bar.txt, this function

-- would ensure that, if dir/foo/bar.txt exists, it would be returned as

-- dir//foo/bar.txt.

recursiveMatch :: Int -> (FilePath -> Bool) -> FilePath -> (Bool, FilePath)
recursiveMatch :: Int -> (String -> Bool) -> String -> (Bool, String)
recursiveMatch Int
n String -> Bool
isMatch String
path =
   case (String -> Bool) -> [String] -> Maybe String
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find String -> Bool
isMatch (String -> [String]
pathParts String
path) of
        Just String
matchedSuffix ->
           let dir :: String
dir = Int -> ShowS
forall a. Int -> [a] -> [a]
take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
path Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
matchedSuffix) String
path
            in ( Bool
True
               , String
dir
                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Char
pathSeparator
                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
matchedSuffix
               )
        Maybe String
Nothing ->
           (Bool
False, String
path)

-- To be called when a pattern didn't match a path: given the path and whether

-- it was a directory, return all paths which didn't match (i.e. for a file,

-- just the file, and for a directory, everything inside it).

didNotMatch :: GlobOptions -> FilePath -> FilePath -> Bool
            -> IO (DList FilePath, DList FilePath)
didNotMatch :: GlobOptions
-> String -> String -> Bool -> IO (DList String, DList String)
didNotMatch GlobOptions
opts String
path String
absPath Bool
isDir =
   if GlobOptions -> Bool
includeUnmatched GlobOptions
opts
      then (DList String -> (DList String, DList String))
-> IO (DList String) -> IO (DList String, DList String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) DList String
forall a. DList a
DL.empty) (IO (DList String) -> IO (DList String, DList String))
-> IO (DList String) -> IO (DList String, DList String)
forall a b. (a -> b) -> a -> b
$
         if Bool
isDir
            then if String
path String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".",String
".."]
                    then DList String -> IO (DList String)
forall (m :: * -> *) a. Monad m => a -> m a
return DList String
forall a. DList a
DL.empty
                    else String -> IO (DList String)
getRecursiveContents String
absPath
            else DList String -> IO (DList String)
forall (m :: * -> *) a. Monad m => a -> m a
return(DList String -> IO (DList String))
-> DList String -> IO (DList String)
forall a b. (a -> b) -> a -> b
$ String -> DList String
forall a. a -> DList a
DL.singleton String
absPath
      else
         (DList String, DList String) -> IO (DList String, DList String)
forall (m :: * -> *) a. Monad m => a -> m a
return (DList String
forall a. DList a
DL.empty, DList String
forall a. DList a
DL.empty)

separate :: Pattern -> [TypedPattern]
separate :: Pattern -> [TypedPattern]
separate = DList Token -> [Token] -> [TypedPattern]
go DList Token
forall a. DList a
DL.empty ([Token] -> [TypedPattern])
-> (Pattern -> [Token]) -> Pattern -> [TypedPattern]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> [Token]
unPattern
 where
   go :: DList Token -> [Token] -> [TypedPattern]
go DList Token
gr [] | [Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DList Token -> [Token]
forall a. DList a -> [a]
DL.toList DList Token
gr) = []
   go DList Token
gr []                       = [Pattern -> TypedPattern
Any (DList Token -> Pattern
pat DList Token
gr)]
   go DList Token
gr (Token
PathSeparator:[Token]
ps)       = DList Token
-> (Int -> Pattern -> TypedPattern) -> [Token] -> [TypedPattern]
slash DList Token
gr Int -> Pattern -> TypedPattern
Dir [Token]
ps
   go DList Token
gr ( Token
AnyDirectory:[Token]
ps)       = DList Token
-> (Int -> Pattern -> TypedPattern) -> [Token] -> [TypedPattern]
slash DList Token
gr Int -> Pattern -> TypedPattern
AnyDir [Token]
ps
   go DList Token
gr (            Token
p:[Token]
ps)       = DList Token -> [Token] -> [TypedPattern]
go (DList Token
gr DList Token -> Token -> DList Token
forall a. DList a -> a -> DList a
`DL.snoc` Token
p) [Token]
ps

   pat :: DList Token -> Pattern
pat = [Token] -> Pattern
Pattern ([Token] -> Pattern)
-> (DList Token -> [Token]) -> DList Token -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList Token -> [Token]
forall a. DList a -> [a]
DL.toList

   slash :: DList Token
-> (Int -> Pattern -> TypedPattern) -> [Token] -> [TypedPattern]
slash DList Token
gr Int -> Pattern -> TypedPattern
f [Token]
ps = let (Int
n,[Token]
ps') = ([Token] -> Int) -> ([Token], [Token]) -> (Int, [Token])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [Token] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (([Token], [Token]) -> (Int, [Token]))
-> ([Token] -> ([Token], [Token])) -> [Token] -> (Int, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token -> Bool) -> [Token] -> ([Token], [Token])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Token -> Bool
isSlash ([Token] -> (Int, [Token])) -> [Token] -> (Int, [Token])
forall a b. (a -> b) -> a -> b
$ [Token]
ps
                    in Int -> Pattern -> TypedPattern
f (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (DList Token -> Pattern
pat DList Token
gr) TypedPattern -> [TypedPattern] -> [TypedPattern]
forall a. a -> [a] -> [a]
: DList Token -> [Token] -> [TypedPattern]
go DList Token
forall a. DList a
DL.empty [Token]
ps'

   isSlash :: Token -> Bool
isSlash Token
PathSeparator = Bool
True
   isSlash Token
_             = Bool
False

unseparate :: [TypedPattern] -> Pattern
unseparate :: [TypedPattern] -> Pattern
unseparate = [Token] -> Pattern
Pattern ([Token] -> Pattern)
-> ([TypedPattern] -> [Token]) -> [TypedPattern] -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypedPattern -> [Token] -> [Token])
-> [Token] -> [TypedPattern] -> [Token]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TypedPattern -> [Token] -> [Token]
f []
 where
   f :: TypedPattern -> [Token] -> [Token]
f (AnyDir Int
n Pattern
p) [Token]
ts = Pattern -> [Token]
u Pattern
p [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ Token
AnyDirectory Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Int -> Token -> [Token]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Token
PathSeparator [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token]
ts
   f (   Dir Int
n Pattern
p) [Token]
ts = Pattern -> [Token]
u Pattern
p [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ Int -> Token -> [Token]
forall a. Int -> a -> [a]
replicate Int
n Token
PathSeparator [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token]
ts
   f (Any      Pattern
p) [Token]
ts = Pattern -> [Token]
u Pattern
p [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token]
ts

   u :: Pattern -> [Token]
u = Pattern -> [Token]
unPattern

-- Note that we consider "/foo" to specify a drive on Windows, even though it's

-- relative to the current drive.

--

-- Returns the [TypedPattern] of the Pattern (with the drive dropped if

-- appropriate) and, if the Pattern specified a drive, a Maybe representing the

-- drive to use. If it's a Just "", use the drive of the current working

-- directory.

driveSplit :: Pattern -> (Pattern, Maybe FilePath)
driveSplit :: Pattern -> (Pattern, Maybe String)
driveSplit = (String, [Token]) -> (Pattern, Maybe String)
check ((String, [Token]) -> (Pattern, Maybe String))
-> (Pattern -> (String, [Token]))
-> Pattern
-> (Pattern, Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Token] -> (String, [Token])
split ([Token] -> (String, [Token]))
-> (Pattern -> [Token]) -> Pattern -> (String, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> [Token]
unPattern
 where
   -- We can't just use something like commonDirectory because of Windows

   -- drives being possibly longer than one "directory", like "//?/foo/bar/".

   -- So just take as much as possible.

   split :: [Token] -> (String, [Token])
split (LongLiteral Int
_ String
l : [Token]
xs) = ShowS -> (String, [Token]) -> (String, [Token])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (String
lString -> ShowS
forall a. [a] -> [a] -> [a]
++) ([Token] -> (String, [Token])
split [Token]
xs)
   split (    Literal   Char
l : [Token]
xs) = ShowS -> (String, [Token]) -> (String, [Token])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Char
lChar -> ShowS
forall a. a -> [a] -> [a]
:) ([Token] -> (String, [Token])
split [Token]
xs)
   split (Token
PathSeparator   : [Token]
xs) = ShowS -> (String, [Token]) -> (String, [Token])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Char
pathSeparatorChar -> ShowS
forall a. a -> [a] -> [a]
:) ([Token] -> (String, [Token])
split [Token]
xs)
   split [Token]
xs                     = ([],[Token]
xs)

   -- The isPathSeparator check is interesting in two ways:

   --

   -- 1. It's correct to return simply Just "" because there can't be more than

   --    one path separator if splitDrive gave a null drive: "//x" is a shared

   --    "drive" in Windows and starts with the root "drive" in Posix.

   --

   -- 2. The 'head' is safe because we have not (null d) && null drive.

   check :: (String, [Token]) -> (Pattern, Maybe String)
check (String
d,[Token]
ps)
      | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
d                      = ([Token] -> Pattern
Pattern     [Token]
ps, Maybe String
forall a. Maybe a
Nothing)
      | Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
drive)            = (String -> [Token] -> Pattern
forall (t :: * -> *). Foldable t => t Char -> [Token] -> Pattern
dirify String
rest [Token]
ps, String -> Maybe String
forall a. a -> Maybe a
Just String
drive)
      | Char -> Bool
isPathSeparator (String -> Char
forall a. [a] -> a
head String
rest) = ([Token] -> Pattern
Pattern     [Token]
ps, String -> Maybe String
forall a. a -> Maybe a
Just String
"")
      | Bool
otherwise                   = (String -> [Token] -> Pattern
forall (t :: * -> *). Foldable t => t Char -> [Token] -> Pattern
dirify String
d    [Token]
ps, Maybe String
forall a. Maybe a
Nothing)
    where
      (String
drive, String
rest) = String -> (String, String)
splitDrive String
d

   dirify :: t Char -> [Token] -> Pattern
dirify t Char
path = [Token] -> Pattern
Pattern ([Token] -> Pattern) -> ([Token] -> [Token]) -> [Token] -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t Char -> [Token]
forall (t :: * -> *). Foldable t => t Char -> [Token]
comp t Char
path[Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++)

   comp :: t Char -> [Token]
comp t Char
s = let ([Token]
p,String
l) = (Char -> ([Token], String) -> ([Token], String))
-> ([Token], String) -> t Char -> ([Token], String)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> ([Token], String) -> ([Token], String)
f ([],[]) t Char
s in if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
l then [Token]
p else String -> [Token] -> [Token]
ll String
l [Token]
p
    where
      f :: Char -> ([Token], String) -> ([Token], String)
f Char
c ([Token]
p,String
l) | Char -> Bool
isExtSeparator  Char
c = (Char -> Token
Literal Char
'.'   Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token] -> [Token]
ll String
l [Token]
p, [])
                | Char -> Bool
isPathSeparator Char
c = (Token
PathSeparator Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token] -> [Token]
ll String
l [Token]
p, [])
                | Bool
otherwise         = ([Token]
p, Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
l)

      ll :: String -> [Token] -> [Token]
ll String
l [Token]
p = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
l then [Token]
p else Int -> String -> Token
LongLiteral (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
l) String
l Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
p

-- |Factors out the directory component of a 'Pattern'. Useful in conjunction

-- with 'globDir'.

--

-- Preserves the number of path separators: @commonDirectory (compile

-- \"foo\/\/\/bar\")@ becomes @(\"foo\/\/\/\", compile \"bar\")@.

commonDirectory :: Pattern -> (FilePath, Pattern)
commonDirectory :: Pattern -> (String, Pattern)
commonDirectory = ([TypedPattern] -> Pattern)
-> (String, [TypedPattern]) -> (String, Pattern)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [TypedPattern] -> Pattern
unseparate ((String, [TypedPattern]) -> (String, Pattern))
-> (Pattern -> (String, [TypedPattern]))
-> Pattern
-> (String, Pattern)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TypedPattern] -> (String, [TypedPattern])
splitP ([TypedPattern] -> (String, [TypedPattern]))
-> (Pattern -> [TypedPattern])
-> Pattern
-> (String, [TypedPattern])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> [TypedPattern]
separate
 where
   splitP :: [TypedPattern] -> (String, [TypedPattern])
splitP pt :: [TypedPattern]
pt@(Dir Int
n Pattern
p:[TypedPattern]
ps) =
      case DList Char -> [Token] -> Maybe String
fromConst DList Char
forall a. DList a
DL.empty (Pattern -> [Token]
unPattern Pattern
p) of
           Just String
d  -> ShowS -> (String, [TypedPattern]) -> (String, [TypedPattern])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((String
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
pathSeparator) String -> ShowS
</>) ([TypedPattern] -> (String, [TypedPattern])
splitP [TypedPattern]
ps)
           Maybe String
Nothing -> (String
"", [TypedPattern]
pt)

   splitP [TypedPattern]
pt = (String
"", [TypedPattern]
pt)

   fromConst :: DList Char -> [Token] -> Maybe String
fromConst DList Char
d []                   = String -> Maybe String
forall a. a -> Maybe a
Just (DList Char -> String
forall a. DList a -> [a]
DL.toList DList Char
d)
   fromConst DList Char
d (Literal Char
c      :[Token]
xs) = DList Char -> [Token] -> Maybe String
fromConst (DList Char
d DList Char -> Char -> DList Char
forall a. DList a -> a -> DList a
`DL.snoc` Char
c) [Token]
xs
   fromConst DList Char
d (LongLiteral Int
_ String
s:[Token]
xs) = DList Char -> [Token] -> Maybe String
fromConst (DList Char
d DList Char -> DList Char -> DList Char
forall a. DList a -> DList a -> DList a
`DL.append`String -> DList Char
forall a. [a] -> DList a
DL.fromList String
s) [Token]
xs
   fromConst DList Char
_ [Token]
_                    = Maybe String
forall a. Maybe a
Nothing