{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}

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

-- |
-- Module      :  Distribution.Simple.Glob
-- Copyright   :  Isaac Jones, Simon Marlow 2003-2004
-- License     :  BSD3
--                portions Copyright (c) 2007, Galois Inc.
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Simple file globbing.
module Distribution.Simple.Glob
  ( -- * Globs
    Glob

    -- * Matching on globs
  , GlobResult (..)
  , globMatches
  , fileGlobMatches
  , matchGlob
  , matchGlobPieces
  , matchDirFileGlob
  , matchDirFileGlobWithDie
  , runDirFileGlob

    -- * Parsing globs
  , parseFileGlob
  , GlobSyntaxError (..)
  , explainGlobSyntaxError

    -- * Utility
  , isRecursiveInRoot
  )
where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.CabalSpecVersion
  ( CabalSpecVersion (..)
  )
import Distribution.Pretty
import Distribution.Simple.Errors
  ( CabalException (MatchDirFileGlob, MatchDirFileGlobErrors)
  )
import Distribution.Simple.Glob.Internal
import Distribution.Simple.Utils
  ( debug
  , dieWithException
  , getDirectoryContentsRecursive
  , warn
  )
import Distribution.Utils.Path
import Distribution.Verbosity
  ( Verbosity
  , silent
  )

import Control.Monad (mapM)
import Data.List (stripPrefix)
import System.Directory
import System.FilePath hiding ((<.>), (</>))

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

-- * Matching

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

-- | Match a 'Glob' against the file system, starting from a
-- given root directory. The results are all relative to the given root.
--
-- @since 3.12.0.0
matchGlob :: FilePath -> Glob -> IO [FilePath]
matchGlob :: [Char] -> Glob -> IO [[Char]]
matchGlob [Char]
root Glob
glob =
  -- For this function, which is the general globbing one (doesn't care about
  -- cabal spec, used e.g. for monitoring), we consider all matches.
  (GlobResult [Char] -> Maybe [Char])
-> [GlobResult [Char]] -> [[Char]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
    ( \case
        GlobMatch [Char]
a -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
a
        GlobWarnMultiDot [Char]
a -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
a
        GlobMatchesDirectory [Char]
a -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
a
        GlobMissingDirectory{} -> Maybe [Char]
forall a. Maybe a
Nothing
    )
    ([GlobResult [Char]] -> [[Char]])
-> IO [GlobResult [Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity
-> Maybe CabalSpecVersion
-> [Char]
-> Glob
-> IO [GlobResult [Char]]
runDirFileGlob Verbosity
silent Maybe CabalSpecVersion
forall a. Maybe a
Nothing [Char]
root Glob
glob

-- | Match a globbing pattern against a file path component
matchGlobPieces :: GlobPieces -> String -> Bool
matchGlobPieces :: GlobPieces -> [Char] -> Bool
matchGlobPieces = GlobPieces -> [Char] -> Bool
goStart
  where
    -- From the man page, glob(7):
    --   "If a filename starts with a '.', this character must be
    --    matched explicitly."

    go, goStart :: [GlobPiece] -> String -> Bool

    goStart :: GlobPieces -> [Char] -> Bool
goStart (GlobPiece
WildCard : GlobPieces
_) (Char
'.' : [Char]
_) = Bool
False
    goStart (Union [GlobPieces]
globs : GlobPieces
rest) [Char]
cs =
      (GlobPieces -> Bool) -> [GlobPieces] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
        (\GlobPieces
glob -> GlobPieces -> [Char] -> Bool
goStart (GlobPieces
glob GlobPieces -> GlobPieces -> GlobPieces
forall a. [a] -> [a] -> [a]
++ GlobPieces
rest) [Char]
cs)
        [GlobPieces]
globs
    goStart GlobPieces
rest [Char]
cs = GlobPieces -> [Char] -> Bool
go GlobPieces
rest [Char]
cs

    go :: GlobPieces -> [Char] -> Bool
go [] [Char]
"" = Bool
True
    go (Literal [Char]
lit : GlobPieces
rest) [Char]
cs
      | Just [Char]
cs' <- [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
lit [Char]
cs =
          GlobPieces -> [Char] -> Bool
go GlobPieces
rest [Char]
cs'
      | Bool
otherwise = Bool
False
    go [GlobPiece
WildCard] [Char]
"" = Bool
True
    go (GlobPiece
WildCard : GlobPieces
rest) (Char
c : [Char]
cs) = GlobPieces -> [Char] -> Bool
go GlobPieces
rest (Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs) Bool -> Bool -> Bool
|| GlobPieces -> [Char] -> Bool
go (GlobPiece
WildCard GlobPiece -> GlobPieces -> GlobPieces
forall a. a -> [a] -> [a]
: GlobPieces
rest) [Char]
cs
    go (Union [GlobPieces]
globs : GlobPieces
rest) [Char]
cs = (GlobPieces -> Bool) -> [GlobPieces] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\GlobPieces
glob -> GlobPieces -> [Char] -> Bool
go (GlobPieces
glob GlobPieces -> GlobPieces -> GlobPieces
forall a. [a] -> [a] -> [a]
++ GlobPieces
rest) [Char]
cs) [GlobPieces]
globs
    go [] (Char
_ : [Char]
_) = Bool
False
    go (GlobPiece
_ : GlobPieces
_) [Char]
"" = Bool
False

-- | Extract the matches from a list of 'GlobResult's.
--
-- Note: throws away the 'GlobMissingDirectory' results; chances are
-- that you want to check for these and error out if any are present.
--
-- @since 3.12.0.0
globMatches :: [GlobResult a] -> [a]
globMatches :: forall a. [GlobResult a] -> [a]
globMatches [GlobResult a]
input = [a
a | GlobMatch a
a <- [GlobResult a]
input]

-- | This will 'die'' when the glob matches no files, or if the glob
-- refers to a missing directory, or if the glob fails to parse.
--
-- The 'Version' argument must be the spec version of the package
-- description being processed, as globs behave slightly differently
-- in different spec versions.
--
-- The first 'FilePath' argument is the directory that the glob is
-- relative to. It must be a valid directory (and hence it can't be
-- the empty string). The returned values will not include this
-- prefix.
--
-- The second 'FilePath' is the glob itself.
matchDirFileGlob
  :: Verbosity
  -> CabalSpecVersion
  -> Maybe (SymbolicPath CWD (Dir dir))
  -> SymbolicPathX allowAbs dir file
  -> IO [SymbolicPathX allowAbs dir file]
matchDirFileGlob :: forall dir (allowAbs :: AllowAbsolute) (file :: FileOrDir).
Verbosity
-> CabalSpecVersion
-> Maybe (SymbolicPath CWD ('Dir dir))
-> SymbolicPathX allowAbs dir file
-> IO [SymbolicPathX allowAbs dir file]
matchDirFileGlob Verbosity
v = Verbosity
-> (forall res. Verbosity -> CabalException -> IO [res])
-> CabalSpecVersion
-> Maybe (SymbolicPath CWD ('Dir dir))
-> SymbolicPathX allowAbs dir file
-> IO [SymbolicPathX allowAbs dir file]
forall dir (allowAbs :: AllowAbsolute) (file :: FileOrDir).
Verbosity
-> (forall res. Verbosity -> CabalException -> IO [res])
-> CabalSpecVersion
-> Maybe (SymbolicPath CWD ('Dir dir))
-> SymbolicPathX allowAbs dir file
-> IO [SymbolicPathX allowAbs dir file]
matchDirFileGlobWithDie Verbosity
v Verbosity -> CabalException -> IO [res]
forall res. Verbosity -> CabalException -> IO [res]
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException

-- | Like 'matchDirFileGlob' but with customizable 'die'
--
-- @since 3.6.0.0
matchDirFileGlobWithDie
  :: Verbosity
  -> (forall res. Verbosity -> CabalException -> IO [res])
  -> CabalSpecVersion
  -> Maybe (SymbolicPath CWD (Dir dir))
  -> SymbolicPathX allowAbs dir file
  -> IO [SymbolicPathX allowAbs dir file]
matchDirFileGlobWithDie :: forall dir (allowAbs :: AllowAbsolute) (file :: FileOrDir).
Verbosity
-> (forall res. Verbosity -> CabalException -> IO [res])
-> CabalSpecVersion
-> Maybe (SymbolicPath CWD ('Dir dir))
-> SymbolicPathX allowAbs dir file
-> IO [SymbolicPathX allowAbs dir file]
matchDirFileGlobWithDie Verbosity
verbosity forall res. Verbosity -> CabalException -> IO [res]
rip CabalSpecVersion
version Maybe (SymbolicPath CWD ('Dir dir))
mbWorkDir SymbolicPathX allowAbs dir file
symPath =
  let rawFilePath :: [Char]
rawFilePath = SymbolicPathX allowAbs dir file -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath SymbolicPathX allowAbs dir file
symPath
      dir :: [Char]
dir = [Char]
-> (SymbolicPath CWD ('Dir dir) -> [Char])
-> Maybe (SymbolicPath CWD ('Dir dir))
-> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"." SymbolicPath CWD ('Dir dir) -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath Maybe (SymbolicPath CWD ('Dir dir))
mbWorkDir
   in case CabalSpecVersion -> [Char] -> Either GlobSyntaxError Glob
parseFileGlob CabalSpecVersion
version [Char]
rawFilePath of
        Left GlobSyntaxError
err -> Verbosity -> CabalException -> IO [SymbolicPathX allowAbs dir file]
forall res. Verbosity -> CabalException -> IO [res]
rip Verbosity
verbosity (CabalException -> IO [SymbolicPathX allowAbs dir file])
-> CabalException -> IO [SymbolicPathX allowAbs dir file]
forall a b. (a -> b) -> a -> b
$ [Char] -> CabalException
MatchDirFileGlob ([Char] -> GlobSyntaxError -> [Char]
explainGlobSyntaxError [Char]
rawFilePath GlobSyntaxError
err)
        Right Glob
glob -> do
          results <- Verbosity
-> Maybe CabalSpecVersion
-> [Char]
-> Glob
-> IO [GlobResult [Char]]
runDirFileGlob Verbosity
verbosity (CabalSpecVersion -> Maybe CabalSpecVersion
forall a. a -> Maybe a
Just CabalSpecVersion
version) [Char]
dir Glob
glob
          let missingDirectories =
                [[Char]
missingDir | GlobMissingDirectory [Char]
missingDir <- [GlobResult [Char]]
results]
              matches = [GlobResult [Char]] -> [[Char]]
forall a. [GlobResult a] -> [a]
globMatches [GlobResult [Char]]
results
              directoryMatches = [[Char]
a | GlobMatchesDirectory [Char]
a <- [GlobResult [Char]]
results]

          let errors :: [String]
              errors =
                [ [Char]
"filepath wildcard '"
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
rawFilePath
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' refers to the directory"
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" '"
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
missingDir
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"', which does not exist or is not a directory."
                | [Char]
missingDir <- [[Char]]
missingDirectories
                ]
                  [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char]
"filepath wildcard '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
rawFilePath [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' does not match any files."
                     | [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
matches Bool -> Bool -> Bool
&& [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
directoryMatches
                     -- we don't error out on directory matches, simply warn about them and ignore.
                     ]

              warns :: [String]
              warns =
                [ [Char]
"Ignoring directory '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
path [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" listed in a Cabal package field which should only include files (not directories)."
                | [Char]
path <- [[Char]]
directoryMatches
                ]

          if null errors
            then do
              unless (null warns) $
                warn verbosity $
                  unlines warns
              return $ map unsafeMakeSymbolicPath matches
            else rip verbosity $ MatchDirFileGlobErrors errors

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

-- * Parsing & printing

--------------------------------------------------------------------------------
-- Filepaths with globs may be parsed in the special context is globbing in
-- cabal package fields, such as `data-files`. In that case, we restrict the
-- globbing syntax to that supported by the cabal spec version in use.
-- Otherwise, we parse the globs to the extent of our globbing features
-- (wildcards `*`, unions `{a,b,c}`, and directory-recursive wildcards `**`).

-- ** Parsing globs in a cabal package

parseFileGlob :: CabalSpecVersion -> FilePath -> Either GlobSyntaxError Glob
parseFileGlob :: CabalSpecVersion -> [Char] -> Either GlobSyntaxError Glob
parseFileGlob CabalSpecVersion
version [Char]
filepath = case [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([Char] -> [[Char]]
splitDirectories [Char]
filepath) of
  [] ->
    GlobSyntaxError -> Either GlobSyntaxError Glob
forall a b. a -> Either a b
Left GlobSyntaxError
EmptyGlob
  ([Char]
filename : [Char]
"**" : [[Char]]
segments)
    | Bool
allowGlobStar -> do
        finalSegment <- case [Char] -> ([Char], [Char])
splitExtensions [Char]
filename of
          ([Char]
"*", [Char]
ext)
            | Char
'*' Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
ext -> GlobSyntaxError -> Either GlobSyntaxError Glob
forall a b. a -> Either a b
Left GlobSyntaxError
StarInExtension
            | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ext -> GlobSyntaxError -> Either GlobSyntaxError Glob
forall a b. a -> Either a b
Left GlobSyntaxError
NoExtensionOnStar
            | Bool
otherwise -> Glob -> Either GlobSyntaxError Glob
forall a b. b -> Either a b
Right (GlobPieces -> Glob
GlobDirRecursive [GlobPiece
WildCard, [Char] -> GlobPiece
Literal [Char]
ext])
          ([Char], [Char])
_
            | Bool
allowLiteralFilenameGlobStar ->
                Glob -> Either GlobSyntaxError Glob
forall a b. b -> Either a b
Right (GlobPieces -> Glob
GlobDirRecursive [[Char] -> GlobPiece
Literal [Char]
filename])
            | Bool
otherwise ->
                GlobSyntaxError -> Either GlobSyntaxError Glob
forall a b. a -> Either a b
Left GlobSyntaxError
LiteralFileNameGlobStar

        foldM addStem finalSegment segments
    | Bool
otherwise -> GlobSyntaxError -> Either GlobSyntaxError Glob
forall a b. a -> Either a b
Left GlobSyntaxError
VersionDoesNotSupportGlobStar
  ([Char]
filename : [[Char]]
segments) -> do
    pat <- case [Char] -> ([Char], [Char])
splitExtensions [Char]
filename of
      ([Char]
"*", [Char]
ext)
        | Bool -> Bool
not Bool
allowGlob -> GlobSyntaxError -> Either GlobSyntaxError Glob
forall a b. a -> Either a b
Left GlobSyntaxError
VersionDoesNotSupportGlob
        | Char
'*' Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
ext -> GlobSyntaxError -> Either GlobSyntaxError Glob
forall a b. a -> Either a b
Left GlobSyntaxError
StarInExtension
        | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ext -> GlobSyntaxError -> Either GlobSyntaxError Glob
forall a b. a -> Either a b
Left GlobSyntaxError
NoExtensionOnStar
        | Bool
otherwise -> Glob -> Either GlobSyntaxError Glob
forall a b. b -> Either a b
Right (GlobPieces -> Glob
GlobFile [GlobPiece
WildCard, [Char] -> GlobPiece
Literal [Char]
ext])
      ([Char]
_, [Char]
ext)
        | Char
'*' Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
ext -> GlobSyntaxError -> Either GlobSyntaxError Glob
forall a b. a -> Either a b
Left GlobSyntaxError
StarInExtension
        | Char
'*' Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
filename -> GlobSyntaxError -> Either GlobSyntaxError Glob
forall a b. a -> Either a b
Left GlobSyntaxError
StarInFileName
        | Bool
otherwise -> Glob -> Either GlobSyntaxError Glob
forall a b. b -> Either a b
Right (GlobPieces -> Glob
GlobFile [[Char] -> GlobPiece
Literal [Char]
filename])

    foldM addStem pat segments
  where
    addStem :: Glob -> [Char] -> Either GlobSyntaxError Glob
addStem Glob
pat [Char]
seg
      | Char
'*' Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
seg = GlobSyntaxError -> Either GlobSyntaxError Glob
forall a b. a -> Either a b
Left GlobSyntaxError
StarInDirectory
      | Bool
otherwise = Glob -> Either GlobSyntaxError Glob
forall a b. b -> Either a b
Right (GlobPieces -> Glob -> Glob
GlobDir [[Char] -> GlobPiece
Literal [Char]
seg] Glob
pat)
    allowGlob :: Bool
allowGlob = CabalSpecVersion
version CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_6
    allowGlobStar :: Bool
allowGlobStar = CabalSpecVersion
version CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_4
    allowLiteralFilenameGlobStar :: Bool
allowLiteralFilenameGlobStar = CabalSpecVersion
version CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV3_8

enableMultidot :: CabalSpecVersion -> Bool
enableMultidot :: CabalSpecVersion -> Bool
enableMultidot CabalSpecVersion
version
  | CabalSpecVersion
version CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_4 = Bool
True
  | Bool
otherwise = Bool
False

--------------------------------------------------------------------------------
-- Parse and printing utils
--------------------------------------------------------------------------------

-- ** Cabal package globbing errors

data GlobSyntaxError
  = StarInDirectory
  | StarInFileName
  | StarInExtension
  | NoExtensionOnStar
  | EmptyGlob
  | LiteralFileNameGlobStar
  | VersionDoesNotSupportGlobStar
  | VersionDoesNotSupportGlob
  deriving (GlobSyntaxError -> GlobSyntaxError -> Bool
(GlobSyntaxError -> GlobSyntaxError -> Bool)
-> (GlobSyntaxError -> GlobSyntaxError -> Bool)
-> Eq GlobSyntaxError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GlobSyntaxError -> GlobSyntaxError -> Bool
== :: GlobSyntaxError -> GlobSyntaxError -> Bool
$c/= :: GlobSyntaxError -> GlobSyntaxError -> Bool
/= :: GlobSyntaxError -> GlobSyntaxError -> Bool
Eq, Int -> GlobSyntaxError -> [Char] -> [Char]
[GlobSyntaxError] -> [Char] -> [Char]
GlobSyntaxError -> [Char]
(Int -> GlobSyntaxError -> [Char] -> [Char])
-> (GlobSyntaxError -> [Char])
-> ([GlobSyntaxError] -> [Char] -> [Char])
-> Show GlobSyntaxError
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> GlobSyntaxError -> [Char] -> [Char]
showsPrec :: Int -> GlobSyntaxError -> [Char] -> [Char]
$cshow :: GlobSyntaxError -> [Char]
show :: GlobSyntaxError -> [Char]
$cshowList :: [GlobSyntaxError] -> [Char] -> [Char]
showList :: [GlobSyntaxError] -> [Char] -> [Char]
Show)

explainGlobSyntaxError :: FilePath -> GlobSyntaxError -> String
explainGlobSyntaxError :: [Char] -> GlobSyntaxError -> [Char]
explainGlobSyntaxError [Char]
filepath GlobSyntaxError
StarInDirectory =
  [Char]
"invalid file glob '"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
filepath
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'. A wildcard '**' is only allowed as the final parent"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" directory. Stars must not otherwise appear in the parent"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" directories."
explainGlobSyntaxError [Char]
filepath GlobSyntaxError
StarInExtension =
  [Char]
"invalid file glob '"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
filepath
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'. Wildcards '*' are only allowed as the"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" file's base name, not in the file extension."
explainGlobSyntaxError [Char]
filepath GlobSyntaxError
StarInFileName =
  [Char]
"invalid file glob '"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
filepath
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'. Wildcards '*' may only totally replace the"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" file's base name, not only parts of it."
explainGlobSyntaxError [Char]
filepath GlobSyntaxError
NoExtensionOnStar =
  [Char]
"invalid file glob '"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
filepath
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'. If a wildcard '*' is used it must be with an file extension."
explainGlobSyntaxError [Char]
filepath GlobSyntaxError
LiteralFileNameGlobStar =
  [Char]
"invalid file glob '"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
filepath
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'. Prior to 'cabal-version: 3.8'"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" if a wildcard '**' is used as a parent directory, the"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" file's base name must be a wildcard '*'."
explainGlobSyntaxError [Char]
_ GlobSyntaxError
EmptyGlob =
  [Char]
"invalid file glob. A glob cannot be the empty string."
explainGlobSyntaxError [Char]
filepath GlobSyntaxError
VersionDoesNotSupportGlobStar =
  [Char]
"invalid file glob '"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
filepath
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'. Using the double-star syntax requires 'cabal-version: 2.4'"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" or greater. Alternatively, for compatibility with earlier Cabal"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" versions, list the included directories explicitly."
explainGlobSyntaxError [Char]
filepath GlobSyntaxError
VersionDoesNotSupportGlob =
  [Char]
"invalid file glob '"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
filepath
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'. Using star wildcards requires 'cabal-version: >= 1.6'. "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Alternatively if you require compatibility with earlier Cabal "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"versions then list all the files explicitly."

-- Note throughout that we use splitDirectories, not splitPath. On
-- Posix, this makes no difference, but, because Windows accepts both
-- slash and backslash as its path separators, if we left in the
-- separators from the glob we might not end up properly normalised.

data GlobResult a
  = -- | The glob matched the value supplied.
    GlobMatch a
  | -- | The glob did not match the value supplied because the
    --   cabal-version is too low and the extensions on the file did
    --   not precisely match the glob's extensions, but rather the
    --   glob was a proper suffix of the file's extensions; i.e., if
    --   not for the low cabal-version, it would have matched.
    GlobWarnMultiDot a
  | -- | The glob couldn't match because the directory named doesn't
    --   exist. The directory will be as it appears in the glob (i.e.,
    --   relative to the directory passed to 'matchDirFileGlob', and,
    --   for 'data-files', relative to 'data-dir').
    GlobMissingDirectory a
  | -- | The glob matched a directory when we were looking for files only.
    -- It didn't match a file!
    --
    -- @since 3.12.0.0
    GlobMatchesDirectory a
  deriving (Int -> GlobResult a -> [Char] -> [Char]
[GlobResult a] -> [Char] -> [Char]
GlobResult a -> [Char]
(Int -> GlobResult a -> [Char] -> [Char])
-> (GlobResult a -> [Char])
-> ([GlobResult a] -> [Char] -> [Char])
-> Show (GlobResult a)
forall a. Show a => Int -> GlobResult a -> [Char] -> [Char]
forall a. Show a => [GlobResult a] -> [Char] -> [Char]
forall a. Show a => GlobResult a -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: forall a. Show a => Int -> GlobResult a -> [Char] -> [Char]
showsPrec :: Int -> GlobResult a -> [Char] -> [Char]
$cshow :: forall a. Show a => GlobResult a -> [Char]
show :: GlobResult a -> [Char]
$cshowList :: forall a. Show a => [GlobResult a] -> [Char] -> [Char]
showList :: [GlobResult a] -> [Char] -> [Char]
Show, GlobResult a -> GlobResult a -> Bool
(GlobResult a -> GlobResult a -> Bool)
-> (GlobResult a -> GlobResult a -> Bool) -> Eq (GlobResult a)
forall a. Eq a => GlobResult a -> GlobResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => GlobResult a -> GlobResult a -> Bool
== :: GlobResult a -> GlobResult a -> Bool
$c/= :: forall a. Eq a => GlobResult a -> GlobResult a -> Bool
/= :: GlobResult a -> GlobResult a -> Bool
Eq, Eq (GlobResult a)
Eq (GlobResult a) =>
(GlobResult a -> GlobResult a -> Ordering)
-> (GlobResult a -> GlobResult a -> Bool)
-> (GlobResult a -> GlobResult a -> Bool)
-> (GlobResult a -> GlobResult a -> Bool)
-> (GlobResult a -> GlobResult a -> Bool)
-> (GlobResult a -> GlobResult a -> GlobResult a)
-> (GlobResult a -> GlobResult a -> GlobResult a)
-> Ord (GlobResult a)
GlobResult a -> GlobResult a -> Bool
GlobResult a -> GlobResult a -> Ordering
GlobResult a -> GlobResult a -> GlobResult a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (GlobResult a)
forall a. Ord a => GlobResult a -> GlobResult a -> Bool
forall a. Ord a => GlobResult a -> GlobResult a -> Ordering
forall a. Ord a => GlobResult a -> GlobResult a -> GlobResult a
$ccompare :: forall a. Ord a => GlobResult a -> GlobResult a -> Ordering
compare :: GlobResult a -> GlobResult a -> Ordering
$c< :: forall a. Ord a => GlobResult a -> GlobResult a -> Bool
< :: GlobResult a -> GlobResult a -> Bool
$c<= :: forall a. Ord a => GlobResult a -> GlobResult a -> Bool
<= :: GlobResult a -> GlobResult a -> Bool
$c> :: forall a. Ord a => GlobResult a -> GlobResult a -> Bool
> :: GlobResult a -> GlobResult a -> Bool
$c>= :: forall a. Ord a => GlobResult a -> GlobResult a -> Bool
>= :: GlobResult a -> GlobResult a -> Bool
$cmax :: forall a. Ord a => GlobResult a -> GlobResult a -> GlobResult a
max :: GlobResult a -> GlobResult a -> GlobResult a
$cmin :: forall a. Ord a => GlobResult a -> GlobResult a -> GlobResult a
min :: GlobResult a -> GlobResult a -> GlobResult a
Ord, (forall a b. (a -> b) -> GlobResult a -> GlobResult b)
-> (forall a b. a -> GlobResult b -> GlobResult a)
-> Functor GlobResult
forall a b. a -> GlobResult b -> GlobResult a
forall a b. (a -> b) -> GlobResult a -> GlobResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GlobResult a -> GlobResult b
fmap :: forall a b. (a -> b) -> GlobResult a -> GlobResult b
$c<$ :: forall a b. a -> GlobResult b -> GlobResult a
<$ :: forall a b. a -> GlobResult b -> GlobResult a
Functor)

-- | Match files against a pre-parsed glob, starting in a directory.
--
-- The 'Version' argument must be the spec version of the package
-- description being processed, as globs behave slightly differently
-- in different spec versions.
--
-- The 'FilePath' argument is the directory that the glob is relative
-- to. It must be a valid directory (and hence it can't be the empty
-- string). The returned values will not include this prefix.
runDirFileGlob
  :: Verbosity
  -> Maybe CabalSpecVersion
  -- ^ If the glob we are running should care about the cabal spec, and warnings such as 'GlobWarnMultiDot', then this should be the version.
  -- If you want to run a glob but don't care about any of the cabal-spec restrictions on globs, use 'Nothing'!
  -> FilePath
  -> Glob
  -> IO [GlobResult FilePath]
runDirFileGlob :: Verbosity
-> Maybe CabalSpecVersion
-> [Char]
-> Glob
-> IO [GlobResult [Char]]
runDirFileGlob Verbosity
verbosity Maybe CabalSpecVersion
mspec [Char]
rawRoot Glob
pat = do
  -- The default data-dir is null. Our callers -should- be
  -- converting that to '.' themselves, but it's a certainty that
  -- some future call-site will forget and trigger a really
  -- hard-to-debug failure if we don't check for that here.
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rawRoot) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
      [Char]
"Null dir passed to runDirFileGlob; interpreting it "
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"as '.'. This is probably an internal error."
  let root :: [Char]
root = if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rawRoot then [Char]
"." else [Char]
rawRoot
  -- This function might be called from the project root with dir as
  -- ".". Walking the tree starting there involves going into .git/
  -- and dist-newstyle/, which is a lot of work for no reward, so
  -- extract the constant prefix from the pattern and start walking
  -- there, and only walk as much as we need to: recursively if **,
  -- the whole directory if *, and just the specific file if it's a
  -- literal.
  let
    ([[Char]]
prefixSegments, Either [Char] Glob
pathOrVariablePattern) = Glob -> ([[Char]], Either [Char] Glob)
splitConstantPrefix Glob
pat
    joinedPrefix :: [Char]
joinedPrefix = [[Char]] -> [Char]
joinPath [[Char]]
prefixSegments

    -- The glob matching function depends on whether we care about the cabal version or not
    doesGlobMatch :: GlobPieces -> String -> Maybe (GlobResult ())
    doesGlobMatch :: GlobPieces -> [Char] -> Maybe (GlobResult ())
doesGlobMatch GlobPieces
glob [Char]
str = case Maybe CabalSpecVersion
mspec of
      Just CabalSpecVersion
spec -> CabalSpecVersion -> GlobPieces -> [Char] -> Maybe (GlobResult ())
checkNameMatches CabalSpecVersion
spec GlobPieces
glob [Char]
str
      Maybe CabalSpecVersion
Nothing -> if GlobPieces -> [Char] -> Bool
matchGlobPieces GlobPieces
glob [Char]
str then GlobResult () -> Maybe (GlobResult ())
forall a. a -> Maybe a
Just (() -> GlobResult ()
forall a. a -> GlobResult a
GlobMatch ()) else Maybe (GlobResult ())
forall a. Maybe a
Nothing

    go :: Glob -> [Char] -> IO [GlobResult [Char]]
go (GlobFile GlobPieces
glob) [Char]
dir = do
      entries <- [Char] -> IO [[Char]]
getDirectoryContents ([Char]
root [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
dir)
      catMaybes
        <$> mapM
          ( \[Char]
s -> do
              -- When running a glob from a Cabal package description (i.e.
              -- when a cabal spec version is passed as an argument), we
              -- disallow matching a @GlobFile@ against a directory, preferring
              -- @GlobDir dir GlobDirTrailing@ to specify a directory match.
              isFile <- IO Bool
-> (CabalSpecVersion -> IO Bool)
-> Maybe CabalSpecVersion
-> IO Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) (IO Bool -> CabalSpecVersion -> IO Bool
forall a b. a -> b -> a
const (IO Bool -> CabalSpecVersion -> IO Bool)
-> IO Bool -> CabalSpecVersion -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist ([Char]
root [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
dir [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
s)) Maybe CabalSpecVersion
mspec
              let match = ([Char]
dir [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
s [Char] -> GlobResult () -> GlobResult [Char]
forall a b. a -> GlobResult b -> GlobResult a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (GlobResult () -> GlobResult [Char])
-> Maybe (GlobResult ()) -> Maybe (GlobResult [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GlobPieces -> [Char] -> Maybe (GlobResult ())
doesGlobMatch GlobPieces
glob [Char]
s
              return $
                if isFile
                  then match
                  else case match of
                    Just (GlobMatch [Char]
x) -> GlobResult [Char] -> Maybe (GlobResult [Char])
forall a. a -> Maybe a
Just (GlobResult [Char] -> Maybe (GlobResult [Char]))
-> GlobResult [Char] -> Maybe (GlobResult [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> GlobResult [Char]
forall a. a -> GlobResult a
GlobMatchesDirectory [Char]
x
                    Just (GlobWarnMultiDot [Char]
x) -> GlobResult [Char] -> Maybe (GlobResult [Char])
forall a. a -> Maybe a
Just (GlobResult [Char] -> Maybe (GlobResult [Char]))
-> GlobResult [Char] -> Maybe (GlobResult [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> GlobResult [Char]
forall a. a -> GlobResult a
GlobMatchesDirectory [Char]
x
                    Just (GlobMatchesDirectory [Char]
x) -> GlobResult [Char] -> Maybe (GlobResult [Char])
forall a. a -> Maybe a
Just (GlobResult [Char] -> Maybe (GlobResult [Char]))
-> GlobResult [Char] -> Maybe (GlobResult [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> GlobResult [Char]
forall a. a -> GlobResult a
GlobMatchesDirectory [Char]
x
                    Just (GlobMissingDirectory [Char]
x) -> GlobResult [Char] -> Maybe (GlobResult [Char])
forall a. a -> Maybe a
Just (GlobResult [Char] -> Maybe (GlobResult [Char]))
-> GlobResult [Char] -> Maybe (GlobResult [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> GlobResult [Char]
forall a. a -> GlobResult a
GlobMissingDirectory [Char]
x -- this should never match, unless you are in a file-delete-heavy concurrent setting i guess
                    Maybe (GlobResult [Char])
Nothing -> Maybe (GlobResult [Char])
forall a. Maybe a
Nothing
          )
          entries
    go (GlobDirRecursive GlobPieces
glob) [Char]
dir = do
      entries <- [Char] -> IO [[Char]]
getDirectoryContentsRecursive ([Char]
root [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
dir)
      return $
        mapMaybe
          ( \[Char]
s -> do
              globMatch <- GlobPieces -> [Char] -> Maybe (GlobResult ())
doesGlobMatch GlobPieces
glob ([Char] -> [Char]
takeFileName [Char]
s)
              pure ((dir </> s) <$ globMatch)
          )
          entries
    go (GlobDir GlobPieces
glob Glob
globPath) [Char]
dir = do
      entries <- [Char] -> IO [[Char]]
getDirectoryContents ([Char]
root [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
dir)
      subdirs <-
        filterM
          ( \[Char]
subdir ->
              [Char] -> IO Bool
doesDirectoryExist
                ([Char]
root [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
dir [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
subdir)
          )
          $ filter (matchGlobPieces glob) entries
      concat <$> traverse (\[Char]
subdir -> Glob -> [Char] -> IO [GlobResult [Char]]
go Glob
globPath ([Char]
dir [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
subdir)) subdirs
    go Glob
GlobDirTrailing [Char]
dir = [GlobResult [Char]] -> IO [GlobResult [Char]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char] -> GlobResult [Char]
forall a. a -> GlobResult a
GlobMatch [Char]
dir]

  case Either [Char] Glob
pathOrVariablePattern of
    Left [Char]
filename -> do
      let filepath :: [Char]
filepath = [Char]
joinedPrefix [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
filename
      Verbosity -> [Char] -> IO ()
debug Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Treating glob as filepath literal '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
filepath [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' in directory '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
root [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'."
      directoryExists <- [Char] -> IO Bool
doesDirectoryExist ([Char]
root [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
filepath)
      if directoryExists
        then pure [GlobMatchesDirectory filepath]
        else do
          exist <- doesFileExist (root </> filepath)
          pure $
            if exist
              then [GlobMatch filepath]
              else []
    Right Glob
variablePattern -> do
      Verbosity -> [Char] -> IO ()
debug Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Expanding glob '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Doc -> [Char]
forall a. Show a => a -> [Char]
show (Glob -> Doc
forall a. Pretty a => a -> Doc
pretty Glob
pat) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' in directory '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
root [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'."
      directoryExists <- [Char] -> IO Bool
doesDirectoryExist ([Char]
root [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
joinedPrefix)
      if directoryExists
        then go variablePattern joinedPrefix
        else return [GlobMissingDirectory joinedPrefix]
  where
    -- \| Extract the (possibly null) constant prefix from the pattern.
    -- This has the property that, if @(pref, final) = splitConstantPrefix pat@,
    -- then @pat === foldr GlobDir final pref@.
    splitConstantPrefix :: Glob -> ([FilePath], Either FilePath Glob)
    splitConstantPrefix :: Glob -> ([[Char]], Either [Char] Glob)
splitConstantPrefix = (Glob -> Either [Char] Glob)
-> ([[Char]], Glob) -> ([[Char]], Either [Char] Glob)
forall a b. (a -> b) -> ([[Char]], a) -> ([[Char]], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Glob -> Either [Char] Glob
literalize (([[Char]], Glob) -> ([[Char]], Either [Char] Glob))
-> (Glob -> ([[Char]], Glob))
-> Glob
-> ([[Char]], Either [Char] Glob)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Glob -> Either Glob ([Char], Glob)) -> Glob -> ([[Char]], Glob)
forall a r b. (a -> Either r (b, a)) -> a -> ([b], r)
unfoldr' Glob -> Either Glob ([Char], Glob)
step
      where
        literalize :: Glob -> Either [Char] Glob
literalize (GlobFile [Literal [Char]
filename]) =
          [Char] -> Either [Char] Glob
forall a b. a -> Either a b
Left [Char]
filename
        literalize Glob
glob =
          Glob -> Either [Char] Glob
forall a b. b -> Either a b
Right Glob
glob

        step :: Glob -> Either Glob ([Char], Glob)
step (GlobDir [Literal [Char]
seg] Glob
pat') = ([Char], Glob) -> Either Glob ([Char], Glob)
forall a b. b -> Either a b
Right ([Char]
seg, Glob
pat')
        step Glob
pat' = Glob -> Either Glob ([Char], Glob)
forall a b. a -> Either a b
Left Glob
pat'

        unfoldr' :: (a -> Either r (b, a)) -> a -> ([b], r)
        unfoldr' :: forall a r b. (a -> Either r (b, a)) -> a -> ([b], r)
unfoldr' a -> Either r (b, a)
f a
a = case a -> Either r (b, a)
f a
a of
          Left r
r -> ([], r
r)
          Right (b
b, a
a') -> case (a -> Either r (b, a)) -> a -> ([b], r)
forall a r b. (a -> Either r (b, a)) -> a -> ([b], r)
unfoldr' a -> Either r (b, a)
f a
a' of
            ([b]
bs, r
r) -> (b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
bs, r
r)

-- | Is the root of this relative glob path a directory-recursive wildcard, e.g. @**/*.txt@ ?
isRecursiveInRoot :: Glob -> Bool
isRecursiveInRoot :: Glob -> Bool
isRecursiveInRoot (GlobDirRecursive GlobPieces
_) = Bool
True
isRecursiveInRoot Glob
_ = Bool
False

-- | Check how the string matches the glob under this cabal version
checkNameMatches :: CabalSpecVersion -> GlobPieces -> String -> Maybe (GlobResult ())
checkNameMatches :: CabalSpecVersion -> GlobPieces -> [Char] -> Maybe (GlobResult ())
checkNameMatches CabalSpecVersion
spec GlobPieces
glob [Char]
candidate
  -- Check if glob matches in its general form
  | GlobPieces -> [Char] -> Bool
matchGlobPieces GlobPieces
glob [Char]
candidate =
      -- if multidot is supported, then this is a clean match
      if CabalSpecVersion -> Bool
enableMultidot CabalSpecVersion
spec
        then GlobResult () -> Maybe (GlobResult ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> GlobResult ()
forall a. a -> GlobResult a
GlobMatch ())
        else -- if not, issue a warning saying multidot is needed for the match

          let ([Char]
_, [Char]
candidateExts) = [Char] -> ([Char], [Char])
splitExtensions ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
takeFileName [Char]
candidate
              extractExts :: GlobPieces -> Maybe String
              extractExts :: GlobPieces -> Maybe [Char]
extractExts [] = Maybe [Char]
forall a. Maybe a
Nothing
              extractExts [Literal [Char]
lit]
                -- Any literal terminating a glob, and which does have an extension,
                -- returns that extension. Otherwise, recurse until Nothing is returned.
                | let ext :: [Char]
ext = [Char] -> [Char]
takeExtensions [Char]
lit
                , [Char]
ext [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"" =
                    [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
ext
              extractExts (GlobPiece
_ : GlobPieces
x) = GlobPieces -> Maybe [Char]
extractExts GlobPieces
x
           in case GlobPieces -> Maybe [Char]
extractExts GlobPieces
glob of
                Just [Char]
exts
                  | [Char]
exts [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
candidateExts ->
                      GlobResult () -> Maybe (GlobResult ())
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> GlobResult ()
forall a. a -> GlobResult a
GlobMatch ())
                  | [Char]
exts [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
candidateExts ->
                      GlobResult () -> Maybe (GlobResult ())
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> GlobResult ()
forall a. a -> GlobResult a
GlobWarnMultiDot ())
                Maybe [Char]
_ -> GlobResult () -> Maybe (GlobResult ())
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> GlobResult ()
forall a. a -> GlobResult a
GlobMatch ())
  | Bool
otherwise = Maybe (GlobResult ())
forall a. Maybe a
forall (f :: * -> *) a. Alternative f => f a
empty

-- | How/does the glob match the given filepath, according to the cabal version?
-- Since this is pure, we don't make a distinction between matching on
-- directories or files (i.e. this function won't return 'GlobMatchesDirectory')
fileGlobMatches :: CabalSpecVersion -> Glob -> FilePath -> Maybe (GlobResult ())
fileGlobMatches :: CabalSpecVersion -> Glob -> [Char] -> Maybe (GlobResult ())
fileGlobMatches CabalSpecVersion
version Glob
g [Char]
path = Glob -> [[Char]] -> Maybe (GlobResult ())
go Glob
g ([Char] -> [[Char]]
splitDirectories [Char]
path)
  where
    go :: Glob -> [[Char]] -> Maybe (GlobResult ())
go Glob
GlobDirTrailing [] = GlobResult () -> Maybe (GlobResult ())
forall a. a -> Maybe a
Just (() -> GlobResult ()
forall a. a -> GlobResult a
GlobMatch ())
    go (GlobFile GlobPieces
glob) [[Char]
file] = CabalSpecVersion -> GlobPieces -> [Char] -> Maybe (GlobResult ())
checkNameMatches CabalSpecVersion
version GlobPieces
glob [Char]
file
    go (GlobDirRecursive GlobPieces
glob) [[Char]]
dirs
      | [] <- [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
dirs =
          Maybe (GlobResult ())
forall a. Maybe a
Nothing -- @dir/**/x.txt@ should not match @dir/hello@
      | [Char]
file : [[Char]]
_ <- [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
dirs =
          CabalSpecVersion -> GlobPieces -> [Char] -> Maybe (GlobResult ())
checkNameMatches CabalSpecVersion
version GlobPieces
glob [Char]
file
    go (GlobDir GlobPieces
glob Glob
globPath) ([Char]
dir : [[Char]]
dirs) = do
      _ <- CabalSpecVersion -> GlobPieces -> [Char] -> Maybe (GlobResult ())
checkNameMatches CabalSpecVersion
version GlobPieces
glob [Char]
dir -- we only care if dir segment matches
      go globPath dirs
    go Glob
_ [[Char]]
_ = Maybe (GlobResult ())
forall a. Maybe a
Nothing