module Cabal2Spec ( cabal2spec, createSpecFile, ForceBinary, RunTests, CopyrightYear ) where

import Control.Monad
import Data.Char
import Data.List ( delete, nub, sort, (\\), inits, intersect, isPrefixOf, groupBy )
import Data.Time.Clock
import Data.Time.Format
import Distribution.Compiler
import Distribution.License
import Distribution.Package
import Distribution.PackageDescription
import Distribution.PackageDescription.Configuration
import Distribution.PackageDescription.Parsec
import Distribution.Pretty
import Distribution.System
import Distribution.Text
import Distribution.Utils.Path ( getSymbolicPath )
import Distribution.Types.ComponentRequestedSpec
import Distribution.Utils.ShortText ( fromShortText )
import Distribution.Verbosity
import Distribution.Version
import System.FilePath
import System.IO

type ForceBinary = Bool
type RunTests = Bool
type CopyrightYear = Int

cabal2spec :: Platform -> CompilerId -> FlagAssignment -> ForceBinary -> RunTests -> Maybe CopyrightYear
           -> FilePath -> FilePath -> IO ()
cabal2spec :: Platform
-> CompilerId
-> FlagAssignment
-> ForceBinary
-> ForceBinary
-> Maybe CopyrightYear
-> FilePath
-> FilePath
-> IO ()
cabal2spec Platform
platform CompilerId
compilerId FlagAssignment
flags ForceBinary
forceBinary ForceBinary
runTests Maybe CopyrightYear
copyrightYear FilePath
cabalFile FilePath
specFile = do
  GenericPackageDescription
gpd <- Verbosity -> FilePath -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
silent FilePath
cabalFile
  case FlagAssignment
-> ComponentRequestedSpec
-> (Dependency -> ForceBinary)
-> Platform
-> CompilerInfo
-> [PackageVersionConstraint]
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
finalizePD FlagAssignment
flags ComponentRequestedSpec
requestedComponents (ForceBinary -> Dependency -> ForceBinary
forall a b. a -> b -> a
const ForceBinary
True) Platform
platform (CompilerId -> AbiTag -> CompilerInfo
unknownCompilerInfo CompilerId
compilerId AbiTag
NoAbiTag) [] GenericPackageDescription
gpd of
    Left [Dependency]
missing -> FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"finalizePD: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Dependency] -> FilePath
forall a. Show a => a -> FilePath
show [Dependency]
missing)
    Right (PackageDescription
pd,FlagAssignment
_) -> FilePath
-> PackageDescription
-> ForceBinary
-> ForceBinary
-> FlagAssignment
-> Maybe CopyrightYear
-> IO ()
createSpecFile FilePath
specFile PackageDescription
pd ForceBinary
forceBinary ForceBinary
runTests FlagAssignment
flags Maybe CopyrightYear
copyrightYear

requestedComponents :: ComponentRequestedSpec
requestedComponents :: ComponentRequestedSpec
requestedComponents = ComponentRequestedSpec
defaultComponentRequestedSpec

showPkgCfg :: String -> String
showPkgCfg :: FilePath -> FilePath
showPkgCfg FilePath
p = FilePath
"pkgconfig(" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
p FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"

mkTools :: [String] -> [String]
mkTools :: [FilePath] -> [FilePath]
mkTools [FilePath]
tools' = (FilePath -> ForceBinary) -> [FilePath] -> [FilePath]
forall a. (a -> ForceBinary) -> [a] -> [a]
filter FilePath -> ForceBinary
excludedTools ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
mapTools [FilePath]
tools'
  where
    excludedTools :: FilePath -> ForceBinary
excludedTools FilePath
n = FilePath
n FilePath -> [FilePath] -> ForceBinary
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> ForceBinary
`notElem` [FilePath
"ghc", FilePath
"hsc2hs", FilePath
"perl"]
    mapTools :: FilePath -> FilePath
mapTools FilePath
"gtk2hsC2hs" = FilePath
"gtk2hs-buildtools"
    mapTools FilePath
"gtk2hsHookGenerator" = FilePath
"gtk2hs-buildtools"
    mapTools FilePath
"gtk2hsTypeGen" = FilePath
"gtk2hs-buildtools"
    mapTools FilePath
tool = FilePath
tool

createSpecFile :: FilePath -> PackageDescription -> ForceBinary -> RunTests -> FlagAssignment -> Maybe CopyrightYear -> IO ()
createSpecFile :: FilePath
-> PackageDescription
-> ForceBinary
-> ForceBinary
-> FlagAssignment
-> Maybe CopyrightYear
-> IO ()
createSpecFile FilePath
specFile PackageDescription
pkgDesc ForceBinary
forceBinary ForceBinary
runTests FlagAssignment
flagAssignment Maybe CopyrightYear
copyrightYear = do
  let deps :: [String]
      deps :: [FilePath]
deps = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
showDep [FilePath]
deps'
      deps' :: [String]
      selfdep :: Bool
      ([FilePath]
deps', ForceBinary
selfdep) = PackageDescription -> FilePath -> ([FilePath], ForceBinary)
buildDependencies PackageDescription
pkgDesc FilePath
name
      pkgcfgs :: [String]
      pkgcfgs :: [FilePath]
pkgcfgs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
showPkgCfg ([FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (PkgconfigDependency -> FilePath)
-> [PkgconfigDependency] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map PkgconfigDependency -> FilePath
forall a. IsDependency a => a -> FilePath
depName ([PkgconfigDependency] -> [FilePath])
-> [PkgconfigDependency] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (BuildInfo -> [PkgconfigDependency])
-> [BuildInfo] -> [PkgconfigDependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [PkgconfigDependency]
pkgconfigDepends [BuildInfo]
buildinfo)
      buildinfo :: [BuildInfo]
      buildinfo :: [BuildInfo]
buildinfo = PackageDescription -> ComponentRequestedSpec -> [BuildInfo]
enabledBuildInfos PackageDescription
pkgDesc ComponentRequestedSpec
requestedComponents
      tools :: [String]
      tools :: [FilePath]
tools = [FilePath] -> [FilePath]
mkTools ([FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (LegacyExeDependency -> FilePath)
-> [LegacyExeDependency] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map LegacyExeDependency -> FilePath
forall a. IsDependency a => a -> FilePath
depName ((BuildInfo -> [LegacyExeDependency])
-> [BuildInfo] -> [LegacyExeDependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [LegacyExeDependency]
buildTools [BuildInfo]
buildinfo)) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
chrpath
      clibs :: [String]
      clibs :: [FilePath]
clibs = [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
resolveLib ((BuildInfo -> [FilePath]) -> [BuildInfo] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [FilePath]
extraLibs [BuildInfo]
buildinfo))
      chrpath :: [String]
      chrpath :: [FilePath]
chrpath = [FilePath
"chrpath" | ForceBinary
selfdep]

      pkg :: PackageIdentifier
pkg = PackageDescription -> PackageIdentifier
package PackageDescription
pkgDesc
      name :: FilePath
name = PackageName -> FilePath
unPackageName (PackageIdentifier -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
pkg)
      hasExec :: ForceBinary
hasExec = PackageDescription -> ForceBinary
hasExes PackageDescription
pkgDesc
      hasLib :: ForceBinary
hasLib = PackageDescription -> ForceBinary
hasLibs PackageDescription
pkgDesc
      hasSubLib :: ForceBinary
hasSubLib = ForceBinary -> ForceBinary
not ([Library] -> ForceBinary
forall (t :: * -> *) a. Foldable t => t a -> ForceBinary
null (PackageDescription -> [Library]
subLibraries PackageDescription
pkgDesc))
      hasPublicModules :: ForceBinary
hasPublicModules = ForceBinary
-> (Library -> ForceBinary) -> Maybe Library -> ForceBinary
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ForceBinary
False (ForceBinary -> ForceBinary
not (ForceBinary -> ForceBinary)
-> (Library -> ForceBinary) -> Library -> ForceBinary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModuleName] -> ForceBinary
forall (t :: * -> *) a. Foldable t => t a -> ForceBinary
null ([ModuleName] -> ForceBinary)
-> (Library -> [ModuleName]) -> Library -> ForceBinary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> [ModuleName]
exposedModules) (PackageDescription -> Maybe Library
library PackageDescription
pkgDesc)
  (FilePath
pkgname, ForceBinary
binlib) <- Maybe FilePath
-> PackageDescription -> ForceBinary -> IO (FilePath, ForceBinary)
getPkgName (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
specFile) PackageDescription
pkgDesc ForceBinary
forceBinary

  let pkg_name :: FilePath
pkg_name = if FilePath
pkgname FilePath -> FilePath -> ForceBinary
forall a. Eq a => a -> a -> ForceBinary
== FilePath
name then FilePath
"%{name}" else FilePath
"%{pkg_name}"
      basename :: FilePath
basename | ForceBinary
binlib = FilePath
"%{pkg_name}"
               | ForceBinary
hasExecPkg = FilePath
name
               | ForceBinary
otherwise = FilePath
"ghc-%{pkg_name}"

      hasExecPkg :: ForceBinary
hasExecPkg = ForceBinary
binlib ForceBinary -> ForceBinary -> ForceBinary
|| (ForceBinary
hasExec ForceBinary -> ForceBinary -> ForceBinary
&& ForceBinary -> ForceBinary
not ForceBinary
hasLib)
  -- run commands before opening file to prevent empty file on error
  -- maybe shell commands should be in a monad or something

      testsuiteDeps :: [FilePath]
testsuiteDeps = PackageDescription -> FilePath -> [FilePath]
testsuiteDependencies PackageDescription
pkgDesc FilePath
name

  Handle
h <- FilePath -> IOMode -> IO Handle
openFile FilePath
specFile IOMode
WriteMode
  let putHdr :: FilePath -> FilePath -> IO ()
putHdr FilePath
hdr FilePath
val = Handle -> FilePath -> IO ()
hPutStrLn Handle
h (FilePath
hdr FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall (t :: * -> *) a. Foldable t => t a -> FilePath
padding FilePath
hdr FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
val)
      padding :: t a -> FilePath
padding t a
hdr = CopyrightYear -> Char -> FilePath
forall a. CopyrightYear -> a -> [a]
replicate (CopyrightYear
14 CopyrightYear -> CopyrightYear -> CopyrightYear
forall a. Num a => a -> a -> a
- t a -> CopyrightYear
forall (t :: * -> *) a. Foldable t => t a -> CopyrightYear
length t a
hdr) Char
' ' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" "
      putNewline :: IO ()
putNewline = Handle -> FilePath -> IO ()
hPutStrLn Handle
h FilePath
""
      put :: FilePath -> IO ()
put = Handle -> FilePath -> IO ()
hPutStrLn Handle
h
      putDef :: FilePath -> FilePath -> IO ()
putDef FilePath
v FilePath
s = FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"%global" FilePath -> FilePath -> FilePath
+-+ FilePath
v FilePath -> FilePath -> FilePath
+-+ FilePath
s
      ghcPkg :: FilePath
ghcPkg = if ForceBinary
binlib then FilePath
"-n ghc-%{name}" else FilePath
""
      ghcPkgDevel :: FilePath
ghcPkgDevel = if ForceBinary
binlib then FilePath
"-n ghc-%{name}-devel" else FilePath
"devel"

  do
    FilePath
year <- case Maybe CopyrightYear
copyrightYear of
              Just CopyrightYear
y -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (CopyrightYear -> FilePath
forall a. Show a => a -> FilePath
show CopyrightYear
y)
              Maybe CopyrightYear
Nothing -> TimeLocale -> FilePath -> UTCTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"%Y" (UTCTime -> FilePath) -> IO UTCTime -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
    FilePath -> IO ()
put FilePath
"#"
    FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"# spec file for package " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pkgname
    FilePath -> IO ()
put FilePath
"#"
    FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"# Copyright (c) " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
year FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" SUSE LLC"
    FilePath -> IO ()
put FilePath
"#"
    FilePath -> IO ()
put FilePath
"# All modifications and additions to the file contributed by third parties"
    FilePath -> IO ()
put FilePath
"# remain the property of their copyright owners, unless otherwise agreed"
    FilePath -> IO ()
put FilePath
"# upon. The license for this file, and modifications and additions to the"
    FilePath -> IO ()
put FilePath
"# file, is the same license as for the pristine package itself (unless the"
    FilePath -> IO ()
put FilePath
"# license for the pristine package is not an Open Source License, in which"
    FilePath -> IO ()
put FilePath
"# case the license is the MIT License). An \"Open Source License\" is a"
    FilePath -> IO ()
put FilePath
"# license that conforms to the Open Source Definition (Version 1.9)"
    FilePath -> IO ()
put FilePath
"# published by the Open Source Initiative."
    IO ()
putNewline
    FilePath -> IO ()
put FilePath
"# Please submit bugfixes or comments via https://bugs.opensuse.org/"
    FilePath -> IO ()
put FilePath
"#"
  IO ()
putNewline
  IO ()
putNewline

  -- Some packages conflate the synopsis and description fields.  Ugh.
  let syn :: FilePath
syn = ShortText -> FilePath
fromShortText (PackageDescription -> ShortText
synopsis PackageDescription
pkgDesc)
  let initialCapital :: FilePath -> FilePath
initialCapital (Char
c:FilePath
cs) = Char -> Char
toUpper Char
cChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
cs
      initialCapital [] = []
  let syn' :: FilePath
syn' = if FilePath -> ForceBinary
badDescription FilePath
syn then FilePath
"FIXME" else ([FilePath] -> FilePath
unwords ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines (FilePath -> [FilePath])
-> (FilePath -> FilePath) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
initialCapital) FilePath
syn
  let summary :: FilePath
summary = (Char -> ForceBinary) -> FilePath -> FilePath
rstrip (Char -> Char -> ForceBinary
forall a. Eq a => a -> a -> ForceBinary
== Char
'.') (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ForceBinary) -> FilePath -> FilePath
rstrip Char -> ForceBinary
isSpace (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
syn'
  let descr :: FilePath
descr = (Char -> ForceBinary) -> FilePath -> FilePath
rstrip Char -> ForceBinary
isSpace (ShortText -> FilePath
fromShortText (PackageDescription -> ShortText
description PackageDescription
pkgDesc))
  let descLines :: [FilePath]
descLines = (FilePath -> [FilePath]
formatParagraphs (FilePath -> [FilePath])
-> (FilePath -> FilePath) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
initialCapital (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
filterSymbols (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
finalPeriod) (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ if FilePath -> ForceBinary
badDescription FilePath
descr then FilePath
syn' else FilePath
descr
      finalPeriod :: FilePath -> FilePath
finalPeriod FilePath
cs = if FilePath -> Char
forall a. [a] -> a
last FilePath
cs Char -> Char -> ForceBinary
forall a. Eq a => a -> a -> ForceBinary
== Char
'.' then FilePath
cs else FilePath
cs FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"."
      filterSymbols :: FilePath -> FilePath
filterSymbols (Char
c:FilePath
cs) =
        if Char
c Char -> FilePath -> ForceBinary
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> ForceBinary
`notElem` FilePath
"@\\" then Char
cChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
filterSymbols FilePath
cs
        else case Char
c of
          Char
'@' -> Char
'\''Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
filterSymbols FilePath
cs
          Char
'\\' -> FilePath -> Char
forall a. [a] -> a
head FilePath
csChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
filterSymbols (FilePath -> FilePath
forall a. [a] -> [a]
tail FilePath
cs)
          Char
_ -> Char
cChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
filterSymbols FilePath
cs
      filterSymbols [] = []
  ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
when ForceBinary
hasLib (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    FilePath -> FilePath -> IO ()
putDef FilePath
"pkg_name" FilePath
name

  ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
when ForceBinary
hasSubLib (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    FilePath -> FilePath -> IO ()
putDef FilePath
"has_internal_sub_libraries" FilePath
"1"

  ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
unless ([FilePath] -> ForceBinary
forall (t :: * -> *) a. Foldable t => t a -> ForceBinary
null [FilePath]
testsuiteDeps) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    if ForceBinary
runTests
       then FilePath -> IO ()
put FilePath
"%bcond_without tests"
       else FilePath -> IO ()
put FilePath
"%bcond_with tests"

  let version :: Version
version = PackageIdentifier -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageIdentifier
pkg
      revision :: FilePath
revision = CopyrightYear -> FilePath
forall a. Show a => a -> FilePath
show (CopyrightYear -> FilePath) -> CopyrightYear -> FilePath
forall a b. (a -> b) -> a -> b
$ CopyrightYear
-> (FilePath -> CopyrightYear) -> Maybe FilePath -> CopyrightYear
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CopyrightYear
0::Int) FilePath -> CopyrightYear
forall a. Read a => FilePath -> a
read (FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
"x-revision" (PackageDescription -> [(FilePath, FilePath)]
customFieldsPD PackageDescription
pkgDesc))
  FilePath -> FilePath -> IO ()
putHdr FilePath
"Name" (if ForceBinary
binlib then FilePath
"%{pkg_name}" else FilePath
basename)
  FilePath -> FilePath -> IO ()
putHdr FilePath
"Version" (Version -> FilePath
forall a. Pretty a => a -> FilePath
display Version
version)
  FilePath -> FilePath -> IO ()
putHdr FilePath
"Release" FilePath
"0"
  FilePath -> FilePath -> IO ()
putHdr FilePath
"Summary" FilePath
summary
  FilePath -> FilePath -> IO ()
putHdr FilePath
"License" (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ (License -> FilePath)
-> (License -> FilePath) -> Either License License -> FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Doc -> FilePath
forall a. Show a => a -> FilePath
show (Doc -> FilePath) -> (License -> Doc) -> License -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. License -> Doc
forall a. Pretty a => a -> Doc
pretty) License -> FilePath
showLicense (PackageDescription -> Either License License
licenseRaw PackageDescription
pkgDesc)
  FilePath -> FilePath -> IO ()
putHdr FilePath
"URL" (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"https://hackage.haskell.org/package/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pkg_name
  FilePath -> FilePath -> IO ()
putHdr FilePath
"Source0" (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"https://hackage.haskell.org/package/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pkg_name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-%{version}/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pkg_name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-%{version}.tar.gz"
  ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
when (FilePath
revision FilePath -> FilePath -> ForceBinary
forall a. Eq a => a -> a -> ForceBinary
/= FilePath
"0") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    FilePath -> FilePath -> IO ()
putHdr FilePath
"Source1" (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"https://hackage.haskell.org/package/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pkg_name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-%{version}/revision/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
revision FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".cabal#/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pkg_name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".cabal"
  FilePath -> FilePath -> IO ()
putHdr FilePath
"ExcludeArch" FilePath
"%{ix86}"

  let fixedDeps :: [FilePath]
fixedDeps = [FilePath
"ghc-Cabal-devel", FilePath
"ghc-rpm-macros"]
  let alldeps :: [FilePath]
alldeps = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
fixedDeps [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
deps [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
tools [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
clibs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkgcfgs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"pkgconfig" | ForceBinary -> ForceBinary
not ([FilePath] -> ForceBinary
forall (t :: * -> *) a. Foldable t => t a -> ForceBinary
null [FilePath]
pkgcfgs)]
  let extraTestDeps :: [FilePath]
extraTestDeps = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
testsuiteDeps [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
deps
  ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
unless ([FilePath] -> ForceBinary
forall (t :: * -> *) a. Foldable t => t a -> ForceBinary
null ([FilePath] -> ForceBinary) -> [FilePath] -> ForceBinary
forall a b. (a -> b) -> a -> b
$ [FilePath]
alldeps [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
extraTestDeps) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> FilePath -> IO ()
putHdr FilePath
"BuildRequires") [FilePath]
alldeps
    ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
unless ([FilePath] -> ForceBinary
forall (t :: * -> *) a. Foldable t => t a -> ForceBinary
null [FilePath]
extraTestDeps) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      FilePath -> IO ()
put FilePath
"%if %{with tests}"
      (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> FilePath -> IO ()
putHdr FilePath
"BuildRequires") [FilePath]
extraTestDeps
      FilePath -> IO ()
put FilePath
"%endif"

  IO ()
putNewline

  FilePath -> IO ()
put FilePath
"%description"
  (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
put [FilePath]
descLines

  let wrapGenDesc :: FilePath -> FilePath
wrapGenDesc = CopyrightYear -> FilePath -> FilePath
wordwrap (CopyrightYear
79 CopyrightYear -> CopyrightYear -> CopyrightYear
forall a. Num a => a -> a -> a
- CopyrightYear -> CopyrightYear -> CopyrightYear
forall a. Ord a => a -> a -> a
max CopyrightYear
0 (FilePath -> CopyrightYear
forall (t :: * -> *) a. Foldable t => t a -> CopyrightYear
length FilePath
pkgname CopyrightYear -> CopyrightYear -> CopyrightYear
forall a. Num a => a -> a -> a
- FilePath -> CopyrightYear
forall (t :: * -> *) a. Foldable t => t a -> CopyrightYear
length FilePath
pkg_name))

  ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
when ForceBinary
hasLib (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
when ForceBinary
binlib (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"%package" FilePath -> FilePath -> FilePath
+-+ FilePath
ghcPkg
      FilePath -> FilePath -> IO ()
putHdr FilePath
"Summary" (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Haskell" FilePath -> FilePath -> FilePath
+-+ FilePath
pkg_name FilePath -> FilePath -> FilePath
+-+ FilePath
"library"
      IO ()
putNewline
      FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"%description" FilePath -> FilePath -> FilePath
+-+ FilePath
ghcPkg
      FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
wrapGenDesc (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"This package provides the Haskell" FilePath -> FilePath -> FilePath
+-+ FilePath
pkg_name FilePath -> FilePath -> FilePath
+-+ FilePath
"shared library."
    FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"%package" FilePath -> FilePath -> FilePath
+-+ FilePath
ghcPkgDevel
    FilePath -> FilePath -> IO ()
putHdr FilePath
"Summary" (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Haskell" FilePath -> FilePath -> FilePath
+-+ FilePath
pkg_name FilePath -> FilePath -> FilePath
+-+ FilePath
"library development files"
    FilePath -> FilePath -> IO ()
putHdr FilePath
"Requires" (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ (if ForceBinary
binlib then FilePath
"ghc-%{name}" else FilePath
"%{name}") FilePath -> FilePath -> FilePath
+-+ FilePath
"= %{version}-%{release}"
    FilePath -> FilePath -> IO ()
putHdr FilePath
"Requires" FilePath
"ghc-compiler = %{ghc_version}"
    ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
unless ([FilePath] -> ForceBinary
forall (t :: * -> *) a. Foldable t => t a -> ForceBinary
null ([FilePath] -> ForceBinary) -> [FilePath] -> ForceBinary
forall a b. (a -> b) -> a -> b
$ [FilePath]
clibs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkgcfgs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> FilePath -> IO ()
putHdr FilePath
"Requires") ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath]
clibs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkgcfgs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"pkgconfig" | ForceBinary -> ForceBinary
not ([FilePath] -> ForceBinary
forall (t :: * -> *) a. Foldable t => t a -> ForceBinary
null [FilePath]
pkgcfgs)])
    FilePath -> FilePath -> IO ()
putHdr FilePath
"Requires(post)" FilePath
"ghc-compiler = %{ghc_version}"
    FilePath -> FilePath -> IO ()
putHdr FilePath
"Requires(postun)" FilePath
"ghc-compiler = %{ghc_version}"
    IO ()
putNewline
    FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"%description" FilePath -> FilePath -> FilePath
+-+ FilePath
ghcPkgDevel
    FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
wrapGenDesc (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"This package provides the Haskell" FilePath -> FilePath -> FilePath
+-+ FilePath
pkg_name FilePath -> FilePath -> FilePath
+-+ FilePath
"library development files."

  FilePath -> IO ()
put FilePath
"%prep"
  FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"%autosetup" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (if FilePath
pkgname FilePath -> FilePath -> ForceBinary
forall a. Eq a => a -> a -> ForceBinary
/= FilePath
name then FilePath
" -n %{pkg_name}-%{version}" else FilePath
"")
  ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
when (FilePath
revision FilePath -> FilePath -> ForceBinary
forall a. Eq a => a -> a -> ForceBinary
/= FilePath
"0") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"cp -p %{SOURCE1}" FilePath -> FilePath -> FilePath
+-+ FilePath
pkg_name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".cabal"
  IO ()
putNewline

  FilePath -> IO ()
put FilePath
"%build"
  ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
when (FlagAssignment
flagAssignment FlagAssignment -> FlagAssignment -> ForceBinary
forall a. Eq a => a -> a -> ForceBinary
/= FlagAssignment
forall a. Monoid a => a
mempty) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let cabalFlags :: [FilePath]
cabalFlags = [ FilePath
"-f" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (if ForceBinary
b then FilePath
"" else FilePath
"-") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FlagName -> FilePath
unFlagName FlagName
n | (FlagName
n, ForceBinary
b) <- FlagAssignment -> [(FlagName, ForceBinary)]
unFlagAssignment FlagAssignment
flagAssignment ]
    FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"%define cabal_configure_options " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
cabalFlags)
  let pkgType :: FilePath
pkgType = if ForceBinary
hasLib then FilePath
"lib" else FilePath
"bin"
      noHaddockModifier :: FilePath
noHaddockModifier = if ForceBinary
hasSubLib ForceBinary -> ForceBinary -> ForceBinary
|| (ForceBinary
hasLib ForceBinary -> ForceBinary -> ForceBinary
&& ForceBinary -> ForceBinary
not ForceBinary
hasPublicModules) then FilePath
"_without_haddock" else FilePath
""
  FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"%ghc_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pkgType FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_build" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
noHaddockModifier -- https://github.com/haskell/cabal/issues/4969
  IO ()
putNewline

  FilePath -> IO ()
put FilePath
"%install"
  FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"%ghc_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pkgType FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_install"

  ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
when ForceBinary
selfdep (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"%ghc_fix_rpath" FilePath -> FilePath -> FilePath
+-+ FilePath
"%{pkg_name}-%{version}"

  -- TODO: getSymbolicPath should not be used like this
  let licensefiles :: [FilePath]
licensefiles = (SymbolicPath PackageDir LicenseFile -> FilePath)
-> [SymbolicPath PackageDir LicenseFile] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir LicenseFile -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath (PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles PackageDescription
pkgDesc)

  -- remove docs from datafiles (#38)
  [FilePath]
docsUnfiltered <- ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath] -> IO [FilePath]
findDocs (PackageDescription -> [FilePath]
extraSrcFiles PackageDescription
pkgDesc [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ PackageDescription -> [FilePath]
extraDocFiles PackageDescription
pkgDesc) [FilePath]
licensefiles)
  let datafiles :: [FilePath]
datafiles = PackageDescription -> [FilePath]
dataFiles PackageDescription
pkgDesc
      dupdocs :: [FilePath]
dupdocs   = [FilePath]
docsUnfiltered [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [FilePath]
datafiles
      docs :: [FilePath]
docs      = [FilePath]
docsUnfiltered [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
datafiles
  ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
unless ([FilePath] -> ForceBinary
forall (t :: * -> *) a. Foldable t => t a -> ForceBinary
null [FilePath]
dupdocs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    -- TODO: What does this warning accomplish?
    FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"*** " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pkgname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": doc files found in datadir:" FilePath -> FilePath -> FilePath
+-+ [FilePath] -> FilePath
unwords ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
dupdocs)
  IO ()
putNewline

  ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
unless ([FilePath] -> ForceBinary
forall (t :: * -> *) a. Foldable t => t a -> ForceBinary
null [FilePath]
testsuiteDeps) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath -> IO ()
put FilePath
"%check"
    FilePath -> IO ()
put FilePath
"%cabal_test"
    IO ()
putNewline

  ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
when ForceBinary
hasLib (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let putInstallScript :: IO ()
putInstallScript = do
          FilePath -> IO ()
put FilePath
"%ghc_pkg_recache"
          IO ()
putNewline
    FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"%post" FilePath -> FilePath -> FilePath
+-+ FilePath
ghcPkgDevel
    IO ()
putInstallScript
    FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"%postun" FilePath -> FilePath -> FilePath
+-+ FilePath
ghcPkgDevel
    IO ()
putInstallScript

  let license_macro :: FilePath
license_macro = FilePath
"%license"
  let execs :: [String]
      execs :: [FilePath]
execs = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Executable -> FilePath) -> [Executable] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> (Executable -> UnqualComponentName) -> Executable -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> UnqualComponentName
exeName) ([Executable] -> [FilePath]) -> [Executable] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Executable -> ForceBinary) -> [Executable] -> [Executable]
forall a. (a -> ForceBinary) -> [a] -> [a]
filter Executable -> ForceBinary
isBuildable ([Executable] -> [Executable]) -> [Executable] -> [Executable]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Executable]
executables PackageDescription
pkgDesc

  let listDataFiles :: IO ()
listDataFiles = ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
unless ([FilePath] -> ForceBinary
forall (t :: * -> *) a. Foldable t => t a -> ForceBinary
null (PackageDescription -> [FilePath]
dataFiles PackageDescription
pkgDesc)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                        FilePath -> IO ()
put (FilePath
"%dir %{_datadir}/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pkg_name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-%{version}")
                        (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> IO ()
put (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath
"%dir %{_datadir}/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pkg_name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-%{version}/")FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
avoidSquareBrackets) ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath]
listDirs (PackageDescription -> [FilePath]
dataFiles PackageDescription
pkgDesc)))
                        (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> IO ()
put (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath
"%{_datadir}/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pkg_name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-%{version}/")FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
avoidSquareBrackets) ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort (PackageDescription -> [FilePath]
dataFiles PackageDescription
pkgDesc))

      listDirs :: [FilePath] -> [FilePath]
      listDirs :: [FilePath] -> [FilePath]
listDirs = [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath] -> [FilePath]) -> [[FilePath]] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (([FilePath] -> FilePath) -> [[FilePath]] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map [FilePath] -> FilePath
joinPath ([[FilePath]] -> [FilePath])
-> ([FilePath] -> [[FilePath]]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[FilePath]] -> [[FilePath]]
forall a. [a] -> [a]
tail ([[FilePath]] -> [[FilePath]])
-> ([FilePath] -> [[FilePath]]) -> [FilePath] -> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [[FilePath]]
forall a. [a] -> [[a]]
inits) ([[FilePath]] -> [FilePath])
-> ([FilePath] -> [[FilePath]]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[FilePath]] -> [[FilePath]]
forall a. Eq a => [a] -> [a]
nub ([[FilePath]] -> [[FilePath]])
-> ([FilePath] -> [[FilePath]]) -> [FilePath] -> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath] -> [FilePath]) -> [[FilePath]] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map [FilePath] -> [FilePath]
forall a. [a] -> [a]
init ([[FilePath]] -> [[FilePath]])
-> ([FilePath] -> [[FilePath]]) -> [FilePath] -> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath] -> ForceBinary) -> [[FilePath]] -> [[FilePath]]
forall a. (a -> ForceBinary) -> [a] -> [a]
filter (\[FilePath]
p -> [FilePath] -> CopyrightYear
forall (t :: * -> *) a. Foldable t => t a -> CopyrightYear
length [FilePath]
p CopyrightYear -> CopyrightYear -> ForceBinary
forall a. Ord a => a -> a -> ForceBinary
> CopyrightYear
1) ([[FilePath]] -> [[FilePath]])
-> ([FilePath] -> [[FilePath]]) -> [FilePath] -> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> [FilePath]
splitDirectories

  ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
when ForceBinary
hasExecPkg (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath -> IO ()
put FilePath
"%files"
    -- Add the license file to the main package only if it wouldn't
    -- otherwise be empty.
    (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ FilePath
l -> FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
license_macro FilePath -> FilePath -> FilePath
+-+ FilePath
l) ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
licensefiles)
    ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
unless ([FilePath] -> ForceBinary
forall (t :: * -> *) a. Foldable t => t a -> ForceBinary
null [FilePath]
docs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"%doc" FilePath -> FilePath -> FilePath
+-+ [FilePath] -> FilePath
unwords ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
docs)
    (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ FilePath
p -> FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"%{_bindir}/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (if FilePath
p FilePath -> FilePath -> ForceBinary
forall a. Eq a => a -> a -> ForceBinary
== FilePath
name then FilePath
"%{name}" else FilePath
p)) ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
execs)
    IO ()
listDataFiles
    IO ()
putNewline

  ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
when ForceBinary
hasLib (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let baseFiles :: FilePath
baseFiles = if ForceBinary
binlib then FilePath
"-f ghc-%{name}.files" else FilePath
"-f %{name}.files"
        develFiles :: FilePath
develFiles = if ForceBinary
binlib then FilePath
"-f ghc-%{name}-devel.files" else FilePath
"-f %{name}-devel.files"
    FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"%files" FilePath -> FilePath -> FilePath
+-+ FilePath
ghcPkg FilePath -> FilePath -> FilePath
+-+ FilePath
baseFiles
    (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ FilePath
l -> FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
license_macro FilePath -> FilePath -> FilePath
+-+ FilePath
l) [FilePath]
licensefiles
    ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
unless ForceBinary
binlib (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ FilePath
p -> FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"%{_bindir}/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (if FilePath
p FilePath -> FilePath -> ForceBinary
forall a. Eq a => a -> a -> ForceBinary
== FilePath
name then FilePath
"%{pkg_name}" else FilePath
p)) ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
execs)
    ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
unless ForceBinary
hasExecPkg IO ()
listDataFiles
    IO ()
putNewline
    FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"%files" FilePath -> FilePath -> FilePath
+-+ FilePath
ghcPkgDevel FilePath -> FilePath -> FilePath
+-+ FilePath
develFiles
    ForceBinary -> IO () -> IO ()
forall (f :: * -> *). Applicative f => ForceBinary -> f () -> f ()
unless ([FilePath] -> ForceBinary
forall (t :: * -> *) a. Foldable t => t a -> ForceBinary
null [FilePath]
docs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      FilePath -> IO ()
put (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"%doc" FilePath -> FilePath -> FilePath
+-+ [FilePath] -> FilePath
unwords ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
docs)
    IO ()
putNewline

  FilePath -> IO ()
put FilePath
"%changelog"
  Handle -> IO ()
hClose Handle
h


isBuildable :: Executable -> Bool
isBuildable :: Executable -> ForceBinary
isBuildable Executable
exe = BuildInfo -> ForceBinary
buildable (BuildInfo -> ForceBinary) -> BuildInfo -> ForceBinary
forall a b. (a -> b) -> a -> b
$ Executable -> BuildInfo
buildInfo Executable
exe

findDocs :: [FilePath] -> [FilePath] -> IO [FilePath]
findDocs :: [FilePath] -> [FilePath] -> IO [FilePath]
findDocs [FilePath]
contents [FilePath]
licensefiles = do
  let docs :: [FilePath]
docs = (FilePath -> ForceBinary) -> [FilePath] -> [FilePath]
forall a. (a -> ForceBinary) -> [a] -> [a]
filter FilePath -> ForceBinary
likely ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ([FilePath] -> FilePath
forall a. [a] -> a
head ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitDirectories) [FilePath]
contents)))
  [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ if [FilePath] -> ForceBinary
forall (t :: * -> *) a. Foldable t => t a -> ForceBinary
null [FilePath]
licensefiles
           then [FilePath]
docs
           else (FilePath -> ForceBinary) -> [FilePath] -> [FilePath]
forall a. (a -> ForceBinary) -> [a] -> [a]
filter (FilePath -> [FilePath] -> ForceBinary
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> ForceBinary
`notElem` [FilePath]
licensefiles) [FilePath]
docs
  where names :: [FilePath]
names = [FilePath
"author", FilePath
"changelog", FilePath
"changes", FilePath
"contributors", FilePath
"copying", FilePath
"doc",
                 FilePath
"example", FilePath
"licence", FilePath
"license", FilePath
"news", FilePath
"readme", FilePath
"todo"]
        likely :: FilePath -> ForceBinary
likely FilePath
name = let lowerName :: FilePath
lowerName = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
name
                      in (FilePath -> ForceBinary) -> [FilePath] -> ForceBinary
forall (t :: * -> *) a.
Foldable t =>
(a -> ForceBinary) -> t a -> ForceBinary
any (FilePath -> FilePath -> ForceBinary
forall a. Eq a => [a] -> [a] -> ForceBinary
`isPrefixOf` FilePath
lowerName) [FilePath]
names

normalizeVersion :: Version -> Version
normalizeVersion :: Version -> Version
normalizeVersion Version
v = case Version -> [CopyrightYear]
versionNumbers Version
v of
                       [CopyrightYear
i] -> [CopyrightYear] -> Version
mkVersion [CopyrightYear
i,CopyrightYear
0]
                       [CopyrightYear]
_   -> Version
v

showLicense :: License -> String
showLicense :: License -> FilePath
showLicense (GPL Maybe Version
Nothing) = FilePath
"GPL-1.0-or-later"
showLicense (GPL (Just Version
ver)) = FilePath
"GPL-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
display (Version -> Version
normalizeVersion Version
ver) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-or-later"
showLicense (LGPL Maybe Version
Nothing) = FilePath
"LGPL-2.0-or-later"
showLicense (LGPL (Just Version
ver)) = FilePath
"LGPL-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
display (Version -> Version
normalizeVersion Version
ver) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-or-later"
showLicense License
BSD3 = FilePath
"BSD-3-Clause"
showLicense License
BSD4 = FilePath
"BSD-4-Clause"
showLicense License
MIT = FilePath
"MIT"
showLicense License
PublicDomain = FilePath
"SUSE-Public-Domain"
showLicense License
AllRightsReserved = FilePath
"SUSE-NonFree"
showLicense License
OtherLicense = FilePath
"Unknown"
showLicense (UnknownLicense FilePath
l) = FilePath
"Unknown" FilePath -> FilePath -> FilePath
+-+ FilePath
l
showLicense (Apache Maybe Version
Nothing) = FilePath
"Apache-2.0"
showLicense (Apache (Just Version
ver)) = FilePath
"Apache-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
display (Version -> Version
normalizeVersion Version
ver)
showLicense (AGPL Maybe Version
Nothing) = FilePath
"AGPL-1.0-or-later"
showLicense (AGPL (Just Version
ver)) = FilePath
"AGPL-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
display (Version -> Version
normalizeVersion Version
ver) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-or-later"
showLicense License
BSD2 = FilePath
"BSD-2-Clause"
showLicense (MPL Version
ver) = FilePath
"MPL-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
display (Version -> Version
normalizeVersion Version
ver)
showLicense License
ISC = FilePath
"ISC"
showLicense License
UnspecifiedLicense = FilePath
"Unspecified license!"

-- http://rosettacode.org/wiki/Word_wrap#Haskell
wordwrap :: Int -> String -> String
wordwrap :: CopyrightYear -> FilePath -> FilePath
wordwrap CopyrightYear
maxlen = CopyrightYear -> ForceBinary -> [FilePath] -> FilePath
wrap_ CopyrightYear
0 ForceBinary
False ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words
  where
    wrap_ :: CopyrightYear -> ForceBinary -> [FilePath] -> FilePath
wrap_ CopyrightYear
_ ForceBinary
_ [] = FilePath
"\n"
    wrap_ CopyrightYear
pos ForceBinary
eos (FilePath
w:[FilePath]
ws)
      -- at line start: put down the word no matter what
      | CopyrightYear
pos CopyrightYear -> CopyrightYear -> ForceBinary
forall a. Eq a => a -> a -> ForceBinary
== CopyrightYear
0 = FilePath
w FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ CopyrightYear -> ForceBinary -> [FilePath] -> FilePath
wrap_ (CopyrightYear
pos CopyrightYear -> CopyrightYear -> CopyrightYear
forall a. Num a => a -> a -> a
+ CopyrightYear
lw) ForceBinary
endp [FilePath]
ws
      | CopyrightYear
pos CopyrightYear -> CopyrightYear -> CopyrightYear
forall a. Num a => a -> a -> a
+ CopyrightYear
lw CopyrightYear -> CopyrightYear -> CopyrightYear
forall a. Num a => a -> a -> a
+ CopyrightYear
1 CopyrightYear -> CopyrightYear -> ForceBinary
forall a. Ord a => a -> a -> ForceBinary
> CopyrightYear
maxlen CopyrightYear -> CopyrightYear -> CopyrightYear
forall a. Num a => a -> a -> a
- CopyrightYear
9 ForceBinary -> ForceBinary -> ForceBinary
&& ForceBinary
eos = Char
'\n'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:CopyrightYear -> ForceBinary -> [FilePath] -> FilePath
wrap_ CopyrightYear
0 ForceBinary
endp (FilePath
wFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
ws)
      | CopyrightYear
pos CopyrightYear -> CopyrightYear -> CopyrightYear
forall a. Num a => a -> a -> a
+ CopyrightYear
lw CopyrightYear -> CopyrightYear -> CopyrightYear
forall a. Num a => a -> a -> a
+ CopyrightYear
1 CopyrightYear -> CopyrightYear -> ForceBinary
forall a. Ord a => a -> a -> ForceBinary
> CopyrightYear
maxlen = Char
'\n'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:CopyrightYear -> ForceBinary -> [FilePath] -> FilePath
wrap_ CopyrightYear
0 ForceBinary
endp (FilePath
wFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
ws)
      | ForceBinary
otherwise = FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
w FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ CopyrightYear -> ForceBinary -> [FilePath] -> FilePath
wrap_ (CopyrightYear
pos CopyrightYear -> CopyrightYear -> CopyrightYear
forall a. Num a => a -> a -> a
+ CopyrightYear
lw CopyrightYear -> CopyrightYear -> CopyrightYear
forall a. Num a => a -> a -> a
+ CopyrightYear
1) ForceBinary
endp [FilePath]
ws
      where
        lw :: CopyrightYear
lw = FilePath -> CopyrightYear
forall (t :: * -> *) a. Foldable t => t a -> CopyrightYear
length FilePath
w
        endp :: ForceBinary
endp = FilePath -> Char
forall a. [a] -> a
last FilePath
w Char -> Char -> ForceBinary
forall a. Eq a => a -> a -> ForceBinary
== Char
'.'

formatParagraphs :: String -> [String]
formatParagraphs :: FilePath -> [FilePath]
formatParagraphs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (CopyrightYear -> FilePath -> FilePath
wordwrap CopyrightYear
79) ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
paragraphs ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
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 :: [FilePath] -> [FilePath]
paragraphs = ([FilePath] -> FilePath) -> [[FilePath]] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ([FilePath] -> FilePath
unlines ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> ForceBinary) -> [FilePath] -> [FilePath]
forall a. (a -> ForceBinary) -> [a] -> [a]
filter (ForceBinary -> ForceBinary
not (ForceBinary -> ForceBinary)
-> (FilePath -> ForceBinary) -> FilePath -> ForceBinary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ForceBinary
forall (t :: * -> *) a. Foldable t => t a -> ForceBinary
null)) ([[FilePath]] -> [FilePath])
-> ([FilePath] -> [[FilePath]]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> ForceBinary) -> [FilePath] -> [[FilePath]]
forall a. (a -> a -> ForceBinary) -> [a] -> [[a]]
groupBy ((FilePath -> ForceBinary) -> FilePath -> FilePath -> ForceBinary
forall a b. a -> b -> a
const ((FilePath -> ForceBinary) -> FilePath -> FilePath -> ForceBinary)
-> (FilePath -> ForceBinary) -> FilePath -> FilePath -> ForceBinary
forall a b. (a -> b) -> a -> b
$ ForceBinary -> ForceBinary
not (ForceBinary -> ForceBinary)
-> (FilePath -> ForceBinary) -> FilePath -> ForceBinary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ForceBinary
forall (t :: * -> *) a. Foldable t => t a -> ForceBinary
null)

rstrip :: (Char -> Bool) -> String -> String
rstrip :: (Char -> ForceBinary) -> FilePath -> FilePath
rstrip Char -> ForceBinary
p = FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ForceBinary) -> FilePath -> FilePath
forall a. (a -> ForceBinary) -> [a] -> [a]
dropWhile Char -> ForceBinary
p (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse

getPkgName :: Maybe FilePath -> PackageDescription -> Bool -> IO (String, Bool)
getPkgName :: Maybe FilePath
-> PackageDescription -> ForceBinary -> IO (FilePath, ForceBinary)
getPkgName (Just FilePath
spec) PackageDescription
pkgDesc ForceBinary
binary = do
  let name :: FilePath
name = PackageName -> FilePath
unPackageName (PackageIdentifier -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName (PackageDescription -> PackageIdentifier
package PackageDescription
pkgDesc))
      pkgname :: FilePath
pkgname = FilePath -> FilePath
takeBaseName FilePath
spec
      hasLib :: ForceBinary
hasLib = PackageDescription -> ForceBinary
hasLibs PackageDescription
pkgDesc
  (FilePath, ForceBinary) -> IO (FilePath, ForceBinary)
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath, ForceBinary) -> IO (FilePath, ForceBinary))
-> (FilePath, ForceBinary) -> IO (FilePath, ForceBinary)
forall a b. (a -> b) -> a -> b
$ if FilePath
name FilePath -> FilePath -> ForceBinary
forall a. Eq a => a -> a -> ForceBinary
== FilePath
pkgname ForceBinary -> ForceBinary -> ForceBinary
|| ForceBinary
binary then (FilePath
name, ForceBinary
hasLib) else (FilePath
pkgname, ForceBinary
False)
getPkgName Maybe FilePath
Nothing PackageDescription
pkgDesc ForceBinary
binary = do
  let name :: FilePath
name = PackageName -> FilePath
unPackageName (PackageIdentifier -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName (PackageDescription -> PackageIdentifier
package PackageDescription
pkgDesc))
      hasExec :: ForceBinary
hasExec = PackageDescription -> ForceBinary
hasExes PackageDescription
pkgDesc
      hasLib :: ForceBinary
hasLib = PackageDescription -> ForceBinary
hasLibs PackageDescription
pkgDesc
  (FilePath, ForceBinary) -> IO (FilePath, ForceBinary)
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath, ForceBinary) -> IO (FilePath, ForceBinary))
-> (FilePath, ForceBinary) -> IO (FilePath, ForceBinary)
forall a b. (a -> b) -> a -> b
$ if ForceBinary
binary ForceBinary -> ForceBinary -> ForceBinary
|| ForceBinary
hasExec ForceBinary -> ForceBinary -> ForceBinary
&& ForceBinary -> ForceBinary
not ForceBinary
hasLib then (FilePath
name, ForceBinary
hasLib) else (FilePath
"ghc-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name, ForceBinary
False)

infixr 4 +-+
(+-+) :: String -> String -> String
FilePath
"" +-+ :: FilePath -> FilePath -> FilePath
+-+ FilePath
s = FilePath
s
FilePath
s +-+ FilePath
"" = FilePath
s
FilePath
s +-+ FilePath
t = FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
t

excludedPkgs :: PackageDescription -> String -> Bool
excludedPkgs :: PackageDescription -> FilePath -> ForceBinary
excludedPkgs PackageDescription
pkgDesc = (FilePath -> [FilePath] -> ForceBinary)
-> [FilePath] -> FilePath -> ForceBinary
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> [FilePath] -> ForceBinary
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> ForceBinary
notElem ([FilePath]
subLibs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"Cabal", FilePath
"base", FilePath
"ghc-prim", FilePath
"integer-gmp"])
  where
    subLibs :: [String]
    subLibs :: [FilePath]
subLibs = [ UnqualComponentName -> FilePath
unUnqualComponentName UnqualComponentName
ln | Library
l <- PackageDescription -> [Library]
subLibraries PackageDescription
pkgDesc, LSubLibName UnqualComponentName
ln <- [Library -> LibraryName
libName Library
l] ]

-- returns list of deps and whether package is self-dependent
buildDependencies :: PackageDescription -> String -> ([String], Bool)
buildDependencies :: PackageDescription -> FilePath -> ([FilePath], ForceBinary)
buildDependencies PackageDescription
pkgDesc FilePath
self =
  let bis :: [BuildInfo]
bis   = (Library -> BuildInfo) -> [Library] -> [BuildInfo]
forall a b. (a -> b) -> [a] -> [b]
map Library -> BuildInfo
libBuildInfo (PackageDescription -> [Library]
allLibraries PackageDescription
pkgDesc) [BuildInfo] -> [BuildInfo] -> [BuildInfo]
forall a. [a] -> [a] -> [a]
++ (Executable -> BuildInfo) -> [Executable] -> [BuildInfo]
forall a b. (a -> b) -> [a] -> [b]
map Executable -> BuildInfo
buildInfo (PackageDescription -> [Executable]
executables PackageDescription
pkgDesc)
      bdeps :: [FilePath]
bdeps = (Dependency -> FilePath) -> [Dependency] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> FilePath
forall a. IsDependency a => a -> FilePath
depName ((BuildInfo -> [Dependency]) -> [BuildInfo] -> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [Dependency]
targetBuildDepends ((BuildInfo -> ForceBinary) -> [BuildInfo] -> [BuildInfo]
forall a. (a -> ForceBinary) -> [a] -> [a]
filter BuildInfo -> ForceBinary
buildable [BuildInfo]
bis))
      sdeps :: [FilePath]
sdeps = [FilePath]
-> (SetupBuildInfo -> [FilePath])
-> Maybe SetupBuildInfo
-> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Dependency -> FilePath) -> [Dependency] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> FilePath
forall a. IsDependency a => a -> FilePath
depName ([Dependency] -> [FilePath])
-> (SetupBuildInfo -> [Dependency]) -> SetupBuildInfo -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetupBuildInfo -> [Dependency]
setupDepends) (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkgDesc)
      deps :: [FilePath]
deps  = [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
bdeps [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
sdeps
  in
    ((FilePath -> ForceBinary) -> [FilePath] -> [FilePath]
forall a. (a -> ForceBinary) -> [a] -> [a]
filter (PackageDescription -> FilePath -> ForceBinary
excludedPkgs PackageDescription
pkgDesc) (FilePath -> [FilePath] -> [FilePath]
forall a. Eq a => a -> [a] -> [a]
delete FilePath
self [FilePath]
deps), FilePath
self FilePath -> [FilePath] -> ForceBinary
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> ForceBinary
`elem` [FilePath]
deps ForceBinary -> ForceBinary -> ForceBinary
&& PackageDescription -> ForceBinary
hasExes PackageDescription
pkgDesc)

class IsDependency a where
  depName :: a -> String

instance IsDependency Dependency where
  depName :: Dependency -> FilePath
depName (Dependency PackageName
n VersionRange
_ NonEmptySet LibraryName
_) = PackageName -> FilePath
unPackageName PackageName
n

instance IsDependency PkgconfigDependency where
  depName :: PkgconfigDependency -> FilePath
depName (PkgconfigDependency PkgconfigName
n PkgconfigVersionRange
_) = PkgconfigName -> FilePath
unPkgconfigName PkgconfigName
n

instance IsDependency LegacyExeDependency where
  depName :: LegacyExeDependency -> FilePath
depName (LegacyExeDependency FilePath
n VersionRange
_) = FilePath
n

showDep :: String -> String
showDep :: FilePath -> FilePath
showDep FilePath
p = FilePath
"ghc-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
p FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-devel"

resolveLib :: String -> String
resolveLib :: FilePath -> FilePath
resolveLib FilePath
"alut" = FilePath
"freealut-devel"
resolveLib FilePath
"asound" = FilePath
"alsa-devel"
resolveLib FilePath
"blas" = FilePath
"blas-devel"
resolveLib FilePath
"bluetooth" = FilePath
"bluez-devel"
resolveLib FilePath
"clang" = FilePath
"clang-devel"
resolveLib FilePath
"crypt" = FilePath
"glibc-devel"
resolveLib FilePath
"crypto" = FilePath
"libopenssl-devel"
resolveLib FilePath
"fftw3" = FilePath
"fftw3-devel"
resolveLib FilePath
"FLAC" = FilePath
"flac-devel"
resolveLib FilePath
"fontconfig" = FilePath
"fontconfig-devel"
resolveLib FilePath
"freetype" = FilePath
"freetype2-devel"
resolveLib FilePath
"gd" = FilePath
"gd-devel"
resolveLib FilePath
"GL" = FilePath
"Mesa-libGL-devel"
resolveLib FilePath
"glib-2.0" = FilePath
"glib2-devel"
resolveLib FilePath
"GLU" = FilePath
"glu-devel"
resolveLib FilePath
"gmp" = FilePath
"gmp-devel"
resolveLib FilePath
"gsl" = FilePath
"gsl-devel"
resolveLib FilePath
"icudata" = FilePath
"libicu-devel"
resolveLib FilePath
"icui18n" = FilePath
"libicu-devel"
resolveLib FilePath
"icuuc" = FilePath
"libicu-devel"
resolveLib FilePath
"IL" = FilePath
"DevIL-devel"
resolveLib FilePath
"Imlib2" = FilePath
"imlib2-devel"
resolveLib FilePath
"lapack" = FilePath
"lapack-devel"
resolveLib FilePath
"leveldb" = FilePath
"leveldb-devel"
resolveLib FilePath
"lmdb" = FilePath
"lmdb-devel"
resolveLib FilePath
"lua" = FilePath
"lua-devel"
resolveLib FilePath
"luajit" = FilePath
"luajit-devel"
resolveLib FilePath
"lzma" = FilePath
"xz-devel"
resolveLib FilePath
"m" = FilePath
"glibc-devel"
resolveLib FilePath
"magic" = FilePath
"file-devel"
resolveLib FilePath
"mpfr" = FilePath
"mpfr-devel"
resolveLib FilePath
"odbc" = FilePath
"unixODBC-devel"
resolveLib FilePath
"openal" = FilePath
"openal-soft-devel"
resolveLib FilePath
"pcre" = FilePath
"pcre-devel"
resolveLib FilePath
"png" = FilePath
"libpng16-compat-devel"
resolveLib FilePath
"pq" = FilePath
"postgresql-server-devel"
resolveLib FilePath
"pthread" = FilePath
"glibc-devel"
resolveLib FilePath
"re2" = FilePath
"re2-devel"
resolveLib FilePath
"resolv" = FilePath
"glibc-devel"
resolveLib FilePath
"ruby" = FilePath
"ruby-devel"
resolveLib FilePath
"snappy" = FilePath
"snappy-devel"
resolveLib FilePath
"sqlite3" = FilePath
"sqlite3-devel"
resolveLib FilePath
"ssl" = FilePath
"libopenssl-devel"
resolveLib FilePath
"tag_c" = FilePath
"libtag-devel"
resolveLib FilePath
"z" = FilePath
"zlib-devel"
resolveLib FilePath
name | FilePath
"lib" FilePath -> FilePath -> ForceBinary
forall a. Eq a => [a] -> [a] -> ForceBinary
`isPrefixOf` FilePath
name = FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-devel"
                | ForceBinary
otherwise               = FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-devel"

testsuiteDependencies :: PackageDescription -- ^pkg description
                      -> String             -- ^self
                      -> [String]           -- ^depends
testsuiteDependencies :: PackageDescription -> FilePath -> [FilePath]
testsuiteDependencies PackageDescription
pkgDesc FilePath
self =
  (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
showDep ([FilePath] -> [FilePath])
-> ([Dependency] -> [FilePath]) -> [Dependency] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> [FilePath]
forall a. Eq a => a -> [a] -> [a]
delete FilePath
self ([FilePath] -> [FilePath])
-> ([Dependency] -> [FilePath]) -> [Dependency] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> ForceBinary) -> [FilePath] -> [FilePath]
forall a. (a -> ForceBinary) -> [a] -> [a]
filter (PackageDescription -> FilePath -> ForceBinary
excludedPkgs PackageDescription
pkgDesc) ([FilePath] -> [FilePath])
-> ([Dependency] -> [FilePath]) -> [Dependency] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath])
-> ([Dependency] -> [FilePath]) -> [Dependency] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dependency -> FilePath) -> [Dependency] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> FilePath
forall a. IsDependency a => a -> FilePath
depName ([Dependency] -> [FilePath]) -> [Dependency] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (BuildInfo -> [Dependency]) -> [BuildInfo] -> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [Dependency]
targetBuildDepends ((BuildInfo -> ForceBinary) -> [BuildInfo] -> [BuildInfo]
forall a. (a -> ForceBinary) -> [a] -> [a]
filter BuildInfo -> ForceBinary
buildable ((TestSuite -> BuildInfo) -> [TestSuite] -> [BuildInfo]
forall a b. (a -> b) -> [a] -> [b]
map TestSuite -> BuildInfo
testBuildInfo (PackageDescription -> [TestSuite]
testSuites PackageDescription
pkgDesc)))

badDescription :: String -> Bool
badDescription :: FilePath -> ForceBinary
badDescription FilePath
s = FilePath -> ForceBinary
forall (t :: * -> *) a. Foldable t => t a -> ForceBinary
null FilePath
s
                ForceBinary -> ForceBinary -> ForceBinary
|| FilePath
"please see readme" FilePath -> FilePath -> ForceBinary
forall a. Eq a => [a] -> [a] -> ForceBinary
`isPrefixOf` (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
s
                ForceBinary -> ForceBinary -> ForceBinary
|| FilePath
"please see the readme" FilePath -> FilePath -> ForceBinary
forall a. Eq a => [a] -> [a] -> ForceBinary
`isPrefixOf` (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
s
                ForceBinary -> ForceBinary -> ForceBinary
|| FilePath
"see readme" FilePath -> FilePath -> ForceBinary
forall a. Eq a => [a] -> [a] -> ForceBinary
`isPrefixOf` (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
s
                ForceBinary -> ForceBinary -> ForceBinary
|| FilePath
"cf readme" FilePath -> FilePath -> ForceBinary
forall a. Eq a => [a] -> [a] -> ForceBinary
`isPrefixOf` (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
s
                ForceBinary -> ForceBinary -> ForceBinary
|| FilePath
"please refer to readme" FilePath -> FilePath -> ForceBinary
forall a. Eq a => [a] -> [a] -> ForceBinary
`isPrefixOf` (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
s
                ForceBinary -> ForceBinary -> ForceBinary
|| FilePath
"initial project template" FilePath -> FilePath -> ForceBinary
forall a. Eq a => [a] -> [a] -> ForceBinary
`isPrefixOf` (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
s

-- | @pandoc-2.2.1@ installs a file with square brackets in its name, and that
-- confuses RPM because it thinks those are shell specials.
--
-- TODO: Figure out how this code is supposed to interact with legitimate shell
-- globs, like '*'.

avoidSquareBrackets :: String -> String
avoidSquareBrackets :: FilePath -> FilePath
avoidSquareBrackets []     = []
avoidSquareBrackets (Char
x:FilePath
xs)
  | Char
x Char -> FilePath -> ForceBinary
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> ForceBinary
`elem` FilePath
"[]"       = Char
'?' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
avoidSquareBrackets FilePath
xs
  | ForceBinary
otherwise           = Char
x Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
avoidSquareBrackets FilePath
xs