1
0
forked from GitHub/gf-core

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.
This commit is contained in:
hallgren
2015-07-20 13:02:49 +00:00
parent 880f0a63d0
commit 400195b307

View File

@@ -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)