{-# LANGUAGE DeriveGeneric #-}

--TODO: [code cleanup] plausibly much of this module should be merged with
-- similar functionality in Cabal.
module Distribution.Client.Glob
    ( FilePathGlob(..)
    , FilePathRoot(..)
    , FilePathGlobRel(..)
    , Glob
    , GlobPiece(..)
    , matchFileGlob
    , matchFileGlobRel
    , matchGlob
    , isTrivialFilePathGlob
    , getFilePathRootDirectory
    ) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Data.List        (stripPrefix)
import System.Directory
import System.FilePath

import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint                as Disp


-- | A file path specified by globbing
--
data FilePathGlob = FilePathGlob FilePathRoot FilePathGlobRel
  deriving (FilePathGlob -> FilePathGlob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilePathGlob -> FilePathGlob -> Bool
$c/= :: FilePathGlob -> FilePathGlob -> Bool
== :: FilePathGlob -> FilePathGlob -> Bool
$c== :: FilePathGlob -> FilePathGlob -> Bool
Eq, Int -> FilePathGlob -> ShowS
[FilePathGlob] -> ShowS
FilePathGlob -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FilePathGlob] -> ShowS
$cshowList :: [FilePathGlob] -> ShowS
show :: FilePathGlob -> FilePath
$cshow :: FilePathGlob -> FilePath
showsPrec :: Int -> FilePathGlob -> ShowS
$cshowsPrec :: Int -> FilePathGlob -> ShowS
Show, forall x. Rep FilePathGlob x -> FilePathGlob
forall x. FilePathGlob -> Rep FilePathGlob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FilePathGlob x -> FilePathGlob
$cfrom :: forall x. FilePathGlob -> Rep FilePathGlob x
Generic)

data FilePathGlobRel
   = GlobDir  !Glob !FilePathGlobRel
   | GlobFile !Glob
   | GlobDirTrailing                -- ^ trailing dir, a glob ending in @/@
  deriving (FilePathGlobRel -> FilePathGlobRel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilePathGlobRel -> FilePathGlobRel -> Bool
$c/= :: FilePathGlobRel -> FilePathGlobRel -> Bool
== :: FilePathGlobRel -> FilePathGlobRel -> Bool
$c== :: FilePathGlobRel -> FilePathGlobRel -> Bool
Eq, Int -> FilePathGlobRel -> ShowS
[FilePathGlobRel] -> ShowS
FilePathGlobRel -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FilePathGlobRel] -> ShowS
$cshowList :: [FilePathGlobRel] -> ShowS
show :: FilePathGlobRel -> FilePath
$cshow :: FilePathGlobRel -> FilePath
showsPrec :: Int -> FilePathGlobRel -> ShowS
$cshowsPrec :: Int -> FilePathGlobRel -> ShowS
Show, forall x. Rep FilePathGlobRel x -> FilePathGlobRel
forall x. FilePathGlobRel -> Rep FilePathGlobRel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FilePathGlobRel x -> FilePathGlobRel
$cfrom :: forall x. FilePathGlobRel -> Rep FilePathGlobRel x
Generic)

-- | A single directory or file component of a globbed path
type Glob = [GlobPiece]

-- | A piece of a globbing pattern
data GlobPiece = WildCard
               | Literal String
               | Union [Glob]
  deriving (GlobPiece -> GlobPiece -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobPiece -> GlobPiece -> Bool
$c/= :: GlobPiece -> GlobPiece -> Bool
== :: GlobPiece -> GlobPiece -> Bool
$c== :: GlobPiece -> GlobPiece -> Bool
Eq, Int -> GlobPiece -> ShowS
Glob -> ShowS
GlobPiece -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: Glob -> ShowS
$cshowList :: Glob -> ShowS
show :: GlobPiece -> FilePath
$cshow :: GlobPiece -> FilePath
showsPrec :: Int -> GlobPiece -> ShowS
$cshowsPrec :: Int -> GlobPiece -> ShowS
Show, forall x. Rep GlobPiece x -> GlobPiece
forall x. GlobPiece -> Rep GlobPiece x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlobPiece x -> GlobPiece
$cfrom :: forall x. GlobPiece -> Rep GlobPiece x
Generic)

data FilePathRoot
   = FilePathRelative
   | FilePathRoot FilePath -- ^ e.g. @"/"@, @"c:\"@ or result of 'takeDrive'
   | FilePathHomeDir
  deriving (FilePathRoot -> FilePathRoot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilePathRoot -> FilePathRoot -> Bool
$c/= :: FilePathRoot -> FilePathRoot -> Bool
== :: FilePathRoot -> FilePathRoot -> Bool
$c== :: FilePathRoot -> FilePathRoot -> Bool
Eq, Int -> FilePathRoot -> ShowS
[FilePathRoot] -> ShowS
FilePathRoot -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FilePathRoot] -> ShowS
$cshowList :: [FilePathRoot] -> ShowS
show :: FilePathRoot -> FilePath
$cshow :: FilePathRoot -> FilePath
showsPrec :: Int -> FilePathRoot -> ShowS
$cshowsPrec :: Int -> FilePathRoot -> ShowS
Show, forall x. Rep FilePathRoot x -> FilePathRoot
forall x. FilePathRoot -> Rep FilePathRoot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FilePathRoot x -> FilePathRoot
$cfrom :: forall x. FilePathRoot -> Rep FilePathRoot x
Generic)

instance Binary FilePathGlob
instance Binary FilePathRoot
instance Binary FilePathGlobRel
instance Binary GlobPiece

instance Structured FilePathGlob
instance Structured FilePathRoot
instance Structured FilePathGlobRel
instance Structured GlobPiece

-- | Check if a 'FilePathGlob' doesn't actually make use of any globbing and
-- is in fact equivalent to a non-glob 'FilePath'.
--
-- If it is trivial in this sense then the result is the equivalent constant
-- 'FilePath'. On the other hand if it is not trivial (so could in principle
-- match more than one file) then the result is @Nothing@.
--
isTrivialFilePathGlob :: FilePathGlob -> Maybe FilePath
isTrivialFilePathGlob :: FilePathGlob -> Maybe FilePath
isTrivialFilePathGlob (FilePathGlob FilePathRoot
root FilePathGlobRel
pathglob) =
    case FilePathRoot
root of
      FilePathRoot
FilePathRelative       -> [FilePath] -> FilePathGlobRel -> Maybe FilePath
go []      FilePathGlobRel
pathglob
      FilePathRoot FilePath
root'     -> [FilePath] -> FilePathGlobRel -> Maybe FilePath
go [FilePath
root'] FilePathGlobRel
pathglob
      FilePathRoot
FilePathHomeDir        -> forall a. Maybe a
Nothing
  where
    go :: [FilePath] -> FilePathGlobRel -> Maybe FilePath
go [FilePath]
paths (GlobDir  [Literal FilePath
path] FilePathGlobRel
globs) = [FilePath] -> FilePathGlobRel -> Maybe FilePath
go (FilePath
pathforall a. a -> [a] -> [a]
:[FilePath]
paths) FilePathGlobRel
globs
    go [FilePath]
paths (GlobFile [Literal FilePath
path]) = forall a. a -> Maybe a
Just ([FilePath] -> FilePath
joinPath (forall a. [a] -> [a]
reverse (FilePath
pathforall a. a -> [a] -> [a]
:[FilePath]
paths)))
    go [FilePath]
paths  FilePathGlobRel
GlobDirTrailing          = forall a. a -> Maybe a
Just (ShowS
addTrailingPathSeparator
                                                 ([FilePath] -> FilePath
joinPath (forall a. [a] -> [a]
reverse [FilePath]
paths)))
    go [FilePath]
_ FilePathGlobRel
_ = forall a. Maybe a
Nothing

-- | Get the 'FilePath' corresponding to a 'FilePathRoot'.
--
-- The 'FilePath' argument is required to supply the path for the
-- 'FilePathRelative' case.
--
getFilePathRootDirectory :: FilePathRoot
                         -> FilePath      -- ^ root for relative paths
                         -> IO FilePath
getFilePathRootDirectory :: FilePathRoot -> FilePath -> IO FilePath
getFilePathRootDirectory  FilePathRoot
FilePathRelative   FilePath
root = forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
root
getFilePathRootDirectory (FilePathRoot FilePath
root) FilePath
_    = forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
root
getFilePathRootDirectory  FilePathRoot
FilePathHomeDir    FilePath
_    = IO FilePath
getHomeDirectory


------------------------------------------------------------------------------
-- Matching
--

-- | Match a 'FilePathGlob' against the file system, starting from a given
-- root directory for relative paths. The results of relative globs are
-- relative to the given root. Matches for absolute globs are absolute.
--
matchFileGlob :: FilePath -> FilePathGlob -> IO [FilePath]
matchFileGlob :: FilePath -> FilePathGlob -> IO [FilePath]
matchFileGlob FilePath
relroot (FilePathGlob FilePathRoot
globroot FilePathGlobRel
glob) = do
    FilePath
root <- FilePathRoot -> FilePath -> IO FilePath
getFilePathRootDirectory FilePathRoot
globroot FilePath
relroot
    [FilePath]
matches <- FilePath -> FilePathGlobRel -> IO [FilePath]
matchFileGlobRel FilePath
root FilePathGlobRel
glob
    case FilePathRoot
globroot of
      FilePathRoot
FilePathRelative -> forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
matches
      FilePathRoot
_                -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map (FilePath
root FilePath -> ShowS
</>) [FilePath]
matches)

-- | Match a 'FilePathGlobRel' against the file system, starting from a
-- given root directory. The results are all relative to the given root.
--
matchFileGlobRel :: FilePath -> FilePathGlobRel -> IO [FilePath]
matchFileGlobRel :: FilePath -> FilePathGlobRel -> IO [FilePath]
matchFileGlobRel FilePath
root FilePathGlobRel
glob0 = FilePathGlobRel -> FilePath -> IO [FilePath]
go FilePathGlobRel
glob0 FilePath
""
  where
    go :: FilePathGlobRel -> FilePath -> IO [FilePath]
go (GlobFile Glob
glob) FilePath
dir = do
      [FilePath]
entries <- FilePath -> IO [FilePath]
getDirectoryContents (FilePath
root FilePath -> ShowS
</> FilePath
dir)
      let files :: [FilePath]
files = forall a. (a -> Bool) -> [a] -> [a]
filter (Glob -> FilePath -> Bool
matchGlob Glob
glob) [FilePath]
entries
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map (FilePath
dir FilePath -> ShowS
</>) [FilePath]
files)

    go (GlobDir Glob
glob FilePathGlobRel
globPath) FilePath
dir = do
      [FilePath]
entries <- FilePath -> IO [FilePath]
getDirectoryContents (FilePath
root FilePath -> ShowS
</> FilePath
dir)
      [FilePath]
subdirs <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\FilePath
subdir -> FilePath -> IO Bool
doesDirectoryExist
                                       (FilePath
root FilePath -> ShowS
</> FilePath
dir FilePath -> ShowS
</> FilePath
subdir))
               forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Glob -> FilePath -> Bool
matchGlob Glob
glob) [FilePath]
entries
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\FilePath
subdir -> FilePathGlobRel -> FilePath -> IO [FilePath]
go FilePathGlobRel
globPath (FilePath
dir FilePath -> ShowS
</> FilePath
subdir)) [FilePath]
subdirs

    go FilePathGlobRel
GlobDirTrailing FilePath
dir = forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
dir]


-- | Match a globbing pattern against a file path component
--
matchGlob :: Glob -> String -> Bool
matchGlob :: Glob -> FilePath -> Bool
matchGlob = Glob -> FilePath -> Bool
goStart
  where
    -- From the man page, glob(7):
    --   "If a filename starts with a '.', this character must be
    --    matched explicitly."

    go, goStart :: [GlobPiece] -> String -> Bool

    goStart :: Glob -> FilePath -> Bool
goStart (GlobPiece
WildCard:Glob
_) (Char
'.':FilePath
_)  = Bool
False
    goStart (Union [Glob]
globs:Glob
rest) FilePath
cs = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Glob
glob -> Glob -> FilePath -> Bool
goStart (Glob
glob forall a. [a] -> [a] -> [a]
++ Glob
rest) FilePath
cs)
                                        [Glob]
globs
    goStart Glob
rest               FilePath
cs = Glob -> FilePath -> Bool
go Glob
rest FilePath
cs

    go :: Glob -> FilePath -> Bool
go []                 FilePath
""    = Bool
True
    go (Literal FilePath
lit:Glob
rest) FilePath
cs
      | Just FilePath
cs' <- forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix FilePath
lit FilePath
cs
                                = Glob -> FilePath -> Bool
go Glob
rest FilePath
cs'
      | Bool
otherwise               = Bool
False
    go [GlobPiece
WildCard]         FilePath
""    = Bool
True
    go (GlobPiece
WildCard:Glob
rest)   (Char
c:FilePath
cs) = Glob -> FilePath -> Bool
go Glob
rest (Char
cforall a. a -> [a] -> [a]
:FilePath
cs) Bool -> Bool -> Bool
|| Glob -> FilePath -> Bool
go (GlobPiece
WildCardforall a. a -> [a] -> [a]
:Glob
rest) FilePath
cs
    go (Union [Glob]
globs:Glob
rest)   FilePath
cs  = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Glob
glob -> Glob -> FilePath -> Bool
go (Glob
glob forall a. [a] -> [a] -> [a]
++ Glob
rest) FilePath
cs) [Glob]
globs
    go []                (Char
_:FilePath
_)  = Bool
False
    go (GlobPiece
_:Glob
_)              FilePath
""    = Bool
False


------------------------------------------------------------------------------
-- Parsing & printing
--

instance Pretty FilePathGlob where
  pretty :: FilePathGlob -> Doc
pretty (FilePathGlob FilePathRoot
root FilePathGlobRel
pathglob) = forall a. Pretty a => a -> Doc
pretty FilePathRoot
root Doc -> Doc -> Doc
Disp.<> forall a. Pretty a => a -> Doc
pretty FilePathGlobRel
pathglob

instance Parsec FilePathGlob where
    parsec :: forall (m :: * -> *). CabalParsing m => m FilePathGlob
parsec = do
        FilePathRoot
root <- forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
        case FilePathRoot
root of
            FilePathRoot
FilePathRelative -> FilePathRoot -> FilePathGlobRel -> FilePathGlob
FilePathGlob FilePathRoot
root forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
            FilePathRoot
_                -> FilePathRoot -> FilePathGlobRel -> FilePathGlob
FilePathGlob FilePathRoot
root forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePathRoot -> FilePathGlobRel -> FilePathGlob
FilePathGlob FilePathRoot
root FilePathGlobRel
GlobDirTrailing)

instance Pretty FilePathRoot where
    pretty :: FilePathRoot -> Doc
pretty  FilePathRoot
FilePathRelative    = Doc
Disp.empty
    pretty (FilePathRoot FilePath
root)  = FilePath -> Doc
Disp.text FilePath
root
    pretty FilePathRoot
FilePathHomeDir      = Char -> Doc
Disp.char Char
'~' Doc -> Doc -> Doc
Disp.<> Char -> Doc
Disp.char Char
'/'

instance Parsec FilePathRoot where
    parsec :: forall (m :: * -> *). CabalParsing m => m FilePathRoot
parsec = m FilePathRoot
root forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Parsing m => m a -> m a
P.try m FilePathRoot
home forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Parsing m => m a -> m a
P.try m FilePathRoot
drive forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePathRoot
FilePathRelative where
        root :: m FilePathRoot
root = FilePath -> FilePathRoot
FilePathRoot FilePath
"/" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'/'
        home :: m FilePathRoot
home = FilePathRoot
FilePathHomeDir forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). CharParsing m => FilePath -> m FilePath
P.string FilePath
"~/"
        drive :: m FilePathRoot
drive = do
            Char
dr <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy forall a b. (a -> b) -> a -> b
$ \Char
c -> (Char
c forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
|| (Char
c forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'Z')
            Char
_ <- forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':'
            Char
_ <- forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'/' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'\\'
            forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePathRoot
FilePathRoot (Char -> Char
toUpper Char
dr forall a. a -> [a] -> [a]
: FilePath
":\\"))

instance Pretty FilePathGlobRel where
    pretty :: FilePathGlobRel -> Doc
pretty (GlobDir  Glob
glob FilePathGlobRel
pathglob) = Glob -> Doc
dispGlob Glob
glob
                            Doc -> Doc -> Doc
Disp.<> Char -> Doc
Disp.char Char
'/'
                            Doc -> Doc -> Doc
Disp.<> forall a. Pretty a => a -> Doc
pretty FilePathGlobRel
pathglob
    pretty (GlobFile Glob
glob)          = Glob -> Doc
dispGlob Glob
glob
    pretty FilePathGlobRel
GlobDirTrailing          = Doc
Disp.empty

instance Parsec FilePathGlobRel where
    parsec :: forall (m :: * -> *). CabalParsing m => m FilePathGlobRel
parsec = forall (m :: * -> *). CabalParsing m => m FilePathGlobRel
parsecPath where
        parsecPath :: CabalParsing m => m FilePathGlobRel
        parsecPath :: forall (m :: * -> *). CabalParsing m => m FilePathGlobRel
parsecPath = do
            Glob
glob <- forall (m :: * -> *). CabalParsing m => m Glob
parsecGlob
            forall (m :: * -> *). CabalParsing m => m ()
dirSep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Glob -> FilePathGlobRel -> FilePathGlobRel
GlobDir Glob
glob forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CabalParsing m => m FilePathGlobRel
parsecPath forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Glob -> FilePathGlobRel -> FilePathGlobRel
GlobDir Glob
glob FilePathGlobRel
GlobDirTrailing)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Glob -> FilePathGlobRel
GlobFile Glob
glob)

        dirSep :: CabalParsing m => m ()
        dirSep :: forall (m :: * -> *). CabalParsing m => m ()
dirSep = () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'/' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Parsing m => m a -> m a
P.try (do
            Char
_ <- forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'\\'
            -- check this isn't an escape code
            forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
P.notFollowedBy (forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy Char -> Bool
isGlobEscapedChar))

dispGlob :: Glob -> Disp.Doc
dispGlob :: Glob -> Doc
dispGlob = [Doc] -> Doc
Disp.hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map GlobPiece -> Doc
dispPiece
  where
    dispPiece :: GlobPiece -> Doc
dispPiece GlobPiece
WildCard      = Char -> Doc
Disp.char Char
'*'
    dispPiece (Literal FilePath
str) = FilePath -> Doc
Disp.text (ShowS
escape FilePath
str)
    dispPiece (Union [Glob]
globs) = Doc -> Doc
Disp.braces
                                ([Doc] -> Doc
Disp.hcat (Doc -> [Doc] -> [Doc]
Disp.punctuate
                                             (Char -> Doc
Disp.char Char
',')
                                             (forall a b. (a -> b) -> [a] -> [b]
map Glob -> Doc
dispGlob [Glob]
globs)))
    escape :: ShowS
escape []               = []
    escape (Char
c:FilePath
cs)
      | Char -> Bool
isGlobEscapedChar Char
c = Char
'\\' forall a. a -> [a] -> [a]
: Char
c forall a. a -> [a] -> [a]
: ShowS
escape FilePath
cs
      | Bool
otherwise           =        Char
c forall a. a -> [a] -> [a]
: ShowS
escape FilePath
cs

parsecGlob :: CabalParsing m => m Glob
parsecGlob :: forall (m :: * -> *). CabalParsing m => m Glob
parsecGlob = forall (f :: * -> *) a. Alternative f => f a -> f [a]
some m GlobPiece
parsecPiece where
    parsecPiece :: m GlobPiece
parsecPiece = forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice [ m GlobPiece
literal, m GlobPiece
wildcard, m GlobPiece
union ]

    wildcard :: m GlobPiece
wildcard = GlobPiece
WildCard forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'*'
    union :: m GlobPiece
union    = [Glob] -> GlobPiece
Union forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
P.between (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'{') (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'}') (forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
P.sepByNonEmpty forall (m :: * -> *). CabalParsing m => m Glob
parsecGlob (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
','))
    literal :: m GlobPiece
literal  = FilePath -> GlobPiece
Literal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some m Char
litchar

    litchar :: m Char
litchar = m Char
normal forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char
escape

    normal :: m Char
normal  = forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy (\Char
c -> Bool -> Bool
not (Char -> Bool
isGlobEscapedChar Char
c) Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'/' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\\')
    escape :: m Char
escape  = forall (m :: * -> *) a. Parsing m => m a -> m a
P.try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy Char -> Bool
isGlobEscapedChar

isGlobEscapedChar :: Char -> Bool
isGlobEscapedChar :: Char -> Bool
isGlobEscapedChar Char
'*'  = Bool
True
isGlobEscapedChar Char
'{'  = Bool
True
isGlobEscapedChar Char
'}'  = Bool
True
isGlobEscapedChar Char
','  = Bool
True
isGlobEscapedChar Char
_    = Bool
False