{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE NoFieldSelectors    #-}
{-# LANGUAGE OverloadedRecordDot #-}

module Stack.Types.CompilerPaths
  ( CompilerPaths (..)
  , GhcPkgExe (..)
  , HasCompiler (..)
  , cabalVersionL
  , compilerVersionL
  , cpWhich
  , getCompilerPath
  , getGhcPkgExe
  ) where

import           Distribution.System ( Arch )
import           Stack.Prelude
import           Stack.Types.Compiler
                   ( ActualCompiler, WhichCompiler, whichCompiler )
import           Stack.Types.CompilerBuild ( CompilerBuild )
import           Stack.Types.DumpPackage ( DumpPackage )

-- | Paths on the filesystem for the compiler we're using

data CompilerPaths = CompilerPaths
  { CompilerPaths -> ActualCompiler
compilerVersion :: !ActualCompiler
  , CompilerPaths -> Arch
arch :: !Arch
  , CompilerPaths -> CompilerBuild
build :: !CompilerBuild
  , CompilerPaths -> Path Abs File
compiler :: !(Path Abs File)
  , CompilerPaths -> GhcPkgExe
pkg :: !GhcPkgExe
    -- ^ ghc-pkg or equivalent

  , CompilerPaths -> Path Abs File
interpreter :: !(Path Abs File)
    -- ^ runghc

  , CompilerPaths -> Path Abs File
haddock :: !(Path Abs File)
    -- ^ haddock, in 'IO' to allow deferring the lookup

  , CompilerPaths -> Bool
sandboxed :: !Bool
    -- ^ Is this a Stack-sandboxed installation?

  , CompilerPaths -> Version
cabalVersion :: !Version
    -- ^ This is the version of Cabal that Stack will use to compile Setup.hs

    -- files in the build process.

    --

    -- Note that this is not necessarily the same version as the one that Stack

    -- depends on as a library and which is displayed when running

    -- @stack ls dependencies | grep Cabal@ in the Stack project.

  , CompilerPaths -> Path Abs Dir
globalDB :: !(Path Abs Dir)
    -- ^ Global package database

  , CompilerPaths -> ByteString
ghcInfo :: !ByteString
    -- ^ Output of @ghc --info@

  , CompilerPaths -> Map PackageName DumpPackage
globalDump :: !(Map PackageName DumpPackage)
  }
  deriving Int -> CompilerPaths -> ShowS
[CompilerPaths] -> ShowS
CompilerPaths -> String
(Int -> CompilerPaths -> ShowS)
-> (CompilerPaths -> String)
-> ([CompilerPaths] -> ShowS)
-> Show CompilerPaths
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompilerPaths -> ShowS
showsPrec :: Int -> CompilerPaths -> ShowS
$cshow :: CompilerPaths -> String
show :: CompilerPaths -> String
$cshowList :: [CompilerPaths] -> ShowS
showList :: [CompilerPaths] -> ShowS
Show

-- | An environment which ensures that the given compiler is available on the

-- PATH

class HasCompiler env where
  compilerPathsL :: SimpleGetter env CompilerPaths

instance HasCompiler CompilerPaths where
  compilerPathsL :: SimpleGetter CompilerPaths CompilerPaths
compilerPathsL = (CompilerPaths -> Const r CompilerPaths)
-> CompilerPaths -> Const r CompilerPaths
forall a. a -> a
id

-- | Location of the ghc-pkg executable

newtype GhcPkgExe
  = GhcPkgExe (Path Abs File)
  deriving Int -> GhcPkgExe -> ShowS
[GhcPkgExe] -> ShowS
GhcPkgExe -> String
(Int -> GhcPkgExe -> ShowS)
-> (GhcPkgExe -> String)
-> ([GhcPkgExe] -> ShowS)
-> Show GhcPkgExe
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GhcPkgExe -> ShowS
showsPrec :: Int -> GhcPkgExe -> ShowS
$cshow :: GhcPkgExe -> String
show :: GhcPkgExe -> String
$cshowList :: [GhcPkgExe] -> ShowS
showList :: [GhcPkgExe] -> ShowS
Show

cabalVersionL :: HasCompiler env => SimpleGetter env Version
cabalVersionL :: forall env. HasCompiler env => SimpleGetter env Version
cabalVersionL = Getting r env CompilerPaths
forall env. HasCompiler env => SimpleGetter env CompilerPaths
SimpleGetter env CompilerPaths
compilerPathsL Getting r env CompilerPaths
-> ((Version -> Const r Version)
    -> CompilerPaths -> Const r CompilerPaths)
-> (Version -> Const r Version)
-> env
-> Const r env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompilerPaths -> Version) -> SimpleGetter CompilerPaths Version
forall s a. (s -> a) -> SimpleGetter s a
to (.cabalVersion)

compilerVersionL :: HasCompiler env => SimpleGetter env ActualCompiler
compilerVersionL :: forall env. HasCompiler env => SimpleGetter env ActualCompiler
compilerVersionL = Getting r env CompilerPaths
forall env. HasCompiler env => SimpleGetter env CompilerPaths
SimpleGetter env CompilerPaths
compilerPathsL Getting r env CompilerPaths
-> ((ActualCompiler -> Const r ActualCompiler)
    -> CompilerPaths -> Const r CompilerPaths)
-> (ActualCompiler -> Const r ActualCompiler)
-> env
-> Const r env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompilerPaths -> ActualCompiler)
-> SimpleGetter CompilerPaths ActualCompiler
forall s a. (s -> a) -> SimpleGetter s a
to (.compilerVersion)

cpWhich :: (MonadReader env m, HasCompiler env) => m WhichCompiler
cpWhich :: forall env (m :: * -> *).
(MonadReader env m, HasCompiler env) =>
m WhichCompiler
cpWhich = Getting WhichCompiler env WhichCompiler -> m WhichCompiler
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting WhichCompiler env WhichCompiler -> m WhichCompiler)
-> Getting WhichCompiler env WhichCompiler -> m WhichCompiler
forall a b. (a -> b) -> a -> b
$ Getting WhichCompiler env CompilerPaths
forall env. HasCompiler env => SimpleGetter env CompilerPaths
SimpleGetter env CompilerPaths
compilerPathsL Getting WhichCompiler env CompilerPaths
-> ((WhichCompiler -> Const WhichCompiler WhichCompiler)
    -> CompilerPaths -> Const WhichCompiler CompilerPaths)
-> Getting WhichCompiler env WhichCompiler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompilerPaths -> WhichCompiler)
-> SimpleGetter CompilerPaths WhichCompiler
forall s a. (s -> a) -> SimpleGetter s a
to (ActualCompiler -> WhichCompiler
whichCompiler (ActualCompiler -> WhichCompiler)
-> (CompilerPaths -> ActualCompiler)
-> CompilerPaths
-> WhichCompiler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.compilerVersion))

-- | Get the path for the given compiler ignoring any local binaries.

--

-- https://github.com/commercialhaskell/stack/issues/1052

getCompilerPath :: HasCompiler env => RIO env (Path Abs File)
getCompilerPath :: forall env. HasCompiler env => RIO env (Path Abs File)
getCompilerPath = Getting (Path Abs File) env (Path Abs File)
-> RIO env (Path Abs File)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Path Abs File) env (Path Abs File)
 -> RIO env (Path Abs File))
-> Getting (Path Abs File) env (Path Abs File)
-> RIO env (Path Abs File)
forall a b. (a -> b) -> a -> b
$ Getting (Path Abs File) env CompilerPaths
forall env. HasCompiler env => SimpleGetter env CompilerPaths
SimpleGetter env CompilerPaths
compilerPathsL Getting (Path Abs File) env CompilerPaths
-> ((Path Abs File -> Const (Path Abs File) (Path Abs File))
    -> CompilerPaths -> Const (Path Abs File) CompilerPaths)
-> Getting (Path Abs File) env (Path Abs File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompilerPaths -> Path Abs File)
-> SimpleGetter CompilerPaths (Path Abs File)
forall s a. (s -> a) -> SimpleGetter s a
to (.compiler)

-- | Get the 'GhcPkgExe' from a 'HasCompiler' environment

getGhcPkgExe :: HasCompiler env => RIO env GhcPkgExe
getGhcPkgExe :: forall env. HasCompiler env => RIO env GhcPkgExe
getGhcPkgExe = Getting GhcPkgExe env GhcPkgExe -> RIO env GhcPkgExe
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting GhcPkgExe env GhcPkgExe -> RIO env GhcPkgExe)
-> Getting GhcPkgExe env GhcPkgExe -> RIO env GhcPkgExe
forall a b. (a -> b) -> a -> b
$ Getting GhcPkgExe env CompilerPaths
forall env. HasCompiler env => SimpleGetter env CompilerPaths
SimpleGetter env CompilerPaths
compilerPathsL Getting GhcPkgExe env CompilerPaths
-> ((GhcPkgExe -> Const GhcPkgExe GhcPkgExe)
    -> CompilerPaths -> Const GhcPkgExe CompilerPaths)
-> Getting GhcPkgExe env GhcPkgExe
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompilerPaths -> GhcPkgExe)
-> SimpleGetter CompilerPaths GhcPkgExe
forall s a. (s -> a) -> SimpleGetter s a
to (.pkg)