{-# LANGUAGE ScopedTypeVariables #-}
-- |
-- Module:      System.FilePath.Glob
-- Copyright:   Bryan O'Sullivan
-- License:     BSD3
-- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>
-- Stability:   unstable
-- Portability: everywhere

module System.FilePath.Glob (
      namesMatching
    ) where

import Control.Exception
import Control.Monad (forM)
import System.FilePath.GlobPattern ((~~))
import System.Directory (doesDirectoryExist, doesFileExist,
                         getCurrentDirectory, getDirectoryContents)
import System.FilePath (dropTrailingPathSeparator, splitFileName, (</>))
import System.IO.Unsafe (unsafeInterleaveIO)

-- | Return a list of names matching a glob pattern.  The list is
-- generated lazily.
namesMatching :: String -> IO [FilePath]
namesMatching :: String -> IO [String]
namesMatching String
pat
  | Bool -> Bool
not (String -> Bool
isPattern String
pat) = do
    exists <- String -> IO Bool
doesNameExist String
pat
    return (if exists then [pat] else [])
  | Bool
otherwise = do
    case String -> (String, String)
splitFileName String
pat of
      (String
"", String
baseName) -> do
          curDir <- IO String
getCurrentDirectory
          listMatches curDir baseName
      (String
dirName, String
baseName) -> do
          dirs <- if String -> Bool
isPattern String
dirName
                  then String -> IO [String]
namesMatching (String -> String
dropTrailingPathSeparator String
dirName)
                  else [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String
dirName]
          let listDir = if String -> Bool
isPattern String
baseName
                        then String -> String -> IO [String]
listMatches
                        else String -> String -> IO [String]
listPlain
          pathNames <- forM dirs $ \String
dir -> do
                           baseNames <- String -> String -> IO [String]
listDir String
dir String
baseName
                           return (map (dir </>) baseNames)
          return (concat pathNames)
  where isPattern :: String -> Bool
isPattern = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"[*?")

listMatches :: FilePath -> String -> IO [String]
listMatches :: String -> String -> IO [String]
listMatches String
dirName String
pat = do
    dirName' <- if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
dirName
                then IO String
getCurrentDirectory
                else String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
dirName
    names <- unsafeInterleaveIO (handle (\(IOException
_::IOException) -> [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []) $
                                        getDirectoryContents dirName')
    let names' = if String -> Bool
isHidden String
pat
                 then (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isHidden [String]
names
                 else (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isHidden) [String]
names
    return (filter (~~ pat) names')
  where isHidden :: String -> Bool
isHidden (Char
'.':String
_) = Bool
True
        isHidden String
_ = Bool
False

listPlain :: FilePath -> String -> IO [String]
listPlain :: String -> String -> IO [String]
listPlain String
dirName String
baseName = do
    exists <- if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
baseName
              then String -> IO Bool
doesDirectoryExist String
dirName
              else String -> IO Bool
doesNameExist (String
dirName String -> String -> String
</> String
baseName)
    return (if exists then [baseName] else [])

doesNameExist :: FilePath -> IO Bool
doesNameExist :: String -> IO Bool
doesNameExist String
name = do
    fileExists <- String -> IO Bool
doesFileExist String
name
    if fileExists
      then return True
      else doesDirectoryExist name