(original) (raw)

{-# LANGUAGE DeriveFunctor, DeriveFoldable #-}

module System.FilePattern.Wildcard( Wildcard(..), wildcardMatch, wildcardSubst, wildcardArity, equals ) where

import Data.Functor import Data.List.Extra import Control.Applicative import System.FilePattern.ListBy import Data.Traversable import qualified Data.Foldable as F import Prelude

equals :: Eq a => a -> a -> Maybe () equals :: a -> a -> Maybe () equals a x a y = if a x a -> a -> Bool forall a. Eq a => a -> a -> Bool == a y then () -> Maybe () forall a. a -> Maybe a Just () else Maybe () forall a. Maybe a Nothing

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

= :: Wildcard a -> Wildcard a -> Bool $c>= :: forall a. Ord a => Wildcard a -> Wildcard a -> Bool :: Wildcard a -> Wildcard a -> Bool $c> :: forall a. Ord a => Wildcard a -> Wildcard a -> Bool <= :: Wildcard a -> Wildcard a -> Bool $c<= :: forall a. Ord a => Wildcard a -> Wildcard a -> Bool < :: Wildcard a -> Wildcard a -> Bool $c< :: forall a. Ord a => Wildcard a -> Wildcard a -> Bool compare :: Wildcard a -> Wildcard a -> Ordering $ccompare :: forall a. Ord a => Wildcard a -> Wildcard a -> Ordering $cp1Ord :: forall a. Ord a => Eq (Wildcard a) Ord,a -> Wildcard b -> Wildcard a (a -> b) -> Wildcard a -> Wildcard b (forall a b. (a -> b) -> Wildcard a -> Wildcard b) -> (forall a b. a -> Wildcard b -> Wildcard a) -> Functor Wildcard forall a b. a -> Wildcard b -> Wildcard a forall a b. (a -> b) -> Wildcard a -> Wildcard b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: a -> Wildcard b -> Wildcard a c<c<c< :: forall a b. a -> Wildcard b -> Wildcard a fmap :: (a -> b) -> Wildcard a -> Wildcard b $cfmap :: forall a b. (a -> b) -> Wildcard a -> Wildcard b Functor,Wildcard a -> Bool (a -> m) -> Wildcard a -> m (a -> b -> b) -> b -> Wildcard a -> b (forall m. Monoid m => Wildcard m -> m) -> (forall m a. Monoid m => (a -> m) -> Wildcard a -> m) -> (forall m a. Monoid m => (a -> m) -> Wildcard a -> m) -> (forall a b. (a -> b -> b) -> b -> Wildcard a -> b) -> (forall a b. (a -> b -> b) -> b -> Wildcard a -> b) -> (forall b a. (b -> a -> b) -> b -> Wildcard a -> b) -> (forall b a. (b -> a -> b) -> b -> Wildcard a -> b) -> (forall a. (a -> a -> a) -> Wildcard a -> a) -> (forall a. (a -> a -> a) -> Wildcard a -> a) -> (forall a. Wildcard a -> [a]) -> (forall a. Wildcard a -> Bool) -> (forall a. Wildcard a -> Int) -> (forall a. Eq a => a -> Wildcard a -> Bool) -> (forall a. Ord a => Wildcard a -> a) -> (forall a. Ord a => Wildcard a -> a) -> (forall a. Num a => Wildcard a -> a) -> (forall a. Num a => Wildcard a -> a) -> Foldable Wildcard forall a. Eq a => a -> Wildcard a -> Bool forall a. Num a => Wildcard a -> a forall a. Ord a => Wildcard a -> a forall m. Monoid m => Wildcard m -> m forall a. Wildcard a -> Bool forall a. Wildcard a -> Int forall a. Wildcard a -> [a] forall a. (a -> a -> a) -> Wildcard a -> a forall m a. Monoid m => (a -> m) -> Wildcard a -> m forall b a. (b -> a -> b) -> b -> Wildcard a -> b forall a b. (a -> b -> b) -> b -> Wildcard a -> b forall (t :: * -> *). (forall m. Monoid m => t m -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. t a -> [a]) -> (forall a. t a -> Bool) -> (forall a. t a -> Int) -> (forall a. Eq a => a -> t a -> Bool) -> (forall a. Ord a => t a -> a) -> (forall a. Ord a => t a -> a) -> (forall a. Num a => t a -> a) -> (forall a. Num a => t a -> a) -> Foldable t product :: Wildcard a -> a $cproduct :: forall a. Num a => Wildcard a -> a sum :: Wildcard a -> a $csum :: forall a. Num a => Wildcard a -> a minimum :: Wildcard a -> a $cminimum :: forall a. Ord a => Wildcard a -> a maximum :: Wildcard a -> a $cmaximum :: forall a. Ord a => Wildcard a -> a elem :: a -> Wildcard a -> Bool $celem :: forall a. Eq a => a -> Wildcard a -> Bool length :: Wildcard a -> Int $clength :: forall a. Wildcard a -> Int null :: Wildcard a -> Bool $cnull :: forall a. Wildcard a -> Bool toList :: Wildcard a -> [a] $ctoList :: forall a. Wildcard a -> [a] foldl1 :: (a -> a -> a) -> Wildcard a -> a $cfoldl1 :: forall a. (a -> a -> a) -> Wildcard a -> a foldr1 :: (a -> a -> a) -> Wildcard a -> a $cfoldr1 :: forall a. (a -> a -> a) -> Wildcard a -> a foldl' :: (b -> a -> b) -> b -> Wildcard a -> b $cfoldl' :: forall b a. (b -> a -> b) -> b -> Wildcard a -> b foldl :: (b -> a -> b) -> b -> Wildcard a -> b $cfoldl :: forall b a. (b -> a -> b) -> b -> Wildcard a -> b foldr' :: (a -> b -> b) -> b -> Wildcard a -> b $cfoldr' :: forall a b. (a -> b -> b) -> b -> Wildcard a -> b foldr :: (a -> b -> b) -> b -> Wildcard a -> b $cfoldr :: forall a b. (a -> b -> b) -> b -> Wildcard a -> b foldMap' :: (a -> m) -> Wildcard a -> m $cfoldMap' :: forall m a. Monoid m => (a -> m) -> Wildcard a -> m foldMap :: (a -> m) -> Wildcard a -> m $cfoldMap :: forall m a. Monoid m => (a -> m) -> Wildcard a -> m fold :: Wildcard m -> m $cfold :: forall m. Monoid m => Wildcard m -> m F.Foldable)

wildcardMatch :: (a -> b -> Maybe c) -> Wildcard [a] -> [b] -> Maybe [Either [c] [b]] wildcardMatch :: (a -> b -> Maybe c) -> Wildcard [a] -> [b] -> Maybe [Either [c] [b]] wildcardMatch a -> b -> Maybe c eq (Literal [a] mid) [b] x = (Either [c] [b] -> [Either [c] [b]] -> [Either [c] [b]] forall a. a -> [a] -> [a] :[]) (Either [c] [b] -> [Either [c] [b]]) -> ([c] -> Either [c] [b]) -> [c] -> [Either [c] [b]] forall b c a. (b -> c) -> (a -> b) -> a -> c . [c] -> Either [c] [b] forall a b. a -> Either a b Left ([c] -> [Either [c] [b]]) -> Maybe [c] -> Maybe [Either [c] [b]] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (a -> b -> Maybe c) -> [a] -> [b] -> Maybe [c] forall a b c. (a -> b -> Maybe c) -> [a] -> [b] -> Maybe [c] eqListBy a -> b -> Maybe c eq [a] mid [b] x wildcardMatch a -> b -> Maybe c eq (Wildcard [a] pre [[a]] mid [a] post) [b] x = do ([c] pre, [b] x) <- (a -> b -> Maybe c) -> [a] -> [b] -> Maybe ([c], [b]) forall a b c. (a -> b -> Maybe c) -> [a] -> [b] -> Maybe ([c], [b]) stripPrefixBy a -> b -> Maybe c eq [a] pre [b] x ([b] x, [c] post) <- (a -> b -> Maybe c) -> [a] -> [b] -> Maybe ([b], [c]) forall a b c. (a -> b -> Maybe c) -> [a] -> [b] -> Maybe ([b], [c]) stripSuffixBy a -> b -> Maybe c eq [a] post [b] x [Either [c] [b]] mid <- [[a]] -> [b] -> Maybe [Either [c] [b]] stripInfixes [[a]] mid [b] x [Either [c] [b]] -> Maybe [Either [c] [b]] forall (f :: * -> *) a. Applicative f => a -> f a pure ([Either [c] [b]] -> Maybe [Either [c] [b]]) -> [Either [c] [b]] -> Maybe [Either [c] [b]] forall a b. (a -> b) -> a -> b $ [[c] -> Either [c] [b] forall a b. a -> Either a b Left [c] pre] [Either [c] [b]] -> [Either [c] [b]] -> [Either [c] [b]] forall a. [a] -> [a] -> [a] ++ [Either [c] [b]] mid [Either [c] [b]] -> [Either [c] [b]] -> [Either [c] [b]] forall a. [a] -> [a] -> [a] ++ [[c] -> Either [c] [b] forall a b. a -> Either a b Left [c] post] where stripInfixes :: [[a]] -> [b] -> Maybe [Either [c] [b]] stripInfixes [] [b] x = [Either [c] [b]] -> Maybe [Either [c] [b]] forall a. a -> Maybe a Just [[b] -> Either [c] [b] forall a b. b -> Either a b Right [b] x] stripInfixes ([a] m:[[a]] ms) [b] y = do ([b] a,[c] b,[b] x) <- (a -> b -> Maybe c) -> [a] -> [b] -> Maybe ([b], [c], [b]) forall a b c. (a -> b -> Maybe c) -> [a] -> [b] -> Maybe ([b], [c], [b]) stripInfixBy a -> b -> Maybe c eq [a] m [b] y ([Either [c] [b]] c -> [b] -> Either [c] [b] forall a b. b -> Either a b Right [b] aEither [c] [b] -> [Either [c] [b]] -> [Either [c] [b]] forall a. a -> [a] -> [a] :[c] -> Either [c] [b] forall a b. a -> Either a b Left [c] bEither [c] [b] -> [Either [c] [b]] -> [Either [c] [b]] forall a. a -> [a] -> [a] :[Either [c] [b]] c) ([Either [c] [b]] -> [Either [c] [b]]) -> Maybe [Either [c] [b]] -> Maybe [Either [c] [b]] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [[a]] -> [b] -> Maybe [Either [c] [b]] stripInfixes [[a]] ms [b] x

wildcardSubst :: Applicative m => m b -> (a -> m b) -> Wildcard a -> m [b] wildcardSubst :: m b -> (a -> m b) -> Wildcard a -> m [b] wildcardSubst m b gap a -> m b lit (Literal a x) = (b -> [b] -> [b] forall a. a -> [a] -> [a] :[]) (b -> [b]) -> m b -> m [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> a -> m b lit a x wildcardSubst m b gap a -> m b lit (Wildcard a pre [a] mid a post) = (:) (b -> [b] -> [b]) -> m b -> m ([b] -> [b]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> a -> m b lit a pre m ([b] -> [b]) -> m [b] -> m [b] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> ([[b]] -> [b] forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat ([[b]] -> [b]) -> m [[b]] -> m [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (a -> m [b]) -> [a] -> m [[b]] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse (\a v -> (\b a b b -> [b a,b b]) (b -> b -> [b]) -> m b -> m (b -> [b]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> m b gap m (b -> [b]) -> m b -> m [b] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> a -> m b lit a v) ([a] mid [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] ++ [a post]))

wildcardArity :: Wildcard a -> Int wildcardArity :: Wildcard a -> Int wildcardArity (Literal a _) = Int 0 wildcardArity (Wildcard a _ [a] xs a _) = [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [a] xs Int -> Int -> Int forall a. Num a => a -> a -> a

• Int 1