{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
module Clod.IgnorePatterns
(
readClodIgnore
, readGitIgnore
, readNestedGitIgnores
, createDefaultClodIgnore
, matchesIgnorePattern
, simpleGlobMatch
, makePatternMatcher
, PatternType(..)
, categorizePatterns
, defaultClodIgnoreContent
, defaultClodIgnoreContentStr
) where
import Control.Monad (filterM)
import Control.Monad.IO.Class (liftIO)
import Control.Exception (try, SomeException)
import Control.Monad.Except (throwError)
import qualified Data.List as L
import Data.Char (toLower)
import qualified Data.Map.Strict as Map
import System.Directory (doesDirectoryExist, doesFileExist, getDirectoryContents)
import System.FilePath (splitDirectories, takeExtension, takeFileName, takeDirectory, (</>))
import Data.FileEmbed (embedStringFile)
import qualified Data.ByteString.Char8 as BS
import qualified Data.Text as T
import Data.Text (Text)
import GHC.Generics (Generic)
import qualified Dhall
import Clod.Types (ClodM, IgnorePattern(..), ClodError(..))
import Clod.Config (clodIgnoreFile)
pattern FileExtension :: String -> String
pattern $mFileExtension :: forall {r}. [Char] -> ([Char] -> r) -> ((# #) -> r) -> r
$bFileExtension :: [Char] -> [Char]
FileExtension ext <- ('*':'.':ext@(_:_)) where
FileExtension [Char]
ext = Char
'*'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
'.'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
ext
pattern DirectoryWildcard :: String -> String
pattern $mDirectoryWildcard :: forall {r}. [Char] -> ([Char] -> r) -> ((# #) -> r) -> r
$bDirectoryWildcard :: [Char] -> [Char]
DirectoryWildcard rest <- ('*':'*':'/':rest) where
DirectoryWildcard [Char]
rest = Char
'*'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
'*'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
'/'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
rest
pattern MultiLevelWildcard :: String -> String
pattern $mMultiLevelWildcard :: forall {r}. [Char] -> ([Char] -> r) -> ((# #) -> r) -> r
$bMultiLevelWildcard :: [Char] -> [Char]
MultiLevelWildcard rest <- ('*':'*':rest) where
MultiLevelWildcard [Char]
rest = Char
'*'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
'*'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
rest
pattern SingleLevelWildcard :: String -> String
pattern $mSingleLevelWildcard :: forall {r}. [Char] -> ([Char] -> r) -> ((# #) -> r) -> r
$bSingleLevelWildcard :: [Char] -> [Char]
SingleLevelWildcard rest <- ('*':rest) where
SingleLevelWildcard [Char]
rest = Char
'*'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
rest
pattern CharClassStart :: String -> String
pattern $mCharClassStart :: forall {r}. [Char] -> ([Char] -> r) -> ((# #) -> r) -> r
$bCharClassStart :: [Char] -> [Char]
CharClassStart rest <- ('[':rest) where
CharClassStart [Char]
rest = Char
'['Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
rest
data PatternType
= Inclusion
| Negation
deriving (Int -> PatternType -> [Char] -> [Char]
[PatternType] -> [Char] -> [Char]
PatternType -> [Char]
(Int -> PatternType -> [Char] -> [Char])
-> (PatternType -> [Char])
-> ([PatternType] -> [Char] -> [Char])
-> Show PatternType
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> PatternType -> [Char] -> [Char]
showsPrec :: Int -> PatternType -> [Char] -> [Char]
$cshow :: PatternType -> [Char]
show :: PatternType -> [Char]
$cshowList :: [PatternType] -> [Char] -> [Char]
showList :: [PatternType] -> [Char] -> [Char]
Show, PatternType -> PatternType -> Bool
(PatternType -> PatternType -> Bool)
-> (PatternType -> PatternType -> Bool) -> Eq PatternType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PatternType -> PatternType -> Bool
== :: PatternType -> PatternType -> Bool
$c/= :: PatternType -> PatternType -> Bool
/= :: PatternType -> PatternType -> Bool
Eq)
data ClodIgnorePatterns = ClodIgnorePatterns
{ ClodIgnorePatterns -> [Text]
textPatterns :: [Text]
} deriving (Int -> ClodIgnorePatterns -> [Char] -> [Char]
[ClodIgnorePatterns] -> [Char] -> [Char]
ClodIgnorePatterns -> [Char]
(Int -> ClodIgnorePatterns -> [Char] -> [Char])
-> (ClodIgnorePatterns -> [Char])
-> ([ClodIgnorePatterns] -> [Char] -> [Char])
-> Show ClodIgnorePatterns
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ClodIgnorePatterns -> [Char] -> [Char]
showsPrec :: Int -> ClodIgnorePatterns -> [Char] -> [Char]
$cshow :: ClodIgnorePatterns -> [Char]
show :: ClodIgnorePatterns -> [Char]
$cshowList :: [ClodIgnorePatterns] -> [Char] -> [Char]
showList :: [ClodIgnorePatterns] -> [Char] -> [Char]
Show, ClodIgnorePatterns -> ClodIgnorePatterns -> Bool
(ClodIgnorePatterns -> ClodIgnorePatterns -> Bool)
-> (ClodIgnorePatterns -> ClodIgnorePatterns -> Bool)
-> Eq ClodIgnorePatterns
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClodIgnorePatterns -> ClodIgnorePatterns -> Bool
== :: ClodIgnorePatterns -> ClodIgnorePatterns -> Bool
$c/= :: ClodIgnorePatterns -> ClodIgnorePatterns -> Bool
/= :: ClodIgnorePatterns -> ClodIgnorePatterns -> Bool
Eq, (forall x. ClodIgnorePatterns -> Rep ClodIgnorePatterns x)
-> (forall x. Rep ClodIgnorePatterns x -> ClodIgnorePatterns)
-> Generic ClodIgnorePatterns
forall x. Rep ClodIgnorePatterns x -> ClodIgnorePatterns
forall x. ClodIgnorePatterns -> Rep ClodIgnorePatterns x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClodIgnorePatterns -> Rep ClodIgnorePatterns x
from :: forall x. ClodIgnorePatterns -> Rep ClodIgnorePatterns x
$cto :: forall x. Rep ClodIgnorePatterns x -> ClodIgnorePatterns
to :: forall x. Rep ClodIgnorePatterns x -> ClodIgnorePatterns
Generic)
instance Dhall.FromDhall ClodIgnorePatterns where
autoWith :: InputNormalizer -> Decoder ClodIgnorePatterns
autoWith InputNormalizer
_ = RecordDecoder ClodIgnorePatterns -> Decoder ClodIgnorePatterns
forall a. RecordDecoder a -> Decoder a
Dhall.record (RecordDecoder ClodIgnorePatterns -> Decoder ClodIgnorePatterns)
-> RecordDecoder ClodIgnorePatterns -> Decoder ClodIgnorePatterns
forall a b. (a -> b) -> a -> b
$ [Text] -> ClodIgnorePatterns
ClodIgnorePatterns ([Text] -> ClodIgnorePatterns)
-> RecordDecoder [Text] -> RecordDecoder ClodIgnorePatterns
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Decoder [Text] -> RecordDecoder [Text]
forall a. Text -> Decoder a -> RecordDecoder a
Dhall.field Text
"textPatterns" Decoder [Text]
forall a. FromDhall a => Decoder a
Dhall.auto
defaultClodIgnoreContent :: Text
defaultClodIgnoreContent :: Text
defaultClodIgnoreContent = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
BS.unpack $(embedStringFile "resources/default_clodignore.dhall")
defaultClodIgnoreContentStr :: String
defaultClodIgnoreContentStr :: [Char]
defaultClodIgnoreContentStr = ByteString -> [Char]
BS.unpack $(embedStringFile "resources/default_clodignore.dhall")
type PatternCache = Map.Map String (FilePath -> Bool)
categorizePatterns :: [IgnorePattern] -> ([IgnorePattern], [IgnorePattern])
categorizePatterns :: [IgnorePattern] -> ([IgnorePattern], [IgnorePattern])
categorizePatterns = (IgnorePattern -> Bool)
-> [IgnorePattern] -> ([IgnorePattern], [IgnorePattern])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition IgnorePattern -> Bool
isInclusion
where
isInclusion :: IgnorePattern -> Bool
isInclusion (IgnorePattern [Char]
p) = Bool -> Bool
not ([Char]
"!" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` [Char]
p)
createDefaultClodIgnore :: FilePath -> String -> ClodM ()
createDefaultClodIgnore :: [Char] -> [Char] -> ClodM ()
createDefaultClodIgnore [Char]
projectPath [Char]
ignoreFileName = do
let ignorePath :: [Char]
ignorePath = [Char]
projectPath [Char] -> [Char] -> [Char]
</> [Char]
ignoreFileName
result <- IO (Either SomeException ClodIgnorePatterns)
-> ReaderT
ClodConfig
(ExceptT ClodError IO)
(Either SomeException ClodIgnorePatterns)
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException ClodIgnorePatterns)
-> ReaderT
ClodConfig
(ExceptT ClodError IO)
(Either SomeException ClodIgnorePatterns))
-> IO (Either SomeException ClodIgnorePatterns)
-> ReaderT
ClodConfig
(ExceptT ClodError IO)
(Either SomeException ClodIgnorePatterns)
forall a b. (a -> b) -> a -> b
$ IO ClodIgnorePatterns
-> IO (Either SomeException ClodIgnorePatterns)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO ClodIgnorePatterns
-> IO (Either SomeException ClodIgnorePatterns))
-> IO ClodIgnorePatterns
-> IO (Either SomeException ClodIgnorePatterns)
forall a b. (a -> b) -> a -> b
$ Decoder ClodIgnorePatterns -> Text -> IO ClodIgnorePatterns
forall a. Decoder a -> Text -> IO a
Dhall.input Decoder ClodIgnorePatterns
forall a. FromDhall a => Decoder a
Dhall.auto Text
defaultClodIgnoreContent
case result of
Left (SomeException
e :: SomeException) ->
ClodError -> ClodM ()
forall a. ClodError -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ClodError -> ClodM ()) -> ClodError -> ClodM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ClodError
ConfigError ([Char] -> ClodError) -> [Char] -> ClodError
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to parse default clodignore patterns: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e
Right (ClodIgnorePatterns [Text]
patterns) -> do
let fileContent :: [Char]
fileContent = [Char]
"# Default .clodignore file for Claude uploader\n# Add patterns to ignore files when uploading to Claude\n\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[[Char]] -> [Char]
unlines ((Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack [Text]
patterns)
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ()
writeFile [Char]
ignorePath [Char]
fileContent
readClodIgnore :: FilePath -> ClodM [IgnorePattern]
readClodIgnore :: [Char] -> ClodM [IgnorePattern]
readClodIgnore [Char]
projectPath = do
ignoreFileName <- IO [Char] -> ReaderT ClodConfig (ExceptT ClodError IO) [Char]
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Char]
clodIgnoreFile
let ignorePath = [Char]
projectPath [Char] -> [Char] -> [Char]
</> [Char]
ignoreFileName
exists <- liftIO $ doesFileExist ignorePath
if exists
then do
content <- liftIO $ readFile ignorePath
return $ map IgnorePattern $ filter isValidPattern $ lines content
else do
createDefaultClodIgnore projectPath ignoreFileName
content <- liftIO $ readFile ignorePath
return $ map IgnorePattern $ filter isValidPattern $ lines content
where
isValidPattern :: [Char] -> Bool
isValidPattern [Char]
line = Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
line) Bool -> Bool -> Bool
&& Bool -> Bool
not ([Char]
"#" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` [Char]
line)
readGitIgnore :: FilePath -> ClodM [IgnorePattern]
readGitIgnore :: [Char] -> ClodM [IgnorePattern]
readGitIgnore [Char]
projectPath = do
let gitIgnorePath :: [Char]
gitIgnorePath = [Char]
projectPath [Char] -> [Char] -> [Char]
</> [Char]
".gitignore"
exists <- IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool)
-> IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
gitIgnorePath
if exists
then do
content <- liftIO $ readFile gitIgnorePath
let lines' = [Char] -> [[Char]]
lines [Char]
content
let validPatterns = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
isValidPattern [[Char]]
lines'
return $ map IgnorePattern validPatterns
else return []
where
isValidPattern :: [Char] -> Bool
isValidPattern [Char]
line = Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
line) Bool -> Bool -> Bool
&& Bool -> Bool
not ([Char]
"#" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` [Char]
line)
readNestedGitIgnores :: FilePath -> ClodM [IgnorePattern]
readNestedGitIgnores :: [Char] -> ClodM [IgnorePattern]
readNestedGitIgnores [Char]
rootPath = do
ignoreFiles <- [Char] -> ClodM [[Char]]
findGitIgnoreFiles [Char]
rootPath
patternLists <- mapM (\[Char]
file -> do
dir <- IO [Char] -> ReaderT ClodConfig (ExceptT ClodError IO) [Char]
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> ReaderT ClodConfig (ExceptT ClodError IO) [Char])
-> IO [Char] -> ReaderT ClodConfig (ExceptT ClodError IO) [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
takeDirectory ([Char] -> [Char]) -> IO [Char] -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
file
patterns <- readGitIgnoreFile file
return (dir, patterns)
) ignoreFiles
let processedPatterns = (([Char], [IgnorePattern]) -> [IgnorePattern])
-> [([Char], [IgnorePattern])] -> [IgnorePattern]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\([Char]
dir, [IgnorePattern]
patterns) ->
(IgnorePattern -> IgnorePattern)
-> [IgnorePattern] -> [IgnorePattern]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> IgnorePattern -> IgnorePattern
makeRelativeToDir [Char]
dir) [IgnorePattern]
patterns) [([Char], [IgnorePattern])]
patternLists
return processedPatterns
where
findGitIgnoreFiles :: FilePath -> ClodM [FilePath]
findGitIgnoreFiles :: [Char] -> ClodM [[Char]]
findGitIgnoreFiles [Char]
dir = do
let gitignorePath :: [Char]
gitignorePath = [Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
".gitignore"
exists <- IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool)
-> IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
gitignorePath
let current = if Bool
exists then [[Char]
gitignorePath] else []
dirExists <- liftIO $ doesDirectoryExist dir
subdirs <- if dirExists
then do
contents <- liftIO $ getDirectoryContents dir
let validDirs = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Char]
".", [Char]
"..", [Char]
".git"]) [[Char]]
contents
filterM (\[Char]
d -> IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool)
-> IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesDirectoryExist ([Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
d)) validDirs
else return []
subResults <- mapM (\[Char]
subdir -> [Char] -> ClodM [[Char]]
findGitIgnoreFiles ([Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
subdir)) subdirs
return $ current ++ concat subResults
readGitIgnoreFile :: FilePath -> ClodM [IgnorePattern]
readGitIgnoreFile :: [Char] -> ClodM [IgnorePattern]
readGitIgnoreFile [Char]
path = do
content <- IO [Char] -> ReaderT ClodConfig (ExceptT ClodError IO) [Char]
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> ReaderT ClodConfig (ExceptT ClodError IO) [Char])
-> IO [Char] -> ReaderT ClodConfig (ExceptT ClodError IO) [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
readFile [Char]
path
return $ map IgnorePattern $ filter isValidPattern $ lines content
where
isValidPattern :: [Char] -> Bool
isValidPattern [Char]
line = Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
line) Bool -> Bool -> Bool
&& Bool -> Bool
not ([Char]
"#" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` [Char]
line)
makeRelativeToDir :: FilePath -> IgnorePattern -> IgnorePattern
makeRelativeToDir :: [Char] -> IgnorePattern -> IgnorePattern
makeRelativeToDir [Char]
dir (IgnorePattern [Char]
p) =
let isNegation :: Bool
isNegation = [Char]
"!" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` [Char]
p
actualPattern :: [Char]
actualPattern = if Bool
isNegation then Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
p else [Char]
p
isAbsolute :: Bool
isAbsolute = [Char]
"/" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` [Char]
actualPattern
adjusted :: [Char]
adjusted = if Bool
isAbsolute
then [Char]
actualPattern
else if [Char]
dir [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
rootPath
then [Char]
actualPattern
else let relDir :: [Char]
relDir = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
rootPath Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Char]
dir
in [Char]
relDir [Char] -> [Char] -> [Char]
</> [Char]
actualPattern
final :: [Char]
final = if Bool
isNegation then [Char]
"!" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
adjusted else [Char]
adjusted
in [Char] -> IgnorePattern
IgnorePattern [Char]
final
matchesIgnorePattern :: [IgnorePattern] -> FilePath -> Bool
matchesIgnorePattern :: [IgnorePattern] -> [Char] -> Bool
matchesIgnorePattern [IgnorePattern]
patterns [Char]
filePath =
let ([IgnorePattern]
inclusions, [IgnorePattern]
negations) = [IgnorePattern] -> ([IgnorePattern], [IgnorePattern])
categorizePatterns [IgnorePattern]
patterns
negationPatterns :: [IgnorePattern]
negationPatterns = (IgnorePattern -> IgnorePattern)
-> [IgnorePattern] -> [IgnorePattern]
forall a b. (a -> b) -> [a] -> [b]
map (\(IgnorePattern [Char]
p) ->
[Char] -> IgnorePattern
IgnorePattern (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
p)) [IgnorePattern]
negations
includedByPattern :: Bool
includedByPattern = (IgnorePattern -> Bool) -> [IgnorePattern] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([Char] -> IgnorePattern -> Bool
matchesPattern [Char]
filePath) [IgnorePattern]
inclusions
negatedByPattern :: Bool
negatedByPattern = (IgnorePattern -> Bool) -> [IgnorePattern] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([Char] -> IgnorePattern -> Bool
matchesPattern [Char]
filePath) [IgnorePattern]
negationPatterns
in
Bool
includedByPattern Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
negatedByPattern
where
cache :: PatternCache
cache = PatternCache
forall k a. Map k a
Map.empty :: PatternCache
matchesPattern :: FilePath -> IgnorePattern -> Bool
matchesPattern :: [Char] -> IgnorePattern -> Bool
matchesPattern [Char]
path (IgnorePattern [Char]
p) =
let (PatternCache
_, [Char] -> Bool
matcher) = PatternCache -> [Char] -> (PatternCache, [Char] -> Bool)
getCachedMatcher PatternCache
cache [Char]
p
in [Char] -> Bool
matcher [Char]
path
getCachedMatcher :: PatternCache -> String -> (PatternCache, FilePath -> Bool)
getCachedMatcher :: PatternCache -> [Char] -> (PatternCache, [Char] -> Bool)
getCachedMatcher PatternCache
cache [Char]
ptn =
case [Char] -> PatternCache -> Maybe ([Char] -> Bool)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
ptn PatternCache
cache of
Just [Char] -> Bool
matcher -> (PatternCache
cache, [Char] -> Bool
matcher)
Maybe ([Char] -> Bool)
Nothing ->
let matcher :: [Char] -> Bool
matcher = [Char] -> [Char] -> Bool
makePatternMatcher [Char]
ptn
newCache :: PatternCache
newCache = [Char] -> ([Char] -> Bool) -> PatternCache -> PatternCache
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Char]
ptn [Char] -> Bool
matcher PatternCache
cache
in (PatternCache
newCache, [Char] -> Bool
matcher)
makePatternMatcher :: String -> (FilePath -> Bool)
makePatternMatcher :: [Char] -> [Char] -> Bool
makePatternMatcher [Char]
ptn
| [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ptn = Bool -> [Char] -> Bool
forall a b. a -> b -> a
const Bool
False
| [Char]
"/" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` [Char]
ptn = [Char] -> [Char] -> Bool
makePatternMatcher ([Char] -> [Char] -> Bool) -> [Char] -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
init [Char]
ptn
| [Char]
"/" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` [Char]
ptn =
let patternWithoutSlash :: [Char]
patternWithoutSlash = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
ptn
in [Char] -> [Char] -> Bool
matchFromRoot [Char]
patternWithoutSlash
| [Char]
"*." [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` [Char]
ptn = [Char] -> [Char] -> Bool
matchExtension [Char]
ptn
| Char
'/' Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
ptn =
if Char
'*' Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
ptn Bool -> Bool -> Bool
|| Char
'?' Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
ptn Bool -> Bool -> Bool
|| [Char] -> Bool
containsCharClass [Char]
ptn
then [Char] -> [Char] -> Bool
simpleGlobMatch [Char]
ptn
else [Char] -> [Char] -> Bool
matchPathComponents [Char]
ptn
| [Char] -> Bool
containsCharClass [Char]
ptn =
[Char] -> [Char] -> Bool
simpleGlobMatch [Char]
ptn
| Bool
otherwise = [Char] -> [Char] -> Bool
matchSimpleName [Char]
ptn
containsCharClass :: String -> Bool
containsCharClass :: [Char] -> Bool
containsCharClass [] = Bool
False
containsCharClass (Char
'[':[Char]
_) = Bool
True
containsCharClass (Char
_:[Char]
rest) = [Char] -> Bool
containsCharClass [Char]
rest
matchExtension :: String -> (FilePath -> Bool)
matchExtension :: [Char] -> [Char] -> Bool
matchExtension [Char]
ptn = \[Char]
path ->
let ext :: [Char]
ext = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
2 [Char]
ptn
dirPattern :: [Char]
dirPattern = [Char] -> [Char]
takeDirectory [Char]
ptn
dirParts :: [[Char]]
dirParts = if [Char]
dirPattern [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"." then [Char] -> [[Char]]
splitDirectories [Char]
dirPattern else []
fileExt :: [Char]
fileExt = [Char] -> [Char]
takeExtension [Char]
path
extWithoutDot :: [Char]
extWithoutDot = if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
fileExt then [Char]
"" else Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
fileExt
pathComponents :: [[Char]]
pathComponents = [Char] -> [[Char]]
splitDirectories [Char]
path
dirCheck :: Bool
dirCheck = [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
dirParts Bool -> Bool -> Bool
|| [[Char]] -> [[Char]] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isPrefixOf [[Char]]
dirParts [[Char]]
pathComponents
extensionCheck :: Bool
extensionCheck = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
extWithoutDot [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
ext
in Bool
dirCheck Bool -> Bool -> Bool
&& Bool
extensionCheck
matchPathComponents :: String -> (FilePath -> Bool)
matchPathComponents :: [Char] -> [Char] -> Bool
matchPathComponents [Char]
ptn = \[Char]
path ->
let patternComponents :: [[Char]]
patternComponents = [Char] -> [[Char]]
splitDirectories [Char]
ptn
pathComponents :: [[Char]]
pathComponents = [Char] -> [[Char]]
splitDirectories [Char]
path
directMatch :: Bool
directMatch = [Char]
ptn [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` [Char]
path Bool -> Bool -> Bool
||
([Char]
"/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
ptn) [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` ([Char]
"/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
path)
multiComponentMatch :: Bool
multiComponentMatch = ([[Char]] -> Bool) -> [[[Char]]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([[Char]] -> [[Char]] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isPrefixOf [[Char]]
patternComponents) ([[Char]] -> [[[Char]]]
forall a. [a] -> [[a]]
tails [[Char]]
pathComponents)
in Bool
directMatch Bool -> Bool -> Bool
|| Bool
multiComponentMatch
matchSimpleName :: String -> (FilePath -> Bool)
matchSimpleName :: [Char] -> [Char] -> Bool
matchSimpleName [Char]
ptn = \[Char]
path ->
let fileName :: [Char]
fileName = [Char] -> [Char]
takeFileName [Char]
path
pathComponents :: [[Char]]
pathComponents = [Char] -> [[Char]]
splitDirectories [Char]
path
exactMatch :: Bool
exactMatch = [Char]
ptn [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
fileName
dirMatch :: Bool
dirMatch = [Char]
ptn [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
pathComponents
hasTrailingWildcard :: Bool
hasTrailingWildcard = [Char]
"/**" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` [Char]
ptn
folderPattern :: [Char]
folderPattern = if Bool
hasTrailingWildcard
then Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
ptn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) [Char]
ptn
else [Char]
ptn
folderMatchWithWildcard :: Bool
folderMatchWithWildcard = Bool
hasTrailingWildcard Bool -> Bool -> Bool
&&
([Char]
folderPattern [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
pathComponents) Bool -> Bool -> Bool
&&
Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
pathComponents Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
([Char] -> [[Char]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
L.elemIndex [Char]
folderPattern [[Char]]
pathComponents)
in Bool
exactMatch Bool -> Bool -> Bool
|| Bool
dirMatch Bool -> Bool -> Bool
|| Bool
folderMatchWithWildcard
tails :: [a] -> [[a]]
tails :: forall a. [a] -> [[a]]
tails [] = [[]]
tails xs :: [a]
xs@(a
_:[a]
xs') = [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
forall a. [a] -> [[a]]
tails [a]
xs'
matchFromRoot :: String -> (FilePath -> Bool)
matchFromRoot :: [Char] -> [Char] -> Bool
matchFromRoot [Char]
ptn = \[Char]
path ->
let patternComponents :: [[Char]]
patternComponents = [Char] -> [[Char]]
splitDirectories [Char]
ptn
pathComponents :: [[Char]]
pathComponents = [Char] -> [[Char]]
splitDirectories [Char]
path
containsSpecial :: Bool
containsSpecial = ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [Char] -> Bool
containsSpecialChars [[Char]]
patternComponents
in if Bool
containsSpecial
then [Char] -> [Char] -> Bool
simpleGlobMatch [Char]
ptn [Char]
path
else [[Char]] -> [[Char]] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isPrefixOf [[Char]]
patternComponents [[Char]]
pathComponents
where
containsSpecialChars :: [Char] -> Bool
containsSpecialChars [Char]
s = Char
'*' Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
s Bool -> Bool -> Bool
|| Char
'?' Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
s Bool -> Bool -> Bool
|| [Char] -> Bool
containsCharClass [Char]
s
startsWith :: String -> Char -> Bool
startsWith :: [Char] -> Char -> Bool
startsWith [] Char
_ = Bool
False
startsWith (Char
x:[Char]
_) Char
c = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c
simpleGlobMatch :: String -> FilePath -> Bool
simpleGlobMatch :: [Char] -> [Char] -> Bool
simpleGlobMatch [Char]
ptn = \[Char]
filepath -> [Char] -> [Char] -> Bool
matchGlob [Char]
ptn [Char]
filepath
where
matchGlob :: String -> String -> Bool
matchGlob :: [Char] -> [Char] -> Bool
matchGlob [Char]
pat [Char]
path = case ([Char]
pat, [Char]
path) of
([], []) -> Bool
True
([], [Char]
_) -> Bool
False
((SingleLevelWildcard [Char]
ps), []) -> [Char] -> [Char] -> Bool
matchGlob [Char]
ps []
([Char]
_, []) -> Bool
False
((FileExtension [Char]
ext), [Char]
_) ->
let fileExt :: [Char]
fileExt = [Char] -> [Char]
takeExtension [Char]
path
in Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
fileExt) Bool -> Bool -> Bool
&& (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
fileExt) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
ext
((DirectoryWildcard [Char]
ps), (Char
_:[Char]
_)) ->
let restPath :: [Char]
restPath = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') [Char]
path
in [Char] -> [Char] -> Bool
matchGlob ([Char] -> [Char]
DirectoryWildcard [Char]
ps) (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
restPath) Bool -> Bool -> Bool
||
[Char] -> [Char] -> Bool
matchGlob [Char]
ps [Char]
path Bool -> Bool -> Bool
||
[Char] -> [Char] -> Bool
matchGlob [Char]
ps (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
restPath)
((MultiLevelWildcard [Char]
ps), (Char
c:[Char]
cs)) ->
[Char] -> [Char] -> Bool
matchGlob [Char]
ps (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
cs) Bool -> Bool -> Bool
|| [Char] -> [Char] -> Bool
matchGlob ([Char] -> [Char]
MultiLevelWildcard [Char]
ps) [Char]
cs
((SingleLevelWildcard [Char]
ps), (Char
c:[Char]
cs)) ->
if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'
then [Char] -> [Char] -> Bool
matchGlob ([Char] -> [Char]
SingleLevelWildcard [Char]
ps) [Char]
cs
else if [Char]
ps [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [] Bool -> Bool -> Bool
&& (Char
'/' Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
cs)
then Bool
False
else if [Char]
cs [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [] Bool -> Bool -> Bool
|| Bool -> Bool
not (Char
'/' Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
cs)
then [Char] -> [Char] -> Bool
matchGlob [Char]
ps (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
cs) Bool -> Bool -> Bool
|| [Char] -> [Char] -> Bool
matchGlob ([Char] -> [Char]
SingleLevelWildcard [Char]
ps) [Char]
cs
else Bool
False
((Char
'?':[Char]
ps), (Char
_:[Char]
cs)) ->
[Char] -> [Char] -> Bool
matchGlob [Char]
ps [Char]
cs
((CharClassStart [Char]
cs), (Char
c:[Char]
path')) ->
let ([Char]
classSpec, [Char]
rest) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']') [Char]
cs
negated :: Bool
negated = Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
classSpec) Bool -> Bool -> Bool
&& [Char]
classSpec [Char] -> Char -> Bool
`startsWith` Char
'!'
actualClass :: [Char]
actualClass = if Bool
negated then Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
classSpec else [Char]
classSpec
in if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rest
then Bool
False
else
let matches :: Bool
matches = [Char] -> Char -> Bool
matchCharacterClass [Char]
actualClass Char
c
result :: Bool
result = if Bool
negated then Bool -> Bool
not Bool
matches else Bool
matches
in Bool
result Bool -> Bool -> Bool
&& [Char] -> [Char] -> Bool
matchGlob (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
rest) [Char]
path'
((Char
p:[Char]
ps), (Char
c:[Char]
cs)) ->
Char
p Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c Bool -> Bool -> Bool
&& [Char] -> [Char] -> Bool
matchGlob [Char]
ps [Char]
cs
data CharClassPattern = SingleChar Char
| CharRange Char Char
deriving (Int -> CharClassPattern -> [Char] -> [Char]
[CharClassPattern] -> [Char] -> [Char]
CharClassPattern -> [Char]
(Int -> CharClassPattern -> [Char] -> [Char])
-> (CharClassPattern -> [Char])
-> ([CharClassPattern] -> [Char] -> [Char])
-> Show CharClassPattern
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> CharClassPattern -> [Char] -> [Char]
showsPrec :: Int -> CharClassPattern -> [Char] -> [Char]
$cshow :: CharClassPattern -> [Char]
show :: CharClassPattern -> [Char]
$cshowList :: [CharClassPattern] -> [Char] -> [Char]
showList :: [CharClassPattern] -> [Char] -> [Char]
Show, CharClassPattern -> CharClassPattern -> Bool
(CharClassPattern -> CharClassPattern -> Bool)
-> (CharClassPattern -> CharClassPattern -> Bool)
-> Eq CharClassPattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CharClassPattern -> CharClassPattern -> Bool
== :: CharClassPattern -> CharClassPattern -> Bool
$c/= :: CharClassPattern -> CharClassPattern -> Bool
/= :: CharClassPattern -> CharClassPattern -> Bool
Eq)
parseCharClass :: String -> [CharClassPattern]
parseCharClass :: [Char] -> [CharClassPattern]
parseCharClass [] = []
parseCharClass (Char
a:Char
'-':Char
b:[Char]
rest) = Char -> Char -> CharClassPattern
CharRange Char
a Char
b CharClassPattern -> [CharClassPattern] -> [CharClassPattern]
forall a. a -> [a] -> [a]
: [Char] -> [CharClassPattern]
parseCharClass [Char]
rest
parseCharClass (Char
x:[Char]
xs) = Char -> CharClassPattern
SingleChar Char
x CharClassPattern -> [CharClassPattern] -> [CharClassPattern]
forall a. a -> [a] -> [a]
: [Char] -> [CharClassPattern]
parseCharClass [Char]
xs
matchCharacterClass :: String -> Char -> Bool
matchCharacterClass :: [Char] -> Char -> Bool
matchCharacterClass [Char]
spec Char
c = (CharClassPattern -> Bool) -> [CharClassPattern] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> CharClassPattern -> Bool
matchesPattern Char
c) ([Char] -> [CharClassPattern]
parseCharClass [Char]
spec)
where
matchesPattern :: Char -> CharClassPattern -> Bool
matchesPattern :: Char -> CharClassPattern -> Bool
matchesPattern Char
ch (SingleChar Char
x) = Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x
matchesPattern Char
ch (CharRange Char
start Char
end) = Char
start Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
ch Bool -> Bool -> Bool
&& Char
ch Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
end