-- | The type of patterns and wildcards, and operations working on parsed versions.
module System.FilePattern.Core(
    FilePattern,
    Pattern(..), parsePattern,
    Path(..), parsePath, renderPath,
    mkParts,
    match, substitute,
    arity
    ) where

import Data.Functor
import Control.Applicative
import System.FilePattern.Wildcard
import System.FilePath (isPathSeparator)
import Data.Either.Extra
import Data.Traversable
import qualified Data.Foldable as F
import System.FilePattern.Monads
import Data.List.Extra
import Prelude


-- | A type synonym for file patterns, containing @**@ and @*@. For the syntax
--   and semantics of 'FilePattern' see 'System.FilePattern.?=='.
--
--   Most 'FilePath' values lacking literal @.@ and @..@ components 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 '<.>' and '</>' (but be aware that @\"\" '</>' \"foo\"@ produces @\"./foo\"@).
type FilePattern = String


newtype Path = Path [String]
    deriving (Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
(Int -> Path -> ShowS)
-> (Path -> String) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> String
$cshow :: Path -> String
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
Show,Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq,Eq Path
Eq Path
-> (Path -> Path -> Ordering)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Path)
-> (Path -> Path -> Path)
-> Ord Path
Path -> Path -> Bool
Path -> Path -> Ordering
Path -> Path -> Path
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
min :: Path -> Path -> Path
$cmin :: Path -> Path -> Path
max :: Path -> Path -> Path
$cmax :: Path -> Path -> Path
>= :: Path -> Path -> Bool
$c>= :: Path -> Path -> Bool
> :: Path -> Path -> Bool
$c> :: Path -> Path -> Bool
<= :: Path -> Path -> Bool
$c<= :: Path -> Path -> Bool
< :: Path -> Path -> Bool
$c< :: Path -> Path -> Bool
compare :: Path -> Path -> Ordering
$ccompare :: Path -> Path -> Ordering
$cp1Ord :: Eq Path
Ord)

newtype Pattern = Pattern (Wildcard [Wildcard String])
    deriving (Int -> Pattern -> ShowS
[Pattern] -> ShowS
Pattern -> String
(Int -> Pattern -> ShowS)
-> (Pattern -> String) -> ([Pattern] -> ShowS) -> Show Pattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pattern] -> ShowS
$cshowList :: [Pattern] -> ShowS
show :: Pattern -> String
$cshow :: Pattern -> String
showsPrec :: Int -> Pattern -> ShowS
$cshowsPrec :: Int -> Pattern -> ShowS
Show,Pattern -> Pattern -> Bool
(Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool) -> Eq Pattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pattern -> Pattern -> Bool
$c/= :: Pattern -> Pattern -> Bool
== :: Pattern -> Pattern -> Bool
$c== :: Pattern -> Pattern -> Bool
Eq,Eq Pattern
Eq Pattern
-> (Pattern -> Pattern -> Ordering)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Pattern)
-> (Pattern -> Pattern -> Pattern)
-> Ord Pattern
Pattern -> Pattern -> Bool
Pattern -> Pattern -> Ordering
Pattern -> Pattern -> Pattern
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
min :: Pattern -> Pattern -> Pattern
$cmin :: Pattern -> Pattern -> Pattern
max :: Pattern -> Pattern -> Pattern
$cmax :: Pattern -> Pattern -> Pattern
>= :: Pattern -> Pattern -> Bool
$c>= :: Pattern -> Pattern -> Bool
> :: Pattern -> Pattern -> Bool
$c> :: Pattern -> Pattern -> Bool
<= :: Pattern -> Pattern -> Bool
$c<= :: Pattern -> Pattern -> Bool
< :: Pattern -> Pattern -> Bool
$c< :: Pattern -> Pattern -> Bool
compare :: Pattern -> Pattern -> Ordering
$ccompare :: Pattern -> Pattern -> Ordering
$cp1Ord :: Eq Pattern
Ord)


-- [Note: Split on ""]
--
-- For parsing patterns and paths, "" can either be [] or [""].
-- Assuming they are consistent, the only cases that are relevant are:
--
-- > match "" "" = Just []
-- > match "*" "" = if [] then Nothing else Just [""]
-- > match "**" "" = if [] then Just [] else Just [""]
--
-- We pick "" splits as [""] because that is slightly more permissive,
-- follows the builtin semantics of split, and matches the 'filepath'
-- library slightly better.

parsePath :: FilePath -> Path
parsePath :: String -> Path
parsePath = [String] -> Path
Path ([String] -> Path) -> (String -> [String]) -> String -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
split Char -> Bool
isPathSeparator

renderPath :: Path -> FilePattern
renderPath :: Path -> String
renderPath (Path [String]
x) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"/" [String]
x

parsePattern :: FilePattern -> Pattern
parsePattern :: String -> Pattern
parsePattern = Wildcard [Wildcard String] -> Pattern
Pattern (Wildcard [Wildcard String] -> Pattern)
-> (String -> Wildcard [Wildcard String]) -> String -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> [Wildcard String])
-> Wildcard [String] -> Wildcard [Wildcard String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Wildcard String) -> [String] -> [Wildcard String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Wildcard String) -> [String] -> [Wildcard String])
-> (String -> Wildcard String) -> [String] -> [Wildcard String]
forall a b. (a -> b) -> a -> b
$ Char -> String -> Wildcard String
forall a. Eq a => a -> [a] -> Wildcard [a]
f Char
'*') (Wildcard [String] -> Wildcard [Wildcard String])
-> (String -> Wildcard [String])
-> String
-> Wildcard [Wildcard String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> Wildcard [String]
forall a. Eq a => a -> [a] -> Wildcard [a]
f String
"**" ([String] -> Wildcard [String])
-> (String -> [String]) -> String -> Wildcard [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
split Char -> Bool
isPathSeparator
    where
        f :: Eq a => a -> [a] -> Wildcard [a]
        f :: a -> [a] -> Wildcard [a]
f a
x [a]
xs = case (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
split (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x) [a]
xs of
            [a]
pre:[[a]]
mid_post -> case [[a]] -> Maybe ([[a]], [a])
forall a. [a] -> Maybe ([a], a)
unsnoc [[a]]
mid_post of
                Maybe ([[a]], [a])
Nothing -> [a] -> Wildcard [a]
forall a. a -> Wildcard a
Literal [a]
pre
                Just ([[a]]
mid, [a]
post) -> [a] -> [[a]] -> [a] -> Wildcard [a]
forall a. a -> [a] -> a -> Wildcard a
Wildcard [a]
pre [[a]]
mid [a]
post


-- [Note: Conversion of parts to String]
--
-- The match of * is String, but the match for ** is really [String].
-- To simplify the API, since everything else is String encoding [String],
-- we want to convert that [String] to String. We considered 3 solutions.
--
-- 1) Since we know the elements of [String] don't contain /, a natural
-- solution is to insert / characters between items with intercalate, but that
-- doesn't work because [] and [""] end up with the same representation, but
-- are very different, e.g.
--
-- > match "**/a" "a"  = Just []
-- > match "**/a" "/a" = Just [""]
--
-- 2) We can join with "/" after every component, so ["a","b"] becomes
-- "a/b/". But that causes / characters to appear from nowhere, e.g.
--
-- > match "**" "a" = Just ["a/"]
--
-- 3) Logically, the only sensible encoding for [] must be "". Because [""]
-- can't be "" (would clash), it must be "/". Therefore we follow solution 2 normally,
-- but switch to solution 1 iff all the components are empty.
-- We implement this scheme with mkParts/fromParts.
--
-- Even after all that, we still have weird corner cases like:
--
-- > match "**" "/" = Just ["//"]
--
-- But the only realistic path it applies to is /, which should be pretty rare.


mkParts :: [String] -> String
mkParts :: [String] -> String
mkParts [String]
xs | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xs = Int -> Char -> String
forall a. Int -> a -> [a]
replicate ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs) Char
'/'
           | Bool
otherwise = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"/" [String]
xs

fromParts :: String -> [String]
fromParts :: String -> [String]
fromParts String
xs | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isPathSeparator String
xs = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
xs) []
             | Bool
otherwise = (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
split Char -> Bool
isPathSeparator String
xs

match :: Pattern -> Path -> Maybe [String]
match :: Pattern -> Path -> Maybe [String]
match (Pattern Wildcard [Wildcard String]
w) (Path [String]
x) = [Either [[Either [()] String]] [String]] -> [String]
f ([Either [[Either [()] String]] [String]] -> [String])
-> Maybe [Either [[Either [()] String]] [String]] -> Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Wildcard String -> String -> Maybe [Either [()] String])
-> Wildcard [Wildcard String]
-> [String]
-> Maybe [Either [[Either [()] String]] [String]]
forall a b c.
(a -> b -> Maybe c)
-> Wildcard [a] -> [b] -> Maybe [Either [c] [b]]
wildcardMatch ((Char -> Char -> Maybe ())
-> Wildcard String -> String -> Maybe [Either [()] String]
forall a b c.
(a -> b -> Maybe c)
-> Wildcard [a] -> [b] -> Maybe [Either [c] [b]]
wildcardMatch Char -> Char -> Maybe ()
forall a. Eq a => a -> a -> Maybe ()
equals) Wildcard [Wildcard String]
w [String]
x
    where
        f :: [Either [[Either [()] String]] [String]] -> [String]
        f :: [Either [[Either [()] String]] [String]] -> [String]
f (Left [[Either [()] String]]
x:[Either [[Either [()] String]] [String]]
xs) = [Either [()] String] -> [String]
forall a b. [Either a b] -> [b]
rights ([[Either [()] String]] -> [Either [()] String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Either [()] String]]
x) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [Either [[Either [()] String]] [String]] -> [String]
f [Either [[Either [()] String]] [String]]
xs
        f (Right [String]
x:[Either [[Either [()] String]] [String]]
xs) = [String] -> String
mkParts [String]
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [Either [[Either [()] String]] [String]] -> [String]
f [Either [[Either [()] String]] [String]]
xs
        f [] = []


substitute :: Pattern -> [String] -> Maybe Path
substitute :: Pattern -> [String] -> Maybe Path
substitute (Pattern Wildcard [Wildcard String]
w) [String]
ps = do
    let inner :: Wildcard [a] -> Next [a] [a]
inner Wildcard [a]
w = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> Next [a] [[a]] -> Next [a] [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Next [a] [a]
-> ([a] -> Next [a] [a]) -> Wildcard [a] -> Next [a] [[a]]
forall (m :: * -> *) b a.
Applicative m =>
m b -> (a -> m b) -> Wildcard a -> m [b]
wildcardSubst Next [a] [a]
forall e. Next e e
getNext [a] -> Next [a] [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Wildcard [a]
w
        outer :: Wildcard [Wildcard String] -> Next String [String]
outer Wildcard [Wildcard String]
w = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> Next String [[String]] -> Next String [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Next String [String]
-> ([Wildcard String] -> Next String [String])
-> Wildcard [Wildcard String]
-> Next String [[String]]
forall (m :: * -> *) b a.
Applicative m =>
m b -> (a -> m b) -> Wildcard a -> m [b]
wildcardSubst (String -> [String]
fromParts (String -> [String]) -> Next String String -> Next String [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Next String String
forall e. Next e e
getNext) ((Wildcard String -> Next String String)
-> [Wildcard String] -> Next String [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Wildcard String -> Next String String
forall a. Wildcard [a] -> Next [a] [a]
inner) Wildcard [Wildcard String]
w
    ([String]
ps, [String]
v) <- [String] -> Next String [String] -> Maybe ([String], [String])
forall e a. [e] -> Next e a -> Maybe ([e], a)
runNext [String]
ps (Next String [String] -> Maybe ([String], [String]))
-> Next String [String] -> Maybe ([String], [String])
forall a b. (a -> b) -> a -> b
$ Wildcard [Wildcard String] -> Next String [String]
outer Wildcard [Wildcard String]
w
    if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ps then Path -> Maybe Path
forall a. a -> Maybe a
Just (Path -> Maybe Path) -> Path -> Maybe Path
forall a b. (a -> b) -> a -> b
$ [String] -> Path
Path [String]
v else Maybe Path
forall a. Maybe a
Nothing


arity :: Pattern -> Int
arity :: Pattern -> Int
arity (Pattern Wildcard [Wildcard String]
x) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Wildcard [Wildcard String] -> Int
forall a. Wildcard a -> Int
wildcardArity Wildcard [Wildcard String]
x Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Wildcard String -> Int) -> [Wildcard String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Wildcard String -> Int
forall a. Wildcard a -> Int
wildcardArity ([[Wildcard String]] -> [Wildcard String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Wildcard String]] -> [Wildcard String])
-> [[Wildcard String]] -> [Wildcard String]
forall a b. (a -> b) -> a -> b
$ Wildcard [Wildcard String] -> [[Wildcard String]]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Wildcard [Wildcard String]
x)