{-# LANGUAGE NoImplicitPrelude #-}

module Stack.Types.CompilerPaths
  ( CompilerPaths (..)
  , GhcPkgExe (..)
  , HasCompiler (..)
  , cabalVersionL
  , 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
cpCompilerVersion :: !ActualCompiler
  , CompilerPaths -> Arch
cpArch :: !Arch
  , CompilerPaths -> CompilerBuild
cpBuild :: !CompilerBuild
  , CompilerPaths -> Path Abs File
cpCompiler :: !(Path Abs File)
  , CompilerPaths -> GhcPkgExe
cpPkg :: !GhcPkgExe
    -- ^ ghc-pkg or equivalent

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

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

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

  , CompilerPaths -> Version
cpCabalVersion :: !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
cpGlobalDB :: !(Path Abs Dir)
    -- ^ Global package database

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

  , CompilerPaths -> Map PackageName DumpPackage
cpGlobalDump :: !(Map PackageName DumpPackage)
  }
  deriving Int -> CompilerPaths -> ShowS
[CompilerPaths] -> ShowS
CompilerPaths -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompilerPaths] -> ShowS
$cshowList :: [CompilerPaths] -> ShowS
show :: CompilerPaths -> String
$cshow :: CompilerPaths -> String
showsPrec :: Int -> CompilerPaths -> ShowS
$cshowsPrec :: Int -> 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 = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GhcPkgExe] -> ShowS
$cshowList :: [GhcPkgExe] -> ShowS
show :: GhcPkgExe -> String
$cshow :: GhcPkgExe -> String
showsPrec :: Int -> GhcPkgExe -> ShowS
$cshowsPrec :: Int -> GhcPkgExe -> ShowS
Show

cabalVersionL :: HasCompiler env => SimpleGetter env Version
cabalVersionL :: forall env. HasCompiler env => SimpleGetter env Version
cabalVersionL = forall env. HasCompiler env => SimpleGetter env CompilerPaths
compilerPathsLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to CompilerPaths -> Version
cpCabalVersion

cpWhich :: (MonadReader env m, HasCompiler env) => m WhichCompiler
cpWhich :: forall env (m :: * -> *).
(MonadReader env m, HasCompiler env) =>
m WhichCompiler
cpWhich = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasCompiler env => SimpleGetter env CompilerPaths
compilerPathsLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to (ActualCompiler -> WhichCompiler
whichCompilerforall b c a. (b -> c) -> (a -> b) -> a -> c
.CompilerPaths -> ActualCompiler
cpCompilerVersion)

-- | 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 = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasCompiler env => SimpleGetter env CompilerPaths
compilerPathsLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to CompilerPaths -> Path Abs File
cpCompiler

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

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