Cabal/src/Distribution/Simple/Glob.hs

   1 {-# LANGUAGE DeriveFunctor #-}
   2 {-# LANGUAGE DeriveGeneric #-}
   3 {-# LANGUAGE LambdaCase #-}
   4
   5 -----------------------------------------------------------------------------
   6
   7 -- |
   8 -- Module      :  Distribution.Simple.Glob
   9 -- Copyright   :  Isaac Jones, Simon Marlow 2003-2004
  10 -- License     :  BSD3
  11 --                portions Copyright (c) 2007, Galois Inc.
  12 --
  13 -- Maintainer  :  cabal-devel@haskell.org
  14 -- Portability :  portable
  15 --
  16 -- Simple file globbing.
  17 module Distribution.Simple.Glob
  18   ( -- * Globs
  19     Glob
  20
  21     -- * Matching on globs
  22   , GlobResult (..)
  23   , globMatches
  24   , fileGlobMatches
  25   , matchDirFileGlob
  26   , matchDirFileGlobWithDie
  27   , runDirFileGlob
  28
  29     -- * Parsing globs
  30   , parseFileGlob
  31   , GlobSyntaxError (..)
  32   , explainGlobSyntaxError
  33
  34     -- * Utility
  35   , isRecursiveInRoot
  36   )
  37 where
  38
  39 import Distribution.Compat.Prelude
  40 import Prelude ()
  41
  42 import Distribution.CabalSpecVersion (CabalSpecVersion)
  43 import Distribution.Simple.Errors
  44   ( CabalException (MatchDirFileGlob, MatchDirFileGlobErrors)
  45   )
  46 import Distribution.Simple.Glob.Internal
  47 import Distribution.Simple.Utils (dieWithException, warn)
  48 import Distribution.Verbosity (Verbosity)
  49
  50 -------------------------------------------------------------------------------
  51
  52 -- * Matching
  53
  54 --------------------------------------------------------------------------------
  55
  56 -- | Extract the matches from a list of 'GlobResult's.
  57 --
  58 -- Note: throws away the 'GlobMissingDirectory' results; chances are
  59 -- that you want to check for these and error out if any are present.
  60 --
  61 -- @since 3.12.0.0
  62 globMatches :: [GlobResult a] -> [a]
  63 globMatches input = [a | GlobMatch a <- input]
  64
  65 -- | This will 'die'' when the glob matches no files, or if the glob
  66 -- refers to a missing directory, or if the glob fails to parse.
  67 --
  68 -- The 'Version' argument must be the spec version of the package
  69 -- description being processed, as globs behave slightly differently
  70 -- in different spec versions.
  71 --
  72 -- The first 'FilePath' argument is the directory that the glob is
  73 -- relative to. It must be a valid directory (and hence it can't be
  74 -- the empty string). The returned values will not include this
  75 -- prefix.
  76 --
  77 -- The second 'FilePath' is the glob itself.
  78 matchDirFileGlob :: Verbosity -> CabalSpecVersion -> FilePath -> FilePath -> IO [FilePath]
  79 matchDirFileGlob v = matchDirFileGlobWithDie v dieWithException
  80
  81 -- | Like 'matchDirFileGlob' but with customizable 'die'
  82 --
  83 -- @since 3.6.0.0
  84 matchDirFileGlobWithDie
  85   :: Verbosity
  86   -> (Verbosity -> CabalException -> IO [FilePath])
  87   -> CabalSpecVersion
  88   -> FilePath
  89   -> FilePath
  90   -> IO [FilePath]
  91 matchDirFileGlobWithDie verbosity rip version dir filepath = case parseFileGlob version filepath of
  92   Left err -> rip verbosity $ MatchDirFileGlob (explainGlobSyntaxError filepath err)
  93   Right glob -> do
  94     results <- runDirFileGlob verbosity (Just version) dir glob
  95     let missingDirectories =
  96           [missingDir | GlobMissingDirectory missingDir <- results]
  97         matches = globMatches results
  98         directoryMatches = [a | GlobMatchesDirectory a <- results]
  99
 100     let errors :: [String]
 101         errors =
 102           [ "filepath wildcard '"
 103             ++ filepath
 104             ++ "' refers to the directory"
 105             ++ " '"
 106             ++ missingDir
 107             ++ "', which does not exist or is not a directory."
 108           | missingDir <- missingDirectories
 109           ]
 110             ++ [ "filepath wildcard '" ++ filepath ++ "' does not match any files."
 111                | null matches && null directoryMatches
 112                -- we don't error out on directory matches, simply warn about them and ignore.
 113                ]
 114
 115         warns :: [String]
 116         warns =
 117           [ "Ignoring directory '" ++ path ++ "'" ++ " listed in a Cabal package field which should only include files (not directories)."
 118           | path <- directoryMatches
 119           ]
 120
 121     if null errors
 122       then do
 123         unless (null warns) $
 124           warn verbosity $
 125             unlines warns
 126         return matches
 127       else rip verbosity $ MatchDirFileGlobErrors errors