{-# LANGUAGE NoImplicitPrelude  #-}
{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TypeFamilies       #-}

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

import           Data.Aeson
                   ( FromJSON (..), FromJSONKey (..), FromJSONKeyFunction (..)
                   , ToJSON (..), Value (..), withText
                   )
import           Database.Persist.Sql
                   ( PersistField (..), PersistFieldSql (..), SqlType (..) )
import qualified Data.Text as T
import           Stack.Prelude
import           Stack.Types.Version ( VersionCheck, checkVersion )
import           Distribution.Version ( mkVersion )

-- | Type representing exceptions thrown by functions exported by the

-- "Stack.Types.Compiler" module.

data CompilerException
  = GhcjsNotSupported
  | PantryException PantryException
  deriving (Int -> CompilerException -> ShowS
[CompilerException] -> ShowS
CompilerException -> String
(Int -> CompilerException -> ShowS)
-> (CompilerException -> String)
-> ([CompilerException] -> ShowS)
-> Show CompilerException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompilerException -> ShowS
showsPrec :: Int -> CompilerException -> ShowS
$cshow :: CompilerException -> String
show :: CompilerException -> String
$cshowList :: [CompilerException] -> ShowS
showList :: [CompilerException] -> ShowS
Show, Typeable)

instance Exception CompilerException where
  displayException :: CompilerException -> String
displayException CompilerException
GhcjsNotSupported =
    String
"Error: [S-7903]\n"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"GHCJS is no longer supported by Stack."
  displayException (PantryException PantryException
p) =
    String
"Error: [S-7972]\n"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ PantryException -> String
forall e. Exception e => e -> String
displayException PantryException
p

-- | Variety of compiler to use.

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

-- | 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 (Typeable ActualCompiler
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 -> Constr
ActualCompiler -> DataType
(forall b. Data b => b -> b) -> ActualCompiler -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ActualCompiler -> c ActualCompiler
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ActualCompiler -> c ActualCompiler
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ActualCompiler
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ActualCompiler
$ctoConstr :: ActualCompiler -> Constr
toConstr :: ActualCompiler -> Constr
$cdataTypeOf :: ActualCompiler -> DataType
dataTypeOf :: ActualCompiler -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ActualCompiler)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ActualCompiler)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ActualCompiler)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ActualCompiler)
$cgmapT :: (forall b. Data b => b -> b) -> ActualCompiler -> ActualCompiler
gmapT :: (forall b. Data b => b -> b) -> ActualCompiler -> ActualCompiler
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ActualCompiler -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ActualCompiler -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ActualCompiler -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ActualCompiler -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ActualCompiler -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ActualCompiler -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ActualCompiler -> m ActualCompiler
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ActualCompiler -> m ActualCompiler
Data, ActualCompiler -> ActualCompiler -> Bool
(ActualCompiler -> ActualCompiler -> Bool)
-> (ActualCompiler -> ActualCompiler -> Bool) -> Eq ActualCompiler
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActualCompiler -> ActualCompiler -> Bool
== :: ActualCompiler -> ActualCompiler -> Bool
$c/= :: ActualCompiler -> ActualCompiler -> Bool
/= :: ActualCompiler -> ActualCompiler -> Bool
Eq, (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
$cfrom :: forall x. ActualCompiler -> Rep ActualCompiler x
from :: forall x. ActualCompiler -> Rep ActualCompiler x
$cto :: forall x. Rep ActualCompiler x -> ActualCompiler
to :: forall x. Rep ActualCompiler x -> ActualCompiler
Generic, 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
$ccompare :: ActualCompiler -> ActualCompiler -> Ordering
compare :: ActualCompiler -> ActualCompiler -> Ordering
$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
>= :: ActualCompiler -> ActualCompiler -> Bool
$cmax :: ActualCompiler -> ActualCompiler -> ActualCompiler
max :: ActualCompiler -> ActualCompiler -> ActualCompiler
$cmin :: ActualCompiler -> ActualCompiler -> ActualCompiler
min :: ActualCompiler -> ActualCompiler -> ActualCompiler
Ord, 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
$cshowsPrec :: Int -> ActualCompiler -> ShowS
showsPrec :: Int -> ActualCompiler -> ShowS
$cshow :: ActualCompiler -> String
show :: ActualCompiler -> String
$cshowList :: [ActualCompiler] -> ShowS
showList :: [ActualCompiler] -> ShowS
Show, 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 a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Failed to parse compiler version")
      ActualCompiler -> Parser ActualCompiler
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Text -> Either CompilerException ActualCompiler
parseActualCompiler Text
t)
  parseJSON Value
_ = String -> Parser ActualCompiler
forall a. String -> Parser a
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 a. String -> Parser a
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 a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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

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
$cshowsPrec :: Int -> CompilerRepository -> ShowS
showsPrec :: Int -> CompilerRepository -> ShowS
$cshow :: CompilerRepository -> String
show :: CompilerRepository -> String
$cshowList :: [CompilerRepository] -> ShowS
showList :: [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 a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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"

whichCompilerL :: Getting r ActualCompiler WhichCompiler
whichCompilerL :: forall r. Getting r ActualCompiler WhichCompiler
whichCompilerL = (ActualCompiler -> WhichCompiler)
-> forall r. Getting r ActualCompiler WhichCompiler
forall s a. (s -> a) -> SimpleGetter s a
to ActualCompiler -> WhichCompiler
whichCompiler