-- 
-- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons
-- 
-- This program is free software; you can redistribute it and/or
-- modify it under the terms of the GNU General Public License as
-- published by the Free Software Foundation; either version 2 of
-- the License, or (at your option) any later version.
-- 
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- General Public License for more details.
-- 
-- You should have received a copy of the GNU General Public License
-- along with this program; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-- 

--
-- | Send notification to a mailing list on a 'darcs push' to a remote machine.
-- A rewrite in Haskell, and redesign of:
--     darcs0.bin (a perl program): 
--      (C) 2004-12-10 Thomas Radke <tradke@aei.mpg.de>
--      Some changes by Erik Schnetter <schnetter@aei.mpg.de>
--
-- If the file _darcs/prefs/mailinglist exists in a repo we push to,
-- then we will attempt to send a summary of the patch just pushed over
-- ssh to the addresses listed in that file. The 'mailinglist' file
-- contains one email address per line. Otherwise behave like darcs as
-- normal.
--

module Main (main) where

import Fork
import MkTemp

import Data.List
import Data.Maybe               ( isJust, fromJust )
import Data.Char

import Control.Exception        ( handle )
import Control.Monad            ( when )

import System.Cmd               ( system )
import System.Directory
import System.Environment       ( getArgs )
import System.Exit
import System.IO
import System.Posix.Process     ( executeFile )

------------------------------------------------------------------------

-- | a lists of mail recipients
type ML = [String]

-- | Path to file containing assoc list of darcs repos to lists of addresses.
darcsmail :: FilePath
darcsmail = "_darcs/prefs/mailinglist"

-- | Path to the real darcs binary
darcs :: FilePath
darcs = "/home/pls/bin/darcs.real"

-- ---------------------------------------------------------------------
-- Let's go
--
-- Notes:
-- * a remote darcs push performs "darcs apply --all" on the remote
-- machine.  apply local uses "apply --all --repodir repo" One idea
-- would be to also extend it to the above push.  Then, what about a
-- direct apply from a patch. We should handle that too.
--
main :: IO ()
main = do
    x <- darcs `doesExistAndIs` executable      -- just in case...
    when (not x) $ do
        putStrLn $ "Couldn't find darcs at "++darcs
        exitFailure

    argv <- getArgs
      
    -- if we're not doing an 'apply --all', just run darcs.
    when (argv /= ["apply","--all"]) $
        executeFile darcs False argv Nothing -- execve!

    patch     <- getContents
    (so,se,e) <- popen darcs argv (Just patch) -- darcs apply --all

    hPutStr stdout so >> hFlush stdout  -- make sure we behave like darcs
    maybeExit se e

    -- now see if we need to mail anyone
    mml <- parseML
    when (isJust mml) $ do
        let who   = fromJust mml
            count = parse patch

        -- Have darcs produce a nice patch summary
        (diff,pe,e') <- popen darcs ["changes","-s","--last="++show count] Nothing
        maybeExit pe e'

        -- write the diff to a tmp file
        pwd <- getCurrentDirectory
        m   <- mkstemp "/tmp/XXXXXXXXXX"
        case m of
            Nothing    -> do 
                hPutStr stderr "mkstemp failed!"
                exitWith (ExitFailure 1)
            Just (f,h) -> do -- all's good. send!
                hPutStr h diff        >> hClose h
                putStr "Mailing ... " >> hFlush stdout
                mapM_ (mail f pwd) who
                putStrLn "done."
                removeFile f

    exitWith ExitSuccess

-- Print to stderr, and exit if exit code was bad.
maybeExit :: String -> ExitCode -> IO ()
maybeExit err e = do
    hPutStr stderr err
    hFlush stderr
    when (e /= ExitSuccess) $ exitWith e

--
-- mail a string to someone
-- system call is a bit dicey, should clean up.
--
mail :: FilePath -> FilePath -> String -> IO ()
mail f repo who = do -- todo: use sendmail
    let cmd = concat $ intersperse " " 
                ["mail", "-s", "\"darcs commit: "++repo++"\"", who, "<", f]
    system cmd
    return ()

--
-- | Extract the comments and header from a patch, for mailing purposes
--
parse :: String -> Integer
parse [] = 0
parse s | "New patches:" `isPrefixOf` s = countPs (drop 12 s) 0
parse (_:cs) = parse cs

-- | Count the number of patches
countPs :: String -> Integer -> Integer
countPs [] n = n
countPs s n | "\n[" `isPrefixOf` s = countPs (drop 2 s) (n+1)
countPs (_:cs) n = countPs cs n

-- | Read the mail data base. Nothing if there is no file.
parseML :: IO (Maybe ML)
parseML = do
    p <- darcsmail `doesExistAndIs` readable
    if not p 
        then return Nothing
        else do h <- openFile darcsmail ReadMode
                s <- hGetContents h
                return (Just (parseMailString s))

parseMailString :: String -> ML
parseMailString s = filter (not . isComment) (lines s)
    where isComment l = case filter (not . isSpace) l of
                          [] -> True
                          ('#':_) -> True
                          _ -> False

-- | does a file exist and have property 'p'?
doesExistAndIs :: FilePath -> (Permissions -> Bool) -> IO Bool
doesExistAndIs f p = do
    e <- doesFileExist f
    m <- Control.Exception.handle (\_ -> return Nothing) $ do
                ps <- getPermissions f
                return (Just ps)
    return $ case m of
            Nothing -> False
            Just ps -> e && p ps