1{-# LANGUAGE Safe #-}
2
3{-
4Copyright (c) 2006-2011 John Goerzen <jgoerzen@complete.org>
5
6All rights reserved.
7
8For license and copyright information, see the file LICENSE
9-}
10
11{- |
12   Module     : System.Path.Glob
13   Copyright  : Copyright (C) 2006-2011 John Goerzen
14   SPDX-License-Identifier: BSD-3-Clause
15
16   Stability  : provisional
17   Portability: portable
18
19Functions for expanding wildcards, filenames, and pathnames.
20
21For information on the metacharacters recognized, please see the notes
22in "System.Path.WildMatch".
23
24-}
25
26module System.Path.Glob (glob, vGlob)
27    where
28import           Control.Exception     (tryJust)
29import           Data.List             (isSuffixOf)
30import           Data.List.Utils       (hasAny)
31import           System.FilePath       (isPathSeparator, pathSeparator,
32                                        splitFileName, (</>))
33import           System.IO.HVFS
34import           System.Path.WildMatch (wildCheckCase)
35
36hasWild :: String -> Bool
37hasWild = hasAny "*?["
38
39{- | Takes a pattern.  Returns a list of names that match that pattern.
40The pattern is evaluated by "System.Path.WildMatch".  This function
41does not perform tilde or environment variable expansion.
42
43Filenames that begin with a dot are not included in the result set unless
44that component of the pattern also begins with a dot.
45
46In MissingH, this function is defined as:
47
48>glob = vGlob SystemFS
49-}
50glob :: FilePath -> IO [FilePath]
51glob = vGlob SystemFS
52
53{- | Like 'glob', but works on both the system ("real") and HVFS virtual
54filesystems. -}
55vGlob :: HVFS a => a -> FilePath -> IO [FilePath]
56vGlob fs fn =
57    if not (hasWild fn)           -- Don't try globbing if there are no wilds
58       then do de <- vDoesExist fs fn
59               if de
60                  then return [fn]
61                  else return []
62       else expandGlob fs fn -- It's there
63
64expandGlob :: HVFS a => a -> FilePath -> IO [FilePath]
65expandGlob fs fn
66    | dirnameslash == '.':pathSeparator:[] = runGlob fs "." basename
67    | dirnameslash == [pathSeparator] = do
68                        rgs <- runGlob fs [pathSeparator] basename
69                        return $ map (pathSeparator :) rgs
70    | otherwise = do dirlist <- if hasWild dirname
71                                  then expandGlob fs dirname
72                                  else return [dirname]
73                     if hasWild basename
74                       then concat `fmap` mapM expandWildBase dirlist
75                       else concat `fmap` mapM expandNormalBase dirlist
76
77    where (dirnameslash, basename) = splitFileName fn
78          dirname = if dirnameslash == [pathSeparator]
79                      then [pathSeparator]
80                      else if isSuffixOf [pathSeparator] dirnameslash
81                              then init dirnameslash
82                              else dirnameslash
83
84          expandWildBase :: FilePath -> IO [FilePath]
85          expandWildBase dname =
86              do dirglobs <- runGlob fs dname basename
87                 return $ map withD dirglobs
88                 where withD = case dname of
89                                 ""  -> id
90                                 _   -> \globfn -> dname ++ [pathSeparator] ++ globfn
91
92          expandNormalBase :: FilePath -> IO [FilePath]
93          expandNormalBase dname =
94              do isdir <- vDoesDirectoryExist fs dname
95                 let newname = dname </> basename
96                 isexists <- vDoesExist fs newname
97                 if isexists && ((basename /= "." && basename /= "") || isdir)
98                    then return [dname </> basename]
99                    else return []
100
101runGlob :: HVFS a => a -> FilePath -> FilePath -> IO [FilePath]
102runGlob fs "" patt = runGlob fs "." patt
103runGlob fs dirname patt =
104    do r <- tryJust ioErrors (vGetDirectoryContents fs dirname)
105       case r of
106         Left _ -> return []
107         Right names -> let matches = filter (wildCheckCase patt) $ names
108                        in if head patt == '.'
109                           then return matches
110                           else return $ filter (\x -> head x /= '.') matches
111    where ioErrors :: IOError -> Maybe IOError
112          ioErrors e = Just e
113