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

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

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

    simplifyDep :: [Char] -> Maybe [Char]
simplifyDep [Char]
br =
      case ([[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head ([[Char]] -> [Char]) -> ([Char] -> [[Char]]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words) [Char]
br of
        Char
'(':[Char]
dep -> [Char] -> Maybe [Char]
simplifyDep [Char]
dep
        [Char]
dep -> case [Char] -> [Char] -> [[Char]]
forall a. (HasCallStack, Eq a) => [a] -> [a] -> [[a]]
splitOn [Char]
"(" ([Char] -> [Char] -> [Char]
forall a. Eq a => [a] -> [a] -> [a]
dropSuffix [Char]
")" [Char]
dep) of
          ([Char]
"rpmlib":[[Char]]
_) -> Maybe [Char]
forall a. Maybe a
Nothing
          ([Char]
"crate":[[Char]
crate]) -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"rust-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char] -> [Char] -> [Char]
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace [Char]
"/" [Char]
"+" [Char]
crate [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-devel"
          ([Char]
"rubygem":[[Char]
gem]) -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"rubygem-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
gem
          [[Char]]
_ -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
dep

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

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

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