{-# LANGUAGE LambdaCase #-}{-# LANGUAGE PatternGuards, ViewPatterns, TupleSections #-}moduleDevelopment.Shake.Internal.FilePattern(-- * Primitive API, as exposedFilePattern ,(?==) ,(<//>) ,-- * General API, used by other people.filePattern ,-- * Optimisation opportunitiessimple ,(?==*) ,-- * Multipattern file rulescompatible ,extract ,substitute ,-- * Accelerated searchingWalk (..),walk ,-- * Testing onlyinternalTest ,isRelativePath ,isRelativePattern )whereimportDevelopment.Shake.Internal.Errors importSystem.FilePath(isPathSeparator)importData.List.ExtraimportControl.MonadimportData.CharimportData.MaybeimportSystem.Info.Extra-- | A type synonym for file patterns, containing @\/\/@ and @*@. For the syntax-- and semantics of 'FilePattern' see '?=='.---- Most 'normaliseEx'd 'FilePath' values are suitable as 'FilePattern' values which match-- only that specific file. On Windows @\\@ is treated as equivalent to @\/@.---- You can write 'FilePattern' values as a literal string, or build them-- up using the operators 'Development.Shake.FilePath.<.>', 'Development.Shake.FilePath.</>'-- and 'Development.Shake.<//>'. However, beware that:---- * On Windows, use 'Development.Shake.FilePath.<.>' from "Development.Shake.FilePath" instead of from-- "System.FilePath" - otherwise @\"\/\/*\" \<.\> exe@ results in @\"\/\/*\\\\.exe\"@.---- * If the second argument of 'Development.Shake.FilePath.</>' has a leading path separator (namely @\/@)-- then the second argument will be returned.typeFilePattern =Stringinfixr5<//> -- | Join two 'FilePattern' values by inserting two @\/@ characters between them.-- Will first remove any trailing path separators on the first argument, and any leading-- separators on the second.---- > "dir" <//> "*" == "dir//*"(<//>) ::FilePattern ->FilePattern ->FilePattern String
a <//> :: String -> String -> String
<//> String
b =(Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEndChar -> Bool
isPathSeparatorString
a String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"//"String -> String -> String
forall a. [a] -> [a] -> [a]
++(Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileChar -> Bool
isPathSeparatorString
b ----------------------------------------------------------------------- PATTERNSdataPat =Lit String-- ^ foo|Star -- ^ /*/|Skip -- ^ //|Skip1 -- ^ //, but must be at least 1 element|Stars String[String]String-- ^ *foo*, prefix (fixed), infix floaters, suffix-- e.g. *foo*bar = Stars "" ["foo"] "bar"deriving(Int -> Pat -> String -> String
[Pat] -> String -> String
Pat -> String
(Int -> Pat -> String -> String)
-> (Pat -> String) -> ([Pat] -> String -> String) -> Show Pat
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Pat -> String -> String
showsPrec :: Int -> Pat -> String -> String
$cshow :: Pat -> String
show :: Pat -> String
$cshowList :: [Pat] -> String -> String
showList :: [Pat] -> String -> String
Show,Pat -> Pat -> Bool
(Pat -> Pat -> Bool) -> (Pat -> Pat -> Bool) -> Eq Pat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pat -> Pat -> Bool
== :: Pat -> Pat -> Bool
$c/= :: Pat -> Pat -> Bool
/= :: Pat -> Pat -> Bool
Eq,Eq Pat
Eq Pat =>
(Pat -> Pat -> Ordering)
-> (Pat -> Pat -> Bool)
-> (Pat -> Pat -> Bool)
-> (Pat -> Pat -> Bool)
-> (Pat -> Pat -> Bool)
-> (Pat -> Pat -> Pat)
-> (Pat -> Pat -> Pat)
-> Ord Pat
Pat -> Pat -> Bool
Pat -> Pat -> Ordering
Pat -> Pat -> Pat
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
$ccompare :: Pat -> Pat -> Ordering
compare :: Pat -> Pat -> Ordering
$c< :: Pat -> Pat -> Bool
< :: Pat -> Pat -> Bool
$c<= :: Pat -> Pat -> Bool
<= :: Pat -> Pat -> Bool
$c> :: Pat -> Pat -> Bool
> :: Pat -> Pat -> Bool
$c>= :: Pat -> Pat -> Bool
>= :: Pat -> Pat -> Bool
$cmax :: Pat -> Pat -> Pat
max :: Pat -> Pat -> Pat
$cmin :: Pat -> Pat -> Pat
min :: Pat -> Pat -> Pat
Ord)fromLit ::Pat ->MaybeStringfromLit :: Pat -> Maybe String
fromLit (Lit String
x )=String -> Maybe String
forall a. a -> Maybe a
JustString
x fromLit Pat
_=Maybe String
forall a. Maybe a
NothingdataLexeme =Str String|Slash |SlashSlash lexer ::FilePattern ->[Lexeme ]lexer :: String -> [Lexeme]
lexer String
""=[]lexer (Char
x1 :Char
x2 :String
xs )|Char -> Bool
isPathSeparatorChar
x1 ,Char -> Bool
isPathSeparatorChar
x2 =Lexeme
SlashSlash Lexeme -> [Lexeme] -> [Lexeme]
forall a. a -> [a] -> [a]
:String -> [Lexeme]
lexer String
xs lexer (Char
x1 :String
xs )|Char -> Bool
isPathSeparatorChar
x1 =Lexeme
Slash Lexeme -> [Lexeme] -> [Lexeme]
forall a. a -> [a] -> [a]
:String -> [Lexeme]
lexer String
xs lexer String
xs =String -> Lexeme
Str String
a Lexeme -> [Lexeme] -> [Lexeme]
forall a. a -> [a] -> [a]
:String -> [Lexeme]
lexer String
b where(String
a ,String
b )=(Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
breakChar -> Bool
isPathSeparatorString
xs -- | Parse a FilePattern. All optimisations I can think of are invalid because they change the extracted expressions.parse ::FilePattern ->[Pat ]parse :: String -> [Pat]
parse =Bool -> Bool -> [Lexeme] -> [Pat]
f Bool
FalseBool
True([Lexeme] -> [Pat]) -> (String -> [Lexeme]) -> String -> [Pat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [Lexeme]
lexer where-- str = I have ever seen a Str go past (equivalent to "can I be satisfied by no paths")-- slash = I am either at the start, or my previous character was Slashf :: Bool -> Bool -> [Lexeme] -> [Pat]
f Bool
str Bool
slash =\case[]->[String -> Pat
Lit String
""|Bool
slash ]Str String
"**":[Lexeme]
xs ->Pat
Skip Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:Bool -> Bool -> [Lexeme] -> [Pat]
f Bool
TrueBool
False[Lexeme]
xs Str String
x :[Lexeme]
xs ->String -> Pat
parseLit String
x Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:Bool -> Bool -> [Lexeme] -> [Pat]
f Bool
TrueBool
False[Lexeme]
xs Lexeme
SlashSlash :Lexeme
Slash :[Lexeme]
xs |Bool -> Bool
notBool
str ->Pat
Skip1 Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:Bool -> Bool -> [Lexeme] -> [Pat]
f Bool
str Bool
True[Lexeme]
xs Lexeme
SlashSlash :[Lexeme]
xs ->Pat
Skip Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:Bool -> Bool -> [Lexeme] -> [Pat]
f Bool
str Bool
False[Lexeme]
xs Lexeme
Slash :[Lexeme]
xs ->[String -> Pat
Lit String
""|Bool -> Bool
notBool
str ][Pat] -> [Pat] -> [Pat]
forall a. [a] -> [a] -> [a]
++Bool -> Bool -> [Lexeme] -> [Pat]
f Bool
str Bool
True[Lexeme]
xs parseLit ::String->Pat parseLit :: String -> Pat
parseLit String
"*"=Pat
Star parseLit String
x =case(Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
split(Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'*')String
x of[String
x ]->String -> Pat
Lit String
x String
pre :[String]
xs |Just([String]
mid ,String
post )<-[String] -> Maybe ([String], String)
forall a. [a] -> Maybe ([a], a)
unsnoc[String]
xs ->String -> [String] -> String -> Pat
Stars String
pre [String]
mid String
post [String]
_->String -> Pat
Lit String
""internalTest ::IO()internalTest :: IO ()
internalTest =doletString
x # :: String -> [Pat] -> f ()
# [Pat]
y =letp :: [Pat]
p =String -> [Pat]
parse String
x inBool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when([Pat]
p [Pat] -> [Pat] -> Bool
forall a. Eq a => a -> a -> Bool
/=[Pat]
y )(f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$String -> f ()
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail(String -> f ()) -> String -> f ()
forall a b. (a -> b) -> a -> b
$(String, String, [Pat], [Pat]) -> String
forall a. Show a => a -> String
show(String
"FilePattern.internalTest",String
x ,[Pat]
p ,[Pat]
y )String
""String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [String -> Pat
Lit String
""]String
"x"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [String -> Pat
Lit String
"x"]String
"/"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [String -> Pat
Lit String
"",String -> Pat
Lit String
""]String
"x/"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [String -> Pat
Lit String
"x",String -> Pat
Lit String
""]String
"/x"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [String -> Pat
Lit String
"",String -> Pat
Lit String
"x"]String
"x/y"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [String -> Pat
Lit String
"x",String -> Pat
Lit String
"y"]String
"//"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [Pat
Skip ]String
"**"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [Pat
Skip ]String
"//x"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [Pat
Skip ,String -> Pat
Lit String
"x"]String
"**/x"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [Pat
Skip ,String -> Pat
Lit String
"x"]String
"x//"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [String -> Pat
Lit String
"x",Pat
Skip ]String
"x/**"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [String -> Pat
Lit String
"x",Pat
Skip ]String
"x//y"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [String -> Pat
Lit String
"x",Pat
Skip ,String -> Pat
Lit String
"y"]String
"x/**/y"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [String -> Pat
Lit String
"x",Pat
Skip ,String -> Pat
Lit String
"y"]String
"///"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [Pat
Skip1 ,String -> Pat
Lit String
""]String
"**/**"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [Pat
Skip ,Pat
Skip ]String
"**/**/"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [Pat
Skip ,Pat
Skip ,String -> Pat
Lit String
""]String
"///x"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [Pat
Skip1 ,String -> Pat
Lit String
"x"]String
"**/x"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [Pat
Skip ,String -> Pat
Lit String
"x"]String
"x///"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [String -> Pat
Lit String
"x",Pat
Skip ,String -> Pat
Lit String
""]String
"x/**/"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [String -> Pat
Lit String
"x",Pat
Skip ,String -> Pat
Lit String
""]String
"x///y"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [String -> Pat
Lit String
"x",Pat
Skip ,String -> Pat
Lit String
"y"]String
"x/**/y"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [String -> Pat
Lit String
"x",Pat
Skip ,String -> Pat
Lit String
"y"]String
"////"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [Pat
Skip ,Pat
Skip ]String
"**/**/**"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [Pat
Skip ,Pat
Skip ,Pat
Skip ]String
"////x"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [Pat
Skip ,Pat
Skip ,String -> Pat
Lit String
"x"]String
"x////"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [String -> Pat
Lit String
"x",Pat
Skip ,Pat
Skip ]String
"x////y"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [String -> Pat
Lit String
"x",Pat
Skip ,Pat
Skip ,String -> Pat
Lit String
"y"]String
"**//x"String -> [Pat] -> IO ()
forall {f :: * -> *}. MonadFail f => String -> [Pat] -> f ()
# [Pat
Skip ,Pat
Skip ,String -> Pat
Lit String
"x"]-- | Optimisations that may change the matched expressionsoptimise ::[Pat ]->[Pat ]optimise :: [Pat] -> [Pat]
optimise (Pat
Skip :Pat
Skip :[Pat]
xs )=[Pat] -> [Pat]
optimise ([Pat] -> [Pat]) -> [Pat] -> [Pat]
forall a b. (a -> b) -> a -> b
$Pat
Skip Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:[Pat]
xs optimise (Pat
Skip :Pat
Star :[Pat]
xs )=[Pat] -> [Pat]
optimise ([Pat] -> [Pat]) -> [Pat] -> [Pat]
forall a b. (a -> b) -> a -> b
$Pat
Skip1 Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:[Pat]
xs optimise (Pat
Star :Pat
Skip :[Pat]
xs )=[Pat] -> [Pat]
optimise ([Pat] -> [Pat]) -> [Pat] -> [Pat]
forall a b. (a -> b) -> a -> b
$Pat
Skip1 Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:[Pat]
xs optimise (Pat
x :[Pat]
xs )=Pat
x Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:[Pat] -> [Pat]
optimise [Pat]
xs optimise []=[]-- | A 'FilePattern' that will only match 'isRelativePath' values.isRelativePattern ::FilePattern ->BoolisRelativePattern :: String -> Bool
isRelativePattern (Char
'*':Char
'*':String
xs )|[]<-String
xs =Bool
True|Char
x :String
_<-String
xs ,Char -> Bool
isPathSeparatorChar
x =Bool
TrueisRelativePattern String
_=Bool
False-- | A non-absolute 'FilePath'.isRelativePath ::FilePath->BoolisRelativePath :: String -> Bool
isRelativePath (Char
x :String
_)|Char -> Bool
isPathSeparatorChar
x =Bool
FalseisRelativePath (Char
x :Char
':':String
_)|Bool
isWindows,Char -> Bool
isAlphaChar
x =Bool
FalseisRelativePath String
_=Bool
True-- | Given a pattern, and a list of path components, return a list of all matches-- (for each wildcard in order, what the wildcard matched).match ::[Pat ]->[String]->[[String]]match :: [Pat] -> [String] -> [[String]]
match (Pat
Skip :[Pat]
xs )(String
y :[String]
ys )=([String] -> [String]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map(String
""String -> [String] -> [String]
forall a. a -> [a] -> [a]
:)([Pat] -> [String] -> [[String]]
match [Pat]
xs (String
y String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ys ))[[String]] -> [[String]] -> [[String]]
forall a. [a] -> [a] -> [a]
++[Pat] -> [String] -> [[String]]
match (Pat
Skip1 Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:[Pat]
xs )(String
y String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ys )match (Pat
Skip1 :[Pat]
xs )(String
y :[String]
ys )=[(String
y String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"/"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
r )String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
rs |String
r :[String]
rs <-[Pat] -> [String] -> [[String]]
match (Pat
Skip Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:[Pat]
xs )[String]
ys ]match (Pat
Skip :[Pat]
xs )[]=([String] -> [String]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map(String
""String -> [String] -> [String]
forall a. a -> [a] -> [a]
:)([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> a -> b
$[Pat] -> [String] -> [[String]]
match [Pat]
xs []match (Pat
Star :[Pat]
xs )(String
y :[String]
ys )=([String] -> [String]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map(String
y String -> [String] -> [String]
forall a. a -> [a] -> [a]
:)([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> a -> b
$[Pat] -> [String] -> [[String]]
match [Pat]
xs [String]
ys match (Lit String
x :[Pat]
xs )(String
y :[String]
ys )=[[[String]]] -> [[String]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat([[[String]]] -> [[String]]) -> [[[String]]] -> [[String]]
forall a b. (a -> b) -> a -> b
$[[Pat] -> [String] -> [[String]]
match [Pat]
xs [String]
ys |String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
y ][[[String]]] -> [[[String]]] -> [[[String]]]
forall a. [a] -> [a] -> [a]
++[[Pat] -> [String] -> [[String]]
match [Pat]
xs (String
y String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ys )|String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"."]match (x :: Pat
x @Stars {}:[Pat]
xs )(String
y :[String]
ys )|Just[String]
rs <-Pat -> String -> Maybe [String]
matchStars Pat
x String
y =([String] -> [String]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map([String]
rs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++)([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> a -> b
$[Pat] -> [String] -> [[String]]
match [Pat]
xs [String]
ys match [][]=[[]]match [Pat]
_[String]
_=[]matchOne ::Pat ->String->BoolmatchOne :: Pat -> String -> Bool
matchOne (Lit String
x )String
y =String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
y matchOne x :: Pat
x @Stars {}String
y =Maybe [String] -> Bool
forall a. Maybe a -> Bool
isJust(Maybe [String] -> Bool) -> Maybe [String] -> Bool
forall a b. (a -> b) -> a -> b
$Pat -> String -> Maybe [String]
matchStars Pat
x String
y matchOne Pat
Star String
_=Bool
TruematchOne Pat
p String
_=SomeException -> Bool
forall a. SomeException -> a
throwImpure (SomeException -> Bool) -> SomeException -> Bool
forall a b. (a -> b) -> a -> b
$Partial => String -> SomeException
String -> SomeException
errorInternal (String -> SomeException) -> String -> SomeException
forall a b. (a -> b) -> a -> b
$String
"unreachablePattern, matchOne "String -> String -> String
forall a. [a] -> [a] -> [a]
++Pat -> String
forall a. Show a => a -> String
showPat
p -- Only return the first (all patterns left-most) valid star matchingmatchStars ::Pat ->String->Maybe[String]matchStars :: Pat -> String -> Maybe [String]
matchStars (Stars String
pre [String]
mid String
post )String
x =doString
x <-String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefixString
pre String
x String
x <-ifString -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
nullString
post thenString -> Maybe String
forall a. a -> Maybe a
JustString
x elseString -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffixString
post String
x [String] -> String -> Maybe [String]
forall {a}. Eq a => [[a]] -> [a] -> Maybe [[a]]
stripInfixes [String]
mid String
x wherestripInfixes :: [[a]] -> [a] -> Maybe [[a]]
stripInfixes [][a]
x =[[a]] -> Maybe [[a]]
forall a. a -> Maybe a
Just[[a]
x ]stripInfixes ([a]
m :[[a]]
ms )[a]
x =do([a]
a ,[a]
x )<-[a] -> [a] -> Maybe ([a], [a])
forall a. Eq a => [a] -> [a] -> Maybe ([a], [a])
stripInfix[a]
m [a]
x ([a]
a [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:)([[a]] -> [[a]]) -> Maybe [[a]] -> Maybe [[a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[[a]] -> [a] -> Maybe [[a]]
stripInfixes [[a]]
ms [a]
x matchStars Pat
p String
_=SomeException -> Maybe [String]
forall a. SomeException -> a
throwImpure (SomeException -> Maybe [String])
-> SomeException -> Maybe [String]
forall a b. (a -> b) -> a -> b
$Partial => String -> SomeException
String -> SomeException
errorInternal (String -> SomeException) -> String -> SomeException
forall a b. (a -> b) -> a -> b
$String
"unreachablePattern, matchStars "String -> String -> String
forall a. [a] -> [a] -> [a]
++Pat -> String
forall a. Show a => a -> String
showPat
p -- | Match a 'FilePattern' against a 'FilePath', There are three special forms:---- * @*@ matches an entire path component, excluding any separators.---- * @\/\/@ matches an arbitrary number of path components, including absolute path-- prefixes.---- * @**@ as a path component matches an arbitrary number of path components, but not-- absolute path prefixes.-- Currently considered experimental.---- Some examples:---- * @test.c@ matches @test.c@ and nothing else.---- * @*.c@ matches all @.c@ files in the current directory, so @file.c@ matches,-- but @file.h@ and @dir\/file.c@ don't.---- * @\/\/*.c@ matches all @.c@ files anywhere on the filesystem,-- so @file.c@, @dir\/file.c@, @dir1\/dir2\/file.c@ and @\/path\/to\/file.c@ all match,-- but @file.h@ and @dir\/file.h@ don't.---- * @dir\/*\/*@ matches all files one level below @dir@, so @dir\/one\/file.c@ and-- @dir\/two\/file.h@ match, but @file.c@, @one\/dir\/file.c@, @dir\/file.h@-- and @dir\/one\/two\/file.c@ don't.---- Patterns with constructs such as @foo\/..\/bar@ will never match-- normalised 'FilePath' values, so are unlikely to be correct.(?==) ::FilePattern ->FilePath->Bool?== :: String -> String -> Bool
(?==) String
p =case[Pat] -> [Pat]
optimise ([Pat] -> [Pat]) -> [Pat] -> [Pat]
forall a b. (a -> b) -> a -> b
$String -> [Pat]
parse String
p of[Pat
x ]|Pat
x Pat -> Pat -> Bool
forall a. Eq a => a -> a -> Bool
==Pat
Skip Bool -> Bool -> Bool
||Pat
x Pat -> Pat -> Bool
forall a. Eq a => a -> a -> Bool
==Pat
Skip1 ->ifBool
rp thenString -> Bool
isRelativePath elseBool -> String -> Bool
forall a b. a -> b -> a
constBool
True[Pat]
p ->letf :: String -> Bool
f =Bool -> Bool
not(Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[[String]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null([[String]] -> Bool) -> (String -> [[String]]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Pat] -> [String] -> [[String]]
match [Pat]
p ([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
splitChar -> Bool
isPathSeparatorinifBool
rp then(\String
x ->String -> Bool
isRelativePath String
x Bool -> Bool -> Bool
&&String -> Bool
f String
x )elseString -> Bool
f whererp :: Bool
rp =String -> Bool
isRelativePattern String
p (?==*) ::[FilePattern ]->FilePath->Bool?==* :: [String] -> String -> Bool
(?==*) [String]
ps =\String
x ->((String -> Bool) -> Bool) -> [String -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any((String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$String
x )[String -> Bool]
vs wherevs :: [String -> Bool]
vs =(String -> String -> Bool) -> [String] -> [String -> Bool]
forall a b. (a -> b) -> [a] -> [b]
mapString -> String -> Bool
(?==) [String]
ps -- | Like '?==', but returns 'Nothing' on if there is no match, otherwise 'Just' with the list-- of fragments matching each wildcard. For example:---- @-- 'filePattern' \"**\/*.c\" \"test.txt\" == Nothing-- 'filePattern' \"**\/*.c\" \"foo.c\" == Just [\"",\"foo\"]-- 'filePattern' \"**\/*.c\" \"bar\/baz\/foo.c\" == Just [\"bar\/baz/\",\"foo\"]-- @---- Note that the @**@ will often contain a trailing @\/@, and even on Windows any-- @\\@ separators will be replaced by @\/@.filePattern ::FilePattern ->FilePath->Maybe[String]filePattern :: String -> String -> Maybe [String]
filePattern String
p =\String
x ->ifString -> Bool
eq String
x then[String] -> Maybe [String]
forall a. a -> Maybe a
Just([String] -> Maybe [String]) -> [String] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$String -> [String]
ex String
x elseMaybe [String]
forall a. Maybe a
Nothingwhereeq :: String -> Bool
eq =String -> String -> Bool
(?==) String
p ex :: String -> [String]
ex =String -> String -> [String]
extract String
p ----------------------------------------------------------------------- MULTIPATTERN COMPATIBLE SUBSTITUTIONSspecials ::FilePattern ->[Pat ]specials :: String -> [Pat]
specials =(Pat -> [Pat]) -> [Pat] -> [Pat]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMapPat -> [Pat]
f ([Pat] -> [Pat]) -> (String -> [Pat]) -> String -> [Pat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [Pat]
parse wheref :: Pat -> [Pat]
f Lit {}=[]f Pat
Star =[Pat
Star ]f Pat
Skip =[Pat
Skip ]f Pat
Skip1 =[Pat
Skip ]f (Stars String
_[String]
xs String
_)=Int -> Pat -> [Pat]
forall a. Int -> a -> [a]
replicate([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length[String]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)Pat
Star -- | Is the pattern free from any * and //.simple ::FilePattern ->Boolsimple :: String -> Bool
simple =[Pat] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null([Pat] -> Bool) -> (String -> [Pat]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [Pat]
specials -- | Do they have the same * and // counts in the same ordercompatible ::[FilePattern ]->Boolcompatible :: [String] -> Bool
compatible []=Bool
Truecompatible (String
x :[String]
xs )=(String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all([Pat] -> [Pat] -> Bool
forall a. Eq a => a -> a -> Bool
(==)(String -> [Pat]
specials String
x )([Pat] -> Bool) -> (String -> [Pat]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [Pat]
specials )[String]
xs -- | Extract the items that match the wildcards. The pair must match with '?=='.extract ::FilePattern ->FilePath->[String]extract :: String -> String -> [String]
extract String
p =letpat :: [Pat]
pat =String -> [Pat]
parse String
p in\String
x ->case[Pat] -> [String] -> [[String]]
match [Pat]
pat ((Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
splitChar -> Bool
isPathSeparatorString
x )of[]|String
p String -> String -> Bool
?== String
x ->SomeException -> [String]
forall a. SomeException -> a
throwImpure (SomeException -> [String]) -> SomeException -> [String]
forall a b. (a -> b) -> a -> b
$Partial => String -> SomeException
String -> SomeException
errorInternal (String -> SomeException) -> String -> SomeException
forall a b. (a -> b) -> a -> b
$String
"extract with "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
forall a. Show a => a -> String
showString
p String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" and "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
forall a. Show a => a -> String
showString
x |Bool
otherwise->String -> [String]
forall a. Partial => String -> a
error(String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$String
"Pattern "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
forall a. Show a => a -> String
showString
p String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" does not match "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++String
", when trying to extract the FilePattern matches"[String]
ms :[[String]]
_->[String]
ms -- | Given the result of 'extract', substitute it back in to a 'compatible' pattern.---- > p '?==' x ==> substitute (extract p x) p == xsubstitute ::[String]->FilePattern ->FilePathsubstitute :: [String] -> String -> String
substitute [String]
oms String
oxs =String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalateString
"/"([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$[[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$([String], [[String]]) -> [[String]]
forall a b. (a, b) -> b
snd(([String], [[String]]) -> [[String]])
-> ([String], [[String]]) -> [[String]]
forall a b. (a -> b) -> a -> b
$([String] -> Pat -> ([String], [String]))
-> [String] -> [Pat] -> ([String], [[String]])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL[String] -> Pat -> ([String], [String])
f [String]
oms (String -> [Pat]
parse String
oxs )wheref :: [String] -> Pat -> ([String], [String])
f [String]
ms (Lit String
x )=([String]
ms ,[String
x ])f (String
m :[String]
ms )Pat
Star =([String]
ms ,[String
m ])f (String
m :[String]
ms )Pat
Skip =([String]
ms ,String -> [String]
split String
m )f (String
m :[String]
ms )Pat
Skip1 =([String]
ms ,String -> [String]
split String
m )f [String]
ms (Stars String
pre [String]
mid String
post )=([String]
ms2 ,[[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$String
pre String -> [String] -> [String]
forall a. a -> [a] -> [a]
:(String -> String -> String) -> [String] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWithString -> String -> String
forall a. [a] -> [a] -> [a]
(++)[String]
ms1 ([String]
mid [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String
post ])])where([String]
ms1 ,[String]
ms2 )=Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length[String]
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)[String]
ms f [String]
_Pat
_=String -> ([String], [String])
forall a. Partial => String -> a
error(String -> ([String], [String])) -> String -> ([String], [String])
forall a b. (a -> b) -> a -> b
$String
"Substitution failed into pattern "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
forall a. Show a => a -> String
showString
oxs String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" with "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length[String]
oms )String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" matches, namely "String -> String -> String
forall a. [a] -> [a] -> [a]
++[String] -> String
forall a. Show a => a -> String
show[String]
oms split :: String -> [String]
split =(Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
linesBy(Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/')----------------------------------------------------------------------- EFFICIENT PATH WALKING-- | Given a list of files, return a list of things I can match in this directory-- plus a list of subdirectories and walks that apply to them.-- Use WalkTo when the list can be predicted in advancedataWalk =Walk ([String]->([String],[(String,Walk )]))|WalkTo ([String],[(String,Walk )])walk ::[FilePattern ]->(Bool,Walk )walk :: [String] -> (Bool, Walk)
walk [String]
ps =(([Pat] -> Bool) -> [[Pat]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any(\[Pat]
p ->[Pat] -> Bool
isEmpty [Pat]
p Bool -> Bool -> Bool
||Bool -> Bool
not([[String]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null([[String]] -> Bool) -> [[String]] -> Bool
forall a b. (a -> b) -> a -> b
$[Pat] -> [String] -> [[String]]
match [Pat]
p [String
""]))[[Pat]]
ps2 ,[[Pat]] -> Walk
f [[Pat]]
ps2 )whereps2 :: [[Pat]]
ps2 =(String -> [Pat]) -> [String] -> [[Pat]]
forall a b. (a -> b) -> [a] -> [b]
map((Pat -> Bool) -> [Pat] -> [Pat]
forall a. (a -> Bool) -> [a] -> [a]
filter(Pat -> Pat -> Bool
forall a. Eq a => a -> a -> Bool
/=String -> Pat
Lit String
".")([Pat] -> [Pat]) -> (String -> [Pat]) -> String -> [Pat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Pat] -> [Pat]
optimise ([Pat] -> [Pat]) -> (String -> [Pat]) -> String -> [Pat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [Pat]
parse )[String]
ps f :: [[Pat]] -> Walk
f ([[Pat]] -> [[Pat]]
forall a. Ord a => [a] -> [a]
nubOrd->[[Pat]]
ps )|Just[String]
fin <-(Pat -> Maybe String) -> [Pat] -> Maybe [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapMPat -> Maybe String
fromLit [Pat]
fin ,Just[(String, Walk)]
nxt <-((Pat, [[Pat]]) -> Maybe (String, Walk))
-> [(Pat, [[Pat]])] -> Maybe [(String, Walk)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM(\(Pat
a ,[[Pat]]
b )->(,[[Pat]] -> Walk
f [[Pat]]
b )(String -> (String, Walk)) -> Maybe String -> Maybe (String, Walk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>Pat -> Maybe String
fromLit Pat
a )[(Pat, [[Pat]])]
nxt =([String], [(String, Walk)]) -> Walk
WalkTo ([String]
fin ,[(String, Walk)]
nxt )|Bool
otherwise=([String] -> ([String], [(String, Walk)])) -> Walk
Walk (([String] -> ([String], [(String, Walk)])) -> Walk)
-> ([String] -> ([String], [(String, Walk)])) -> Walk
forall a b. (a -> b) -> a -> b
$\[String]
xs ->(ifBool
finStar then[String]
xs else(String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter(\String
x ->(Pat -> Bool) -> [Pat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any(Pat -> String -> Bool
`matchOne` String
x )[Pat]
fin )[String]
xs ,[(String
x ,[[Pat]] -> Walk
f [[Pat]]
ys )|String
x <-[String]
xs ,letys :: [[Pat]]
ys =[[[Pat]]] -> [[Pat]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat[[[Pat]]
b |(Pat
a ,[[Pat]]
b )<-[(Pat, [[Pat]])]
nxt ,Pat -> String -> Bool
matchOne Pat
a String
x ],Bool -> Bool
not(Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$[[Pat]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null[[Pat]]
ys ])wherefinStar :: Bool
finStar =Pat
Star Pat -> [Pat] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`[Pat]
fin fin :: [Pat]
fin =[Pat] -> [Pat]
forall a. Ord a => [a] -> [a]
nubOrd([Pat] -> [Pat]) -> [Pat] -> [Pat]
forall a b. (a -> b) -> a -> b
$([Pat] -> Maybe Pat) -> [[Pat]] -> [Pat]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe[Pat] -> Maybe Pat
final [[Pat]]
ps nxt :: [(Pat, [[Pat]])]
nxt =[(Pat, [Pat])] -> [(Pat, [[Pat]])]
forall k v. Ord k => [(k, v)] -> [(k, [v])]
groupSort([(Pat, [Pat])] -> [(Pat, [[Pat]])])
-> [(Pat, [Pat])] -> [(Pat, [[Pat]])]
forall a b. (a -> b) -> a -> b
$([Pat] -> [(Pat, [Pat])]) -> [[Pat]] -> [(Pat, [Pat])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap[Pat] -> [(Pat, [Pat])]
next [[Pat]]
ps next ::[Pat ]->[(Pat ,[Pat ])]next :: [Pat] -> [(Pat, [Pat])]
next (Pat
Skip1 :[Pat]
xs )=[(Pat
Star ,Pat
Skip Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:[Pat]
xs )]next (Pat
Skip :[Pat]
xs )=(Pat
Star ,Pat
Skip Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:[Pat]
xs )(Pat, [Pat]) -> [(Pat, [Pat])] -> [(Pat, [Pat])]
forall a. a -> [a] -> [a]
:[Pat] -> [(Pat, [Pat])]
next [Pat]
xs next (Pat
x :[Pat]
xs )=[(Pat
x ,[Pat]
xs )|Bool -> Bool
not(Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$[Pat] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null[Pat]
xs ]next []=[]final ::[Pat ]->MaybePat final :: [Pat] -> Maybe Pat
final (Pat
Skip :[Pat]
xs )=if[Pat] -> Bool
isEmpty [Pat]
xs thenPat -> Maybe Pat
forall a. a -> Maybe a
JustPat
Star else[Pat] -> Maybe Pat
final [Pat]
xs final (Pat
Skip1 :[Pat]
xs )=if[Pat] -> Bool
isEmpty [Pat]
xs thenPat -> Maybe Pat
forall a. a -> Maybe a
JustPat
Star elseMaybe Pat
forall a. Maybe a
Nothingfinal (Pat
x :[Pat]
xs )=if[Pat] -> Bool
isEmpty [Pat]
xs thenPat -> Maybe Pat
forall a. a -> Maybe a
JustPat
x elseMaybe Pat
forall a. Maybe a
Nothingfinal []=Maybe Pat
forall a. Maybe a
NothingisEmpty :: [Pat] -> Bool
isEmpty =(Pat -> Bool) -> [Pat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all(Pat -> Pat -> Bool
forall a. Eq a => a -> a -> Bool
==Pat
Skip )