packages feed

hs-0.1.0.2: src/HS/Managers/Ghcup.hs

{-# 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.FilePath
import           System.Process.Typed
import           Text.Enum.Text


-- | use @ghcup@ to install a toolchain
installGhcup :: Cfg -> CompilerVersion -> IO Installation
installGhcup cfg cv = do
    runProcess_ $ proc "ghcup" ["install","ghc","ghc-"+|cv|+""]
    dir <- ghcupInstallationDir cfg cv
    return
      Installation
        { _iln_compiler = cv
        , _iln_manager  = ghcup
        , _iln_dir      = dir
        }

-- | locate all of the toolchains being managed by the local @ghcup@ installation
ghcupDiscover :: Cfg -> IO (Map Compiler Installation)
ghcupDiscover cfg = handle hdl $ mk =<< listDirectory =<< ghcupStashDir cfg
  where
    mk :: [FilePath] -> IO (Map Compiler Installation)
    mk fps = mk' fps <$> ghcupStashDir cfg

    mk' :: [FilePath] -> FilePath -> Map Compiler Installation
    mk' fps sr = Map.fromList $ catMaybes $ map (chk sr) fps

    chk :: FilePath -> FilePath -> Maybe (Compiler,Installation)
    chk sr fp = do
        cv  <- either (const Nothing) Just $ parseText $ T.pack fp
        return $ (,) (compiler cv)
          Installation
            { _iln_compiler = cv
            , _iln_manager  = ghcup
            , _iln_dir      = sr </> fp
            }

    hdl :: SomeException -> IO (Map Compiler Installation)
    hdl _ = return mempty

ghcupInstallationDir :: Cfg -> CompilerVersion -> IO FilePath
ghcupInstallationDir cfg cv = ghcupInstallationDir' cfg cv <$> ghcupStashDir cfg

ghcupInstallationDir' :: Cfg -> CompilerVersion -> FilePath -> FilePath
ghcupInstallationDir' _ cv sr = ""+|sr|+"/"+|cv|+""

ghcupStashDir :: Cfg -> IO FilePath
ghcupStashDir _ = mk <$> getHomeDirectory
  where
    mk :: FilePath -> FilePath
    mk hme = ""+|hme|+"/.ghcup/ghc"