{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# 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 (
        GlobSyntaxError(..),
        GlobResult(..),
        matchDirFileGlob,
        runDirFileGlob,
        fileGlobMatches,
        parseFileGlob,
        explainGlobSyntaxError,
        Glob,
  ) where

import Prelude ()
import Distribution.Compat.Prelude

import Control.Monad (guard)

import Distribution.Simple.Utils
import Distribution.Verbosity
import Distribution.Version

import System.Directory (getDirectoryContents, doesDirectoryExist, doesFileExist)
import System.FilePath (joinPath, splitExtensions, splitDirectories, takeFileName, (</>), (<.>))

import qualified Data.List.NonEmpty as NE

-- 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
  = GlobMatch a
    -- ^ The glob matched the value supplied.
  | GlobWarnMultiDot 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.
  | GlobMissingDirectory FilePath
    -- ^ 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').
  deriving (Int -> GlobResult a -> ShowS
[GlobResult a] -> ShowS
GlobResult a -> String
(Int -> GlobResult a -> ShowS)
-> (GlobResult a -> String)
-> ([GlobResult a] -> ShowS)
-> Show (GlobResult a)
forall a. Show a => Int -> GlobResult a -> ShowS
forall a. Show a => [GlobResult a] -> ShowS
forall a. Show a => GlobResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobResult a] -> ShowS
$cshowList :: forall a. Show a => [GlobResult a] -> ShowS
show :: GlobResult a -> String
$cshow :: forall a. Show a => GlobResult a -> String
showsPrec :: Int -> GlobResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> GlobResult a -> ShowS
External instance of the constraint type Show Char
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Ord Int
External instance of the constraint type Ord Int
Evidence bound by a type signature of the constraint type Show a
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
/= :: GlobResult a -> GlobResult a -> Bool
$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
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
Evidence bound by a type signature of the constraint type Eq a
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
min :: GlobResult a -> GlobResult a -> GlobResult a
$cmin :: forall a. Ord a => GlobResult a -> GlobResult a -> GlobResult a
max :: GlobResult a -> GlobResult a -> GlobResult a
$cmax :: forall a. Ord a => GlobResult a -> GlobResult a -> GlobResult a
>= :: 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
$c< :: forall a. Ord a => GlobResult a -> GlobResult a -> Bool
compare :: GlobResult a -> GlobResult a -> Ordering
$ccompare :: forall a. Ord a => GlobResult a -> GlobResult a -> Ordering
External instance of the constraint type Ord Char
External instance of the constraint type Ord Char
External instance of the constraint type Ord Char
External instance of the constraint type forall a. Ord a => Ord [a]
Instance of class: Eq of the constraint type forall a. Eq a => Eq (GlobResult a)
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a type signature of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a type signature of the constraint type Ord a
Instance of class: Ord of the constraint type forall a. Ord a => Ord (GlobResult a)
Evidence bound by a type signature of the constraint type Ord a
Instance of class: Eq of the constraint type forall a. Eq a => Eq (GlobResult a)
Ord, a -> GlobResult b -> GlobResult a
(a -> b) -> GlobResult a -> GlobResult b
(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
<$ :: a -> GlobResult b -> GlobResult a
$c<$ :: forall a b. a -> GlobResult b -> GlobResult a
fmap :: (a -> b) -> GlobResult a -> GlobResult b
$cfmap :: forall a b. (a -> b) -> GlobResult a -> GlobResult b
Functor)

-- | 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.
globMatches :: [GlobResult a] -> [a]
globMatches :: [GlobResult a] -> [a]
globMatches [GlobResult a]
input = [ a
a | GlobMatch a
a <- [GlobResult a]
input ]

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
/= :: GlobSyntaxError -> GlobSyntaxError -> Bool
$c/= :: GlobSyntaxError -> GlobSyntaxError -> Bool
== :: GlobSyntaxError -> GlobSyntaxError -> Bool
$c== :: GlobSyntaxError -> GlobSyntaxError -> Bool
Eq, Int -> GlobSyntaxError -> ShowS
[GlobSyntaxError] -> ShowS
GlobSyntaxError -> String
(Int -> GlobSyntaxError -> ShowS)
-> (GlobSyntaxError -> String)
-> ([GlobSyntaxError] -> ShowS)
-> Show GlobSyntaxError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobSyntaxError] -> ShowS
$cshowList :: [GlobSyntaxError] -> ShowS
show :: GlobSyntaxError -> String
$cshow :: GlobSyntaxError -> String
showsPrec :: Int -> GlobSyntaxError -> ShowS
$cshowsPrec :: Int -> GlobSyntaxError -> ShowS
Show)

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

data IsRecursive = Recursive | NonRecursive

data MultiDot = MultiDotDisabled | MultiDotEnabled

data Glob
  = GlobStem FilePath Glob
    -- ^ A single subdirectory component + remainder.
  | GlobFinal GlobFinal

data GlobFinal
  = FinalMatch IsRecursive MultiDot String
    -- ^ First argument: Is this a @**/*.ext@ pattern?
    --   Second argument: should we match against the exact extensions, or accept a suffix?
    --   Third argument: the extensions to accept.
  | FinalLit FilePath
    -- ^ Literal file name.

reconstructGlob :: Glob -> FilePath
reconstructGlob :: Glob -> String
reconstructGlob (GlobStem String
dir Glob
glob) =
  String
dir String -> ShowS
</> Glob -> String
reconstructGlob Glob
glob
reconstructGlob (GlobFinal GlobFinal
final) = case GlobFinal
final of
  FinalMatch IsRecursive
Recursive MultiDot
_ String
exts -> String
"**" String -> ShowS
</> String
"*" String -> ShowS
<.> String
exts
  FinalMatch IsRecursive
NonRecursive MultiDot
_ String
exts -> String
"*" String -> ShowS
<.> String
exts
  FinalLit String
path -> String
path

-- | Returns 'Nothing' if the glob didn't match at all, or 'Just' the
--   result if the glob matched (or would have matched with a higher
--   cabal-version).
fileGlobMatches :: Glob -> FilePath -> Maybe (GlobResult FilePath)
fileGlobMatches :: Glob -> String -> Maybe (GlobResult String)
fileGlobMatches Glob
pat String
candidate = do
  GlobResult ()
match <- Glob -> [String] -> Maybe (GlobResult ())
fileGlobMatchesSegments Glob
pat (String -> [String]
splitDirectories String
candidate)
  GlobResult String -> Maybe (GlobResult String)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad Maybe
return (String
candidate String -> GlobResult () -> GlobResult String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
Instance of class: Functor of the constraint type Functor GlobResult
<$ GlobResult ()
match)

fileGlobMatchesSegments :: Glob -> [FilePath] -> Maybe (GlobResult ())
fileGlobMatchesSegments :: Glob -> [String] -> Maybe (GlobResult ())
fileGlobMatchesSegments Glob
_ [] = Maybe (GlobResult ())
forall a. Maybe a
Nothing
fileGlobMatchesSegments Glob
pat (String
seg : [String]
segs) = case Glob
pat of
  GlobStem String
dir Glob
pat' -> do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
External instance of the constraint type Alternative Maybe
guard (String
dir String -> String -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
== String
seg)
    Glob -> [String] -> Maybe (GlobResult ())
fileGlobMatchesSegments Glob
pat' [String]
segs
  GlobFinal GlobFinal
final -> case GlobFinal
final of
    FinalMatch IsRecursive
Recursive MultiDot
multidot String
ext -> do
      let (String
candidateBase, String
candidateExts) = String -> (String, String)
splitExtensions (NonEmpty String -> String
forall a. NonEmpty a -> a
NE.last (NonEmpty String -> String) -> NonEmpty String -> String
forall a b. (a -> b) -> a -> b
$ String
segString -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:|[String]
segs)
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
External instance of the constraint type Alternative Maybe
guard (Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null String
candidateBase))
      MultiDot -> String -> String -> Maybe (GlobResult ())
checkExt MultiDot
multidot String
ext String
candidateExts
    FinalMatch IsRecursive
NonRecursive MultiDot
multidot String
ext -> do
      let (String
candidateBase, String
candidateExts) = String -> (String, String)
splitExtensions String
seg
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
External instance of the constraint type Alternative Maybe
guard ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [String]
segs Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null String
candidateBase))
      MultiDot -> String -> String -> Maybe (GlobResult ())
checkExt MultiDot
multidot String
ext String
candidateExts
    FinalLit String
filename -> do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
External instance of the constraint type Alternative Maybe
guard ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [String]
segs Bool -> Bool -> Bool
&& String
filename String -> String -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
== String
seg)
      GlobResult () -> Maybe (GlobResult ())
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad Maybe
return (() -> GlobResult ()
forall a. a -> GlobResult a
GlobMatch ())

checkExt
  :: MultiDot
  -> String -- ^ The pattern's extension
  -> String -- ^ The candidate file's extension
  -> Maybe (GlobResult ())
checkExt :: MultiDot -> String -> String -> Maybe (GlobResult ())
checkExt MultiDot
multidot String
ext String
candidate
  | String
ext String -> String -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
== String
candidate = GlobResult () -> Maybe (GlobResult ())
forall a. a -> Maybe a
Just (() -> GlobResult ()
forall a. a -> GlobResult a
GlobMatch ())
  | String
ext String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
External instance of the constraint type Eq Char
`isSuffixOf` String
candidate = case MultiDot
multidot of
      MultiDot
MultiDotDisabled -> GlobResult () -> Maybe (GlobResult ())
forall a. a -> Maybe a
Just (() -> GlobResult ()
forall a. a -> GlobResult a
GlobWarnMultiDot ())
      MultiDot
MultiDotEnabled -> GlobResult () -> Maybe (GlobResult ())
forall a. a -> Maybe a
Just (() -> GlobResult ()
forall a. a -> GlobResult a
GlobMatch ())
  | Bool
otherwise = Maybe (GlobResult ())
forall a. Maybe a
Nothing

parseFileGlob :: Version -> FilePath -> Either GlobSyntaxError Glob
parseFileGlob :: Version -> String -> Either GlobSyntaxError Glob
parseFileGlob Version
version String
filepath = case [String] -> [String]
forall a. [a] -> [a]
reverse (String -> [String]
splitDirectories String
filepath) of
  [] ->
        GlobSyntaxError -> Either GlobSyntaxError Glob
forall a b. a -> Either a b
Left GlobSyntaxError
EmptyGlob
  (String
filename : String
"**" : [String]
segments)
    | Bool
allowGlobStar -> do
        String
ext <- case String -> (String, String)
splitExtensions String
filename of
          (String
"*", String
ext) | Char
'*' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Foldable []
`elem` String
ext -> GlobSyntaxError -> Either GlobSyntaxError String
forall a b. a -> Either a b
Left GlobSyntaxError
StarInExtension
                     | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null String
ext       -> GlobSyntaxError -> Either GlobSyntaxError String
forall a b. a -> Either a b
Left GlobSyntaxError
NoExtensionOnStar
                     | Bool
otherwise      -> String -> Either GlobSyntaxError String
forall a b. b -> Either a b
Right String
ext
          (String, String)
_                           -> GlobSyntaxError -> Either GlobSyntaxError String
forall a b. a -> Either a b
Left GlobSyntaxError
LiteralFileNameGlobStar
        (Glob -> String -> Either GlobSyntaxError Glob)
-> Glob -> [String] -> Either GlobSyntaxError Glob
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
External instance of the constraint type forall e. Monad (Either e)
External instance of the constraint type Foldable []
foldM Glob -> String -> Either GlobSyntaxError Glob
addStem (GlobFinal -> Glob
GlobFinal (GlobFinal -> Glob) -> GlobFinal -> Glob
forall a b. (a -> b) -> a -> b
$ IsRecursive -> MultiDot -> String -> GlobFinal
FinalMatch IsRecursive
Recursive MultiDot
multidot String
ext) [String]
segments
    | Bool
otherwise -> GlobSyntaxError -> Either GlobSyntaxError Glob
forall a b. a -> Either a b
Left GlobSyntaxError
VersionDoesNotSupportGlobStar
  (String
filename : [String]
segments) -> do
        GlobFinal
pat <- case String -> (String, String)
splitExtensions String
filename of
          (String
"*", String
ext) | Bool -> Bool
not Bool
allowGlob       -> GlobSyntaxError -> Either GlobSyntaxError GlobFinal
forall a b. a -> Either a b
Left GlobSyntaxError
VersionDoesNotSupportGlob
                     | Char
'*' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Foldable []
`elem` String
ext      -> GlobSyntaxError -> Either GlobSyntaxError GlobFinal
forall a b. a -> Either a b
Left GlobSyntaxError
StarInExtension
                     | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null String
ext            -> GlobSyntaxError -> Either GlobSyntaxError GlobFinal
forall a b. a -> Either a b
Left GlobSyntaxError
NoExtensionOnStar
                     | Bool
otherwise           -> GlobFinal -> Either GlobSyntaxError GlobFinal
forall a b. b -> Either a b
Right (IsRecursive -> MultiDot -> String -> GlobFinal
FinalMatch IsRecursive
NonRecursive MultiDot
multidot String
ext)
          (String
_, String
ext)   | Char
'*' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Foldable []
`elem` String
ext      -> GlobSyntaxError -> Either GlobSyntaxError GlobFinal
forall a b. a -> Either a b
Left GlobSyntaxError
StarInExtension
                     | Char
'*' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Foldable []
`elem` String
filename -> GlobSyntaxError -> Either GlobSyntaxError GlobFinal
forall a b. a -> Either a b
Left GlobSyntaxError
StarInFileName
                     | Bool
otherwise           -> GlobFinal -> Either GlobSyntaxError GlobFinal
forall a b. b -> Either a b
Right (String -> GlobFinal
FinalLit String
filename)
        (Glob -> String -> Either GlobSyntaxError Glob)
-> Glob -> [String] -> Either GlobSyntaxError Glob
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
External instance of the constraint type forall e. Monad (Either e)
External instance of the constraint type Foldable []
foldM Glob -> String -> Either GlobSyntaxError Glob
addStem (GlobFinal -> Glob
GlobFinal GlobFinal
pat) [String]
segments
  where
    allowGlob :: Bool
allowGlob = Version
version Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Version
>= [Int] -> Version
mkVersion [Int
1,Int
6]
    allowGlobStar :: Bool
allowGlobStar = Version
version Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Version
>= [Int] -> Version
mkVersion [Int
2,Int
4]
    addStem :: Glob -> String -> Either GlobSyntaxError Glob
addStem Glob
pat String
seg
      | Char
'*' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Foldable []
`elem` String
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 (String -> Glob -> Glob
GlobStem String
seg Glob
pat)
    multidot :: MultiDot
multidot
      | Version
version Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Version
>= [Int] -> Version
mkVersion [Int
2,Int
4] = MultiDot
MultiDotEnabled
      | Bool
otherwise = MultiDot
MultiDotDisabled

-- | 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 -> Version -> FilePath -> FilePath -> IO [FilePath]
matchDirFileGlob :: Verbosity -> Version -> String -> String -> IO [String]
matchDirFileGlob Verbosity
verbosity Version
version String
dir String
filepath = case Version -> String -> Either GlobSyntaxError Glob
parseFileGlob Version
version String
filepath of
  Left GlobSyntaxError
err -> Verbosity -> String -> IO [String]
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO [String]) -> String -> IO [String]
forall a b. (a -> b) -> a -> b
$ String -> GlobSyntaxError -> String
explainGlobSyntaxError String
filepath GlobSyntaxError
err
  Right Glob
glob -> do
    [GlobResult String]
results <- Verbosity -> String -> Glob -> IO [GlobResult String]
runDirFileGlob Verbosity
verbosity String
dir Glob
glob
    let missingDirectories :: [String]
missingDirectories =
          [ String
missingDir | GlobMissingDirectory String
missingDir <- [GlobResult String]
results ]
        matches :: [String]
matches = [GlobResult String] -> [String]
forall a. [GlobResult a] -> [a]
globMatches [GlobResult String]
results
    -- Check for missing directories first, since we'll obviously have
    -- no matches in that case.
    [String] -> (String -> IO Any) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
External instance of the constraint type Applicative IO
External instance of the constraint type Foldable []
for_ [String]
missingDirectories ((String -> IO Any) -> IO ()) -> (String -> IO Any) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ String
missingDir ->
      Verbosity -> String -> IO Any
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO Any) -> String -> IO Any
forall a b. (a -> b) -> a -> b
$
           String
"filepath wildcard '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filepath String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' refers to the directory"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
missingDir String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"', which does not exist or is not a directory."
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
External instance of the constraint type Applicative IO
when ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [String]
matches) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
         String
"filepath wildcard '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filepath
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' does not match any files."
    [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return [String]
matches

-- | 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 -> FilePath -> Glob -> IO [GlobResult FilePath]
runDirFileGlob :: Verbosity -> String -> Glob -> IO [GlobResult String]
runDirFileGlob Verbosity
verbosity String
rawDir 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 ()
External instance of the constraint type Applicative IO
when (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null String
rawDir) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Verbosity -> String -> IO ()
warn Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
         String
"Null dir passed to runDirFileGlob; interpreting it "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"as '.'. This is probably an internal error."
  let dir :: String
dir = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null String
rawDir then String
"." else String
rawDir
  Verbosity -> String -> IO ()
debug Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Expanding glob '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Glob -> String
reconstructGlob Glob
pat String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' in directory '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dir String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
  -- 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 ([String]
prefixSegments, GlobFinal
final) = Glob -> ([String], GlobFinal)
splitConstantPrefix Glob
pat
      joinedPrefix :: String
joinedPrefix = [String] -> String
joinPath [String]
prefixSegments
  case GlobFinal
final of
    FinalMatch IsRecursive
recursive MultiDot
multidot String
exts -> do
      let prefix :: String
prefix = String
dir String -> ShowS
</> String
joinedPrefix
      Bool
directoryExists <- String -> IO Bool
doesDirectoryExist String
prefix
      if Bool
directoryExists
        then do
          [String]
candidates <- case IsRecursive
recursive of
            IsRecursive
Recursive -> String -> IO [String]
getDirectoryContentsRecursive String
prefix
            IsRecursive
NonRecursive -> (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
External instance of the constraint type Applicative IO
filterM (String -> IO Bool
doesFileExist (String -> IO Bool) -> ShowS -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
prefix String -> ShowS
</>)) ([String] -> IO [String]) -> IO [String] -> IO [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
External instance of the constraint type Monad IO
=<< String -> IO [String]
getDirectoryContents String
prefix
          let checkName :: String -> Maybe (GlobResult String)
checkName String
candidate = do
                let (String
candidateBase, String
candidateExts) = String -> (String, String)
splitExtensions (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ ShowS
takeFileName String
candidate
                Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
External instance of the constraint type Alternative Maybe
guard (Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null String
candidateBase))
                GlobResult ()
match <- MultiDot -> String -> String -> Maybe (GlobResult ())
checkExt MultiDot
multidot String
exts String
candidateExts
                GlobResult String -> Maybe (GlobResult String)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad Maybe
return (String
joinedPrefix String -> ShowS
</> String
candidate String -> GlobResult () -> GlobResult String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
Instance of class: Functor of the constraint type Functor GlobResult
<$ GlobResult ()
match)
          [GlobResult String] -> IO [GlobResult String]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ([GlobResult String] -> IO [GlobResult String])
-> [GlobResult String] -> IO [GlobResult String]
forall a b. (a -> b) -> a -> b
$ (String -> Maybe (GlobResult String))
-> [String] -> [GlobResult String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe (GlobResult String)
checkName [String]
candidates
        else
          [GlobResult String] -> IO [GlobResult String]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return [ String -> GlobResult String
forall a. String -> GlobResult a
GlobMissingDirectory String
joinedPrefix ]
    FinalLit String
fn -> do
      Bool
exists <- String -> IO Bool
doesFileExist (String
dir String -> ShowS
</> String
joinedPrefix String -> ShowS
</> String
fn)
      [GlobResult String] -> IO [GlobResult String]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return [ String -> GlobResult String
forall a. a -> GlobResult a
GlobMatch (String
joinedPrefix String -> ShowS
</> String
fn) | Bool
exists ]

unfoldr' :: (a -> Either r (b, a)) -> a -> ([b], r)
unfoldr' :: (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)

-- | Extract the (possibly null) constant prefix from the pattern.
-- This has the property that, if @(pref, final) = splitConstantPrefix pat@,
-- then @pat === foldr GlobStem (GlobFinal final) pref@.
splitConstantPrefix :: Glob -> ([FilePath], GlobFinal)
splitConstantPrefix :: Glob -> ([String], GlobFinal)
splitConstantPrefix = (Glob -> Either GlobFinal (String, Glob))
-> Glob -> ([String], GlobFinal)
forall a r b. (a -> Either r (b, a)) -> a -> ([b], r)
unfoldr' Glob -> Either GlobFinal (String, Glob)
step
  where
    step :: Glob -> Either GlobFinal (String, Glob)
step (GlobStem String
seg Glob
pat) = (String, Glob) -> Either GlobFinal (String, Glob)
forall a b. b -> Either a b
Right (String
seg, Glob
pat)
    step (GlobFinal GlobFinal
pat) = GlobFinal -> Either GlobFinal (String, Glob)
forall a b. a -> Either a b
Left GlobFinal
pat