-- |
-- Module    : cabalgraph: graph sets of modules from cabal packages
-- Copyright : (c) Don Stewart, 2009
-- License   : BSD3
--
-- Maintainer: Don Stewart <dons@galois.com>
-- Stability : provisional
-- Portability:
--

import Distribution.Package
import Distribution.PackageDescription
import Distribution.PackageDescription.Parse
import Distribution.PackageDescription.Configuration
import Distribution.Simple.Utils hiding (die, intercalate)
import Distribution.Verbosity
import Distribution.ModuleName hiding (main)
import Distribution.Version
import Distribution.Package
import Distribution.License
import Distribution.Text
import Distribution.Compiler
import Distribution.System
import Distribution.Simple.PackageIndex

import qualified Text.PrettyPrint as Disp

import Control.Monad
import Control.Concurrent
import Control.Exception
import qualified Control.OldException as C

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 qualified Data.Map as M
import Data.Monoid
import Data.Char
import Debug.Trace

main :: IO ()
main =
 bracket
   -- We do all our work in a temp directory
  (do cwd  <- getCurrentDirectory
      etmp <- myReadProcess "mktemp" ["-d"] []
      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
               (f:fs)     -> return (f:fs)

   modules' <- forM res $ \f -> do

       cabalfile <- findCabalFile f cwd tmp
       cabalsrc  <- readPackageDescription normal cabalfile
       let ms = case condLibrary cabalsrc of
            Just x -> exposedModules (condTreeData x)
            _      -> error "This is not a library package"
       return ms

   let modules = concat modules'

   -- printing

   putStrLn "strict graph graphname {"

   mapM_ putStrLn (map ppr modules)

   putStrLn "}"

ppr :: ModuleName -> String
ppr ms =
     Disp.render $ Disp.hcat
                     $ intersperse (Disp.text " -- ")
                                  [ Disp.doubleQuotes (Disp.text (intercalate "." x))
                                  | x <- tail (inits (components ms)) ]


{-
    D -- D.B -- D.B.C

    strict graph graphname {
        Data -- ByteString
        Data -- ByteString -- Char8
        Data -- ByteString -- Unsafe
        Data -- ByteString -- Internal
        Data -- ByteString -- Lazy
        Data -- ByteString -- Lazy -- Char8
        Data -- ByteString -- Lazy -- Internal
        Data -- ByteString -- Fusion
    }

    -}


-- 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
    [ "cabalgraph: [-h|--help] [directory|url]"
    , ""
    , "  Generate graphs for .cabal files in <directory> or at <url>"
    , ""
    , "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, "")