filestore 0.3 → 0.3.1

raw patch · 8 files changed

+239/−189 lines, 8 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Data/FileStore/Darcs.hs +34/−139
• Data/FileStore/DarcsXml.hs +72/−0
• Data/FileStore/Generic.hs +3/−5
• Data/FileStore/Git.hs +5/−9
• Data/FileStore/Types.hs +23/−19
• Data/FileStore/Utils.hs +83/−8
• Tests.lhs +6/−6
• filestore.cabal +13/−3

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {- |    Module      : Data.FileStore.Darcs    Copyright   : Copyright (C) 2009 Gwern Branwen@@ -9,29 +10,25 @@     A versioned filestore implemented using darcs.    Normally this module should not be imported: import-   "Data.FileStore" instead.--}+   "Data.FileStore" instead. -}  module Data.FileStore.Darcs ( darcsFileStore ) where -import Codec.Binary.UTF8.String (encodeString) import Control.Exception (throwIO)-import Control.Monad (liftM, unless, when)-import Data.ByteString.Lazy.UTF8 (toString)-import Data.Char (isSpace)-import Data.DateTime (parseDateTime, toSqlString)-import Data.FileStore.Types-import Data.FileStore.Utils (hashsMatch, isInsideRepo, parseMatchLine, runShellCommand, escapeRegexSpecialChars)-import Data.List (intersect, nub, sort, isPrefixOf)-import Data.Maybe (fromMaybe, fromJust)-import Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import System.Directory (doesFileExist, doesDirectoryExist, createDirectoryIfMissing)+import Control.Monad (unless, when)+import Data.DateTime (toSqlString)+import Data.List (sort, isPrefixOf)+import System.Directory (doesDirectoryExist, createDirectoryIfMissing) import System.Exit (ExitCode(ExitSuccess)) import System.FilePath ((</>), takeDirectory, dropFileName, addTrailingPathSeparator)-import Text.Regex.Posix ((=~))-import Text.XML.Light-import qualified Data.ByteString.Lazy as B (ByteString, writeFile) +import Data.FileStore.DarcsXml (parseDarcsXML)+import Data.FileStore.Types+import Data.FileStore.Utils (checkAndWriteFile, hashsMatch, isInsideRepo, runShellCommand, ensureFileExists, grepSearchRepo)++import Data.ByteString.Lazy.UTF8 (toString)+import qualified Data.ByteString.Lazy as B (ByteString)+ -- | Return a filestore implemented using the Darcs distributed revision control system -- (<http://darcs.net/>). darcsFileStore :: FilePath -> FileStore@@ -56,94 +53,6 @@   (status, err, out) <- runShellCommand repo Nothing "darcs" (command : args)   return (status, toString err, out) -parseDarcsXML :: String -> Maybe [Revision]-parseDarcsXML str = do changelog <- parseXMLDoc str-                       let patches = filterChildrenName (\(QName n _ _) -> n == "patch") changelog-                       return $ map parseIntoRevision patches--parseIntoRevision :: Element -> Revision-parseIntoRevision a = Revision { revId = hashXML a,-                                 revDateTime = date a,-                                 revAuthor = Author { authorName=authorXML a, authorEmail=emailXML a },-                                 revDescription = descriptionXML a,-                                 revChanges = changesXML a }-    where-        -- If we can't get a date from the XML, we default to the beginning of the POSIX era.-        -- This at least makes it easy for someone to filter out bad dates, as obviously no real DVCSs-        -- were in operation then. :)-        -- date :: Element -> UTCTime-        date = fromMaybe (posixSecondsToUTCTime $ realToFrac (0::Int)) . parseDateTime "%c" . dateXML--authorXML, dateXML, descriptionXML, emailXML, hashXML :: Element -> String-authorXML = snd . splitEmailAuthor . fromMaybe "" . findAttr (QName "author" Nothing Nothing)-emailXML =  fromMaybe"" . fst . splitEmailAuthor . fromMaybe "" . findAttr (QName "author" Nothing Nothing)-dateXML   = fromMaybe "" . findAttr (QName "local_date" Nothing Nothing)-hashXML   = fromMaybe "" . findAttr (QName "hash" Nothing Nothing)-descriptionXML = fromMaybe "" . liftM strContent . findChild (QName "name" Nothing Nothing)--changesXML :: Element -> [Change]-changesXML = analyze . filterSummary . changes---- | Our policy is: if the input is clearly a "name \<e\@mail.com\>" input, then we return "(Just Address, Name)"---   If there is no '<' in the input, then it clearly can't be of that format, and so we just return "(Nothing, Name)"------ > splitEmailAuthor "foo bar baz@gmail.com" ~> (Nothing,"foo bar baz@gmail.com")--- > splitEmailAuthor "foo bar <baz@gmail.com>" ~> (Just "baz@gmail.com","foo bar")-splitEmailAuthor :: String -> (Maybe String, String)-splitEmailAuthor x = if '<' `elem` x then (Just (tail $ init c), reverse . dropWhile isSpace $ reverse b)-                                     else (Nothing,x)-    -- Will still need to trim the '<>' brackets in the email, and whitespace at the end of name-    where (_,b,c) = x =~ "[^<]*" :: (String,String,String)--changes :: Element -> Element-changes = fromJust . findElement (QName  "summary" Nothing Nothing)--analyze :: [Element] -> [Change]-analyze s = map convert s-  where convert a-           | x == "add_directory" || x == "add_file" = Added b-           | x == "remove_file" || x == "remove_directory" = Deleted b-           | x == "added_lines"-              || x == "modify_file"-              || x == "removed_lines"-              || x == "replaced_tokens" = Modified b-           | otherwise = error "Unknown change type"-             where  x = qName . elName $ a-                    b = takeWhile (/='\n') $ dropWhile isSpace $ strContent a--filterSummary :: Element -> [Element]-filterSummary = filterElementsName (\(QName {qName = x}) -> x == "add_file"-                                || x == "add_directory"-                                || x == "remove_file"-                                || x == "remove_directory"-                                || x == "modify_file"-                                || x == "added_lines"-                                || x == "removed_lines"-                                || x == "replaced_tokens")---- Following are for 'darcsSearch'---- | Search multiple files with a single regexp-go :: FilePath -> [String] -> String -> IO [String]-go repo filesToCheck pattern = do (_, _, result) <- runShellCommand repo-                                               Nothing  "grep" $ ["--line-number", "-l", "-E", "-e", pattern] ++ filesToCheck-                                  let results = intersect filesToCheck $ lines $ toString result-                                  return results---- | Search a single file with multiple regexps-go' :: [String] -> FilePath -> [String] -> String -> IO [String]-go' os repo patterns file = do res <- mapM (\x -> run file x) patterns-                               return $ nub $ concat res-      where run f p = do (_,_,r) <- runShellCommand repo Nothing "grep" $-                                        os ++ [p, f]-                         return $ lines $ toString r---- | If name doesn't exist in repo or is not a file, throw NotFound-ensureFileExists :: FilePath -> FilePath -> IO ()-ensureFileExists repo name = do-  isFile <- doesFileExist (repo </> encodeString name)-  when (not isFile) $ throwIO NotFound- --------------------------- -- End utility functions and types -- Begin repository creation & modification@@ -163,11 +72,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-  let filename = repo </> encodeString name-  inside <- isInsideRepo repo filename-  unless inside $ throwIO IllegalResourceName-  createDirectoryIfMissing True $ takeDirectory filename-  B.writeFile filename $ toByteString contents+  checkAndWriteFile repo name 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]@@ -234,17 +139,22 @@  -- | Get revision information for a particular revision ID, or latest revision. darcsGetRevision :: FilePath -> RevisionId -> IO Revision-darcsGetRevision repo hash = do hists <- darcsLog repo [] (TimeRange Nothing Nothing)-                                let hist = filter (\x -> hashsMatch (revId x) hash) hists-                                let result =  if null hist then hists else hist-                                return $ head result+darcsGetRevision repo hash = do (_,_,output) <- runDarcsCommand repo "changes"+                                                ["--xml-output", "--summary", "--match=hash " ++ hash]+                                let hists = parseDarcsXML $ toString output+                                case hists of+                                    Nothing -> throwIO NotFound+                                    Just a  -> return $ head a  -- | Return revision ID for latest commit for a resource. darcsLatestRevId :: FilePath -> FilePath -> 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]+#ifdef USE_MAXCOUNT+  (_, _, output) <- runDarcsCommand repo "changes" ["--xml-output", "--max-count=1", name]+#else+  (_, _, output) <- runDarcsCommand repo "changes" ["--xml-output", name]+#endif   let patchs = parseDarcsXML $ toString output   case patchs of       Nothing -> throwIO NotFound@@ -256,11 +166,11 @@             -> FilePath             -> Maybe RevisionId    -- ^ @Just@ revision ID, or @Nothing@ for latest             -> IO a-darcsRetrieve repo name Nothing =-  darcsLatestRevId repo name >>= darcsRetrieve repo name . Just-darcsRetrieve repo name (Just revid) = do+darcsRetrieve repo name mbId = do   ensureFileExists repo name-  let opts = ["contents", "--match=hash " ++ revid, name]+  let opts = case mbId of+              Nothing    -> ["contents", name]+              Just revid -> ["contents", "--match=hash " ++ revid, name]   (status, err, output) <- runDarcsCommand repo "query" opts   if status == ExitSuccess      then return $ fromByteString output@@ -282,32 +192,17 @@   (status2, _errOutput2, output2) <- runDarcsCommand repo "query" ["files","--no-files"]   if status1 == ExitSuccess && status2 == ExitSuccess      then do-       let files = map (drop $ length dir' + 2) . filter (("." </> dir') `isPrefixOf`) . lines . toString $ output1+       let files = adhocParsing dir' . lines . toString $ output1        -- We need to do 'drop $ length dir' + 3' because Darcs returns files like ["./foo/foobar"].-       let dirs  = map (drop $ length dir' + 2) . filter (("." </> dir') `isPrefixOf`) . drop 1 . lines . toString $ output2+       let dirs  = adhocParsing dir' . drop 1 . lines . toString $ output2        -- We need the drop 1 to eliminate the root directory, which appears first.        -- Now, select the ones that are in THIS directory and convert to Resources:        let files' = map FSFile  $ filter ('/' `notElem`) files        let dirs'  = map FSDirectory $ filter ('/' `notElem`) dirs        return $ sort (files' ++ dirs')       else return []  -- returns empty list for invalid path (see gitDirectory)+              where adhocParsing d = map (drop $ length d + 2) . filter (("." </> d) `isPrefixOf`) --- | Uses grep to search repository.+-- Use the generic grep-based search of a repo. darcsSearch :: FilePath -> SearchQuery -> IO [SearchMatch]-darcsSearch repo query = do-  let opts = ["--line-number", "--with-filename"] ++-             (if queryIgnoreCase query then ["-i"] else []) ++-             (if queryWholeWords query then ["--word-regexp"] else ["-E"])-  let regexps = map escapeRegexSpecialChars $ queryPatterns query-  files <- darcsIndex repo-  if queryMatchAll query then do-                                  filesMatchingAllPatterns <- liftM (foldr1 intersect) $ mapM (go repo files) regexps-                                  output <- mapM (go' opts repo regexps) filesMatchingAllPatterns-                                  return $ map parseMatchLine $ concat output-   else do (_status, _errOutput, output) <--                runShellCommand repo Nothing "grep" $ opts ++-                                                       concatMap (\term -> ["-e", term]) regexps ++-                                                       files-           let results = lines $ toString output-           return $ map parseMatchLine results-+darcsSearch = grepSearchRepo darcsIndex

@@ -0,0 +1,72 @@+module Data.FileStore.DarcsXml (parseDarcsXML) where++import Data.Maybe (catMaybes, fromMaybe)+import Data.Char (isSpace)+import Data.DateTime (parseDateTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Text.XML.Light++import Data.FileStore.Types (Change(..), Revision(..), Author(..))+import Data.FileStore.Utils (splitEmailAuthor)++-- | Take a String presumed to be a Darcs-generated changelog in XML format;+--   discard all tags, initializations, etc, leaving only actual patches;+--   then convert each patch entry into FileStore's homebrew 'Revision' type.+parseDarcsXML :: String -> Maybe [Revision]+parseDarcsXML str = do changelog <- parseXMLDoc str+                       let patches = filterChildrenName (\(QName n _ _) -> n == "patch") changelog+                       return $ map parseIntoRevision patches++parseIntoRevision :: Element -> Revision+parseIntoRevision a = Revision { revId = hashXML a,+                                 revDateTime = date a,+                                 revAuthor = Author { authorName=authorXML a, authorEmail=emailXML a },+                                 revDescription = descriptionXML a,+                                 revChanges = catMaybes $ changesXML a }+    where+        -- If we can't get a date from the XML, we default to the beginning of the POSIX era.+        -- This at least makes it easy for someone to filter out bad dates, as obviously no real DVCSs+        -- were in operation then. :)+        -- date :: Element -> UTCTime+        date = fromMaybe (posixSecondsToUTCTime $ realToFrac (0::Int)) . parseDateTime "%c" . dateXML++authorXML, dateXML, descriptionXML, emailXML, hashXML :: Element -> String+authorXML = snd . splitEmailAuthor . fromMaybe "" . findAttr (QName "author" Nothing Nothing)+emailXML  = fromMaybe "" . fst . splitEmailAuthor . fromMaybe "" . findAttr (QName "author" Nothing Nothing)+dateXML   = fromMaybe "" . findAttr (QName "local_date" Nothing Nothing)+hashXML   = fromMaybe "" . findAttr (QName "hash" Nothing Nothing)+descriptionXML = fromMaybe "" . fmap strContent . findChild (QName "name" Nothing Nothing)++-- Perhaps there was no '--summary' option used, in which case there is no 'Change' information we+-- can extract.+changesXML :: Element -> [Maybe Change]+changesXML a = case (changes a) of+                    Just b -> analyze $ filterSummary b+                    Nothing -> []++-- | Extract the file-modification fields+changes :: Element -> Maybe Element+changes = findElement (QName  "summary" Nothing Nothing)++analyze :: [Element] -> [Maybe Change]+analyze s = map convert s+  where convert a+           | x == "add_directory" || x == "add_file" = Just (Added b)+           | x == "remove_file" || x == "remove_directory" = Just (Deleted b)+           | x == "added_lines"+              || x == "modify_file"+              || x == "removed_lines"+              || x == "replaced_tokens" = Just (Modified b)+           | otherwise = Nothing+             where  x = qName . elName $ a+                    b = takeWhile (/='\n') $ dropWhile isSpace $ strContent a++filterSummary :: Element -> [Element]+filterSummary = filterElementsName (\(QName {qName = x}) -> x == "add_file"+                                || x == "add_directory"+                                || x == "remove_file"+                                || x == "remove_directory"+                                || x == "modify_file"+                                || x == "added_lines"+                                || x == "removed_lines"+                                || x == "replaced_tokens")

@@ -104,7 +104,7 @@   let matcher = if exact                 then (== desc)                 else (desc `isInfixOf`)-  revs <- (history repo) [name] (TimeRange Nothing Nothing)+  revs <- history repo [name] (TimeRange Nothing Nothing)   return $ Prelude.filter (matcher . revDescription) revs  -- | Try to retrieve a resource from the repository by name and possibly a@@ -141,10 +141,8 @@  -- | Like 'directory', but returns information about the latest revision. richDirectory :: FileStore -> FilePath -> IO [(Resource, Either String Revision)]-richDirectory fs fp = do-  rs <- directory fs fp-  mapM f rs-  where f r = Control.Exception.catch (g r) (\(e :: FileStoreError)-> return $ ( r, Left . show $ e ) )+richDirectory fs fp = directory fs fp >>= mapM f+  where f r = Control.Exception.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 repos")         g res@(FSFile file) = do rev <- revision fs =<< latest fs ( fp </> file )                                  return (res,Right rev)

@@ -20,7 +20,7 @@ import Data.Maybe (mapMaybe) import System.Exit import Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import Data.FileStore.Utils (hashsMatch, isInsideRepo, runShellCommand, escapeRegexSpecialChars) +import Data.FileStore.Utils (checkAndWriteFile, hashsMatch, isInsideRepo, runShellCommand, escapeRegexSpecialChars)  import Data.ByteString.Lazy.UTF8 (toString) import qualified Data.ByteString.Lazy as B import qualified Text.ParserCombinators.Parsec as P@@ -97,11 +97,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-  let filename = repo </> encodeString name-  inside <- isInsideRepo repo filename-  unless inside $ throwIO IllegalResourceName-  createDirectoryIfMissing True $ takeDirectory filename-  B.writeFile filename $ toByteString contents+  checkAndWriteFile repo name contents   (statusAdd, errAdd, _) <- runGitCommand repo "add" [name]   if statusAdd == ExitSuccess      then gitCommit repo [name] author logMsg@@ -255,10 +251,10 @@ parseGitLog :: P.Parser [Revision] parseGitLog = P.manyTill gitLogEntry P.eof -wholeLine :: P.GenParser Char st [Char]+wholeLine :: P.GenParser Char st String wholeLine = P.manyTill P.anyChar P.newline -nonblankLine :: P.GenParser Char st [Char]+nonblankLine :: P.GenParser Char st String nonblankLine = P.notFollowedBy P.newline >> wholeLine  gitLogEntry :: P.Parser Revision@@ -300,7 +296,7 @@     Left _    -> s     Right res -> res -pEncodedString :: P.GenParser Char st [Char]+pEncodedString :: P.GenParser Char st String pEncodedString = do   P.char '"'   res <- P.many1 (pOctalChar P.<|> P.anyChar)

@@ -86,17 +86,18 @@  data MergeInfo =   MergeInfo {-    mergeRevision  :: Revision   -- ^ The revision with which changes were merged+    mergeRevision  :: Revision   -- ^ The revision w/ which changes were merged   , mergeConflicts :: Bool       -- ^ @True@ if there were merge conflicts-  , mergeText      :: String     -- ^ The merged text, including conflict markers+  , mergeText      :: String     -- ^ The merged text, w/ conflict markers   } deriving (Show, Read, Eq, Typeable)  data FileStoreError =-    RepositoryExists             -- ^ Tried to initialize a repository that already exists-  | ResourceExists               -- ^ Tried to create a resource that already exists+    RepositoryExists             -- ^ Tried to initialize a repo that exists+  | ResourceExists               -- ^ Tried to create a resource that exists   | NotFound                     -- ^ Requested resource was not found   | IllegalResourceName          -- ^ The specified resource name is illegal-  | Unchanged                    -- ^ The resource was not modified, because the contents were unchanged+  | Unchanged                    -- ^ The resource was not modified,+                                 --   because the contents were unchanged   | UnsupportedOperation   | UnknownError String   deriving (Read, Eq, Typeable)@@ -116,7 +117,8 @@   SearchQuery {     queryPatterns    :: [String] -- ^ Patterns to match   , queryWholeWords  :: Bool     -- ^ Match patterns only with whole words?-  , queryMatchAll    :: Bool     -- ^ Return matches only from files in which all patterns match?+  , queryMatchAll    :: Bool     -- ^ Return matches only from files in which+                                 --   all patterns match?   , queryIgnoreCase  :: Bool     -- ^ Make matches case-insensitive?   } deriving (Show, Read, Eq, Typeable) @@ -149,11 +151,12 @@                    -> Description       --  Description of change.                    -> a                 --  New contents of resource.                    -> IO ()-    +     -- | Retrieve the contents of the named resource.   , retrieve       :: Contents a                    => FilePath          -- Resource to retrieve.-                   -> Maybe RevisionId  -- @Just@ a particular revision ID, or @Nothing@ for latest+                   -> Maybe RevisionId  -- @Just@ a particular revision ID,+                                        -- or @Nothing@ for latest                    -> IO a      -- | Delete a named resource, providing author and log message.@@ -169,20 +172,22 @@                    -> Description       -- Description of change.                    -> IO () -    -- | Get history for a list of named resources in a (possibly openended) time range.-    -- If the list is empty, history for all resources will be returned. -  , history        :: [FilePath]        -- List of resources to get history for, or @[]@ for all.-                   -> TimeRange         -- Time range within which to get history.+    -- | Get history for a list of named resources in a (possibly openended)+    -- time range. If the list is empty, history for all resources will+    -- be returned.+  , history        :: [FilePath]        -- List of resources to get history for+                                        -- or @[]@ for all.+                   -> TimeRange         -- Time range in which to get history.                    -> IO [Revision] -    -- | Return the revision ID of the latest change for a resource.  Raises 'NotFound'-    -- if the resource is not found.+    -- | Return the revision ID of the latest change for a resource.+    -- Raises 'NotFound' if the resource is not found.   , latest         :: FilePath          -- Resource to get revision ID for.                    -> IO RevisionId -    -- | Return information about a revision, given the ID.  Raises 'NotFound' if there is-    -- no such revision.-  , revision       :: RevisionId        -- Revision ID to get revision information for.+    -- | Return information about a revision, given the ID.+    -- Raises 'NotFound' if there is no such revision.+  , revision       :: RevisionId        -- Revision ID to get information for.                    -> IO Revision      -- | Return a list of resources in the filestore.@@ -198,9 +203,8 @@                    -> RevisionId                    -> Bool -  -- | Search the filestore for patterns. +  -- | Search the filestore for patterns.   , search         :: SearchQuery                    -> IO [SearchMatch]    }-

@@ -16,26 +16,35 @@         , hashsMatch         , isInsideRepo         , escapeRegexSpecialChars-        , parseMatchLine ) where-+        , parseMatchLine+        , splitEmailAuthor+        , ensureFileExists+        , regSearchFiles+        , regsSearchFile+        , checkAndWriteFile+        , grepSearchRepo ) where  import Codec.Binary.UTF8.String (encodeString)-import Control.Monad (liftM)+import Control.Exception (throwIO)+import Control.Monad (liftM, unless) import Data.ByteString.Lazy.UTF8 (toString)-import Data.List (isPrefixOf)+import Data.Char (isSpace)+import Data.List (intersect, nub, isPrefixOf) import Data.List.Split (splitWhen) import Data.Maybe (isJust)-import System.Directory (canonicalizePath)-import System.Directory (getTemporaryDirectory, removeFile, findExecutable)+import System.Directory (canonicalizePath, doesFileExist, getTemporaryDirectory, removeFile, findExecutable, createDirectoryIfMissing) import System.Exit (ExitCode(..))+import System.FilePath ((</>), takeDirectory) import System.IO (openTempFile, hClose) import System.Process (runProcess, waitForProcess)+import Text.Regex.Posix ((=~)) import qualified Data.ByteString.Lazy as B -import Data.FileStore.Types (SearchMatch(..))+import Data.FileStore.Types (toByteString, Contents, SearchMatch(..), +                              FileStoreError(IllegalResourceName, NotFound), SearchQuery(..))  -- | Run shell command and return error status, standard output, and error output.  Assumes--- UTF-8 locale. Note that this does not actuall go through \/bin\/sh!+-- UTF-8 locale. Note that this does not actually go through \/bin\/sh! runShellCommand :: FilePath                     -- ^ Working directory                 -> Maybe [(String, String)]     -- ^ Environment                 -> String                       -- ^ Command@@ -130,3 +139,69 @@ parseMatchLine str =   let (fn:n:res:_) = splitWhen (==':') str   in  SearchMatch{matchResourceName = fn, matchLineNumber = read n, matchLine = res}++-- | Our policy is: if the input is clearly a "name \<e\@mail.com\>" input, then we return "(Just Address, Name)"+--   If there is no '<' in the input, then it clearly can't be of that format, and so we just return "(Nothing, Name)"+--+-- > splitEmailAuthor "foo bar baz@gmail.com" ~> (Nothing,"foo bar baz@gmail.com")+-- > splitEmailAuthor "foo bar <baz@gmail.com>" ~> (Just "baz@gmail.com","foo bar")+splitEmailAuthor :: String -> (Maybe String, String)+splitEmailAuthor x = if '<' `elem` x then (Just (tail $ init c), reverse . dropWhile isSpace $ reverse b)+                                     else (Nothing,x)+    -- Will still need to trim the '<>' brackets in the email, and whitespace at the end of name+    where (_,b,c) = x =~ "[^<]*" :: (String,String,String)++-- | Search multiple files with a single regexp.+--   This calls out to grep, and so supports the regular expressions grep does.+regSearchFiles :: FilePath -> [String] -> String -> IO [String]+regSearchFiles repo filesToCheck pattern = do (_, _, result) <- runShellCommand repo+                                                             Nothing  "grep" $ ["--line-number", "-I", "-l", "-E", "-e", pattern] ++ filesToCheck+                                              let results = intersect filesToCheck $ lines $ toString result+                                              return results++-- | Search a single file with multiple regexps.+regsSearchFile :: [String] -> FilePath -> [String] -> String -> IO [String]+regsSearchFile os repo patterns file = do res <- mapM (run file) patterns+                                          return $ nub $ concat res+      where run f p = do (_,_,r) <- runShellCommand repo Nothing "grep" (os ++ [p, f])+                         return $ lines $ toString r++-- | 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)+  unless isFile $ throwIO NotFound++-- | Write out a file with given contents. We do sanity checking first, and make sure that the+--   filename/location is within the given repo.+checkAndWriteFile :: (Data.FileStore.Types.Contents a) =>FilePath -> String -> a -> IO ()+checkAndWriteFile repo name contents = do+  let filename = repo </> encodeString name+  inside <- isInsideRepo repo filename+  unless inside $ throwIO IllegalResourceName+  createDirectoryIfMissing True $ takeDirectory filename+  B.writeFile filename $ toByteString contents++-- | Uses grep to search a file-based repository. Note that this calls out to grep; and so+--   is generic over repos like git or darcs-based repos. (The git FileStore instance doesn't+--   use this because git has builtin grep functionality.)+--   Expected usage is to specialize this function with a particular backend's 'index'.+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 []) +++             (if queryWholeWords query then ["--word-regexp"] else ["-E"])+  let regexps = map escapeRegexSpecialChars $ queryPatterns query+  files <- indexer repo+  if queryMatchAll query+     then do+       filesMatchingAllPatterns <- liftM (foldr1 intersect) $ mapM (regSearchFiles repo files) regexps+       output <- mapM (regsSearchFile opts repo regexps) filesMatchingAllPatterns+       return $ map parseMatchLine $ concat output+     else do+       (_status, _errOutput, output) <-+            runShellCommand repo Nothing "grep" $ opts +++                                                  concatMap (\term -> ["-e", term]) regexps +++                                                  files+       let results = lines $ toString output+       return $ map parseMatchLine results

@@ -26,9 +26,9 @@  > testFileStore :: FileStore -> String -> IO Counts  > testFileStore fs fsName = do->   putStrLn $ "**********************************"+>   putStrLn   "**********************************" >   putStrLn $ "Testing " ++ fsName->   putStrLn $ "**********************************"+>   putStrLn   "**********************************" >   runTestTT $ TestList $ map (\(label, testFn) -> TestLabel label $ testFn fs)  >     [ ("initialize", initializeTest) >     , ("create resource", createTest1)@@ -139,7 +139,7 @@  *** Retrieve a directory (should fail): -> retrieveTest4 fs = TestCase $ do+> 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@@ -165,16 +165,16 @@     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 =+>   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"})+>                         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})+>   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 ().

@@ -1,5 +1,5 @@ Name:                filestore-Version:             0.3+Version:             0.3.1 Cabal-version:       >= 1.2 Build-type:          Custom Tested-with:         GHC==6.10.1@@ -24,14 +24,24 @@ --    Type:            darcs --    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.+ Library-    Build-depends:       base >= 4, bytestring, utf8-string, filepath, directory, datetime,+    Build-depends:       base >= 4 && < 5, bytestring, utf8-string, filepath, directory, datetime,                          parsec >= 2 && < 3, process, time, datetime, regex-posix, xml, split, Diff      Exposed-modules:     Data.FileStore, Data.FileStore.Types, Data.FileStore.Git, Data.FileStore.Darcs,                          -- Data.FileStore.Sqlite3,                          Data.FileStore.Utils, Data.FileStore.Generic-    Other-modules:       Paths_filestore+    Other-modules:       Paths_filestore, Data.FileStore.DarcsXml++    if flag(maxcount) +        cpp-options: -DUSE_MAXCOUNT+        extensions: CPP      Ghc-Options:         -Wall     Ghc-Prof-Options:    -auto-all