{-# OPTIONS_GHC -Wno-deprecations #-}
-- | This module encodes what we know about GHC, including existing/supported versions.
module HaskellCI.Compiler (
    -- * Compiler version
    CompilerVersion (..),
    maybeGHC,
    isGHCJS,
    maybeGHCJS,
    previewGHC,
    -- ** Selectors
    compilerKind,
    compilerVersion,
    -- * Compiler version range
    CompilerRange (..),
    compilerWithinRange,
    invertCompilerRange,
    -- * Known versions
    knownGhcVersions,
    knownGhcjsVersions,
    -- * Showing
    dispGhcVersion,
    dispGhcVersionShort,
    dispCabalVersion,
    -- * Cabal version
    correspondingCabalVersion,
    previewCabal,
    -- * Misc
    ghcMajVer,
    translateCompilerVersion,
    ) where

import HaskellCI.Prelude

import Distribution.Types.VersionInterval.Legacy (fromVersionIntervals, invertVersionIntervals, toVersionIntervals)
import Distribution.Version                      (hasUpperBound, versionNumbers, withinRange)

import qualified Data.Set            as S
import qualified Distribution.Pretty as C

-------------------------------------------------------------------------------
-- CompilerVersion
-------------------------------------------------------------------------------

data CompilerVersion
    = GHCHead
    | GHC Version
    | GHCJS Version
  deriving (CompilerVersion -> CompilerVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompilerVersion -> CompilerVersion -> Bool
$c/= :: CompilerVersion -> CompilerVersion -> Bool
== :: CompilerVersion -> CompilerVersion -> Bool
$c== :: CompilerVersion -> CompilerVersion -> Bool
Eq, Eq CompilerVersion
CompilerVersion -> CompilerVersion -> Bool
CompilerVersion -> CompilerVersion -> Ordering
CompilerVersion -> CompilerVersion -> CompilerVersion
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 :: CompilerVersion -> CompilerVersion -> CompilerVersion
$cmin :: CompilerVersion -> CompilerVersion -> CompilerVersion
max :: CompilerVersion -> CompilerVersion -> CompilerVersion
$cmax :: CompilerVersion -> CompilerVersion -> CompilerVersion
>= :: CompilerVersion -> CompilerVersion -> Bool
$c>= :: CompilerVersion -> CompilerVersion -> Bool
> :: CompilerVersion -> CompilerVersion -> Bool
$c> :: CompilerVersion -> CompilerVersion -> Bool
<= :: CompilerVersion -> CompilerVersion -> Bool
$c<= :: CompilerVersion -> CompilerVersion -> Bool
< :: CompilerVersion -> CompilerVersion -> Bool
$c< :: CompilerVersion -> CompilerVersion -> Bool
compare :: CompilerVersion -> CompilerVersion -> Ordering
$ccompare :: CompilerVersion -> CompilerVersion -> Ordering
Ord, Int -> CompilerVersion -> ShowS
[CompilerVersion] -> ShowS
CompilerVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompilerVersion] -> ShowS
$cshowList :: [CompilerVersion] -> ShowS
show :: CompilerVersion -> String
$cshow :: CompilerVersion -> String
showsPrec :: Int -> CompilerVersion -> ShowS
$cshowsPrec :: Int -> CompilerVersion -> ShowS
Show)

maybeGHC :: a -> (Version -> a) -> CompilerVersion -> a
maybeGHC :: forall a. a -> (Version -> a) -> CompilerVersion -> a
maybeGHC a
_ Version -> a
f (GHC Version
v) = Version -> a
f Version
v
maybeGHC a
x Version -> a
_ CompilerVersion
_       = a
x

isGHCJS :: CompilerVersion -> Bool
isGHCJS :: CompilerVersion -> Bool
isGHCJS (GHCJS Version
_) = Bool
True
isGHCJS CompilerVersion
_         = Bool
False

maybeGHCJS :: CompilerVersion -> Maybe Version
maybeGHCJS :: CompilerVersion -> Maybe Version
maybeGHCJS (GHCJS Version
v) = forall a. a -> Maybe a
Just Version
v
maybeGHCJS CompilerVersion
_         = forall a. Maybe a
Nothing

-------------------------------------------------------------------------------
-- String selectors
-------------------------------------------------------------------------------

compilerKind :: CompilerVersion -> String
compilerKind :: CompilerVersion -> String
compilerKind CompilerVersion
GHCHead   = String
"ghc"
compilerKind (GHC Version
_)   = String
"ghc"
compilerKind (GHCJS Version
_) = String
"ghcjs"

compilerVersion :: CompilerVersion -> String
compilerVersion :: CompilerVersion -> String
compilerVersion CompilerVersion
GHCHead   = String
"head"
compilerVersion (GHC Version
v)   = forall a. Pretty a => a -> String
C.prettyShow Version
v
compilerVersion (GHCJS Version
v) = forall a. Pretty a => a -> String
C.prettyShow Version
v

-------------------------------------------------------------------------------
-- CompilerRange
-------------------------------------------------------------------------------

data CompilerRange
    = Range VersionRange
    | RangeGHC
    | RangeGHCJS
    | RangePoints (Set CompilerVersion)
    | RangeInter CompilerRange CompilerRange
    | RangeUnion CompilerRange CompilerRange
  deriving (Int -> CompilerRange -> ShowS
[CompilerRange] -> ShowS
CompilerRange -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompilerRange] -> ShowS
$cshowList :: [CompilerRange] -> ShowS
show :: CompilerRange -> String
$cshow :: CompilerRange -> String
showsPrec :: Int -> CompilerRange -> ShowS
$cshowsPrec :: Int -> CompilerRange -> ShowS
Show)

instance Lattice CompilerRange where
    /\ :: CompilerRange -> CompilerRange -> CompilerRange
(/\) = CompilerRange -> CompilerRange -> CompilerRange
RangeInter
    \/ :: CompilerRange -> CompilerRange -> CompilerRange
(\/) = CompilerRange -> CompilerRange -> CompilerRange
RangeUnion

instance BoundedJoinSemiLattice CompilerRange where
    bottom :: CompilerRange
bottom = Set CompilerVersion -> CompilerRange
RangePoints forall a. Set a
S.empty

instance BoundedMeetSemiLattice CompilerRange where
    top :: CompilerRange
top = Set CompilerVersion -> CompilerRange
RangePoints Set CompilerVersion
allCompilerVersions

compilerWithinRange :: CompilerVersion -> CompilerRange -> Bool
compilerWithinRange :: CompilerVersion -> CompilerRange -> Bool
compilerWithinRange CompilerVersion
v         (RangeInter CompilerRange
a CompilerRange
b) = CompilerVersion -> CompilerRange -> Bool
compilerWithinRange CompilerVersion
v CompilerRange
a forall a. Lattice a => a -> a -> a
/\ CompilerVersion -> CompilerRange -> Bool
compilerWithinRange CompilerVersion
v CompilerRange
b
compilerWithinRange CompilerVersion
v         (RangeUnion CompilerRange
a CompilerRange
b) = CompilerVersion -> CompilerRange -> Bool
compilerWithinRange CompilerVersion
v CompilerRange
a forall a. Lattice a => a -> a -> a
\/ CompilerVersion -> CompilerRange -> Bool
compilerWithinRange CompilerVersion
v CompilerRange
b
compilerWithinRange (GHC Version
v)   (Range VersionRange
vr)       = Version -> VersionRange -> Bool
withinRange Version
v VersionRange
vr
compilerWithinRange (GHCJS Version
v) (Range VersionRange
vr)       = Version -> VersionRange -> Bool
withinRange Version
v VersionRange
vr
compilerWithinRange CompilerVersion
GHCHead   (Range VersionRange
vr)       = Bool -> Bool
not (VersionRange -> Bool
hasUpperBound VersionRange
vr)
compilerWithinRange (GHC Version
_)   CompilerRange
RangeGHC         = Bool
True
compilerWithinRange CompilerVersion
GHCHead   CompilerRange
RangeGHC         = Bool
True
compilerWithinRange (GHCJS Version
_) CompilerRange
RangeGHC         = Bool
False
compilerWithinRange (GHC Version
_)   CompilerRange
RangeGHCJS       = Bool
False
compilerWithinRange CompilerVersion
GHCHead   CompilerRange
RangeGHCJS       = Bool
False
compilerWithinRange (GHCJS Version
_) CompilerRange
RangeGHCJS       = Bool
True
compilerWithinRange CompilerVersion
v         (RangePoints Set CompilerVersion
vs) = forall a. Ord a => a -> Set a -> Bool
S.member CompilerVersion
v Set CompilerVersion
vs

invertCompilerRange :: CompilerRange -> CompilerRange
invertCompilerRange :: CompilerRange -> CompilerRange
invertCompilerRange (Range VersionRange
vr)       = VersionRange -> CompilerRange
Range (VersionRange -> VersionRange
invertVersionRange VersionRange
vr)
invertCompilerRange CompilerRange
RangeGHC         = CompilerRange
RangeGHCJS
invertCompilerRange CompilerRange
RangeGHCJS       = CompilerRange
RangeGHC
invertCompilerRange (RangeInter CompilerRange
a CompilerRange
b) = CompilerRange -> CompilerRange -> CompilerRange
RangeUnion (CompilerRange -> CompilerRange
invertCompilerRange CompilerRange
a) (CompilerRange -> CompilerRange
invertCompilerRange CompilerRange
b)
invertCompilerRange (RangeUnion CompilerRange
a CompilerRange
b) = CompilerRange -> CompilerRange -> CompilerRange
RangeInter (CompilerRange -> CompilerRange
invertCompilerRange CompilerRange
a) (CompilerRange -> CompilerRange
invertCompilerRange CompilerRange
b)
invertCompilerRange (RangePoints Set CompilerVersion
vs) = Set CompilerVersion -> CompilerRange
RangePoints (forall a. Ord a => Set a -> Set a -> Set a
S.difference Set CompilerVersion
allCompilerVersions Set CompilerVersion
vs)

invertVersionRange :: VersionRange -> VersionRange
invertVersionRange :: VersionRange -> VersionRange
invertVersionRange = VersionIntervals -> VersionRange
fromVersionIntervals forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionIntervals -> VersionIntervals
invertVersionIntervals forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> VersionIntervals
toVersionIntervals

-------------------------------------------------------------------------------
-- Known versions
-------------------------------------------------------------------------------

knownGhcVersions :: [Version]
knownGhcVersions :: [Version]
knownGhcVersions = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int] -> Version
mkVersion
    [ [Int
7,Int
0,Int
1],  [Int
7,Int
0,Int
2], [Int
7,Int
0,Int
3], [Int
7,Int
0,Int
4]
    , [Int
7,Int
2,Int
1],  [Int
7,Int
2,Int
2]
    , [Int
7,Int
4,Int
1],  [Int
7,Int
4,Int
2]
    , [Int
7,Int
6,Int
1],  [Int
7,Int
6,Int
2], [Int
7,Int
6,Int
3]
    , [Int
7,Int
8,Int
1],  [Int
7,Int
8,Int
2], [Int
7,Int
8,Int
3], [Int
7,Int
8,Int
4]
    , [Int
7,Int
10,Int
1], [Int
7,Int
10,Int
2], [Int
7,Int
10,Int
3]
    , [Int
8,Int
0,Int
1],  [Int
8,Int
0,Int
2]
    , [Int
8,Int
2,Int
1],  [Int
8,Int
2,Int
2]
    , [Int
8,Int
4,Int
1],  [Int
8,Int
4,Int
2], [Int
8,Int
4,Int
3], [Int
8,Int
4,Int
4]
    , [Int
8,Int
6,Int
1],  [Int
8,Int
6,Int
2], [Int
8,Int
6,Int
3], [Int
8,Int
6,Int
4], [Int
8,Int
6,Int
5]
    , [Int
8,Int
8,Int
1],  [Int
8,Int
8,Int
2], [Int
8,Int
8,Int
3], [Int
8,Int
8,Int
4]
    , [Int
8,Int
10,Int
1], [Int
8,Int
10,Int
2], [Int
8,Int
10,Int
3], [Int
8,Int
10,Int
4], [Int
8,Int
10,Int
5], [Int
8,Int
10,Int
6], [Int
8,Int
10,Int
7]
    , [Int
9,Int
0,Int
1],  [Int
9,Int
0,Int
2]
    , [Int
9,Int
2,Int
1],  [Int
9,Int
2,Int
2],  [Int
9,Int
2,Int
3], [Int
9,Int
2,Int
4], [Int
9,Int
2,Int
5], [Int
9,Int
2,Int
6], [Int
9,Int
2,Int
7]
    , [Int
9,Int
4,Int
1],  [Int
9,Int
4,Int
2],  [Int
9,Int
4,Int
3], [Int
9,Int
4,Int
4]
    , [Int
9,Int
6,Int
1]
    ]

knownGhcjsVersions :: [Version]
knownGhcjsVersions :: [Version]
knownGhcjsVersions = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int] -> Version
mkVersion
    [ [Int
8,Int
4]
    ]

allCompilerVersions :: Set CompilerVersion
allCompilerVersions :: Set CompilerVersion
allCompilerVersions = forall a. Ord a => a -> Set a -> Set a
S.insert CompilerVersion
GHCHead forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$
    [ Version -> CompilerVersion
GHC Version
v | Version
v <- [Version]
knownGhcVersions ] forall a. [a] -> [a] -> [a]
++
    [ Version -> CompilerVersion
GHCJS Version
v | Version
v <- [Version]
knownGhcjsVersions ]

-------------------------------------------------------------------------------
-- Combinators
-------------------------------------------------------------------------------

-- Used by travis only?
correspondingCabalVersion
    :: Maybe Version    -- ^ Preferred Cabal Version
    -> CompilerVersion  -- ^ GHC Version
    -> Maybe Version
correspondingCabalVersion :: Maybe Version -> CompilerVersion -> Maybe Version
correspondingCabalVersion Maybe Version
Nothing   CompilerVersion
_         = forall a. Maybe a
Nothing
correspondingCabalVersion (Just Version
_)  CompilerVersion
GHCHead   = forall a. Maybe a
Nothing
correspondingCabalVersion (Just Version
_)  (GHCJS Version
_) = forall a. a -> Maybe a
Just ([Int] -> Version
mkVersion [Int
3,Int
4])
correspondingCabalVersion (Just Version
cv) (GHC Version
gv)
    | Version
gv forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8,Int
10] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max ([Int] -> Version
mkVersion [Int
3,Int
2]) Version
cv
    | Bool
otherwise              = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max ([Int] -> Version
mkVersion [Int
3,Int
0]) Version
cv

dispGhcVersion :: CompilerVersion -> String
dispGhcVersion :: CompilerVersion -> String
dispGhcVersion CompilerVersion
GHCHead   = String
"ghc-head"
dispGhcVersion (GHC Version
v)   = String
"ghc-" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
C.prettyShow Version
v
dispGhcVersion (GHCJS Version
v) = String
"ghcjs-" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
C.prettyShow Version
v

dispGhcVersionShort :: CompilerVersion -> String
dispGhcVersionShort :: CompilerVersion -> String
dispGhcVersionShort CompilerVersion
GHCHead   = String
"ghc-head"
dispGhcVersionShort (GHC Version
v)   = forall a. Pretty a => a -> String
C.prettyShow Version
v
dispGhcVersionShort (GHCJS Version
v) = String
"ghcjs-" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
C.prettyShow Version
v

dispCabalVersion :: Maybe Version -> String
dispCabalVersion :: Maybe Version -> String
dispCabalVersion = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"head" forall a. Pretty a => a -> String
C.prettyShow

ghcAlpha :: Maybe (Version, Version)
ghcAlpha :: Maybe (Version, Version)
ghcAlpha = forall a. Maybe a
Nothing -- Just (mkVersion [9,6,1], mkVersion [9,6,0,20230302])

-- | Alphas, RCs and HEAD.
previewGHC
    :: VersionRange     -- ^ head.hackage range
    -> CompilerVersion
    -> Bool
previewGHC :: VersionRange -> CompilerVersion -> Bool
previewGHC VersionRange
_vr CompilerVersion
GHCHead   = Bool
True
previewGHC  VersionRange
vr (GHC Version
v)   = Version -> VersionRange -> Bool
withinRange Version
v VersionRange
vr Bool -> Bool -> Bool
|| forall a. Integral a => a -> Bool
odd (forall a b. (a, b) -> b
snd (Version -> (Int, Int)
ghcMajVer Version
v)) Bool -> Bool -> Bool
|| forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(Version
v', Version
_) -> Version
v forall a. Ord a => a -> a -> Bool
>= Version
v') Maybe (Version, Version)
ghcAlpha
previewGHC VersionRange
_vr (GHCJS Version
_) = Bool
False

previewCabal
    :: Maybe Version
    -> Bool
previewCabal :: Maybe Version -> Bool
previewCabal Maybe Version
Nothing = Bool
True
previewCabal (Just Version
v) = case Version -> [Int]
versionNumbers Version
v of
    Int
_:Int
y:[Int]
_ -> forall a. Integral a => a -> Bool
odd Int
y
    [Int]
_     -> Bool
False

ghcMajVer :: Version -> (Int,Int)
ghcMajVer :: Version -> (Int, Int)
ghcMajVer Version
v
    | Int
x:Int
y:[Int]
_ <- Version -> [Int]
versionNumbers Version
v = (Int
x,Int
y)
    | Bool
otherwise = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"panic: ghcMajVer called with " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Version
v

-- | Map compiler version to one available to download.
--
-- This way we can map e.g. 9.4.1 to 9.4.0.20220501 i.e. a prerelease.
translateCompilerVersion :: CompilerVersion -> CompilerVersion
translateCompilerVersion :: CompilerVersion -> CompilerVersion
translateCompilerVersion (GHC Version
v)
    | Just (Version
u, Version
w) <- Maybe (Version, Version)
ghcAlpha
    , Version
v forall a. Eq a => a -> a -> Bool
== Version
u
    = Version -> CompilerVersion
GHC Version
w
translateCompilerVersion CompilerVersion
v = CompilerVersion
v