(original) (raw)

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

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)

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

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)