diff --git a/ChangeMonger.hs b/ChangeMonger.hs new file mode 100644 --- /dev/null +++ b/ChangeMonger.hs @@ -0,0 +1,39 @@ +module Main (main) where + +import System.Environment (getArgs) +import System.Directory (doesDirectoryExist) +import System.IO.Unsafe (unsafePerformIO) + +import Text.ChangeMonger.Darcs (darcsChangesSince) +import Text.ChangeMonger.Git (gitChangesSince) +import Text.ChangeMonger.Subversion (svnChangesAll) +import Text.ChangeMonger.Mercurial (hgChangesSince) +import Text.ChangeMonger.CVS (cvsChangesAll) + +main :: IO () +main = do args <- getArgs + if null args then dirsParsePrint "ChangeLog" + else dirsParsePrint (head args) + +dirsParsePrint :: FilePath -> IO () +dirsParsePrint s = case dirs of + "_darcs" -> write s darcsChangesSince + ".git" -> write s gitChangesSince + ".svn" -> write s svnChangesAll + ".hg" -> write s hgChangesSince + "CVS" -> write s cvsChangesAll + _ -> error "No understood VCSes found." + +write :: FilePath -> IO String -> IO () +write fle cmd = cmd >>= writeFile fle + +dirFilter :: [(a, Bool)] -> a +dirFilter (x:xs) + | snd x == True = fst x + | otherwise = dirFilter xs + +dirs :: FilePath +dirs = dirFilter $ map (\(x,_) -> (x, unsafePerformIO $ doesDirectoryExist x)) directories + +directories :: [(FilePath, Bool)] +directories = [("_darcs", False), (".git", False), (".svn", False), (".hg", False), ("CVS", False)] diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,28 @@ +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/Text/ChangeMonger/CVS.hs b/Text/ChangeMonger/CVS.hs new file mode 100644 --- /dev/null +++ b/Text/ChangeMonger/CVS.hs @@ -0,0 +1,19 @@ +module Text.ChangeMonger.CVS (cvsChanges, cvsChangesAll) where + +import Text.ChangeMonger.Parse (run) + +-- | Ask CVS for changes in general; we accept an options argument which +-- will be passed onto CVS, so you can customize by using any of the many +-- options to 'changes' which CVS understands. +-- WARNING: This seems to be broken. +cvsChanges :: String -> IO String +cvsChanges "" = run "cvs" ["log"] +cvsChanges a = run "cvs" ["log", a] + +-- | Nothing fancy: just get the entire repository history. +cvsChangesAll :: IO String +cvsChangesAll = cvsChanges "" + +-- TODO: like with Subversion, I'm going to punt on this one. +{- cvsChangesSince :: IO String +cvsChangesSince = cvsChanges "" -} diff --git a/Text/ChangeMonger/Darcs.hs b/Text/ChangeMonger/Darcs.hs new file mode 100644 --- /dev/null +++ b/Text/ChangeMonger/Darcs.hs @@ -0,0 +1,18 @@ +module Text.ChangeMonger.Darcs (darcsChanges, darcsChangesAll, darcsChangesSince) where + +import Text.ChangeMonger.Parse (run) + +-- | Ask Darcs for changes in general; we accept an options argument which +-- will be passed onto Darcs, so you can customize by using any of the many +-- options to 'changes' which Darcs understands. +darcsChanges :: String -> IO String +darcsChanges a = run "darcs" ["changes", a] + +-- | Nothing fancy: just get the entire repository history. +darcsChangesAll :: IO String +darcsChangesAll = darcsChanges "" + +-- | Ask Darcs for all changes, since the last tag. Conscientious folks +-- tag at every release, so this is a good heuristic. +darcsChangesSince :: IO String +darcsChangesSince = darcsChanges "--from-tag=." diff --git a/Text/ChangeMonger/Git.hs b/Text/ChangeMonger/Git.hs new file mode 100644 --- /dev/null +++ b/Text/ChangeMonger/Git.hs @@ -0,0 +1,30 @@ +module Text.ChangeMonger.Git (gitChanges, gitChangesAll, gitChangesSince) where + +import Control.Monad (liftM) +import Text.ChangeMonger.Parse (run) + +gitRun :: [String] -> IO String +gitRun a = run "git" $ ["--no-pager"] ++ a + +-- | Ask Git for changes in general; we accept an options argument which +-- will be passed onto Git, so you can customize by using any of the many +-- options to 'log' which Git understands. +-- Tricky bits: we can't pass Git \"\", because it won't treat it as non-existent, +-- so the implementation needs to reflect this. +gitChanges :: String -> IO String +gitChanges "" = gitRun ["log"] +gitChanges a = gitRun ["log", a] + +-- | Nothing fancy: just get the entire repository history. +gitChangesAll :: IO String +gitChangesAll = gitChanges [] + +-- | Ask Git for all changes, since the last tag. Conscientious folks +-- tag at every release, so this is a good heuristic. +-- Tricky bits: 'run' returns the name of the last tag with '\n' included, +-- so we use 'init' to drop the last character and remove '\n'. +-- Then, we ask "git log" 'tag-name..', which is its syntax for "all commits" +-- since a particular tag. In this case, our tag-name is the last tag, so we're good. +gitChangesSince :: IO String +gitChangesSince = do tag <- liftM init $ gitRun ["describe", "--abbrev=0"] + gitChanges (tag ++ "..") diff --git a/Text/ChangeMonger/Mercurial.hs b/Text/ChangeMonger/Mercurial.hs new file mode 100644 --- /dev/null +++ b/Text/ChangeMonger/Mercurial.hs @@ -0,0 +1,30 @@ +module Text.ChangeMonger.Mercurial (hgChanges, hgChangesAll, hgChangesSince) where + +import Control.Monad (liftM) +import Text.ChangeMonger.Parse (run) + +runHg :: [String] -> IO String +runHg = run "hg" + +-- | Ask Mercurial for changes in general; we accept an options argument which +-- will be passed onto Mercurial, so you can customize by using any of the many +-- options to 'log' which Mercurial understands. +hgChanges :: String -> IO String +hgChanges a = runHg ["log", a] + +-- | Nothing fancy: just get the entire repository history. +hgChangesAll :: IO String +hgChangesAll = hgChanges "" + +-- | Ask Mercurial for all changes, since the last tag. Conscientious folks +-- tag at every release, so this is a good heuristic. +hgChangesSince :: IO String +hgChangesSince = do tags <- liftM lines $ runHg ["tags", "--quiet"] + runHg ["log", "-r", ((release tags) ++ ":tip")] + +release :: [String] -> String +release [] = "" +release [""] = "" +-- Extract the most recent tag +release (_:x:_) = x -- ["tip", last-tag, other, tags, and, so, on] +release (_:_) = "" diff --git a/Text/ChangeMonger/Parse.hs b/Text/ChangeMonger/Parse.hs new file mode 100644 --- /dev/null +++ b/Text/ChangeMonger/Parse.hs @@ -0,0 +1,12 @@ +module Text.ChangeMonger.Parse (run) where + +import System.Process (runInteractiveProcess) +import System.IO (hGetContents) + +-- | Call out to the shell, and collect the result as a String. +run :: String -- ^ The command + -> [String] -- ^ Options to the command + -> IO String -- ^ Result +run "" _ = return "" +run prog opts = do (_,x,_,_) <- runInteractiveProcess prog opts Nothing Nothing + hGetContents x diff --git a/Text/ChangeMonger/Subversion.hs b/Text/ChangeMonger/Subversion.hs new file mode 100644 --- /dev/null +++ b/Text/ChangeMonger/Subversion.hs @@ -0,0 +1,25 @@ +module Text.ChangeMonger.Subversion (svnChanges, svnChangesAll) where + +import Text.ChangeMonger.Parse (run) + +-- | Ask Subversion for changes in general; we accept an options argument which +-- will be passed onto Subversion, so you can customize by using any of the many +-- options to 'log' which Subversion understands. +svnChanges :: String -> IO String +svnChanges a = run "svn" ["log", a] + +-- | Nothing fancy: just get the entire repository history. +-- Unfortunately, Subversion doesn't have a very useful notion of +-- tags, so we merely get the full history. +svnChangesAll :: IO String +svnChangesAll = svnChanges "" + +{- TODO: add support for what tagging there is. See + . + It'd look something like foo="svn log | grep -C 2 tag | head -n | cut -d 1,2-"; + "svn log -rfoo-HEAD" + someone on #svn suggested doing something like 'svn log --stop-on-copy + http://svn.yourhost.com/reposname/tags/tagname" -} + +-- svnChangesSince :: IO String +-- svnChangesSince = undefined diff --git a/change-monger.cabal b/change-monger.cabal new file mode 100644 --- /dev/null +++ b/change-monger.cabal @@ -0,0 +1,33 @@ +name: change-monger +version: 0.0 + +license: BSD3 +license-file: LICENSE +author: Gwern +maintainer: Gwern + +category: Text, Development +synopsis: Parse VCS changelogs into ChangeLogs +description: change-monger is intended to allow you to extract + the revision history from various VCSes like Darcs, + and save them as a ChangeLog; particularly important + is being able to extract the summaries for all patches + since the last release. + + +build-type: Simple +Cabal-Version: >= 1.2 + +Library + exposed-modules: Text.ChangeMonger.Darcs, + Text.ChangeMonger.Git, + Text.ChangeMonger.Subversion, + Text.ChangeMonger.CVS, + Text.ChangeMonger.Mercurial, + Text.ChangeMonger.Parse + build-Depends: base, process + ghc-options: -Wall + +Executable change-monger + main-is: ChangeMonger.hs + build-depends: directory