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

import HaskellCI.Prelude

import Distribution.Version (hasUpperBound, invertVersionRange, 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
(CompilerVersion -> CompilerVersion -> Bool)
-> (CompilerVersion -> CompilerVersion -> Bool)
-> Eq CompilerVersion
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
Eq CompilerVersion
-> (CompilerVersion -> CompilerVersion -> Ordering)
-> (CompilerVersion -> CompilerVersion -> Bool)
-> (CompilerVersion -> CompilerVersion -> Bool)
-> (CompilerVersion -> CompilerVersion -> Bool)
-> (CompilerVersion -> CompilerVersion -> Bool)
-> (CompilerVersion -> CompilerVersion -> CompilerVersion)
-> (CompilerVersion -> CompilerVersion -> CompilerVersion)
-> Ord 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
$cp1Ord :: Eq CompilerVersion
Ord, Int -> CompilerVersion -> ShowS
[CompilerVersion] -> ShowS
CompilerVersion -> String
(Int -> CompilerVersion -> ShowS)
-> (CompilerVersion -> String)
-> ([CompilerVersion] -> ShowS)
-> Show CompilerVersion
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 :: 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) = Version -> Maybe Version
forall a. a -> Maybe a
Just Version
v
maybeGHCJS CompilerVersion
_         = Maybe Version
forall a. Maybe a
Nothing

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

data CompilerRange
    = Range VersionRange
    | RangeGHC
    | RangeGHCJS
    | RangePoints (Set CompilerVersion)
    | RangeInter CompilerRange CompilerRange
    | RangeUnion CompilerRange CompilerRange
  deriving (Int -> CompilerRange -> ShowS
[CompilerRange] -> ShowS
CompilerRange -> String
(Int -> CompilerRange -> ShowS)
-> (CompilerRange -> String)
-> ([CompilerRange] -> ShowS)
-> Show CompilerRange
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 Set CompilerVersion
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 Bool -> Bool -> Bool
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 Bool -> Bool -> Bool
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) = CompilerVersion -> Set CompilerVersion -> Bool
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 (Set CompilerVersion -> Set CompilerVersion -> Set CompilerVersion
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set CompilerVersion
allCompilerVersions Set CompilerVersion
vs)

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

knownGhcVersions :: [Version]
knownGhcVersions :: [Version]
knownGhcVersions = ([Int] -> Version) -> [[Int]] -> [Version]
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
9,Int
0,Int
1]
    ]

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

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

correspondingCabalVersion
    :: Maybe Version    -- ^ Preferred Cabal Version
    -> CompilerVersion  -- ^ GHC Version
    -> Maybe Version
correspondingCabalVersion :: Maybe Version -> CompilerVersion -> Maybe Version
correspondingCabalVersion Maybe Version
Nothing   CompilerVersion
_         = Maybe Version
forall a. Maybe a
Nothing
correspondingCabalVersion (Just Version
_)  CompilerVersion
GHCHead   = Maybe Version
forall a. Maybe a
Nothing
correspondingCabalVersion (Just Version
_)  (GHCJS Version
_) = Version -> Maybe Version
forall a. a -> Maybe a
Just ([Int] -> Version
mkVersion [Int
3,Int
4])
correspondingCabalVersion (Just Version
cv) (GHC Version
gv)
    | Version
gv Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8,Int
10] = Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ Version -> Version -> Version
forall a. Ord a => a -> a -> a
max ([Int] -> Version
mkVersion [Int
3,Int
2]) Version
cv
    | Bool
otherwise              = Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ Version -> Version -> Version
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-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Pretty a => a -> String
C.prettyShow Version
v
dispGhcVersion (GHCJS Version
v) = String
"ghcjs-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
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)   = Version -> String
forall a. Pretty a => a -> String
C.prettyShow Version
v
dispGhcVersionShort (GHCJS Version
v) = String
"ghcjs-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Pretty a => a -> String
C.prettyShow Version
v

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

-- | 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
|| Int -> Bool
forall a. Integral a => a -> Bool
odd ((Int, Int) -> Int
forall a b. (a, b) -> b
snd (Version -> (Int, Int)
ghcMajVer Version
v))
previewGHC VersionRange
_vr (GHCJS Version
_) = 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 = String -> (Int, Int)
forall a. HasCallStack => String -> a
error (String -> (Int, Int)) -> String -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ String
"panic: ghcMajVer called with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Show a => a -> String
show Version
v