module Cabal.Internal.Glob where
import Control.Applicative (some, (<|>))
import Control.Monad (filterM, void)
import Data.Char (isAsciiLower, isAsciiUpper, toUpper)
import Data.Foldable (toList)
import Data.List (stripPrefix)
import Distribution.Parsec (CabalParsing, Parsec (..))
import Distribution.Pretty (Pretty (..))
import System.Directory (doesDirectoryExist, getDirectoryContents, getHomeDirectory)
import System.FilePath.Posix (addTrailingPathSeparator, joinPath, (</>))
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as Disp
data FilePathGlob = FilePathGlob FilePathRoot FilePathGlobRel
deriving (FilePathGlob -> FilePathGlob -> Bool
(FilePathGlob -> FilePathGlob -> Bool)
-> (FilePathGlob -> FilePathGlob -> Bool) -> Eq FilePathGlob
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 -> String
(Int -> FilePathGlob -> ShowS)
-> (FilePathGlob -> String)
-> ([FilePathGlob] -> ShowS)
-> Show FilePathGlob
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilePathGlob] -> ShowS
$cshowList :: [FilePathGlob] -> ShowS
show :: FilePathGlob -> String
$cshow :: FilePathGlob -> String
showsPrec :: Int -> FilePathGlob -> ShowS
$cshowsPrec :: Int -> FilePathGlob -> ShowS
Show)
data FilePathGlobRel
= GlobDir !Glob !FilePathGlobRel
| GlobFile !Glob
| GlobDirTrailing
deriving (FilePathGlobRel -> FilePathGlobRel -> Bool
(FilePathGlobRel -> FilePathGlobRel -> Bool)
-> (FilePathGlobRel -> FilePathGlobRel -> Bool)
-> Eq FilePathGlobRel
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 -> String
(Int -> FilePathGlobRel -> ShowS)
-> (FilePathGlobRel -> String)
-> ([FilePathGlobRel] -> ShowS)
-> Show FilePathGlobRel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilePathGlobRel] -> ShowS
$cshowList :: [FilePathGlobRel] -> ShowS
show :: FilePathGlobRel -> String
$cshow :: FilePathGlobRel -> String
showsPrec :: Int -> FilePathGlobRel -> ShowS
$cshowsPrec :: Int -> FilePathGlobRel -> ShowS
Show)
type Glob = [GlobPiece]
data GlobPiece = WildCard
| Literal String
| Union [Glob]
deriving (GlobPiece -> GlobPiece -> Bool
(GlobPiece -> GlobPiece -> Bool)
-> (GlobPiece -> GlobPiece -> Bool) -> Eq GlobPiece
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
[GlobPiece] -> ShowS
GlobPiece -> String
(Int -> GlobPiece -> ShowS)
-> (GlobPiece -> String)
-> ([GlobPiece] -> ShowS)
-> Show GlobPiece
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobPiece] -> ShowS
$cshowList :: [GlobPiece] -> ShowS
show :: GlobPiece -> String
$cshow :: GlobPiece -> String
showsPrec :: Int -> GlobPiece -> ShowS
$cshowsPrec :: Int -> GlobPiece -> ShowS
Show)
data FilePathRoot
= FilePathRelative
| FilePathRoot FilePath
| FilePathHomeDir
deriving (FilePathRoot -> FilePathRoot -> Bool
(FilePathRoot -> FilePathRoot -> Bool)
-> (FilePathRoot -> FilePathRoot -> Bool) -> Eq FilePathRoot
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 -> String
(Int -> FilePathRoot -> ShowS)
-> (FilePathRoot -> String)
-> ([FilePathRoot] -> ShowS)
-> Show FilePathRoot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilePathRoot] -> ShowS
$cshowList :: [FilePathRoot] -> ShowS
show :: FilePathRoot -> String
$cshow :: FilePathRoot -> String
showsPrec :: Int -> FilePathRoot -> ShowS
$cshowsPrec :: Int -> FilePathRoot -> ShowS
Show)
isTrivialFilePathGlob :: FilePathGlob -> Maybe FilePath
isTrivialFilePathGlob :: FilePathGlob -> Maybe String
isTrivialFilePathGlob (FilePathGlob FilePathRoot
root FilePathGlobRel
pathglob) =
case FilePathRoot
root of
FilePathRoot
FilePathRelative -> [String] -> FilePathGlobRel -> Maybe String
go [] FilePathGlobRel
pathglob
FilePathRoot String
root' -> [String] -> FilePathGlobRel -> Maybe String
go [String
root'] FilePathGlobRel
pathglob
FilePathRoot
FilePathHomeDir -> Maybe String
forall a. Maybe a
Nothing
where
go :: [String] -> FilePathGlobRel -> Maybe String
go [String]
paths (GlobDir [Literal String
path] FilePathGlobRel
globs) = [String] -> FilePathGlobRel -> Maybe String
go (String
pathString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
paths) FilePathGlobRel
globs
go [String]
paths (GlobFile [Literal String
path]) = String -> Maybe String
forall a. a -> Maybe a
Just ([String] -> String
joinPath ([String] -> [String]
forall a. [a] -> [a]
reverse (String
pathString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
paths)))
go [String]
paths FilePathGlobRel
GlobDirTrailing = String -> Maybe String
forall a. a -> Maybe a
Just (ShowS
addTrailingPathSeparator
([String] -> String
joinPath ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
paths)))
go [String]
_ FilePathGlobRel
_ = Maybe String
forall a. Maybe a
Nothing
getFilePathRootDirectory :: FilePathRoot
-> FilePath
-> IO FilePath
getFilePathRootDirectory :: FilePathRoot -> String -> IO String
getFilePathRootDirectory FilePathRoot
FilePathRelative String
root = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
root
getFilePathRootDirectory (FilePathRoot String
root) String
_ = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
root
getFilePathRootDirectory FilePathRoot
FilePathHomeDir String
_ = IO String
getHomeDirectory
matchFileGlob :: FilePath -> FilePathGlob -> IO [FilePath]
matchFileGlob :: String -> FilePathGlob -> IO [String]
matchFileGlob String
relroot (FilePathGlob FilePathRoot
globroot FilePathGlobRel
glob) = do
String
root <- FilePathRoot -> String -> IO String
getFilePathRootDirectory FilePathRoot
globroot String
relroot
[String]
matches <- String -> FilePathGlobRel -> IO [String]
matchFileGlobRel String
root FilePathGlobRel
glob
case FilePathRoot
globroot of
FilePathRoot
FilePathRelative -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
matches
FilePathRoot
_ -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
root String -> ShowS
</>) [String]
matches)
matchFileGlobRel :: FilePath -> FilePathGlobRel -> IO [FilePath]
matchFileGlobRel :: String -> FilePathGlobRel -> IO [String]
matchFileGlobRel String
root FilePathGlobRel
glob0 = FilePathGlobRel -> String -> IO [String]
go FilePathGlobRel
glob0 String
""
where
go :: FilePathGlobRel -> String -> IO [String]
go (GlobFile [GlobPiece]
glob) String
dir = do
[String]
entries <- String -> IO [String]
getDirectoryContents (String
root String -> ShowS
</> String
dir)
let files :: [String]
files = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ([GlobPiece] -> String -> Bool
matchGlob [GlobPiece]
glob) [String]
entries
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
dir String -> ShowS
</>) [String]
files)
go (GlobDir [GlobPiece]
glob FilePathGlobRel
globPath) String
dir = do
[String]
entries <- String -> IO [String]
getDirectoryContents (String
root String -> ShowS
</> String
dir)
[String]
subdirs <- (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\String
subdir -> String -> IO Bool
doesDirectoryExist
(String
root String -> ShowS
</> String
dir String -> ShowS
</> String
subdir))
([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ([GlobPiece] -> String -> Bool
matchGlob [GlobPiece]
glob) [String]
entries
[[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\String
subdir -> FilePathGlobRel -> String -> IO [String]
go FilePathGlobRel
globPath (String
dir String -> ShowS
</> String
subdir)) [String]
subdirs
go FilePathGlobRel
GlobDirTrailing String
dir = [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
dir]
matchGlob :: Glob -> String -> Bool
matchGlob :: [GlobPiece] -> String -> Bool
matchGlob = [GlobPiece] -> String -> Bool
goStart
where
go, goStart :: [GlobPiece] -> String -> Bool
goStart :: [GlobPiece] -> String -> Bool
goStart (GlobPiece
WildCard:[GlobPiece]
_) (Char
'.':String
_) = Bool
False
goStart (Union [[GlobPiece]]
globs:[GlobPiece]
rest) String
cs = ([GlobPiece] -> Bool) -> [[GlobPiece]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\[GlobPiece]
glob -> [GlobPiece] -> String -> Bool
goStart ([GlobPiece]
glob [GlobPiece] -> [GlobPiece] -> [GlobPiece]
forall a. [a] -> [a] -> [a]
++ [GlobPiece]
rest) String
cs)
[[GlobPiece]]
globs
goStart [GlobPiece]
rest String
cs = [GlobPiece] -> String -> Bool
go [GlobPiece]
rest String
cs
go :: [GlobPiece] -> String -> Bool
go [] String
"" = Bool
True
go (Literal String
lit:[GlobPiece]
rest) String
cs
| Just String
cs' <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
lit String
cs
= [GlobPiece] -> String -> Bool
go [GlobPiece]
rest String
cs'
| Bool
otherwise = Bool
False
go [GlobPiece
WildCard] String
"" = Bool
True
go (GlobPiece
WildCard:[GlobPiece]
rest) (Char
c:String
cs) = [GlobPiece] -> String -> Bool
go [GlobPiece]
rest (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs) Bool -> Bool -> Bool
|| [GlobPiece] -> String -> Bool
go (GlobPiece
WildCardGlobPiece -> [GlobPiece] -> [GlobPiece]
forall a. a -> [a] -> [a]
:[GlobPiece]
rest) String
cs
go (Union [[GlobPiece]]
globs:[GlobPiece]
rest) String
cs = ([GlobPiece] -> Bool) -> [[GlobPiece]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\[GlobPiece]
glob -> [GlobPiece] -> String -> Bool
go ([GlobPiece]
glob [GlobPiece] -> [GlobPiece] -> [GlobPiece]
forall a. [a] -> [a] -> [a]
++ [GlobPiece]
rest) String
cs) [[GlobPiece]]
globs
go [] (Char
_:String
_) = Bool
False
go (GlobPiece
_:[GlobPiece]
_) String
"" = Bool
False
instance Pretty FilePathGlob where
pretty :: FilePathGlob -> Doc
pretty (FilePathGlob FilePathRoot
root FilePathGlobRel
pathglob) = FilePathRoot -> Doc
forall a. Pretty a => a -> Doc
pretty FilePathRoot
root Doc -> Doc -> Doc
Disp.<> FilePathGlobRel -> Doc
forall a. Pretty a => a -> Doc
pretty FilePathGlobRel
pathglob
instance Parsec FilePathGlob where
parsec :: m FilePathGlob
parsec = do
FilePathRoot
root <- m FilePathRoot
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
case FilePathRoot
root of
FilePathRoot
FilePathRelative -> FilePathRoot -> FilePathGlobRel -> FilePathGlob
FilePathGlob FilePathRoot
root (FilePathGlobRel -> FilePathGlob)
-> m FilePathGlobRel -> m FilePathGlob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m FilePathGlobRel
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
FilePathRoot
_ -> FilePathRoot -> FilePathGlobRel -> FilePathGlob
FilePathGlob FilePathRoot
root (FilePathGlobRel -> FilePathGlob)
-> m FilePathGlobRel -> m FilePathGlob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m FilePathGlobRel
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec m FilePathGlob -> m FilePathGlob -> m FilePathGlob
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePathGlob -> m FilePathGlob
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 String
root) = String -> Doc
Disp.text String
root
pretty FilePathRoot
FilePathHomeDir = Char -> Doc
Disp.char Char
'~' Doc -> Doc -> Doc
Disp.<> Char -> Doc
Disp.char Char
'/'
instance Parsec FilePathRoot where
parsec :: m FilePathRoot
parsec = m FilePathRoot
root m FilePathRoot -> m FilePathRoot -> m FilePathRoot
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m FilePathRoot -> m FilePathRoot
forall (m :: * -> *) a. Parsing m => m a -> m a
P.try m FilePathRoot
home m FilePathRoot -> m FilePathRoot -> m FilePathRoot
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m FilePathRoot -> m FilePathRoot
forall (m :: * -> *) a. Parsing m => m a -> m a
P.try m FilePathRoot
drive m FilePathRoot -> m FilePathRoot -> m FilePathRoot
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePathRoot -> m FilePathRoot
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePathRoot
FilePathRelative where
root :: m FilePathRoot
root = String -> FilePathRoot
FilePathRoot String
"/" FilePathRoot -> m Char -> m FilePathRoot
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'/'
home :: m FilePathRoot
home = FilePathRoot
FilePathHomeDir FilePathRoot -> m String -> m FilePathRoot
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"~/"
drive :: m FilePathRoot
drive = do
Char
dr <- (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy ((Char -> Bool) -> m Char) -> (Char -> Bool) -> m Char
forall a b. (a -> b) -> a -> b
$ \Char
c -> Char -> Bool
isAsciiLower Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
c
Char
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':'
Char
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'/' m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'\\'
FilePathRoot -> m FilePathRoot
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FilePathRoot
FilePathRoot (Char -> Char
toUpper Char
dr Char -> ShowS
forall a. a -> [a] -> [a]
: String
":\\"))
instance Pretty FilePathGlobRel where
pretty :: FilePathGlobRel -> Doc
pretty (GlobDir [GlobPiece]
glob FilePathGlobRel
pathglob) = [GlobPiece] -> Doc
dispGlob [GlobPiece]
glob
Doc -> Doc -> Doc
Disp.<> Char -> Doc
Disp.char Char
'/'
Doc -> Doc -> Doc
Disp.<> FilePathGlobRel -> Doc
forall a. Pretty a => a -> Doc
pretty FilePathGlobRel
pathglob
pretty (GlobFile [GlobPiece]
glob) = [GlobPiece] -> Doc
dispGlob [GlobPiece]
glob
pretty FilePathGlobRel
GlobDirTrailing = Doc
Disp.empty
instance Parsec FilePathGlobRel where
parsec :: m FilePathGlobRel
parsec = m FilePathGlobRel
forall (m :: * -> *). CabalParsing m => m FilePathGlobRel
parsecPath where
parsecPath :: CabalParsing m => m FilePathGlobRel
parsecPath :: m FilePathGlobRel
parsecPath = do
[GlobPiece]
glob <- m [GlobPiece]
forall (m :: * -> *). CabalParsing m => m [GlobPiece]
parsecGlob
m ()
forall (m :: * -> *). CabalParsing m => m ()
dirSep m () -> m FilePathGlobRel -> m FilePathGlobRel
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([GlobPiece] -> FilePathGlobRel -> FilePathGlobRel
GlobDir [GlobPiece]
glob (FilePathGlobRel -> FilePathGlobRel)
-> m FilePathGlobRel -> m FilePathGlobRel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m FilePathGlobRel
forall (m :: * -> *). CabalParsing m => m FilePathGlobRel
parsecPath m FilePathGlobRel -> m FilePathGlobRel -> m FilePathGlobRel
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePathGlobRel -> m FilePathGlobRel
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([GlobPiece] -> FilePathGlobRel -> FilePathGlobRel
GlobDir [GlobPiece]
glob FilePathGlobRel
GlobDirTrailing)) m FilePathGlobRel -> m FilePathGlobRel -> m FilePathGlobRel
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePathGlobRel -> m FilePathGlobRel
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([GlobPiece] -> FilePathGlobRel
GlobFile [GlobPiece]
glob)
dirSep :: CabalParsing m => m ()
dirSep :: m ()
dirSep = m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'/') m () -> m () -> m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m () -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m a
P.try (do
Char
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'\\'
m Char -> m ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
P.notFollowedBy ((Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy Char -> Bool
isGlobEscapedChar))
dispGlob :: Glob -> Disp.Doc
dispGlob :: [GlobPiece] -> Doc
dispGlob = [Doc] -> Doc
Disp.hcat ([Doc] -> Doc) -> ([GlobPiece] -> [Doc]) -> [GlobPiece] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobPiece -> Doc) -> [GlobPiece] -> [Doc]
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 String
str) = String -> Doc
Disp.text (ShowS
escape String
str)
dispPiece (Union [[GlobPiece]]
globs) = Doc -> Doc
Disp.braces
([Doc] -> Doc
Disp.hcat (Doc -> [Doc] -> [Doc]
Disp.punctuate
(Char -> Doc
Disp.char Char
',')
(([GlobPiece] -> Doc) -> [[GlobPiece]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map [GlobPiece] -> Doc
dispGlob [[GlobPiece]]
globs)))
escape :: ShowS
escape [] = []
escape (Char
c:String
cs)
| Char -> Bool
isGlobEscapedChar Char
c = Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
escape String
cs
| Bool
otherwise = Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
escape String
cs
parsecGlob :: CabalParsing m => m Glob
parsecGlob :: m [GlobPiece]
parsecGlob = m GlobPiece -> m [GlobPiece]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some m GlobPiece
parsecPiece where
parsecPiece :: m GlobPiece
parsecPiece = [m GlobPiece] -> m GlobPiece
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 GlobPiece -> m Char -> m GlobPiece
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'*'
union :: m GlobPiece
union = [[GlobPiece]] -> GlobPiece
Union ([[GlobPiece]] -> GlobPiece)
-> (NonEmpty [GlobPiece] -> [[GlobPiece]])
-> NonEmpty [GlobPiece]
-> GlobPiece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty [GlobPiece] -> [[GlobPiece]]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty [GlobPiece] -> GlobPiece)
-> m (NonEmpty [GlobPiece]) -> m GlobPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
-> m Char -> m (NonEmpty [GlobPiece]) -> m (NonEmpty [GlobPiece])
forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
P.between (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'{') (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'}') (m [GlobPiece] -> m Char -> m (NonEmpty [GlobPiece])
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
P.sepByNonEmpty m [GlobPiece]
forall (m :: * -> *). CabalParsing m => m [GlobPiece]
parsecGlob (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
','))
literal :: m GlobPiece
literal = String -> GlobPiece
Literal (String -> GlobPiece) -> m String -> m GlobPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char -> m String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some m Char
litchar
litchar :: m Char
litchar = m Char
normal m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char
escape
normal :: m Char
normal = (Char -> Bool) -> m Char
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\')
escape :: m Char
escape = m Char -> m Char
forall (m :: * -> *) a. Parsing m => m a -> m a
P.try (m Char -> m Char) -> m Char -> m Char
forall a b. (a -> b) -> a -> b
$ Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'\\' m Char -> m Char -> m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> m Char
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