{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}

module Stack.Setup.Installed
  ( getCompilerVersion
  , markInstalled
  , unmarkInstalled
  , listInstalled
  , Tool (..)
  , toolString
  , toolNameString
  , parseToolText
  , filterTools
  , extraDirs
  , installDir
  , tempInstallDir
  ) where

import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as BL
import           Data.Char ( isDigit )
import qualified Data.List as L
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import           Distribution.System ( Platform (..) )
import qualified Distribution.System as Cabal
import           Path ( (</>), filename, parseRelDir, parseRelFile )
import           Path.IO ( doesDirExist, ignoringAbsence, listDir, removeFile )
import           RIO.Process ( HasProcessContext, proc, readProcess_ )
import           Stack.Constants
                   ( relDirBin, relDirInclude, relDirLib, relDirLocal, relDirMingw
                   , relDirMingw32, relDirMingw64, relDirUsr
                   )
import           Stack.Prelude
import           Stack.Types.Compiler
                   ( ActualCompiler (..), WhichCompiler (..) )
import           Stack.Types.Config ( Config (..), HasConfig (..) )
import           Stack.Types.ExtraDirs ( ExtraDirs (..) )

data Tool
  = Tool PackageIdentifier -- ^ e.g. ghc-7.8.4, msys2-20150512

  | ToolGhcGit !Text !Text   -- ^ e.g. ghc-git-COMMIT_ID-FLAVOUR

  deriving Tool -> Tool -> Bool
(Tool -> Tool -> Bool) -> (Tool -> Tool -> Bool) -> Eq Tool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tool -> Tool -> Bool
== :: Tool -> Tool -> Bool
$c/= :: Tool -> Tool -> Bool
/= :: Tool -> Tool -> Bool
Eq

-- | 'Tool' values are ordered by name (being @ghc-git@, for @ToolGhcGit _ _@)

-- alphabetically and then by version (later versions are ordered before

-- earlier versions, where applicable).

instance Ord Tool where
  compare :: Tool -> Tool -> Ordering
compare (Tool PackageIdentifier
pkgId1) (Tool PackageIdentifier
pkgId2) = if PackageName
pkgName1 PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
pkgName2
    then Version -> Version -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Version
pkgVersion2 Version
pkgVersion1 -- Later versions ordered first

    else PackageName -> PackageName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare PackageName
pkgName1 PackageName
pkgName2
   where
    PackageIdentifier PackageName
pkgName1 Version
pkgVersion1 = PackageIdentifier
pkgId1
    PackageIdentifier PackageName
pkgName2 Version
pkgVersion2 = PackageIdentifier
pkgId2
  compare (Tool PackageIdentifier
pkgId) (ToolGhcGit Text
_ Text
_) = PackageName -> PackageName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PackageIdentifier -> PackageName
pkgName PackageIdentifier
pkgId) PackageName
"ghc-git"
  compare (ToolGhcGit Text
_ Text
_) (Tool PackageIdentifier
pkgId) = PackageName -> PackageName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare PackageName
"ghc-git" (PackageIdentifier -> PackageName
pkgName PackageIdentifier
pkgId)
  compare (ToolGhcGit Text
c1 Text
f1) (ToolGhcGit Text
c2 Text
f2) = if Text
f1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
f2
    then Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
c1 Text
c2
    else Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
f1 Text
f2

toolString :: Tool -> String
toolString :: Tool -> [Char]
toolString (Tool PackageIdentifier
ident) = PackageIdentifier -> [Char]
packageIdentifierString PackageIdentifier
ident
toolString (ToolGhcGit Text
commit Text
flavour) = [Char]
"ghc-git-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
commit [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
flavour

toolNameString :: Tool -> String
toolNameString :: Tool -> [Char]
toolNameString (Tool PackageIdentifier
ident) = PackageName -> [Char]
packageNameString (PackageName -> [Char]) -> PackageName -> [Char]
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> PackageName
pkgName PackageIdentifier
ident
toolNameString ToolGhcGit{} = [Char]
"ghc-git"

parseToolText :: Text -> Maybe Tool
parseToolText :: Text -> Maybe Tool
parseToolText (Text -> Either PantryException WantedCompiler
parseWantedCompiler -> Right WCGhcjs{}) = Maybe Tool
forall a. Maybe a
Nothing
parseToolText (Text -> Either PantryException WantedCompiler
parseWantedCompiler -> Right (WCGhcGit Text
c Text
f)) = Tool -> Maybe Tool
forall a. a -> Maybe a
Just (Text -> Text -> Tool
ToolGhcGit Text
c Text
f)
parseToolText ([Char] -> Maybe PackageIdentifier
parsePackageIdentifier ([Char] -> Maybe PackageIdentifier)
-> (Text -> [Char]) -> Text -> Maybe PackageIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack -> Just PackageIdentifier
pkgId) = Tool -> Maybe Tool
forall a. a -> Maybe a
Just (PackageIdentifier -> Tool
Tool PackageIdentifier
pkgId)
parseToolText Text
_ = Maybe Tool
forall a. Maybe a
Nothing

markInstalled :: (MonadIO m, MonadThrow m)
              => Path Abs Dir
              -> Tool
              -> m ()
markInstalled :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir -> Tool -> m ()
markInstalled Path Abs Dir
programsPath Tool
tool = do
  Path Rel File
fpRel <- [Char] -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel File)
parseRelFile ([Char] -> m (Path Rel File)) -> [Char] -> m (Path Rel File)
forall a b. (a -> b) -> a -> b
$ Tool -> [Char]
toolString Tool
tool [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".installed"
  Path Abs File -> Builder -> m ()
forall (m :: * -> *) absrel.
MonadIO m =>
Path absrel File -> Builder -> m ()
writeBinaryFileAtomic (Path Abs Dir
programsPath Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
fpRel) Builder
"installed"

unmarkInstalled :: MonadIO m
                => Path Abs Dir
                -> Tool
                -> m ()
unmarkInstalled :: forall (m :: * -> *). MonadIO m => Path Abs Dir -> Tool -> m ()
unmarkInstalled Path Abs Dir
programsPath Tool
tool = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Path Rel File
fpRel <- [Char] -> IO (Path Rel File)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel File)
parseRelFile ([Char] -> IO (Path Rel File)) -> [Char] -> IO (Path Rel File)
forall a b. (a -> b) -> a -> b
$ Tool -> [Char]
toolString Tool
tool [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".installed"
  IO () -> IO ()
forall (m :: * -> *) a. (MonadIO m, MonadCatch m) => m a -> m ()
ignoringAbsence (Path Abs File -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b File -> m ()
removeFile (Path Abs File -> IO ()) -> Path Abs File -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
programsPath Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
fpRel)

listInstalled :: (MonadIO m, MonadThrow m)
              => Path Abs Dir
              -> m [Tool]
listInstalled :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir -> m [Tool]
listInstalled Path Abs Dir
programsPath =
  Path Abs Dir -> m Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist Path Abs Dir
programsPath m Bool -> (Bool -> m [Tool]) -> m [Tool]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
False -> [Tool] -> m [Tool]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Bool
True -> do ([Path Abs Dir]
_, [Path Abs File]
files) <- Path Abs Dir -> m ([Path Abs Dir], [Path Abs File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir Path Abs Dir
programsPath
               [Tool] -> m [Tool]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Tool] -> m [Tool]) -> [Tool] -> m [Tool]
forall a b. (a -> b) -> a -> b
$ (Path Abs File -> Maybe Tool) -> [Path Abs File] -> [Tool]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Path Abs File -> Maybe Tool
forall {b}. Path b File -> Maybe Tool
toTool [Path Abs File]
files
 where
  toTool :: Path b File -> Maybe Tool
toTool Path b File
fp = do
    Text
x <- Text -> Text -> Maybe Text
T.stripSuffix Text
".installed" (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Path Rel File -> [Char]
forall b t. Path b t -> [Char]
toFilePath (Path Rel File -> [Char]) -> Path Rel File -> [Char]
forall a b. (a -> b) -> a -> b
$ Path b File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Path b File
fp
    Text -> Maybe Tool
parseToolText Text
x

filterTools :: PackageName       -- ^ package to find

            -> (Version -> Bool) -- ^ which versions are acceptable

            -> [Tool]            -- ^ tools to filter

            -> [PackageIdentifier]
filterTools :: PackageName -> (Version -> Bool) -> [Tool] -> [PackageIdentifier]
filterTools PackageName
name Version -> Bool
goodVersion [Tool]
installed =
  [ PackageIdentifier
pkgId | Tool PackageIdentifier
pkgId <- [Tool]
installed
          , PackageIdentifier -> PackageName
pkgName PackageIdentifier
pkgId PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
name
          , Version -> Bool
goodVersion (PackageIdentifier -> Version
pkgVersion PackageIdentifier
pkgId) ]

getCompilerVersion ::
     (HasProcessContext env, HasLogFunc env)
  => WhichCompiler
  -> Path Abs File -- ^ executable

  -> RIO env ActualCompiler
getCompilerVersion :: forall env.
(HasProcessContext env, HasLogFunc env) =>
WhichCompiler -> Path Abs File -> RIO env ActualCompiler
getCompilerVersion WhichCompiler
wc Path Abs File
exe =
  case WhichCompiler
wc of
    WhichCompiler
Ghc -> do
      Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Asking GHC for its version"
      ByteString
bs <- (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> RIO env (ByteString, ByteString) -> RIO env ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> [[Char]]
-> (ProcessConfig () () () -> RIO env (ByteString, ByteString))
-> RIO env (ByteString, ByteString)
forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
 MonadIO m, HasCallStack) =>
[Char] -> [[Char]] -> (ProcessConfig () () () -> m a) -> m a
proc (Path Abs File -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs File
exe) [[Char]
"--numeric-version"] ProcessConfig () () () -> RIO env (ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ByteString, ByteString)
readProcess_
      let (ByteString
_, ByteString
ghcVersion) = ByteString -> (ByteString, ByteString)
versionFromEnd (ByteString -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict ByteString
bs
      ActualCompiler
x <- Version -> ActualCompiler
ACGhc (Version -> ActualCompiler)
-> RIO env Version -> RIO env ActualCompiler
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> RIO env Version
forall (m :: * -> *). MonadThrow m => [Char] -> m Version
parseVersionThrowing (Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
ghcVersion)
      Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"GHC version is: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ActualCompiler -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display ActualCompiler
x
      ActualCompiler -> RIO env ActualCompiler
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActualCompiler
x
 where
  versionFromEnd :: ByteString -> (ByteString, ByteString)
versionFromEnd = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
S8.spanEnd Char -> Bool
isValid (ByteString -> (ByteString, ByteString))
-> (ByteString -> ByteString)
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
S8.breakEnd Char -> Bool
isValid
  isValid :: Char -> Bool
isValid Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c

-- | Binary directories for the given installed package

extraDirs :: HasConfig env => Tool -> RIO env ExtraDirs
extraDirs :: forall env. HasConfig env => Tool -> RIO env ExtraDirs
extraDirs Tool
tool = do
  Config
config <- Getting Config env Config -> RIO env Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config env Config
forall env. HasConfig env => Lens' env Config
Lens' env Config
configL
  Path Abs Dir
dir <- Path Abs Dir -> Tool -> RIO env (Path Abs Dir)
forall env (m :: * -> *).
(MonadReader env m, MonadThrow m) =>
Path Abs Dir -> Tool -> m (Path Abs Dir)
installDir (Config -> Path Abs Dir
configLocalPrograms Config
config) Tool
tool
  case (Config -> Platform
configPlatform Config
config, Tool -> [Char]
toolNameString Tool
tool) of
    (Platform Arch
_ OS
Cabal.Windows, [Char] -> Bool
isGHC -> Bool
True) -> ExtraDirs -> RIO env ExtraDirs
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExtraDirs
forall a. Monoid a => a
mempty
      { edBins :: [Path Abs Dir]
edBins =
          [ Path Abs Dir
dir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirBin
          , Path Abs Dir
dir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirMingw Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirBin
          ]
      }
    (Platform Arch
Cabal.I386 OS
Cabal.Windows, [Char]
"msys2") -> ExtraDirs -> RIO env ExtraDirs
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExtraDirs
forall a. Monoid a => a
mempty
      { edBins :: [Path Abs Dir]
edBins =
          [ Path Abs Dir
dir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirMingw32 Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirBin
          , Path Abs Dir
dir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirUsr Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirBin
          , Path Abs Dir
dir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirUsr Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirLocal Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirBin
          ]
      , edInclude :: [Path Abs Dir]
edInclude =
          [ Path Abs Dir
dir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirMingw32 Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirInclude
          ]
      , edLib :: [Path Abs Dir]
edLib =
          [ Path Abs Dir
dir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirMingw32 Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirLib
          , Path Abs Dir
dir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirMingw32 Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirBin
          ]
      }
    (Platform Arch
Cabal.X86_64 OS
Cabal.Windows, [Char]
"msys2") -> ExtraDirs -> RIO env ExtraDirs
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExtraDirs
forall a. Monoid a => a
mempty
      { edBins :: [Path Abs Dir]
edBins =
          [ Path Abs Dir
dir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirMingw64 Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirBin
          , Path Abs Dir
dir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirUsr Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirBin
          , Path Abs Dir
dir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirUsr Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirLocal Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirBin
          ]
      , edInclude :: [Path Abs Dir]
edInclude =
          [ Path Abs Dir
dir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirMingw64 Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirInclude
          ]
      , edLib :: [Path Abs Dir]
edLib =
          [ Path Abs Dir
dir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirMingw64 Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirLib
          , Path Abs Dir
dir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirMingw64 Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirBin
          ]
      }
    (Platform
_, [Char] -> Bool
isGHC -> Bool
True) -> ExtraDirs -> RIO env ExtraDirs
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExtraDirs
forall a. Monoid a => a
mempty
      { edBins :: [Path Abs Dir]
edBins =
          [ Path Abs Dir
dir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirBin
          ]
      }
    (Platform Arch
_ OS
x, [Char]
toolName) -> do
      [StyleDoc] -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
        [ [Char] -> StyleDoc
flow [Char]
"binDirs: unexpected OS/tool combo:"
        , [Char] -> StyleDoc
flow ((OS, [Char]) -> [Char]
forall a. Show a => a -> [Char]
show (OS
x, [Char]
toolName) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
".")
        ]
      ExtraDirs -> RIO env ExtraDirs
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExtraDirs
forall a. Monoid a => a
mempty
 where
  isGHC :: [Char] -> Bool
isGHC [Char]
n = [Char]
"ghc" [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
n Bool -> Bool -> Bool
|| [Char]
"ghc-" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` [Char]
n

installDir :: (MonadReader env m, MonadThrow m)
           => Path Abs Dir
           -> Tool
           -> m (Path Abs Dir)
installDir :: forall env (m :: * -> *).
(MonadReader env m, MonadThrow m) =>
Path Abs Dir -> Tool -> m (Path Abs Dir)
installDir Path Abs Dir
programsDir Tool
tool = do
  Path Rel Dir
relativeDir <- [Char] -> m (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel Dir)
parseRelDir ([Char] -> m (Path Rel Dir)) -> [Char] -> m (Path Rel Dir)
forall a b. (a -> b) -> a -> b
$ Tool -> [Char]
toolString Tool
tool
  Path Abs Dir -> m (Path Abs Dir)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs Dir -> m (Path Abs Dir))
-> Path Abs Dir -> m (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
programsDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relativeDir

tempInstallDir ::
     (MonadReader env m, MonadThrow m)
  => Path Abs Dir
  -> Tool
  -> m (Path Abs Dir)
tempInstallDir :: forall env (m :: * -> *).
(MonadReader env m, MonadThrow m) =>
Path Abs Dir -> Tool -> m (Path Abs Dir)
tempInstallDir Path Abs Dir
programsDir Tool
tool = do
  Path Rel Dir
relativeDir <- [Char] -> m (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel Dir)
parseRelDir ([Char] -> m (Path Rel Dir)) -> [Char] -> m (Path Rel Dir)
forall a b. (a -> b) -> a -> b
$ Tool -> [Char]
toolString Tool
tool [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".temp"
  Path Abs Dir -> m (Path Abs Dir)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs Dir -> m (Path Abs Dir))
-> Path Abs Dir -> m (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
programsDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relativeDir