-- 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 -> FilePath
(Int -> TypedPattern -> ShowS)
-> (TypedPattern -> FilePath)
-> ([TypedPattern] -> ShowS)
-> Show TypedPattern
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypedPattern -> ShowS
showsPrec :: Int -> TypedPattern -> ShowS
$cshow :: TypedPattern -> FilePath
show :: TypedPattern -> FilePath
$cshowList :: [TypedPattern] -> ShowS
showList :: [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] -> FilePath -> IO [[FilePath]]
globDir [Pattern]
pats FilePath
dir = (([[FilePath]], Maybe [FilePath]) -> [[FilePath]])
-> IO ([[FilePath]], Maybe [FilePath]) -> IO [[FilePath]]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([[FilePath]], Maybe [FilePath]) -> [[FilePath]]
forall a b. (a, b) -> a
fst (GlobOptions
-> [Pattern] -> FilePath -> IO ([[FilePath]], Maybe [FilePath])
globDirWith GlobOptions
globDefault [Pattern]
pats FilePath
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] -> FilePath -> IO ([[FilePath]], Maybe [FilePath])
globDirWith GlobOptions
opts [Pattern
pat] FilePath
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 (FilePath
prefix, Pattern
pat') = Pattern -> (FilePath, Pattern)
commonDirectory Pattern
pat
    in GlobOptions
-> [Pattern] -> FilePath -> IO ([[FilePath]], Maybe [FilePath])
globDirWith' GlobOptions
opts [Pattern
pat'] (FilePath
dir FilePath -> ShowS
</> FilePath
prefix)

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

-- See 'globDirWith'.

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

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

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

   ([[FilePath]], Maybe [FilePath])
-> IO ([[FilePath]], Maybe [FilePath])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ( (DList FilePath -> [FilePath]) -> [DList FilePath] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map DList FilePath -> [FilePath]
forall a. DList a -> [a]
DL.toList [DList FilePath]
matches
          , if GlobOptions -> Bool
includeUnmatched GlobOptions
opts
               then [FilePath] -> Maybe [FilePath]
forall a. a -> Maybe a
Just ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd [FilePath]
allOthers [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
allMatches)
               else Maybe [FilePath]
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 -> FilePath -> IO [FilePath]
globDir1 Pattern
p = ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall a. HasCallStack => [a] -> a
head (IO [[FilePath]] -> IO [FilePath])
-> (FilePath -> IO [[FilePath]]) -> FilePath -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern] -> FilePath -> IO [[FilePath]]
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 :: FilePath -> IO [FilePath]
glob = (Pattern -> FilePath -> IO [FilePath])
-> FilePath -> Pattern -> IO [FilePath]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Pattern -> FilePath -> IO [FilePath]
globDir1 FilePath
"" (Pattern -> IO [FilePath])
-> (FilePath -> Pattern) -> FilePath -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Pattern
compile

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

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

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

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

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

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

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

   (DList FilePath, DList FilePath)
-> IO (DList FilePath, DList FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> DList FilePath
forall a. a -> DList a
DL.singleton (FilePath
dir FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
pathSeparator]), DList FilePath
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]
-> FilePath
-> FilePath
-> IO (DList FilePath, DList FilePath)
matchTypedAndGo GlobOptions
opts [Any Pattern
p] FilePath
path FilePath
absPath =
   if MatchOptions -> Pattern -> FilePath -> Bool
matchWith (GlobOptions -> MatchOptions
matchOptions GlobOptions
opts) Pattern
p FilePath
path
      then (DList FilePath, DList FilePath)
-> IO (DList FilePath, DList FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> DList FilePath
forall a. a -> DList a
DL.singleton FilePath
absPath, DList FilePath
forall a. DList a
DL.empty)
      else FilePath -> IO Bool
doesDirectoryExist FilePath
absPath IO Bool
-> (Bool -> IO (DList FilePath, DList FilePath))
-> IO (DList FilePath, DList FilePath)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GlobOptions
-> FilePath
-> FilePath
-> Bool
-> IO (DList FilePath, DList FilePath)
didNotMatch GlobOptions
opts FilePath
path FilePath
absPath

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

matchTypedAndGo GlobOptions
opts (AnyDir Int
n Pattern
p:[TypedPattern]
ps) FilePath
path FilePath
absPath =
   if FilePath
path FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
".",FilePath
".."]
      then GlobOptions
-> FilePath
-> FilePath
-> Bool
-> IO (DList FilePath, DList FilePath)
didNotMatch GlobOptions
opts FilePath
path FilePath
absPath Bool
True
      else do
         Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
absPath
         let m :: FilePath -> Bool
m = MatchOptions -> Pattern -> FilePath -> Bool
matchWith (GlobOptions -> MatchOptions
matchOptions GlobOptions
opts) ([TypedPattern] -> Pattern
unseparate [TypedPattern]
ps)
             unconditionalMatch :: Bool
unconditionalMatch =
                [Token] -> Bool
forall a. [a] -> 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
$ FilePath -> Char
forall a. HasCallStack => [a] -> a
head FilePath
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 -> FilePath -> Bool
matchWith (GlobOptions -> MatchOptions
matchOptions GlobOptions
opts) Pattern
p' FilePath
path of
              Bool
True | Bool
isDir -> do
                 DList FilePath
contents <- FilePath -> IO (DList FilePath)
getRecursiveContents FilePath
absPath
                 (DList FilePath, DList FilePath)
-> IO (DList FilePath, DList FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((DList FilePath, DList FilePath)
 -> IO (DList FilePath, DList FilePath))
-> (DList FilePath, DList FilePath)
-> IO (DList FilePath, DList FilePath)
forall a b. (a -> b) -> a -> b
$
                    -- foo**/ should match foo/ and nothing below it

                    -- relies on head contents == absPath

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

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

matchTypedAndGo GlobOptions
_ [TypedPattern]
_ FilePath
_ FilePath
_ = FilePath -> IO (DList FilePath, DList FilePath)
forall a. HasCallStack => FilePath -> a
error FilePath
"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 -> (FilePath -> Bool) -> FilePath -> (Bool, FilePath)
recursiveMatch Int
n FilePath -> Bool
isMatch FilePath
path =
   case (FilePath -> Bool) -> [FilePath] -> Maybe FilePath
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find FilePath -> Bool
isMatch (FilePath -> [FilePath]
pathParts FilePath
path) of
        Just FilePath
matchedSuffix ->
           let dir :: FilePath
dir = Int -> ShowS
forall a. Int -> [a] -> [a]
take (FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
path Int -> Int -> Int
forall a. Num a => a -> a -> a
- FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
matchedSuffix) FilePath
path
            in ( Bool
True
               , FilePath
dir
                 FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Char
pathSeparator
                 FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
matchedSuffix
               )
        Maybe FilePath
Nothing ->
           (Bool
False, FilePath
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
-> FilePath
-> FilePath
-> Bool
-> IO (DList FilePath, DList FilePath)
didNotMatch GlobOptions
opts FilePath
path FilePath
absPath Bool
isDir =
   if GlobOptions -> Bool
includeUnmatched GlobOptions
opts
      then (DList FilePath -> (DList FilePath, DList FilePath))
-> IO (DList FilePath) -> IO (DList FilePath, DList FilePath)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) DList FilePath
forall a. DList a
DL.empty) (IO (DList FilePath) -> IO (DList FilePath, DList FilePath))
-> IO (DList FilePath) -> IO (DList FilePath, DList FilePath)
forall a b. (a -> b) -> a -> b
$
         if Bool
isDir
            then if FilePath
path FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
".",FilePath
".."]
                    then DList FilePath -> IO (DList FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DList FilePath
forall a. DList a
DL.empty
                    else FilePath -> IO (DList FilePath)
getRecursiveContents FilePath
absPath
            else DList FilePath -> IO (DList FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(DList FilePath -> IO (DList FilePath))
-> DList FilePath -> IO (DList FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> DList FilePath
forall a. a -> DList a
DL.singleton FilePath
absPath
      else
         (DList FilePath, DList FilePath)
-> IO (DList FilePath, DList FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DList FilePath
forall a. DList a
DL.empty, DList FilePath
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 a. [a] -> 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 b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [Token] -> Int
forall a. [a] -> 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 a b. (a -> b -> b) -> b -> [a] -> b
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 FilePath)
driveSplit = (FilePath, [Token]) -> (Pattern, Maybe FilePath)
check ((FilePath, [Token]) -> (Pattern, Maybe FilePath))
-> (Pattern -> (FilePath, [Token]))
-> Pattern
-> (Pattern, Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Token] -> (FilePath, [Token])
split ([Token] -> (FilePath, [Token]))
-> (Pattern -> [Token]) -> Pattern -> (FilePath, [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] -> (FilePath, [Token])
split (LongLiteral Int
_ FilePath
l : [Token]
xs) = ShowS -> (FilePath, [Token]) -> (FilePath, [Token])
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (FilePath
lFilePath -> ShowS
forall a. [a] -> [a] -> [a]
++) ([Token] -> (FilePath, [Token])
split [Token]
xs)
   split (    Literal   Char
l : [Token]
xs) = ShowS -> (FilePath, [Token]) -> (FilePath, [Token])
forall b c d. (b -> c) -> (b, d) -> (c, d)
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] -> (FilePath, [Token])
split [Token]
xs)
   split (Token
PathSeparator   : [Token]
xs) = ShowS -> (FilePath, [Token]) -> (FilePath, [Token])
forall b c d. (b -> c) -> (b, d) -> (c, d)
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] -> (FilePath, [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 :: (FilePath, [Token]) -> (Pattern, Maybe FilePath)
check (FilePath
d,[Token]
ps)
      | FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
d                      = ([Token] -> Pattern
Pattern     [Token]
ps, Maybe FilePath
forall a. Maybe a
Nothing)
      | Bool -> Bool
not (FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
drive)            = (FilePath -> [Token] -> Pattern
forall {t :: * -> *}. Foldable t => t Char -> [Token] -> Pattern
dirify FilePath
rest [Token]
ps, FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
drive)
      | Char -> Bool
isPathSeparator (FilePath -> Char
forall a. HasCallStack => [a] -> a
head FilePath
rest) = ([Token] -> Pattern
Pattern     [Token]
ps, FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"")
      | Bool
otherwise                   = (FilePath -> [Token] -> Pattern
forall {t :: * -> *}. Foldable t => t Char -> [Token] -> Pattern
dirify FilePath
d    [Token]
ps, Maybe FilePath
forall a. Maybe a
Nothing)
    where
      (FilePath
drive, FilePath
rest) = FilePath -> (FilePath, FilePath)
splitDrive FilePath
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,FilePath
l) = (Char -> ([Token], FilePath) -> ([Token], FilePath))
-> ([Token], FilePath) -> t Char -> ([Token], FilePath)
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> ([Token], FilePath) -> ([Token], FilePath)
f ([],[]) t Char
s in if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
l then [Token]
p else FilePath -> [Token] -> [Token]
ll FilePath
l [Token]
p
    where
      f :: Char -> ([Token], FilePath) -> ([Token], FilePath)
f Char
c ([Token]
p,FilePath
l) | Char -> Bool
isExtSeparator  Char
c = (Char -> Token
Literal Char
'.'   Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: FilePath -> [Token] -> [Token]
ll FilePath
l [Token]
p, [])
                | Char -> Bool
isPathSeparator Char
c = (Token
PathSeparator Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: FilePath -> [Token] -> [Token]
ll FilePath
l [Token]
p, [])
                | Bool
otherwise         = ([Token]
p, Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:FilePath
l)

      ll :: FilePath -> [Token] -> [Token]
ll FilePath
l [Token]
p = if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
l then [Token]
p else Int -> FilePath -> Token
LongLiteral (FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
l) FilePath
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 -> (FilePath, Pattern)
commonDirectory = ([TypedPattern] -> Pattern)
-> (FilePath, [TypedPattern]) -> (FilePath, Pattern)
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 [TypedPattern] -> Pattern
unseparate ((FilePath, [TypedPattern]) -> (FilePath, Pattern))
-> (Pattern -> (FilePath, [TypedPattern]))
-> Pattern
-> (FilePath, Pattern)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TypedPattern] -> (FilePath, [TypedPattern])
splitP ([TypedPattern] -> (FilePath, [TypedPattern]))
-> (Pattern -> [TypedPattern])
-> Pattern
-> (FilePath, [TypedPattern])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> [TypedPattern]
separate
 where
   splitP :: [TypedPattern] -> (FilePath, [TypedPattern])
splitP pt :: [TypedPattern]
pt@(Dir Int
n Pattern
p:[TypedPattern]
ps) =
      case DList Char -> [Token] -> Maybe FilePath
fromConst DList Char
forall a. DList a
DL.empty (Pattern -> [Token]
unPattern Pattern
p) of
           Just FilePath
d  -> ShowS -> (FilePath, [TypedPattern]) -> (FilePath, [TypedPattern])
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((FilePath
d FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate Int
n Char
pathSeparator) FilePath -> ShowS
</>) ([TypedPattern] -> (FilePath, [TypedPattern])
splitP [TypedPattern]
ps)
           Maybe FilePath
Nothing -> (FilePath
"", [TypedPattern]
pt)

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

   fromConst :: DList Char -> [Token] -> Maybe FilePath
fromConst DList Char
d []                   = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (DList Char -> FilePath
forall a. DList a -> [a]
DL.toList DList Char
d)
   fromConst DList Char
d (Literal Char
c      :[Token]
xs) = DList Char -> [Token] -> Maybe FilePath
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
_ FilePath
s:[Token]
xs) = DList Char -> [Token] -> Maybe FilePath
fromConst (DList Char
d DList Char -> DList Char -> DList Char
forall a. DList a -> DList a -> DList a
`DL.append`FilePath -> DList Char
forall a. [a] -> DList a
DL.fromList FilePath
s) [Token]
xs
   fromConst DList Char
_ [Token]
_                    = Maybe FilePath
forall a. Maybe a
Nothing