{-# LANGUAGE PatternGuards, ViewPatterns #-}

module Development.Shake.Internal.FilePattern(
    -- * Primitive API, as exposed
    FilePattern, (?==), (<//>),
    -- * General API, used by other people.
    filePattern,
    -- * Optimisation opportunities
    simple,
    -- * Multipattern file rules
    compatible, extract, substitute,
    -- * Accelerated searching
    Walk(..), walk,
    -- * Testing only
    internalTest, isRelativePath, isRelativePattern
    ) where

import Development.Shake.Internal.Errors
import System.FilePath(isPathSeparator)
import Data.List.Extra
import Control.Applicative
import Control.Monad
import Data.Char
import Data.Tuple.Extra
import Data.Maybe
import System.Info.Extra
import Prelude


-- | 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.
type FilePattern = String

infixr 5 <//>

-- | 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
a :: FilePattern
a <//> :: FilePattern -> FilePattern -> FilePattern
<//> b :: FilePattern
b = (Char -> Bool) -> FilePattern -> FilePattern
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isPathSeparator FilePattern
a FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ "//" FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ (Char -> Bool) -> FilePattern -> FilePattern
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isPathSeparator FilePattern
b


---------------------------------------------------------------------
-- PATTERNS

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

isLit :: Pat -> Bool
isLit Lit{} = Bool
True; isLit _ = Bool
False
fromLit :: Pat -> FilePattern
fromLit (Lit x :: FilePattern
x) = FilePattern
x


data Lexeme = Str String | Slash | SlashSlash

lexer :: FilePattern -> [Lexeme]
lexer :: FilePattern -> [Lexeme]
lexer "" = []
lexer (x1 :: Char
x1:x2 :: Char
x2:xs :: FilePattern
xs) | Char -> Bool
isPathSeparator Char
x1, Char -> Bool
isPathSeparator Char
x2 = Lexeme
SlashSlash Lexeme -> [Lexeme] -> [Lexeme]
forall a. a -> [a] -> [a]
: FilePattern -> [Lexeme]
lexer FilePattern
xs
lexer (x1 :: Char
x1:xs :: FilePattern
xs) | Char -> Bool
isPathSeparator Char
x1 = Lexeme
Slash Lexeme -> [Lexeme] -> [Lexeme]
forall a. a -> [a] -> [a]
: FilePattern -> [Lexeme]
lexer FilePattern
xs
lexer xs :: FilePattern
xs = FilePattern -> Lexeme
Str FilePattern
a Lexeme -> [Lexeme] -> [Lexeme]
forall a. a -> [a] -> [a]
: FilePattern -> [Lexeme]
lexer FilePattern
b
    where (a :: FilePattern
a,b :: FilePattern
b) = (Char -> Bool) -> FilePattern -> (FilePattern, FilePattern)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isPathSeparator FilePattern
xs


-- | Parse a FilePattern. All optimisations I can think of are invalid because they change the extracted expressions.
parse :: FilePattern -> [Pat]
parse :: FilePattern -> [Pat]
parse = Bool -> Bool -> [Lexeme] -> [Pat]
f Bool
False Bool
True ([Lexeme] -> [Pat])
-> (FilePattern -> [Lexeme]) -> FilePattern -> [Pat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePattern -> [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 Slash
        f :: Bool -> Bool -> [Lexeme] -> [Pat]
f str :: Bool
str slash :: Bool
slash [] = [FilePattern -> Pat
Lit "" | Bool
slash]
        f str :: Bool
str slash :: Bool
slash (Str "**":xs :: [Lexeme]
xs) = Pat
Skip Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
: Bool -> Bool -> [Lexeme] -> [Pat]
f Bool
True Bool
False [Lexeme]
xs
        f str :: Bool
str slash :: Bool
slash (Str x :: FilePattern
x:xs :: [Lexeme]
xs) = FilePattern -> Pat
parseLit FilePattern
x Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
: Bool -> Bool -> [Lexeme] -> [Pat]
f Bool
True Bool
False [Lexeme]
xs
        f str :: Bool
str slash :: Bool
slash (SlashSlash:Slash:xs :: [Lexeme]
xs) | Bool -> Bool
not Bool
str = Pat
Skip1 Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
: Bool -> Bool -> [Lexeme] -> [Pat]
f Bool
str Bool
True [Lexeme]
xs
        f str :: Bool
str slash :: Bool
slash (SlashSlash:xs :: [Lexeme]
xs) = Pat
Skip Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
: Bool -> Bool -> [Lexeme] -> [Pat]
f Bool
str Bool
False [Lexeme]
xs
        f str :: Bool
str slash :: Bool
slash (Slash:xs :: [Lexeme]
xs) = [FilePattern -> Pat
Lit "" | Bool -> Bool
not Bool
str] [Pat] -> [Pat] -> [Pat]
forall a. [a] -> [a] -> [a]
++ Bool -> Bool -> [Lexeme] -> [Pat]
f Bool
str Bool
True [Lexeme]
xs


parseLit :: String -> Pat
parseLit :: FilePattern -> Pat
parseLit "*" = Pat
Star
parseLit x :: FilePattern
x = case (Char -> Bool) -> FilePattern -> [FilePattern]
forall a. (a -> Bool) -> [a] -> [[a]]
split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '*') FilePattern
x of
    [x :: FilePattern
x] -> FilePattern -> Pat
Lit FilePattern
x
    pre :: FilePattern
pre:xs :: [FilePattern]
xs | Just (mid :: [FilePattern]
mid,post :: FilePattern
post) <- [FilePattern] -> Maybe ([FilePattern], FilePattern)
forall a. [a] -> Maybe ([a], a)
unsnoc [FilePattern]
xs -> FilePattern -> [FilePattern] -> FilePattern -> Pat
Stars FilePattern
pre [FilePattern]
mid FilePattern
post


internalTest :: IO ()
internalTest :: IO ()
internalTest = do
    let x :: FilePattern
x # :: FilePattern -> [Pat] -> f ()
# y :: [Pat]
y = Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePattern -> [Pat]
parse FilePattern
x [Pat] -> [Pat] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Pat]
y) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$ FilePattern -> f ()
forall (m :: * -> *) a. MonadFail m => FilePattern -> m a
fail (FilePattern -> f ()) -> FilePattern -> f ()
forall a b. (a -> b) -> a -> b
$ (FilePattern, FilePattern, [Pat], [Pat]) -> FilePattern
forall a. Show a => a -> FilePattern
show ("FilePattern.internalTest",FilePattern
x,FilePattern -> [Pat]
parse FilePattern
x,[Pat]
y)
    "" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [FilePattern -> Pat
Lit ""]
    "x" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [FilePattern -> Pat
Lit "x"]
    "/" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [FilePattern -> Pat
Lit "",FilePattern -> Pat
Lit ""]
    "x/" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [FilePattern -> Pat
Lit "x",FilePattern -> Pat
Lit ""]
    "/x" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [FilePattern -> Pat
Lit "",FilePattern -> Pat
Lit "x"]
    "x/y" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [FilePattern -> Pat
Lit "x",FilePattern -> Pat
Lit "y"]
    "//" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [Pat
Skip]
    "**" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [Pat
Skip]
    "//x" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [Pat
Skip, FilePattern -> Pat
Lit "x"]
    "**/x" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [Pat
Skip, FilePattern -> Pat
Lit "x"]
    "x//" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [FilePattern -> Pat
Lit "x", Pat
Skip]
    "x/**" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [FilePattern -> Pat
Lit "x", Pat
Skip]
    "x//y" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [FilePattern -> Pat
Lit "x",Pat
Skip, FilePattern -> Pat
Lit "y"]
    "x/**/y" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [FilePattern -> Pat
Lit "x",Pat
Skip, FilePattern -> Pat
Lit "y"]
    "///" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [Pat
Skip1, FilePattern -> Pat
Lit ""]
    "**/**" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [Pat
Skip,Pat
Skip]
    "**/**/" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [Pat
Skip, Pat
Skip, FilePattern -> Pat
Lit ""]
    "///x" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [Pat
Skip1, FilePattern -> Pat
Lit "x"]
    "**/x" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [Pat
Skip, FilePattern -> Pat
Lit "x"]
    "x///" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [FilePattern -> Pat
Lit "x", Pat
Skip, FilePattern -> Pat
Lit ""]
    "x/**/" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [FilePattern -> Pat
Lit "x", Pat
Skip, FilePattern -> Pat
Lit ""]
    "x///y" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [FilePattern -> Pat
Lit "x",Pat
Skip, FilePattern -> Pat
Lit "y"]
    "x/**/y" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [FilePattern -> Pat
Lit "x",Pat
Skip, FilePattern -> Pat
Lit "y"]
    "////" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [Pat
Skip, Pat
Skip]
    "**/**/**" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [Pat
Skip, Pat
Skip, Pat
Skip]
    "////x" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [Pat
Skip, Pat
Skip, FilePattern -> Pat
Lit "x"]
    "x////" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [FilePattern -> Pat
Lit "x", Pat
Skip, Pat
Skip]
    "x////y" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [FilePattern -> Pat
Lit "x",Pat
Skip, Pat
Skip, FilePattern -> Pat
Lit "y"]
    "**//x" FilePattern -> [Pat] -> IO ()
forall (f :: * -> *). MonadFail f => FilePattern -> [Pat] -> f ()
# [Pat
Skip, Pat
Skip, FilePattern -> Pat
Lit "x"]


-- | Optimisations that may change the matched expressions
optimise :: [Pat] -> [Pat]
optimise :: [Pat] -> [Pat]
optimise (Skip:Skip:xs :: [Pat]
xs) = [Pat] -> [Pat]
optimise ([Pat] -> [Pat]) -> [Pat] -> [Pat]
forall a b. (a -> b) -> a -> b
$ Pat
SkipPat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:[Pat]
xs
optimise (Skip:Star:xs :: [Pat]
xs) = [Pat] -> [Pat]
optimise ([Pat] -> [Pat]) -> [Pat] -> [Pat]
forall a b. (a -> b) -> a -> b
$ Pat
Skip1Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:[Pat]
xs
optimise (Star:Skip:xs :: [Pat]
xs) = [Pat] -> [Pat]
optimise ([Pat] -> [Pat]) -> [Pat] -> [Pat]
forall a b. (a -> b) -> a -> b
$ Pat
Skip1Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:[Pat]
xs
optimise (x :: Pat
x:xs :: [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 -> Bool
isRelativePattern :: FilePattern -> Bool
isRelativePattern ('*':'*':xs :: FilePattern
xs)
    | [] <- FilePattern
xs = Bool
True
    | x :: Char
x:xs :: FilePattern
xs <- FilePattern
xs, Char -> Bool
isPathSeparator Char
x = Bool
True
isRelativePattern _ = Bool
False

-- | A non-absolute 'FilePath'.
isRelativePath :: FilePath -> Bool
isRelativePath :: FilePattern -> Bool
isRelativePath (x :: Char
x:_) | Char -> Bool
isPathSeparator Char
x = Bool
False
isRelativePath (x :: Char
x:':':_) | Bool
isWindows, Char -> Bool
isAlpha Char
x = Bool
False
isRelativePath _ = 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] -> [FilePattern] -> [[FilePattern]]
match (Skip:xs :: [Pat]
xs) (y :: FilePattern
y:ys :: [FilePattern]
ys) = ([FilePattern] -> [FilePattern])
-> [[FilePattern]] -> [[FilePattern]]
forall a b. (a -> b) -> [a] -> [b]
map (""FilePattern -> [FilePattern] -> [FilePattern]
forall a. a -> [a] -> [a]
:) ([Pat] -> [FilePattern] -> [[FilePattern]]
match [Pat]
xs (FilePattern
yFilePattern -> [FilePattern] -> [FilePattern]
forall a. a -> [a] -> [a]
:[FilePattern]
ys)) [[FilePattern]] -> [[FilePattern]] -> [[FilePattern]]
forall a. [a] -> [a] -> [a]
++ [Pat] -> [FilePattern] -> [[FilePattern]]
match (Pat
Skip1Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:[Pat]
xs) (FilePattern
yFilePattern -> [FilePattern] -> [FilePattern]
forall a. a -> [a] -> [a]
:[FilePattern]
ys)
match (Skip1:xs :: [Pat]
xs) (y :: FilePattern
y:ys :: [FilePattern]
ys) = [(FilePattern
yFilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++"/"FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++FilePattern
r)FilePattern -> [FilePattern] -> [FilePattern]
forall a. a -> [a] -> [a]
:[FilePattern]
rs | r :: FilePattern
r:rs :: [FilePattern]
rs <- [Pat] -> [FilePattern] -> [[FilePattern]]
match (Pat
SkipPat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:[Pat]
xs) [FilePattern]
ys]
match (Skip:xs :: [Pat]
xs) [] = ([FilePattern] -> [FilePattern])
-> [[FilePattern]] -> [[FilePattern]]
forall a b. (a -> b) -> [a] -> [b]
map (""FilePattern -> [FilePattern] -> [FilePattern]
forall a. a -> [a] -> [a]
:) ([[FilePattern]] -> [[FilePattern]])
-> [[FilePattern]] -> [[FilePattern]]
forall a b. (a -> b) -> a -> b
$ [Pat] -> [FilePattern] -> [[FilePattern]]
match [Pat]
xs []
match (Star:xs :: [Pat]
xs) (y :: FilePattern
y:ys :: [FilePattern]
ys) = ([FilePattern] -> [FilePattern])
-> [[FilePattern]] -> [[FilePattern]]
forall a b. (a -> b) -> [a] -> [b]
map (FilePattern
yFilePattern -> [FilePattern] -> [FilePattern]
forall a. a -> [a] -> [a]
:) ([[FilePattern]] -> [[FilePattern]])
-> [[FilePattern]] -> [[FilePattern]]
forall a b. (a -> b) -> a -> b
$ [Pat] -> [FilePattern] -> [[FilePattern]]
match [Pat]
xs [FilePattern]
ys
match (Lit x :: FilePattern
x:xs :: [Pat]
xs) (y :: FilePattern
y:ys :: [FilePattern]
ys) = [[[FilePattern]]] -> [[FilePattern]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[FilePattern]]] -> [[FilePattern]])
-> [[[FilePattern]]] -> [[FilePattern]]
forall a b. (a -> b) -> a -> b
$ [[Pat] -> [FilePattern] -> [[FilePattern]]
match [Pat]
xs [FilePattern]
ys | FilePattern
x FilePattern -> FilePattern -> Bool
forall a. Eq a => a -> a -> Bool
== FilePattern
y] [[[FilePattern]]] -> [[[FilePattern]]] -> [[[FilePattern]]]
forall a. [a] -> [a] -> [a]
++ [[Pat] -> [FilePattern] -> [[FilePattern]]
match [Pat]
xs (FilePattern
yFilePattern -> [FilePattern] -> [FilePattern]
forall a. a -> [a] -> [a]
:[FilePattern]
ys) | FilePattern
x FilePattern -> FilePattern -> Bool
forall a. Eq a => a -> a -> Bool
== "."]
match (x :: Pat
x@Stars{}:xs :: [Pat]
xs) (y :: FilePattern
y:ys :: [FilePattern]
ys) | Just rs :: [FilePattern]
rs <- Pat -> FilePattern -> Maybe [FilePattern]
matchStars Pat
x FilePattern
y = ([FilePattern] -> [FilePattern])
-> [[FilePattern]] -> [[FilePattern]]
forall a b. (a -> b) -> [a] -> [b]
map ([FilePattern]
rs [FilePattern] -> [FilePattern] -> [FilePattern]
forall a. [a] -> [a] -> [a]
++) ([[FilePattern]] -> [[FilePattern]])
-> [[FilePattern]] -> [[FilePattern]]
forall a b. (a -> b) -> a -> b
$ [Pat] -> [FilePattern] -> [[FilePattern]]
match [Pat]
xs [FilePattern]
ys
match [] [] = [[]]
match _ _ = []


matchOne :: Pat -> String -> Bool
matchOne :: Pat -> FilePattern -> Bool
matchOne (Lit x :: FilePattern
x) y :: FilePattern
y = FilePattern
x FilePattern -> FilePattern -> Bool
forall a. Eq a => a -> a -> Bool
== FilePattern
y
matchOne x :: Pat
x@Stars{} y :: FilePattern
y = Maybe [FilePattern] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [FilePattern] -> Bool) -> Maybe [FilePattern] -> Bool
forall a b. (a -> b) -> a -> b
$ Pat -> FilePattern -> Maybe [FilePattern]
matchStars Pat
x FilePattern
y
matchOne Star _ = Bool
True


-- Only return the first (all patterns left-most) valid star matching
matchStars :: Pat -> String -> Maybe [String]
matchStars :: Pat -> FilePattern -> Maybe [FilePattern]
matchStars (Stars pre :: FilePattern
pre mid :: [FilePattern]
mid post :: FilePattern
post) x :: FilePattern
x = do
    FilePattern
x <- FilePattern -> FilePattern -> Maybe FilePattern
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix FilePattern
pre FilePattern
x
    FilePattern
x <- if FilePattern -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePattern
post then FilePattern -> Maybe FilePattern
forall a. a -> Maybe a
Just FilePattern
x else FilePattern -> FilePattern -> Maybe FilePattern
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix FilePattern
post FilePattern
x
    [FilePattern] -> FilePattern -> Maybe [FilePattern]
forall a. Eq a => [[a]] -> [a] -> Maybe [[a]]
stripInfixes [FilePattern]
mid FilePattern
x
    where
        stripInfixes :: [[a]] -> [a] -> Maybe [[a]]
stripInfixes [] x :: [a]
x = [[a]] -> Maybe [[a]]
forall a. a -> Maybe a
Just [[a]
x]
        stripInfixes (m :: [a]
m:ms :: [[a]]
ms) x :: [a]
x = do
            (a :: [a]
a,x :: [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


-- | 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
?== :: FilePattern -> FilePattern -> Bool
(?==) p :: FilePattern
p = case [Pat] -> [Pat]
optimise ([Pat] -> [Pat]) -> [Pat] -> [Pat]
forall a b. (a -> b) -> a -> b
$ FilePattern -> [Pat]
parse FilePattern
p of
    [x :: 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 -> if Bool
rp then FilePattern -> Bool
isRelativePath else Bool -> FilePattern -> Bool
forall a b. a -> b -> a
const Bool
True
    p :: [Pat]
p -> let f :: FilePattern -> Bool
f = Bool -> Bool
not (Bool -> Bool) -> (FilePattern -> Bool) -> FilePattern -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[FilePattern]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[FilePattern]] -> Bool)
-> (FilePattern -> [[FilePattern]]) -> FilePattern -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pat] -> [FilePattern] -> [[FilePattern]]
match [Pat]
p ([FilePattern] -> [[FilePattern]])
-> (FilePattern -> [FilePattern]) -> FilePattern -> [[FilePattern]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePattern -> [FilePattern]
forall a. (a -> Bool) -> [a] -> [[a]]
split Char -> Bool
isPathSeparator
         in if Bool
rp then (\x :: FilePattern
x -> FilePattern -> Bool
isRelativePath FilePattern
x Bool -> Bool -> Bool
&& FilePattern -> Bool
f FilePattern
x) else FilePattern -> Bool
f
    where rp :: Bool
rp = FilePattern -> Bool
isRelativePattern FilePattern
p


-- | 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 :: FilePattern -> FilePattern -> Maybe [FilePattern]
filePattern p :: FilePattern
p = \x :: FilePattern
x -> if FilePattern -> Bool
eq FilePattern
x then [FilePattern] -> Maybe [FilePattern]
forall a. a -> Maybe a
Just ([FilePattern] -> Maybe [FilePattern])
-> [FilePattern] -> Maybe [FilePattern]
forall a b. (a -> b) -> a -> b
$ FilePattern -> [FilePattern]
ex FilePattern
x else Maybe [FilePattern]
forall a. Maybe a
Nothing
    where eq :: FilePattern -> Bool
eq = FilePattern -> FilePattern -> Bool
(?==) FilePattern
p
          ex :: FilePattern -> [FilePattern]
ex = FilePattern -> FilePattern -> [FilePattern]
extract FilePattern
p

---------------------------------------------------------------------
-- MULTIPATTERN COMPATIBLE SUBSTITUTIONS

specials :: FilePattern -> [Pat]
specials :: FilePattern -> [Pat]
specials = (Pat -> [Pat]) -> [Pat] -> [Pat]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Pat -> [Pat]
f ([Pat] -> [Pat]) -> (FilePattern -> [Pat]) -> FilePattern -> [Pat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePattern -> [Pat]
parse
    where
        f :: Pat -> [Pat]
f Lit{} = []
        f Star = [Pat
Star]
        f Skip = [Pat
Skip]
        f Skip1 = [Pat
Skip]
        f (Stars _ xs :: [FilePattern]
xs _) = Int -> Pat -> [Pat]
forall a. Int -> a -> [a]
replicate ([FilePattern] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePattern]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Pat
Star

-- | Is the pattern free from any * and //.
simple :: FilePattern -> Bool
simple :: FilePattern -> Bool
simple = [Pat] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Pat] -> Bool) -> (FilePattern -> [Pat]) -> FilePattern -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePattern -> [Pat]
specials

-- | Do they have the same * and // counts in the same order
compatible :: [FilePattern] -> Bool
compatible :: [FilePattern] -> Bool
compatible [] = Bool
True
compatible (x :: FilePattern
x:xs :: [FilePattern]
xs) = (FilePattern -> Bool) -> [FilePattern] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Pat] -> [Pat] -> Bool
forall a. Eq a => a -> a -> Bool
(==) (FilePattern -> [Pat]
specials FilePattern
x) ([Pat] -> Bool) -> (FilePattern -> [Pat]) -> FilePattern -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePattern -> [Pat]
specials) [FilePattern]
xs

-- | Extract the items that match the wildcards. The pair must match with '?=='.
extract :: FilePattern -> FilePath -> [String]
extract :: FilePattern -> FilePattern -> [FilePattern]
extract p :: FilePattern
p = let pat :: [Pat]
pat = FilePattern -> [Pat]
parse FilePattern
p in \x :: FilePattern
x ->
    case [Pat] -> [FilePattern] -> [[FilePattern]]
match [Pat]
pat ((Char -> Bool) -> FilePattern -> [FilePattern]
forall a. (a -> Bool) -> [a] -> [[a]]
split Char -> Bool
isPathSeparator FilePattern
x) of
        [] | FilePattern
p FilePattern -> FilePattern -> Bool
?== FilePattern
x -> FilePattern -> [FilePattern]
forall a. FilePattern -> a
errorInternal (FilePattern -> [FilePattern]) -> FilePattern -> [FilePattern]
forall a b. (a -> b) -> a -> b
$ "extract with " FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ FilePattern -> FilePattern
forall a. Show a => a -> FilePattern
show FilePattern
p FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ " and " FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ FilePattern -> FilePattern
forall a. Show a => a -> FilePattern
show FilePattern
x
           | Bool
otherwise -> FilePattern -> [FilePattern]
forall a. HasCallStack => FilePattern -> a
error (FilePattern -> [FilePattern]) -> FilePattern -> [FilePattern]
forall a b. (a -> b) -> a -> b
$ "Pattern " FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ FilePattern -> FilePattern
forall a. Show a => a -> FilePattern
show FilePattern
p FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ " does not match " FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ FilePattern
x FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ ", when trying to extract the FilePattern matches"
        ms :: [FilePattern]
ms:_ -> [FilePattern]
ms


-- | Given the result of 'extract', substitute it back in to a 'compatible' pattern.
--
-- > p '?==' x ==> substitute (extract p x) p == x
substitute :: [String] -> FilePattern -> FilePath
substitute :: [FilePattern] -> FilePattern -> FilePattern
substitute oms :: [FilePattern]
oms oxs :: FilePattern
oxs = FilePattern -> [FilePattern] -> FilePattern
forall a. [a] -> [[a]] -> [a]
intercalate "/" ([FilePattern] -> FilePattern) -> [FilePattern] -> FilePattern
forall a b. (a -> b) -> a -> b
$ [[FilePattern]] -> [FilePattern]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePattern]] -> [FilePattern])
-> [[FilePattern]] -> [FilePattern]
forall a b. (a -> b) -> a -> b
$ ([FilePattern], [[FilePattern]]) -> [[FilePattern]]
forall a b. (a, b) -> b
snd (([FilePattern], [[FilePattern]]) -> [[FilePattern]])
-> ([FilePattern], [[FilePattern]]) -> [[FilePattern]]
forall a b. (a -> b) -> a -> b
$ ([FilePattern] -> Pat -> ([FilePattern], [FilePattern]))
-> [FilePattern] -> [Pat] -> ([FilePattern], [[FilePattern]])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL [FilePattern] -> Pat -> ([FilePattern], [FilePattern])
f [FilePattern]
oms (FilePattern -> [Pat]
parse FilePattern
oxs)
    where
        f :: [FilePattern] -> Pat -> ([FilePattern], [FilePattern])
f ms :: [FilePattern]
ms (Lit x :: FilePattern
x) = ([FilePattern]
ms, [FilePattern
x])
        f (m :: FilePattern
m:ms :: [FilePattern]
ms) Star = ([FilePattern]
ms, [FilePattern
m])
        f (m :: FilePattern
m:ms :: [FilePattern]
ms) Skip = ([FilePattern]
ms, FilePattern -> [FilePattern]
split FilePattern
m)
        f (m :: FilePattern
m:ms :: [FilePattern]
ms) Skip1 = ([FilePattern]
ms, FilePattern -> [FilePattern]
split FilePattern
m)
        f ms :: [FilePattern]
ms (Stars pre :: FilePattern
pre mid :: [FilePattern]
mid post :: FilePattern
post) = ([FilePattern]
ms2, [[FilePattern] -> FilePattern
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePattern] -> FilePattern) -> [FilePattern] -> FilePattern
forall a b. (a -> b) -> a -> b
$ FilePattern
pre FilePattern -> [FilePattern] -> [FilePattern]
forall a. a -> [a] -> [a]
: (FilePattern -> FilePattern -> FilePattern)
-> [FilePattern] -> [FilePattern] -> [FilePattern]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
(++) [FilePattern]
ms1 ([FilePattern]
mid[FilePattern] -> [FilePattern] -> [FilePattern]
forall a. [a] -> [a] -> [a]
++[FilePattern
post])])
            where (ms1 :: [FilePattern]
ms1,ms2 :: [FilePattern]
ms2) = Int -> [FilePattern] -> ([FilePattern], [FilePattern])
forall a. Int -> [a] -> ([a], [a])
splitAt ([FilePattern] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePattern]
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) [FilePattern]
ms
        f _ _ = FilePattern -> ([FilePattern], [FilePattern])
forall a. HasCallStack => FilePattern -> a
error (FilePattern -> ([FilePattern], [FilePattern]))
-> FilePattern -> ([FilePattern], [FilePattern])
forall a b. (a -> b) -> a -> b
$ "Substitution failed into pattern " FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ FilePattern -> FilePattern
forall a. Show a => a -> FilePattern
show FilePattern
oxs FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ " with " FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ Int -> FilePattern
forall a. Show a => a -> FilePattern
show ([FilePattern] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePattern]
oms) FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ " matches, namely " FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ [FilePattern] -> FilePattern
forall a. Show a => a -> FilePattern
show [FilePattern]
oms

        split :: FilePattern -> [FilePattern]
split = (Char -> Bool) -> FilePattern -> [FilePattern]
forall a. (a -> Bool) -> [a] -> [[a]]
linesBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '/')


---------------------------------------------------------------------
-- 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 advance
data Walk = Walk ([String] -> ([String],[(String,Walk)]))
          | WalkTo            ([String],[(String,Walk)])

walk :: [FilePattern] -> (Bool, Walk)
walk :: [FilePattern] -> (Bool, Walk)
walk ps :: [FilePattern]
ps = (([Pat] -> Bool) -> [[Pat]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\p :: [Pat]
p -> [Pat] -> Bool
isEmpty [Pat]
p Bool -> Bool -> Bool
|| Bool -> Bool
not ([[FilePattern]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[FilePattern]] -> Bool) -> [[FilePattern]] -> Bool
forall a b. (a -> b) -> a -> b
$ [Pat] -> [FilePattern] -> [[FilePattern]]
match [Pat]
p [""])) [[Pat]]
ps2, [[Pat]] -> Walk
f [[Pat]]
ps2)
    where
        ps2 :: [[Pat]]
ps2 = (FilePattern -> [Pat]) -> [FilePattern] -> [[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
/= FilePattern -> Pat
Lit ".") ([Pat] -> [Pat]) -> (FilePattern -> [Pat]) -> FilePattern -> [Pat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pat] -> [Pat]
optimise ([Pat] -> [Pat]) -> (FilePattern -> [Pat]) -> FilePattern -> [Pat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePattern -> [Pat]
parse) [FilePattern]
ps

        f :: [[Pat]] -> Walk
f ([[Pat]] -> [[Pat]]
forall a. Ord a => [a] -> [a]
nubOrd -> [[Pat]]
ps)
            | (Pat -> Bool) -> [Pat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Pat -> Bool
isLit [Pat]
fin, ((Pat, [[Pat]]) -> Bool) -> [(Pat, [[Pat]])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Pat -> Bool
isLit (Pat -> Bool) -> ((Pat, [[Pat]]) -> Pat) -> (Pat, [[Pat]]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pat, [[Pat]]) -> Pat
forall a b. (a, b) -> a
fst) [(Pat, [[Pat]])]
nxt = ([FilePattern], [(FilePattern, Walk)]) -> Walk
WalkTo ((Pat -> FilePattern) -> [Pat] -> [FilePattern]
forall a b. (a -> b) -> [a] -> [b]
map Pat -> FilePattern
fromLit [Pat]
fin, ((Pat, [[Pat]]) -> (FilePattern, Walk))
-> [(Pat, [[Pat]])] -> [(FilePattern, Walk)]
forall a b. (a -> b) -> [a] -> [b]
map (Pat -> FilePattern
fromLit (Pat -> FilePattern)
-> ([[Pat]] -> Walk) -> (Pat, [[Pat]]) -> (FilePattern, Walk)
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
*** [[Pat]] -> Walk
f) [(Pat, [[Pat]])]
nxt)
            | Bool
otherwise = ([FilePattern] -> ([FilePattern], [(FilePattern, Walk)])) -> Walk
Walk (([FilePattern] -> ([FilePattern], [(FilePattern, Walk)])) -> Walk)
-> ([FilePattern] -> ([FilePattern], [(FilePattern, Walk)]))
-> Walk
forall a b. (a -> b) -> a -> b
$ \xs :: [FilePattern]
xs ->
                (if Bool
finStar then [FilePattern]
xs else (FilePattern -> Bool) -> [FilePattern] -> [FilePattern]
forall a. (a -> Bool) -> [a] -> [a]
filter (\x :: FilePattern
x -> (Pat -> Bool) -> [Pat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Pat -> FilePattern -> Bool
`matchOne` FilePattern
x) [Pat]
fin) [FilePattern]
xs
                ,[(FilePattern
x, [[Pat]] -> Walk
f [[Pat]]
ys) | FilePattern
x <- [FilePattern]
xs, let ys :: [[Pat]]
ys = [[[Pat]]] -> [[Pat]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Pat]]
b | (a :: Pat
a,b :: [[Pat]]
b) <- [(Pat, [[Pat]])]
nxt, Pat -> FilePattern -> Bool
matchOne Pat
a FilePattern
x], Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [[Pat]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Pat]]
ys])
            where
                finStar :: Bool
finStar = Pat
Star Pat -> [Pat] -> 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 (Skip1:xs :: [Pat]
xs) = [(Pat
Star,Pat
SkipPat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:[Pat]
xs)]
next (Skip:xs :: [Pat]
xs) = (Pat
Star,Pat
SkipPat -> [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 (x :: Pat
x:xs :: [Pat]
xs) = [(Pat
x,[Pat]
xs) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Pat] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pat]
xs]
next [] = []

final :: [Pat] -> Maybe Pat
final :: [Pat] -> Maybe Pat
final (Skip:xs :: [Pat]
xs) = if [Pat] -> Bool
isEmpty [Pat]
xs then Pat -> Maybe Pat
forall a. a -> Maybe a
Just Pat
Star else [Pat] -> Maybe Pat
final [Pat]
xs
final (Skip1:xs :: [Pat]
xs) = if [Pat] -> Bool
isEmpty [Pat]
xs then Pat -> Maybe Pat
forall a. a -> Maybe a
Just Pat
Star else Maybe Pat
forall a. Maybe a
Nothing
final (x :: Pat
x:xs :: [Pat]
xs) = if [Pat] -> Bool
isEmpty [Pat]
xs then Pat -> Maybe Pat
forall a. a -> Maybe a
Just Pat
x else Maybe Pat
forall a. Maybe a
Nothing
final [] = Maybe Pat
forall a. Maybe a
Nothing

isEmpty :: [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)