-- |
-- 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, "")