Main.hs

{-# LANGUAGE DeriveDataTypeable #-}

-- |
-- Module    : cabal2arch: convert cabal packages to Arch Linux PKGBUILD format
-- Copyright : (c) Don Stewart, 2008 .. 2010
-- License   : BSD3
--
-- Maintainer: Don Stewart <dons@galois.com>
-- Stability : provisional
-- Portability:
--

-- TODO: if build-type: Configure, accurate C library dependecies
-- require downloading the source, and running configure
--
-- C libraries are dynamically linked, should be listed in depends,
-- rather than makedepends

import Distribution.PackageDescription.Parse
import Distribution.Simple.Utils hiding (die)
import Distribution.Verbosity
import Distribution.Text

-- from the archlinux package:
import Distribution.ArchLinux.PkgBuild
import Distribution.ArchLinux.CabalTranslation

import Control.Monad
import Control.Monad.Error
import qualified Control.Exception as CE

import Data.List

import Text.PrettyPrint

import Paths_cabal2arch
import Data.Version (showVersion)

import System.Directory
import System.Exit
import System.FilePath
import System.IO
import System.Process hiding(cwd)

import System.Console.CmdArgs
import Cabal2Arch.Util

data CmdLnArgs
    = CmdLnConvertOne { argCabalFile :: String, argCreateTar :: Bool, argDataFiles :: String }
    deriving (Data, Typeable)

cmdLnConvertOne :: CmdLnArgs
cmdLnConvertOne = CmdLnConvertOne
    { argCabalFile = "" &= argPos 0 &= typ "FILE|DIR|URL"
    , argCreateTar = False &= name "tar" &= explicit &= help "Create a tar-ball for the source package."
    , argDataFiles = "" &= name "sysinfo" &= typDir &= explicit &= help "Use custom system information files."
    } &= auto &= name "conv" &= help "Convert a single CABAL file."

cmdLnArgs :: CmdLnArgs
cmdLnArgs = modes [cmdLnConvertOne]
    &= program "cabal2arch"
    &= summary ("cabal2arch, v. " ++ showVersion version ++ ": Convert .cabal file to ArchLinux source package")

main :: IO ()
main = cmdArgs cmdLnArgs >>= subCmd

subCmd :: CmdLnArgs -> IO ()
subCmd (CmdLnConvertOne cabalLoc createTar dataFiles) =
    CE.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

            -- myArgs <- cmdArgs cmdLnArgs
            email <- do
                r <- getEnvMaybe "ARCH_HASKELL"
                case r of
                    Nothing -> do
                        hPutStrLn stderr "Warning: ARCH_HASKELL environment variable not set. Set this to the maintainer contact you wish to use. \n E.g. 'Arch Haskell Team <arch-haskell@haskell.org>'"
                        return []
                    Just s  -> return s

            cabalfile <- findCabalFile cabalLoc _cwd tmp
            hPutStrLn stderr $ "Using " ++ cabalfile

            cabalsrc  <- readPackageDescription normal cabalfile

            -- Create a package description with all configurations resolved.
            maybeSysProvides <- runErrorT $ getSystemProvidesFromPath dataFiles
            sysProvides <- case maybeSysProvides of
                Left s -> die s
                Right sp -> return sp
            let finalcabal = preprocessCabal cabalsrc sysProvides
            finalcabal' <- case finalcabal of
                Nothing -> die "Aborting..."
                Just f -> return f
            let (pkgbuild', hooks) = cabal2pkg finalcabal' sysProvides

            apkgbuild' <- getMD5 pkgbuild'
            let apkgbuild = apkgbuild' { pkgBuiltWith = Just version }
                pkgbuild = pkgBody apkgbuild
                doc = pkg2doc email apkgbuild
                dir = arch_pkgname pkgbuild

            setCurrentDirectory _cwd
            createDirectoryIfMissing False dir
            setCurrentDirectory dir

            writeFile "PKGBUILD" (render doc ++ "\n")

            -- print pkgname.install
            case hooks of
                Nothing -> return ()
                Just i  -> writeFile (install_hook_name (arch_pkgname pkgbuild)) i

            setCurrentDirectory _cwd

            _ <- system $ "rm -rf " ++ dir </> "{pkg,src,*.tar.gz}"
            when createTar $ do
                tarred <- myReadProcess "tar" ["-zcvvf",(dir <.> "tar.gz"), dir] []
                case tarred of
                    Left (_,s,_)  -> do
                        hPutStrLn stderr s
                        die "Unable to tar package"
                    Right _ -> putStrLn ("Created " ++ (_cwd </> dir <.> "tar.gz"))

            -- If the user created a .cabal2arch.log file, append log results there.
            mh <- getEnvMaybe "HOME"
            case mh of
                Nothing   -> return ()
                Just home -> do
                    b <- doesFileExist $ home </> ".cabal2arch.log"
                    if not b
                        then return ()
                        else do

                            -- Log to build file.
                            appendFile (home </> ".cabal2arch.log") $ (show $ (,,)
                                (arch_pkgname pkgbuild ++ "-" ++ (display $ arch_pkgver pkgbuild))
                                (arch_pkgdesc pkgbuild)
                                (arch_url pkgbuild)) ++ "\n"

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

-- | Given an abstract pkgbuild, run "makepkg -g" to compute md5
-- of source files (possibly cached locally), and modify the PkgBuild
-- accordingly.
--
getMD5 :: AnnotatedPkgBuild -> IO AnnotatedPkgBuild
getMD5 pkg = do
    putStrLn "Feeding the PKGBUILD to `makepkg -g`..."
    eres <- readProcessWithExitCode "makepkg" ["-g"] $ display pkg
    case eres of
        (ExitFailure _,_,err) -> do
            hPutStrLn stderr err
            hPutStrLn stderr $ "makepkg encountered an error while calculating MD5."
            return pkg
        (ExitSuccess,out,err) -> do
            -- s should be "md5sums=(' ... ')"
            hPutStrLn stderr err
            if "md5sums=('" `isPrefixOf` out
                then
                    let md5sum = takeWhile (\x -> x `elem` "0123456789abcdef") $ drop 10 out
                    in return pkg { pkgBody = (pkgBody pkg) { arch_md5sum = ArchList [md5sum] } }
                else do
                    hPutStrLn stderr $ "Incorrect output from makepkg."
                    return pkg

-- 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 :: String -> 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 directory path
                = Right 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

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