diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,37 @@ +Version 0.3.2 released ?? + +* Made maxcount default to True, as '--max-count' is supported by + the latest released version of darcs (2.3.0). Print an informative + error message if the version of darcs being used does not support + --max-count. + +* Made 'initialize' throw RepoExists error only if the repo + exists; catch permission or other errors separately. (Thomas Hartmann) + +* Made 'index' throw an error if the directory is not present or + there are insufficient permissions. (Thomas Hartmann) + +* Improved error message for search match helper. + +Version 0.3.1 released 04 Jul 2009 + +* Added -I flag to grep in regSearchFiles. Ignore binary files + in the repository when searching. + +* Added maxcount Cabal flag, defaulting to False. When true, + this flag causes 'latest' to run 'darcs changes' with the + flag '--max-count=1', which dramatically increases performance. + (Without this, filestore has to retrieve the entire changelog + just to get the latest revision ID.) '--max-count' is at this + point only in development versions of darcs. + +* Removed quoting from --match=hash in Darcs module (since it doesn't + go through /bin/sh). Thanks to Ganesh Sittampalam. + +* Efficiency improvements and refactoring in Darcs module. + +* Moved darcs utility functions to Util module. + Version 0.3 released 08 Apr 2009 * Added new 'directory' function, which returns a list of resources given diff --git a/Data/FileStore/Darcs.hs b/Data/FileStore/Darcs.hs --- a/Data/FileStore/Darcs.hs +++ b/Data/FileStore/Darcs.hs @@ -18,13 +18,16 @@ import Control.Monad (unless, when) import Data.DateTime (toSqlString) import Data.List (sort, isPrefixOf) +#ifdef USE_MAXCOUNT +import Data.List (isInfixOf) +#endif +import System.Exit (ExitCode(..)) import System.Directory (doesDirectoryExist, createDirectoryIfMissing) -import System.Exit (ExitCode(ExitSuccess)) import System.FilePath ((), takeDirectory, dropFileName, addTrailingPathSeparator) import Data.FileStore.DarcsXml (parseDarcsXML) import Data.FileStore.Types -import Data.FileStore.Utils (checkAndWriteFile, hashsMatch, isInsideRepo, runShellCommand, ensureFileExists, grepSearchRepo) +import Data.FileStore.Utils (checkAndWriteFile, hashsMatch, isInsideRepo, runShellCommand, ensureFileExists, grepSearchRepo, withVerifyDir) import Data.ByteString.Lazy.UTF8 (toString) import qualified Data.ByteString.Lazy as B (ByteString) @@ -62,7 +65,7 @@ darcsInit :: FilePath -> IO () darcsInit repo = do exists <- doesDirectoryExist repo - when exists $ throwIO RepositoryExists + when exists $ withVerifyDir repo $ throwIO RepositoryExists createDirectoryIfMissing True repo (status, err, _) <- runDarcsCommand repo "init" [] if status == ExitSuccess @@ -151,7 +154,8 @@ darcsLatestRevId repo name = do ensureFileExists repo name #ifdef USE_MAXCOUNT - (_, _, output) <- runDarcsCommand repo "changes" ["--xml-output", "--max-count=1", name] + (status, err, output) <- runDarcsCommand repo "changes" ["--xml-output", "--max-count=1", name] + when (status /= ExitSuccess && "unrecognized option" `isInfixOf` err) $ throwIO NoMaxCount #else (_, _, output) <- runDarcsCommand repo "changes" ["--xml-output", name] #endif @@ -178,7 +182,7 @@ -- | Get a list of all known files inside and managed by a repository. darcsIndex :: FilePath ->IO [FilePath] -darcsIndex repo = do +darcsIndex repo = withVerifyDir repo $ do (status, _errOutput, output) <- runDarcsCommand repo "query" ["files","--no-directories"] if status == ExitSuccess then return $ map (drop 2) . lines . toString $ output @@ -186,7 +190,7 @@ -- | Get a list of all resources inside a directory in the repository. darcsDirectory :: FilePath -> FilePath -> IO [Resource] -darcsDirectory repo dir = do +darcsDirectory repo dir = withVerifyDir (repo dir) $ do let dir' = if null dir then "" else addTrailingPathSeparator dir (status1, _errOutput1, output1) <- runDarcsCommand repo "query" ["files","--no-directories"] (status2, _errOutput2, output2) <- runDarcsCommand repo "query" ["files","--no-files"] diff --git a/Data/FileStore/Git.hs b/Data/FileStore/Git.hs --- a/Data/FileStore/Git.hs +++ b/Data/FileStore/Git.hs @@ -20,20 +20,17 @@ import Data.Maybe (mapMaybe) import System.Exit import Data.Time.Clock.POSIX (posixSecondsToUTCTime) -import Data.FileStore.Utils (checkAndWriteFile, hashsMatch, isInsideRepo, runShellCommand, escapeRegexSpecialChars) +import Data.FileStore.Utils (checkAndWriteFile, hashsMatch, isInsideRepo, runShellCommand, escapeRegexSpecialChars, withVerifyDir) import Data.ByteString.Lazy.UTF8 (toString) import qualified Data.ByteString.Lazy as B import qualified Text.ParserCombinators.Parsec as P -import Codec.Binary.UTF8.String (decodeString) +import Codec.Binary.UTF8.String (decodeString, encodeString) import Data.Char (chr) -import Control.Monad (liftM, when) +import Control.Monad (liftM, unless, when) import System.FilePath ((), takeDirectory) -import System.Directory (doesDirectoryExist, createDirectoryIfMissing) -import Codec.Binary.UTF8.String (encodeString) +import System.Directory (createDirectoryIfMissing, doesDirectoryExist, executable, getPermissions, setPermissions) import Control.Exception (throwIO) -import Control.Monad (unless) import Text.Regex.Posix ((=~)) -import System.Directory (getPermissions, setPermissions, executable) import Paths_filestore -- | Return a filestore implemented using the git distributed revision control system @@ -41,7 +38,7 @@ gitFileStore :: FilePath -> FileStore gitFileStore repo = FileStore { initialize = gitInit repo - , save = gitSave repo + , save = gitSave repo , retrieve = gitRetrieve repo , delete = gitDelete repo , rename = gitMove repo @@ -66,7 +63,7 @@ gitInit :: FilePath -> IO () gitInit repo = do exists <- doesDirectoryExist repo - when exists $ throwIO RepositoryExists + when exists $ withVerifyDir repo $ throwIO RepositoryExists createDirectoryIfMissing True repo (status, err, _) <- runGitCommand repo "init" [] if status == ExitSuccess @@ -169,7 +166,7 @@ -- | Get a list of all known files inside and managed by a repository. gitIndex :: FilePath ->IO [FilePath] -gitIndex repo = do +gitIndex repo = withVerifyDir repo $ do (status, _err, output) <- runGitCommand repo "ls-tree" ["-r","-t","HEAD"] if status == ExitSuccess then return $ mapMaybe (lineToFilename . words) . lines . toString $ output @@ -178,9 +175,12 @@ where lineToFilename (_:"blob":_:rest) = Just $ convertEncoded $ unwords rest lineToFilename _ = Nothing + + + -- | Get list of resources in one directory of the repository. gitDirectory :: FilePath -> FilePath -> IO [Resource] -gitDirectory repo dir = do +gitDirectory repo dir = withVerifyDir (repo dir) $ do (status, _err, output) <- runGitCommand repo "ls-tree" ["HEAD:" ++ dir] if status == ExitSuccess then return $ map (lineToResource . words) $ lines $ toString output @@ -202,14 +202,15 @@ concatMap (\term -> ["-e", escapeRegexSpecialChars term]) (queryPatterns query)) if status == ExitSuccess then return $ map parseMatchLine $ lines $ toString output - else error $ "git grep returned error status.\n" ++ errOutput + else throwIO $ UnknownError $ "git grep returned error status.\n" ++ errOutput -- Auxiliary function for searchResults parseMatchLine :: String -> SearchMatch parseMatchLine str = - let (_,_,_,[fname,_,ln,cont]) = str =~ "^(([^:]|:[^0-9])*):([0-9]*):(.*)$" :: (String, String, String, [String]) - in SearchMatch{matchResourceName = fname, matchLineNumber = read ln, matchLine = cont} - + let (_,_,_,res) = str =~ "^(([^:]|:[^0-9])*):([0-9]*):(.*)$" :: (String, String, String, [String]) + in case res of + [fname,_,ln,cont] -> SearchMatch{matchResourceName = fname, matchLineNumber = read ln, matchLine = cont} + e -> error $ "parseMatchLine: (str,e)" ++ show (str,e) -- give better error for failing tests {- -- | Uses git-diff to get a dif between two revisions. gitDiff :: FilePath -> FilePath -> RevisionId -> RevisionId -> IO String diff --git a/Data/FileStore/Types.hs b/Data/FileStore/Types.hs --- a/Data/FileStore/Types.hs +++ b/Data/FileStore/Types.hs @@ -99,6 +99,8 @@ | Unchanged -- ^ The resource was not modified, -- because the contents were unchanged | UnsupportedOperation + | NoMaxCount -- ^ The darcs version used does not support + -- --max-count | UnknownError String deriving (Read, Eq, Typeable) @@ -109,6 +111,11 @@ show IllegalResourceName = "IllegalResourceName" show Unchanged = "Unchanged" show UnsupportedOperation = "UnsupportedOperation" + show NoMaxCount = "NoMaxCount:\n" + ++ "filestore was compiled with the maxcount flag, but your version of\n" + ++ "darcs does not support the --max-count option. You should either\n" + ++ "upgrade to darcs >= 2.3.0 (recommended) or compile filestore without\n" + ++ "the maxcount flag (cabal install filestore -f-maxcount)." show (UnknownError s) = "UnknownError: " ++ s instance Exception FileStoreError diff --git a/Data/FileStore/Utils.hs b/Data/FileStore/Utils.hs --- a/Data/FileStore/Utils.hs +++ b/Data/FileStore/Utils.hs @@ -22,17 +22,18 @@ , regSearchFiles , regsSearchFile , checkAndWriteFile - , grepSearchRepo ) where + , grepSearchRepo + , withVerifyDir ) where import Codec.Binary.UTF8.String (encodeString) import Control.Exception (throwIO) import Control.Monad (liftM, unless) import Data.ByteString.Lazy.UTF8 (toString) import Data.Char (isSpace) -import Data.List (intersect, nub, isPrefixOf) +import Data.List (intersect, nub, isPrefixOf, isInfixOf) import Data.List.Split (splitWhen) import Data.Maybe (isJust) -import System.Directory (canonicalizePath, doesFileExist, getTemporaryDirectory, removeFile, findExecutable, createDirectoryIfMissing) +import System.Directory (canonicalizePath, doesFileExist, getTemporaryDirectory, removeFile, findExecutable, createDirectoryIfMissing, getDirectoryContents) import System.Exit (ExitCode(..)) import System.FilePath ((), takeDirectory) import System.IO (openTempFile, hClose) @@ -41,7 +42,7 @@ import qualified Data.ByteString.Lazy as B import Data.FileStore.Types (toByteString, Contents, SearchMatch(..), - FileStoreError(IllegalResourceName, NotFound), SearchQuery(..)) + FileStoreError(IllegalResourceName, NotFound, UnknownError), SearchQuery(..)) -- | Run shell command and return error status, standard output, and error output. Assumes -- UTF-8 locale. Note that this does not actually go through \/bin\/sh! @@ -189,7 +190,7 @@ grepSearchRepo :: (FilePath -> IO [String]) -> FilePath -> SearchQuery -> IO [SearchMatch] grepSearchRepo indexer repo query = do let opts = ["-I", "--line-number", "--with-filename"] ++ - (if queryIgnoreCase query then ["-i"] else []) ++ + ["-i" | queryIgnoreCase query] ++ (if queryWholeWords query then ["--word-regexp"] else ["-E"]) let regexps = map escapeRegexSpecialChars $ queryPatterns query files <- indexer repo @@ -205,3 +206,11 @@ files let results = lines $ toString output return $ map parseMatchLine results + +-- | we don't actually need the contents, just want to check that the directory exists and we have enough permissions +withVerifyDir :: FilePath -> IO a -> IO a +withVerifyDir d a = + catch (liftM head (getDirectoryContents d) >> a) $ \e -> + if "No such file or directory" `isInfixOf` show e + then throwIO NotFound + else throwIO . UnknownError . show $ e diff --git a/Tests.lhs b/Tests.lhs --- a/Tests.lhs +++ b/Tests.lhs @@ -6,15 +6,14 @@ runghc -idist/build/autogen Tests.lhs > import Data.FileStore -> import Data.List (sort) +> import Data.List (sort, isInfixOf) > import Test.HUnit -> import System.Directory (removeDirectoryRecursive) +> import System.Directory (doesFileExist, removeDirectoryRecursive) > import Control.Monad (forM) > import Prelude hiding (catch) > import Control.Exception (catch) > import Data.DateTime > import Data.Maybe (mapMaybe) -> import System.Directory (doesFileExist) > import System.FilePath > import System.Process > import Data.Algorithm.Diff (DI(..)) @@ -24,13 +23,15 @@ > testFileStore (darcsFileStore "tmp/darcsfs") "Data.FileStore.Darcs" > removeDirectoryRecursive "tmp" + > testFileStore :: FileStore -> String -> IO Counts > testFileStore fs fsName = do > putStrLn "**********************************" > putStrLn $ "Testing " ++ fsName > putStrLn "**********************************" > runTestTT $ TestList $ map (\(label, testFn) -> TestLabel label $ testFn fs) -> [ ("initialize", initializeTest) +> [ ("pre initialize", preInitializeTest) +> , ("initialize", initializeTest) > , ("create resource", createTest1) > , ("create resource in subdirectory", createTest2) > , ("create resource with non-ascii name", createTest3) @@ -64,6 +65,14 @@ > nonasciiTestTitle :: String > nonasciiTestTitle = "αβγ" +*** index and directory for noexisting repository should raise error: + +> preInitializeTest fs = TestCase $ do +> catch (do index fs; assertFailure "preInitialize, uncaught error") $ +> \e -> assertEqual "error status from attempt to get index of nonexistent repo" e NotFound +> catch (do directory fs "foo"; assertFailure "preInitialize, uncaught error") $ +> \e -> assertEqual "error status from attempt to get directory of nonexistent repo" e NotFound + *** Initialize a repository, check for empty index, and then try to initialize again *** in the same directory (should raise an error): @@ -119,23 +128,28 @@ > subdirFiles <- directory fs "subdir" > assertEqual "result of directory on subdir" [FSFile (takeFileName subdirTestTitle), FSFile (takeFileName (subdirTestTitle ++ "2"))] subdirFiles + Try to get contents of nonexistent subdirectory + +> catch (do directory fs "foo"; assertFailure "nonexistent subdirectory, uncaught error") $ +> \e -> assertEqual "error status from attempt to get directory listing of nonexistent directory" e NotFound + *** Retrieve latest version of a resource: -> retrieveTest1 fs = TestCase $ do -> cont <- retrieve fs testTitle Nothing -> assertEqual "contents returned by retrieve" testContents cont +> retrieveTest1 fs = TestCase $ +> retrieve fs testTitle Nothing >>= +> assertEqual "contents returned by retrieve" testContents *** Retrieve latest version of a resource (in a subdirectory): -> retrieveTest2 fs = TestCase $ do -> cont <- retrieve fs subdirTestTitle Nothing -> assertEqual "contents returned by retrieve" testContents cont +> retrieveTest2 fs = TestCase $ +> retrieve fs subdirTestTitle Nothing >>= +> assertEqual "contents returned by retrieve" testContents *** Retrieve latest version of a resource with a nonascii name: -> retrieveTest3 fs = TestCase $ do -> cont <- retrieve fs nonasciiTestTitle Nothing -> assertEqual "contents returned by retrieve" testContents cont +> retrieveTest3 fs = TestCase $ +> retrieve fs nonasciiTestTitle Nothing >>= +> assertEqual "contents returned by retrieve" testContents *** Retrieve a directory (should fail): diff --git a/filestore.cabal b/filestore.cabal --- a/filestore.cabal +++ b/filestore.cabal @@ -1,5 +1,5 @@ Name: filestore -Version: 0.3.1 +Version: 0.3.2 Cabal-version: >= 1.2 Build-type: Custom Tested-with: GHC==6.10.1 @@ -25,10 +25,10 @@ -- Location: http://johnmacfarlane.net/repos/filestore Flag maxcount - default: False - description: Make use of a bleeding-edge Darcs feature which is a large performance win. - Don't enable this unless you can do a command like 'darcs changes --max-count=1' - without error! If you don't know what --max-count is, you probably don't have it. + default: True + description: Make use of a recent (>= 2.3.0) Darcs feature which vastly improves the performance + of 'latest'. You should disable this flag if you plan to use gitit with an + older version of Darcs, or 'latest' will raise an error. Library Build-depends: base >= 4 && < 5, bytestring, utf8-string, filepath, directory, datetime, @@ -39,7 +39,7 @@ Data.FileStore.Utils, Data.FileStore.Generic Other-modules: Paths_filestore, Data.FileStore.DarcsXml - if flag(maxcount) + if flag(maxcount) cpp-options: -DUSE_MAXCOUNT extensions: CPP