diff --git a/CHANGES.txt b/CHANGES.txt --- a/CHANGES.txt +++ b/CHANGES.txt @@ -1,5 +1,7 @@ Changelog for filepattern +0.1.3, released 2022-08-21 + #5, remove invalid optimisation in the presence of symlinks 0.1.2, released 2020-02-26 Optimise matchMany for empty lists Remove support for GHC 7.4 to 7.8 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright Neil Mitchell 2011-2020. +Copyright Neil Mitchell 2011-2022. All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# FilePattern [![Hackage version](https://img.shields.io/hackage/v/filepattern.svg?label=Hackage)](https://hackage.haskell.org/package/filepattern) [![Stackage version](https://www.stackage.org/package/filepattern/badge/nightly?label=Stackage)](https://www.stackage.org/package/filepattern) [![Linux build status](https://img.shields.io/travis/ndmitchell/filepattern/master.svg?label=Linux%20build)](https://travis-ci.org/ndmitchell/filepattern) [![Windows build status](https://img.shields.io/appveyor/ci/ndmitchell/filepattern/master.svg?label=Windows%20build)](https://ci.appveyor.com/project/ndmitchell/filepattern) +# FilePattern [![Hackage version](https://img.shields.io/hackage/v/filepattern.svg?label=Hackage)](https://hackage.haskell.org/package/filepattern) [![Stackage version](https://www.stackage.org/package/filepattern/badge/nightly?label=Stackage)](https://www.stackage.org/package/filepattern) [![Build status](https://img.shields.io/github/workflow/status/ndmitchell/filepattern/ci/master.svg)](https://github.com/ndmitchell/filepattern/actions) A library for matching files using patterns such as `src/**/*.png` for all `.png` files recursively under the `src` directory. There are two special forms: diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/filepattern.cabal b/filepattern.cabal --- a/filepattern.cabal +++ b/filepattern.cabal @@ -1,13 +1,13 @@ -cabal-version: >= 1.18 +cabal-version: 1.18 build-type: Simple name: filepattern -version: 0.1.2 +version: 0.1.3 license: BSD3 license-file: LICENSE category: Development, FilePath author: Neil Mitchell , Evan Rutledge Borden maintainer: Neil Mitchell -copyright: Neil Mitchell 2011-2020 +copyright: Neil Mitchell 2011-2022 synopsis: File path glob-like matching description: A library for matching files using patterns such as @\"src\/**\/*.png\"@ for all @.png@ files @@ -28,7 +28,7 @@ Originally taken from the . homepage: https://github.com/ndmitchell/filepattern#readme bug-reports: https://github.com/ndmitchell/filepattern/issues -tested-with: GHC==8.8.1, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3 +tested-with: GHC==9.0, GHC==8.10, GHC==8.8, GHC==8.6, GHC==8.4, GHC==8.2, GHC==8.0 extra-doc-files: CHANGES.txt README.md @@ -45,8 +45,6 @@ directory, extra >= 1.6.2, filepath - if impl(ghc < 8.0) - build-depends: semigroups >= 0.18 exposed-modules: System.FilePattern System.FilePattern.Directory diff --git a/src/System/FilePattern/Directory.hs b/src/System/FilePattern/Directory.hs --- a/src/System/FilePattern/Directory.hs +++ b/src/System/FilePattern/Directory.hs @@ -78,24 +78,26 @@ -- parts is a series of path components joined with trailing / characters f parts yes no - | StepEverything <- stepNext no = return [] - | not slow, StepOnly xs <- stepNext yes = g parts yes no xs False + | StepEverything <- stepNext no = pure [] + | not slow, StepOnly xs <- stepNext yes = g parts yes no xs | otherwise = do xs <- filter (not . all (== '.')) <$> getDirectoryContents (root ++ parts) - g parts yes no xs True + g parts yes no xs - -- doesExist means that one of doesFileExist or doesDirectoryExist is true - g parts yes no xs doesExist = + g parts yes no xs = concatForM (sort xs) $ \x -> do let path = root ++ parts ++ x -- deliberately shadow since using yes/no from now on would be wrong - yes <- return $ stepApply yes x - no <- return $ stepApply no x - isFile <- if stepDone yes /= [] && stepDone no == [] then Just <$> doesFileExist path else return Nothing + yes <- pure $ stepApply yes x + no <- pure $ stepApply no x + isFile <- whenMaybe (stepDone yes /= [] && stepDone no == []) (doesFileExist path) case isFile of - Just True -> return [parts ++ x] - _ | StepEverything <- stepNext no -> return [] - | StepOnly [] <- stepNext yes -> return [] + Just True -> pure [parts ++ x] + _ | StepEverything <- stepNext no -> pure [] + | StepOnly [] <- stepNext yes -> pure [] | otherwise -> do - b <- if doesExist && isFile == Just False then return True else doesDirectoryExist path - if not b then return [] else f (parts ++ x ++ "/") yes no + -- Here we used to assume that getDirectoryContents means something exists, + -- doesFileExists is False, therefore this must be a directory. + -- That's not true in the presence of symlinks. + b <- doesDirectoryExist path + if not b then pure [] else f (parts ++ x ++ "/") yes no diff --git a/src/System/FilePattern/Wildcard.hs b/src/System/FilePattern/Wildcard.hs --- a/src/System/FilePattern/Wildcard.hs +++ b/src/System/FilePattern/Wildcard.hs @@ -22,7 +22,6 @@ import Data.Functor import Data.List.Extra import Control.Applicative -import Control.Monad.Extra import System.FilePattern.ListBy import Data.Traversable import qualified Data.Foldable as F @@ -46,7 +45,7 @@ (pre, x) <- stripPrefixBy eq pre x (x, post) <- stripSuffixBy eq post x mid <- stripInfixes mid x - return $ [Left pre] ++ mid ++ [Left post] + pure $ [Left pre] ++ mid ++ [Left post] where stripInfixes [] x = Just [Right x] stripInfixes (m:ms) y = do diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -64,8 +64,8 @@ T.assertBool (sort resOne == sort resMany) "matchMany" [] putStrLn $ "Passed " ++ show (length xs ^ 2) ++ " properties on specific cases" Success{} <- quickCheckWithResult stdArgs{maxSuccess=10000} $ \(ArbPattern p) (ArbPath x) -> - (if p ?== x then label "match" else property) $ unsafePerformIO $ prop p x >> return True - return () + (if p ?== x then label "match" else property) $ unsafePerformIO $ prop p x >> pure True + pure () where prop :: FilePattern -> FilePath -> IO (Maybe [String]) prop pat file = do @@ -78,4 +78,4 @@ let norm = (\x -> if null x then [""] else x) . filter (/= ".") . split isPathSeparator when (isJust ans) $ let res = substitute pat (fromJust $ FilePattern.match pat file) in T.assertBool (norm res == norm file) "substitute" $ fields ++ ["Match" T.#= FilePattern.match pat file, "Got" T.#= res, "Input (norm)" T.#= norm file, "Got (norm)" T.#= norm res] - return ans + pure ans diff --git a/test/Test/Util.hs b/test/Test/Util.hs --- a/test/Test/Util.hs +++ b/test/Test/Util.hs @@ -96,7 +96,7 @@ substituteErr :: Partial => FilePattern -> [String] -> [String] -> IO () substituteErr pat parts want = do addTestData [pat] [] - assertException (return $ FP.substitute pat parts) want "substitute" ["Pattern" #= pat, "Parts" #= parts] + assertException (pure $ FP.substitute pat parts) want "substitute" ["Pattern" #= pat, "Parts" #= parts] stepNext :: [FilePattern] -> [String] -> FP.StepNext -> IO ()