Glob.hs

{-# 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 input = [a | GlobMatch 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 v = matchDirFileGlobWithDie v 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 rip version dir filepath = case parseFileGlob version filepath of
  Left err -> rip verbosity $ MatchDirFileGlob (explainGlobSyntaxError filepath err)
  Right glob -> do
    results <- runDirFileGlob verbosity (Just version) dir glob
    let missingDirectories =
          [missingDir | GlobMissingDirectory missingDir <- results]
        matches = globMatches results
        directoryMatches = [a | GlobMatchesDirectory a <- results]

    let errors :: [String]
        errors =
          [ "filepath wildcard '"
            ++ filepath
            ++ "' refers to the directory"
            ++ " '"
            ++ missingDir
            ++ "', which does not exist or is not a directory."
          | missingDir <- missingDirectories
          ]
            ++ [ "filepath wildcard '" ++ filepath ++ "' does not match any files."
               | null matches && null directoryMatches
               -- we don't error out on directory matches, simply warn about them and ignore.
               ]

        warns :: [String]
        warns =
          [ "Ignoring directory '" ++ path ++ "'" ++ " listed in a Cabal package field which should only include files (not directories)."
          | path <- directoryMatches
          ]

    if null errors
      then do
        unless (null warns) $
          warn verbosity $
            unlines warns
        return matches
      else rip verbosity $ MatchDirFileGlobErrors errors