{-# LANGUAGE DeriveGeneric #-}

module Distribution.Client.Glob
  ( -- * cabal-install globbing features
    RootedGlob (..)
  , isTrivialRootedGlob
  , FilePathRoot (..)
  , getFilePathRootDirectory

    -- * Additional re-exports
  , module Distribution.Simple.Glob
  , Glob (..)
  , GlobPiece (..)
  , GlobPieces
  , matchFileGlob
  ) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.Simple.FileMonitor.Types
import Distribution.Simple.Glob
import Distribution.Simple.Glob.Internal
  ( Glob (..)
  , GlobPiece (..)
  , GlobPieces
  )

import System.Directory
import System.FilePath

--------------------------------------------------------------------------------

-- | Check if a 'RootedGlob' doesn't actually make use of any globbing and
-- is in fact equivalent to a non-glob 'FilePath'.
--
-- If it is trivial in this sense then the result is the equivalent constant
-- 'FilePath'. On the other hand, if it is not trivial (so could in principle
-- match more than one file), then the result is @Nothing@.
isTrivialRootedGlob :: RootedGlob -> Maybe FilePath
isTrivialRootedGlob :: RootedGlob -> Maybe FilePath
isTrivialRootedGlob (RootedGlob FilePathRoot
root Glob
pathglob) =
  case FilePathRoot
root of
    FilePathRoot
FilePathRelative -> [FilePath] -> Glob -> Maybe FilePath
go [] Glob
pathglob
    FilePathRoot FilePath
root' -> [FilePath] -> Glob -> Maybe FilePath
go [FilePath
root'] Glob
pathglob
    -- TODO: why don't we do the following?
    -- > go ["~"] pathglob
    FilePathRoot
FilePathHomeDir -> Maybe FilePath
forall a. Maybe a
Nothing
  where
    go :: [FilePath] -> Glob -> Maybe FilePath
go [FilePath]
paths (GlobDir [Literal FilePath
path] Glob
globs) = [FilePath] -> Glob -> Maybe FilePath
go (FilePath
path FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
paths) Glob
globs
    go [FilePath]
paths (GlobFile [Literal FilePath
path]) = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just ([FilePath] -> FilePath
joinPath ([FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse (FilePath
path FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
paths)))
    go [FilePath]
paths Glob
GlobDirTrailing =
      FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just
        ( FilePath -> FilePath
addTrailingPathSeparator
            ([FilePath] -> FilePath
joinPath ([FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
paths))
        )
    go [FilePath]
_ Glob
_ = Maybe FilePath
forall a. Maybe a
Nothing

-- | Get the 'FilePath' corresponding to a 'FilePathRoot'.
--
-- The 'FilePath' argument is required to supply the path for the
-- 'FilePathRelative' case.
getFilePathRootDirectory
  :: FilePathRoot
  -> FilePath
  -- ^ root for relative paths
  -> IO FilePath
getFilePathRootDirectory :: FilePathRoot -> FilePath -> IO FilePath
getFilePathRootDirectory FilePathRoot
FilePathRelative FilePath
root = FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
root
getFilePathRootDirectory (FilePathRoot FilePath
root) FilePath
_ = FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
root
getFilePathRootDirectory FilePathRoot
FilePathHomeDir FilePath
_ = IO FilePath
getHomeDirectory

------------------------------------------------------------------------------
-- Matching
--

-- | Match a 'RootedGlob' against the file system, starting from a given
-- root directory for relative paths. The results of relative globs are
-- relative to the given root. Matches for absolute globs are absolute.
matchFileGlob :: FilePath -> RootedGlob -> IO [FilePath]
matchFileGlob :: FilePath -> RootedGlob -> IO [FilePath]
matchFileGlob FilePath
relroot (RootedGlob FilePathRoot
globroot Glob
glob) = do
  FilePath
root <- FilePathRoot -> FilePath -> IO FilePath
getFilePathRootDirectory FilePathRoot
globroot FilePath
relroot
  [FilePath]
matches <- FilePath -> Glob -> IO [FilePath]
matchGlob FilePath
root Glob
glob
  case FilePathRoot
globroot of
    FilePathRoot
FilePathRelative -> [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
matches
    FilePathRoot
_ -> [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
root FilePath -> FilePath -> FilePath
</>) [FilePath]
matches)