From 43dd0de83abedeb159c294c70a230d4819540fb8 Mon Sep 17 00:00:00 2001
From: Harry Garrood <harry@garrood.me>
Date: Sat, 28 Jun 2014 01:56:27 -0700
Subject: [PATCH 01/10] Implement bash (with globstar) style globbing

Implement a reduced form of GNU bash style globbing. The supported
features should account for 99% of use cases.

Still to do: minimum cabal-version constraint. This seems to be
necessary because, for example, this commit changes the meaning of *.js,
which previously would not have matched jquery.cookie.js, and now does.
---
 Cabal/Cabal.cabal                             |   5 +
 Cabal/Distribution/Glob.hs                    |  12 +
 Cabal/Distribution/Glob/Match.hs              | 106 ++++++++
 Cabal/Distribution/Glob/Parse.hs              | 139 +++++++++++
 Cabal/Distribution/Glob/Type.hs               | 122 +++++++++
 .../Distribution/PackageDescription/Check.hs  |   6 +-
 Cabal/Distribution/Simple/Utils.hs            |  47 +---
 Cabal/tests/UnitTests.hs                      |   3 +
 Cabal/tests/UnitTests/Distribution/Glob.hs    | 233 ++++++++++++++++++
 9 files changed, 636 insertions(+), 37 deletions(-)
 create mode 100644 Cabal/Distribution/Glob.hs
 create mode 100644 Cabal/Distribution/Glob/Match.hs
 create mode 100644 Cabal/Distribution/Glob/Parse.hs
 create mode 100644 Cabal/Distribution/Glob/Type.hs
 create mode 100644 Cabal/tests/UnitTests/Distribution/Glob.hs

diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
index bbb527cdcdd..5c0245ff4b1 100644
--- a/Cabal/Cabal.cabal
+++ b/Cabal/Cabal.cabal
@@ -163,6 +163,7 @@ library
     Distribution.Compat.Exception
     Distribution.Compat.ReadP
     Distribution.Compiler
+    Distribution.Glob
     Distribution.InstalledPackageInfo
     Distribution.License
     Distribution.Make
@@ -241,6 +242,9 @@ library
     Distribution.Simple.GHC.IPI641
     Distribution.Simple.GHC.IPI642
     Distribution.Simple.GHC.ImplInfo
+    Distribution.Glob.Type
+    Distribution.Glob.Parse
+    Distribution.Glob.Match
     Paths_Cabal
 
   if flag(bundled-binary-generic)
@@ -260,6 +264,7 @@ test-suite unit-tests
     UnitTests.Distribution.Compat.ReadP
     UnitTests.Distribution.Simple.Program.Internal
     UnitTests.Distribution.Utils.NubList
+    UnitTests.Distribution.Glob
   main-is: UnitTests.hs
   build-depends:
     base,
diff --git a/Cabal/Distribution/Glob.hs b/Cabal/Distribution/Glob.hs
new file mode 100644
index 00000000000..df7e4045fc3
--- /dev/null
+++ b/Cabal/Distribution/Glob.hs
@@ -0,0 +1,12 @@
+module Distribution.Glob
+  ( Glob(..)
+  , isRealGlob
+  , parseFileGlob
+  , isMatch
+  , realIsMatch
+  )
+  where
+
+import Distribution.Glob.Type
+import Distribution.Glob.Parse
+import Distribution.Glob.Match
diff --git a/Cabal/Distribution/Glob/Match.hs b/Cabal/Distribution/Glob/Match.hs
new file mode 100644
index 00000000000..21f09ea1468
--- /dev/null
+++ b/Cabal/Distribution/Glob/Match.hs
@@ -0,0 +1,106 @@
+module Distribution.Glob.Match where
+
+import Control.Monad
+    ( (>=>) )
+import Data.Maybe
+    ( listToMaybe )
+import Data.List
+    ( stripPrefix )
+import Distribution.Glob.Type
+
+isMatch :: Glob -> FilePath -> Bool
+isMatch (Glob realGlob) fp = realIsMatch realGlob fp
+isMatch (NoGlob fp') fp = fp' == fp
+
+realIsMatch :: RealGlob -> FilePath -> Bool
+realIsMatch (RealGlob parts) fp = isMatch' True parts (toSegments fp)
+
+toSegments :: FilePath -> [String]
+toSegments = filter (not . null) . splitOn '/'
+
+-- Not quite the same as the function from Data.List.Split, but this allows
+-- for a simpler implementation
+splitOn :: Eq a => a -> [a] -> [[a]]
+splitOn _ [] = []
+splitOn splitter list =
+  let (next, rest) = span (/= splitter) list
+  in  next : splitOn splitter (drop 1 rest)
+
+-- | Given:
+-- * A Bool which records whether we are at the beginning of the current
+-- segment
+-- * A list of GlobParts
+-- * A list of path segments in a file path
+-- Return whether the glob parts list matches the file path.
+isMatch' :: Bool -> [GlobPart] -> [String] -> Bool
+isMatch' _ (Literal l : parts) (seg : segs) =
+  case stripPrefix l seg of
+    Just seg' -> isMatch' False parts (seg' : segs)
+    Nothing -> False
+isMatch' _ (PathSeparator : parts) (seg : segs)
+  | seg == "" = isMatch' True parts segs
+  | otherwise = False
+isMatch' _ (CharList cs : parts) ((h:tl) : segs) =
+  if charListIsMatch cs h
+    then isMatch' False parts (tl : segs)
+    else False
+isMatch' _ (CharListComplement cs : parts) ((h:tl) : segs) =
+  if charListIsMatch cs h
+    then False
+    else isMatch' False parts (tl : segs)
+isMatch' startSegment (WildOne : parts) ((h:tl) : segs)
+  | startSegment && h == '.' = False
+  | otherwise = isMatch' False parts (tl : segs)
+isMatch' startSegment (WildMany : parts) segs
+  | startSegment && (listToMaybe >=> listToMaybe) segs == Just '.' = False
+  | otherwise =
+    case segs of
+      first : rest ->
+        let candidates = map (:rest) (iterateWhile drop1 first)
+        in  any (isMatch' False parts) candidates
+      [] ->
+        isMatch' startSegment parts segs
+isMatch' startSegment (WildManyRecursive : parts) segs
+   | startSegment && (listToMaybe >=> listToMaybe) segs == Just '.' = False
+   | otherwise =
+     anyCandidates || handlePathSep
+     where
+     anyCandidates =
+       any (\(start, segs') -> isMatch' start parts segs') candidates
+     candidates = iterateWhile (drop1' . snd) (False, segs)
+     handlePathSep =
+       case parts of
+         PathSeparator : parts' -> isMatch' startSegment parts' segs
+         _ -> False
+
+isMatch' startSegment (Choice gs : parts) segs =
+  any (\g -> isMatch' startSegment (g ++ parts) segs) gs
+isMatch' _ [] [""] = True
+isMatch' _ _ _ = False
+
+charListIsMatch :: [CharListPart] -> Char -> Bool
+charListIsMatch parts c = any (matches c) parts
+  where
+  matches x (CharLiteral y) = x == y
+  matches x (Range start end) = start <= x && x <= end
+
+-- | A safe version of 'tail'.
+drop1 :: String -> Maybe String
+drop1 [] = Nothing
+drop1 (_ : tl) = Just tl
+
+-- | Drop one character from a list of path segments, or if the first segment
+-- is empty, move on to the next segment.
+drop1' :: [String] -> Maybe (Bool, [String])
+drop1' [] = Nothing
+drop1' ("" : segs) = Just (True, segs)
+drop1' (seg : segs) = Just (False, drop 1 seg : segs)
+
+-- | Generate a list of values obtained by repeatedly applying a function
+-- to an initial value, until it stops returning Just.
+iterateWhile :: (a -> Maybe a) -> a -> [a]
+iterateWhile f x = x : rest
+  where
+  rest = case f x of
+    Just y -> iterateWhile f y
+    Nothing -> []
diff --git a/Cabal/Distribution/Glob/Parse.hs b/Cabal/Distribution/Glob/Parse.hs
new file mode 100644
index 00000000000..38fd759ae50
--- /dev/null
+++ b/Cabal/Distribution/Glob/Parse.hs
@@ -0,0 +1,139 @@
+module Distribution.Glob.Parse where
+
+import Control.Monad
+    ( unless, liftM2 )
+import Distribution.Compat.ReadP
+import Distribution.Glob.Type
+
+-- | We want to ensure this works the same way on all platforms, so we do not
+-- use System.FilePath here.
+--
+-- Backslashes (like on Windows) may not be used as path separators, because
+-- they would significantly complicate the implementation for little benefit.
+pathSeparators :: [Char]
+pathSeparators = "/"
+
+charIsPathSeparator :: Char -> Bool
+charIsPathSeparator x = x `elem` pathSeparators
+
+-- | Characters which must not be parsed as literals if not escaped in glob
+-- patterns
+globSpecialChars :: [Char]
+globSpecialChars = pathSeparators ++ "\\{}*[]?!^,"
+
+isSpecialChar :: Char -> Bool
+isSpecialChar x = x `elem` globSpecialChars
+
+-- | Characters which can occur at the start of a bracket pattern to transform
+-- it into its complement.
+bracketComplementors :: [Char]
+bracketComplementors = "^!"
+
+isBracketComplementor :: Char -> Bool
+isBracketComplementor x = x `elem` bracketComplementors
+
+-- | Characters which must not be parsed as literals if not escaped in bracket
+-- patterns.
+bracketSpecialChars :: [Char]
+bracketSpecialChars = bracketComplementors ++ "-[]\\/"
+
+isBracketSpecialChar :: Char -> Bool
+isBracketSpecialChar x = x `elem` bracketSpecialChars
+
+-- | Like manyTill, but always consumes at least one occurence of 'p'.
+manyTill1 :: ReadP r a -> ReadP [a] end -> ReadP r [a]
+manyTill1 p end = liftM2 (:) p (manyTill p end)
+
+-- | Parse an escape sequence. Anything is allowed, except a path separator.
+escapeSequence :: ReadP r Char
+escapeSequence = char '\\' >> satisfy (not . charIsPathSeparator)
+
+parseLiteral :: ReadP r GlobPart
+parseLiteral = fmap Literal $ manyTill1 literalSegment literalEnd
+  where
+  literalSegment = notSpecial +++ escapeSequence
+  notSpecial = satisfy (not . isSpecialChar)
+  literalEnd = do
+    str <- look
+    case str of
+        (x:_) | isSpecialChar x -> return ()
+        ""                      -> return ()
+        _                       -> pfail
+
+parsePathSeparator :: ReadP r GlobPart
+parsePathSeparator = munch1 (== '/') >> return PathSeparator
+
+parseCharList :: ReadP r GlobPart
+parseCharList =
+  between (char '[') (char ']')
+    (fmap CharList (many1 parseCharListPart))
+
+parseCharListComplement :: ReadP r GlobPart
+parseCharListComplement =
+  between (char '[') (char ']')
+    (satisfy isBracketComplementor
+     >> fmap CharListComplement (many1 parseCharListPart))
+
+parseCharListPart :: ReadP r CharListPart
+parseCharListPart = range <++ fmap CharLiteral literal
+  where
+  range = do
+    start <- literal
+    _ <- char '-'
+    end <- literal
+    unless (start < end) pfail
+    return (Range start end)
+
+  literal = satisfy (not . isBracketSpecialChar) +++ escapeSequence
+
+parseWildOne :: ReadP r GlobPart
+parseWildOne = char '?' >> return WildOne
+
+-- | Parses either a WildMany or a WildManyRecursive.
+parseWildMany :: ReadP r GlobPart
+parseWildMany = do
+  str <- munch1 (== '*')
+  case str of
+    "*"  -> return WildMany
+    "**" -> return WildManyRecursive
+    _    -> pfail
+
+parseChoice :: ReadP r GlobPart
+parseChoice =
+  between (char '{') (char '}') $ do
+    first <- parseGlobParts
+    _ <- char ','
+    rest <- sepBy1 (parseGlobParts <++ emptyGlob) (char ',')
+    return (Choice (first : rest))
+  where
+  emptyGlob = return []
+
+parseGlobPart :: ReadP r GlobPart
+parseGlobPart = choice
+  [ parseLiteral
+  , parsePathSeparator
+  , parseCharList
+  , parseCharListComplement
+  , parseWildOne
+  , parseWildMany
+  , parseChoice
+  ]
+
+parseGlobParts :: ReadP r [GlobPart]
+parseGlobParts = many1 parseGlobPart
+
+parseFileGlob :: String -> Maybe Glob
+parseFileGlob fp =
+  case fullyParsed (readP_to_S parseGlobParts fp) of
+    [parts] -> Just (mkGlob parts)
+    _       -> Nothing
+  where
+  fullyParsed = map fst . filter (null . snd)
+  mkGlob parts =
+    case sequence (map asLiteral parts) of
+      Just literalParts -> NoGlob (concat literalParts)
+      Nothing -> Glob (RealGlob parts)
+
+  asLiteral (Literal str) = Just str
+  asLiteral (PathSeparator) = Just "/"
+  asLiteral _ = Nothing
diff --git a/Cabal/Distribution/Glob/Type.hs b/Cabal/Distribution/Glob/Type.hs
new file mode 100644
index 00000000000..1f12270cbc9
--- /dev/null
+++ b/Cabal/Distribution/Glob/Type.hs
@@ -0,0 +1,122 @@
+module Distribution.Glob.Type where
+
+-- | A part of a glob. The aim is to be reasonably close to bash; see
+-- http://wiki.bash-hackers.org/syntax/expansion/globs
+--
+-- We do not implement the whole bash globbing syntax here; it doesn't seem
+-- worth implementing some of the more unusual cases. Notably (although this
+-- list is not exhaustive):
+--
+-- * the POSIX character class patterns, like [[:alpha:]],
+-- * the whole `extglob` extended language.
+data GlobPart
+  = Literal String
+  -- ^ Match a part of a file with this exact string only. For example:
+  -- "dictionary.txt" would be parsed as [Literal "dictionary.txt"], and
+  -- would match "dictionary.txt" and nothing else.
+
+  | PathSeparator
+  -- ^ A path separator, '/'. Multiple '/'s are condensed down to one.
+
+  | CharList [CharListPart]
+  -- ^ Match exactly one character from any of the literal characters listed.
+  -- For example:
+  --
+  -- "[abc]" matches "a", "b", "c", and nothing else.
+  -- "[a-z]" matches any lower case English letter.
+  -- "[a-zA-Z]" matches any English letter, either lower or upper case.
+  --
+  -- Special characters inside a CharList are:
+  -- * exclamation mark !
+  -- * hyphen-minus -
+  -- * caret ^
+  --
+  -- To match these characters, they must be escaped with a backslash, eg:
+  -- "[\^\!]"
+  --
+  -- Path separators may not appear in a CharList.
+
+  | CharListComplement [CharListPart]
+  -- ^ Match exactly one character, as long as it is not in any of the listed
+  -- literal characters; the complement of a CharList. Written as "[!..]" or
+  -- "[^..]". Escaping rules are the same as for a CharList. Examples:
+  --
+  -- "[!a]" matches anything except "a".
+  -- "[^abc]" matches anything except "a", "b", or "c".
+
+  | WildOne
+  -- ^ Match exactly one character, excluding path separators, and also
+  -- excluding dots at the beginning of file names. Written "?". Example:
+  --
+  -- "Cab?l" matches "Cabal", "Cabbl", "Cabcl"...
+
+  | WildMany
+  -- ^ Match zero or more characters of any part of a file name, excluding
+  -- path separators, and also excluding dots at the beginning of filenames.
+  -- Written "*".  Examples:
+  --
+  -- "jquery.*.js" matches "jquery.1.js", "jquery.2.js", "jquery.3-pre.js"...
+  -- "*" matches "jquery.js" but not "jquery/index.js" or ".vimrc".
+
+  | WildManyRecursive
+  -- ^ Recursively matches all files and directories, excluding dots at the
+  -- beginning of filenames. Written "**". Examples:
+  --
+  -- "**/*Test.hs" matches "GlobTest.hs", "test/HttpTest.hs",
+  -- "test/examples/ExampleTest.hs"...
+
+  | Choice [[GlobPart]]
+  -- ^ Match exactly one of the given glob patterns. Written with curly
+  -- braces, separated by commas. For example:
+  --
+  -- "{a,b,c*}" should be parsed as:
+  --      [ Choice [ [Literal "a"]
+  --               , [Literal "b"]
+  --               , [Literal "c", MatchAny]
+  --               ]
+  --      ]
+  --
+  -- that is, "a", "b", or anything starting with "c".
+
+  deriving (Show, Eq)
+
+isLiteral :: GlobPart -> Bool
+isLiteral (Literal _) = True
+isLiteral _ = False
+
+isPathSeparator :: GlobPart -> Bool
+isPathSeparator PathSeparator = True
+isPathSeparator _ = False
+
+-- | A part of a bracket pattern, like [abc].
+data CharListPart
+  = Range Char Char
+  -- ^ A character range, like "a-z".
+
+  | CharLiteral Char
+  -- ^ A single character, like "a".
+
+  deriving (Show, Eq)
+
+-- | A glob pattern that can match any number of files.
+-- We purposefully omit an Eq instance because the derived instance would
+-- return False in cases where the globs are actually the same, and also
+-- because we don't really need one.
+--
+-- For example, using the derived Eq instance, we would have:
+--
+--     parseGlob "[abc]" /= parseGlob "{a,b,c}"
+--
+-- even though these are really the same glob.
+newtype RealGlob = RealGlob { runRealGlob :: [GlobPart] }
+  deriving (Show)
+
+-- | A Glob which might just be a literal FilePath.
+data Glob
+  = Glob RealGlob
+  | NoGlob FilePath
+  deriving (Show)
+
+isRealGlob :: Glob -> Bool
+isRealGlob (Glob _) = True
+isRealGlob (NoGlob _) = False
diff --git a/Cabal/Distribution/PackageDescription/Check.hs b/Cabal/Distribution/PackageDescription/Check.hs
index 9127acfb7a9..05147fd67f9 100644
--- a/Cabal/Distribution/PackageDescription/Check.hs
+++ b/Cabal/Distribution/PackageDescription/Check.hs
@@ -55,7 +55,7 @@ import Distribution.License
 import Distribution.Simple.CCompiler
          ( filenameCDialect )
 import Distribution.Simple.Utils
-         ( cabalVersion, intercalate, parseFileGlob, FileGlob(..), lowercase )
+         ( cabalVersion, intercalate, parseFileGlob, isRealGlob, lowercase )
 
 import Distribution.Version
          ( Version(..)
@@ -1098,8 +1098,8 @@ checkCabalVersion pkg =
     dataFilesUsingGlobSyntax     = filter usesGlobSyntax (dataFiles pkg)
     extraSrcFilesUsingGlobSyntax = filter usesGlobSyntax (extraSrcFiles pkg)
     usesGlobSyntax str = case parseFileGlob str of
-      Just (FileGlob _ _) -> True
-      _                   -> False
+      Just g  -> isRealGlob g
+      Nothing -> False
 
     versionRangeExpressions =
         [ dep | dep@(Dependency _ vr) <- buildDepends pkg
diff --git a/Cabal/Distribution/Simple/Utils.hs b/Cabal/Distribution/Simple/Utils.hs
index 4f60b34bfeb..8b494852aa1 100644
--- a/Cabal/Distribution/Simple/Utils.hs
+++ b/Cabal/Distribution/Simple/Utils.hs
@@ -82,7 +82,8 @@ module Distribution.Simple.Utils (
         matchFileGlob,
         matchDirFileGlob,
         parseFileGlob,
-        FileGlob(..),
+        Glob(..),
+        isRealGlob,
 
         -- * modification time
         moreRecentFile,
@@ -156,7 +157,7 @@ import System.Exit
 import System.FilePath
     ( normalise, (</>), (<.>)
     , getSearchPath, joinPath, takeDirectory, splitFileName
-    , splitExtension, splitExtensions, splitDirectories
+    , splitExtension, splitDirectories
     , searchPathSeparator )
 import System.Directory
     ( createDirectory, renameFile, removeDirectoryRecursive )
@@ -199,6 +200,7 @@ import Distribution.Compat.TempFile
 import Distribution.Compat.Exception
          ( tryIO, catchIO, catchExit )
 import Distribution.Verbosity
+import Distribution.Glob
 
 #ifdef VERSION_base
 import qualified Paths_Cabal (version)
@@ -723,43 +725,20 @@ addLibraryPath os paths = addEnv
 ----------------
 -- File globbing
 
-data FileGlob
-   -- | No glob at all, just an ordinary file
-   = NoGlob FilePath
-
-   -- | dir prefix and extension, like @\"foo\/bar\/\*.baz\"@ corresponds to
-   --    @FileGlob \"foo\/bar\" \".baz\"@
-   | FileGlob FilePath String
-
-parseFileGlob :: FilePath -> Maybe FileGlob
-parseFileGlob filepath = case splitExtensions filepath of
-  (filepath', ext) -> case splitFileName filepath' of
-    (dir, "*") | '*' `elem` dir
-              || '*' `elem` ext
-              || null ext            -> Nothing
-               | null dir            -> Just (FileGlob "." ext)
-               | otherwise           -> Just (FileGlob dir ext)
-    _          | '*' `elem` filepath -> Nothing
-               | otherwise           -> Just (NoGlob filepath)
-
 matchFileGlob :: FilePath -> IO [FilePath]
 matchFileGlob = matchDirFileGlob "."
 
 matchDirFileGlob :: FilePath -> FilePath -> IO [FilePath]
 matchDirFileGlob dir filepath = case parseFileGlob filepath of
-  Nothing -> die $ "invalid file glob '" ++ filepath
-                ++ "'. Wildcards '*' are only allowed in place of the file"
-                ++ " name, not in the directory name or file extension."
-                ++ " If a wildcard is used it must be with an file extension."
-  Just (NoGlob filepath') -> return [filepath']
-  Just (FileGlob dir' ext) -> do
-    files <- getDirectoryContents (dir </> dir')
-    case   [ dir' </> file
-           | file <- files
-           , let (name, ext') = splitExtensions file
-           , not (null name) && ext' == ext ] of
-      []      -> die $ "filepath wildcard '" ++ filepath
-                    ++ "' does not match any files."
+  Nothing ->
+    die $ "invalid file glob '" ++ filepath ++ "'."
+  Just (NoGlob filepath') ->
+    return [filepath']
+  Just (Glob glob) -> do
+    files <- getDirectoryContentsRecursive dir
+    case filter (realIsMatch glob) files of
+      [] -> die $ "filepath wildcard '" ++ filepath
+                  ++ "' does not match any files."
       matches -> return matches
 
 --------------------
diff --git a/Cabal/tests/UnitTests.hs b/Cabal/tests/UnitTests.hs
index 6f22262b009..252950f5592 100644
--- a/Cabal/tests/UnitTests.hs
+++ b/Cabal/tests/UnitTests.hs
@@ -8,6 +8,7 @@ import qualified UnitTests.Distribution.Compat.CreatePipe
 import qualified UnitTests.Distribution.Compat.ReadP
 import qualified UnitTests.Distribution.Simple.Program.Internal
 import qualified UnitTests.Distribution.Utils.NubList
+import qualified UnitTests.Distribution.Glob
 
 tests :: TestTree
 tests = testGroup "Unit Tests" $
@@ -19,6 +20,8 @@ tests = testGroup "Unit Tests" $
         UnitTests.Distribution.Simple.Program.Internal.tests
     , testGroup "Distribution.Utils.NubList"
         UnitTests.Distribution.Utils.NubList.tests
+    , testGroup "Distribution.Glob"
+        UnitTests.Distribution.Glob.tests
     ]
 
 main :: IO ()
diff --git a/Cabal/tests/UnitTests/Distribution/Glob.hs b/Cabal/tests/UnitTests/Distribution/Glob.hs
new file mode 100644
index 00000000000..561e804e498
--- /dev/null
+++ b/Cabal/tests/UnitTests/Distribution/Glob.hs
@@ -0,0 +1,233 @@
+module UnitTests.Distribution.Glob
+  ( tests
+  ) where
+
+import Data.Maybe
+    ( isNothing )
+import Distribution.Glob
+import Test.Tasty
+import Test.Tasty.HUnit
+
+data Result
+    = DoesMatch
+    | DoesNotMatch
+    deriving (Show, Eq, Ord)
+
+tests :: [TestTree]
+tests =
+  [ testGroup "Unparseable globs"
+      (map testDoesNotCompile dataDoesNotCompile)
+  , testGroup "Glob matches"
+      (map (testMatches DoesMatch) dataDoesMatch)
+  , testGroup "Glob mismatches"
+      (map (testMatches DoesNotMatch) dataDoesNotMatch)
+  ]
+  where
+  testDoesNotCompile str =
+    testCase str
+      (assertBool "Expected parse to fail"
+        (isNothing (parseFileGlob str)))
+
+  testMatches r (input, expecteds) =
+    case parseFileGlob input of
+      Just glob ->
+        testGroup input (map (testMatch r) (map (\e -> (glob, e)) expecteds))
+      Nothing ->
+        testCase input (assertFailure "Expected parse to succeed")
+
+  testMatch r (glob, filepath) =
+    testCase filepath (assertGlob r)
+    where
+    matchSuccess = isMatch glob filepath
+
+    assertGlob DoesMatch =
+      assertBool "Expected glob to match" matchSuccess
+    assertGlob DoesNotMatch =
+      assertBool "Expected glob to not match" (not matchSuccess)
+
+-- TODO: Test with Unicode filenames.
+
+dataDoesNotCompile :: [String]
+dataDoesNotCompile =
+  [ "{unterminated,"
+  , "[unterminated"
+
+  -- empty choice
+  , "{}"
+
+  -- bad range
+  , "[z-a]"
+
+  -- unescaped "!"
+  , "[abc!]"
+
+  -- unescaped "^"
+  , "[ads^]"
+
+  -- escaped path separator
+  , "hello\\/world"
+
+  -- Path separator in CharList
+  , "[abc/]"
+  , "[\\]"
+  , "[abc\\/]"
+  ]
+
+dataDoesMatch :: [(String, [String])]
+dataDoesMatch =
+  [ ("dictionary.txt",
+      [ "dictionary.txt"
+      ])
+
+  , ("hello/world.txt",
+      [ "hello/world.txt"
+      ])
+
+  , ("hello/world/a.txt",
+      [ "hello/world/a.txt"
+      ])
+
+  , ("[abc]",
+      [ "a"
+      , "b"
+      , "c"
+      ])
+
+  , ("[a-z0-9]",
+      [ "a"
+      , "m"
+      , "y"
+      , "z"
+      , "0"
+      , "5"
+      ])
+
+  , ("[a-z][0-9]",
+      [ "a3"
+      , "m0"
+      , "y9"
+      , "z2"
+      , "a4"
+      , "b8"
+      ])
+
+  , ("hello[wW]orld",
+      [ "helloworld"
+      , "helloWorld"
+      ])
+
+  , ("hello[!AaBb]orld",
+      [ "helloworld"
+      , "helloWorld"
+      ])
+
+  , ("*",
+      [ "hello"
+      , "helloworld"
+      ])
+
+  , ("**",
+      [ "hello"
+      , "helloworld"
+      , "hello/world"
+      ])
+
+  , ("*.hs",
+      [ "foo.hs"
+      , "bar.hs"
+      ])
+
+  , ("Foo*",
+      [ "Foo.hs"
+      , "FooBar.hs"
+      , "Foo"
+      ])
+
+  , ("test/*.hs",
+      [ "test/Foo.hs"
+      , "test/Bar.hs"
+      ])
+
+  , ("test/Foo.*",
+      [ "test/Foo."
+      , "test/Foo.txt"
+      , "test/Foo.hs"
+      ])
+
+  , ("{hello,goodbye}",
+      [ "hello"
+      , "goodbye"
+      ])
+
+  , ("tests/**/*.hs",
+      [ "tests/Foo.hs"
+      , "tests/Foo/Bar.hs"
+      , "tests/Foo/Bar/Baz.hs"
+      ])
+
+  -- Backslash escaping
+  , ("\\[hello\\]",
+      [ "[hello]"
+      ])
+
+  -- Backslash followed by a non-special character (in terms of globbing)
+  -- should be ok
+  , ("he\\ll\\o",
+      [ "hello"
+      ])
+
+  -- choices
+  , ("{a,b,c}",
+      [ "a"
+      , "b"
+      , "c"
+      ])
+
+  , ("hello{world,}",
+      [ "helloworld"
+      , "hello"
+      ])
+  ]
+
+dataDoesNotMatch :: [(String, [String])]
+dataDoesNotMatch =
+  [ ("hello[!Ww]orld",
+      [ "helloWorld"
+      , "helloworld"
+      ])
+
+  , ("[a-z0-9]",
+      [ "a3"
+      , "m0"
+      , "y9"
+      , "z2"
+      , "a4"
+      , "b8"
+      ])
+
+  , ("[a-z][0-9]",
+      [ "a"
+      , "m"
+      , "y"
+      , "z"
+      , "0"
+      , "5"
+      ])
+
+  , ("*.hs",
+      [ ".hs"
+      , ".Foo.hs"
+      , ".hso"
+      , "Foo.hso"
+      ])
+
+  , ("**/*.hs",
+      [ ".hs"
+      , ".Foo.hs"
+      , ".hso"
+      , "Foo.hso"
+      , "Foo/.Bar.hs"
+      , "Foo/.hs"
+      ])
+
+  ]

From 94345910061b314e864c3fe19dce1a3d0656d57c Mon Sep 17 00:00:00 2001
From: Harry Garrood <harry@garrood.me>
Date: Sun, 5 Apr 2015 00:13:21 +0100
Subject: [PATCH 02/10] Tweaks based on PR feedback

* Move Distribution.Glob to Distribution.Utils.Glob
* Add documentation for Distribution.Simple.Utils.matchDirFileGlob
---
 Cabal/Cabal.cabal                            |  8 ++++----
 Cabal/Distribution/Glob.hs                   | 12 ------------
 Cabal/Distribution/Simple/Utils.hs           | 12 +++++++-----
 Cabal/Distribution/Utils/Glob.hs             | 12 ++++++++++++
 Cabal/Distribution/{ => Utils}/Glob/Match.hs |  4 ++--
 Cabal/Distribution/{ => Utils}/Glob/Parse.hs |  4 ++--
 Cabal/Distribution/{ => Utils}/Glob/Type.hs  |  2 +-
 Cabal/tests/UnitTests/Distribution/Glob.hs   |  2 +-
 8 files changed, 29 insertions(+), 27 deletions(-)
 delete mode 100644 Cabal/Distribution/Glob.hs
 create mode 100644 Cabal/Distribution/Utils/Glob.hs
 rename Cabal/Distribution/{ => Utils}/Glob/Match.hs (97%)
 rename Cabal/Distribution/{ => Utils}/Glob/Parse.hs (98%)
 rename Cabal/Distribution/{ => Utils}/Glob/Type.hs (98%)

diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
index 5c0245ff4b1..05c5502bd2d 100644
--- a/Cabal/Cabal.cabal
+++ b/Cabal/Cabal.cabal
@@ -163,7 +163,7 @@ library
     Distribution.Compat.Exception
     Distribution.Compat.ReadP
     Distribution.Compiler
-    Distribution.Glob
+    Distribution.Utils.Glob
     Distribution.InstalledPackageInfo
     Distribution.License
     Distribution.Make
@@ -242,9 +242,9 @@ library
     Distribution.Simple.GHC.IPI641
     Distribution.Simple.GHC.IPI642
     Distribution.Simple.GHC.ImplInfo
-    Distribution.Glob.Type
-    Distribution.Glob.Parse
-    Distribution.Glob.Match
+    Distribution.Utils.Glob.Type
+    Distribution.Utils.Glob.Parse
+    Distribution.Utils.Glob.Match
     Paths_Cabal
 
   if flag(bundled-binary-generic)
diff --git a/Cabal/Distribution/Glob.hs b/Cabal/Distribution/Glob.hs
deleted file mode 100644
index df7e4045fc3..00000000000
--- a/Cabal/Distribution/Glob.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module Distribution.Glob
-  ( Glob(..)
-  , isRealGlob
-  , parseFileGlob
-  , isMatch
-  , realIsMatch
-  )
-  where
-
-import Distribution.Glob.Type
-import Distribution.Glob.Parse
-import Distribution.Glob.Match
diff --git a/Cabal/Distribution/Simple/Utils.hs b/Cabal/Distribution/Simple/Utils.hs
index 8b494852aa1..15ebc53b9eb 100644
--- a/Cabal/Distribution/Simple/Utils.hs
+++ b/Cabal/Distribution/Simple/Utils.hs
@@ -200,7 +200,7 @@ import Distribution.Compat.TempFile
 import Distribution.Compat.Exception
          ( tryIO, catchIO, catchExit )
 import Distribution.Verbosity
-import Distribution.Glob
+import Distribution.Utils.Glob
 
 #ifdef VERSION_base
 import qualified Paths_Cabal (version)
@@ -728,16 +728,18 @@ addLibraryPath os paths = addEnv
 matchFileGlob :: FilePath -> IO [FilePath]
 matchFileGlob = matchDirFileGlob "."
 
-matchDirFileGlob :: FilePath -> FilePath -> IO [FilePath]
-matchDirFileGlob dir filepath = case parseFileGlob filepath of
+-- | Return a list of files matching a glob pattern, relative to a given source
+-- directory. Note that not all the returned files are guaranteed to exist.
+matchDirFileGlob :: FilePath -> String -> IO [FilePath]
+matchDirFileGlob dir pattern = case parseFileGlob pattern of
   Nothing ->
-    die $ "invalid file glob '" ++ filepath ++ "'."
+    die $ "invalid file glob '" ++ pattern ++ "'."
   Just (NoGlob filepath') ->
     return [filepath']
   Just (Glob glob) -> do
     files <- getDirectoryContentsRecursive dir
     case filter (realIsMatch glob) files of
-      [] -> die $ "filepath wildcard '" ++ filepath
+      [] -> die $ "glob pattern '" ++ pattern
                   ++ "' does not match any files."
       matches -> return matches
 
diff --git a/Cabal/Distribution/Utils/Glob.hs b/Cabal/Distribution/Utils/Glob.hs
new file mode 100644
index 00000000000..00647140d42
--- /dev/null
+++ b/Cabal/Distribution/Utils/Glob.hs
@@ -0,0 +1,12 @@
+module Distribution.Utils.Glob
+  ( Glob(..)
+  , isRealGlob
+  , parseFileGlob
+  , isMatch
+  , realIsMatch
+  )
+  where
+
+import Distribution.Utils.Glob.Type
+import Distribution.Utils.Glob.Parse
+import Distribution.Utils.Glob.Match
diff --git a/Cabal/Distribution/Glob/Match.hs b/Cabal/Distribution/Utils/Glob/Match.hs
similarity index 97%
rename from Cabal/Distribution/Glob/Match.hs
rename to Cabal/Distribution/Utils/Glob/Match.hs
index 21f09ea1468..80288d39af7 100644
--- a/Cabal/Distribution/Glob/Match.hs
+++ b/Cabal/Distribution/Utils/Glob/Match.hs
@@ -1,4 +1,4 @@
-module Distribution.Glob.Match where
+module Distribution.Utils.Glob.Match where
 
 import Control.Monad
     ( (>=>) )
@@ -6,7 +6,7 @@ import Data.Maybe
     ( listToMaybe )
 import Data.List
     ( stripPrefix )
-import Distribution.Glob.Type
+import Distribution.Utils.Glob.Type
 
 isMatch :: Glob -> FilePath -> Bool
 isMatch (Glob realGlob) fp = realIsMatch realGlob fp
diff --git a/Cabal/Distribution/Glob/Parse.hs b/Cabal/Distribution/Utils/Glob/Parse.hs
similarity index 98%
rename from Cabal/Distribution/Glob/Parse.hs
rename to Cabal/Distribution/Utils/Glob/Parse.hs
index 38fd759ae50..2ae8e237abe 100644
--- a/Cabal/Distribution/Glob/Parse.hs
+++ b/Cabal/Distribution/Utils/Glob/Parse.hs
@@ -1,9 +1,9 @@
-module Distribution.Glob.Parse where
+module Distribution.Utils.Glob.Parse where
 
 import Control.Monad
     ( unless, liftM2 )
 import Distribution.Compat.ReadP
-import Distribution.Glob.Type
+import Distribution.Utils.Glob.Type
 
 -- | We want to ensure this works the same way on all platforms, so we do not
 -- use System.FilePath here.
diff --git a/Cabal/Distribution/Glob/Type.hs b/Cabal/Distribution/Utils/Glob/Type.hs
similarity index 98%
rename from Cabal/Distribution/Glob/Type.hs
rename to Cabal/Distribution/Utils/Glob/Type.hs
index 1f12270cbc9..09bd77c00da 100644
--- a/Cabal/Distribution/Glob/Type.hs
+++ b/Cabal/Distribution/Utils/Glob/Type.hs
@@ -1,4 +1,4 @@
-module Distribution.Glob.Type where
+module Distribution.Utils.Glob.Type where
 
 -- | A part of a glob. The aim is to be reasonably close to bash; see
 -- http://wiki.bash-hackers.org/syntax/expansion/globs
diff --git a/Cabal/tests/UnitTests/Distribution/Glob.hs b/Cabal/tests/UnitTests/Distribution/Glob.hs
index 561e804e498..6093237a340 100644
--- a/Cabal/tests/UnitTests/Distribution/Glob.hs
+++ b/Cabal/tests/UnitTests/Distribution/Glob.hs
@@ -4,7 +4,7 @@ module UnitTests.Distribution.Glob
 
 import Data.Maybe
     ( isNothing )
-import Distribution.Glob
+import Distribution.Utils.Glob
 import Test.Tasty
 import Test.Tasty.HUnit
 

From 8f2e745e48b152a08c4c585e8a82f8fb0aa8dc59 Mon Sep 17 00:00:00 2001
From: Harry Garrood <harry@garrood.me>
Date: Sun, 5 Apr 2015 01:06:35 +0100
Subject: [PATCH 03/10] Documentation and changelog updates for bash globs

---
 Cabal/changelog                        |  1 +
 Cabal/doc/developing-packages.markdown | 39 +++++++++++++-------------
 2 files changed, 20 insertions(+), 20 deletions(-)

diff --git a/Cabal/changelog b/Cabal/changelog
index e6d1c5e9f6f..cf5bda17795 100644
--- a/Cabal/changelog
+++ b/Cabal/changelog
@@ -2,6 +2,7 @@
 
 1.23.x.x (current development version) 
 	* Deal with extra C sources from preprocessors (#238).
+	* Expand glob syntax to be a subset of that of GNU bash.
 
 1.22.0.0 Johan Tibell <johan.tibell@gmail.com> January 2015
 	* Support GHC 7.10.
diff --git a/Cabal/doc/developing-packages.markdown b/Cabal/doc/developing-packages.markdown
index 12e87059ff0..1e11775e999 100644
--- a/Cabal/doc/developing-packages.markdown
+++ b/Cabal/doc/developing-packages.markdown
@@ -880,27 +880,26 @@ describe the package as a whole:
 `data-files:` _filename list_
 :   A list of files to be installed for run-time use by the package.
     This is useful for packages that use a large amount of static data,
-    such as tables of values  or code templates. Cabal provides a way to
+    such as tables of values or code templates. Cabal provides a way to
     [find these files at
     run-time](#accessing-data-files-from-package-code).
 
-    A limited form of `*` wildcards in file names, for example
-    `data-files: images/*.png` matches all the `.png` files in the
-    `images` directory.
+    A reasonably large subset of bash's glob pattern syntax (with the
+    `globstar` option enabled) is supported. For example:
 
-    The limitation is that `*` wildcards are only allowed in place of
-    the file name, not in the directory name or file extension.  In
-    particular, wildcards do not include directories contents
-    recursively. Furthermore, if a wildcard is used it must be used with
-    an extension, so `data-files: data/*` is not allowed. When matching
-    a wildcard plus extension, a file's full extension must match
-    exactly, so `*.gz` matches `foo.gz` but not `foo.tar.gz`. A wildcard
-    that does not match any files is an error.
+    * `data-files: images/*.png` matches all the `.png` files in the
+      `images` directory.
+    * `data-files: test/**/*.js` matches all the `.js` files recursively
+      in the `test` directory.
+    * `data-files: test/**/*.{html,js}` matches all the `.js` _and_
+      `.html` files recursively in the `test` directory.
 
-    The reason for providing only a very limited form of wildcard is to
-    concisely express the common case of a large number of related files
-    of the same file type without making it too easy to accidentally
-    include unwanted files.
+    The limitation is that `*`/`**` wildcards are not allowed at
+    the very end of the pattern.
+
+    The reason for this limitation is to concisely express the common
+    case of a large number of related files of the same file type without
+    making it too easy to accidentally include unwanted files.
 
 `data-dir:` _directory_
 :   The directory where Cabal looks for data files to install, relative
@@ -910,14 +909,14 @@ describe the package as a whole:
 `extra-source-files:` _filename list_
 :   A list of additional files to be included in source distributions
     built with [`setup sdist`](installing-packages.html#setup-sdist). As
-    with `data-files` it can use a limited form of `*` wildcards in file
-    names.
+    with `data-files` it can use a reasonably large subset of bash's
+    glob syntax in file names.
 
 `extra-doc-files:` _filename list_
 :   A list of additional files to be included in source distributions,
     and also copied to the html directory when Haddock documentation is
-    generated. As with `data-files` it can use a limited form of `*`
-    wildcards in file names.
+    generated. As with `data-files` it can use a reasonably large subset
+    of bash's glob syntax in file names.
 
 `extra-tmp-files:` _filename list_
 :   A list of additional files or directories to be removed by [`setup

From 2bb20faaaa9315e39499292617c2342dd53262c7 Mon Sep 17 00:00:00 2001
From: Harry Garrood <harry@garrood.me>
Date: Sun, 5 Apr 2015 01:25:21 +0100
Subject: [PATCH 04/10] Clearer wording

---
 Cabal/doc/developing-packages.markdown | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Cabal/doc/developing-packages.markdown b/Cabal/doc/developing-packages.markdown
index 1e11775e999..8f80f7d5544 100644
--- a/Cabal/doc/developing-packages.markdown
+++ b/Cabal/doc/developing-packages.markdown
@@ -894,7 +894,7 @@ describe the package as a whole:
     * `data-files: test/**/*.{html,js}` matches all the `.js` _and_
       `.html` files recursively in the `test` directory.
 
-    The limitation is that `*`/`**` wildcards are not allowed at
+    The limitation is that the wildcards `*` and `**` are not allowed at
     the very end of the pattern.
 
     The reason for this limitation is to concisely express the common

From 72d038d1fef1c7a7db4b10042606878b98f3d0c8 Mon Sep 17 00:00:00 2001
From: Harry Garrood <harry@garrood.me>
Date: Sun, 5 Apr 2015 16:42:58 +0100
Subject: [PATCH 05/10] Add missing 'Utils' in UnitTests.Distribution.Glob

---
 Cabal/Cabal.cabal                                      | 2 +-
 Cabal/tests/UnitTests.hs                               | 6 +++---
 Cabal/tests/UnitTests/Distribution/{ => Utils}/Glob.hs | 2 +-
 3 files changed, 5 insertions(+), 5 deletions(-)
 rename Cabal/tests/UnitTests/Distribution/{ => Utils}/Glob.hs (98%)

diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
index 05c5502bd2d..ed05a1d1f17 100644
--- a/Cabal/Cabal.cabal
+++ b/Cabal/Cabal.cabal
@@ -264,7 +264,7 @@ test-suite unit-tests
     UnitTests.Distribution.Compat.ReadP
     UnitTests.Distribution.Simple.Program.Internal
     UnitTests.Distribution.Utils.NubList
-    UnitTests.Distribution.Glob
+    UnitTests.Distribution.Utils.Glob
   main-is: UnitTests.hs
   build-depends:
     base,
diff --git a/Cabal/tests/UnitTests.hs b/Cabal/tests/UnitTests.hs
index 252950f5592..cc8aa1c8bb7 100644
--- a/Cabal/tests/UnitTests.hs
+++ b/Cabal/tests/UnitTests.hs
@@ -8,7 +8,7 @@ import qualified UnitTests.Distribution.Compat.CreatePipe
 import qualified UnitTests.Distribution.Compat.ReadP
 import qualified UnitTests.Distribution.Simple.Program.Internal
 import qualified UnitTests.Distribution.Utils.NubList
-import qualified UnitTests.Distribution.Glob
+import qualified UnitTests.Distribution.Utils.Glob
 
 tests :: TestTree
 tests = testGroup "Unit Tests" $
@@ -20,8 +20,8 @@ tests = testGroup "Unit Tests" $
         UnitTests.Distribution.Simple.Program.Internal.tests
     , testGroup "Distribution.Utils.NubList"
         UnitTests.Distribution.Utils.NubList.tests
-    , testGroup "Distribution.Glob"
-        UnitTests.Distribution.Glob.tests
+    , testGroup "Distribution.Utils.Glob"
+        UnitTests.Distribution.Utils.Glob.tests
     ]
 
 main :: IO ()
diff --git a/Cabal/tests/UnitTests/Distribution/Glob.hs b/Cabal/tests/UnitTests/Distribution/Utils/Glob.hs
similarity index 98%
rename from Cabal/tests/UnitTests/Distribution/Glob.hs
rename to Cabal/tests/UnitTests/Distribution/Utils/Glob.hs
index 6093237a340..82006a83c5e 100644
--- a/Cabal/tests/UnitTests/Distribution/Glob.hs
+++ b/Cabal/tests/UnitTests/Distribution/Utils/Glob.hs
@@ -1,4 +1,4 @@
-module UnitTests.Distribution.Glob
+module UnitTests.Distribution.Utils.Glob
   ( tests
   ) where
 

From 186c3203f0c7f6a32674e77e1635ec71613556e1 Mon Sep 17 00:00:00 2001
From: Harry Garrood <harry@garrood.me>
Date: Sun, 5 Apr 2015 17:02:52 +0100
Subject: [PATCH 06/10] Rename drop1 to tailMay

... and add to Distribution.Utils.Safe
---
 Cabal/Cabal.cabal                      | 1 +
 Cabal/Distribution/Simple/Utils.hs     | 2 ++
 Cabal/Distribution/Utils/Glob/Match.hs | 9 +++------
 Cabal/Distribution/Utils/Safe.hs       | 6 ++++++
 4 files changed, 12 insertions(+), 6 deletions(-)
 create mode 100644 Cabal/Distribution/Utils/Safe.hs

diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
index ed05a1d1f17..953ea23c514 100644
--- a/Cabal/Cabal.cabal
+++ b/Cabal/Cabal.cabal
@@ -245,6 +245,7 @@ library
     Distribution.Utils.Glob.Type
     Distribution.Utils.Glob.Parse
     Distribution.Utils.Glob.Match
+    Distribution.Utils.Safe
     Paths_Cabal
 
   if flag(bundled-binary-generic)
diff --git a/Cabal/Distribution/Simple/Utils.hs b/Cabal/Distribution/Simple/Utils.hs
index 15ebc53b9eb..5ce14c54d10 100644
--- a/Cabal/Distribution/Simple/Utils.hs
+++ b/Cabal/Distribution/Simple/Utils.hs
@@ -128,6 +128,7 @@ module Distribution.Simple.Utils (
         ordNubRight,
         wrapText,
         wrapLine,
+        tailMay,
   ) where
 
 import Control.Monad
@@ -201,6 +202,7 @@ import Distribution.Compat.Exception
          ( tryIO, catchIO, catchExit )
 import Distribution.Verbosity
 import Distribution.Utils.Glob
+import Distribution.Utils.Safe
 
 #ifdef VERSION_base
 import qualified Paths_Cabal (version)
diff --git a/Cabal/Distribution/Utils/Glob/Match.hs b/Cabal/Distribution/Utils/Glob/Match.hs
index 80288d39af7..2cbfe03974d 100644
--- a/Cabal/Distribution/Utils/Glob/Match.hs
+++ b/Cabal/Distribution/Utils/Glob/Match.hs
@@ -6,6 +6,8 @@ import Data.Maybe
     ( listToMaybe )
 import Data.List
     ( stripPrefix )
+import Distribution.Utils.Safe
+    ( tailMay )
 import Distribution.Utils.Glob.Type
 
 isMatch :: Glob -> FilePath -> Bool
@@ -56,7 +58,7 @@ isMatch' startSegment (WildMany : parts) segs
   | otherwise =
     case segs of
       first : rest ->
-        let candidates = map (:rest) (iterateWhile drop1 first)
+        let candidates = map (:rest) (iterateWhile tailMay first)
         in  any (isMatch' False parts) candidates
       [] ->
         isMatch' startSegment parts segs
@@ -84,11 +86,6 @@ charListIsMatch parts c = any (matches c) parts
   matches x (CharLiteral y) = x == y
   matches x (Range start end) = start <= x && x <= end
 
--- | A safe version of 'tail'.
-drop1 :: String -> Maybe String
-drop1 [] = Nothing
-drop1 (_ : tl) = Just tl
-
 -- | Drop one character from a list of path segments, or if the first segment
 -- is empty, move on to the next segment.
 drop1' :: [String] -> Maybe (Bool, [String])
diff --git a/Cabal/Distribution/Utils/Safe.hs b/Cabal/Distribution/Utils/Safe.hs
new file mode 100644
index 00000000000..102ce0f28f0
--- /dev/null
+++ b/Cabal/Distribution/Utils/Safe.hs
@@ -0,0 +1,6 @@
+module Distribution.Utils.Safe where
+
+tailMay :: [a] -> Maybe [a]
+tailMay [] = Nothing
+tailMay (_ : tl) = Just tl
+

From 75a21e8ae3d5c19ee749ba217165ed71a6ccedd7 Mon Sep 17 00:00:00 2001
From: Harry Garrood <harry@garrood.me>
Date: Sun, 5 Apr 2015 17:03:51 +0100
Subject: [PATCH 07/10] Update comment

---
 Cabal/Distribution/Simple/Utils.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Cabal/Distribution/Simple/Utils.hs b/Cabal/Distribution/Simple/Utils.hs
index 5ce14c54d10..e44d7ab3538 100644
--- a/Cabal/Distribution/Simple/Utils.hs
+++ b/Cabal/Distribution/Simple/Utils.hs
@@ -78,7 +78,7 @@ module Distribution.Simple.Utils (
         isInSearchPath,
         addLibraryPath,
 
-        -- * simple file globbing
+        -- * file globbing
         matchFileGlob,
         matchDirFileGlob,
         parseFileGlob,

From 183a0aa39c19bd3751791f237904567a2c20296d Mon Sep 17 00:00:00 2001
From: Harry Garrood <harry@garrood.me>
Date: Sun, 5 Apr 2015 17:49:00 +0100
Subject: [PATCH 08/10] Rename splitOn to endBy

---
 Cabal/Distribution/Utils/Glob/Match.hs | 16 +++++++++-------
 1 file changed, 9 insertions(+), 7 deletions(-)

diff --git a/Cabal/Distribution/Utils/Glob/Match.hs b/Cabal/Distribution/Utils/Glob/Match.hs
index 2cbfe03974d..efb8db4f077 100644
--- a/Cabal/Distribution/Utils/Glob/Match.hs
+++ b/Cabal/Distribution/Utils/Glob/Match.hs
@@ -18,15 +18,17 @@ realIsMatch :: RealGlob -> FilePath -> Bool
 realIsMatch (RealGlob parts) fp = isMatch' True parts (toSegments fp)
 
 toSegments :: FilePath -> [String]
-toSegments = filter (not . null) . splitOn '/'
+toSegments = filter (not . null) . endBy '/'
 
--- Not quite the same as the function from Data.List.Split, but this allows
--- for a simpler implementation
-splitOn :: Eq a => a -> [a] -> [[a]]
-splitOn _ [] = []
-splitOn splitter list =
+-- Not quite the same as the function from Data.List.Split (whose first
+-- argument is a sublist, not a single list element). However, we only need to
+-- split on individual elements here, and this allows for a simpler
+-- implementation.
+endBy :: Eq a => a -> [a] -> [[a]]
+endBy _ [] = []
+endBy splitter list =
   let (next, rest) = span (/= splitter) list
-  in  next : splitOn splitter (drop 1 rest)
+  in  next : endBy splitter (drop 1 rest)
 
 -- | Given:
 -- * A Bool which records whether we are at the beginning of the current

From 87678f0fa13ffeb0b7b1feefa5902d6df0629677 Mon Sep 17 00:00:00 2001
From: Harry Garrood <harry@garrood.me>
Date: Sun, 5 Apr 2015 21:11:39 +0100
Subject: [PATCH 09/10] Revert "Rename drop1 to tailMay"

This reverts commit 186c3203f0c7f6a32674e77e1635ec71613556e1.
---
 Cabal/Cabal.cabal                      | 1 -
 Cabal/Distribution/Simple/Utils.hs     | 2 --
 Cabal/Distribution/Utils/Glob/Match.hs | 9 ++++++---
 Cabal/Distribution/Utils/Safe.hs       | 6 ------
 4 files changed, 6 insertions(+), 12 deletions(-)
 delete mode 100644 Cabal/Distribution/Utils/Safe.hs

diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
index 953ea23c514..ed05a1d1f17 100644
--- a/Cabal/Cabal.cabal
+++ b/Cabal/Cabal.cabal
@@ -245,7 +245,6 @@ library
     Distribution.Utils.Glob.Type
     Distribution.Utils.Glob.Parse
     Distribution.Utils.Glob.Match
-    Distribution.Utils.Safe
     Paths_Cabal
 
   if flag(bundled-binary-generic)
diff --git a/Cabal/Distribution/Simple/Utils.hs b/Cabal/Distribution/Simple/Utils.hs
index e44d7ab3538..4243050c9fa 100644
--- a/Cabal/Distribution/Simple/Utils.hs
+++ b/Cabal/Distribution/Simple/Utils.hs
@@ -128,7 +128,6 @@ module Distribution.Simple.Utils (
         ordNubRight,
         wrapText,
         wrapLine,
-        tailMay,
   ) where
 
 import Control.Monad
@@ -202,7 +201,6 @@ import Distribution.Compat.Exception
          ( tryIO, catchIO, catchExit )
 import Distribution.Verbosity
 import Distribution.Utils.Glob
-import Distribution.Utils.Safe
 
 #ifdef VERSION_base
 import qualified Paths_Cabal (version)
diff --git a/Cabal/Distribution/Utils/Glob/Match.hs b/Cabal/Distribution/Utils/Glob/Match.hs
index efb8db4f077..2f25fd17c1e 100644
--- a/Cabal/Distribution/Utils/Glob/Match.hs
+++ b/Cabal/Distribution/Utils/Glob/Match.hs
@@ -6,8 +6,6 @@ import Data.Maybe
     ( listToMaybe )
 import Data.List
     ( stripPrefix )
-import Distribution.Utils.Safe
-    ( tailMay )
 import Distribution.Utils.Glob.Type
 
 isMatch :: Glob -> FilePath -> Bool
@@ -60,7 +58,7 @@ isMatch' startSegment (WildMany : parts) segs
   | otherwise =
     case segs of
       first : rest ->
-        let candidates = map (:rest) (iterateWhile tailMay first)
+        let candidates = map (:rest) (iterateWhile drop1 first)
         in  any (isMatch' False parts) candidates
       [] ->
         isMatch' startSegment parts segs
@@ -88,6 +86,11 @@ charListIsMatch parts c = any (matches c) parts
   matches x (CharLiteral y) = x == y
   matches x (Range start end) = start <= x && x <= end
 
+-- | A safe version of 'tail'.
+drop1 :: String -> Maybe String
+drop1 [] = Nothing
+drop1 (_ : tl) = Just tl
+
 -- | Drop one character from a list of path segments, or if the first segment
 -- is empty, move on to the next segment.
 drop1' :: [String] -> Maybe (Bool, [String])
diff --git a/Cabal/Distribution/Utils/Safe.hs b/Cabal/Distribution/Utils/Safe.hs
deleted file mode 100644
index 102ce0f28f0..00000000000
--- a/Cabal/Distribution/Utils/Safe.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module Distribution.Utils.Safe where
-
-tailMay :: [a] -> Maybe [a]
-tailMay [] = Nothing
-tailMay (_ : tl) = Just tl
-

From 829ccf371ee44966e8dca2f4155bd9bf3ab53237 Mon Sep 17 00:00:00 2001
From: Harry Garrood <harry@garrood.me>
Date: Sun, 5 Apr 2015 21:50:51 +0100
Subject: [PATCH 10/10] Replace `iterateWhile tailMay` with `tails`

---
 Cabal/Distribution/Utils/Glob/Match.hs | 9 ++-------
 1 file changed, 2 insertions(+), 7 deletions(-)

diff --git a/Cabal/Distribution/Utils/Glob/Match.hs b/Cabal/Distribution/Utils/Glob/Match.hs
index 2f25fd17c1e..f2fe23aec74 100644
--- a/Cabal/Distribution/Utils/Glob/Match.hs
+++ b/Cabal/Distribution/Utils/Glob/Match.hs
@@ -5,7 +5,7 @@ import Control.Monad
 import Data.Maybe
     ( listToMaybe )
 import Data.List
-    ( stripPrefix )
+    ( stripPrefix, tails )
 import Distribution.Utils.Glob.Type
 
 isMatch :: Glob -> FilePath -> Bool
@@ -58,7 +58,7 @@ isMatch' startSegment (WildMany : parts) segs
   | otherwise =
     case segs of
       first : rest ->
-        let candidates = map (:rest) (iterateWhile drop1 first)
+        let candidates = map (:rest) (tails first)
         in  any (isMatch' False parts) candidates
       [] ->
         isMatch' startSegment parts segs
@@ -86,11 +86,6 @@ charListIsMatch parts c = any (matches c) parts
   matches x (CharLiteral y) = x == y
   matches x (Range start end) = start <= x && x <= end
 
--- | A safe version of 'tail'.
-drop1 :: String -> Maybe String
-drop1 [] = Nothing
-drop1 (_ : tl) = Just tl
-
 -- | Drop one character from a list of path segments, or if the first segment
 -- is empty, move on to the next segment.
 drop1' :: [String] -> Maybe (Bool, [String])