{-# LANGUAGE OverloadedStrings #-}

{-|
This module has commands for reading the Requires and Provides
from an RPM package spec file.
-}

module Distribution.RPM.Build.ProvReqs
  (rpmspecProvidesBuildRequires)
where

import Control.Monad (unless)
import qualified Data.CaseInsensitive as CI
import Data.List.Extra
import Data.Maybe (mapMaybe)
import SimpleCmd (cmdFull, cmdLines, cmdStdErr, egrep_, error',
                  grep, warning, (+-+))
import SimpleCmd.Git (isGitDir)
import System.Directory (doesFileExist, getCurrentDirectory)
import System.Exit (exitFailure)
import System.FilePath
import System.IO.Extra (withTempDir)
import Text.Regex.TDFA ((=~))

generateBuildRequires :: FilePath -> IO Bool
generateBuildRequires :: FilePath -> IO Bool
generateBuildRequires =
  FilePath -> FilePath -> IO Bool
egrep_ FilePath
"^\\(%generate_buildrequires\\|%gometa\\)"

-- | Get RPM Provides and BuildRequires based on spec file.
rpmspecProvidesBuildRequires :: Bool -- ^ lenient (allow failure)
                             -> [String] -- ^ RPM opts
                             -> FilePath -- ^ spec file
                             -- ghc 8.10 haddock cannot annotate inside type
                             -> IO (Maybe ([String], [String])) -- ^ (Provs,BRs)
rpmspecProvidesBuildRequires :: Bool
-> [FilePath] -> FilePath -> IO (Maybe ([FilePath], [FilePath]))
rpmspecProvidesBuildRequires Bool
lenient [FilePath]
rpmopts FilePath
spec = do
  Bool
dynbr <- FilePath -> IO Bool
generateBuildRequires FilePath
spec
  if Bool
dynbr
    then do
    [FilePath]
brs <- FilePath -> IO [FilePath]
rpmspecDynBuildRequires FilePath
spec
    [FilePath]
provs <- do
      [FilePath]
dynprovs <- IO [FilePath]
dynProvides
      [FilePath]
prs <- Bool -> [FilePath] -> FilePath -> IO [FilePath]
rpmspecProvides Bool
lenient [FilePath]
rpmopts FilePath
spec
      [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
$ [FilePath]
dynprovs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
prs
    Maybe ([FilePath], [FilePath])
-> IO (Maybe ([FilePath], [FilePath]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ([FilePath], [FilePath])
 -> IO (Maybe ([FilePath], [FilePath])))
-> Maybe ([FilePath], [FilePath])
-> IO (Maybe ([FilePath], [FilePath]))
forall a b. (a -> b) -> a -> b
$ ([FilePath], [FilePath]) -> Maybe ([FilePath], [FilePath])
forall a. a -> Maybe a
Just ([FilePath]
provs, (FilePath -> Maybe FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FilePath -> Maybe FilePath
simplifyDep [FilePath]
brs)
    else do
    Maybe FilePath
mcontent <- IO (Maybe FilePath)
rpmspecParse
    case Maybe FilePath
mcontent of
      Maybe FilePath
Nothing -> Maybe ([FilePath], [FilePath])
-> IO (Maybe ([FilePath], [FilePath]))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([FilePath], [FilePath])
forall a. Maybe a
Nothing
      Just FilePath
content ->
        let pkg :: FilePath
pkg = FilePath -> FilePath
takeBaseName FilePath
spec
        in (([FilePath], [FilePath]) -> Maybe ([FilePath], [FilePath]))
-> IO ([FilePath], [FilePath])
-> IO (Maybe ([FilePath], [FilePath]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([FilePath], [FilePath]) -> Maybe ([FilePath], [FilePath])
forall a. a -> Maybe a
Just (IO ([FilePath], [FilePath])
 -> IO (Maybe ([FilePath], [FilePath])))
-> ([FilePath] -> IO ([FilePath], [FilePath]))
-> [FilePath]
-> IO (Maybe ([FilePath], [FilePath]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> IO ([FilePath], [FilePath])
extractMetadata FilePath
pkg ([],[]) ([FilePath] -> IO (Maybe ([FilePath], [FilePath])))
-> [FilePath] -> IO (Maybe ([FilePath], [FilePath]))
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
lines FilePath
content
  where
    extractMetadata :: FilePath -> ([String],[String]) -> [String]
                    -> IO ([String],[String])
    extractMetadata :: FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> IO ([FilePath], [FilePath])
extractMetadata FilePath
_ ([FilePath]
provs,[FilePath]
brs) [] =
      ([FilePath], [FilePath]) -> IO ([FilePath], [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
provs, (FilePath -> Maybe FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FilePath -> Maybe FilePath
simplifyDep [FilePath]
brs)
    extractMetadata FilePath
pkg acc :: ([FilePath], [FilePath])
acc@([FilePath]
provs,[FilePath]
brs) (FilePath
l:[FilePath]
ls) =
      case FilePath -> [FilePath]
words FilePath
l of
        [] -> FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> IO ([FilePath], [FilePath])
extractMetadata FilePath
pkg ([FilePath], [FilePath])
acc [FilePath]
ls
        [FilePath
w]
          | FilePath
w FilePath -> FilePath -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (FilePath
"^/usr/(lib(64)?|share)/pkgconfig/.*\\.pc" :: String) ->
              let pc :: FilePath
pc = FilePath -> FilePath -> FilePath
metaName FilePath
"pkgconfig" (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeBaseName FilePath
w
              in FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> IO ([FilePath], [FilePath])
extractMetadata FilePath
pkg (FilePath
pc FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
provs, [FilePath]
brs) [FilePath]
ls
          | FilePath
w FilePath -> FilePath -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (FilePath
"^/usr/(lib(64)?|share)/cmake/[^/]*$" :: String) ->
              let p :: FilePath
p = FilePath -> FilePath
takeFileName FilePath
w
                  cm :: [FilePath]
cm = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
metaName FilePath
"cmake") ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$
                       if FilePath -> FilePath
lower FilePath
p FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
p then [FilePath
p] else [FilePath
p, FilePath -> FilePath
lower FilePath
p]
              in FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> IO ([FilePath], [FilePath])
extractMetadata FilePath
pkg ([FilePath]
provs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
cm, [FilePath]
brs) [FilePath]
ls
          | Bool
otherwise -> FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> IO ([FilePath], [FilePath])
extractMetadata FilePath
pkg ([FilePath], [FilePath])
acc [FilePath]
ls
        (FilePath
w:FilePath
w':[FilePath]
ws) ->
            case FilePath -> CI FilePath
forall s. FoldCase s => s -> CI s
CI.mk FilePath
w of
              CI FilePath
"BuildRequires:" ->
                -- FIXME could be more than one package: parse ws
                FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> IO ([FilePath], [FilePath])
extractMetadata FilePath
pkg ([FilePath]
provs, FilePath
w'FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
brs) [FilePath]
ls
              CI FilePath
"Name:" -> FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> IO ([FilePath], [FilePath])
extractMetadata FilePath
pkg (FilePath
w' FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
provs, [FilePath]
brs) [FilePath]
ls
              CI FilePath
"Provides:" -> FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> IO ([FilePath], [FilePath])
extractMetadata FilePath
pkg (FilePath
w' FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
provs, [FilePath]
brs) [FilePath]
ls
              CI FilePath
"%package" ->
                let subpkg :: FilePath
subpkg =
                      if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
ws
                      then FilePath
pkg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
'-' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
w'
                      else [FilePath] -> FilePath
forall a. [a] -> a
last [FilePath]
ws
                in FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> IO ([FilePath], [FilePath])
extractMetadata FilePath
pkg (FilePath
subpkg FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
provs, [FilePath]
brs) [FilePath]
ls
              CI FilePath
_ -> FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> IO ([FilePath], [FilePath])
extractMetadata FilePath
pkg ([FilePath], [FilePath])
acc [FilePath]
ls

    rpmspecParse :: IO (Maybe String)
    rpmspecParse :: IO (Maybe FilePath)
rpmspecParse = do
      (Bool
ok, FilePath
out, FilePath
err) <- FilePath -> [FilePath] -> FilePath -> IO (Bool, FilePath, FilePath)
cmdFull FilePath
"rpmspec" ([FilePath
"-P"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
rpmopts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
spec]) FilePath
""
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
warning (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
spec FilePath -> FilePath -> FilePath
+-+ FilePath
err
      if Bool
ok
        then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
out
        else if Bool
lenient then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing else IO (Maybe FilePath)
forall a. IO a
exitFailure

    dynProvides :: IO [String]
    dynProvides :: IO [FilePath]
dynProvides =
      if FilePath
"golang-" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath -> FilePath
takeBaseName FilePath
spec
      then do
        [FilePath]
macro <- FilePath -> FilePath -> IO [FilePath]
grep FilePath
"%global goipath" FilePath
spec
        [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
$
          case [FilePath]
macro of
            [FilePath
def] -> [FilePath
"golang(" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. [a] -> a
last (FilePath -> [FilePath]
words FilePath
def) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"]
            [FilePath]
_ -> FilePath -> [FilePath]
forall a. FilePath -> a
error' (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
"failed to find %goipath in" FilePath -> FilePath -> FilePath
+-+ FilePath
spec
      else [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []

    simplifyDep :: FilePath -> Maybe FilePath
simplifyDep FilePath
br =
      case ([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]
words) FilePath
br of
        Char
'(':FilePath
dep -> FilePath -> Maybe FilePath
simplifyDep FilePath
dep
        FilePath
dep -> case FilePath -> FilePath -> [FilePath]
forall a. (Partial, Eq a) => [a] -> [a] -> [[a]]
splitOn FilePath
"(" (FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a]
dropSuffix FilePath
")" FilePath
dep) of
          (FilePath
"rpmlib":[FilePath]
_) -> Maybe FilePath
forall a. Maybe a
Nothing
          (FilePath
"crate":[FilePath
crate]) -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"rust-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath -> FilePath -> FilePath
forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
replace FilePath
"/" FilePath
"+" FilePath
crate FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-devel"
          (FilePath
"rubygem":[FilePath
gem]) -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"rubygem-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
gem
          [FilePath]
_ -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
dep

rpmspecDynBuildRequires :: FilePath -> IO [String]
rpmspecDynBuildRequires :: FilePath -> IO [FilePath]
rpmspecDynBuildRequires FilePath
spec =
  (FilePath -> IO [FilePath]) -> IO [FilePath]
forall a. (FilePath -> IO a) -> IO a
withTempDir ((FilePath -> IO [FilePath]) -> IO [FilePath])
-> (FilePath -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
tmpdir -> do
  [FilePath]
sourceopt <- do
    Bool
isgit <- FilePath -> IO Bool
isGitDir FilePath
"."
    if Bool
isgit
      then do
      FilePath
cwd <- IO FilePath
getCurrentDirectory
      [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
"--define", FilePath
"_sourcedir" FilePath -> FilePath -> FilePath
+-+ FilePath
cwd]
      else [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  (FilePath
out,FilePath
err) <- FilePath -> [FilePath] -> IO (FilePath, FilePath)
cmdStdErr FilePath
"rpmbuild" ([FilePath] -> IO (FilePath, FilePath))
-> [FilePath] -> IO (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ [FilePath
"-br", FilePath
"--nodeps", FilePath
"--define", FilePath
"_srcrpmdir" FilePath -> FilePath -> FilePath
+-+ FilePath
tmpdir, FilePath
spec] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
sourceopt
  -- Wrote: /current/dir/SRPMS/name-version-release.buildreqs.nosrc.rpm
  let errmsg :: FilePath
errmsg =
        FilePath
"failed to generate srpm for dynamic buildrequires for" FilePath -> FilePath -> FilePath
+-+ FilePath
spec FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
        FilePath
"\n\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err
  case FilePath -> [FilePath]
words FilePath
out of
    [] -> FilePath -> IO [FilePath]
forall a. FilePath -> a
error' FilePath
errmsg
    [FilePath]
ws -> do
      let srpm :: FilePath
srpm = [FilePath] -> FilePath
forall a. [a] -> a
last [FilePath]
ws
      Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
srpm
      if Bool
exists
        then FilePath -> [FilePath] -> IO [FilePath]
cmdLines FilePath
"rpm" [FilePath
"-qp", FilePath
"--requires", [FilePath] -> FilePath
forall a. [a] -> a
last [FilePath]
ws]
        else FilePath -> IO [FilePath]
forall a. FilePath -> a
error' FilePath
errmsg

rpmspecProvides :: Bool -> [String] -> FilePath -> IO [String]
rpmspecProvides :: Bool -> [FilePath] -> FilePath -> IO [FilePath]
rpmspecProvides Bool
lenient [FilePath]
rpmopts FilePath
spec = do
  (Bool
ok, FilePath
out, FilePath
err) <- FilePath -> [FilePath] -> FilePath -> IO (Bool, FilePath, FilePath)
cmdFull FilePath
"rpmspec" ([FilePath
"-q", FilePath
"--provides"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
rpmopts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
spec]) FilePath
""
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
warning FilePath
err
  if Bool
ok
    then [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
$ (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]
words) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
lines FilePath
out
    else if Bool
lenient then [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [] else IO [FilePath]
forall a. IO a
exitFailure

metaName :: String -> String -> String
metaName :: FilePath -> FilePath -> FilePath
metaName FilePath
meta FilePath
name =
  FilePath
meta FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
'(' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"