module System.FilePath.Glob.Directory
( GlobOptions(..), globDefault
, globDir, globDirWith, globDir1, glob
, commonDirectory
) where
import Control.Arrow (first, second)
import Control.Monad (forM)
import qualified Data.DList as DL
import Data.DList (DList)
import Data.List ((\\), find)
import System.Directory ( doesDirectoryExist, getDirectoryContents
, getCurrentDirectory
)
import System.FilePath ( (</>), takeDrive, splitDrive
, isExtSeparator
, pathSeparator, isPathSeparator
, takeDirectory
)
import System.FilePath.Glob.Base ( Pattern(..), Token(..)
, MatchOptions, matchDefault
, compile
)
import System.FilePath.Glob.Match (matchWith)
import System.FilePath.Glob.Utils ( getRecursiveContents
, nubOrd
, pathParts
, partitionDL, tailDL
, catchIO
)
data GlobOptions = GlobOptions
{ GlobOptions -> MatchOptions
matchOptions :: MatchOptions
, GlobOptions -> Bool
includeUnmatched :: Bool
}
globDefault :: GlobOptions
globDefault :: GlobOptions
globDefault = MatchOptions -> Bool -> GlobOptions
GlobOptions MatchOptions
matchDefault Bool
False
data TypedPattern
= Any Pattern
| Dir Int Pattern
| AnyDir Int Pattern
deriving Int -> TypedPattern -> ShowS
[TypedPattern] -> ShowS
TypedPattern -> String
(Int -> TypedPattern -> ShowS)
-> (TypedPattern -> String)
-> ([TypedPattern] -> ShowS)
-> Show TypedPattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypedPattern] -> ShowS
$cshowList :: [TypedPattern] -> ShowS
show :: TypedPattern -> String
$cshow :: TypedPattern -> String
showsPrec :: Int -> TypedPattern -> ShowS
$cshowsPrec :: Int -> TypedPattern -> ShowS
Show
globDir :: [Pattern] -> FilePath -> IO [[FilePath]]
globDir :: [Pattern] -> String -> IO [[String]]
globDir [Pattern]
pats String
dir = (([[String]], Maybe [String]) -> [[String]])
-> IO ([[String]], Maybe [String]) -> IO [[String]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([[String]], Maybe [String]) -> [[String]]
forall a b. (a, b) -> a
fst (GlobOptions
-> [Pattern] -> String -> IO ([[String]], Maybe [String])
globDirWith GlobOptions
globDefault [Pattern]
pats String
dir)
globDirWith :: GlobOptions -> [Pattern] -> FilePath
-> IO ([[FilePath]], Maybe [FilePath])
globDirWith :: GlobOptions
-> [Pattern] -> String -> IO ([[String]], Maybe [String])
globDirWith GlobOptions
opts [Pattern
pat] String
dir | Bool -> Bool
not (GlobOptions -> Bool
includeUnmatched GlobOptions
opts) =
let (String
prefix, Pattern
pat') = Pattern -> (String, Pattern)
commonDirectory Pattern
pat
in GlobOptions
-> [Pattern] -> String -> IO ([[String]], Maybe [String])
globDirWith' GlobOptions
opts [Pattern
pat'] (String
dir String -> ShowS
</> String
prefix)
globDirWith GlobOptions
opts [Pattern]
pats String
dir =
GlobOptions
-> [Pattern] -> String -> IO ([[String]], Maybe [String])
globDirWith' GlobOptions
opts [Pattern]
pats String
dir
globDirWith' :: GlobOptions -> [Pattern] -> FilePath
-> IO ([[FilePath]], Maybe [FilePath])
globDirWith' :: GlobOptions
-> [Pattern] -> String -> IO ([[String]], Maybe [String])
globDirWith' GlobOptions
opts [] String
dir =
if GlobOptions -> Bool
includeUnmatched GlobOptions
opts
then do
String
dir' <- if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
dir then IO String
getCurrentDirectory else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
dir
DList String
c <- String -> IO (DList String)
getRecursiveContents String
dir'
([[String]], Maybe [String]) -> IO ([[String]], Maybe [String])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [String] -> Maybe [String]
forall a. a -> Maybe a
Just (DList String -> [String]
forall a. DList a -> [a]
DL.toList DList String
c))
else
([[String]], Maybe [String]) -> IO ([[String]], Maybe [String])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe [String]
forall a. Maybe a
Nothing)
globDirWith' GlobOptions
opts pats :: [Pattern]
pats@(Pattern
_:[Pattern]
_) String
dir = do
[(DList String, DList String)]
results <- (Pattern -> IO (DList String, DList String))
-> [Pattern] -> IO [(DList String, DList String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Pattern
p -> GlobOptions -> Pattern -> String -> IO (DList String, DList String)
globDir'0 GlobOptions
opts Pattern
p String
dir) [Pattern]
pats
let ([DList String]
matches, [DList String]
others) = [(DList String, DList String)] -> ([DList String], [DList String])
forall a b. [(a, b)] -> ([a], [b])
unzip [(DList String, DList String)]
results
allMatches :: [String]
allMatches = DList String -> [String]
forall a. DList a -> [a]
DL.toList (DList String -> [String])
-> ([DList String] -> DList String) -> [DList String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DList String] -> DList String
forall a. [DList a] -> DList a
DL.concat ([DList String] -> [String]) -> [DList String] -> [String]
forall a b. (a -> b) -> a -> b
$ [DList String]
matches
allOthers :: [String]
allOthers = DList String -> [String]
forall a. DList a -> [a]
DL.toList (DList String -> [String])
-> ([DList String] -> DList String) -> [DList String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DList String] -> DList String
forall a. [DList a] -> DList a
DL.concat ([DList String] -> [String]) -> [DList String] -> [String]
forall a b. (a -> b) -> a -> b
$ [DList String]
others
([[String]], Maybe [String]) -> IO ([[String]], Maybe [String])
forall (m :: * -> *) a. Monad m => a -> m a
return ( (DList String -> [String]) -> [DList String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map DList String -> [String]
forall a. DList a -> [a]
DL.toList [DList String]
matches
, if GlobOptions -> Bool
includeUnmatched GlobOptions
opts
then [String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd [String]
allOthers [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
allMatches)
else Maybe [String]
forall a. Maybe a
Nothing
)
globDir1 :: Pattern -> FilePath -> IO [FilePath]
globDir1 :: Pattern -> String -> IO [String]
globDir1 Pattern
p = ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[String]] -> [String]
forall a. [a] -> a
head (IO [[String]] -> IO [String])
-> (String -> IO [[String]]) -> String -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern] -> String -> IO [[String]]
globDir [Pattern
p]
glob :: String -> IO [FilePath]
glob :: String -> IO [String]
glob = (Pattern -> String -> IO [String])
-> String -> Pattern -> IO [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Pattern -> String -> IO [String]
globDir1 String
"" (Pattern -> IO [String])
-> (String -> Pattern) -> String -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Pattern
compile
globDir'0 :: GlobOptions -> Pattern -> FilePath
-> IO (DList FilePath, DList FilePath)
globDir'0 :: GlobOptions -> Pattern -> String -> IO (DList String, DList String)
globDir'0 GlobOptions
opts Pattern
pat String
dir = do
let (Pattern
pat', Maybe String
drive) = Pattern -> (Pattern, Maybe String)
driveSplit Pattern
pat
String
dir' <- case Maybe String
drive of
Just String
"" -> ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
takeDrive IO String
getCurrentDirectory
Just String
d -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
d
Maybe String
Nothing -> if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
dir then IO String
getCurrentDirectory else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
dir
GlobOptions
-> [TypedPattern] -> String -> IO (DList String, DList String)
globDir' GlobOptions
opts (Pattern -> [TypedPattern]
separate Pattern
pat') String
dir'
globDir' :: GlobOptions -> [TypedPattern] -> FilePath
-> IO (DList FilePath, DList FilePath)
globDir' :: GlobOptions
-> [TypedPattern] -> String -> IO (DList String, DList String)
globDir' GlobOptions
opts pats :: [TypedPattern]
pats@(TypedPattern
_:[TypedPattern]
_) String
dir = do
[String]
entries <- String -> IO [String]
getDirectoryContents String
dir IO [String] -> (IOException -> IO [String]) -> IO [String]
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` IO [String] -> IOException -> IO [String]
forall a b. a -> b -> a
const ([String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
[(DList String, DList String)]
results <- [String]
-> (String -> IO (DList String, DList String))
-> IO [(DList String, DList String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
entries ((String -> IO (DList String, DList String))
-> IO [(DList String, DList String)])
-> (String -> IO (DList String, DList String))
-> IO [(DList String, DList String)]
forall a b. (a -> b) -> a -> b
$ \String
e -> GlobOptions
-> [TypedPattern]
-> String
-> String
-> IO (DList String, DList String)
matchTypedAndGo GlobOptions
opts [TypedPattern]
pats String
e (String
dir String -> ShowS
</> String
e)
let ([DList String]
matches, [DList String]
others) = [(DList String, DList String)] -> ([DList String], [DList String])
forall a b. [(a, b)] -> ([a], [b])
unzip [(DList String, DList String)]
results
(DList String, DList String) -> IO (DList String, DList String)
forall (m :: * -> *) a. Monad m => a -> m a
return ([DList String] -> DList String
forall a. [DList a] -> DList a
DL.concat [DList String]
matches, [DList String] -> DList String
forall a. [DList a] -> DList a
DL.concat [DList String]
others)
globDir' GlobOptions
_ [] String
dir =
(DList String, DList String) -> IO (DList String, DList String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> DList String
forall a. a -> DList a
DL.singleton (String
dir String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
pathSeparator]), DList String
forall a. DList a
DL.empty)
matchTypedAndGo :: GlobOptions
-> [TypedPattern]
-> FilePath -> FilePath
-> IO (DList FilePath, DList FilePath)
matchTypedAndGo :: GlobOptions
-> [TypedPattern]
-> String
-> String
-> IO (DList String, DList String)
matchTypedAndGo GlobOptions
opts [Any Pattern
p] String
path String
absPath =
if MatchOptions -> Pattern -> String -> Bool
matchWith (GlobOptions -> MatchOptions
matchOptions GlobOptions
opts) Pattern
p String
path
then (DList String, DList String) -> IO (DList String, DList String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> DList String
forall a. a -> DList a
DL.singleton String
absPath, DList String
forall a. DList a
DL.empty)
else String -> IO Bool
doesDirectoryExist String
absPath IO Bool
-> (Bool -> IO (DList String, DList String))
-> IO (DList String, DList String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GlobOptions
-> String -> String -> Bool -> IO (DList String, DList String)
didNotMatch GlobOptions
opts String
path String
absPath
matchTypedAndGo GlobOptions
opts (Dir Int
n Pattern
p:[TypedPattern]
ps) String
path String
absPath = do
Bool
isDir <- String -> IO Bool
doesDirectoryExist String
absPath
if Bool
isDir Bool -> Bool -> Bool
&& MatchOptions -> Pattern -> String -> Bool
matchWith (GlobOptions -> MatchOptions
matchOptions GlobOptions
opts) Pattern
p String
path
then GlobOptions
-> [TypedPattern] -> String -> IO (DList String, DList String)
globDir' GlobOptions
opts [TypedPattern]
ps (String
absPath String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
pathSeparator)
else GlobOptions
-> String -> String -> Bool -> IO (DList String, DList String)
didNotMatch GlobOptions
opts String
path String
absPath Bool
isDir
matchTypedAndGo GlobOptions
opts (AnyDir Int
n Pattern
p:[TypedPattern]
ps) String
path String
absPath =
if String
path String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".",String
".."]
then GlobOptions
-> String -> String -> Bool -> IO (DList String, DList String)
didNotMatch GlobOptions
opts String
path String
absPath Bool
True
else do
Bool
isDir <- String -> IO Bool
doesDirectoryExist String
absPath
let m :: String -> Bool
m = MatchOptions -> Pattern -> String -> Bool
matchWith (GlobOptions -> MatchOptions
matchOptions GlobOptions
opts) ([TypedPattern] -> Pattern
unseparate [TypedPattern]
ps)
unconditionalMatch :: Bool
unconditionalMatch =
[Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Pattern -> [Token]
unPattern Pattern
p) Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isExtSeparator (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Char
forall a. [a] -> a
head String
path)
p' :: Pattern
p' = [Token] -> Pattern
Pattern (Pattern -> [Token]
unPattern Pattern
p [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token
AnyNonPathSeparator])
case Bool
unconditionalMatch Bool -> Bool -> Bool
|| MatchOptions -> Pattern -> String -> Bool
matchWith (GlobOptions -> MatchOptions
matchOptions GlobOptions
opts) Pattern
p' String
path of
Bool
True | Bool
isDir -> do
DList String
contents <- String -> IO (DList String)
getRecursiveContents String
absPath
(DList String, DList String) -> IO (DList String, DList String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((DList String, DList String) -> IO (DList String, DList String))
-> (DList String, DList String) -> IO (DList String, DList String)
forall a b. (a -> b) -> a -> b
$
if [TypedPattern] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypedPattern]
ps
then ( String -> DList String
forall a. a -> DList a
DL.singleton (String -> DList String) -> String -> DList String
forall a b. (a -> b) -> a -> b
$
DList String -> String
forall a. DList a -> a
DL.head DList String
contents
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
pathSeparator
, DList String -> DList String
forall a. DList a -> DList a
tailDL DList String
contents
)
else let (DList (Bool, String)
matches, DList (Bool, String)
nonMatches) =
((Bool, String) -> Bool)
-> DList (Bool, String)
-> (DList (Bool, String), DList (Bool, String))
forall a. (a -> Bool) -> DList a -> (DList a, DList a)
partitionDL (Bool, String) -> Bool
forall a b. (a, b) -> a
fst
((String -> (Bool, String)) -> DList String -> DList (Bool, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> (String -> Bool) -> String -> (Bool, String)
recursiveMatch Int
n String -> Bool
m) DList String
contents)
in (((Bool, String) -> String) -> DList (Bool, String) -> DList String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool, String) -> String
forall a b. (a, b) -> b
snd DList (Bool, String)
matches, ((Bool, String) -> String) -> DList (Bool, String) -> DList String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool, String) -> String
forall a b. (a, b) -> b
snd DList (Bool, String)
nonMatches)
Bool
True | String -> Bool
m String
path ->
(DList String, DList String) -> IO (DList String, DList String)
forall (m :: * -> *) a. Monad m => a -> m a
return ( String -> DList String
forall a. a -> DList a
DL.singleton (String -> DList String) -> String -> DList String
forall a b. (a -> b) -> a -> b
$
ShowS
takeDirectory String
absPath
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
pathSeparator
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path
, DList String
forall a. DList a
DL.empty
)
Bool
_ ->
GlobOptions
-> String -> String -> Bool -> IO (DList String, DList String)
didNotMatch GlobOptions
opts String
path String
absPath Bool
isDir
matchTypedAndGo GlobOptions
_ [TypedPattern]
_ String
_ String
_ = String -> IO (DList String, DList String)
forall a. HasCallStack => String -> a
error String
"Glob.matchTypedAndGo :: internal error"
recursiveMatch :: Int -> (FilePath -> Bool) -> FilePath -> (Bool, FilePath)
recursiveMatch :: Int -> (String -> Bool) -> String -> (Bool, String)
recursiveMatch Int
n String -> Bool
isMatch String
path =
case (String -> Bool) -> [String] -> Maybe String
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find String -> Bool
isMatch (String -> [String]
pathParts String
path) of
Just String
matchedSuffix ->
let dir :: String
dir = Int -> ShowS
forall a. Int -> [a] -> [a]
take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
path Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
matchedSuffix) String
path
in ( Bool
True
, String
dir
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Char
pathSeparator
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
matchedSuffix
)
Maybe String
Nothing ->
(Bool
False, String
path)
didNotMatch :: GlobOptions -> FilePath -> FilePath -> Bool
-> IO (DList FilePath, DList FilePath)
didNotMatch :: GlobOptions
-> String -> String -> Bool -> IO (DList String, DList String)
didNotMatch GlobOptions
opts String
path String
absPath Bool
isDir =
if GlobOptions -> Bool
includeUnmatched GlobOptions
opts
then (DList String -> (DList String, DList String))
-> IO (DList String) -> IO (DList String, DList String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) DList String
forall a. DList a
DL.empty) (IO (DList String) -> IO (DList String, DList String))
-> IO (DList String) -> IO (DList String, DList String)
forall a b. (a -> b) -> a -> b
$
if Bool
isDir
then if String
path String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".",String
".."]
then DList String -> IO (DList String)
forall (m :: * -> *) a. Monad m => a -> m a
return DList String
forall a. DList a
DL.empty
else String -> IO (DList String)
getRecursiveContents String
absPath
else DList String -> IO (DList String)
forall (m :: * -> *) a. Monad m => a -> m a
return(DList String -> IO (DList String))
-> DList String -> IO (DList String)
forall a b. (a -> b) -> a -> b
$ String -> DList String
forall a. a -> DList a
DL.singleton String
absPath
else
(DList String, DList String) -> IO (DList String, DList String)
forall (m :: * -> *) a. Monad m => a -> m a
return (DList String
forall a. DList a
DL.empty, DList String
forall a. DList a
DL.empty)
separate :: Pattern -> [TypedPattern]
separate :: Pattern -> [TypedPattern]
separate = DList Token -> [Token] -> [TypedPattern]
go DList Token
forall a. DList a
DL.empty ([Token] -> [TypedPattern])
-> (Pattern -> [Token]) -> Pattern -> [TypedPattern]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> [Token]
unPattern
where
go :: DList Token -> [Token] -> [TypedPattern]
go DList Token
gr [] | [Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DList Token -> [Token]
forall a. DList a -> [a]
DL.toList DList Token
gr) = []
go DList Token
gr [] = [Pattern -> TypedPattern
Any (DList Token -> Pattern
pat DList Token
gr)]
go DList Token
gr (Token
PathSeparator:[Token]
ps) = DList Token
-> (Int -> Pattern -> TypedPattern) -> [Token] -> [TypedPattern]
slash DList Token
gr Int -> Pattern -> TypedPattern
Dir [Token]
ps
go DList Token
gr ( Token
AnyDirectory:[Token]
ps) = DList Token
-> (Int -> Pattern -> TypedPattern) -> [Token] -> [TypedPattern]
slash DList Token
gr Int -> Pattern -> TypedPattern
AnyDir [Token]
ps
go DList Token
gr ( Token
p:[Token]
ps) = DList Token -> [Token] -> [TypedPattern]
go (DList Token
gr DList Token -> Token -> DList Token
forall a. DList a -> a -> DList a
`DL.snoc` Token
p) [Token]
ps
pat :: DList Token -> Pattern
pat = [Token] -> Pattern
Pattern ([Token] -> Pattern)
-> (DList Token -> [Token]) -> DList Token -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList Token -> [Token]
forall a. DList a -> [a]
DL.toList
slash :: DList Token
-> (Int -> Pattern -> TypedPattern) -> [Token] -> [TypedPattern]
slash DList Token
gr Int -> Pattern -> TypedPattern
f [Token]
ps = let (Int
n,[Token]
ps') = ([Token] -> Int) -> ([Token], [Token]) -> (Int, [Token])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [Token] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (([Token], [Token]) -> (Int, [Token]))
-> ([Token] -> ([Token], [Token])) -> [Token] -> (Int, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token -> Bool) -> [Token] -> ([Token], [Token])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Token -> Bool
isSlash ([Token] -> (Int, [Token])) -> [Token] -> (Int, [Token])
forall a b. (a -> b) -> a -> b
$ [Token]
ps
in Int -> Pattern -> TypedPattern
f (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (DList Token -> Pattern
pat DList Token
gr) TypedPattern -> [TypedPattern] -> [TypedPattern]
forall a. a -> [a] -> [a]
: DList Token -> [Token] -> [TypedPattern]
go DList Token
forall a. DList a
DL.empty [Token]
ps'
isSlash :: Token -> Bool
isSlash Token
PathSeparator = Bool
True
isSlash Token
_ = Bool
False
unseparate :: [TypedPattern] -> Pattern
unseparate :: [TypedPattern] -> Pattern
unseparate = [Token] -> Pattern
Pattern ([Token] -> Pattern)
-> ([TypedPattern] -> [Token]) -> [TypedPattern] -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypedPattern -> [Token] -> [Token])
-> [Token] -> [TypedPattern] -> [Token]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TypedPattern -> [Token] -> [Token]
f []
where
f :: TypedPattern -> [Token] -> [Token]
f (AnyDir Int
n Pattern
p) [Token]
ts = Pattern -> [Token]
u Pattern
p [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ Token
AnyDirectory Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Int -> Token -> [Token]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Token
PathSeparator [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token]
ts
f ( Dir Int
n Pattern
p) [Token]
ts = Pattern -> [Token]
u Pattern
p [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ Int -> Token -> [Token]
forall a. Int -> a -> [a]
replicate Int
n Token
PathSeparator [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token]
ts
f (Any Pattern
p) [Token]
ts = Pattern -> [Token]
u Pattern
p [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token]
ts
u :: Pattern -> [Token]
u = Pattern -> [Token]
unPattern
driveSplit :: Pattern -> (Pattern, Maybe FilePath)
driveSplit :: Pattern -> (Pattern, Maybe String)
driveSplit = (String, [Token]) -> (Pattern, Maybe String)
check ((String, [Token]) -> (Pattern, Maybe String))
-> (Pattern -> (String, [Token]))
-> Pattern
-> (Pattern, Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Token] -> (String, [Token])
split ([Token] -> (String, [Token]))
-> (Pattern -> [Token]) -> Pattern -> (String, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> [Token]
unPattern
where
split :: [Token] -> (String, [Token])
split (LongLiteral Int
_ String
l : [Token]
xs) = ShowS -> (String, [Token]) -> (String, [Token])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (String
lString -> ShowS
forall a. [a] -> [a] -> [a]
++) ([Token] -> (String, [Token])
split [Token]
xs)
split ( Literal Char
l : [Token]
xs) = ShowS -> (String, [Token]) -> (String, [Token])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Char
lChar -> ShowS
forall a. a -> [a] -> [a]
:) ([Token] -> (String, [Token])
split [Token]
xs)
split (Token
PathSeparator : [Token]
xs) = ShowS -> (String, [Token]) -> (String, [Token])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Char
pathSeparatorChar -> ShowS
forall a. a -> [a] -> [a]
:) ([Token] -> (String, [Token])
split [Token]
xs)
split [Token]
xs = ([],[Token]
xs)
check :: (String, [Token]) -> (Pattern, Maybe String)
check (String
d,[Token]
ps)
| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
d = ([Token] -> Pattern
Pattern [Token]
ps, Maybe String
forall a. Maybe a
Nothing)
| Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
drive) = (String -> [Token] -> Pattern
forall (t :: * -> *). Foldable t => t Char -> [Token] -> Pattern
dirify String
rest [Token]
ps, String -> Maybe String
forall a. a -> Maybe a
Just String
drive)
| Char -> Bool
isPathSeparator (String -> Char
forall a. [a] -> a
head String
rest) = ([Token] -> Pattern
Pattern [Token]
ps, String -> Maybe String
forall a. a -> Maybe a
Just String
"")
| Bool
otherwise = (String -> [Token] -> Pattern
forall (t :: * -> *). Foldable t => t Char -> [Token] -> Pattern
dirify String
d [Token]
ps, Maybe String
forall a. Maybe a
Nothing)
where
(String
drive, String
rest) = String -> (String, String)
splitDrive String
d
dirify :: t Char -> [Token] -> Pattern
dirify t Char
path = [Token] -> Pattern
Pattern ([Token] -> Pattern) -> ([Token] -> [Token]) -> [Token] -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t Char -> [Token]
forall (t :: * -> *). Foldable t => t Char -> [Token]
comp t Char
path[Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++)
comp :: t Char -> [Token]
comp t Char
s = let ([Token]
p,String
l) = (Char -> ([Token], String) -> ([Token], String))
-> ([Token], String) -> t Char -> ([Token], String)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> ([Token], String) -> ([Token], String)
f ([],[]) t Char
s in if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
l then [Token]
p else String -> [Token] -> [Token]
ll String
l [Token]
p
where
f :: Char -> ([Token], String) -> ([Token], String)
f Char
c ([Token]
p,String
l) | Char -> Bool
isExtSeparator Char
c = (Char -> Token
Literal Char
'.' Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token] -> [Token]
ll String
l [Token]
p, [])
| Char -> Bool
isPathSeparator Char
c = (Token
PathSeparator Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token] -> [Token]
ll String
l [Token]
p, [])
| Bool
otherwise = ([Token]
p, Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
l)
ll :: String -> [Token] -> [Token]
ll String
l [Token]
p = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
l then [Token]
p else Int -> String -> Token
LongLiteral (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
l) String
l Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
p
commonDirectory :: Pattern -> (FilePath, Pattern)
commonDirectory :: Pattern -> (String, Pattern)
commonDirectory = ([TypedPattern] -> Pattern)
-> (String, [TypedPattern]) -> (String, Pattern)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [TypedPattern] -> Pattern
unseparate ((String, [TypedPattern]) -> (String, Pattern))
-> (Pattern -> (String, [TypedPattern]))
-> Pattern
-> (String, Pattern)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TypedPattern] -> (String, [TypedPattern])
splitP ([TypedPattern] -> (String, [TypedPattern]))
-> (Pattern -> [TypedPattern])
-> Pattern
-> (String, [TypedPattern])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> [TypedPattern]
separate
where
splitP :: [TypedPattern] -> (String, [TypedPattern])
splitP pt :: [TypedPattern]
pt@(Dir Int
n Pattern
p:[TypedPattern]
ps) =
case DList Char -> [Token] -> Maybe String
fromConst DList Char
forall a. DList a
DL.empty (Pattern -> [Token]
unPattern Pattern
p) of
Just String
d -> ShowS -> (String, [TypedPattern]) -> (String, [TypedPattern])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((String
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
pathSeparator) String -> ShowS
</>) ([TypedPattern] -> (String, [TypedPattern])
splitP [TypedPattern]
ps)
Maybe String
Nothing -> (String
"", [TypedPattern]
pt)
splitP [TypedPattern]
pt = (String
"", [TypedPattern]
pt)
fromConst :: DList Char -> [Token] -> Maybe String
fromConst DList Char
d [] = String -> Maybe String
forall a. a -> Maybe a
Just (DList Char -> String
forall a. DList a -> [a]
DL.toList DList Char
d)
fromConst DList Char
d (Literal Char
c :[Token]
xs) = DList Char -> [Token] -> Maybe String
fromConst (DList Char
d DList Char -> Char -> DList Char
forall a. DList a -> a -> DList a
`DL.snoc` Char
c) [Token]
xs
fromConst DList Char
d (LongLiteral Int
_ String
s:[Token]
xs) = DList Char -> [Token] -> Maybe String
fromConst (DList Char
d DList Char -> DList Char -> DList Char
forall a. DList a -> DList a -> DList a
`DL.append`String -> DList Char
forall a. [a] -> DList a
DL.fromList String
s) [Token]
xs
fromConst DList Char
_ [Token]
_ = Maybe String
forall a. Maybe a
Nothing