{-# LANGUAGE NoImplicitPrelude #-}

module Stack.Types.EnvConfig
  ( EnvConfig (..)
  , HasEnvConfig (..)
  , HasSourceMap (..)
  , actualCompilerVersionL
  , appropriateGhcColorFlag
  , bindirCompilerTools
  , compilerVersionDir
  , extraBinDirs
  , hoogleDatabasePath
  , hoogleRoot
  , hpcReportDir
  , installationRootDeps
  , installationRootLocal
  , packageDatabaseDeps
  , packageDatabaseExtra
  , packageDatabaseLocal
  , platformGhcRelDir
  , platformGhcVerOnlyRelDir
  , platformSnapAndCompilerRel
  , shouldForceGhcColorFlag
  , snapshotsDir
  , useShaPathOnWindows
  , shaPathForBytes
  ) where

import           Crypto.Hash ( SHA1 (..), hashWith )
import qualified Data.ByteArray.Encoding as Mem ( Base(Base16), convertToBase )
import qualified Data.ByteString.Char8 as S8
import qualified Data.Text as T
import qualified Distribution.Text ( display )
import           Distribution.Version ( mkVersion )
import           Path
                   ( (</>), parseAbsDir, parseAbsFile, parseRelDir
                   , parseRelFile
                   )
import           RIO.Process ( HasProcessContext (..) )
import           Stack.Constants
                   ( bindirSuffix, ghcColorForceFlag, osIsWindows, relDirCompilerTools
                   , relDirHoogle, relDirHpc, relDirInstall, relDirPkgdb
                   , relDirSnapshots, relFileDatabaseHoo
                   )
import           Stack.Prelude
import           Stack.Types.BuildConfig
                    ( BuildConfig (..), HasBuildConfig (..), getProjectWorkDir )
import           Stack.Types.BuildOpts ( BuildOptsCLI )
import           Stack.Types.Compiler
                   ( ActualCompiler (..), compilerVersionString, getGhcVersion )
import           Stack.Types.CompilerBuild ( compilerBuildSuffix )
import           Stack.Types.CompilerPaths
                   ( CompilerPaths (..), HasCompiler (..) )
import           Stack.Types.Config ( HasConfig (..), stackRootL )
import           Stack.Types.GHCVariant ( HasGHCVariant (..), ghcVariantSuffix )
import           Stack.Types.Platform
                   ( HasPlatform (..), platformVariantSuffix )
import           Stack.Types.Runner ( HasRunner (..) )
import           Stack.Types.SourceMap
                   ( SourceMap (..), SourceMapHash, smRelDir )

-- | Configuration after the environment has been setup.

data EnvConfig = EnvConfig
  { EnvConfig -> BuildConfig
envConfigBuildConfig :: !BuildConfig
  , EnvConfig -> BuildOptsCLI
envConfigBuildOptsCLI :: !BuildOptsCLI
  , EnvConfig -> SourceMap
envConfigSourceMap :: !SourceMap
  , EnvConfig -> SourceMapHash
envConfigSourceMapHash :: !SourceMapHash
  , EnvConfig -> CompilerPaths
envConfigCompilerPaths :: !CompilerPaths
  }

instance HasConfig EnvConfig where
  configL :: Lens' EnvConfig Config
configL = forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BuildConfig -> Config
bcConfig (\BuildConfig
x Config
y -> BuildConfig
x { bcConfig :: Config
bcConfig = Config
y })
  {-# INLINE configL #-}

instance HasBuildConfig EnvConfig where
  buildConfigL :: Lens' EnvConfig BuildConfig
buildConfigL = forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    EnvConfig -> BuildConfig
envConfigBuildConfig
    (\EnvConfig
x BuildConfig
y -> EnvConfig
x { envConfigBuildConfig :: BuildConfig
envConfigBuildConfig = BuildConfig
y })

instance HasPlatform EnvConfig where
  platformL :: Lens' EnvConfig Platform
platformL = forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasPlatform env => Lens' env Platform
platformL
  {-# INLINE platformL #-}
  platformVariantL :: Lens' EnvConfig PlatformVariant
platformVariantL = forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasPlatform env => Lens' env PlatformVariant
platformVariantL
  {-# INLINE platformVariantL #-}

instance HasGHCVariant EnvConfig where
  ghcVariantL :: SimpleGetter EnvConfig GHCVariant
ghcVariantL = forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasGHCVariant env => SimpleGetter env GHCVariant
ghcVariantL
  {-# INLINE ghcVariantL #-}

instance HasProcessContext EnvConfig where
  processContextL :: Lens' EnvConfig ProcessContext
processContextL = forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasProcessContext env => Lens' env ProcessContext
processContextL

instance HasPantryConfig EnvConfig where
  pantryConfigL :: Lens' EnvConfig PantryConfig
pantryConfigL = forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasPantryConfig env => Lens' env PantryConfig
pantryConfigL

instance HasCompiler EnvConfig where
  compilerPathsL :: SimpleGetter EnvConfig CompilerPaths
compilerPathsL = forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> CompilerPaths
envConfigCompilerPaths

instance HasRunner EnvConfig where
  runnerL :: Lens' EnvConfig Runner
runnerL = forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasRunner env => Lens' env Runner
runnerL

instance HasLogFunc EnvConfig where
  logFuncL :: Lens' EnvConfig LogFunc
logFuncL = forall env. HasRunner env => Lens' env Runner
runnerLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasLogFunc env => Lens' env LogFunc
logFuncL

instance HasStylesUpdate EnvConfig where
  stylesUpdateL :: Lens' EnvConfig StylesUpdate
stylesUpdateL = forall env. HasRunner env => Lens' env Runner
runnerLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasStylesUpdate env => Lens' env StylesUpdate
stylesUpdateL

instance HasTerm EnvConfig where
  useColorL :: Lens' EnvConfig Bool
useColorL = forall env. HasRunner env => Lens' env Runner
runnerLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasTerm env => Lens' env Bool
useColorL
  termWidthL :: Lens' EnvConfig Int
termWidthL = forall env. HasRunner env => Lens' env Runner
runnerLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasTerm env => Lens' env Int
termWidthL

class (HasBuildConfig env, HasSourceMap env, HasCompiler env) => HasEnvConfig env where
  envConfigL :: Lens' env EnvConfig

instance HasEnvConfig EnvConfig where
  envConfigL :: Lens' EnvConfig EnvConfig
envConfigL = forall a. a -> a
id
  {-# INLINE envConfigL #-}

class HasSourceMap env where
  sourceMapL :: Lens' env SourceMap

instance HasSourceMap EnvConfig where
  sourceMapL :: Lens' EnvConfig SourceMap
sourceMapL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EnvConfig -> SourceMap
envConfigSourceMap (\EnvConfig
x SourceMap
y -> EnvConfig
x { envConfigSourceMap :: SourceMap
envConfigSourceMap = SourceMap
y })

shouldForceGhcColorFlag ::
     (HasEnvConfig env, HasRunner env)
  => RIO env Bool
shouldForceGhcColorFlag :: forall env. (HasEnvConfig env, HasRunner env) => RIO env Bool
shouldForceGhcColorFlag = do
  Bool
canDoColor <- (forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8, Int
2, Int
1]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActualCompiler -> Version
getGhcVersion
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionL
  Bool
shouldDoColor <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasTerm env => Lens' env Bool
useColorL
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool
canDoColor Bool -> Bool -> Bool
&& Bool
shouldDoColor

appropriateGhcColorFlag ::
     (HasEnvConfig env, HasRunner env)
  => RIO env (Maybe String)
appropriateGhcColorFlag :: forall env.
(HasEnvConfig env, HasRunner env) =>
RIO env (Maybe String)
appropriateGhcColorFlag = Bool -> Maybe String
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env. (HasEnvConfig env, HasRunner env) => RIO env Bool
shouldForceGhcColorFlag
 where
  f :: Bool -> Maybe String
f Bool
True = forall a. a -> Maybe a
Just String
ghcColorForceFlag
  f Bool
False = forall a. Maybe a
Nothing

-- | Directory containing snapshots

snapshotsDir ::
     (HasEnvConfig env, MonadReader env m, MonadThrow m)
  => m (Path Abs Dir)
snapshotsDir :: forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
m (Path Abs Dir)
snapshotsDir = do
  Path Abs Dir
root <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s. HasConfig s => Lens' s (Path Abs Dir)
stackRootL
  Path Rel Dir
platform <- forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
m (Path Rel Dir)
platformGhcRelDir
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Path Abs Dir
root forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirSnapshots forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
platform

-- | Installation root for dependencies

installationRootDeps :: HasEnvConfig env => RIO env (Path Abs Dir)
installationRootDeps :: forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootDeps = do
  Path Abs Dir
root <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s. HasConfig s => Lens' s (Path Abs Dir)
stackRootL
  -- TODO: also useShaPathOnWindows here, once #1173 is resolved.

  Path Rel Dir
psc <- forall env. HasEnvConfig env => RIO env (Path Rel Dir)
platformSnapAndCompilerRel
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Path Abs Dir
root forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirSnapshots forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
psc

-- | Installation root for locals

installationRootLocal :: HasEnvConfig env => RIO env (Path Abs Dir)
installationRootLocal :: forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootLocal = do
  Path Abs Dir
workDir <- forall env (m :: * -> *).
(HasBuildConfig env, MonadReader env m) =>
m (Path Abs Dir)
getProjectWorkDir
  Path Rel Dir
psc <- forall (m :: * -> *).
MonadThrow m =>
Path Rel Dir -> m (Path Rel Dir)
useShaPathOnWindows forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall env. HasEnvConfig env => RIO env (Path Rel Dir)
platformSnapAndCompilerRel
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Path Abs Dir
workDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirInstall forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
psc

-- | Get the hoogle database path.

hoogleDatabasePath :: HasEnvConfig env => RIO env (Path Abs File)
hoogleDatabasePath :: forall env. HasEnvConfig env => RIO env (Path Abs File)
hoogleDatabasePath = do
  Path Abs Dir
dir <- forall env. HasEnvConfig env => RIO env (Path Abs Dir)
hoogleRoot
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs Dir
dir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileDatabaseHoo)

-- | Path for platform followed by snapshot name followed by compiler

-- name.

platformSnapAndCompilerRel :: HasEnvConfig env => RIO env (Path Rel Dir)
platformSnapAndCompilerRel :: forall env. HasEnvConfig env => RIO env (Path Rel Dir)
platformSnapAndCompilerRel = do
  Path Rel Dir
platform <- forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
m (Path Rel Dir)
platformGhcRelDir
  SourceMapHash
smh <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> SourceMapHash
envConfigSourceMapHash
  Path Rel Dir
name <- forall (m :: * -> *).
MonadThrow m =>
SourceMapHash -> m (Path Rel Dir)
smRelDir SourceMapHash
smh
  Path Rel Dir
ghc <- forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
m (Path Rel Dir)
compilerVersionDir
  forall (m :: * -> *).
MonadThrow m =>
Path Rel Dir -> m (Path Rel Dir)
useShaPathOnWindows (Path Rel Dir
platform forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
name forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
ghc)

-- | Relative directory for the platform and GHC identifier

platformGhcRelDir ::
     (HasEnvConfig env, MonadReader env m, MonadThrow m)
  => m (Path Rel Dir)
platformGhcRelDir :: forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
m (Path Rel Dir)
platformGhcRelDir = do
  CompilerPaths
cp <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasCompiler env => SimpleGetter env CompilerPaths
compilerPathsL
  let cbSuffix :: String
cbSuffix = CompilerBuild -> String
compilerBuildSuffix forall a b. (a -> b) -> a -> b
$ CompilerPaths -> CompilerBuild
cpBuild CompilerPaths
cp
  String
verOnly <- forall env (m :: * -> *).
(HasGHCVariant env, HasPlatform env, MonadReader env m) =>
m String
platformGhcVerOnlyRelDirStr
  forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir (forall a. Monoid a => [a] -> a
mconcat [ String
verOnly, String
cbSuffix ])

-- | Installation root for compiler tools

bindirCompilerTools ::
     (HasEnvConfig env, MonadReader env m, MonadThrow m)
  => m (Path Abs Dir)
bindirCompilerTools :: forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
m (Path Abs Dir)
bindirCompilerTools = do
  Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
  Path Rel Dir
platform <- forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
m (Path Rel Dir)
platformGhcRelDir
  ActualCompiler
compilerVersion <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionL
  Path Rel Dir
compiler <- forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir forall a b. (a -> b) -> a -> b
$ ActualCompiler -> String
compilerVersionString ActualCompiler
compilerVersion
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s. HasConfig s => Lens' s (Path Abs Dir)
stackRootL Config
config forall b t. Path b Dir -> Path Rel t -> Path b t
</>
    Path Rel Dir
relDirCompilerTools forall b t. Path b Dir -> Path Rel t -> Path b t
</>
    Path Rel Dir
platform forall b t. Path b Dir -> Path Rel t -> Path b t
</>
    Path Rel Dir
compiler forall b t. Path b Dir -> Path Rel t -> Path b t
</>
    Path Rel Dir
bindirSuffix

-- | Hoogle directory.

hoogleRoot :: HasEnvConfig env => RIO env (Path Abs Dir)
hoogleRoot :: forall env. HasEnvConfig env => RIO env (Path Abs Dir)
hoogleRoot = do
  Path Abs Dir
workDir <- forall env (m :: * -> *).
(HasBuildConfig env, MonadReader env m) =>
m (Path Abs Dir)
getProjectWorkDir
  Path Rel Dir
psc <- forall (m :: * -> *).
MonadThrow m =>
Path Rel Dir -> m (Path Rel Dir)
useShaPathOnWindows forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall env. HasEnvConfig env => RIO env (Path Rel Dir)
platformSnapAndCompilerRel
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Path Abs Dir
workDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirHoogle forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
psc

compilerVersionDir ::
     (HasEnvConfig env, MonadReader env m, MonadThrow m)
  => m (Path Rel Dir)
compilerVersionDir :: forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
m (Path Rel Dir)
compilerVersionDir = do
  ActualCompiler
compilerVersion <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionL
  forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir forall a b. (a -> b) -> a -> b
$ case ActualCompiler
compilerVersion of
    ACGhc Version
version -> Version -> String
versionString Version
version
    ACGhcGit {} -> ActualCompiler -> String
compilerVersionString ActualCompiler
compilerVersion

-- | Package database for installing dependencies into

packageDatabaseDeps :: HasEnvConfig env => RIO env (Path Abs Dir)
packageDatabaseDeps :: forall env. HasEnvConfig env => RIO env (Path Abs Dir)
packageDatabaseDeps = do
  Path Abs Dir
root <- forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootDeps
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Path Abs Dir
root forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirPkgdb

-- | Package database for installing local packages into

packageDatabaseLocal :: HasEnvConfig env => RIO env (Path Abs Dir)
packageDatabaseLocal :: forall env. HasEnvConfig env => RIO env (Path Abs Dir)
packageDatabaseLocal = do
  Path Abs Dir
root <- forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootLocal
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Path Abs Dir
root forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirPkgdb

-- | Extra package databases

packageDatabaseExtra ::
     (HasEnvConfig env, MonadReader env m)
  => m [Path Abs Dir]
packageDatabaseExtra :: forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m) =>
m [Path Abs Dir]
packageDatabaseExtra = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to BuildConfig -> [Path Abs Dir]
bcExtraPackageDBs

-- | Where HPC reports and tix files get stored.

hpcReportDir :: HasEnvConfig env => RIO env (Path Abs Dir)
hpcReportDir :: forall env. HasEnvConfig env => RIO env (Path Abs Dir)
hpcReportDir = do
  Path Abs Dir
root <- forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootLocal
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Path Abs Dir
root forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirHpc

-- | Get the extra bin directories (for the PATH). Puts more local first

--

-- Bool indicates whether or not to include the locals

extraBinDirs :: HasEnvConfig env => RIO env (Bool -> [Path Abs Dir])
extraBinDirs :: forall env. HasEnvConfig env => RIO env (Bool -> [Path Abs Dir])
extraBinDirs = do
  Path Abs Dir
deps <- forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootDeps
  Path Abs Dir
local' <- forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootLocal
  Path Abs Dir
tools <- forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
m (Path Abs Dir)
bindirCompilerTools
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \Bool
locals -> if Bool
locals
    then [Path Abs Dir
local' forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
bindirSuffix, Path Abs Dir
deps forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
bindirSuffix, Path Abs Dir
tools]
    else [Path Abs Dir
deps forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
bindirSuffix, Path Abs Dir
tools]

-- | The version of the compiler which will actually be used. May be different

-- than that specified in the 'SnapshotDef' and returned by

-- 'wantedCompilerVersionL'.

actualCompilerVersionL :: HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionL :: forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionL = forall env. HasSourceMap env => Lens' env SourceMap
sourceMapLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to SourceMap -> ActualCompiler
smCompiler

-- | Relative directory for the platform and GHC identifier without GHC bindist

-- build

platformGhcVerOnlyRelDir ::
     (HasGHCVariant env, HasPlatform env, MonadReader env m, MonadThrow m)
  => m (Path Rel Dir)
platformGhcVerOnlyRelDir :: forall env (m :: * -> *).
(HasGHCVariant env, HasPlatform env, MonadReader env m,
 MonadThrow m) =>
m (Path Rel Dir)
platformGhcVerOnlyRelDir =
  forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall env (m :: * -> *).
(HasGHCVariant env, HasPlatform env, MonadReader env m) =>
m String
platformGhcVerOnlyRelDirStr

-- | Relative directory for the platform and GHC identifier without GHC bindist

-- build (before parsing into a Path)

platformGhcVerOnlyRelDirStr ::
     (HasGHCVariant env, HasPlatform env, MonadReader env m)
  => m FilePath
platformGhcVerOnlyRelDirStr :: forall env (m :: * -> *).
(HasGHCVariant env, HasPlatform env, MonadReader env m) =>
m String
platformGhcVerOnlyRelDirStr = do
  Platform
platform <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasPlatform env => Lens' env Platform
platformL
  PlatformVariant
platformVariant <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasPlatform env => Lens' env PlatformVariant
platformVariantL
  GHCVariant
ghcVariant <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasGHCVariant env => SimpleGetter env GHCVariant
ghcVariantL
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [ forall a. Pretty a => a -> String
Distribution.Text.display Platform
platform
                   , PlatformVariant -> String
platformVariantSuffix PlatformVariant
platformVariant
                   , GHCVariant -> String
ghcVariantSuffix GHCVariant
ghcVariant ]

-- | This is an attempt to shorten Stack paths on Windows to decrease our

-- chances of hitting 260 symbol path limit. The idea is to calculate

-- SHA1 hash of the path used on other architectures, encode with base

-- 16 and take first 8 symbols of it.

useShaPathOnWindows :: MonadThrow m => Path Rel Dir -> m (Path Rel Dir)
useShaPathOnWindows :: forall (m :: * -> *).
MonadThrow m =>
Path Rel Dir -> m (Path Rel Dir)
useShaPathOnWindows
  | Bool
osIsWindows = forall t (m :: * -> *).
(IsPath Rel t, MonadThrow m) =>
Path Rel t -> m (Path Rel t)
shaPath
  | Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure

shaPath :: (IsPath Rel t, MonadThrow m) => Path Rel t -> m (Path Rel t)
shaPath :: forall t (m :: * -> *).
(IsPath Rel t, MonadThrow m) =>
Path Rel t -> m (Path Rel t)
shaPath = forall t (m :: * -> *).
(IsPath Rel t, MonadThrow m) =>
ByteString -> m (Path Rel t)
shaPathForBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> String
toFilePath

shaPathForBytes :: (IsPath Rel t, MonadThrow m) => ByteString -> m (Path Rel t)
shaPathForBytes :: forall t (m :: * -> *).
(IsPath Rel t, MonadThrow m) =>
ByteString -> m (Path Rel t)
shaPathForBytes
  = forall b t (m :: * -> *).
(IsPath b t, MonadThrow m) =>
String -> m (Path b t)
parsePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
S8.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
S8.take Int
8
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
Mem.convertToBase Base
Mem.Base16 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA1
SHA1

-- TODO: Move something like this into the path package. Consider

-- subsuming path-io's 'AnyPath'?

class IsPath b t where
  parsePath :: MonadThrow m => FilePath -> m (Path b t)

instance IsPath Abs Dir where
  parsePath :: forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
parsePath = forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
parseAbsDir

instance IsPath Rel Dir where
  parsePath :: forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parsePath = forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir

instance IsPath Abs File where
  parsePath :: forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parsePath = forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseAbsFile

instance IsPath Rel File where
  parsePath :: forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parsePath = forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile