-- | 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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> [Char]
$cshow :: Path -> [Char]
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
Show,Path -> Path -> Bool
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
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
Ord)

newtype Pattern = Pattern (Wildcard [Wildcard String])
    deriving (Int -> Pattern -> ShowS
[Pattern] -> ShowS
Pattern -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Pattern] -> ShowS
$cshowList :: [Pattern] -> ShowS
show :: Pattern -> [Char]
$cshow :: Pattern -> [Char]
showsPrec :: Int -> Pattern -> ShowS
$cshowsPrec :: Int -> Pattern -> ShowS
Show,Pattern -> Pattern -> Bool
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
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
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 :: [Char] -> Path
parsePath = [[Char]] -> Path
Path forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [[a]]
split Char -> Bool
isPathSeparator

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

parsePattern :: FilePattern -> Pattern
parsePattern :: [Char] -> Pattern
parsePattern = Wildcard [Wildcard [Char]] -> Pattern
Pattern forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> Wildcard [a]
f Char
'*') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> [a] -> Wildcard [a]
f [Char]
"**" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [[a]]
split Char -> Bool
isPathSeparator
    where
        f :: Eq a => a -> [a] -> Wildcard [a]
        f :: forall a. Eq a => a -> [a] -> Wildcard [a]
f a
x [a]
xs = case forall a. (a -> Bool) -> [a] -> [[a]]
split (forall a. Eq a => a -> a -> Bool
== a
x) [a]
xs of
            [a]
pre:[[a]]
mid_post -> case forall a. [a] -> Maybe ([a], a)
unsnoc [[a]]
mid_post of
                Maybe ([[a]], [a])
Nothing -> forall a. a -> Wildcard a
Literal [a]
pre
                Just ([[a]]
mid, [a]
post) -> 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 :: [[Char]] -> [Char]
mkParts [[Char]]
xs | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
xs = forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
xs) Char
'/'
           | Bool
otherwise = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"/" [[Char]]
xs

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

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


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


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