    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE RankNTypes #-}

    -----------------------------------------------------------------------------
    -- |
    -- 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 (
            GlobSyntaxError(..),
            GlobResult(..),
            matchDirFileGlob,
            matchDirFileGlobWithDie,
            runDirFileGlob,
            fileGlobMatches,
            parseFileGlob,
            explainGlobSyntaxError,
            Glob,
      ) where

    import Prelude ()
    import Distribution.Compat.Prelude

    import Distribution.CabalSpecVersion
    import Distribution.Simple.Utils
    import Distribution.Verbosity

    import System.Directory (getDirectoryContents, doesDirectoryExist, doesFileExist)
    import System.FilePath (joinPath, splitExtensions, splitDirectories, takeFileName, (</>), (<.>))

    import qualified Data.List.NonEmpty as NE

    -- Note throughout that we use splitDirectories, not splitPath. On
    -- Posix, this makes no difference, but, because Windows accepts both
    -- slash and backslash as its path separators, if we left in the
    -- separators from the glob we might not end up properly normalised.

    data GlobResult a
      = GlobMatch a
        -- ^ The glob matched the value supplied.
      | GlobWarnMultiDot a
        -- ^ The glob did not match the value supplied because the
        --   cabal-version is too low and the extensions on the file did
        --   not precisely match the glob's extensions, but rather the
        --   glob was a proper suffix of the file's extensions; i.e., if
        --   not for the low cabal-version, it would have matched.
      | GlobMissingDirectory FilePath
        -- ^ The glob couldn't match because the directory named doesn't
        --   exist. The directory will be as it appears in the glob (i.e.,
        --   relative to the directory passed to 'matchDirFileGlob', and,
        --   for 'data-files', relative to 'data-dir').
      deriving (Int -> GlobResult a -> ShowS
    [GlobResult a] -> ShowS
    GlobResult a -> String
    (Int -> GlobResult a -> ShowS)
    -> (GlobResult a -> String)
    -> ([GlobResult a] -> ShowS)
    -> Show (GlobResult a)
    forall a. Show a => Int -> GlobResult a -> ShowS
    forall a. Show a => [GlobResult a] -> ShowS
    forall a. Show a => GlobResult a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [GlobResult a] -> ShowS
    $cshowList :: forall a. Show a => [GlobResult a] -> ShowS
    show :: GlobResult a -> String
    $cshow :: forall a. Show a => GlobResult a -> String
    showsPrec :: Int -> GlobResult a -> ShowS
    $cshowsPrec :: forall a. Show a => Int -> GlobResult a -> ShowS
    Show, GlobResult a -> GlobResult a -> Bool
    (GlobResult a -> GlobResult a -> Bool)
    -> (GlobResult a -> GlobResult a -> Bool) -> Eq (GlobResult a)
    forall a. Eq a => GlobResult a -> GlobResult a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: GlobResult a -> GlobResult a -> Bool
    $c/= :: forall a. Eq a => GlobResult a -> GlobResult a -> Bool
    == :: GlobResult a -> GlobResult a -> Bool
    $c== :: forall a. Eq a => GlobResult a -> GlobResult a -> Bool
    Eq, Eq (GlobResult a)
    Eq (GlobResult a)
    -> (GlobResult a -> GlobResult a -> Ordering)
    -> (GlobResult a -> GlobResult a -> Bool)
    -> (GlobResult a -> GlobResult a -> Bool)
    -> (GlobResult a -> GlobResult a -> Bool)
    -> (GlobResult a -> GlobResult a -> Bool)
    -> (GlobResult a -> GlobResult a -> GlobResult a)
    -> (GlobResult a -> GlobResult a -> GlobResult a)
    -> Ord (GlobResult a)
    GlobResult a -> GlobResult a -> Bool
    GlobResult a -> GlobResult a -> Ordering
    GlobResult a -> GlobResult a -> GlobResult a
    forall a.
    Eq a
    -> (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    forall {a}. Ord a => Eq (GlobResult a)
    forall a. Ord a => GlobResult a -> GlobResult a -> Bool
    forall a. Ord a => GlobResult a -> GlobResult a -> Ordering
    forall a. Ord a => GlobResult a -> GlobResult a -> GlobResult a
    min :: GlobResult a -> GlobResult a -> GlobResult a
    $cmin :: forall a. Ord a => GlobResult a -> GlobResult a -> GlobResult a
    max :: GlobResult a -> GlobResult a -> GlobResult a
    $cmax :: forall a. Ord a => GlobResult a -> GlobResult a -> GlobResult a
    >= :: GlobResult a -> GlobResult a -> Bool
    $c>= :: forall a. Ord a => GlobResult a -> GlobResult a -> Bool
    > :: GlobResult a -> GlobResult a -> Bool
    $c> :: forall a. Ord a => GlobResult a -> GlobResult a -> Bool
    <= :: GlobResult a -> GlobResult a -> Bool
    $c<= :: forall a. Ord a => GlobResult a -> GlobResult a -> Bool
    < :: GlobResult a -> GlobResult a -> Bool
    $c< :: forall a. Ord a => GlobResult a -> GlobResult a -> Bool
    compare :: GlobResult a -> GlobResult a -> Ordering
    $ccompare :: forall a. Ord a => GlobResult a -> GlobResult a -> Ordering
    Ord, (forall a b. (a -> b) -> GlobResult a -> GlobResult b)
    -> (forall a b. a -> GlobResult b -> GlobResult a)
    -> Functor GlobResult
    forall a b. a -> GlobResult b -> GlobResult a
    forall a b. (a -> b) -> GlobResult a -> GlobResult b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    <$ :: forall a b. a -> GlobResult b -> GlobResult a
    $c<$ :: forall a b. a -> GlobResult b -> GlobResult a
    fmap :: forall a b. (a -> b) -> GlobResult a -> GlobResult b
    $cfmap :: forall a b. (a -> b) -> GlobResult a -> GlobResult b
    Functor)

    -- | 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.
    globMatches :: [GlobResult a] -> [a]
    globMatches :: forall a. [GlobResult a] -> [a]
    globMatches [GlobResult a]
    input = [ a
    a | GlobMatch a
    a <- [GlobResult a]
    input ]

    data GlobSyntaxError
      = StarInDirectory
      | StarInFileName
      | StarInExtension
      | NoExtensionOnStar
      | EmptyGlob
      | LiteralFileNameGlobStar
      | VersionDoesNotSupportGlobStar
      | VersionDoesNotSupportGlob
      deriving (GlobSyntaxError -> GlobSyntaxError -> Bool
    (GlobSyntaxError -> GlobSyntaxError -> Bool)
    -> (GlobSyntaxError -> GlobSyntaxError -> Bool)
    -> Eq GlobSyntaxError
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: GlobSyntaxError -> GlobSyntaxError -> Bool
    $c/= :: GlobSyntaxError -> GlobSyntaxError -> Bool
    == :: GlobSyntaxError -> GlobSyntaxError -> Bool
    $c== :: GlobSyntaxError -> GlobSyntaxError -> Bool
    Eq, Int -> GlobSyntaxError -> ShowS
    [GlobSyntaxError] -> ShowS
    GlobSyntaxError -> String
    (Int -> GlobSyntaxError -> ShowS)
    -> (GlobSyntaxError -> String)
    -> ([GlobSyntaxError] -> ShowS)
    -> Show GlobSyntaxError
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [GlobSyntaxError] -> ShowS
    $cshowList :: [GlobSyntaxError] -> ShowS
    show :: GlobSyntaxError -> String
    $cshow :: GlobSyntaxError -> String
    showsPrec :: Int -> GlobSyntaxError -> ShowS
    $cshowsPrec :: Int -> GlobSyntaxError -> ShowS
    Show)

    explainGlobSyntaxError :: FilePath -> GlobSyntaxError -> String
    explainGlobSyntaxError :: String -> GlobSyntaxError -> String
    explainGlobSyntaxError String
    filepath GlobSyntaxError
    StarInDirectory =
         String
    "invalid file glob '" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    filepath
      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'. A wildcard '**' is only allowed as the final parent"
      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " directory. Stars must not otherwise appear in the parent"
      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " directories."
    explainGlobSyntaxError String
    filepath GlobSyntaxError
    StarInExtension =
         String
    "invalid file glob '" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    filepath
      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'. Wildcards '*' are only allowed as the"
      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " file's base name, not in the file extension."
    explainGlobSyntaxError String
    filepath GlobSyntaxError
    StarInFileName =
         String
    "invalid file glob '" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    filepath
      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'. Wildcards '*' may only totally replace the"
      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " file's base name, not only parts of it."
    explainGlobSyntaxError String
    filepath GlobSyntaxError
    NoExtensionOnStar =
         String
    "invalid file glob '" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    filepath
      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'. If a wildcard '*' is used it must be with an file extension."
    explainGlobSyntaxError String
    filepath GlobSyntaxError
    LiteralFileNameGlobStar =
         String
    "invalid file glob '" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    filepath
      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'. If a wildcard '**' is used as a parent directory, the"
      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " file's base name must be a wildcard '*'."
    explainGlobSyntaxError String
    _ GlobSyntaxError
    EmptyGlob =
         String
    "invalid file glob. A glob cannot be the empty string."
    explainGlobSyntaxError String
    filepath GlobSyntaxError
    VersionDoesNotSupportGlobStar =
         String
    "invalid file glob '" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    filepath
      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'. Using the double-star syntax requires 'cabal-version: 2.4'"
      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " or greater. Alternatively, for compatibility with earlier Cabal"
      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " versions, list the included directories explicitly."
    explainGlobSyntaxError String
    filepath GlobSyntaxError
    VersionDoesNotSupportGlob =
         String
    "invalid file glob '" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    filepath
      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'. Using star wildcards requires 'cabal-version: >= 1.6'. "
      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "Alternatively if you require compatibility with earlier Cabal "
      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "versions then list all the files explicitly."

    data IsRecursive = Recursive | NonRecursive

    data MultiDot = MultiDotDisabled | MultiDotEnabled

    data Glob
      = GlobStem FilePath Glob
        -- ^ A single subdirectory component + remainder.
      | GlobFinal GlobFinal

    data GlobFinal
      = FinalMatch IsRecursive MultiDot String
        -- ^ First argument: Is this a @**/*.ext@ pattern?
        --   Second argument: should we match against the exact extensions, or accept a suffix?
        --   Third argument: the extensions to accept.
      | FinalLit FilePath
        -- ^ Literal file name.

    reconstructGlob :: Glob -> FilePath
    reconstructGlob :: Glob -> String
    reconstructGlob (GlobStem String
    dir Glob
    glob) =
      String
    dir String -> ShowS
    </> Glob -> String
    reconstructGlob Glob
    glob
    reconstructGlob (GlobFinal GlobFinal
    final) = case GlobFinal
    final of
      FinalMatch IsRecursive
    Recursive MultiDot
    _ String
    exts -> String
    "**" String -> ShowS
    </> String
    "*" String -> ShowS
    <.> String
    exts
      FinalMatch IsRecursive
    NonRecursive MultiDot
    _ String
    exts -> String
    "*" String -> ShowS
    <.> String
    exts
      FinalLit String
    path -> String
    path

    -- | Returns 'Nothing' if the glob didn't match at all, or 'Just' the
    --   result if the glob matched (or would have matched with a higher
    --   cabal-version).
    fileGlobMatches :: Glob -> FilePath -> Maybe (GlobResult FilePath)
    fileGlobMatches :: Glob -> String -> Maybe (GlobResult String)
    fileGlobMatches Glob
    pat String
    candidate = do
      GlobResult ()
    match <- Glob -> [String] -> Maybe (GlobResult ())
    fileGlobMatchesSegments Glob
    pat (String -> [String]
    splitDirectories String
    candidate)
      GlobResult String -> Maybe (GlobResult String)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    candidate String -> GlobResult () -> GlobResult String
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ GlobResult ()
    match)

    fileGlobMatchesSegments :: Glob -> [FilePath] -> Maybe (GlobResult ())
    fileGlobMatchesSegments :: Glob -> [String] -> Maybe (GlobResult ())
    fileGlobMatchesSegments Glob
    _ [] = Maybe (GlobResult ())
    forall a. Maybe a
    Nothing
    fileGlobMatchesSegments Glob
    pat (String
    seg : [String]
    segs) = case Glob
    pat of
      GlobStem String
    dir Glob
    pat' -> do
        Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (String
    dir String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    seg)
        Glob -> [String] -> Maybe (GlobResult ())
    fileGlobMatchesSegments Glob
    pat' [String]
    segs
      GlobFinal GlobFinal
    final -> case GlobFinal
    final of
        FinalMatch IsRecursive
    Recursive MultiDot
    multidot String
    ext -> do
          let (String
    candidateBase, String
    candidateExts) = String -> (String, String)
    splitExtensions (NonEmpty String -> String
    forall a. NonEmpty a -> a
    NE.last (NonEmpty String -> String) -> NonEmpty String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    segString -> [String] -> NonEmpty String
    forall a. a -> [a] -> NonEmpty a
    :|[String]
    segs)
          Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Bool
    not (String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    candidateBase))
          MultiDot -> String -> String -> Maybe (GlobResult ())
    checkExt MultiDot
    multidot String
    ext String
    candidateExts
        FinalMatch IsRecursive
    NonRecursive MultiDot
    multidot String
    ext -> do
          let (String
    candidateBase, String
    candidateExts) = String -> (String, String)
    splitExtensions String
    seg
          Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard ([String] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    segs Bool -> Bool -> Bool
    && Bool -> Bool
    not (String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    candidateBase))
          MultiDot -> String -> String -> Maybe (GlobResult ())
    checkExt MultiDot
    multidot String
    ext String
    candidateExts
        FinalLit String
    filename -> do
          Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard ([String] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    segs Bool -> Bool -> Bool
    && String
    filename String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    seg)
          GlobResult () -> Maybe (GlobResult ())
    forall (m :: * -> *) a. Monad m => a -> m a
    return (() -> GlobResult ()
    forall a. a -> GlobResult a
    GlobMatch ())

    checkExt
      :: MultiDot
      -> String -- ^ The pattern's extension
      -> String -- ^ The candidate file's extension
      -> Maybe (GlobResult ())
    checkExt :: MultiDot -> String -> String -> Maybe (GlobResult ())
    checkExt MultiDot
    multidot String
    ext String
    candidate
      | String
    ext String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    candidate = GlobResult () -> Maybe (GlobResult ())
    forall a. a -> Maybe a
    Just (() -> GlobResult ()
    forall a. a -> GlobResult a
    GlobMatch ())
      | String
    ext String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` String
    candidate = case MultiDot
    multidot of
          MultiDot
    MultiDotDisabled -> GlobResult () -> Maybe (GlobResult ())
    forall a. a -> Maybe a
    Just (() -> GlobResult ()
    forall a. a -> GlobResult a
    GlobWarnMultiDot ())
          MultiDot
    MultiDotEnabled -> GlobResult () -> Maybe (GlobResult ())
    forall a. a -> Maybe a
    Just (() -> GlobResult ()
    forall a. a -> GlobResult a
    GlobMatch ())
      | Bool
    otherwise = Maybe (GlobResult ())
    forall a. Maybe a
    Nothing

    parseFileGlob :: CabalSpecVersion -> FilePath -> Either GlobSyntaxError Glob
    parseFileGlob :: CabalSpecVersion -> String -> Either GlobSyntaxError Glob
    parseFileGlob CabalSpecVersion
    version String
    filepath = case [String] -> [String]
    forall a. [a] -> [a]
    reverse (String -> [String]
    splitDirectories String
    filepath) of
      [] ->
            GlobSyntaxError -> Either GlobSyntaxError Glob
    forall a b. a -> Either a b
    Left GlobSyntaxError
    EmptyGlob
      (String
    filename : String
    "**" : [String]
    segments)
        | Bool
    allowGlobStar -> do
            String
    ext <- case String -> (String, String)
    splitExtensions String
    filename of
              (String
    "*", String
    ext) | Char
    '*' Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    ext -> GlobSyntaxError -> Either GlobSyntaxError String
    forall a b. a -> Either a b
    Left GlobSyntaxError
    StarInExtension
                         | String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    ext       -> GlobSyntaxError -> Either GlobSyntaxError String
    forall a b. a -> Either a b
    Left GlobSyntaxError
    NoExtensionOnStar
                         | Bool
    otherwise      -> String -> Either GlobSyntaxError String
    forall a b. b -> Either a b
    Right String
    ext
              (String, String)
    _                           -> GlobSyntaxError -> Either GlobSyntaxError String
    forall a b. a -> Either a b
    Left GlobSyntaxError
    LiteralFileNameGlobStar
            (Glob -> String -> Either GlobSyntaxError Glob)
    -> Glob -> [String] -> Either GlobSyntaxError Glob
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM Glob -> String -> Either GlobSyntaxError Glob
    addStem (GlobFinal -> Glob
    GlobFinal (GlobFinal -> Glob) -> GlobFinal -> Glob
    forall a b. (a -> b) -> a -> b
    $ IsRecursive -> MultiDot -> String -> GlobFinal
    FinalMatch IsRecursive
    Recursive MultiDot
    multidot String
    ext) [String]
    segments
        | Bool
    otherwise -> GlobSyntaxError -> Either GlobSyntaxError Glob
    forall a b. a -> Either a b
    Left GlobSyntaxError
    VersionDoesNotSupportGlobStar
      (String
    filename : [String]
    segments) -> do
            GlobFinal
    pat <- case String -> (String, String)
    splitExtensions String
    filename of
              (String
    "*", String
    ext) | Bool -> Bool
    not Bool
    allowGlob       -> GlobSyntaxError -> Either GlobSyntaxError GlobFinal
    forall a b. a -> Either a b
    Left GlobSyntaxError
    VersionDoesNotSupportGlob
                         | Char
    '*' Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    ext      -> GlobSyntaxError -> Either GlobSyntaxError GlobFinal
    forall a b. a -> Either a b
    Left GlobSyntaxError
    StarInExtension
                         | String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    ext            -> GlobSyntaxError -> Either GlobSyntaxError GlobFinal
    forall a b. a -> Either a b
    Left GlobSyntaxError
    NoExtensionOnStar
                         | Bool
    otherwise           -> GlobFinal -> Either GlobSyntaxError GlobFinal
    forall a b. b -> Either a b
    Right (IsRecursive -> MultiDot -> String -> GlobFinal
    FinalMatch IsRecursive
    NonRecursive MultiDot
    multidot String
    ext)
              (String
    _, String
    ext)   | Char
    '*' Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    ext      -> GlobSyntaxError -> Either GlobSyntaxError GlobFinal
    forall a b. a -> Either a b
    Left GlobSyntaxError
    StarInExtension
                         | Char
    '*' Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    filename -> GlobSyntaxError -> Either GlobSyntaxError GlobFinal
    forall a b. a -> Either a b
    Left GlobSyntaxError
    StarInFileName
                         | Bool
    otherwise           -> GlobFinal -> Either GlobSyntaxError GlobFinal
    forall a b. b -> Either a b
    Right (String -> GlobFinal
    FinalLit String
    filename)
            (Glob -> String -> Either GlobSyntaxError Glob)
    -> Glob -> [String] -> Either GlobSyntaxError Glob
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM Glob -> String -> Either GlobSyntaxError Glob
    addStem (GlobFinal -> Glob
    GlobFinal GlobFinal
    pat) [String]
    segments
      where
        allowGlob :: Bool
    allowGlob     = CabalSpecVersion
    version CabalSpecVersion -> CabalSpecVersion -> Bool
    forall a. Ord a => a -> a -> Bool
    >= CabalSpecVersion
    CabalSpecV1_6
        allowGlobStar :: Bool
    allowGlobStar = CabalSpecVersion
    version CabalSpecVersion -> CabalSpecVersion -> Bool
    forall a. Ord a => a -> a -> Bool
    >= CabalSpecVersion
    CabalSpecV2_4
        addStem :: Glob -> String -> Either GlobSyntaxError Glob
    addStem Glob
    pat String
    seg
          | Char
    '*' Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    seg = GlobSyntaxError -> Either GlobSyntaxError Glob
    forall a b. a -> Either a b
    Left GlobSyntaxError
    StarInDirectory
          | Bool
    otherwise      = Glob -> Either GlobSyntaxError Glob
    forall a b. b -> Either a b
    Right (String -> Glob -> Glob
    GlobStem String
    seg Glob
    pat)
        multidot :: MultiDot
    multidot
          | CabalSpecVersion
    version CabalSpecVersion -> CabalSpecVersion -> Bool
    forall a. Ord a => a -> a -> Bool
    >= CabalSpecVersion
    CabalSpecV2_4 = MultiDot
    MultiDotEnabled
          | Bool
    otherwise                = MultiDot
    MultiDotDisabled

    -- | 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 -> String -> String -> IO [String]
    matchDirFileGlob Verbosity
    v = Verbosity
    -> (Verbosity -> String -> IO [String])
    -> CabalSpecVersion
    -> String
    -> String
    -> IO [String]
    matchDirFileGlobWithDie Verbosity
    v Verbosity -> String -> IO [String]
    forall a. Verbosity -> String -> IO a
    die'

    -- | Like 'matchDirFileGlob' but with customizable 'die'
    --
    -- @since 3.6.0.0
    --
    matchDirFileGlobWithDie :: Verbosity -> (Verbosity -> String -> IO [FilePath]) -> CabalSpecVersion -> FilePath -> FilePath -> IO [FilePath]
    matchDirFileGlobWithDie :: Verbosity
    -> (Verbosity -> String -> IO [String])
    -> CabalSpecVersion
    -> String
    -> String
    -> IO [String]
    matchDirFileGlobWithDie Verbosity
    verbosity Verbosity -> String -> IO [String]
    rip CabalSpecVersion
    version String
    dir String
    filepath = case CabalSpecVersion -> String -> Either GlobSyntaxError Glob
    parseFileGlob CabalSpecVersion
    version String
    filepath of
      Left GlobSyntaxError
    err -> Verbosity -> String -> IO [String]
    rip Verbosity
    verbosity (String -> IO [String]) -> String -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ String -> GlobSyntaxError -> String
    explainGlobSyntaxError String
    filepath GlobSyntaxError
    err
      Right Glob
    glob -> do
        [GlobResult String]
    results <- Verbosity -> String -> Glob -> IO [GlobResult String]
    runDirFileGlob Verbosity
    verbosity String
    dir Glob
    glob
        let missingDirectories :: [String]
    missingDirectories =
              [ String
    missingDir | GlobMissingDirectory String
    missingDir <- [GlobResult String]
    results ]
            matches :: [String]
    matches = [GlobResult String] -> [String]
    forall a. [GlobResult a] -> [a]
    globMatches [GlobResult String]
    results

        let errors :: [String]
            errors :: [String]
    errors =
                [ String
    "filepath wildcard '" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    filepath String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "' refers to the directory"
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " '" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    missingDir String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "', which does not exist or is not a directory."
                | String
    missingDir <- [String]
    missingDirectories
                ]
                [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
                [ String
    "filepath wildcard '" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    filepath String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "' does not match any files."
                | [String] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    matches
                ]

        if [String] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    errors
        then [String] -> IO [String]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String]
    matches
        else Verbosity -> String -> IO [String]
    rip Verbosity
    verbosity (String -> IO [String]) -> String -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines [String]
    errors

    -- | Match files against a pre-parsed glob, starting in a directory.
    --
    -- The 'Version' argument must be the spec version of the package
    -- description being processed, as globs behave slightly differently
    -- in different spec versions.
    --
    -- The '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.
    runDirFileGlob :: Verbosity -> FilePath -> Glob -> IO [GlobResult FilePath]
    runDirFileGlob :: Verbosity -> String -> Glob -> IO [GlobResult String]
    runDirFileGlob Verbosity
    verbosity String
    rawDir Glob
    pat = do
      -- The default data-dir is null. Our callers -should- be
      -- converting that to '.' themselves, but it's a certainty that
      -- some future call-site will forget and trigger a really
      -- hard-to-debug failure if we don't check for that here.
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    rawDir) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        Verbosity -> String -> IO ()
    warn Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $
             String
    "Null dir passed to runDirFileGlob; interpreting it "
          String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "as '.'. This is probably an internal error."
      let dir :: String
    dir = if String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    rawDir then String
    "." else String
    rawDir
      Verbosity -> String -> IO ()
    debug Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Expanding glob '" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Glob -> String
    reconstructGlob Glob
    pat String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "' in directory '" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    dir String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'."
      -- This function might be called from the project root with dir as
      -- ".". Walking the tree starting there involves going into .git/
      -- and dist-newstyle/, which is a lot of work for no reward, so
      -- extract the constant prefix from the pattern and start walking
      -- there, and only walk as much as we need to: recursively if **,
      -- the whole directory if *, and just the specific file if it's a
      -- literal.
      let ([String]
    prefixSegments, GlobFinal
    final) = Glob -> ([String], GlobFinal)
    splitConstantPrefix Glob
    pat
          joinedPrefix :: String
    joinedPrefix = [String] -> String
    joinPath [String]
    prefixSegments
      case GlobFinal
    final of
        FinalMatch IsRecursive
    recursive MultiDot
    multidot String
    exts -> do
          let prefix :: String
    prefix = String
    dir String -> ShowS
    </> String
    joinedPrefix
          Bool
    directoryExists <- String -> IO Bool
    doesDirectoryExist String
    prefix
          if Bool
    directoryExists
            then do
              [String]
    candidates <- case IsRecursive
    recursive of
                IsRecursive
    Recursive -> String -> IO [String]
    getDirectoryContentsRecursive String
    prefix
                IsRecursive
    NonRecursive -> (String -> IO Bool) -> [String] -> IO [String]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM (String -> IO Bool
    doesFileExist (String -> IO Bool) -> ShowS -> String -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    prefix String -> ShowS
    </>)) ([String] -> IO [String]) -> IO [String] -> IO [String]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String -> IO [String]
    getDirectoryContents String
    prefix
              let checkName :: String -> Maybe (GlobResult String)
    checkName String
    candidate = do
                    let (String
    candidateBase, String
    candidateExts) = String -> (String, String)
    splitExtensions (String -> (String, String)) -> String -> (String, String)
    forall a b. (a -> b) -> a -> b
    $ ShowS
    takeFileName String
    candidate
                    Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Bool
    not (String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    candidateBase))
                    GlobResult ()
    match <- MultiDot -> String -> String -> Maybe (GlobResult ())
    checkExt MultiDot
    multidot String
    exts String
    candidateExts
                    GlobResult String -> Maybe (GlobResult String)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    joinedPrefix String -> ShowS
    </> String
    candidate String -> GlobResult () -> GlobResult String
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ GlobResult ()
    match)
              [GlobResult String] -> IO [GlobResult String]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([GlobResult String] -> IO [GlobResult String])
    -> [GlobResult String] -> IO [GlobResult String]
    forall a b. (a -> b) -> a -> b
    $ (String -> Maybe (GlobResult String))
    -> [String] -> [GlobResult String]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe String -> Maybe (GlobResult String)
    checkName [String]
    candidates
            else
              [GlobResult String] -> IO [GlobResult String]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ String -> GlobResult String
    forall a. String -> GlobResult a
    GlobMissingDirectory String
    joinedPrefix ]
        FinalLit String
    fn -> do
          Bool
    exists <- String -> IO Bool
    doesFileExist (String
    dir String -> ShowS
    </> String
    joinedPrefix String -> ShowS
    </> String
    fn)
          [GlobResult String] -> IO [GlobResult String]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ String -> GlobResult String
    forall a. a -> GlobResult a
    GlobMatch (String
    joinedPrefix String -> ShowS
    </> String
    fn) | Bool
    exists ]

    unfoldr' :: (a -> Either r (b, a)) -> a -> ([b], r)
    unfoldr' :: forall a r b. (a -> Either r (b, a)) -> a -> ([b], r)
    unfoldr' a -> Either r (b, a)
    f a
    a = case a -> Either r (b, a)
    f a
    a of
      Left r
    r -> ([], r
    r)
      Right (b
    b, a
    a') -> case (a -> Either r (b, a)) -> a -> ([b], r)
    forall a r b. (a -> Either r (b, a)) -> a -> ([b], r)
    unfoldr' a -> Either r (b, a)
    f a
    a' of
        ([b]
    bs, r
    r) -> (b
    b b -> [b] -> [b]
    forall a. a -> [a] -> [a]
    : [b]
    bs, r
    r)

    -- | Extract the (possibly null) constant prefix from the pattern.
    -- This has the property that, if @(pref, final) = splitConstantPrefix pat@,
    -- then @pat === foldr GlobStem (GlobFinal final) pref@.
    splitConstantPrefix :: Glob -> ([FilePath], GlobFinal)
    splitConstantPrefix :: Glob -> ([String], GlobFinal)
    splitConstantPrefix = (Glob -> Either GlobFinal (String, Glob))
    -> Glob -> ([String], GlobFinal)
    forall a r b. (a -> Either r (b, a)) -> a -> ([b], r)
    unfoldr' Glob -> Either GlobFinal (String, Glob)
    step
      where
        step :: Glob -> Either GlobFinal (String, Glob)
    step (GlobStem String
    seg Glob
    pat) = (String, Glob) -> Either GlobFinal (String, Glob)
    forall a b. b -> Either a b
    Right (String
    seg, Glob
    pat)
        step (GlobFinal GlobFinal
    pat) = GlobFinal -> Either GlobFinal (String, Glob)
    forall a b. a -> Either a b
    Left GlobFinal
    pat