{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}

module Stack.Types.Compiler
  ( ActualCompiler (..)
  , WhichCompiler (..)
  , CompilerRepository (..)
  , CompilerException (..)
  , defaultCompilerRepository
  , getGhcVersion
  , whichCompiler
  , compilerVersionText
  , compilerVersionString
  , isWantedCompiler
  , wantedToActual
  , actualToWanted
  , parseActualCompiler
  ) where

import           Data.Aeson
import           Database.Persist
import           Database.Persist.Sql
import qualified Data.Text as T
import           Stack.Prelude
import           Stack.Types.Version
import           Distribution.Version (mkVersion)

-- | Variety of compiler to use.
data WhichCompiler
    = Ghc
    deriving (Int -> WhichCompiler -> ShowS
[WhichCompiler] -> ShowS
WhichCompiler -> String
(Int -> WhichCompiler -> ShowS)
-> (WhichCompiler -> String)
-> ([WhichCompiler] -> ShowS)
-> Show WhichCompiler
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WhichCompiler] -> ShowS
$cshowList :: [WhichCompiler] -> ShowS
show :: WhichCompiler -> String
$cshow :: WhichCompiler -> String
showsPrec :: Int -> WhichCompiler -> ShowS
$cshowsPrec :: Int -> WhichCompiler -> ShowS
Show, WhichCompiler -> WhichCompiler -> Bool
(WhichCompiler -> WhichCompiler -> Bool)
-> (WhichCompiler -> WhichCompiler -> Bool) -> Eq WhichCompiler
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WhichCompiler -> WhichCompiler -> Bool
$c/= :: WhichCompiler -> WhichCompiler -> Bool
== :: WhichCompiler -> WhichCompiler -> Bool
$c== :: WhichCompiler -> WhichCompiler -> Bool
Eq, Eq WhichCompiler
Eq WhichCompiler
-> (WhichCompiler -> WhichCompiler -> Ordering)
-> (WhichCompiler -> WhichCompiler -> Bool)
-> (WhichCompiler -> WhichCompiler -> Bool)
-> (WhichCompiler -> WhichCompiler -> Bool)
-> (WhichCompiler -> WhichCompiler -> Bool)
-> (WhichCompiler -> WhichCompiler -> WhichCompiler)
-> (WhichCompiler -> WhichCompiler -> WhichCompiler)
-> Ord WhichCompiler
WhichCompiler -> WhichCompiler -> Bool
WhichCompiler -> WhichCompiler -> Ordering
WhichCompiler -> WhichCompiler -> WhichCompiler
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 :: WhichCompiler -> WhichCompiler -> WhichCompiler
$cmin :: WhichCompiler -> WhichCompiler -> WhichCompiler
max :: WhichCompiler -> WhichCompiler -> WhichCompiler
$cmax :: WhichCompiler -> WhichCompiler -> WhichCompiler
>= :: WhichCompiler -> WhichCompiler -> Bool
$c>= :: WhichCompiler -> WhichCompiler -> Bool
> :: WhichCompiler -> WhichCompiler -> Bool
$c> :: WhichCompiler -> WhichCompiler -> Bool
<= :: WhichCompiler -> WhichCompiler -> Bool
$c<= :: WhichCompiler -> WhichCompiler -> Bool
< :: WhichCompiler -> WhichCompiler -> Bool
$c< :: WhichCompiler -> WhichCompiler -> Bool
compare :: WhichCompiler -> WhichCompiler -> Ordering
$ccompare :: WhichCompiler -> WhichCompiler -> Ordering
$cp1Ord :: Eq WhichCompiler
Ord)

-- | Specifies a compiler and its version number(s).
--
-- Note that despite having this datatype, stack isn't in a hurry to
-- support compilers other than GHC.
data ActualCompiler
    = ACGhc !Version
    | ACGhcGit !Text !Text
    deriving ((forall x. ActualCompiler -> Rep ActualCompiler x)
-> (forall x. Rep ActualCompiler x -> ActualCompiler)
-> Generic ActualCompiler
forall x. Rep ActualCompiler x -> ActualCompiler
forall x. ActualCompiler -> Rep ActualCompiler x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActualCompiler x -> ActualCompiler
$cfrom :: forall x. ActualCompiler -> Rep ActualCompiler x
Generic, Int -> ActualCompiler -> ShowS
[ActualCompiler] -> ShowS
ActualCompiler -> String
(Int -> ActualCompiler -> ShowS)
-> (ActualCompiler -> String)
-> ([ActualCompiler] -> ShowS)
-> Show ActualCompiler
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActualCompiler] -> ShowS
$cshowList :: [ActualCompiler] -> ShowS
show :: ActualCompiler -> String
$cshow :: ActualCompiler -> String
showsPrec :: Int -> ActualCompiler -> ShowS
$cshowsPrec :: Int -> ActualCompiler -> ShowS
Show, ActualCompiler -> ActualCompiler -> Bool
(ActualCompiler -> ActualCompiler -> Bool)
-> (ActualCompiler -> ActualCompiler -> Bool) -> Eq ActualCompiler
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActualCompiler -> ActualCompiler -> Bool
$c/= :: ActualCompiler -> ActualCompiler -> Bool
== :: ActualCompiler -> ActualCompiler -> Bool
$c== :: ActualCompiler -> ActualCompiler -> Bool
Eq, Eq ActualCompiler
Eq ActualCompiler
-> (ActualCompiler -> ActualCompiler -> Ordering)
-> (ActualCompiler -> ActualCompiler -> Bool)
-> (ActualCompiler -> ActualCompiler -> Bool)
-> (ActualCompiler -> ActualCompiler -> Bool)
-> (ActualCompiler -> ActualCompiler -> Bool)
-> (ActualCompiler -> ActualCompiler -> ActualCompiler)
-> (ActualCompiler -> ActualCompiler -> ActualCompiler)
-> Ord ActualCompiler
ActualCompiler -> ActualCompiler -> Bool
ActualCompiler -> ActualCompiler -> Ordering
ActualCompiler -> ActualCompiler -> ActualCompiler
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 :: ActualCompiler -> ActualCompiler -> ActualCompiler
$cmin :: ActualCompiler -> ActualCompiler -> ActualCompiler
max :: ActualCompiler -> ActualCompiler -> ActualCompiler
$cmax :: ActualCompiler -> ActualCompiler -> ActualCompiler
>= :: ActualCompiler -> ActualCompiler -> Bool
$c>= :: ActualCompiler -> ActualCompiler -> Bool
> :: ActualCompiler -> ActualCompiler -> Bool
$c> :: ActualCompiler -> ActualCompiler -> Bool
<= :: ActualCompiler -> ActualCompiler -> Bool
$c<= :: ActualCompiler -> ActualCompiler -> Bool
< :: ActualCompiler -> ActualCompiler -> Bool
$c< :: ActualCompiler -> ActualCompiler -> Bool
compare :: ActualCompiler -> ActualCompiler -> Ordering
$ccompare :: ActualCompiler -> ActualCompiler -> Ordering
$cp1Ord :: Eq ActualCompiler
Ord, Typeable ActualCompiler
DataType
Constr
Typeable ActualCompiler
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ActualCompiler -> c ActualCompiler)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ActualCompiler)
-> (ActualCompiler -> Constr)
-> (ActualCompiler -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ActualCompiler))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ActualCompiler))
-> ((forall b. Data b => b -> b)
    -> ActualCompiler -> ActualCompiler)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ActualCompiler -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ActualCompiler -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ActualCompiler -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ActualCompiler -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ActualCompiler -> m ActualCompiler)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ActualCompiler -> m ActualCompiler)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ActualCompiler -> m ActualCompiler)
-> Data ActualCompiler
ActualCompiler -> DataType
ActualCompiler -> Constr
(forall b. Data b => b -> b) -> ActualCompiler -> ActualCompiler
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ActualCompiler -> c ActualCompiler
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ActualCompiler
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ActualCompiler -> u
forall u. (forall d. Data d => d -> u) -> ActualCompiler -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ActualCompiler -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ActualCompiler -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ActualCompiler -> m ActualCompiler
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ActualCompiler -> m ActualCompiler
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ActualCompiler
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ActualCompiler -> c ActualCompiler
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ActualCompiler)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ActualCompiler)
$cACGhcGit :: Constr
$cACGhc :: Constr
$tActualCompiler :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ActualCompiler -> m ActualCompiler
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ActualCompiler -> m ActualCompiler
gmapMp :: (forall d. Data d => d -> m d)
-> ActualCompiler -> m ActualCompiler
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ActualCompiler -> m ActualCompiler
gmapM :: (forall d. Data d => d -> m d)
-> ActualCompiler -> m ActualCompiler
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ActualCompiler -> m ActualCompiler
gmapQi :: Int -> (forall d. Data d => d -> u) -> ActualCompiler -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ActualCompiler -> u
gmapQ :: (forall d. Data d => d -> u) -> ActualCompiler -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ActualCompiler -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ActualCompiler -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ActualCompiler -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ActualCompiler -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ActualCompiler -> r
gmapT :: (forall b. Data b => b -> b) -> ActualCompiler -> ActualCompiler
$cgmapT :: (forall b. Data b => b -> b) -> ActualCompiler -> ActualCompiler
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ActualCompiler)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ActualCompiler)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ActualCompiler)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ActualCompiler)
dataTypeOf :: ActualCompiler -> DataType
$cdataTypeOf :: ActualCompiler -> DataType
toConstr :: ActualCompiler -> Constr
$ctoConstr :: ActualCompiler -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ActualCompiler
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ActualCompiler
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ActualCompiler -> c ActualCompiler
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ActualCompiler -> c ActualCompiler
$cp1Data :: Typeable ActualCompiler
Data, Typeable)
instance NFData ActualCompiler
instance Display ActualCompiler where
    display :: ActualCompiler -> Utf8Builder
display (ACGhc Version
x) = WantedCompiler -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Version -> WantedCompiler
WCGhc Version
x)
    display (ACGhcGit Text
x Text
y) = WantedCompiler -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Text -> Text -> WantedCompiler
WCGhcGit Text
x Text
y)
instance ToJSON ActualCompiler where
    toJSON :: ActualCompiler -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (ActualCompiler -> Text) -> ActualCompiler -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActualCompiler -> Text
compilerVersionText
instance FromJSON ActualCompiler where
    parseJSON :: Value -> Parser ActualCompiler
parseJSON (String Text
t) = (CompilerException -> Parser ActualCompiler)
-> (ActualCompiler -> Parser ActualCompiler)
-> Either CompilerException ActualCompiler
-> Parser ActualCompiler
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Parser ActualCompiler -> CompilerException -> Parser ActualCompiler
forall a b. a -> b -> a
const (Parser ActualCompiler
 -> CompilerException -> Parser ActualCompiler)
-> Parser ActualCompiler
-> CompilerException
-> Parser ActualCompiler
forall a b. (a -> b) -> a -> b
$ String -> Parser ActualCompiler
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Failed to parse compiler version") ActualCompiler -> Parser ActualCompiler
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either CompilerException ActualCompiler
parseActualCompiler Text
t)
    parseJSON Value
_ = String -> Parser ActualCompiler
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid CompilerVersion, must be String"
instance FromJSONKey ActualCompiler where
    fromJSONKey :: FromJSONKeyFunction ActualCompiler
fromJSONKey = (Text -> Parser ActualCompiler)
-> FromJSONKeyFunction ActualCompiler
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser ActualCompiler)
 -> FromJSONKeyFunction ActualCompiler)
-> (Text -> Parser ActualCompiler)
-> FromJSONKeyFunction ActualCompiler
forall a b. (a -> b) -> a -> b
$ \Text
k ->
        case Text -> Either CompilerException ActualCompiler
parseActualCompiler Text
k of
            Left CompilerException
_ -> String -> Parser ActualCompiler
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ActualCompiler)
-> String -> Parser ActualCompiler
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse CompilerVersion " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
k
            Right ActualCompiler
parsed -> ActualCompiler -> Parser ActualCompiler
forall (m :: * -> *) a. Monad m => a -> m a
return ActualCompiler
parsed
instance PersistField ActualCompiler where
  toPersistValue :: ActualCompiler -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (ActualCompiler -> Text) -> ActualCompiler -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActualCompiler -> Text
compilerVersionText
  fromPersistValue :: PersistValue -> Either Text ActualCompiler
fromPersistValue = ((CompilerException -> Text)
-> Either CompilerException ActualCompiler
-> Either Text ActualCompiler
forall a1 a2 b. (a1 -> a2) -> Either a1 b -> Either a2 b
mapLeft CompilerException -> Text
forall a. Show a => a -> Text
tshow (Either CompilerException ActualCompiler
 -> Either Text ActualCompiler)
-> (Text -> Either CompilerException ActualCompiler)
-> Text
-> Either Text ActualCompiler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CompilerException ActualCompiler
parseActualCompiler) (Text -> Either Text ActualCompiler)
-> (PersistValue -> Either Text Text)
-> PersistValue
-> Either Text ActualCompiler
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< PersistValue -> Either Text Text
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue
instance PersistFieldSql ActualCompiler where
  sqlType :: Proxy ActualCompiler -> SqlType
sqlType Proxy ActualCompiler
_ = SqlType
SqlString

data CompilerException
  = GhcjsNotSupported
  | PantryException PantryException

instance Show CompilerException where
    show :: CompilerException -> String
show CompilerException
GhcjsNotSupported = String
"GHCJS is no longer supported by Stack"
    show (PantryException PantryException
p) = PantryException -> String
forall e. Exception e => e -> String
displayException PantryException
p
instance Exception CompilerException

wantedToActual :: WantedCompiler -> Either CompilerException ActualCompiler
wantedToActual :: WantedCompiler -> Either CompilerException ActualCompiler
wantedToActual (WCGhc Version
x) = ActualCompiler -> Either CompilerException ActualCompiler
forall a b. b -> Either a b
Right (ActualCompiler -> Either CompilerException ActualCompiler)
-> ActualCompiler -> Either CompilerException ActualCompiler
forall a b. (a -> b) -> a -> b
$ Version -> ActualCompiler
ACGhc Version
x
wantedToActual (WCGhcjs Version
_ Version
_) = CompilerException -> Either CompilerException ActualCompiler
forall a b. a -> Either a b
Left CompilerException
GhcjsNotSupported
wantedToActual (WCGhcGit Text
x Text
y) = ActualCompiler -> Either CompilerException ActualCompiler
forall a b. b -> Either a b
Right (ActualCompiler -> Either CompilerException ActualCompiler)
-> ActualCompiler -> Either CompilerException ActualCompiler
forall a b. (a -> b) -> a -> b
$ Text -> Text -> ActualCompiler
ACGhcGit Text
x Text
y

actualToWanted :: ActualCompiler -> WantedCompiler
actualToWanted :: ActualCompiler -> WantedCompiler
actualToWanted (ACGhc Version
x) = Version -> WantedCompiler
WCGhc Version
x
actualToWanted (ACGhcGit Text
x Text
y) = Text -> Text -> WantedCompiler
WCGhcGit Text
x Text
y

parseActualCompiler :: T.Text -> Either CompilerException ActualCompiler
parseActualCompiler :: Text -> Either CompilerException ActualCompiler
parseActualCompiler =
  (PantryException -> Either CompilerException ActualCompiler)
-> (WantedCompiler -> Either CompilerException ActualCompiler)
-> Either PantryException WantedCompiler
-> Either CompilerException ActualCompiler
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (CompilerException -> Either CompilerException ActualCompiler
forall a b. a -> Either a b
Left (CompilerException -> Either CompilerException ActualCompiler)
-> (PantryException -> CompilerException)
-> PantryException
-> Either CompilerException ActualCompiler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PantryException -> CompilerException
PantryException) WantedCompiler -> Either CompilerException ActualCompiler
wantedToActual (Either PantryException WantedCompiler
 -> Either CompilerException ActualCompiler)
-> (Text -> Either PantryException WantedCompiler)
-> Text
-> Either CompilerException ActualCompiler
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Text -> Either PantryException WantedCompiler
parseWantedCompiler

compilerVersionText :: ActualCompiler -> T.Text
compilerVersionText :: ActualCompiler -> Text
compilerVersionText = Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text)
-> (ActualCompiler -> Utf8Builder) -> ActualCompiler -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActualCompiler -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display

compilerVersionString :: ActualCompiler -> String
compilerVersionString :: ActualCompiler -> String
compilerVersionString = Text -> String
T.unpack (Text -> String)
-> (ActualCompiler -> Text) -> ActualCompiler -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActualCompiler -> Text
compilerVersionText

whichCompiler :: ActualCompiler -> WhichCompiler
whichCompiler :: ActualCompiler -> WhichCompiler
whichCompiler ACGhc{} = WhichCompiler
Ghc
whichCompiler ACGhcGit{} = WhichCompiler
Ghc

isWantedCompiler :: VersionCheck -> WantedCompiler -> ActualCompiler -> Bool
isWantedCompiler :: VersionCheck -> WantedCompiler -> ActualCompiler -> Bool
isWantedCompiler VersionCheck
check (WCGhc Version
wanted) (ACGhc Version
actual) =
    VersionCheck -> Version -> Version -> Bool
checkVersion VersionCheck
check Version
wanted Version
actual
isWantedCompiler VersionCheck
_check (WCGhcGit Text
wCommit Text
wFlavour) (ACGhcGit Text
aCommit Text
aFlavour) =
    Text
wCommit Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
aCommit Bool -> Bool -> Bool
&& Text
wFlavour Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
aFlavour
isWantedCompiler VersionCheck
_ WantedCompiler
_ ActualCompiler
_ = Bool
False

getGhcVersion :: ActualCompiler -> Version
getGhcVersion :: ActualCompiler -> Version
getGhcVersion (ACGhc Version
v) = Version
v
getGhcVersion (ACGhcGit Text
_ Text
_) =
   -- We can't return the actual version without running the installed ghc.
   -- For now we assume that users of ghc-git use it with a recent commit so we
   -- return a version far in the future. This disables our hacks for older
   -- versions and passes version checking when we use newer features.
   [Int] -> Version
mkVersion [Int
999,Int
0,Int
0]

-- | Repository containing the compiler sources
newtype CompilerRepository
  = CompilerRepository Text
  deriving (Int -> CompilerRepository -> ShowS
[CompilerRepository] -> ShowS
CompilerRepository -> String
(Int -> CompilerRepository -> ShowS)
-> (CompilerRepository -> String)
-> ([CompilerRepository] -> ShowS)
-> Show CompilerRepository
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompilerRepository] -> ShowS
$cshowList :: [CompilerRepository] -> ShowS
show :: CompilerRepository -> String
$cshow :: CompilerRepository -> String
showsPrec :: Int -> CompilerRepository -> ShowS
$cshowsPrec :: Int -> CompilerRepository -> ShowS
Show)

instance FromJSON CompilerRepository where
  parseJSON :: Value -> Parser CompilerRepository
parseJSON = String
-> (Text -> Parser CompilerRepository)
-> Value
-> Parser CompilerRepository
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"CompilerRepository" (CompilerRepository -> Parser CompilerRepository
forall (m :: * -> *) a. Monad m => a -> m a
return (CompilerRepository -> Parser CompilerRepository)
-> (Text -> CompilerRepository)
-> Text
-> Parser CompilerRepository
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CompilerRepository
CompilerRepository)

defaultCompilerRepository :: CompilerRepository
defaultCompilerRepository :: CompilerRepository
defaultCompilerRepository = Text -> CompilerRepository
CompilerRepository Text
"https://gitlab.haskell.org/ghc/ghc.git"