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

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

-- See 'globDirWith'.

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

globDirWith' GlobOptions
opts pats :: [Pattern]
pats@(Pattern
_:[Pattern]
_) [Char]
dir = do
   results <- (Pattern -> IO (DList [Char], DList [Char]))
-> [Pattern] -> IO [(DList [Char], DList [Char])]
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 -> [Char] -> IO (DList [Char], DList [Char])
globDir'0 GlobOptions
opts Pattern
p [Char]
dir) [Pattern]
pats

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

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

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

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

   results <- forM entries $ \[Char]
e -> GlobOptions
-> [TypedPattern]
-> [Char]
-> [Char]
-> IO (DList [Char], DList [Char])
matchTypedAndGo GlobOptions
opts [TypedPattern]
pats [Char]
e ([Char]
dir [Char] -> ShowS
</> [Char]
e)

   let (matches, others) = unzip results

   return (DL.concat matches, DL.concat others)

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

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

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

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

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

         case unconditionalMatch || matchWith (matchOptions opts) p' path of
              Bool
True | Bool
isDir -> do
                 contents <- [Char] -> IO (DList [Char])
getRecursiveContents [Char]
absPath
                 return $
                    -- foo**/ should match foo/ and nothing below it

                    -- relies on head contents == absPath

                    if null ps
                       then ( DL.singleton $
                                DL.head contents
                                ++ replicate n pathSeparator
                            , tailDL contents
                            )
                       else let (matches, nonMatches) =
                                   partitionDL fst
                                      (fmap (recursiveMatch n m) contents)
                             in (fmap snd matches, fmap snd nonMatches)

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

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

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

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

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