{-# 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 Safe (headMay)
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
  dynbr <- [Char] -> IO Bool
generateBuildRequires [Char]
spec
  if dynbr
    then do
    brs <- rpmspecDynBuildRequires spec
    provs <- do
      dynprovs <- dynProvides
      prs <- rpmspecProvides lenient rpmopts spec
      return $ dynprovs ++ prs
    return $ Just (provs, mapMaybe simplifyDep brs)
    else do
    mcontent <- rpmspecParse
    case 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 ->
        (([[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]] -> IO ([[Char]], [[Char]])
extractMetadata ([],[]) ([[Char]] -> IO (Maybe ([[Char]], [[Char]])))
-> [[Char]] -> IO (Maybe ([[Char]], [[Char]]))
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines [Char]
content
  where
    pkg :: [Char]
pkg = [Char] -> [Char]
takeBaseName [Char]
spec

    extractMetadata :: ([String],[String]) -> [String]
                    -> IO ([String],[String])
    extractMetadata :: ([[Char]], [[Char]]) -> [[Char]] -> IO ([[Char]], [[Char]])
extractMetadata ([[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 acc :: ([[Char]], [[Char]])
acc@([[Char]]
provs,[[Char]]
brs) ([Char]
l:[[Char]]
ls) =
      case [Char] -> [[Char]]
words [Char]
l of
        [] -> ([[Char]], [[Char]]) -> [[Char]] -> IO ([[Char]], [[Char]])
extractMetadata ([[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]] -> IO ([[Char]], [[Char]])
extractMetadata ([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] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
dropTrailingPathSeparator [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]] -> IO ([[Char]], [[Char]])
extractMetadata ([[Char]]
provs [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
cm, [[Char]]
brs) [[Char]]
ls
          | Bool
otherwise -> ([[Char]], [[Char]]) -> [[Char]] -> IO ([[Char]], [[Char]])
extractMetadata ([[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]] -> IO ([[Char]], [[Char]])
extractMetadata ([[Char]]
provs, [Char]
w'[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
brs) [[Char]]
ls
              CI [Char]
"Name:" -> ([[Char]], [[Char]]) -> [[Char]] -> IO ([[Char]], [[Char]])
extractMetadata ([Char]
w' [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
provs, [[Char]]
brs) [[Char]]
ls
              CI [Char]
"Provides:" -> ([[Char]], [[Char]]) -> [[Char]] -> IO ([[Char]], [[Char]])
extractMetadata ([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]] -> IO ([[Char]], [[Char]])
extractMetadata ([Char]
subpkg [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
provs, [[Char]]
brs) [[Char]]
ls
              CI [Char]
_ -> ([[Char]], [[Char]]) -> [[Char]] -> IO ([[Char]], [[Char]])
extractMetadata ([[Char]], [[Char]])
acc [[Char]]
ls

    rpmspecParse :: IO (Maybe String)
    rpmspecParse :: IO (Maybe [Char])
rpmspecParse = do
      (ok, out, 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]
""
      unless (null err) $ warning $ spec +-+ err
      if ok
        then return $ Just out
        else if lenient then return Nothing else exitFailure

    dynProvides :: IO [String]
    dynProvides :: IO [[Char]]
dynProvides
      | [Char]
"python-" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
pkg = do
          let dist :: [Char]
dist = [Char] -> [Char] -> [Char]
forall a. Eq a => [a] -> [a] -> [a]
dropPrefix [Char]
"python-" [Char]
pkg
          [[Char]] -> IO [[Char]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]
"python3dist(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
dist [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"]
      | [Char]
"golang-" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
pkg = do
          macro <- [Char] -> [Char] -> IO [[Char]]
grep [Char]
"%global goipath" [Char]
spec
          return $
            case 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
      | Bool
otherwise = [[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]] -> Maybe [Char]
forall a. [a] -> Maybe a
headMay ([[Char]] -> Maybe [Char])
-> ([Char] -> [[Char]]) -> [Char] -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words) [Char]
br of
        Maybe [Char]
Nothing -> Maybe [Char]
forall a. Maybe a
Nothing
        Just [Char]
pri ->
          case [Char]
pri 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
  sourceopt <- do
    isgit <- [Char] -> IO Bool
isGitDir [Char]
"."
    if isgit
      then do
      cwd <- getCurrentDirectory
      return ["--define", "_sourcedir" +-+ cwd]
      else return []
  (out,err) <- cmdStdErr "rpmbuild" $ ["-br", "--nodeps", "--define", "_srcrpmdir" +-+ tmpdir, spec] ++ sourceopt
  -- Wrote: /current/dir/SRPMS/name-version-release.buildreqs.nosrc.rpm
  let 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 words 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
      exists <- [Char] -> IO Bool
doesFileExist [Char]
srpm
      if exists
        then cmdLines "rpm" ["-qp", "--requires", last ws]
        else error' errmsg

rpmspecProvides :: Bool -> [String] -> FilePath -> IO [String]
rpmspecProvides :: Bool -> [[Char]] -> [Char] -> IO [[Char]]
rpmspecProvides Bool
lenient [[Char]]
rpmopts [Char]
spec = do
  (ok, out, 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]
""
  unless (null err) $ warning err
  if ok
    then return $ map (fst . word1) $ lines out
    else if lenient then return [] else 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]
")"