filestore 0.1 → 0.2

raw patch · 9 files changed

+103/−53 lines, 9 filesbuild-type:Customsetup-changednew-uploaderPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES +33/−0
• Data/FileStore.hs +1/−1
• Data/FileStore/Darcs.hs +19/−15
• Data/FileStore/Generic.hs +11/−16
• Data/FileStore/Git.hs +11/−11
• Data/FileStore/Utils.hs +1/−1
• Setup.lhs +9/−1
• Tests.lhs +14/−5
• filestore.cabal +4/−3

@@ -0,0 +1,33 @@+Version 0.2 released 08 Feb 2009++* Changed diff to do a line-by-line rather than word-by-word diff.+  The word-by-word diff led to excessive memory usage and confusing+  output in some cases.  NOTE:  diff now returns lists of lines,+  not including newlines.  So calling programs may need to be changed.++  diff also now skips calling getGroupedDiff when the left document+  is empty, for better performance.++* Added ghc-prof-options to cabal file.++* Clean up code in gitRetrieve.++* Added ensureFileExists to Darcs module. Added checks to ensure that file+  exists in darcsLatestRevId and darcsRetrieve.  If not, return+  NotFound.++* gitRetrieve:  check to make sure object is a file before retrieving.+  Also, if Nothing is the revision ID, use gitLatestRevId rather than+  going directly to the file system. This is a step in the direction of+  making filestore compatible with bare repositories.++* Test suite has been wired into Setup.lhs:  'cabal test' now runs tests.++* Added new test case for attempting to retrieve a subdirectory,+  and for creating a second file in a subdirectory.++* Minor code cleanup.++Version 0.1 released 24 Jan 2009++* Initial release.

@@ -1,7 +1,7 @@ {-# LANGUAGE Rank2Types, FlexibleContexts #-} {- |    Module      : Data.FileStore-   Copyright   : Copyright (C) 2009 John MacFarlane, Gwern Brandwen, Sebastiaan Visser+   Copyright   : Copyright (C) 2009 John MacFarlane, Gwern Branwen, Sebastiaan Visser    License     : BSD 3     Maintainer  : John MacFarlane <jgm@berkeley.edu>

@@ -1,6 +1,6 @@ {- |    Module      : Data.FileStore.Darcs-   Copyright   : Copyright (C) 2009 Gwern Brandwen+   Copyright   : Copyright (C) 2009 Gwern Branwen    License     : BSD 3     Maintainer  : John MacFarlane <jgm@berkeley.edu>@@ -25,13 +25,12 @@ import Data.List (intersect, nub) import Data.Maybe (fromMaybe, fromJust) import Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import System.Directory (doesDirectoryExist, createDirectoryIfMissing)+import System.Directory (doesFileExist, doesDirectoryExist, createDirectoryIfMissing) import System.Exit (ExitCode(ExitSuccess)) import System.FilePath ((</>), takeDirectory, dropFileName)-import System.IO.Error (isDoesNotExistError) import Text.Regex.Posix ((=~)) import Text.XML.Light-import qualified Data.ByteString.Lazy as B (ByteString, readFile, writeFile)+import qualified Data.ByteString.Lazy as B (ByteString, writeFile)  -- | Return a filestore implemented using the Darcs distributed revision control system -- (<http://darcs.net/>).@@ -138,6 +137,12 @@                                         os ++ [p, f]                          return $ lines $ toString r +-- | If name doesn't exist in repo or is not a file, throw NotFound+ensureFileExists :: FilePath -> ResourceName -> IO ()+ensureFileExists repo name = do+  isFile <- doesFileExist (repo </> encodeString name)+  when (not isFile) $ throwIO NotFound+ --------------------------- -- End utility functions and types -- Begin repository creation & modification@@ -236,6 +241,7 @@ -- | Return revision ID for latest commit for a resource. darcsLatestRevId :: FilePath -> ResourceName -> IO RevisionId darcsLatestRevId repo name = do+  ensureFileExists repo name   -- changes always succeeds, so no need to check error   (_, _, output) <- runDarcsCommand repo "changes" ["--xml-output", "--summary", name]   let patchs = parseDarcsXML $ toString output@@ -243,23 +249,21 @@       Nothing -> throwIO NotFound       Just as -> if null as then throwIO NotFound else return $ revId $ head as --- | Retrieve the (text) contents of a resource.+-- | Retrieve the contents of a resource. darcsRetrieve :: Contents a             => FilePath             -> ResourceName             -> Maybe RevisionId    -- ^ @Just@ revision ID, or @Nothing@ for latest             -> IO a--- If called with Nothing, go straight to the file system-darcsRetrieve repo name Nothing = do-  let filename = repo </> encodeString name-  catch (liftM fromByteString $ B.readFile filename) $-    \e -> if isDoesNotExistError e then throwIO NotFound else throwIO e+darcsRetrieve repo name Nothing =+  darcsLatestRevId repo name >>= darcsRetrieve repo name . Just darcsRetrieve repo name (Just revid) = do-   let opts = ["contents", "--match=hash " ++ revid, name]-   (status, err, output) <- runDarcsCommand repo "query" opts-   if status == ExitSuccess-      then return $ fromByteString output-      else throwIO $ UnknownError $ "Error in darcs query contents:\n" ++ err+  ensureFileExists repo name+  let opts = ["contents", "--match=hash " ++ revid, name]+  (status, err, output) <- runDarcsCommand repo "query" opts+  if status == ExitSuccess+     then return $ fromByteString output+     else throwIO $ UnknownError $ "Error in darcs query contents:\n" ++ err  -- | Get a list of all known files inside and managed by a repository. darcsIndex :: FilePath ->IO [ResourceName]

@@ -1,6 +1,6 @@ {- |    Module      : Data.FileStore.Generic-   Copyright   : Copyright (C) 2009 John MacFarlane, Gwern Brandwen, Sebastiaan Visser+   Copyright   : Copyright (C) 2009 John MacFarlane, Gwern Branwen, Sebastiaan Visser    License     : BSD 3     Maintainer  : John MacFarlane <jgm@berkeley.edu>@@ -24,10 +24,7 @@  import Control.Exception (throwIO, catch, SomeException, try) import Data.FileStore.Utils-import Data.Maybe (isNothing) import Data.List (isInfixOf)-import qualified Data.List.Split as S (whenElt, split)-import Data.Char (isSpace) import Data.Algorithm.Diff (DI(..), getGroupedDiff) import Prelude hiding (catch) @@ -72,25 +69,23 @@                                   handleUnknownError        return $ Left (MergeInfo latestRev conflicts mergedText) --- | Split a string at spaces (but include the spaces in the list of results).-splitOnSpaces :: String -> [String]-splitOnSpaces = S.split (S.whenElt isSpace) ---- | Return a unified diff of two revisions of a named resource, using an external @diff@--- program.+-- | Return a unified diff of two revisions of a named resource.+-- Format of the diff is a list @[(DI, [String])]@, where+-- @DI@ is @F@ (in first document only), @S@ (in second only),+-- or @B@ (in both), and the list is a list of lines (without+-- newlines at the end). diff :: FileStore      -> ResourceName      -- ^ Resource name to get diff for.      -> Maybe RevisionId  -- ^ @Just@ old revision ID, or @Nothing@ for empty.      -> Maybe RevisionId  -- ^ @Just@ oew revision ID, or @Nothing@ for latest.      -> IO [(DI, [String])]+diff fs name Nothing id2 = do+  contents2 <- retrieve fs name id2+  return [(S, lines contents2)]   -- no need to run getGroupedDiff here - diff vs empty document  diff fs name id1 id2 = do-  contents1 <- if isNothing id1-                  then return ""-                  else retrieve fs name id1+  contents1 <- retrieve fs name id1   contents2 <- retrieve fs name id2-  let words1 = splitOnSpaces contents1-  let words2 = splitOnSpaces contents2-  return $ getGroupedDiff words1 words2+  return $ getGroupedDiff (lines contents1) (lines contents2)  -- | Return a list of all revisions that are saved with the given -- description or with a part of this description.

@@ -18,7 +18,6 @@ where import Data.FileStore.Types import System.Exit-import System.IO.Error (isDoesNotExistError) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.FileStore.Utils (hashsMatch, isInsideRepo, runShellCommand, escapeRegexSpecialChars)  import Data.ByteString.Lazy.UTF8 (toString)@@ -112,16 +111,17 @@             -> ResourceName             -> Maybe RevisionId    -- ^ @Just@ revision ID, or @Nothing@ for latest             -> IO a-gitRetrieve repo name Nothing = do-  -- If called with Nothing, go straight to the file system-  let filename = repo </> encodeString name-  catch (liftM fromByteString $ B.readFile filename) $-    \e -> if isDoesNotExistError e then throwIO NotFound else throwIO e-gitRetrieve repo name (Just revid) = do-  (status, err, output) <- runGitCommand repo "cat-file" ["-p", revid ++ ":" ++ name]-  if status == ExitSuccess-     then return $ fromByteString output-     else throwIO $ UnknownError $ "Error in git cat-file:\n" ++ err+gitRetrieve repo name revid = do+  let objectName = case revid of+                        Nothing  -> "HEAD:" ++ name+                        Just rev -> rev ++ ":" ++ name+  -- Check that the object is a file (blob), not a directory (tree)+  (_, _, output) <- runGitCommand repo "cat-file" ["-t", objectName]+  when (take 4 (toString output) /= "blob") $ throwIO NotFound+  (status', err', output') <- runGitCommand repo "cat-file" ["-p", objectName]+  if status' == ExitSuccess+     then return $ fromByteString output'+     else throwIO $ UnknownError $ "Error in git cat-file:\n" ++ err'  -- | Delete a resource from the repository. gitDelete :: FilePath -> ResourceName -> Author -> Description -> IO ()

@@ -1,6 +1,6 @@ {- |    Module      : Data.FileStore.Utils-   Copyright   : Copyright (C) 2009 John MacFarlane, Gwern Brandwen+   Copyright   : Copyright (C) 2009 John MacFarlane, Gwern Branwen    License     : BSD 3     Maintainer  : John MacFarlane <jgm@berkeley.edu>

@@ -1,3 +1,11 @@ #!/usr/bin/env runhaskell > import Distribution.Simple-> main = defaultMain+> import System.Process+> import System.Exit++> main = defaultMainWithHooks $ simpleUserHooks { runTests  = runTestSuite }++Run test suite.++> runTestSuite _ _ _ _ = runCommand "runghc -idist/build/autogen Tests.lhs" >>= waitForProcess >>= exitWith+

@@ -3,7 +3,7 @@ This program runs tests for the filestore modules. Invoke it with: -    runghc Tests.lhs+    runghc -idist/build/autogen Tests.lhs  > import Data.FileStore > import Test.HUnit@@ -36,6 +36,7 @@ >     , ("retrieve resource", retrieveTest1) >     , ("retrieve resource in a subdirectory", retrieveTest2) >     , ("retrieve resource with non-ascii name", retrieveTest3)+>     , ("retrieve subdirectory (should raise error)", retrieveTest4) >     , ("modify resource", modifyTest) >     , ("delete resource", deleteTest) >     , ("rename resource", renameTest)@@ -83,6 +84,7 @@ >   create fs subdirTestTitle testAuthor "description of change" testContents >   revid <- latest fs testTitle >   assertBool "revision returns a revision after create" (not (null revid))+>   create fs "subdir/Subdir title2.txt" testAuthor "+Second file" testContents  *** Create a resource with a non-ascii title, and check to see that revision returns a revision for it: @@ -118,6 +120,13 @@ >   cont <- retrieve fs nonasciiTestTitle Nothing >   assertEqual "contents returned by retrieve" testContents cont  +*** Retrieve a directory (should fail):++> retrieveTest4 fs = TestCase $ do+>   catch ((retrieve fs "subdir" Nothing :: IO String) >>+>          assertFailure "did not return error from retrieve from subdir") $+>      \e -> assertEqual "error from retrieve from subdir" NotFound e+ *** Modify a resource:  > modifyTest fs = TestCase $ do@@ -230,14 +239,14 @@  >   [secondrev, firstrev] <- history fs [diffTitle] (TimeRange Nothing Nothing) >   diff' <- diff fs diffTitle (Just $ revId firstrev) (Just $ revId secondrev)->   let subtracted' = mapMaybe (\(d,s) -> if d == F then Just (concat s) else Nothing) diff'->   assertEqual "subtracted lines" [last (lines testContents)] subtracted'+>   let subtracted' = mapMaybe (\(d,s) -> if d == F then Just s else Nothing) diff'+>   assertEqual "subtracted lines" [[last (lines testContents)]] subtracted'      Diff from Nothing should be diff from empty document.  >   diff'' <- diff fs diffTitle Nothing (Just $ revId firstrev)->   let added'' = mapMaybe (\(d,s) -> if d == S then Just (concat s) else Nothing) diff''->   assertEqual "added lines from empty document to first revision" [testContents] added''+>   let added'' = mapMaybe (\(d,s) -> if d == S then Just s else Nothing) diff''+>   assertEqual "added lines from empty document to first revision" [lines testContents] added''      Diff to Nothing should be diff to latest. 

@@ -1,7 +1,7 @@ Name:                filestore-Version:             0.1+Version:             0.2 Cabal-version:       >= 1.2-Build-type:          Simple+Build-type:          Custom Tested-with:         GHC==6.10.1 Synopsis:            Interface for versioning file stores. Description:         The filestore library provides an abstract interface for a versioning@@ -21,5 +21,6 @@                      -- Data.FileStore.Sqlite3,                      Data.FileStore.Utils, Data.FileStore.Generic Other-modules:       Paths_filestore-Data-Files:          extra/post-update+Data-Files:          extra/post-update, CHANGES Ghc-Options:         -Wall+Ghc-Prof-Options:    -auto-all