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