    {-
    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