{-
Copyright (c) 2006-2011 John Goerzen <jgoerzen@complete.org>

All rights reserved.

For license and copyright information, see the file LICENSE
-}

{- |
   Module     : System.Path.Glob
   Copyright  : Copyright (C) 2006-2011 John Goerzen
   SPDX-License-Identifier: BSD-3-Clause

   Stability  : stable
   Portability: portable

Functions for expanding wildcards, filenames, and pathnames.

For information on the metacharacters recognized, please see the notes
in "System.Path.WildMatch".

-}

module System.Path.Glob (glob, vGlob)
    where

import           Control.Exception     (tryJust)
import           Data.List             (isSuffixOf)
import           Data.List.Utils       (hasAny)
import           System.FilePath       (pathSeparator, splitFileName, (</>))
import           System.IO.HVFS        (HVFS (vDoesDirectoryExist, vDoesExist, vGetDirectoryContents),
                                         SystemFS (SystemFS))
import           System.Path.WildMatch (wildCheckCase)

hasWild :: String -> Bool
hasWild :: String -> Bool
hasWild = String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
hasAny String
"*?["

{- | Takes a pattern.  Returns a list of names that match that pattern.
The pattern is evaluated by "System.Path.WildMatch".  This function
does not perform tilde or environment variable expansion.

Filenames that begin with a dot are not included in the result set unless
that component of the pattern also begins with a dot.

In MissingH, this function is defined as:

>glob = vGlob SystemFS
-}
glob :: FilePath -> IO [FilePath]
glob :: String -> IO [String]
glob = SystemFS -> String -> IO [String]
forall a. HVFS a => a -> String -> IO [String]
vGlob SystemFS
SystemFS

{- | Like 'glob', but works on both the system ("real") and HVFS virtual
filesystems. -}
vGlob :: HVFS a => a -> FilePath -> IO [FilePath]
vGlob :: forall a. HVFS a => a -> String -> IO [String]
vGlob a
fs String
fn =
    if Bool -> Bool
not (String -> Bool
hasWild String
fn)           -- Don't try globbing if there are no wilds
       then do Bool
de <- a -> String -> IO Bool
forall a. HVFS a => a -> String -> IO Bool
vDoesExist a
fs String
fn
               if Bool
de
                  then [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String
fn]
                  else [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
       else a -> String -> IO [String]
forall a. HVFS a => a -> String -> IO [String]
expandGlob a
fs String
fn -- It's there

expandGlob :: HVFS a => a -> FilePath -> IO [FilePath]
expandGlob :: forall a. HVFS a => a -> String -> IO [String]
expandGlob a
fs String
fn
    | String
dirnameslash String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
pathSeparatorChar -> String -> String
forall a. a -> [a] -> [a]
:[] = a -> String -> String -> IO [String]
forall a. HVFS a => a -> String -> String -> IO [String]
runGlob a
fs String
"." String
basename
    | String
dirnameslash String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [Char
pathSeparator] = do
                        [String]
rgs <- a -> String -> String -> IO [String]
forall a. HVFS a => a -> String -> String -> IO [String]
runGlob a
fs [Char
pathSeparator] String
basename
                        [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char
pathSeparator Char -> String -> String
forall a. a -> [a] -> [a]
:) [String]
rgs
    | Bool
otherwise = do [String]
dirlist <- if String -> Bool
hasWild String
dirname
                                  then a -> String -> IO [String]
forall a. HVFS a => a -> String -> IO [String]
expandGlob a
fs String
dirname
                                  else [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String
dirname]
                     if String -> Bool
hasWild String
basename
                       then [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (String -> IO [String]) -> [String] -> IO [[String]]
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 String -> IO [String]
expandWildBase [String]
dirlist
                       else [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (String -> IO [String]) -> [String] -> IO [[String]]
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 String -> IO [String]
expandNormalBase [String]
dirlist

    where (String
dirnameslash, String
basename) = String -> (String, String)
splitFileName String
fn
          dirname :: String
dirname = if String
dirnameslash String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [Char
pathSeparator]
                      then [Char
pathSeparator]
                      else if String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf [Char
pathSeparator] String
dirnameslash
                              then String -> String
forall a. HasCallStack => [a] -> [a]
init String
dirnameslash
                              else String
dirnameslash

          expandWildBase :: FilePath -> IO [FilePath]
          expandWildBase :: String -> IO [String]
expandWildBase String
dname =
              do [String]
dirglobs <- a -> String -> String -> IO [String]
forall a. HVFS a => a -> String -> String -> IO [String]
runGlob a
fs String
dname String
basename
                 [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
withD [String]
dirglobs
                 where withD :: String -> String
withD = case String
dname of
                                 String
""  -> String -> String
forall a. a -> a
id
                                 String
_   -> \String
globfn -> String
dname String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
pathSeparator] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
globfn

          expandNormalBase :: FilePath -> IO [FilePath]
          expandNormalBase :: String -> IO [String]
expandNormalBase String
dname =
              do Bool
isdir <- a -> String -> IO Bool
forall a. HVFS a => a -> String -> IO Bool
vDoesDirectoryExist a
fs String
dname
                 let newname :: String
newname = String
dname String -> String -> String
</> String
basename
                 Bool
isexists <- a -> String -> IO Bool
forall a. HVFS a => a -> String -> IO Bool
vDoesExist a
fs String
newname
                 if Bool
isexists Bool -> Bool -> Bool
&& ((String
basename String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"." Bool -> Bool -> Bool
&& String
basename String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"") Bool -> Bool -> Bool
|| Bool
isdir)
                    then [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String
dname String -> String -> String
</> String
basename]
                    else [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

runGlob :: HVFS a => a -> FilePath -> FilePath -> IO [FilePath]
runGlob :: forall a. HVFS a => a -> String -> String -> IO [String]
runGlob a
fs String
"" String
patt = a -> String -> String -> IO [String]
forall a. HVFS a => a -> String -> String -> IO [String]
runGlob a
fs String
"." String
patt
runGlob a
fs String
dirname String
patt =
    do Either IOError [String]
r <- (IOError -> Maybe IOError)
-> IO [String] -> IO (Either IOError [String])
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust IOError -> Maybe IOError
ioErrors (a -> String -> IO [String]
forall a. HVFS a => a -> String -> IO [String]
vGetDirectoryContents a
fs String
dirname)
       case Either IOError [String]
r of
         Left IOError
_ -> [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
         Right [String]
names -> let matches :: [String]
matches = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
wildCheckCase String
patt) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
names
                        in if String -> Char
forall a. HasCallStack => [a] -> a
head String
patt Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
                           then [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
matches
                           else [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
x -> String -> Char
forall a. HasCallStack => [a] -> a
head String
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') [String]
matches
    where ioErrors :: IOError -> Maybe IOError
          ioErrors :: IOError -> Maybe IOError
ioErrors IOError
e = IOError -> Maybe IOError
forall a. a -> Maybe a
Just IOError
e