{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE DataKinds #-}

{-# LANGUAGE OverloadedStrings #-}

{-# LANGUAGE DeriveDataTypeable #-}

{-# LANGUAGE DeriveGeneric #-}

{-# LANGUAGE FlexibleInstances #-}

{-# LANGUAGE KindSignatures #-}

{-# LANGUAGE TypeFamilies #-}

module Stack.Types.Compiler where

import Data.Aeson

import Data.Data

import qualified Data.Text as T

import Stack.Prelude

import Stack.Types.Version

-- | Variety of compiler to use.

data WhichCompiler

= Ghc

| Ghcjs

deriving (Show, Eq, Ord)

-- | Whether the compiler version given is the wanted version (what

-- the stack.yaml file, snapshot file, or --resolver argument

-- request), or the actual installed GHC. Depending on the matching

-- requirements, these values could be different.

data CVType = CVWanted | CVActual

-- | 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 CompilerVersion (cvType :: CVType)

= GhcVersion {-# UNPACK #-} !Version

| GhcjsVersion

{-# UNPACK #-} !Version -- GHCJS version

{-# UNPACK #-} !Version -- GHC version

deriving (Generic, Show, Eq, Ord, Data, Typeable)

instance Store (CompilerVersion a)

instance NFData (CompilerVersion a)

instance Display (CompilerVersion a) where

display = display . compilerVersionText

instance ToJSON (CompilerVersion a) where

toJSON = toJSON . compilerVersionText

instance FromJSON (CompilerVersion a) where

parseJSON (String t) = maybe (fail "Failed to parse compiler version") return (parseCompilerVersion t)

parseJSON _ = fail "Invalid CompilerVersion, must be String"

instance FromJSONKey (CompilerVersion a) where

fromJSONKey = FromJSONKeyTextParser $ \k ->

case parseCompilerVersion k of

Nothing -> fail $ "Failed to parse CompilerVersion " ++ T.unpack k

Just parsed -> return parsed

actualToWanted :: CompilerVersion 'CVActual -> CompilerVersion 'CVWanted

actualToWanted (GhcVersion x) = GhcVersion x

actualToWanted (GhcjsVersion x y) = GhcjsVersion x y

wantedToActual :: CompilerVersion 'CVWanted -> CompilerVersion 'CVActual

wantedToActual (GhcVersion x) = GhcVersion x

wantedToActual (GhcjsVersion x y) = GhcjsVersion x y

parseCompilerVersion :: T.Text -> Maybe (CompilerVersion a)

parseCompilerVersion t

| Just t' <- T.stripPrefix "ghc-" t

, Just v <- parseVersionFromString $ T.unpack t'

= Just (GhcVersion v)

| Just t' <- T.stripPrefix "ghcjs-" t

, [tghcjs, tghc] <- T.splitOn "_ghc-" t'

, Just vghcjs <- parseVersionFromString $ T.unpack tghcjs

, Just vghc <- parseVersionFromString $ T.unpack tghc

= Just (GhcjsVersion vghcjs vghc)

| otherwise

= Nothing

compilerVersionText :: CompilerVersion a -> T.Text

compilerVersionText (GhcVersion vghc) =

"ghc-" <> versionText vghc

compilerVersionText (GhcjsVersion vghcjs vghc) =

"ghcjs-" <> versionText vghcjs <> "_ghc-" <> versionText vghc

compilerVersionString :: CompilerVersion a -> String

compilerVersionString = T.unpack . compilerVersionText

whichCompiler :: CompilerVersion a -> WhichCompiler

whichCompiler GhcVersion {} = Ghc

whichCompiler GhcjsVersion {} = Ghcjs

isWantedCompiler :: VersionCheck -> CompilerVersion 'CVWanted -> CompilerVersion 'CVActual -> Bool

isWantedCompiler check (GhcVersion wanted) (GhcVersion actual) =

checkVersion check wanted actual

isWantedCompiler check (GhcjsVersion wanted wantedGhc) (GhcjsVersion actual actualGhc) =

checkVersion check wanted actual && checkVersion check wantedGhc actualGhc

isWantedCompiler _ _ _ = False

getGhcVersion :: CompilerVersion a -> Version

getGhcVersion (GhcVersion v) = v

getGhcVersion (GhcjsVersion _ v) = v

compilerExeName :: WhichCompiler -> String

compilerExeName Ghc = "ghc"

compilerExeName Ghcjs = "ghcjs"

haddockExeName :: WhichCompiler -> String

haddockExeName Ghc = "haddock"

haddockExeName Ghcjs = "haddock-ghcjs"