{-# LANGUAGE CPP #-}
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
data Dist = RHEL Version
| EPEL Int
| EPELNext Int
| Fedora Int
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
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
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
getFedoraReleases :: IO [Release]
getFedoraReleases :: IO [Release]
getFedoraReleases =
Text -> IO [Release]
getProductReleases (String -> Text
T.pack String
"fedora")
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")
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
rawhideVersionId :: Text
rawhideVersionId :: Text
rawhideVersionId = String -> Text
T.pack String
"fedora-rawhide"
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
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
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
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
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
distBranch :: Dist
-> 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
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"
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
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
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
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
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
kojicmd :: Dist -> String
kojicmd :: Dist -> String
kojicmd (RHEL Version
_) = String
"brew"
kojicmd Dist
_ = String
"koji"
rpkg :: Dist -> String
rpkg :: Dist -> String
rpkg (RHEL Version
_) = String
"rhpkg"
rpkg Dist
_ = String
"fedpkg"