filestore 0.6.0.3 → 0.6.0.4
raw patch · 6 files changed
+413/−411 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGES +4/−0
- Data/FileStore/Generic.hs +10/−11
- Data/FileStore/Types.hs +0/−1
- filestore.cabal +2/−2
- tests/Tests.hs +397/−0
- tests/Tests.lhs +0/−397
CHANGES view
@@ -1,3 +1,7 @@+Version 0.6.0.4 released 31 Oct 2014++* Fixed test suite so that it returns error status if tests fail (#16).+ Version 0.6.0.3 released 26 Jul 2014 * Disable the broken mercurial command server on Windows, falling back
Data/FileStore/Generic.hs view
@@ -24,15 +24,14 @@ where import Data.FileStore.Types -import Control.Exception (throwIO, catch, SomeException, try)+import Control.Exception as E import Data.FileStore.Utils import Data.List (isInfixOf) import Data.Algorithm.Diff (Diff(..), getGroupedDiff) import System.FilePath ((</>))-import Prelude hiding (catch) -handleUnknownError :: SomeException -> IO a-handleUnknownError = throwIO . UnknownError . show+handleUnknownError :: E.SomeException -> IO a+handleUnknownError = E.throwIO . UnknownError . show -- | Like save, but first verify that the resource name is new. If not, throws a 'ResourceExists' -- error.@@ -43,10 +42,10 @@ -> Description -- ^ Description of change. -> a -- ^ Contents of resource. -> IO ()-create fs name author logMsg contents = catch (latest fs name >> throwIO ResourceExists)+create fs name author logMsg contents = E.catch (latest fs name >> E.throwIO ResourceExists) (\e -> if e == NotFound then save fs name author logMsg contents- else throwIO e)+ else E.throwIO e) -- | Modify a named resource in the filestore. Like save, except that a revision ID -- must be specified. If the resource has been modified since the specified revision,@@ -67,7 +66,7 @@ else do latestContents <- retrieve fs name (Just latestRevId) originalContents <- retrieve fs name (Just originalRevId)- (conflicts, mergedText) <- catch + (conflicts, mergedText) <- E.catch (mergeContents ("edited", toByteString contents) (originalRevId, originalContents) (latestRevId, latestContents)) handleUnknownError return $ Left (MergeInfo latestRev conflicts mergedText)@@ -119,14 +118,14 @@ -> Maybe String -- ^ @Just@ revision ID or description, or @Nothing@ for empty. -> IO a smartRetrieve fs exact name mrev = do- edoc <- try (retrieve fs name mrev)+ edoc <- E.try (retrieve fs name mrev) case (edoc, mrev) of -- Regular retrieval using revision identifier succeeded, use this doc. (Right doc, _) -> return doc -- Retrieval of latest revision failed, nothing we can do about this.- (Left e, Nothing) -> throwIO (e :: FileStoreError)+ (Left e, Nothing) -> E.throwIO (e :: FileStoreError) -- Retrieval failed, we can try fetching a revision by the description. (Left _, Just rev) -> do@@ -134,7 +133,7 @@ if Prelude.null revs -- No revisions containing this description.- then throwIO NotFound+ then E.throwIO NotFound -- Retrieve resource for latest matching revision. else retrieve fs name (Just $ revId $ Prelude.head revs)@@ -142,7 +141,7 @@ -- | Like 'directory', but returns information about the latest revision. richDirectory :: FileStore -> FilePath -> IO [(Resource, Either String Revision)] richDirectory fs fp = directory fs fp >>= mapM f- where f r = Control.Exception.catch (g r) (\(e :: FileStoreError)-> return ( r, Left . show $ e ) )+ where f r = E.catch (g r) (\(e :: FileStoreError)-> return ( r, Left . show $ e ) ) g r@(FSDirectory _dir) = return (r,Left "richDirectory, we don't care about revision info for directories") g res@(FSFile file) = do rev <- revision fs =<< latest fs ( fp </> file ) return (res,Right rev)
Data/FileStore/Types.hs view
@@ -34,7 +34,6 @@ import Data.ByteString.Lazy.UTF8 (toString, fromString) import Data.Time (UTCTime) import Control.Exception (Exception)-import Prelude hiding (catch) type RevisionId = String
filestore.cabal view
@@ -1,5 +1,5 @@ Name: filestore-Version: 0.6.0.3+Version: 0.6.0.4 Cabal-Version: >= 1.10 Build-type: Custom Synopsis: Interface for versioning file stores.@@ -61,7 +61,7 @@ Test-suite test-filestore Type: exitcode-stdio-1.0 Hs-source-dirs: tests- Main-is: Tests.lhs+ Main-is: Tests.hs Default-Language: Haskell98 Build-depends: base >= 4 && < 5, HUnit >= 1.2 && < 1.3,
+ tests/Tests.hs view
@@ -0,0 +1,397 @@+import Data.FileStore+import Data.List (sort, isInfixOf)+import Test.HUnit+import System.Directory (doesFileExist, removeDirectoryRecursive)+import Control.Monad (forM)+import Prelude hiding (catch)+import Control.Exception (catch)+import Data.Time+import Data.Maybe (mapMaybe)+import System.FilePath+import Data.Algorithm.Diff (Diff(..))+import System.Exit++data FileStoreType = Darcs | Git | Mercurial deriving (Show, Eq)++main = do+ gc <- testFileStore (gitFileStore "tmp/gitfs") Git+ dc <- testFileStore (darcsFileStore "tmp/darcsfs") Darcs+ mc <- testFileStore (mercurialFileStore "tmp/mercurialfs") Mercurial+ removeDirectoryRecursive "tmp"+ let counts = Counts{ cases = cases gc + cases dc + cases mc,+ tried = tried gc + tried dc + tried mc,+ failures = failures gc + failures dc + failures mc,+ errors = errors gc + errors dc + errors mc }+ let errorCode = failures counts + errors counts+ putStrLn $ "Total " ++ showCounts counts+ exitWith $ if errorCode == 0+ then ExitSuccess+ else ExitFailure errorCode++testFileStore :: FileStore -> FileStoreType -> IO Counts+testFileStore fs fsName = do+ runTestTT $ TestList $ map (\(label, testFn) ->+ TestLabel (show fsName ++ " (" ++ label ++ ")") $ testFn fs)+ [ ("pre initialize", preInitializeTest)+ , ("initialize", initializeTest)+ , ("create resource", createTest1)+ , ("create resource in subdirectory", createTest2)+ , ("create resource with non-ascii name", createTest3)+ , ("create resource with non-ascii subdirectory", createTest3a)+ , ("try to create resource outside repo", createTest4)+ , ("try to create resource in special directory", createTest5 fsName)+ , ("directory", directoryTest)+ , ("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 fsName)+ , ("retrieve deleted file", retrieveTest5)+ , ("rename resource", renameTest)+ , ("test for matching IDs", matchTest)+ , ("history and revision", historyTest)+ , ("diff", diffTest)+ , ("search", searchTest)+ ]++testAuthor :: Author+testAuthor = Author "Test Suite" "suite@test.org"++testContents :: String+testContents = "Test contents.\nSecond line.\nThird test line with some Greek αβ."++testTitle :: String+testTitle = "New resource.txt"++subdirTestTitle :: String+subdirTestTitle = "subdir/Subdir title.txt"++nonasciiTestTitle :: String+nonasciiTestTitle = "αβγ"++subdirNonasciiTestTitle :: String+subdirNonasciiTestTitle = "Fooé/bar"++-- 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):++initializeTest fs = TestCase $ do+ initialize fs+ ind <- index fs+ assertEqual "index of just-initialized repository" ind []+ catch (initialize fs >> assertFailure "did not return error for existing repository") $+ \e -> assertEqual "error status from existing repository" e RepositoryExists++-- Create a resource, and check to see that latest returns a revision ID for it:++createTest1 fs = TestCase $ do+ create fs testTitle testAuthor "description of change" testContents+ revid <- latest fs testTitle+ assertBool "revision returns a revision after create" (not (null revid))++-- Create a resource in a subdirectory, and check to see that revision returns a revision for it:++createTest2 fs = TestCase $ do+ create fs subdirTestTitle testAuthor "description of change" testContents+ revid <- latest fs testTitle+ assertBool "revision returns a revision after create" (not (null revid))+ create fs (subdirTestTitle ++ "2") testAuthor "+Second file" testContents++-- Create a resource with a non-ascii title, and check to see that revision returns a revision for it:++createTest3 fs = TestCase $ do+ create fs nonasciiTestTitle testAuthor "description of change" testContents+ revid <- latest fs nonasciiTestTitle+ assertBool "revision returns a revision after create" (not (null revid))+ allfiles <- index fs+ assertBool "index contains file with nonascii name" (nonasciiTestTitle `elem` allfiles)++createTest3a fs = TestCase $ do+ create fs subdirNonasciiTestTitle testAuthor "description of change" testContents+ revid <- latest fs subdirNonasciiTestTitle+ assertBool "revision returns a revision after create" (not (null revid))+ allfiles <- index fs+ assertBool "index contains file with nonascii subdir" (subdirNonasciiTestTitle `elem` allfiles)++-- Try to create a resource outside the repository (should fail with an error and NOT write the file):++createTest4 fs = TestCase $ do+ catch (create fs "../oops" testAuthor "description of change" testContents >>+ assertFailure "did not return error from create ../oops") $+ \e -> assertEqual "error from create ../oops" IllegalResourceName e+ exists <- doesFileExist "tmp/oops"+ assertBool "file ../oops was created outside repository" (not exists)++-- Try to create a resource in special directory (should fail with an error and NOT write the file):++createTest5 fsName fs = TestCase $ do+ let (realpath, special) = case fsName of+ Git -> ("tmp" </> "gitfs" </> ".git" </> "newfile", ".git/newfile")+ Darcs -> ("tmp" </> "darcsfs" </> "_darcs" </> "newfile", "_darcs/newfile")+ Mercurial -> ("tmp" </> "mercurialfs" </> ".hg" </> "newfile", ".hg/newfile")+ catch (create fs special testAuthor "description of change" testContents >>+ (assertFailure $ "did not return error from create " ++ special)) $+ \e -> assertEqual ("error from create " ++ special) IllegalResourceName e+ exists <- doesFileExist realpath+ assertBool ("file " ++ realpath ++ " was created outside repository") (not exists)++-- Test directory++directoryTest fs = TestCase $ do+ -- Get directory for top-level+ files <- directory fs ""+ assertEqual "result of directory on top-level" (sort [FSDirectory (takeDirectory subdirTestTitle), FSFile testTitle, FSFile nonasciiTestTitle, FSDirectory (takeDirectory subdirNonasciiTestTitle)]) (sort files)++ -- Get contents of subdirectory+ 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 $+ retrieve fs testTitle Nothing >>=+ assertEqual "contents returned by retrieve" testContents++-- Retrieve latest version of a resource (in a subdirectory):++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 $+ retrieve fs nonasciiTestTitle Nothing >>=+ assertEqual "contents returned by retrieve" testContents++-- Retrieve a directory (should fail):++retrieveTest4 fs = TestCase $+ 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++ -- Modify a resource. Should return Right ().++ revid <- latest fs testTitle+ let modifiedContents = unlines $ take 2 $ lines testContents+ modResult <- modify fs testTitle revid testAuthor "removed third line" modifiedContents+ assertEqual "results of modify" (Right ()) modResult++ -- Now retrieve the contents and make sure they were changed.++ modifiedContents' <- retrieve fs testTitle Nothing+ newRevId <- latest fs testTitle+ newRev <- revision fs newRevId+ assertEqual "retrieved contents after modify" modifiedContents' modifiedContents++ -- Now try to modify again, using the old revision as base. This should+ -- result in a merge with conflicts.++ modResult2 <- modify fs testTitle revid testAuthor "modified from old version" (testContents ++ "\nFourth line")+ let normModResult2 = Left MergeInfo {mergeRevision = newRev, mergeConflicts = True, mergeText =+ "Test contents.\nSecond line.\n<<<<<<< edited\nThird test line with some Greek \945\946.\nFourth line\n=======\n>>>>>>> " +++ newRevId ++ "\n"}+ assertEqual "results of modify from old version" normModResult2 modResult2++ -- Now try it again, still using the old version as base, but with contents+ -- of the new version. This should result in a merge without conflicts.++ modResult3 <- modify fs testTitle revid testAuthor "modified from old version" modifiedContents+ let normModResult3 = Left MergeInfo {mergeRevision = newRev, mergeConflicts = False, mergeText = modifiedContents}+ assertEqual "results of modify from old version with new version's contents" normModResult3 modResult3++ -- Now try modifying again, this time using the new version as base. Should+ -- succeed with Right ().++ modResult4 <- modify fs testTitle newRevId testAuthor "modified from new version" (modifiedContents ++ "\nThird line")+ assertEqual "results of modify from new version" (Right ()) modResult4++-- Delete a resource:++deleteTest fsName fs = TestCase $ do++ -- Create a file and verify that it's there.++ let toBeDeleted = "Aaack!"+ create fs toBeDeleted testAuthor "description of change" testContents+ ind <- index fs+ assertBool "index contains resource to be deleted" (toBeDeleted `elem` ind)++ -- Now delete it and verify that it's gone.++ delete fs toBeDeleted testAuthor "goodbye"+ ind <- index fs+ assertBool "index does not contain resource that was deleted" (toBeDeleted `notElem` ind)++ -- Now make sure you can create and delete it again.++ create fs toBeDeleted testAuthor "description of change" testContents+ ind <- index fs+ assertBool "index contains re-created resource" (toBeDeleted `elem` ind)+ delete fs toBeDeleted testAuthor "goodbye"+ ind <- index fs+ assertBool "index does not contain resource that was deleted" (toBeDeleted `notElem` ind)++ -- Try to delete a file somewhere we shouldn't be able to delete++ let (realpath, special) = case fsName of+ Git -> ("tmp" </> "gitfs" </> ".git" </> "newfile", ".git/newfile")+ Darcs -> ("tmp" </> "darcsfs" </> "_darcs" </> "newfile", "_darcs/newfile")+ Mercurial -> ("tmp" </> "mercurialfs" </> ".hg" </> "newfile", ".hg/newfile")+ catch (delete fs special testAuthor "description of change" >>+ (assertFailure $ "did not return error from delete " ++ special)) $+ \e -> assertEqual ("error from delete " ++ special) IllegalResourceName e++-- Retrieve earlier version of deleted file:++retrieveTest5 fs = TestCase $ do+ hist <- history fs ["Aaack!"] (TimeRange Nothing Nothing) Nothing+ assertBool "history is nonempty" (not (null hist))+ let deletedId = revId $ last hist+ contents <- retrieve fs "Aaack!" (Just deletedId) :: IO String+ assertEqual "contents returned by retrieve" testContents contents++-- Rename a resource:++renameTest fs = TestCase $ do++ -- Create a file and verify that it's there.++ let oldName = "Old Name"+ let newName = "newdir/New Name.txt"+ create fs oldName testAuthor "description of change" testContents+ ind <- index fs+ assertBool "index contains old name" (oldName `elem` ind)+ assertBool "index does not contain new name" (newName `notElem` ind)++ -- Now rename it and verify that it changed names.++ rename fs oldName newName testAuthor "rename"+ ind <- index fs+ assertBool "index does not contain old name" (oldName `notElem` ind)+ assertBool "index contains new name" (newName `elem` ind)++ -- Try renaming a file that doesn't exist.++ catch (rename fs "nonexistent file" "other name" testAuthor "rename" >>+ assertFailure "rename of nonexistent file did not throw error") $+ \e -> assertEqual "error status from rename of nonexistent file" NotFound e++ -- Try to rename a file to a location we shouldn't be able to write in.++ let badName = "../eek"+ let cmd = "rename " ++ newName ++ " " ++ badName+ catch (rename fs newName badName testAuthor "description of change" >>+ (assertFailure $ "did not return error from " ++ cmd)) $+ \e -> assertEqual ("error from " ++ cmd) IllegalResourceName e+++-- Test history and revision++historyTest fs = TestCase $ do+ let testDescription = "history test message"+ save fs testTitle testAuthor testDescription testContents++ -- Get history for three files++ hist <- history fs [testTitle, subdirTestTitle, nonasciiTestTitle] (TimeRange Nothing Nothing) Nothing+ assertBool "history is nonempty" (not (null hist))+ now <- getCurrentTime+ rev <- latest fs testTitle >>= revision fs -- get latest revision+ assertBool "history contains latest revision" (rev `elem` hist)+ assertEqual "revAuthor" testAuthor (revAuthor rev)+ assertBool "revId non-null" (not (null (revId rev)))+ assertEqual "revDescription" testDescription (revDescription rev)+ assertEqual "revChanges" [Modified testTitle] (revChanges rev)+ let revtime = revDateTime rev+ histNow <- history fs [testTitle] (TimeRange (Just $ addUTCTime (60 * 60 * 24) now) Nothing) Nothing+ assertBool "history from now + 1 day onwards is empty" (null histNow)+ histOne <- history fs [testTitle] (TimeRange Nothing Nothing) (Just 1)+ assertBool "history with limit = 1 contains one item" (length histOne == 1)++-- Test diff++diffTest fs = TestCase $ do++ -- Create a file and modiy it.++ let diffTitle = "difftest.txt"+ create fs diffTitle testAuthor "description of change" testContents+ save fs diffTitle testAuthor "removed a line" (unlines . init . lines $ testContents)++ [secondrev, firstrev] <- history fs [diffTitle] (TimeRange Nothing Nothing) Nothing+ diff' <- diff fs diffTitle (Just $ revId firstrev) (Just $ revId secondrev)+ let subtracted' = [s | First s <- 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'' = concat [x | Second x <- diff'']+ assertEqual "added lines from empty document to first revision" (lines testContents) added''++ -- Diff to Nothing should be diff to latest.++ diff''' <- diff fs diffTitle (Just $ revId firstrev) Nothing+ assertEqual "diff from first revision to latest" diff' diff'''++-- Test search++searchTest fs = TestCase $ do++ -- Search for "bing"++ create fs "foo" testAuthor "my 1st search test doc" "bing\nbong\nbang\nφ"+ create fs "bar" testAuthor "my 2nd search test doc" "bing BONG"+ create fs "baz" testAuthor "my 3nd search test doc" "bingbang\nbong"++ -- Search for "bing" with whole-word matches.++ res1 <- search fs SearchQuery{queryPatterns = ["bing"], queryWholeWords = True, queryMatchAll = True, queryIgnoreCase = True}+ assertEqual "search results 1" [SearchMatch "bar" 1 "bing BONG", SearchMatch "foo" 1 "bing"] res1++ -- Search for regex "BONG" case-sensitive.++ res2 <- search fs SearchQuery{queryPatterns = ["BONG"], queryWholeWords = True, queryMatchAll = True, queryIgnoreCase = False}+ assertEqual "search results 2" [SearchMatch "bar" 1 "bing BONG"] res2++ -- Search for "bong" and "φ"++ res3 <- search fs SearchQuery{queryPatterns = ["bong", "φ"], queryWholeWords = True, queryMatchAll = True, queryIgnoreCase = True}+ assertEqual "search results 3" [SearchMatch "foo" 2 "bong", SearchMatch "foo" 4 "φ"] res3++ -- Search for "bong" and "φ" but without match-all set++ res4 <- search fs SearchQuery{queryPatterns = ["bong", "φ"], queryWholeWords = True, queryMatchAll = False, queryIgnoreCase = True}+ assertEqual "search results 4" [SearchMatch "bar" 1 "bing BONG", SearchMatch "baz" 2 "bong", SearchMatch "foo" 2 "bong", SearchMatch "foo" 4 "φ"] res4++ -- Search for "bing" but without whole-words set++ res5 <- search fs SearchQuery{queryPatterns = ["bing"], queryWholeWords = False, queryMatchAll = True, queryIgnoreCase = True}+ assertEqual "search results 5" [SearchMatch "bar" 1 "bing BONG", SearchMatch "baz" 1 "bingbang", SearchMatch "foo" 1 "bing"] res5++-- Test IDs match++matchTest fs = TestCase $ do++ assertBool "match with two identical IDs" (idsMatch fs "abcde" "abcde")+ assertBool "match with nonidentical but matching IDs" (idsMatch fs "abcde" "abcde5553")+ assertBool "non-match" (not (idsMatch fs "abcde" "abedc"))
− tests/Tests.lhs
@@ -1,397 +0,0 @@-#!/usr/bin/env runghc--This program runs tests for the filestore modules.--> import Data.FileStore-> import Data.List (sort, isInfixOf)-> import Test.HUnit-> import System.Directory (doesFileExist, removeDirectoryRecursive)-> import Control.Monad (forM)-> import Prelude hiding (catch)-> import Control.Exception (catch)-> import Data.Time-> import Data.Maybe (mapMaybe)-> import System.FilePath-> import Data.Algorithm.Diff (Diff(..))--> main = do-> testFileStore (gitFileStore "tmp/gitfs") "Data.FileStore.Git"-> testFileStore (darcsFileStore "tmp/darcsfs") "Data.FileStore.Darcs"-> testFileStore (mercurialFileStore "tmp/mercurialfs") "Data.FileStore.Mercurial"-> 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) -> [ ("pre initialize", preInitializeTest)-> , ("initialize", initializeTest)-> , ("create resource", createTest1)-> , ("create resource in subdirectory", createTest2)-> , ("create resource with non-ascii name", createTest3)-> , ("create resource with non-ascii subdirectory", createTest3a)-> , ("try to create resource outside repo", createTest4)-> , ("try to create resource in special directory", createTest5 fsName)-> , ("directory", directoryTest)-> , ("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 fsName)-> , ("retrieve deleted file", retrieveTest5)-> , ("rename resource", renameTest)-> , ("test for matching IDs", matchTest)-> , ("history and revision", historyTest)-> , ("diff", diffTest)-> , ("search", searchTest)-> ]--> testAuthor :: Author-> testAuthor = Author "Test Suite" "suite@test.org"--> testContents :: String-> testContents = "Test contents.\nSecond line.\nThird test line with some Greek αβ."--> testTitle :: String-> testTitle = "New resource.txt"--> subdirTestTitle :: String-> subdirTestTitle = "subdir/Subdir title.txt"--> nonasciiTestTitle :: String-> nonasciiTestTitle = "αβγ"--> subdirNonasciiTestTitle :: String-> subdirNonasciiTestTitle = "Fooé/bar"--*** 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):--> initializeTest fs = TestCase $ do-> initialize fs-> ind <- index fs-> assertEqual "index of just-initialized repository" ind []-> catch (initialize fs >> assertFailure "did not return error for existing repository") $-> \e -> assertEqual "error status from existing repository" e RepositoryExists--*** Create a resource, and check to see that latest returns a revision ID for it:--> createTest1 fs = TestCase $ do-> create fs testTitle testAuthor "description of change" testContents-> revid <- latest fs testTitle-> assertBool "revision returns a revision after create" (not (null revid))--*** Create a resource in a subdirectory, and check to see that revision returns a revision for it:--> createTest2 fs = TestCase $ do-> create fs subdirTestTitle testAuthor "description of change" testContents-> revid <- latest fs testTitle-> assertBool "revision returns a revision after create" (not (null revid))-> create fs (subdirTestTitle ++ "2") testAuthor "+Second file" testContents--*** Create a resource with a non-ascii title, and check to see that revision returns a revision for it:--> createTest3 fs = TestCase $ do-> create fs nonasciiTestTitle testAuthor "description of change" testContents-> revid <- latest fs nonasciiTestTitle-> assertBool "revision returns a revision after create" (not (null revid))-> allfiles <- index fs-> assertBool "index contains file with nonascii name" (nonasciiTestTitle `elem` allfiles)--> createTest3a fs = TestCase $ do-> create fs subdirNonasciiTestTitle testAuthor "description of change" testContents-> revid <- latest fs subdirNonasciiTestTitle-> assertBool "revision returns a revision after create" (not (null revid))-> allfiles <- index fs-> assertBool "index contains file with nonascii subdir" (subdirNonasciiTestTitle `elem` allfiles)--*** Try to create a resource outside the repository (should fail with an error and NOT write the file):--> createTest4 fs = TestCase $ do-> catch (create fs "../oops" testAuthor "description of change" testContents >>-> assertFailure "did not return error from create ../oops") $-> \e -> assertEqual "error from create ../oops" IllegalResourceName e -> exists <- doesFileExist "tmp/oops"-> assertBool "file ../oops was created outside repository" (not exists)--*** Try to create a resource in special directory (should fail with an error and NOT write the file):--> createTest5 fsName fs = TestCase $ do-> let (realpath, special) = case fsName of-> "Data.FileStore.Git" -> ("tmp" </> "gitfs" </> ".git" </> "newfile", ".git/newfile")-> "Data.FileStore.Darcs" -> ("tmp" </> "darcsfs" </> "_darcs" </> "newfile", "_darcs/newfile")-> "Data.FileStore.Mercurial" -> ("tmp" </> "mercurialfs" </> ".hg" </> "newfile", ".hg/newfile")-> _ -> error "Unknown filestore type! Add a test case."-> catch (create fs special testAuthor "description of change" testContents >>-> (assertFailure $ "did not return error from create " ++ special)) $-> \e -> assertEqual ("error from create " ++ special) IllegalResourceName e -> exists <- doesFileExist realpath-> assertBool ("file " ++ realpath ++ " was created outside repository") (not exists)--*** Test directory--> directoryTest fs = TestCase $ do-- Get directory for top-level--> files <- directory fs ""-> assertEqual "result of directory on top-level" (sort [FSDirectory (takeDirectory subdirTestTitle), FSFile testTitle, FSFile nonasciiTestTitle, FSDirectory (takeDirectory subdirNonasciiTestTitle)]) (sort files)-- Get contents of subdirectory--> 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 $-> retrieve fs testTitle Nothing >>=-> assertEqual "contents returned by retrieve" testContents--*** Retrieve latest version of a resource (in a subdirectory):--> 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 $-> retrieve fs nonasciiTestTitle Nothing >>=-> assertEqual "contents returned by retrieve" testContents--*** Retrieve a directory (should fail):--> retrieveTest4 fs = TestCase $-> 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-- Modify a resource. Should return Right ().--> revid <- latest fs testTitle-> let modifiedContents = unlines $ take 2 $ lines testContents-> modResult <- modify fs testTitle revid testAuthor "removed third line" modifiedContents-> assertEqual "results of modify" (Right ()) modResult-- Now retrieve the contents and make sure they were changed.--> modifiedContents' <- retrieve fs testTitle Nothing-> newRevId <- latest fs testTitle-> newRev <- revision fs newRevId-> assertEqual "retrieved contents after modify" modifiedContents' modifiedContents-- Now try to modify again, using the old revision as base. This should result in a merge with conflicts.--> modResult2 <- modify fs testTitle revid testAuthor "modified from old version" (testContents ++ "\nFourth line")-> let normModResult2 = Left MergeInfo {mergeRevision = newRev, mergeConflicts = True, mergeText =-> "Test contents.\nSecond line.\n<<<<<<< edited\nThird test line with some Greek \945\946.\nFourth line\n=======\n>>>>>>> " ++-> newRevId ++ "\n"}-> assertEqual "results of modify from old version" normModResult2 modResult2-- Now try it again, still using the old version as base, but with contents of the new version.- This should result in a merge without conflicts.--> modResult3 <- modify fs testTitle revid testAuthor "modified from old version" modifiedContents-> let normModResult3 = Left MergeInfo {mergeRevision = newRev, mergeConflicts = False, mergeText = modifiedContents}-> assertEqual "results of modify from old version with new version's contents" normModResult3 modResult3-- Now try modifying again, this time using the new version as base. Should succeed with Right ().--> modResult4 <- modify fs testTitle newRevId testAuthor "modified from new version" (modifiedContents ++ "\nThird line")-> assertEqual "results of modify from new version" (Right ()) modResult4 --*** Delete a resource:--> deleteTest fsName fs = TestCase $ do-- Create a file and verify that it's there.--> let toBeDeleted = "Aaack!"-> create fs toBeDeleted testAuthor "description of change" testContents-> ind <- index fs-> assertBool "index contains resource to be deleted" (toBeDeleted `elem` ind) -- Now delete it and verify that it's gone.--> delete fs toBeDeleted testAuthor "goodbye"-> ind <- index fs-> assertBool "index does not contain resource that was deleted" (toBeDeleted `notElem` ind)-- Now make sure you can create and delete it again.--> create fs toBeDeleted testAuthor "description of change" testContents-> ind <- index fs-> assertBool "index contains re-created resource" (toBeDeleted `elem` ind) -> delete fs toBeDeleted testAuthor "goodbye"-> ind <- index fs-> assertBool "index does not contain resource that was deleted" (toBeDeleted `notElem` ind)-- Try to delete a file somewhere we shouldn't be able to delete--> let (realpath, special) = case fsName of-> "Data.FileStore.Git" -> ("tmp" </> "gitfs" </> ".git" </> "newfile", ".git/newfile")-> "Data.FileStore.Darcs" -> ("tmp" </> "darcsfs" </> "_darcs" </> "newfile", "_darcs/newfile")-> "Data.FileStore.Mercurial" -> ("tmp" </> "mercurialfs" </> ".hg" </> "newfile", ".hg/newfile")-> _ -> error "Unknown filestore type! Add a test case."-> catch (delete fs special testAuthor "description of change" >>-> (assertFailure $ "did not return error from delete " ++ special)) $-> \e -> assertEqual ("error from delete " ++ special) IllegalResourceName e --*** Retrieve earlier version of deleted file:--> retrieveTest5 fs = TestCase $ do-> hist <- history fs ["Aaack!"] (TimeRange Nothing Nothing) Nothing-> assertBool "history is nonempty" (not (null hist))-> let deletedId = revId $ last hist-> contents <- retrieve fs "Aaack!" (Just deletedId) :: IO String-> assertEqual "contents returned by retrieve" testContents contents--*** Rename a resource:--> renameTest fs = TestCase $ do-- Create a file and verify that it's there.--> let oldName = "Old Name"-> let newName = "newdir/New Name.txt"-> create fs oldName testAuthor "description of change" testContents-> ind <- index fs-> assertBool "index contains old name" (oldName `elem` ind) -> assertBool "index does not contain new name" (newName `notElem` ind)-- Now rename it and verify that it changed names.--> rename fs oldName newName testAuthor "rename"-> ind <- index fs-> assertBool "index does not contain old name" (oldName `notElem` ind) -> assertBool "index contains new name" (newName `elem` ind)-- Try renaming a file that doesn't exist.--> catch (rename fs "nonexistent file" "other name" testAuthor "rename" >>-> assertFailure "rename of nonexistent file did not throw error") $-> \e -> assertEqual "error status from rename of nonexistent file" NotFound e-- Try to rename a file to a location we shouldn't be able to write in.--> let badName = "../eek"-> let cmd = "rename " ++ newName ++ " " ++ badName-> catch (rename fs newName badName testAuthor "description of change" >>-> (assertFailure $ "did not return error from " ++ cmd)) $-> \e -> assertEqual ("error from " ++ cmd) IllegalResourceName e ---*** Test history and revision--> historyTest fs = TestCase $ do-> let testDescription = "history test message"-> save fs testTitle testAuthor testDescription testContents-- Get history for three files--> hist <- history fs [testTitle, subdirTestTitle, nonasciiTestTitle] (TimeRange Nothing Nothing) Nothing-> assertBool "history is nonempty" (not (null hist))-> now <- getCurrentTime-> rev <- latest fs testTitle >>= revision fs -- get latest revision-> assertBool "history contains latest revision" (rev `elem` hist)-> assertEqual "revAuthor" testAuthor (revAuthor rev)-> assertBool "revId non-null" (not (null (revId rev)))-> assertEqual "revDescription" testDescription (revDescription rev)-> assertEqual "revChanges" [Modified testTitle] (revChanges rev)-> let revtime = revDateTime rev-> histNow <- history fs [testTitle] (TimeRange (Just $ addUTCTime (60 * 60 * 24) now) Nothing) Nothing-> assertBool "history from now + 1 day onwards is empty" (null histNow)-> histOne <- history fs [testTitle] (TimeRange Nothing Nothing) (Just 1)-> assertBool "history with limit = 1 contains one item" (length histOne == 1)--*** Test diff--> diffTest fs = TestCase $ do-- Create a file and modiy it.--> let diffTitle = "difftest.txt"-> create fs diffTitle testAuthor "description of change" testContents-> save fs diffTitle testAuthor "removed a line" (unlines . init . lines $ testContents)--> [secondrev, firstrev] <- history fs [diffTitle] (TimeRange Nothing Nothing) Nothing-> diff' <- diff fs diffTitle (Just $ revId firstrev) (Just $ revId secondrev)-> let subtracted' = [s | First s <- 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'' = concat [x | Second x <- diff'']-> assertEqual "added lines from empty document to first revision" (lines testContents) added''-- Diff to Nothing should be diff to latest.--> diff''' <- diff fs diffTitle (Just $ revId firstrev) Nothing-> assertEqual "diff from first revision to latest" diff' diff'''--*** Test search--> searchTest fs = TestCase $ do-- Search for "bing"--> create fs "foo" testAuthor "my 1st search test doc" "bing\nbong\nbang\nφ"-> create fs "bar" testAuthor "my 2nd search test doc" "bing BONG" -> create fs "baz" testAuthor "my 3nd search test doc" "bingbang\nbong"-- Search for "bing" with whole-word matches.--> res1 <- search fs SearchQuery{queryPatterns = ["bing"], queryWholeWords = True, queryMatchAll = True, queryIgnoreCase = True}-> assertEqual "search results 1" [SearchMatch "bar" 1 "bing BONG", SearchMatch "foo" 1 "bing"] res1-- Search for regex "BONG" case-sensitive.--> res2 <- search fs SearchQuery{queryPatterns = ["BONG"], queryWholeWords = True, queryMatchAll = True, queryIgnoreCase = False}-> assertEqual "search results 2" [SearchMatch "bar" 1 "bing BONG"] res2-- Search for "bong" and "φ"--> res3 <- search fs SearchQuery{queryPatterns = ["bong", "φ"], queryWholeWords = True, queryMatchAll = True, queryIgnoreCase = True}-> assertEqual "search results 3" [SearchMatch "foo" 2 "bong", SearchMatch "foo" 4 "φ"] res3-- Search for "bong" and "φ" but without match-all set--> res4 <- search fs SearchQuery{queryPatterns = ["bong", "φ"], queryWholeWords = True, queryMatchAll = False, queryIgnoreCase = True}-> assertEqual "search results 4" [SearchMatch "bar" 1 "bing BONG", SearchMatch "baz" 2 "bong", SearchMatch "foo" 2 "bong", SearchMatch "foo" 4 "φ"] res4-- Search for "bing" but without whole-words set--> res5 <- search fs SearchQuery{queryPatterns = ["bing"], queryWholeWords = False, queryMatchAll = True, queryIgnoreCase = True}-> assertEqual "search results 5" [SearchMatch "bar" 1 "bing BONG", SearchMatch "baz" 1 "bingbang", SearchMatch "foo" 1 "bing"] res5--*** Test IDs match--> matchTest fs = TestCase $ do--> assertBool "match with two identical IDs" (idsMatch fs "abcde" "abcde")-> assertBool "match with nonidentical but matching IDs" (idsMatch fs "abcde" "abcde5553")-> assertBool "non-match" (not (idsMatch fs "abcde" "abedc"))-