packages feed

cabal-rpm-0.11: src/Commands/Spec.hs

{-# LANGUAGE CPP #-}

-- |
-- Module      :  Commands.Spec
-- Copyright   :  (C) 2007-2008  Bryan O'Sullivan
--                (C) 2012-2016  Jens Petersen
--
-- Maintainer  :  Jens Petersen <petersen@fedoraproject.org>
-- Stability   :  alpha
-- Portability :  portable
--
-- Explanation: Generates an RPM spec file from a .cabal file.

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

module Commands.Spec (
  createSpecFile, createSpecFile_
  ) where

import Dependencies (notInstalled, packageDependencies, showDep,
                     testsuiteDependencies)
import Distro (Distro(..), detectDistro)
import Options (RpmFlags (..))
import PackageUtils (getPkgName, isScmDir, PackageData (..),
                     packageName, packageVersion)
import SysCmd ((+-+))

#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2))
#else
import Control.Applicative ((<$>))
#endif
import Control.Monad    (filterM, unless, void, when)
import Data.Char        (toLower, toUpper)
import Data.List        (groupBy, intercalate, intersect, isPrefixOf, isSuffixOf,
                         sort, (\\))
import Data.Maybe       (fromMaybe)
import Data.Time.Clock  (getCurrentTime)
import Data.Time.Format (formatTime)
import Data.Version     (showVersion)

import Distribution.License  (License (..))

import Distribution.Simple.Utils (notice, warn)

import Distribution.PackageDescription (BuildInfo (..), PackageDescription (..),
                                        Executable (..), FlagName (..),
                                        exeName, hasExes, hasLibs)

--import Distribution.Version (VersionRange, foldVersionRange')

import System.Directory (doesFileExist, getDirectoryContents)
import System.IO     (IOMode (..), hClose, hPutStrLn, openFile)
#if defined(MIN_VERSION_time) && MIN_VERSION_time(1,5,0)
import Data.Time.Format (defaultTimeLocale)
#else
import System.Locale (defaultTimeLocale)
#endif
import System.FilePath (dropFileName, takeBaseName, takeDirectory, (</>))

import qualified Paths_cabal_rpm (version)


defaultRelease :: FilePath -> Distro -> IO String
defaultRelease cabalPath distro = do
  let pkgDir = takeDirectory cabalPath
  scmRepo <- isScmDir pkgDir
  if scmRepo
    then do
    now <- getCurrentTime
    return $ formatTime defaultTimeLocale "0.%Y%m%d" now
    else return $ if distro == SUSE then "0" else "1"

rstrip :: (Char -> Bool) -> String -> String
rstrip p = reverse . dropWhile p . reverse

createSpecFile :: PackageData -> RpmFlags ->
                  Maybe FilePath -> IO FilePath
createSpecFile pkgdata flags mdest = do
  let mspec = specFilename pkgdata
      cabalPath = cabalFilename pkgdata
      pkgDesc = packageDesc pkgdata
      pkg = package pkgDesc
      name = packageName pkg
      verbose = rpmVerbosity flags
      hasExec = hasExes pkgDesc
      hasLib = hasLibs pkgDesc
  (pkgname, binlib) <- getPkgName mspec pkgDesc (rpmBinary flags)
  let pkg_name = if pkgname == name then "%{name}" else "%{pkg_name}"
      basename | binlib = "%{pkg_name}"
               | hasExecPkg = name
               | otherwise = "ghc-%{pkg_name}"
      specFile = fromMaybe "" mdest </> pkgname ++ ".spec"
      hasExecPkg = binlib || (hasExec && not hasLib)
  -- run commands before opening file to prevent empty file on error
  -- maybe shell commands should be in a monad or something
  (deps, tools, clibs, pkgcfgs, selfdep) <- packageDependencies (rpmStrict flags) pkgDesc
  let testsuiteDeps = testsuiteDependencies pkgDesc name
  missTestDeps <- filterM notInstalled testsuiteDeps

  specAlreadyExists <- doesFileExist specFile
  let specFile' = specFile ++ if not (rpmForce flags) && specAlreadyExists then ".cblrpm" else ""
  if specAlreadyExists
    then notice verbose $ specFile +-+ "exists:" +-+ if rpmForce flags then "forcing overwrite" else "creating" +-+ specFile'
    else do
    let realdir dir = "cblrpm." `isPrefixOf` takeBaseName dir
    when (maybe True realdir mdest) $
      putStrLn pkgname

  h <- openFile specFile' WriteMode
  let putHdr hdr val = hPutStrLn h (hdr ++ ":" ++ padding hdr ++ val)
      padding hdr = replicate (14 - length hdr) ' ' ++ " "
      putNewline = hPutStrLn h ""
      sectionNewline = putNewline >> putNewline
      put = hPutStrLn h
      putDef v s = put $ "%global" +-+ v +-+ s
      ghcPkg = if binlib then "-n ghc-%{name}" else ""
      ghcPkgDevel = if binlib then "-n ghc-%{name}-devel" else "devel"

  put $ "# generated by cabal-rpm-" ++ showVersion Paths_cabal_rpm.version
  distro <- fromMaybe detectDistro (return <$> rpmDistribution flags)
  if distro /= SUSE
    then put "# https://fedoraproject.org/wiki/Packaging:Haskell"
    else do
    now <- getCurrentTime
    let year = formatTime defaultTimeLocale "%Y" now
    put "#"
    put $ "# spec file for package " ++ pkgname
    put "#"
    put $ "# Copyright (c) " ++ year ++ " SUSE LINUX GmbH, Nuernberg, Germany."
    put "#"
    put "# All modifications and additions to the file contributed by third parties"
    put "# remain the property of their copyright owners, unless otherwise agreed"
    put "# upon. The license for this file, and modifications and additions to the"
    put "# file, is the same license as for the pristine package itself (unless the"
    put "# license for the pristine package is not an Open Source License, in which"
    put "# case the license is the MIT License). An \"Open Source License\" is a"
    put "# license that conforms to the Open Source Definition (Version 1.9)"
    put "# published by the Open Source Initiative."
    putNewline
    put "# Please submit bugfixes or comments via http://bugs.opensuse.org/"
    put "#"
  putNewline

  -- Some packages conflate the synopsis and description fields.  Ugh.
  let syn = synopsis pkgDesc
  when (null syn) $
    warn verbose "this package has no synopsis."
  let initialCapital (c:cs) = toUpper c:cs
      initialCapital [] = []
  let syn' = if null syn
             then "Haskell" +-+ name +-+ "package"
             else (unwords . lines . initialCapital) syn
  let summary = rstrip (== '.') syn'
  when (length ("Summary     : " ++ syn') > 79) $
    warn verbose "this package has a long synopsis."

  let descr = description pkgDesc
  when (null descr) $
    warn verbose "this package has no description."
  let descLines = (formatParagraphs . initialCapital . filterSymbols . finalPeriod) $ if null descr then syn' else descr
      finalPeriod cs = if last cs == '.' then cs else cs ++ "."
      filterSymbols (c:cs) =
        if c `notElem` "@\\" then c: filterSymbols cs
        else case c of
          '@' -> '\'': filterSymbols cs
          '\\' -> head cs: filterSymbols (tail cs)
          _ -> c: filterSymbols cs
      filterSymbols [] = []
  when hasLib $ do
    putDef "pkg_name" name
    putNewline

  unless (null testsuiteDeps) $ do
    put $ "%bcond_" ++ (if null missTestDeps then "without" else "with") +-+ "tests"
    putNewline

  -- let eCsources = concatMap (cSources . buildInfo) $ executables pkgDesc
  -- let lCsources = concatMap (cSources . libBuildInfo) $ maybeToList $ library pkgDesc
  -- when (null $ eCsources ++ lCsources) $ do
  --   put "# no useful debuginfo for Haskell packages without C sources"
  --   putDef "debug_package" "%{nil}"
  --   putNewline

  defRelease <- defaultRelease cabalPath distro
  let version = packageVersion pkg
      release = fromMaybe defRelease (rpmRelease flags)
      revision = show $ maybe (0::Int) read (lookup "x-revision" (customFieldsPD pkgDesc))
  putHdr "Name" (if binlib then "%{pkg_name}" else basename)
  putHdr "Version" version
  putHdr "Release" $ release ++ (if distro == SUSE then [] else "%{?dist}")
  putHdr "Summary" summary
  case distro of
    SUSE -> putHdr "Group" "Development/Languages/Other"
    RHEL5 -> putHdr "Group" (if binlib then "Development/Languages"
                            else "System Environment/Libraries")
    _ -> return ()
  putNewline
  putHdr "License" $ (showLicense distro . license) pkgDesc
  putHdr "Url" $ "https://hackage.haskell.org/package/" ++ pkg_name
  putHdr "Source0" $ "https://hackage.haskell.org/package/" ++ pkg_name ++ "-%{version}/" ++ pkg_name ++ "-%{version}.tar.gz"
  when (revision /= "0") $
    if distro == SUSE
    then putHdr "Source1" $ "https://hackage.haskell.org/package/" ++ pkg_name ++ "-%{version}/revision/" ++ revision ++ ".cabal#/" ++ pkg_name ++ ".cabal"
    else putStrLn "Warning: this is a revised .cabal file"
  case distro of
    Fedora -> return ()
    _ -> putHdr "BuildRoot" "%{_tmppath}/%{name}-%{version}-build"
  putNewline
  putHdr "BuildRequires" "ghc-Cabal-devel"
  putHdr "BuildRequires" "ghc-rpm-macros"

  let isa = if distro == SUSE then "" else "%{?_isa}"
  let alldeps = sort $ deps ++ tools ++ map (++ isa) clibs ++ pkgcfgs
  let extraTestDeps = sort $ testsuiteDeps \\ deps
  unless (null $ alldeps ++ extraTestDeps) $ do
    put "# Begin cabal-rpm deps:"
    mapM_ (putHdr "BuildRequires") alldeps
    -- for ghc < 7.8
    when (distro `notElem` [Fedora, SUSE] &&
          any (\ d -> d `elem` map showDep ["template-haskell", "hamlet"]) deps) $
      putHdr "ExclusiveArch" "%{ghc_arches_with_ghci}"
    unless (null extraTestDeps) $ do
      put "%if %{with tests}"
      mapM_ (putHdr "BuildRequires") extraTestDeps
      put "%endif"
    put "# End cabal-rpm deps"

  putNewline

  put "%description"
  mapM_ put descLines
  putNewline

  let wrapGenDesc = wordwrap (79 - max 0 (length pkgname - length pkg_name))

  when hasLib $ do
    when binlib $ do
      put $ "%package" +-+ ghcPkg
      putHdr "Summary" $ "Haskell" +-+ pkg_name +-+ "library"
      case distro of
        SUSE -> putHdr "Group" "System/Libraries"
        RHEL5 -> putHdr "Group" "System Environment/Libraries"
        _ -> return ()
      putNewline
      put $ "%description" +-+ ghcPkg
      put $ wrapGenDesc $ "This package provides the Haskell" +-+ pkg_name +-+ "shared library."
      putNewline
    put $ "%package" +-+ ghcPkgDevel
    putHdr "Summary" $ "Haskell" +-+ pkg_name +-+ "library development files"
    case distro of
      RHEL5 -> putHdr "Group" "Development/Libraries"
      SUSE -> putHdr "Group" "Development/Libraries/Other"
      _ -> return ()
    unless (distro == SUSE) $
      putHdr "Provides" $ (if binlib then "ghc-%{name}" else "%{name}") ++ "-static = %{version}-%{release}"
    putHdr "Requires" "ghc-compiler = %{ghc_version}"
    putHdr "Requires(post)" "ghc-compiler = %{ghc_version}"
    putHdr "Requires(postun)" "ghc-compiler = %{ghc_version}"
    putHdr "Requires" $ (if binlib then "ghc-%{name}" else "%{name}") ++ isa +-+ "= %{version}-%{release}"
    unless (null $ clibs ++ pkgcfgs) $ do
      put "# Begin cabal-rpm deps:"
      mapM_ (putHdr "Requires") $ sort $ map (++ isa) clibs ++ pkgcfgs ++ ["pkgconfig" | distro == SUSE, not $ null pkgcfgs]
      put "# End cabal-rpm deps"
    putNewline
    put $ "%description" +-+ ghcPkgDevel
    put $ wrapGenDesc $ "This package provides the Haskell" +-+ pkg_name +-+ "library development files."
    putNewline

  put "%prep"
  put $ "%setup -q" ++ (if pkgname /= name then " -n %{pkg_name}-%{version}" else "")
  when (distro == SUSE && revision /= "0") $
    put $ "cp -p %{SOURCE1}" +-+ pkg_name ++ ".cabal"
  sectionNewline

  put "%build"
  when (distro == SUSE && rpmConfigurationsFlags flags /= []) $ do
    let cabalFlags = [ "-f" ++ (if b then "" else "-") ++ n | (FlagName n, b) <- rpmConfigurationsFlags flags ]
    put $ "%define cabal_configure_options " ++ unwords cabalFlags
  let pkgType = if hasLib then "lib" else "bin"
  put $ "%ghc_" ++ pkgType ++ "_build"
  sectionNewline

  put "%install"
  put $ "%ghc_" ++ pkgType ++ "_install"

  when selfdep $ do
    putNewline
    put $ "%ghc_fix_rpath" +-+ "%{pkg_name}-%{version}"

  let licensefiles =
#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,20,0)
        licenseFiles pkgDesc
#else
        if null (licenseFile pkgDesc) then [] else [licenseFile pkgDesc]
#endif

  -- remove docs from datafiles (#38)
  docs <- sort <$> findDocs cabalPath licensefiles
  let datafiles = dataFiles pkgDesc
      dupdocs = docs `intersect` datafiles
  unless (null dupdocs) $ do
    putNewline
    putStrLn $ "Warning: doc files found in datadir:" +-+ unwords dupdocs
    unless (distro == SUSE) $
      put $ "rm %{buildroot}%{_datadir}/" ++ pkg_name ++ "-%{version}/" ++
        case length dupdocs of
           1 -> head dupdocs
           _ -> "{" ++ intercalate "," dupdocs ++ "}"

  sectionNewline

  unless (null testsuiteDeps) $ do
    put "%check"
    put "%cabal_test"
    sectionNewline

  when hasLib $ do
    put $ "%post" +-+ ghcPkgDevel
    put "%ghc_pkg_recache"
    sectionNewline

    put $ "%postun" +-+ ghcPkgDevel
    put "%ghc_pkg_recache"
    sectionNewline

  let license_macro = if distro == Fedora then "%license" else "%doc"
  let execs = sort $ map exeName $ filter isBuildable $ executables pkgDesc

  when hasExecPkg $ do
    put "%files"
    when (distro /= Fedora) $ put "%defattr(-,root,root,-)"
    -- Add the license file to the main package only if it wouldn't
    -- otherwise be empty.
    mapM_ (\ l -> put $ license_macro +-+ l) licensefiles
    unless (null docs) $
      put $ "%doc" +-+ unwords docs
    mapM_ (\ p -> put $ "%{_bindir}/" ++ (if p == name then "%{name}" else p)) execs
    unless (null datafiles) $
      put $ "%{_datadir}/" ++ pkg_name ++ "-%{version}"

    sectionNewline

  when hasLib $ do
    let baseFiles = if binlib then "-f ghc-%{name}.files" else "-f %{name}.files"
        develFiles = if binlib then "-f ghc-%{name}-devel.files" else "-f %{name}-devel.files"
    put $ "%files" +-+ ghcPkg +-+ baseFiles
    when (distro /= Fedora) $ put "%defattr(-,root,root,-)"
    mapM_ (\ l -> put $ license_macro +-+ l) licensefiles
    when (distro == SUSE && not binlib) $
      mapM_ (\ p -> put $ "%{_bindir}/" ++ (if p == name then "%{pkg_name}" else p)) execs
    unless (null datafiles || binlib) $
      put $ "%{_datadir}/" ++ pkg_name ++ "-%{version}"
    sectionNewline
    put $ "%files" +-+ ghcPkgDevel +-+  develFiles
    when (distro /= Fedora) $ put "%defattr(-,root,root,-)"
    unless (null docs) $
      put $ "%doc" +-+ unwords docs
    when (distro /= SUSE && not binlib) $
      mapM_ (\ p -> put $ "%{_bindir}/" ++ (if p == name then "%{pkg_name}" else p)) execs
    sectionNewline

  put "%changelog"
  unless (distro == SUSE) $ do
    now <- getCurrentTime
    let date = formatTime defaultTimeLocale "%a %b %e %Y" now
    put $ "*" +-+ date +-+ "Fedora Haskell SIG <haskell@lists.fedoraproject.org> - " ++ version ++ "-" ++ release
    put $ "- spec file generated by cabal-rpm-" ++ showVersion Paths_cabal_rpm.version
  hClose h
  return specFile'

createSpecFile_ :: PackageData -> RpmFlags ->
                   Maybe FilePath -> IO ()
createSpecFile_ pkgFiles flags mdest =
  void (createSpecFile pkgFiles flags mdest)

isBuildable :: Executable -> Bool
isBuildable exe = buildable $ buildInfo exe

findDocs :: FilePath -> [FilePath] -> IO [FilePath]
findDocs cabalPath licensefiles = do
  contents <- getDirectoryContents $ dropFileName cabalPath
  let docs = filter likely contents
  return $ if null licensefiles
           then docs
           else filter unlikely $ filter (`notElem` licensefiles) docs
  where names = ["author", "changelog", "changes", "contributors", "copying", "doc",
                 "example", "licence", "license", "news", "readme", "todo"]
        likely name = let lowerName = map toLower name
                      in any (`isPrefixOf` lowerName) names
        unlikely name = not $ any (`isSuffixOf` name) ["~"]

showLicense :: Distro -> License -> String
showLicense SUSE (GPL Nothing) = "GPL-1.0+"
showLicense _    (GPL Nothing) = "GPL+"
showLicense SUSE (GPL (Just ver)) = "GPL-" ++ showVersion ver ++ "+"
showLicense _    (GPL (Just ver)) = "GPLv" ++ showVersion ver ++ "+"
showLicense SUSE (LGPL Nothing) = "LGPL-2.0+"
showLicense _    (LGPL Nothing) = "LGPLv2+"
showLicense SUSE (LGPL (Just ver)) = "LGPL-" ++ showVersion ver ++ "+"
showLicense _    (LGPL (Just ver)) = "LGPLv" ++ [head $ showVersion ver] ++ "+"
showLicense SUSE BSD3 = "BSD-3-Clause"
showLicense _    BSD3 = "BSD"
showLicense SUSE BSD4 = "BSD-4-Clause"
showLicense _    BSD4 = "BSD"
showLicense _ MIT = "MIT"
showLicense SUSE PublicDomain = "SUSE-Public-Domain"
showLicense _    PublicDomain = "Public Domain"
showLicense SUSE AllRightsReserved = "SUSE-NonFree"
showLicense _    AllRightsReserved = "Proprietary"
showLicense _ OtherLicense = "Unknown"
showLicense _ (UnknownLicense l) = "Unknown" +-+ l
#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,16,0)
showLicense SUSE (Apache Nothing) = "Apache-2.0"
showLicense _    (Apache Nothing) = "ASL ?"
showLicense SUSE (Apache (Just ver)) = "Apache-" ++ showVersion ver
showLicense _    (Apache (Just ver)) = "ASL" +-+ showVersion ver
#endif
#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,18,0)
showLicense _ (AGPL Nothing) = "AGPLv?"
showLicense _ (AGPL (Just ver)) = "AGPLv" ++ showVersion ver
#endif
#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,20,0)
showLicense SUSE BSD2 = "BSD-2-Clause"
showLicense _ BSD2 = "BSD"
showLicense SUSE (MPL ver) = "MPL-" ++ showVersion ver
showLicense _ (MPL ver) = "MPLv" ++ showVersion ver
#endif
#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,22,0)
showLicense _ ISC = "ISC"
showLicense _ UnspecifiedLicense = "Unspecified license!"
#endif

-- http://rosettacode.org/wiki/Word_wrap#Haskell
wordwrap :: Int -> String -> String
wordwrap maxlen = wrap_ 0 False . words
  where
    wrap_ _ _ [] = "\n"
    wrap_ pos eos (w:ws)
      -- at line start: put down the word no matter what
      | pos == 0 = w ++ wrap_ (pos + lw) endp ws
      | pos + lw + 1 > maxlen - 9 && eos = '\n':wrap_ 0 endp (w:ws)
      | pos + lw + 1 > maxlen = '\n':wrap_ 0 endp (w:ws)
      | otherwise = " " ++ w ++ wrap_ (pos + lw + 1) endp ws
      where
        lw = length w
        endp = last w == '.'

formatParagraphs :: String -> [String]
formatParagraphs = map (wordwrap 79) . paragraphs . lines
  where
    -- from http://stackoverflow.com/questions/930675/functional-paragraphs
    -- using split would be: map unlines . (Data.List.Split.splitWhen null)
    paragraphs :: [String] -> [String]
    paragraphs = map (unlines . filter (not . null)) . groupBy (const $ not . null)