{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
module Distribution.Simple.Glob
(
Glob
, GlobResult (..)
, globMatches
, fileGlobMatches
, matchDirFileGlob
, matchDirFileGlobWithDie
, runDirFileGlob
, parseFileGlob
, GlobSyntaxError (..)
, explainGlobSyntaxError
, isRecursiveInRoot
)
where
import Distribution.Compat.Prelude
import Prelude ()
import Distribution.CabalSpecVersion (CabalSpecVersion)
import Distribution.Simple.Errors
( CabalException (MatchDirFileGlob, MatchDirFileGlobErrors)
)
import Distribution.Simple.Glob.Internal
import Distribution.Simple.Utils (dieWithException, warn)
import Distribution.Verbosity (Verbosity)
globMatches :: [GlobResult a] -> [a]
globMatches :: forall a. [GlobResult a] -> [a]
globMatches [GlobResult a]
input = [a
a | GlobMatch a
a <- [GlobResult a]
input]
matchDirFileGlob :: Verbosity -> CabalSpecVersion -> FilePath -> FilePath -> IO [FilePath]
matchDirFileGlob :: Verbosity
-> CabalSpecVersion -> FilePath -> FilePath -> IO [FilePath]
matchDirFileGlob Verbosity
v = Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> CabalSpecVersion
-> FilePath
-> FilePath
-> IO [FilePath]
matchDirFileGlobWithDie Verbosity
v Verbosity -> CabalException -> IO [FilePath]
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException
matchDirFileGlobWithDie
:: Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> CabalSpecVersion
-> FilePath
-> FilePath
-> IO [FilePath]
matchDirFileGlobWithDie :: Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> CabalSpecVersion
-> FilePath
-> FilePath
-> IO [FilePath]
matchDirFileGlobWithDie Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip CabalSpecVersion
version FilePath
dir FilePath
filepath = case CabalSpecVersion -> FilePath -> Either GlobSyntaxError Glob
parseFileGlob CabalSpecVersion
version FilePath
filepath of
Left GlobSyntaxError
err -> Verbosity -> CabalException -> IO [FilePath]
rip Verbosity
verbosity (CabalException -> IO [FilePath])
-> CabalException -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> CabalException
MatchDirFileGlob (FilePath -> GlobSyntaxError -> FilePath
explainGlobSyntaxError FilePath
filepath GlobSyntaxError
err)
Right Glob
glob -> do
results <- Verbosity
-> Maybe CabalSpecVersion
-> FilePath
-> Glob
-> IO [GlobResult FilePath]
runDirFileGlob Verbosity
verbosity (CabalSpecVersion -> Maybe CabalSpecVersion
forall a. a -> Maybe a
Just CabalSpecVersion
version) FilePath
dir Glob
glob
let missingDirectories =
[FilePath
missingDir | GlobMissingDirectory FilePath
missingDir <- [GlobResult FilePath]
results]
matches = [GlobResult FilePath] -> [FilePath]
forall a. [GlobResult a] -> [a]
globMatches [GlobResult FilePath]
results
directoryMatches = [FilePath
a | GlobMatchesDirectory FilePath
a <- [GlobResult FilePath]
results]
let errors :: [String]
errors =
[ FilePath
"filepath wildcard '"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
filepath
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' refers to the directory"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" '"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
missingDir
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"', which does not exist or is not a directory."
| FilePath
missingDir <- [FilePath]
missingDirectories
]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [ FilePath
"filepath wildcard '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
filepath FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' does not match any files."
| [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
matches Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
directoryMatches
]
warns :: [String]
warns =
[ FilePath
"Ignoring directory '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" listed in a Cabal package field which should only include files (not directories)."
| FilePath
path <- [FilePath]
directoryMatches
]
if null errors
then do
unless (null warns) $
warn verbosity $
unlines warns
return matches
else rip verbosity $ MatchDirFileGlobErrors errors