Setup.hs: correctly parse output from 'darcs changes' for newer versions of darcs

It worked with darcs-2.8 before, now it also works with darcs-2.10.

1 files changed, 15 insertions, 3 deletions

diff --git a/Setup.hs b/Setup.hs
index c98fa8bab..272322d8e 100644
--- a/Setup.hs
+++ b/Setup.hs
@@ -5,7 +5,8 @@ import Distribution.Simple.Utils
 import Distribution.Simple.Setup
 import Distribution.PackageDescription hiding (Flag)
 import Control.Monad
-import Data.List(isPrefixOf,intersect)
+import Data.Char(isSpace)
+import Data.List(isPrefixOf,intersect,unfoldr,stripPrefix)
 import Data.Maybe(listToMaybe)
 --import System.IO
 import qualified Control.Exception as E
@@ -397,8 +398,8 @@ extractDarcsVersion distFlag =
          let from = case tags of
                       [] -> []
                       tag:_ -> ["--from-tag="++tag]
-         changes <- lines `fmap` readProcess "darcs" ("changes":from) ""
-         let dates = init' (filter ((`notElem` [""," "]).take 1) changes)
+         dates <- patches `fmap` readProcess "darcs" ("changes":from) ""
+--       let dates = init' (filter ((`notElem` [""," "]).take 1) changes)
          whatsnew <- tryIOE $ lines `fmap` readProcess "darcs" ["whatsnew","-s"] ""
          return (listToMaybe tags,listToMaybe dates,
                  length dates,either (const 0) length whatsnew)
@@ -423,3 +424,14 @@ parallel_ ms = sequence_ ms {-
      ts <- sequence [ forkIO (m >> writeChan c ()) | m <- ms]
      sequence_ [readChan c | _ <- ts]
 --}
+
+patches = paras . lines
+  where
+    paras = unfoldr para
+    para ls = case break null $ dropWhile null ls of
+                ([],[]) -> Nothing
+                (xs,ys) -> Just (info xs,ys)
+
+    info = unwords . map dropHeaders . filter (\l->not $ any (`isPrefixOf` l) [" ","patch "])
+    dropHeaders = dropWhile isSpace . dropPrefix "Author: " . dropPrefix "Date: "
+    dropPrefix pre l = maybe l id (stripPrefix pre l)