-- |
-- Module    : lscabal: 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.PackageDescription
import Distribution.PackageDescription.Parse
import Distribution.Simple.Utils hiding (die, intercalate)
import Distribution.Verbosity
import Distribution.ModuleName hiding (main)

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 Data.Char

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"] -> 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

   mapM_ putStrLn (map ppr modules)

makeTempDir :: IO (Either (ExitCode, String, String) String)
makeTempDir = myReadProcess "mktemp" ["-d", "-t", "fooXXXX"] []

ppr :: ModuleName -> String
ppr ms = intercalate "." (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
    [ "lscabal [-h|--help] [directory|url]"
    , ""
    , "  List modules exported by .cabal package at <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, "")