filestore 0.4.1 → 0.4.2

raw patch · 8 files changed

+43/−23 lines, 8 filesdep +HUnitdep +mtldep ~Diffdep ~timesetup-changednew-component:exe:test-filestorePVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, mtl

Dependency ranges changed: Diff, time

API changes (from Hackage documentation)

Files

• Data/FileStore/Darcs.hs +2/−3
• Data/FileStore/Git.hs +2/−3
• Data/FileStore/Mercurial.hs +2/−3
• Data/FileStore/Types.hs +1/−1
• Data/FileStore/Utils.hs +19/−6
• Setup.lhs +1/−1
• Tests.lhs +0/−3
• filestore.cabal +16/−3

@@ -28,8 +28,7 @@  import Data.FileStore.DarcsXml (parseDarcsXML) import Data.FileStore.Types-import Data.FileStore.Utils (withSanityCheck, hashsMatch, runShellCommand, ensureFileExists, grepSearchRepo, withVerifyDir)-import Codec.Binary.UTF8.String (encodeString)+import Data.FileStore.Utils (withSanityCheck, hashsMatch, runShellCommand, ensureFileExists, grepSearchRepo, withVerifyDir, encodeArg)  import Data.ByteString.Lazy.UTF8 (toString) import qualified Data.ByteString.Lazy as B (ByteString, writeFile, null)@@ -77,7 +76,7 @@ -- | Save changes (creating the file and directory if needed), add, and commit. darcsSave :: Contents a => FilePath -> FilePath -> Author -> Description -> a -> IO () darcsSave repo name author logMsg contents = do-  withSanityCheck repo ["_darcs"] name $ B.writeFile (repo </> encodeString name) $ toByteString contents+  withSanityCheck repo ["_darcs"] name $ B.writeFile (repo </> encodeArg name) $ toByteString contents   -- Just in case it hasn't been added yet; we ignore failures since darcs will   -- fail if the file doesn't exist *and* if the file exists but has been added already.   runDarcsCommand repo "add" [name]

@@ -21,11 +21,10 @@ import Data.List.Split (endByOneOf) import System.Exit import Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import Data.FileStore.Utils (withSanityCheck, hashsMatch, runShellCommand, escapeRegexSpecialChars, withVerifyDir) +import Data.FileStore.Utils (withSanityCheck, hashsMatch, runShellCommand, escapeRegexSpecialChars, withVerifyDir, encodeArg) 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 (encodeString) import Control.Monad (when) import System.FilePath ((</>)) import System.Directory (createDirectoryIfMissing, doesDirectoryExist, executable, getPermissions, setPermissions)@@ -97,7 +96,7 @@ -- | Save changes (creating file and directory if needed), add, and commit. gitSave :: Contents a => FilePath -> FilePath -> Author -> Description -> a -> IO () gitSave repo name author logMsg contents = do-  withSanityCheck repo [".git"] name $ B.writeFile (repo </> encodeString name) $ toByteString contents+  withSanityCheck repo [".git"] name $ B.writeFile (repo </> encodeArg name) $ toByteString contents   (statusAdd, errAdd, _) <- runGitCommand repo "add" [name]   if statusAdd == ExitSuccess      then gitCommit repo [name] author logMsg

@@ -19,12 +19,11 @@ import Data.FileStore.Types import Data.Maybe (fromJust) import System.Exit-import Data.FileStore.Utils (withSanityCheck, hashsMatch, withVerifyDir, grepSearchRepo)+import Data.FileStore.Utils (withSanityCheck, hashsMatch, withVerifyDir, grepSearchRepo, encodeArg) import Data.FileStore.MercurialCommandServer 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 (encodeString) import Data.List (nub) import Control.Monad (when, liftM, unless) import System.FilePath ((</>), splitDirectories, takeFileName)@@ -84,7 +83,7 @@ -- | Save changes (creating file and directory if needed), add, and commit. mercurialSave :: Contents a => FilePath -> FilePath -> Author -> Description -> a -> IO () mercurialSave repo name author logMsg contents = do-  withSanityCheck repo [".hg"] name $ B.writeFile (repo </> encodeString name) $ toByteString contents+  withSanityCheck repo [".hg"] name $ B.writeFile (repo </> encodeArg name) $ toByteString contents   (statusAdd, errAdd, _) <- runMercurialCommand repo "add" ["path:" ++ name]   if statusAdd == ExitSuccess      then mercurialCommit repo [name] author logMsg

@@ -1,4 +1,4 @@-{-# LANGUAGE Rank2Types, TypeSynonymInstances, DeriveDataTypeable #-}+{-# LANGUAGE Rank2Types, TypeSynonymInstances, DeriveDataTypeable, FlexibleInstances #-} {- |    Module      : Data.FileStore.Types    Copyright   : Copyright (C) 2009 John MacFarlane

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {- |    Module      : Data.FileStore.Utils    Copyright   : Copyright (C) 2009 John MacFarlane, Gwern Branwen@@ -22,9 +23,9 @@         , regsSearchFile         , withSanityCheck         , grepSearchRepo -        , withVerifyDir ) where+        , withVerifyDir+        , encodeArg ) where -import Codec.Binary.UTF8.String (encodeString) import Control.Exception (throwIO) import Control.Monad (liftM, when, unless) import Data.ByteString.Lazy.UTF8 (toString)@@ -39,9 +40,21 @@ import System.Process (runProcess, waitForProcess) import qualified Data.ByteString.Lazy as B import qualified Data.ByteString as S+#if MIN_VERSION_base(4,5,0)+#else+import Codec.Binary.UTF8.String (encodeString)+#endif  import Data.FileStore.Types (SearchMatch(..), FileStoreError(IllegalResourceName, NotFound, UnknownError), SearchQuery(..)) +-- | Encode argument for raw command.+encodeArg :: String -> String+#if MIN_VERSION_base(4,5,0)+encodeArg = id+#else+encodeArg = encodeString+#endif+ -- | 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! runShellCommand :: FilePath                     -- ^ Working directory@@ -53,7 +66,7 @@   tempPath <- catch getTemporaryDirectory (\_ -> return ".")   (outputPath, hOut) <- openTempFile tempPath "out"   (errorPath, hErr) <- openTempFile tempPath "err"-  hProcess <- runProcess (encodeString command) (map encodeString optionList) (Just workingDir) environment Nothing (Just hOut) (Just hErr)+  hProcess <- runProcess (encodeArg command) (map encodeArg optionList) (Just workingDir) environment Nothing (Just hOut) (Just hErr)   status <- waitForProcess hProcess   errorOutput <- S.readFile errorPath   output <- S.readFile outputPath@@ -174,7 +187,7 @@ -- | If name doesn't exist in repo or is not a file, throw 'NotFound' exception. ensureFileExists :: FilePath -> FilePath -> IO () ensureFileExists repo name = do-  isFile <- doesFileExist (repo </> encodeString name)+  isFile <- doesFileExist (repo </> encodeArg name)   unless isFile $ throwIO NotFound  -- | Check that the filename/location is within the given repo, and not inside@@ -186,7 +199,7 @@                 -> IO b                  -> IO b withSanityCheck repo excludes name action = do-  let filename = repo </> encodeString name+  let filename = repo </> encodeArg name   let insideRepo = filename `isInsideDir` repo   let insideExcludes = or $ map (filename `isInsideDir`)                           $ map (repo </>) excludes@@ -222,7 +235,7 @@ -- | 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 $ encodeString d) >> a) $ \e ->+  catch (liftM head (getDirectoryContents $ encodeArg d) >> a) $ \e ->     if "No such file or directory" `isInfixOf` show e        then throwIO NotFound        else throwIO . UnknownError . show $ e

@@ -7,5 +7,5 @@  Run test suite. -> runTestSuite _ _ _ _ = runCommand "runghc -idist/build/autogen Tests.lhs" >>= waitForProcess >>= exitWith+> runTestSuite _ _ _ _ = runCommand "./dist/build/test-filestore/test-filestore" >>= waitForProcess >>= exitWith 

@@ -1,9 +1,6 @@ #!/usr/bin/env runghc  This program runs tests for the filestore modules.-Invoke it with:--    runghc -idist/build/autogen Tests.lhs  > import Data.FileStore > import Data.List (sort, isInfixOf)

@@ -1,8 +1,7 @@ Name:                filestore-Version:             0.4.1+Version:             0.4.2 Cabal-version:       >= 1.2 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                      file store, and modules that instantiate this interface.  Currently@@ -24,6 +23,10 @@ --    Type:            darcs --    Location:        http://johnmacfarlane.net/repos/filestore +Flag tests+    default:    False+    description: Build test suite+ Flag maxcount     default:     True     description: Make use of a recent (>= 2.3.0) Darcs feature which vastly improves the performance@@ -51,7 +54,7 @@     Other-modules:       Paths_filestore,                          Data.FileStore.DarcsXml,                          Data.FileStore.MercurialCommandServer-    extensions:          FlexibleInstances+    extensions:          FlexibleInstances, CPP      if flag(maxcount)          cpp-options: -DUSE_MAXCOUNT@@ -61,3 +64,13 @@     else       Ghc-Options:       -Wall     Ghc-Prof-Options:    -auto-all++Executable test-filestore+    if flag(tests)+       Buildable: True+    else+       Buildable: False+    Main-is: Tests.lhs+    Build-depends:  base >= 4 && < 5, HUnit >= 1.2 && < 1.3, mtl,+                    time, Diff+