{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}

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

-- |
-- 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
  , matchDirFileGlob
  , matchDirFileGlobWithDie
  , runDirFileGlob

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

    -- * Utility
  , 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)

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

-- * Matching

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

-- | 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 -> 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

-- | Like 'matchDirFileGlob' but with customizable 'die'
--
-- @since 3.6.0.0
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
    [GlobResult FilePath]
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]
missingDirectories =
          [FilePath
missingDir | GlobMissingDirectory FilePath
missingDir <- [GlobResult FilePath]
results]
        matches :: [FilePath]
matches = [GlobResult FilePath] -> [FilePath]
forall a. [GlobResult a] -> [a]
globMatches [GlobResult FilePath]
results
        directoryMatches :: [FilePath]
directoryMatches = [FilePath
a | GlobMatchesDirectory FilePath
a <- [GlobResult FilePath]
results]

    let errors :: [String]
        errors :: [FilePath]
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
               -- we don't error out on directory matches, simply warn about them and ignore.
               ]

        warns :: [String]
        warns :: [FilePath]
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 [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
errors
      then do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
warns) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
            [FilePath] -> FilePath
unlines [FilePath]
warns
        [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
matches
      else Verbosity -> CabalException -> IO [FilePath]
rip Verbosity
verbosity (CabalException -> IO [FilePath])
-> CabalException -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> CabalException
MatchDirFileGlobErrors [FilePath]
errors