filestore 0.3.1 → 0.3.2

raw patch · 7 files changed

+114/−45 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES +34/−0
• Data/FileStore/Darcs.hs +10/−6
• Data/FileStore/Git.hs +16/−15
• Data/FileStore/Types.hs +7/−0
• Data/FileStore/Utils.hs +14/−5
• Tests.lhs +27/−13
• filestore.cabal +6/−6

@@ -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

@@ -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"]

@@ -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

@@ -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

@@ -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

@@ -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): 

@@ -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