Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Added a 'limit' parameter to 'history'.

Ignore-this: 5364447925857732d997149b70e468e3

darcs-hash:20120520230458-0f649-15abb77e84c99355e2aecc861ca072d121256768.gz
  • Loading branch information...
commit 2e7d45eab127577cdab5e84c3711425bc70691a3 1 parent 26d48bb
@jgm authored
View
15 Data/FileStore/Darcs.hs
@@ -117,16 +117,23 @@ darcsDelete repo name author logMsg = withSanityCheck repo ["_darcs"] name $ do
-- | Return list of log entries for the list of resources.
-- If list of resources is empty, log entries for all resources are returned.
-darcsLog :: FilePath -> [FilePath] -> TimeRange -> IO [Revision]
-darcsLog repo names (TimeRange begin end) = do
- let opts = timeOpts begin end
- do (status, err, output) <- runDarcsCommand repo "changes" $ ["--xml-output", "--summary"] ++ names ++ opts
+darcsLog :: FilePath -> [FilePath] -> TimeRange -> Maybe Int -> IO [Revision]
+darcsLog repo names (TimeRange begin end) mblimit = do
+ (status, err, output) <- runDarcsCommand repo "changes" $ ["--xml-output", "--summary"] ++ names ++ opts
if status == ExitSuccess
then case parseDarcsXML $ toString output of
Nothing -> throwIO ResourceExists
Just parsed -> return parsed
else throwIO $ UnknownError $ "darcs changes returned error status.\n" ++ err
where
+ opts = timeOpts begin end ++ limit
+ limit = case mblimit of
+#ifdef USE_MAXCOUNT
+ Just lim -> ["--max-count",show lim]
+#else
+ Just _ -> []
+#endif
+ Nothing -> []
timeOpts :: Maybe UTCTime -> Maybe UTCTime ->[String]
timeOpts b e = case (b,e) of
(Nothing,Nothing) -> []
View
2  Data/FileStore/Generic.hs
@@ -104,7 +104,7 @@ searchRevisions repo exact name desc = do
let matcher = if exact
then (== desc)
else (desc `isInfixOf`)
- revs <- history repo [name] (TimeRange Nothing Nothing)
+ revs <- history repo [name] (TimeRange Nothing Nothing) Nothing
return $ Prelude.filter (matcher . revDescription) revs
-- | Try to retrieve a resource from the repository by name and possibly a
View
9 Data/FileStore/Git.hs
@@ -237,8 +237,8 @@ gitLogFormat = "%H%n%ct%n%an%n%ae%n%B%n%x00"
-- | Return list of log entries for the given time frame and list of resources.
-- If list of resources is empty, log entries for all resources are returned.
-gitLog :: FilePath -> [FilePath] -> TimeRange -> IO [Revision]
-gitLog repo names (TimeRange mbSince mbUntil) = do
+gitLog :: FilePath -> [FilePath] -> TimeRange -> Maybe Int -> IO [Revision]
+gitLog repo names (TimeRange mbSince mbUntil) mblimit = do
(status, err, output) <- runGitCommand repo "whatchanged" $
["-z","--pretty=format:" ++ gitLogFormat] ++
(case mbSince of
@@ -247,7 +247,10 @@ gitLog repo names (TimeRange mbSince mbUntil) = do
(case mbUntil of
Just til -> ["--until='" ++ show til ++ "'"]
Nothing -> []) ++
- ["--"] ++ names
+ (case mblimit of
+ Just lim -> ["-n", show lim]
+ Nothing -> []) ++
+ ["--"] ++ names
if status == ExitSuccess
then case P.parse parseGitLog "" (toString output) of
Left err' -> throwIO $ UnknownError $ "Error parsing git log.\n" ++ show err'
View
9 Data/FileStore/Mercurial.hs
@@ -200,9 +200,9 @@ mercurialLogFormat = "{node}\\n{date|rfc822date}\\n{author|person}\\n{author|ema
-- | Return list of log entries for the given time frame and list of resources.
-- If list of resources is empty, log entries for all resources are returned.
-mercurialLog :: FilePath -> [FilePath] -> TimeRange -> IO [Revision]
-mercurialLog repo names (TimeRange mbSince mbUntil) = do
- (status, err, output) <- runMercurialCommand repo "log" $ ["--template", mercurialLogFormat] ++ revOpts mbSince mbUntil ++ names
+mercurialLog :: FilePath -> [FilePath] -> TimeRange -> Maybe Int -> IO [Revision]
+mercurialLog repo names (TimeRange mbSince mbUntil) mblimit = do
+ (status, err, output) <- runMercurialCommand repo "log" $ ["--template", mercurialLogFormat] ++ revOpts mbSince mbUntil ++ limit ++ names
if status == ExitSuccess
then case P.parse parseMercurialLog "" (toString output) of
Left err' -> throwIO $ UnknownError $ "Error parsing mercurial log.\n" ++ show err'
@@ -213,6 +213,9 @@ mercurialLog repo names (TimeRange mbSince mbUntil) = do
revOpts (Just s) Nothing = ["-d", ">" ++ showTime s]
revOpts (Just s) (Just u) = ["-d", showTime s ++ " to " ++ showTime u]
showTime = formatTime defaultTimeLocale "%F %X"
+ limit = case mblimit of
+ Just lim -> ["--limit", show lim]
+ Nothing -> []
--
View
1  Data/FileStore/Types.hs
@@ -184,6 +184,7 @@ data FileStore = FileStore {
, history :: [FilePath] -- List of resources to get history for
-- or @[]@ for all.
-> TimeRange -- Time range in which to get history.
+ -> Maybe Int -- Maybe max number of entries.
-> IO [Revision]
-- | Return the revision ID of the latest change for a resource.
View
10 Tests.lhs
@@ -263,7 +263,7 @@ This program runs tests for the filestore modules.
*** Retrieve earlier version of deleted file:
> retrieveTest5 fs = TestCase $ do
-> hist <- history fs ["Aaack!"] (TimeRange Nothing Nothing)
+> 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
@@ -310,7 +310,7 @@ This program runs tests for the filestore modules.
Get history for three files
-> hist <- history fs [testTitle, subdirTestTitle, nonasciiTestTitle] (TimeRange Nothing Nothing)
+> 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
@@ -320,8 +320,10 @@ This program runs tests for the filestore modules.
> assertBool "revDescription non-null" (not (null (revDescription rev)))
> assertEqual "revChanges" [Modified testTitle] (revChanges rev)
> let revtime = revDateTime rev
-> histNow <- history fs [testTitle] (TimeRange (Just $ addUTCTime (60 * 60 * 24) now) Nothing)
+> 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
@@ -333,7 +335,7 @@ This program runs tests for the filestore modules.
> 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)
+> [secondrev, firstrev] <- history fs [diffTitle] (TimeRange Nothing Nothing) Nothing
> diff' <- diff fs diffTitle (Just $ revId firstrev) (Just $ revId secondrev)
> let subtracted' = mapMaybe (\(d,s) -> if d == F then Just s else Nothing) diff'
> assertEqual "subtracted lines" [[last (lines testContents)]] subtracted'
Please sign in to comment.
Something went wrong with that request. Please try again.