{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module HS.Managers.Ghcup
( installGhcup
, ghcupDiscover
) where
import Control.Exception
import Data.Map(Map)
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Text as T
import Fmt
import HS.Cfg.Types
import HS.Managers.Types
import HS.Types.CompilerTool
import System.Directory
import System.Process.Typed
import Text.Enum.Text
installGhcup :: Cfg -> CompilerVersion -> IO Installation
installGhcup :: Cfg -> CompilerVersion -> IO Installation
installGhcup Cfg
cfg CompilerVersion
cv = do
ProcessConfig () () () -> IO ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_ (ProcessConfig () () () -> IO ())
-> ProcessConfig () () () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"ghcup" [FilePath
"install",FilePath
"ghc",Builder
"ghc-"Builder -> Builder -> FilePath
forall b. FromBuilder b => Builder -> Builder -> b
+|CompilerVersion
cvCompilerVersion -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
""]
FilePath
dir <- Cfg -> CompilerVersion -> IO FilePath
ghcupInstallationDir Cfg
cfg CompilerVersion
cv
Installation -> IO Installation
forall (m :: * -> *) a. Monad m => a -> m a
return
Installation :: CompilerVersion -> Manager -> FilePath -> Installation
Installation
{ _iln_compiler :: CompilerVersion
_iln_compiler = CompilerVersion
cv
, _iln_manager :: Manager
_iln_manager = Manager
ghcup
, _iln_dir :: FilePath
_iln_dir = FilePath
dir
}
ghcupDiscover :: Cfg -> IO (Map Compiler Installation)
ghcupDiscover :: Cfg -> IO (Map Compiler Installation)
ghcupDiscover Cfg
cfg = (SomeException -> IO (Map Compiler Installation))
-> IO (Map Compiler Installation) -> IO (Map Compiler Installation)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SomeException -> IO (Map Compiler Installation)
hdl (IO (Map Compiler Installation) -> IO (Map Compiler Installation))
-> IO (Map Compiler Installation) -> IO (Map Compiler Installation)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> IO (Map Compiler Installation)
mk ([FilePath] -> IO (Map Compiler Installation))
-> IO [FilePath] -> IO (Map Compiler Installation)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
listDirectory (FilePath -> IO [FilePath]) -> IO FilePath -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cfg -> IO FilePath
ghcupStashDir Cfg
cfg
where
mk :: [FilePath] -> IO (Map Compiler Installation)
mk :: [FilePath] -> IO (Map Compiler Installation)
mk [FilePath]
fps = [FilePath] -> FilePath -> Map Compiler Installation
mk' [FilePath]
fps (FilePath -> Map Compiler Installation)
-> IO FilePath -> IO (Map Compiler Installation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cfg -> IO FilePath
ghcupStashDir Cfg
cfg
mk' :: [FilePath] -> FilePath -> Map Compiler Installation
mk' :: [FilePath] -> FilePath -> Map Compiler Installation
mk' [FilePath]
fps FilePath
sr = [(Compiler, Installation)] -> Map Compiler Installation
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Compiler, Installation)] -> Map Compiler Installation)
-> [(Compiler, Installation)] -> Map Compiler Installation
forall a b. (a -> b) -> a -> b
$ [Maybe (Compiler, Installation)] -> [(Compiler, Installation)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Compiler, Installation)] -> [(Compiler, Installation)])
-> [Maybe (Compiler, Installation)] -> [(Compiler, Installation)]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Maybe (Compiler, Installation))
-> [FilePath] -> [Maybe (Compiler, Installation)]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> Maybe (Compiler, Installation)
chk FilePath
sr) [FilePath]
fps
chk :: FilePath -> FilePath -> Maybe (Compiler,Installation)
chk :: FilePath -> FilePath -> Maybe (Compiler, Installation)
chk FilePath
sr FilePath
fp = do
CompilerVersion
cv <- (FilePath -> Maybe CompilerVersion)
-> (CompilerVersion -> Maybe CompilerVersion)
-> Either FilePath CompilerVersion
-> Maybe CompilerVersion
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe CompilerVersion -> FilePath -> Maybe CompilerVersion
forall a b. a -> b -> a
const Maybe CompilerVersion
forall a. Maybe a
Nothing) CompilerVersion -> Maybe CompilerVersion
forall a. a -> Maybe a
Just (Either FilePath CompilerVersion -> Maybe CompilerVersion)
-> Either FilePath CompilerVersion -> Maybe CompilerVersion
forall a b. (a -> b) -> a -> b
$ Text -> Either FilePath CompilerVersion
forall a. TextParsable a => Text -> Possibly a
parseText (Text -> Either FilePath CompilerVersion)
-> Text -> Either FilePath CompilerVersion
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
fp
(Compiler, Installation) -> Maybe (Compiler, Installation)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Compiler, Installation) -> Maybe (Compiler, Installation))
-> (Compiler, Installation) -> Maybe (Compiler, Installation)
forall a b. (a -> b) -> a -> b
$ (,) (CompilerVersion -> Compiler
compiler CompilerVersion
cv)
Installation :: CompilerVersion -> Manager -> FilePath -> Installation
Installation
{ _iln_compiler :: CompilerVersion
_iln_compiler = CompilerVersion
cv
, _iln_manager :: Manager
_iln_manager = Manager
ghcup
, _iln_dir :: FilePath
_iln_dir = Cfg -> CompilerVersion -> FilePath -> FilePath
ghcupInstallationDir' Cfg
cfg CompilerVersion
cv FilePath
sr
}
hdl :: SomeException -> IO (Map Compiler Installation)
hdl :: SomeException -> IO (Map Compiler Installation)
hdl SomeException
_ = Map Compiler Installation -> IO (Map Compiler Installation)
forall (m :: * -> *) a. Monad m => a -> m a
return Map Compiler Installation
forall a. Monoid a => a
mempty
ghcupInstallationDir :: Cfg -> CompilerVersion -> IO FilePath
ghcupInstallationDir :: Cfg -> CompilerVersion -> IO FilePath
ghcupInstallationDir Cfg
cfg CompilerVersion
cv = Cfg -> CompilerVersion -> FilePath -> FilePath
ghcupInstallationDir' Cfg
cfg CompilerVersion
cv (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cfg -> IO FilePath
ghcupStashDir Cfg
cfg
ghcupInstallationDir' :: Cfg -> CompilerVersion -> FilePath -> FilePath
ghcupInstallationDir' :: Cfg -> CompilerVersion -> FilePath -> FilePath
ghcupInstallationDir' Cfg
_ CompilerVersion
cv FilePath
sr = Builder
""Builder -> Builder -> FilePath
forall b. FromBuilder b => Builder -> Builder -> b
+|FilePath
srFilePath -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
"/"Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|CompilerVersion
cvCompilerVersion -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
""
ghcupStashDir :: Cfg -> IO FilePath
ghcupStashDir :: Cfg -> IO FilePath
ghcupStashDir Cfg
_ = FilePath -> FilePath
mk (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getHomeDirectory
where
mk :: FilePath -> FilePath
mk :: FilePath -> FilePath
mk FilePath
hme = Builder
""Builder -> Builder -> FilePath
forall b. FromBuilder b => Builder -> Builder -> b
+|FilePath
hmeFilePath -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
"/.ghcup/ghc"