{- c2shs - Generate a .spec file from a cabalised source tarball
- Copyright (C) 2009 Conrad Meyer <cemeyer@u.washington.edu>
-
- This program is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
-}
import qualified Codec.Archive.Tar as Tar
import qualified Codec.Compression.GZip as GZip
import Control.Monad
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List
import Data.Time.Clock
import Data.Time.Format
import qualified Data.Version as DV
import qualified Distribution.ModuleName as DMN
import qualified Distribution.Package as DP
import qualified Distribution.PackageDescription as DPD
import Distribution.PackageDescription.Parse
import qualified Distribution.Verbosity as Verbosity
import IO
import System
import System.Console.GetOpt
import System.Directory
import System.Exit
import System.FilePath
import qualified System.Locale as SL
import qualified System.IO as IO
import qualified System.Posix.Directory as PD
import System.Posix.Files
import System.Unix.Directory
import System.Process
version = "c2shs 0.01"
data Options = Options { optPackager :: Maybe String
, stdout :: Maybe IO.Handle }
startOptions :: Options
startOptions = Options { optPackager = Nothing
, Main.stdout = Nothing }
options :: [ OptDescr (Options -> IO Options) ]
options =
[ Option "p" ["packager"]
(ReqArg
(\arg opt -> return opt { optPackager = Just arg })
"PACKAGER")
"Packager and email tag for ChangeLog"
, Option "s" ["stdout"]
(NoArg
(\opt -> return opt { Main.stdout = Just IO.stdout } ))
"Print version"
, Option "v" ["version"]
(NoArg
(\_ -> do
hPutStrLn stderr version
exitWith ExitSuccess))
"Print version"
, Option "h" ["help"]
(NoArg
(\_ -> do
prg <- getProgName
hPutStrLn stderr (usageInfo prg options)
exitWith ExitSuccess))
"Show help"
]
main :: IO ()
main = do
args <- getArgs
let (actions, nonOptions, errors) = getOpt RequireOrder options args
opts <- foldl (>>=) (return startOptions) actions
let Options { optPackager = author } = opts
let Options { Main.stdout = stdoutMaybe } = opts
authorStr <- case author of
Just str -> return str
Nothing -> do
putStrLn "No packager supplied!"
exitFailure
if (length nonOptions) /= 1
then do prg <- getProgName
hPutStrLn stderr (usageInfo prg options)
exitSuccess
else do let cabalFile = head nonOptions
if ".cabal" `isSuffixOf` cabalFile
then genSpec cabalFile authorStr stdoutMaybe
else do cabalFile <- extractCabal cabalFile
genSpec cabalFile authorStr stdoutMaybe
-- Used to be in tar, but now we had to recreate it
extractTarData :: FilePath -> B.ByteString -> IO ()
extractTarData dir bytes = Tar.unpack dir . Tar.read =<< return bytes
extractCabal :: FilePath -> IO FilePath
extractCabal file = do
fileContents <- B.readFile file
let tarContents = GZip.decompress fileContents
cwd <- getCurrentDirectory
tmpdir <- getTemporaryDirectory
PD.changeWorkingDirectory tmpdir
-- make temporary working directory
dirname <- mkdtemp "c2shs-XXXXXX"
PD.changeWorkingDirectory dirname
extractTarData "." tarContents
dirContents <- getDirectoryContents "."
let normalFiles = filter (\x -> and [x /= ".", x /= ".."]) dirContents
PD.changeWorkingDirectory (head normalFiles)
subdirContents <- getDirectoryContents "."
cabalFile <- canonicalizePath $ head (filter (\x -> ".cabal" `isSuffixOf` x) subdirContents)
PD.changeWorkingDirectory cwd
return $ cabalFile
genSpec :: FilePath -> String -> Maybe IO.Handle -> IO ()
genSpec cabalFile author stdoutMaybe = do
pd <- readPackageDescription Verbosity.normal cabalFile
processCabal pd author stdoutMaybe
licenseTab :: [(String,String)]
licenseTab = [("BSD3", "BSD")
,("BSD4", "BSD")
,("PublicDomain", "Public Domain")
]
licenseLookup :: String -> String
licenseLookup str = licenseLookupHelper str licenseTab
licenseLookupHelper :: String -> [(String,String)] -> String
licenseLookupHelper str [] = str
licenseLookupHelper str ((key,x) : xs) | str == key = x
| otherwise = licenseLookupHelper str xs
processCabal :: DPD.GenericPackageDescription -> String -> Maybe IO.Handle -> IO ()
processCabal gpd author stdoutMaybe = do
let pd = DPD.packageDescription gpd
let pflags = DPD.genPackageFlags gpd
let lib = DPD.condLibrary gpd
let exe = DPD.condExecutables gpd
let copy = DPD.copyright pd
let licenseTmp = licenseLookup (show (DPD.license pd))
license <- if or [licenseTmp == "GPL", licenseTmp == "LGPL"]
then licenseLookupFile licenseTmp (DPD.licenseFile pd)
else return licenseTmp
let pkgid = DPD.package pd
let DP.PackageName pkgname = DP.pkgName pkgid
let pkgversion = DP.pkgVersion pkgid
let pkgversionlist = (DV.versionBranch pkgversion)
let pkgversionstr = foldl (\s i -> s ++ "." ++ (show i)) (show (head pkgversionlist)) (tail pkgversionlist)
let urlTmp = DPD.homepage pd
let url = if null urlTmp
then "http://hackage.haskell.org/cgi-bin/hackage-scripts/package/" ++ pkgname
else urlTmp
--let pkgurl = DPD.pkgUrl pd -- nothing uses these
{- we print in a separate action
putStr "Name: "
print pkgname
putStr "Version: "
print pkgversionstr
-}
--print (DV.versionTags pkgversion) -- nothing uses these
{- we print in a separate action
putStr "License: "
print license
putStr "URL: "
print url
-}
let summary = DPD.synopsis pd
{- we print in a separate action
putStr "Summary: "
print summary
-}
let description = DPD.description pd
{- we print in a separate action
putStrLn "\n%description"
putStrLn description
putStrLn ""
-}
--print (DPD.category pd) -- not useful, I think
let builddeps = map (\d -> let DP.Dependency (DP.PackageName s) _ = d in s) (DPD.buildDepends pd)
{- we print in a separate action
putStr "Build-Depends: "
print builddeps
-}
--putStr "Librar(y|ies): "
--print lib
--putStr "Executable(s): "
--print exe
let has_lib = case (DPD.condLibrary gpd) of
Nothing -> False
Just _ -> True
let has_bin = not (null (DPD.condExecutables gpd))
--putStrLn $ "HAS_LIB: " ++ (show has_lib)
--putStrLn $ "HAS_BIN: " ++ (show has_bin)
stdout <- maybe (IO.openFile ((if has_lib && not has_bin then "ghc-" else "") ++ pkgname `replaceExtension` ".spec") IO.WriteMode) return stdoutMaybe
if has_lib
then if has_bin
then renderBinLib stdout author pkgname pkgversionstr summary description builddeps url license
else renderLib stdout author pkgname pkgversionstr summary description builddeps url license
else if has_bin
then renderBin stdout author pkgname pkgversionstr summary description builddeps url license
else do
putStrLn "Error: pkg is neither a library nor binary!"
exitFailure
IO.hClose stdout
licenseLookupFile :: String -> FilePath -> IO String
licenseLookupFile guess fn = do
contents <- readFile fn
{-
Haskell packages rarely include licensing information inside their
source files, so the best picture we can get is to use the LICENSE /
COPYING files and guess the closest version (for things that need a
specific version, i.e. LGPL and GPL).
If GPL and no other information is present, return GPL+.
If LGPL and no other info is present, return LGPLv2+.
-}
let contains x = x `isInfixOf` contents
let license = licenseLookupFileHelper contains
if license == "None"
then if guess == "LGPL"
then return "LGPLv2+"
else return "GPL+"
else if guess == "LGPL"
then return ('L' : license)
else return license
licenseLookupFileHelper :: (String -> Bool) -> String
licenseLookupFileHelper contains
| contains "Version 1, February 1989" = "GPLv1"
| contains "Version 2, June 1991" = "GPLv2"
| contains "Version 3, 29 June 2007" = "GPLv3"
| contains "Version 2.1, February 1999" = "GPLv2"
| contains
"version 2.1 of the License, or (at your option) any later version." =
"GPLv2+"
| and [contains "either version 2"
,contains "or (at your option) any later version."] =
"GPLv2+"
| and [contains "either version 1, or"
,contains "any later version."] =
"GPL+"
| and [contains "either version 3 of the License"
,contains "any later version."] =
"GPLv3+"
| otherwise = "None"
replaceString :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString
replaceString str old new
| B.null str = B.empty
| otherwise = if old `B.isPrefixOf` str
then B.append new (replaceString (B.drop (B.length old) str) old new)
else B.cons (B.head str) (replaceString (B.tail str) old new)
replaceStringT :: B.ByteString -> (B.ByteString, B.ByteString) -> B.ByteString
replaceStringT str (old, new) = replaceString str old new
replaceStrings :: B.ByteString -> [(B.ByteString, B.ByteString)] -> B.ByteString
replaceStrings str oldnews = foldl replaceStringT str oldnews
packStrings :: [(String, String)] -> [(B.ByteString, B.ByteString)]
packStrings = map (\(x, y) -> (C.pack x, C.pack y))
fixDescription :: String -> String
fixDescription description =
if null description
then "This package provides the Haskell %{pkg_name} library/nbuilt for ghc-%{ghc_version}."
else description
replacements :: String -> String -> String -> String -> String -> [String] -> String -> String -> [(String, String)]
replacements author pkgname pkgversionstr summary description builddeps url license =
[ ("@AUTHOR@", author)
, ("@PACKAGE@", pkgname)
, ("@VERSION@", pkgversionstr)
, ("@SUMMARY@", summary)
, ("@DESCRIPTION@", description)
, ("@URL@", url)
, ("@LICENSE@", license)]
replacementsAndDate :: [(String, String)] -> IO [(String, String)]
replacementsAndDate replacement =
do date <- getCurrentTime
return $ ("@DATE@", (formatTime SL.defaultTimeLocale "%a %b %e %Y" date)):replacement
replacementsAndGhcVersion :: [(String, String)] -> IO [(String, String)]
replacementsAndGhcVersion replacement =
do ghcversion <- readProcess "ghc" ["--numeric-version"] ""
return $ ("@GHC_VERSION@", ghcversion):replacement
renderTemplate :: FilePath -> Handle -> String -> String -> String -> String -> String -> [String] -> String -> String -> IO ()
renderTemplate fp stdout author pkgname pkgversionstr summary description builddeps url license =
do template <- B.readFile fp
let desc = fixDescription description
reps <- replacementsAndDate $ replacements author pkgname pkgversionstr summary desc builddeps url license
reps <- replacementsAndGhcVersion reps
B.hPut stdout $ replaceStrings template $ packStrings reps
return ()
renderBin :: Handle -> String -> String -> String -> String -> String -> [String] -> String -> String -> IO ()
renderBin = renderTemplate "/etc/rpmdevtools/spectemplate-ghc-bin.spec"
renderLib :: Handle -> String -> String -> String -> String -> String -> [String] -> String -> String -> IO ()
renderLib = renderTemplate "/etc/rpmdevtools/spectemplate-ghc-lib.spec"
renderBinLib :: Handle -> String -> String -> String -> String -> String -> [String] -> String -> String -> IO ()
renderBinLib = renderTemplate "/etc/rpmdevtools/spectemplate-ghc-lib.spec"