{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.Glob (
GlobSyntaxError(..),
GlobResult(..),
matchDirFileGlob,
runDirFileGlob,
fileGlobMatches,
parseFileGlob,
explainGlobSyntaxError,
Glob,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.CabalSpecVersion
import Distribution.Simple.Utils
import Distribution.Verbosity
import System.Directory (getDirectoryContents, doesDirectoryExist, doesFileExist)
import System.FilePath (joinPath, splitExtensions, splitDirectories, takeFileName, (</>), (<.>))
import qualified Data.List.NonEmpty as NE
data GlobResult a
= GlobMatch a
| GlobWarnMultiDot a
| GlobMissingDirectory FilePath
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
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
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
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
<$ :: forall a b. a -> GlobResult b -> GlobResult a
$c<$ :: forall a b. a -> GlobResult b -> GlobResult a
fmap :: forall a b. (a -> b) -> GlobResult a -> GlobResult b
$cfmap :: forall a b. (a -> b) -> GlobResult a -> GlobResult b
Functor)
globMatches :: [GlobResult a] -> [a]
globMatches :: forall a. [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
| GlobFinal GlobFinal
data GlobFinal
= FinalMatch IsRecursive MultiDot String
| FinalLit FilePath
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
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
return (String
candidate String -> GlobResult () -> GlobResult String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ 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 ()
guard (String
dir String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== 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 ()
guard (Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
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 ()
guard ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
segs Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
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 ()
guard ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
segs Bool -> Bool -> Bool
&& String
filename String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
seg)
GlobResult () -> Maybe (GlobResult ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> GlobResult ()
forall a. a -> GlobResult a
GlobMatch ())
checkExt
:: MultiDot
-> String
-> String
-> 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
== 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
`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 :: CabalSpecVersion -> FilePath -> Either GlobSyntaxError Glob
parseFileGlob :: CabalSpecVersion -> String -> Either GlobSyntaxError Glob
parseFileGlob CabalSpecVersion
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
`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
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
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
`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
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
`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
`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
foldM Glob -> String -> Either GlobSyntaxError Glob
addStem (GlobFinal -> Glob
GlobFinal GlobFinal
pat) [String]
segments
where
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
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
`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
| CabalSpecVersion
version CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_4 = MultiDot
MultiDotEnabled
| Bool
otherwise = MultiDot
MultiDotDisabled
matchDirFileGlob :: Verbosity -> CabalSpecVersion -> FilePath -> FilePath -> IO [FilePath]
matchDirFileGlob :: Verbosity -> CabalSpecVersion -> String -> String -> IO [String]
matchDirFileGlob Verbosity
verbosity CabalSpecVersion
version String
dir String
filepath = case CabalSpecVersion -> String -> Either GlobSyntaxError Glob
parseFileGlob CabalSpecVersion
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
[String] -> (String -> IO Any) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
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 ()
when ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
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
return [String]
matches
runDirFileGlob :: Verbosity -> FilePath -> Glob -> IO [GlobResult FilePath]
runDirFileGlob :: Verbosity -> String -> Glob -> IO [GlobResult String]
runDirFileGlob Verbosity
verbosity String
rawDir Glob
pat = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
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
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
"'."
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]
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
=<< 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 ()
guard (Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
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
return (String
joinedPrefix String -> ShowS
</> String
candidate String -> GlobResult () -> GlobResult String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ GlobResult ()
match)
[GlobResult String] -> IO [GlobResult String]
forall (m :: * -> *) a. Monad m => a -> m a
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
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
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' :: 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)
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