{-# LANGUAGE CPP #-}

-- |
-- Module      :  Distribution.Fedora
-- Copyright   :  (C) 2014-2021  Jens Petersen
--
-- Maintainer  :  Jens Petersen <petersen@fedoraproject.org>
--
-- Explanation: Fedora Dist type and functions

-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.

module Distribution.Fedora
  (Dist(..),
   getReleaseIds,
   getFedoraReleaseIds,
   getFedoraDists,
   getEPELReleaseIds,
   getRawhideDist,
   getLatestFedoraDist,
   getLatestEPELDist,
   rawhideVersionId,
   distBranch,
   distRepo,
   distUpdates,
   distOverride,
   mockConfig,
   distVersion,
   kojicmd,
   rpkg,
   rpmDistTag) where

import Data.Maybe
import qualified Data.Text as T
import Data.Text (Text)
import Data.Version
import Text.Read
import Text.ParserCombinators.ReadP (char, eof, string)

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (*>))
import Data.Traversable (traverse)
#endif

import Distribution.Fedora.Products
import Distribution.Fedora.Release

-- | The `Dist` datatype specifies the target OS and version.
-- (roughly corresponds to a git branch)
data Dist = RHEL Version -- ^ RHEL version
          | EPEL Int -- ^ EPEL release
          | EPELNext Int -- ^ EPEL Next release
          | Fedora Int -- ^ Fedora release
  deriving (Dist -> Dist -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dist -> Dist -> Bool
$c/= :: Dist -> Dist -> Bool
== :: Dist -> Dist -> Bool
$c== :: Dist -> Dist -> Bool
Eq, Eq Dist
Dist -> Dist -> Bool
Dist -> Dist -> Ordering
Dist -> Dist -> Dist
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Dist -> Dist -> Dist
$cmin :: Dist -> Dist -> Dist
max :: Dist -> Dist -> Dist
$cmax :: Dist -> Dist -> Dist
>= :: Dist -> Dist -> Bool
$c>= :: Dist -> Dist -> Bool
> :: Dist -> Dist -> Bool
$c> :: Dist -> Dist -> Bool
<= :: Dist -> Dist -> Bool
$c<= :: Dist -> Dist -> Bool
< :: Dist -> Dist -> Bool
$c< :: Dist -> Dist -> Bool
compare :: Dist -> Dist -> Ordering
$ccompare :: Dist -> Dist -> Ordering
Ord)

instance Show Dist where
  show :: Dist -> String
show (Fedora Int
n) = String
"f" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
  show (EPEL Int
n) = (if Int
n forall a. Ord a => a -> a -> Bool
<= Int
6 then String
"el" else String
"epel") forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
  show (EPELNext Int
n) = String
"epel" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
"-next"
  show (RHEL Version
v) = String
"rhel-" forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
v

-- | Read from eg "f35", "epel8"
instance Read Dist where
  readPrec :: ReadPrec Dist
readPrec = forall a. [ReadPrec a] -> ReadPrec a
choice [ReadPrec Dist
pFedora, ReadPrec Dist
pEPELNext, ReadPrec Dist
pEPEL, ReadPrec Dist
pRHEL] where
    pFedora :: ReadPrec Dist
pFedora = Int -> Dist
Fedora forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. ReadP a -> ReadPrec a
lift (Char -> ReadP Char
char Char
'f') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Read a => ReadPrec a
readPrec)
    pEPELNext :: ReadPrec Dist
pEPELNext = Int -> Dist
EPELNext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
string String
"epel") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Read a => ReadPrec a
readPrec forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
string String
"-next"))
    pEPEL :: ReadPrec Dist
pEPEL = Int -> Dist
EPEL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
string String
"epel") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Read a => ReadPrec a
readPrec)
    pRHEL :: ReadPrec Dist
pRHEL = Version -> Dist
RHEL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadP a -> ReadPrec a
lift (do
      Version
v <- String -> ReadP String
string String
"rhel-" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP Version
parseVersion
      ReadP ()
eof
      forall (m :: * -> *) a. Monad m => a -> m a
return Version
v)

getReleases :: IO [Release]
getReleases :: IO [Release]
getReleases = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Object -> Maybe Release
readRelease forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Object]
getProducts

-- | gets list of current releases (Fedora and EPEL)
--
-- The data is stored in ~/.fedora/product-versions.json
-- and refreshed from Fedora PDC if older than 5.5 hours
getReleaseIds :: IO [Text]
getReleaseIds :: IO [Text]
getReleaseIds = forall a b. (a -> b) -> [a] -> [b]
map Release -> Text
releaseProductVersionId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Release]
getReleases

getProductReleases :: Text -> IO [Release]
getProductReleases :: Text -> IO [Release]
getProductReleases Text
name =
  forall a. (a -> Bool) -> [a] -> [a]
filter (\Release
p -> Release -> Text
releaseProduct Release
p forall a. Eq a => a -> a -> Bool
== Text
name) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Release]
getReleases

-- getRelease :: Text -> IO (Maybe Release)
-- getRelease pv =
--   find (\p -> releaseProductVersionId p == pv) <$> getReleases

getFedoraReleases :: IO [Release]
getFedoraReleases :: IO [Release]
getFedoraReleases =
  Text -> IO [Release]
getProductReleases (String -> Text
T.pack String
"fedora")

-- | gets current Fedora releases
getFedoraReleaseIds :: IO [Text]
getFedoraReleaseIds :: IO [Text]
getFedoraReleaseIds =
  forall a b. (a -> b) -> [a] -> [b]
map Release -> Text
releaseProductVersionId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Release]
getFedoraReleases

getEPELReleases :: IO [Release]
getEPELReleases :: IO [Release]
getEPELReleases =
  Text -> IO [Release]
getProductReleases (String -> Text
T.pack String
"epel")

-- | gets current EPEL releases
getEPELReleaseIds :: IO [Text]
getEPELReleaseIds :: IO [Text]
getEPELReleaseIds =
  forall a b. (a -> b) -> [a] -> [b]
map Release -> Text
releaseProductVersionId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Release]
getEPELReleases

-- | Rawhide version id
rawhideVersionId :: Text
rawhideVersionId :: Text
rawhideVersionId = String -> Text
T.pack String
"fedora-rawhide"

-- fails on rawhide - only use on other releases
releaseMajorVersion :: Release -> Int
releaseMajorVersion :: Release -> Int
releaseMajorVersion = forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Release -> Text
releaseVersion

releaseDist :: Release -> Dist
releaseDist :: Release -> Dist
releaseDist = Int -> Dist
Fedora forall b c a. (b -> c) -> (a -> b) -> a -> c
. Release -> Int
releaseMajorVersion

releaseDists :: [Release] -> [Dist]
releaseDists :: [Release] -> [Dist]
releaseDists [Release]
rels =
  forall a b. (a -> b) -> [a] -> [b]
map Release -> Dist
mkDist [Release]
rels
  where
    mkDist :: Release -> Dist
    mkDist :: Release -> Dist
mkDist Release
r | Release -> Text
releaseProductVersionId Release
r forall a. Eq a => a -> a -> Bool
== Text
rawhideVersionId = Release -> Dist
newerDist Release
latestbranch
             | Bool
otherwise = Release -> Dist
releaseDist Release
r

    latestbranch :: Release
latestbranch = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\Release
p -> Release -> Text
releaseProductVersionId Release
p forall a. Eq a => a -> a -> Bool
/= Text
rawhideVersionId) [Release]
rels

    newerDist :: Release -> Dist
newerDist = Int -> Dist
Fedora forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+ Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Release -> Int
releaseMajorVersion

-- | get list of current Fedora Dist's
getFedoraDists :: IO [Dist]
getFedoraDists :: IO [Dist]
getFedoraDists = [Release] -> [Dist]
releaseDists forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Release]
getFedoraReleases

-- | get current Dist for Fedora Rawhide
getRawhideDist :: IO Dist
getRawhideDist :: IO Dist
getRawhideDist =
  forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Release] -> [Dist]
releaseDists forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Release]
getFedoraReleases

-- | get newest Fedora branch
getLatestFedoraDist :: IO Dist
getLatestFedoraDist :: IO Dist
getLatestFedoraDist =
  Release -> Dist
releaseDist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\Release
p -> Release -> Text
releaseProductVersionId Release
p forall a. Eq a => a -> a -> Bool
/= Text
rawhideVersionId) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Release]
getFedoraReleases

-- | get newest EPEL release
getLatestEPELDist :: IO Dist
getLatestEPELDist :: IO Dist
getLatestEPELDist =
  Int -> Dist
EPEL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Release -> Int
releaseMajorVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Release]
getEPELReleases

-- activeRelease :: Text -> IO Bool
-- activeRelease pv = do
--   res <- filter (\p -> releaseProductVersionId p == pv) <$> getReleases
--   return $ not (null res)

-- | Maps `Dist` to package dist-git branch name, relative to latest branch
--
-- > distBranch (Fedora 35) (Fedora 36) == "rawhide"
-- > distBranch (Fedora 35) (Fedora 34) == "f34"
distBranch :: Dist -- ^ latest branch
           -> Dist -> String
distBranch :: Dist -> Dist -> String
distBranch Dist
branch (Fedora Int
n) | Int -> Dist
Fedora Int
n forall a. Ord a => a -> a -> Bool
> Dist
branch = String
"rawhide"
distBranch Dist
_ Dist
d = forall a. Show a => a -> String
show Dist
d

-- | Map `Dist` to DNF/YUM repo name, relative to latest branch
distRepo :: Dist -> Dist -> String
distRepo :: Dist -> Dist -> String
distRepo Dist
branched (Fedora Int
n) | Int -> Dist
Fedora Int
n forall a. Ord a => a -> a -> Bool
> Dist
branched = String
"rawhide"
                             | Bool
otherwise = String
"fedora"
distRepo Dist
_ (EPEL Int
_) = String
"epel"
distRepo Dist
_ (EPELNext Int
_) = String
"epel-next"
distRepo Dist
_ (RHEL Version
_) = String
"rhel"

-- | Map `Dist` to Maybe the DNF/YUM updates repo name, relative to latest branch
distUpdates :: Dist -> Dist -> Maybe String
distUpdates :: Dist -> Dist -> Maybe String
distUpdates Dist
branched (Fedora Int
n) | Int -> Dist
Fedora Int
n forall a. Ord a => a -> a -> Bool
> Dist
branched  = forall a. Maybe a
Nothing
distUpdates Dist
_ (Fedora Int
_) = forall a. a -> Maybe a
Just String
"updates"
distUpdates Dist
_ Dist
_ = forall a. Maybe a
Nothing

-- | Whether dist has overrides in Bodhi, relative to latest branch
distOverride :: Dist -> Dist -> Bool
distOverride :: Dist -> Dist -> Bool
distOverride Dist
branch (Fedora Int
n) = Int -> Dist
Fedora Int
n forall a. Ord a => a -> a -> Bool
<= Dist
branch
distOverride Dist
_ (EPEL Int
n) = Int
n forall a. Ord a => a -> a -> Bool
< Int
10
distOverride Dist
_ (EPELNext Int
n) = Int
n forall a. Ord a => a -> a -> Bool
< Int
10
distOverride Dist
_ Dist
_ = Bool
False

-- | OS release major version for `Dist`, relative to latest branch
distVersion :: Dist -> Dist -> String
distVersion :: Dist -> Dist -> String
distVersion Dist
branch (Fedora Int
n) | Int -> Dist
Fedora Int
n forall a. Ord a => a -> a -> Bool
> Dist
branch = String
"rawhide"
distVersion Dist
_ (Fedora Int
n) = forall a. Show a => a -> String
show Int
n
distVersion Dist
_ (EPEL Int
n) = forall a. Show a => a -> String
show Int
n
distVersion Dist
_ (EPELNext Int
n) = forall a. Show a => a -> String
show Int
n
distVersion Dist
_ (RHEL Version
n) = forall a. Show a => a -> String
show Version
n

-- | Mock configuration for `Dist` and arch, relative to latest branch
mockConfig :: Dist -> Dist -> String -> String
mockConfig :: Dist -> Dist -> ShowS
mockConfig Dist
branch Dist
dist String
arch =
  let prefix :: String
prefix =
        case Dist
dist of
          Fedora Int
_ -> String
"fedora"
          Dist
_ -> Dist -> Dist -> String
distRepo Dist
branch Dist
dist
  in
  String
prefix forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ Dist -> Dist -> String
distVersion Dist
branch Dist
dist forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ String
arch

-- | `Dist` tag (appended to rpm package release field)
rpmDistTag :: Dist -> String
rpmDistTag :: Dist -> String
rpmDistTag (Fedora Int
n) = String
".fc" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
rpmDistTag (EPEL Int
n) = String
".el" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
rpmDistTag (EPELNext Int
n) = String
".el" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
".next"
rpmDistTag (RHEL Version
v) = String
".el" forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
versionBranch) Version
v

-- | Command line tool for `Dist` (eg "koji")
kojicmd :: Dist -> String
kojicmd :: Dist -> String
kojicmd (RHEL Version
_) = String
"brew"
kojicmd Dist
_ =  String
"koji"

-- | rpkg command for `Dist` (eg "fedpkg")
rpkg :: Dist -> String
rpkg :: Dist -> String
rpkg (RHEL Version
_) = String
"rhpkg"
rpkg Dist
_ = String
"fedpkg"