-- |
-- Module : diffcabal: diff two cabal files
-- Copyright : (c) Don Stewart, 2010
-- License : BSD3
--
-- Maintainer: Don Stewart <dons@galois.com>
-- Stability : provisional
-- Portability:
--
import Distribution.PackageDescription
import Distribution.PackageDescription.Parse
import Distribution.Simple.Utils hiding (die, intercalate)
import Distribution.Verbosity
import Distribution.Package
import Distribution.ModuleName hiding (main)
import Distribution.PackageDescription.Configuration
import Distribution.Text
import Distribution.Version
import Data.Algorithm.Diff
import Data.Function
import Control.Monad
import Control.Concurrent
import Control.Exception
import qualified Control.OldException as C
import Debug.Trace
import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import System.IO
import System.Process hiding (cwd)
import Data.List
import Data.Maybe
import Data.Char
import Text.PrettyPrint
main :: IO ()
main =
bracket
-- We do all our work in a temp directory
(do cwd <- getCurrentDirectory
etmp <- makeTempDir
case etmp of
Left _ -> die "Unable to create temp directory"
Right d -> do
let dir = makeValid (init d) -- drop newline
setCurrentDirectory dir
return (dir, cwd))
-- Always remember to clean up
(\(d,cwd) -> do
setCurrentDirectory cwd
removeDirectoryRecursive d)
-- Now, get to work:
$ \(tmp,cwd) -> do
res <- do x <- getArgs
case x of
["--help"] -> help
["-h"] -> help
(f1:f2:[]) -> return [f1,f2]
_ -> help
modules' <- forM res $ \f -> do
cabalfile <- findCabalFile f cwd tmp
cabalsrc <- readPackageDescription normal cabalfile
let final = flattenPackageDescription cabalsrc
dependencies = buildDepends final ++
concatMap buildTools
(allBuildInfo final)
return (final, dependencies)
------------------------------------------------------------------------
-- diff the dependencies.
let diff =
groupBy ((==) `on` (name . snd)) $
sortBy (comparing (name . snd))
[ (t, d)
| (t, d) <-
getDiff (sortBy (comparing name) . snd $ modules' !! 0)
(sortBy (comparing name) . snd $ modules' !! 1)
, t /= B -- strip stuff that is equal
]
mapM_ (putStrLn . render . pprDiff) diff
------------------------------------------------------------------------
name (Dependency n _) = n
vers (Dependency _ v) = v
precise (ThisVersion v) = v
pprDiff :: [(DI, Dependency)] -> Doc
pprDiff [(S, b), (F, a)] =
hang
(disp (name a))
4 $
disp (precise $ vers a) <+> text "->" <+> disp (precise $ vers b)
pprDiff [(S, b)] =
hang
(disp (name b))
4 $
text "Added: " <+> disp (precise $ vers b)
pprDiff [(F, a)] =
hang
(disp (name a))
4 $
text "Removed: " <+> disp (precise $ vers a)
------------------------------------------------------------------------
makeTempDir :: IO (Either (ExitCode, String, String) String)
makeTempDir = myReadProcess "mktemp" ["-d", "-t", "fooXXXX"] []
------------------------------------------------------------------------
-- Return the path to a .cabal file.
-- If not arguments are specified, use ".",
-- if the argument looks like a url, download that
-- otherwise, assume its a directory
--
findCabalFile :: FilePath -> FilePath -> FilePath -> IO FilePath
findCabalFile file cwd tmp = do
let epath | null file
= Right cwd
| "http://" `isPrefixOf` file
= Left file
| ".cabal" `isSuffixOf` file
= Right (makeValid (joinPath [cwd,file]))
| otherwise -- a relative directory path
= Right (cwd </> file)
-- download url to .cabal
case epath of
Left url -> do
eres <- myReadProcess "wget" [url] []
case eres of
Left (_,s,_) -> do
hPutStrLn stderr s
die $ "Couldn't download .cabal file: " ++ show url
Right _ ->
findPackageDesc tmp -- tmp dir -- error: only allows one url on the command line
-- it might be a .cabal file
Right f | ".cabal" `isSuffixOf` f -> do
b <- doesFileExist f
if not b
then die $ ".cabal file doesn't exist: " ++ show f
else return f
-- or assume it is a dir to a file:
Right dir -> do
b <- doesDirectoryExist dir
if not b
then die $ "directory doesn't exist: " ++ show dir
else findPackageDesc dir
die :: String -> IO a
die s = do
hPutStrLn stderr $ "cabalgraph:\n" ++ s
exitWith (ExitFailure 1)
help :: IO a
help = do
hPutStrLn stderr $ unlines
[ "diffcabal [-h|--help] [file|directory|url] [file|directory|url]"
, ""
, " Diff two .cabal files syntactically"
, ""
, "Usage:"
, " -h Display help message"
, ""
, "Arguments: <directory>"
, " Look for .cabal file in <directory>"
, " If directory is empty, use pwd"
, " <file.cabal>"
, " Use .cabal file as source"
, " <url>"
, " Download .cabal file from <url>"
]
exitWith ExitSuccess
------------------------------------------------------------------------
--
-- Strict process reading
--
myReadProcess :: FilePath -- ^ command to run
-> [String] -- ^ any arguments
-> String -- ^ standard input
-> IO (Either (ExitCode,String,String) String) -- ^ either the stdout, or an exitcode and any output
myReadProcess cmd args input = C.handle (return . handler) $ do
(inh,outh,errh,pid) <- runInteractiveProcess cmd args Nothing Nothing
output <- hGetContents outh
outMVar <- newEmptyMVar
forkIO $ (C.evaluate (length output) >> putMVar outMVar ())
errput <- hGetContents errh
errMVar <- newEmptyMVar
forkIO $ (C.evaluate (length errput) >> putMVar errMVar ())
when (not (null input)) $ hPutStr inh input
takeMVar outMVar
takeMVar errMVar
ex <- C.catch (waitForProcess pid) (\_e -> return ExitSuccess)
hClose outh
hClose inh -- done with stdin
hClose errh -- ignore stderr
return $ case ex of
ExitSuccess -> Right output
ExitFailure _ -> Left (ex, errput, output)
where
handler (C.ExitException e) = Left (e,"","")
handler e = Left (ExitFailure 1, show e, "")