{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE ViewPatterns          #-}

{-|
Module      : GHCup
Description : GHCup installation functions
Copyright   : (c) Julian Ospald, 2020
License     : LGPL-3.0
Maintainer  : hasufell@hasufell.de
Stability   : experimental
Portability : POSIX

This module contains the main functions that correspond
to the command line interface, like installation, listing versions
and so on.

These are the entry points.
-}
module GHCup where


import           GHCup.Download
import           GHCup.Errors
import           GHCup.Platform
import           GHCup.Types
import           GHCup.Types.JSON               ( )
import           GHCup.Types.Optics
import           GHCup.Utils
import           GHCup.Utils.File
import           GHCup.Utils.Prelude
import           GHCup.Utils.String.QQ
import           GHCup.Utils.Version.QQ
import           GHCup.Version

#if !defined(TAR)
import           Codec.Archive                  ( ArchiveResult )
#endif
import           Control.Applicative
import           Control.Exception.Safe
import           Control.Monad
#if !MIN_VERSION_base(4,13,0)
import           Control.Monad.Fail             ( MonadFail )
#endif
import           Control.Monad.Logger
import           Control.Monad.Reader
import           Control.Monad.Trans.Resource
                                         hiding ( throwM )
import           Data.ByteString                ( ByteString )
import           Data.Either
import           Data.List
import           Data.Maybe
import           Data.String.Interpolate
import           Data.Text                      ( Text )
import           Data.Versions
import           Data.Word8
import           GHC.IO.Exception
import           HPath
import           HPath.IO                hiding ( hideError )
import           Haskus.Utils.Variant.Excepts
import           Optics
import           Prelude                 hiding ( abs
                                                , readFile
                                                , writeFile
                                                )
import           Safe                    hiding ( at )
import           System.IO.Error
import           System.Posix.Env.ByteString    ( getEnvironment, getEnv )
import           System.Posix.FilePath          ( getSearchPath, takeExtension )
import           System.Posix.Files.ByteString
import           Text.Regex.Posix

import qualified Crypto.Hash.SHA256            as SHA256
import qualified Data.ByteString.Base16        as B16
import qualified Data.ByteString               as B
import qualified Data.ByteString.Lazy          as BL
import qualified Data.Map.Strict               as Map
import qualified Data.Text                     as T
import qualified Data.Text.Encoding            as E



    -------------------------
    --[ Tool installation ]--
    -------------------------


-- | Like 'installGHCBin', except takes the 'DownloadInfo' as
-- argument instead of looking it up from 'GHCupDownloads'.
installGHCBindist :: ( MonadFail m
                     , MonadMask m
                     , MonadCatch m
                     , MonadReader AppState m
                     , MonadLogger m
                     , MonadResource m
                     , MonadIO m
                     )
                  => DownloadInfo    -- ^ where/how to download
                  -> Version         -- ^ the version to install
                  -> PlatformRequest -- ^ the platform to install on
                  -> Excepts
                       '[ AlreadyInstalled
                        , BuildFailed
                        , DigestError
                        , DownloadFailed
                        , NoDownload
                        , NotInstalled
                        , UnknownArchive
                        , TarDirDoesNotExist
#if !defined(TAR)
                        , ArchiveResult
#endif
                        ]
                       m
                       ()
installGHCBindist :: DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
installGHCBindist DownloadInfo
dlinfo Version
ver PlatformRequest
pfreq = do
  let tver :: GHCTargetVersion
tver = Version -> GHCTargetVersion
mkTVer Version
ver
  m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|Requested to install GHC with #{ver}|]
  Excepts
  '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
    NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
    ArchiveResult]
  m
  Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      Bool)
-> m Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     Bool
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m Bool
forall (m :: * -> *).
(MonadIO m, MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
tver) (AlreadyInstalled
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (AlreadyInstalled
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> AlreadyInstalled
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> AlreadyInstalled
AlreadyInstalled Tool
GHC Version
ver)

  -- download (or use cached version)
  Path Abs
dl                           <- Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed] m (Path Abs)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      (Path Abs))
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Path Abs)
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (m :: * -> *).
(MonadMask m, MonadResource m, MonadThrow m, MonadLogger m,
 MonadIO m, MonadReader AppState m) =>
DownloadInfo
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
downloadCached DownloadInfo
dlinfo Maybe (Path Rel)
forall a. Maybe a
Nothing

  -- prepare paths
  Path Abs
ghcdir <- m (Path Abs)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Path Abs)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      (Path Abs))
-> m (Path Abs)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Path Abs)
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m (Path Abs)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m (Path Abs)
ghcupGHCDir GHCTargetVersion
tver

  Excepts
  '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
    NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
    ArchiveResult]
  m
  ()
toolchainSanityChecks
  
  Excepts
  '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
  m
  ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs
-> Maybe TarDir
-> Path Abs
-> Version
-> PlatformRequest
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     ()
forall (m :: * -> *).
(MonadMask m, MonadCatch m, MonadReader AppState m, MonadThrow m,
 MonadLogger m, MonadIO m) =>
Path Abs
-> Maybe TarDir
-> Path Abs
-> Version
-> PlatformRequest
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     ()
installPackedGHC Path Abs
dl (Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
-> DownloadInfo -> Maybe TarDir
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
dlSubdir DownloadInfo
dlinfo) Path Abs
ghcdir Version
ver PlatformRequest
pfreq

  Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
 MonadIO m, MonadCatch m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
postGHCInstall GHCTargetVersion
tver

 where
  toolchainSanityChecks :: Excepts
  '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
    NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
    ArchiveResult]
  m
  ()
toolchainSanityChecks = do
    [Maybe ByteString]
r <- [ByteString]
-> (ByteString
    -> Excepts
         '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
           NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
           ArchiveResult]
         m
         (Maybe ByteString))
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     [Maybe ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ByteString
"CC", ByteString
"LD"] (IO (Maybe ByteString)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      (Maybe ByteString))
-> (ByteString -> IO (Maybe ByteString))
-> ByteString
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO (Maybe ByteString)
getEnv)
    case [Maybe ByteString] -> [ByteString]
forall a. [Maybe a] -> [a]
catMaybes [Maybe ByteString]
r of
      [] -> ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      [ByteString]
_ -> do
        m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn) Text
"CC/LD environment variable is set. This will change the compiler/linker"
        m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn) Text
"GHC uses internally and can cause defunct GHC in some cases (e.g. in Anaconda"
        m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn) Text
"environments). If you encounter problems, unset CC and LD and reinstall."


-- | Install a packed GHC distribution. This only deals with unpacking and the GHC
-- build system and nothing else.
installPackedGHC :: ( MonadMask m
                    , MonadCatch m
                    , MonadReader AppState m
                    , MonadThrow m
                    , MonadLogger m
                    , MonadIO m
                    )
                 => Path Abs          -- ^ Path to the packed GHC bindist
                 -> Maybe TarDir      -- ^ Subdir of the archive
                 -> Path Abs          -- ^ Path to install to
                 -> Version           -- ^ The GHC version
                 -> PlatformRequest
                 -> Excepts
                      '[ BuildFailed
                       , UnknownArchive
                       , TarDirDoesNotExist
#if !defined(TAR)
                       , ArchiveResult
#endif
                       ] m ()
installPackedGHC :: Path Abs
-> Maybe TarDir
-> Path Abs
-> Version
-> PlatformRequest
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     ()
installPackedGHC Path Abs
dl Maybe TarDir
msubdir Path Abs
inst Version
ver pfreq :: PlatformRequest
pfreq@PlatformRequest{Maybe Versioning
Platform
Architecture
_rVersion :: PlatformRequest -> Maybe Versioning
_rPlatform :: PlatformRequest -> Platform
_rArch :: PlatformRequest -> Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
..} = do
  -- unpack
  Path Abs
tmpUnpack <- m (Path Abs)
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     (Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Path Abs)
forall (m :: * -> *). (MonadThrow m, MonadIO m) => m (Path Abs)
mkGhcupTmpDir
  Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
 -> Excepts
      '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
      m
      ())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs
-> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadThrow m) =>
Path Abs
-> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir Path Abs
tmpUnpack Path Abs
dl
  Excepts
  '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
  m
  (Either ProcessError ())
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts
   '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
   m
   (Either ProcessError ())
 -> Excepts
      '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
      m
      ())
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     (Either ProcessError ())
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ IO (Either ProcessError ())
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     (Either ProcessError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ProcessError ())
 -> Excepts
      '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
      m
      (Either ProcessError ()))
-> IO (Either ProcessError ())
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     (Either ProcessError ())
forall a b. (a -> b) -> a -> b
$ Platform -> Path Abs -> IO (Either ProcessError ())
darwinNotarization Platform
_rPlatform Path Abs
tmpUnpack

  -- the subdir of the archive where we do the work
  Path Abs
workdir <- Excepts
  '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
  m
  (Path Abs)
-> (TarDir
    -> Excepts
         '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
         m
         (Path Abs))
-> Maybe TarDir
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     (Path Abs)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Path Abs
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs
tmpUnpack)
                   (Excepts '[TarDirDoesNotExist] m (Path Abs)
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     (Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m (Path Abs)
 -> Excepts
      '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
      m
      (Path Abs))
-> (TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs))
-> TarDir
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     (Path Abs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs)
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadThrow m, MonadCatch m) =>
Path Abs -> TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs)
intoSubdir Path Abs
tmpUnpack)
                   Maybe TarDir
msubdir

  Excepts '[BuildFailed] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[BuildFailed] m ()
 -> Excepts
      '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
      m
      ())
-> Excepts '[BuildFailed] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs
-> Maybe (Path Abs)
-> Excepts '[ProcessError] m ()
-> Excepts '[BuildFailed] m ()
forall (e :: [*]) (m :: * -> *) a.
(Show (V e), MonadReader AppState m, MonadIO m, MonadMask m) =>
Path Abs
-> Maybe (Path Abs) -> Excepts e m a -> Excepts '[BuildFailed] m a
runBuildAction Path Abs
tmpUnpack
                         (Path Abs -> Maybe (Path Abs)
forall a. a -> Maybe a
Just Path Abs
inst)
                         (Path Abs
-> Path Abs
-> Version
-> PlatformRequest
-> Excepts '[ProcessError] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m) =>
Path Abs
-> Path Abs
-> Version
-> PlatformRequest
-> Excepts '[ProcessError] m ()
installUnpackedGHC Path Abs
workdir Path Abs
inst Version
ver PlatformRequest
pfreq)


-- | Install an unpacked GHC distribution. This only deals with the GHC
-- build system and nothing else.
installUnpackedGHC :: ( MonadReader AppState m
                      , MonadThrow m
                      , MonadLogger m
                      , MonadIO m
                      )
                   => Path Abs      -- ^ Path to the unpacked GHC bindist (where the configure script resides)
                   -> Path Abs      -- ^ Path to install to
                   -> Version       -- ^ The GHC version
                   -> PlatformRequest
                   -> Excepts '[ProcessError] m ()
installUnpackedGHC :: Path Abs
-> Path Abs
-> Version
-> PlatformRequest
-> Excepts '[ProcessError] m ()
installUnpackedGHC Path Abs
path Path Abs
inst Version
ver PlatformRequest{Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
_rVersion :: PlatformRequest -> Maybe Versioning
_rPlatform :: PlatformRequest -> Platform
_rArch :: PlatformRequest -> Architecture
..} = do
  m () -> Excepts '[ProcessError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[ProcessError] m ())
-> m () -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Installing GHC (this may take a while)"
  m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ ByteString
-> Bool
-> [ByteString]
-> Path Rel
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> m (Either ProcessError ())
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m) =>
ByteString
-> Bool
-> [ByteString]
-> Path Rel
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> m (Either ProcessError ())
execLogged ByteString
"./configure"
                   Bool
False
                   ((ByteString
"--prefix=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
inst) ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
alpineArgs)
                   [rel|ghc-configure|]
                   (Path Abs -> Maybe (Path Abs)
forall a. a -> Maybe a
Just Path Abs
path)
                   Maybe [(ByteString, ByteString)]
forall a. Maybe a
Nothing
  m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Maybe (Path Abs) -> m (Either ProcessError ())
forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadReader AppState m) =>
[ByteString] -> Maybe (Path Abs) -> m (Either ProcessError ())
make [ByteString
"install"] (Path Abs -> Maybe (Path Abs)
forall a. a -> Maybe a
Just Path Abs
path)
  () -> Excepts '[ProcessError] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
 where
  alpineArgs :: [ByteString]
alpineArgs
    | Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [vver|8.2.2|], Linux LinuxDistro
Alpine <- Platform
_rPlatform
    = [ByteString
"--disable-ld-override"]
    | Bool
otherwise
    = []


-- | Installs GHC into @~\/.ghcup\/ghc/\<ver\>@ and places the
-- following symlinks in @~\/.ghcup\/bin@:
--
--   * @ghc-x.y.z -> ..\/ghc\/x.y.z\/bin/ghc@
--   * @ghc-x.y   -> ..\/ghc\/x.y.z\/bin/ghc@ (if x.y.z is the latest x.y version)
installGHCBin :: ( MonadFail m
                 , MonadMask m
                 , MonadCatch m
                 , MonadReader AppState m
                 , MonadLogger m
                 , MonadResource m
                 , MonadIO m
                 )
              => GHCupDownloads  -- ^ the download info to look up the tarball from
              -> Version         -- ^ the version to install
              -> PlatformRequest -- ^ the platform to install on
              -> Excepts
                   '[ AlreadyInstalled
                    , BuildFailed
                    , DigestError
                    , DownloadFailed
                    , NoDownload
                    , NotInstalled
                    , UnknownArchive
                    , TarDirDoesNotExist
#if !defined(TAR)
                    , ArchiveResult
#endif
                    ]
                   m
                   ()
installGHCBin :: GHCupDownloads
-> Version
-> PlatformRequest
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
installGHCBin GHCupDownloads
bDls Version
ver PlatformRequest
pfreq = do
  DownloadInfo
dlinfo <- Either NoDownload DownloadInfo
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Either e a -> Excepts es m a
lE (Either NoDownload DownloadInfo
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      DownloadInfo)
-> Either NoDownload DownloadInfo
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool
-> Version
-> PlatformRequest
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo Tool
GHC Version
ver PlatformRequest
pfreq GHCupDownloads
bDls
  DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (m :: * -> *).
(MonadFail m, MonadMask m, MonadCatch m, MonadReader AppState m,
 MonadLogger m, MonadResource m, MonadIO m) =>
DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
installGHCBindist DownloadInfo
dlinfo Version
ver PlatformRequest
pfreq


-- | Like 'installCabalBin', except takes the 'DownloadInfo' as
-- argument instead of looking it up from 'GHCupDownloads'.
installCabalBindist :: ( MonadMask m
                       , MonadCatch m
                       , MonadReader AppState m
                       , MonadLogger m
                       , MonadResource m
                       , MonadIO m
                       , MonadFail m
                       )
                    => DownloadInfo
                    -> Version
                    -> PlatformRequest
                    -> Excepts
                         '[ AlreadyInstalled
                          , CopyError
                          , DigestError
                          , DownloadFailed
                          , NoDownload
                          , NotInstalled
                          , UnknownArchive
                          , TarDirDoesNotExist
#if !defined(TAR)
                          , ArchiveResult
#endif
                          ]
                         m
                         ()
installCabalBindist :: DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
installCabalBindist DownloadInfo
dlinfo Version
ver PlatformRequest {Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
_rVersion :: PlatformRequest -> Maybe Versioning
_rPlatform :: PlatformRequest -> Platform
_rArch :: PlatformRequest -> Architecture
..} = do
  m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|Requested to install cabal version #{ver}|]

  AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
..}} <- m AppState
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask

  Excepts
  '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
    NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
    ArchiveResult]
  m
  Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM
      (m Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Version -> m Bool
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadReader AppState m, MonadCatch m) =>
Version -> m Bool
cabalInstalled Version
ver) Excepts
  '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
    NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
    ArchiveResult]
  m
  Bool
-> (Bool
    -> Excepts
         '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
           NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
           ArchiveResult]
         m
         Bool)
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
a -> IO Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      Bool)
-> IO Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     Bool
forall a b. (a -> b) -> a -> b
$
        (IOException -> IO Bool) -> IO Bool -> IO Bool
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
          (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (FileStatus -> Bool) -> IO FileStatus -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FileStatus
x -> Bool
a Bool -> Bool -> Bool
&& FileStatus -> Bool
isSymbolicLink FileStatus
x)
          -- ignore when the installation is a legacy cabal (binary, not symlink)
          (IO FileStatus -> IO Bool) -> IO FileStatus -> IO Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> IO FileStatus
getSymbolicLinkStatus (Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|cabal|]))
      )
      (AlreadyInstalled
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (AlreadyInstalled
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> AlreadyInstalled
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> AlreadyInstalled
AlreadyInstalled Tool
Cabal Version
ver)

  -- download (or use cached version)
  Path Abs
dl                           <- Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed] m (Path Abs)
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      (Path Abs))
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Path Abs)
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (m :: * -> *).
(MonadMask m, MonadResource m, MonadThrow m, MonadLogger m,
 MonadIO m, MonadReader AppState m) =>
DownloadInfo
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
downloadCached DownloadInfo
dlinfo Maybe (Path Rel)
forall a. Maybe a
Nothing

  -- unpack
  Path Abs
tmpUnpack                    <- m (Path Abs)
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Path Abs)
forall (m :: * -> *).
(MonadResource m, MonadThrow m, MonadIO m) =>
m (Path Abs)
withGHCupTmpDir
  Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs
-> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadThrow m) =>
Path Abs
-> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir Path Abs
tmpUnpack Path Abs
dl
  Excepts
  '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
    NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
    ArchiveResult]
  m
  (Either ProcessError ())
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts
   '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
     NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
     ArchiveResult]
   m
   (Either ProcessError ())
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Either ProcessError ())
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ IO (Either ProcessError ())
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Either ProcessError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ProcessError ())
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      (Either ProcessError ()))
-> IO (Either ProcessError ())
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Either ProcessError ())
forall a b. (a -> b) -> a -> b
$ Platform -> Path Abs -> IO (Either ProcessError ())
darwinNotarization Platform
_rPlatform Path Abs
tmpUnpack

  -- the subdir of the archive where we do the work
  Path Abs
workdir <- Excepts
  '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
    NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
    ArchiveResult]
  m
  (Path Abs)
-> (TarDir
    -> Excepts
         '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
           NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
           ArchiveResult]
         m
         (Path Abs))
-> Maybe TarDir
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Path Abs)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Path Abs
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs
tmpUnpack) (Excepts '[TarDirDoesNotExist] m (Path Abs)
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m (Path Abs)
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      (Path Abs))
-> (TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs))
-> TarDir
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Path Abs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs)
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadThrow m, MonadCatch m) =>
Path Abs -> TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs)
intoSubdir Path Abs
tmpUnpack) (Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
-> DownloadInfo -> Maybe TarDir
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
dlSubdir DownloadInfo
dlinfo)

  Excepts '[CopyError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> Excepts '[CopyError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> Excepts '[CopyError] m ()
forall (m :: * -> *).
(MonadLogger m, MonadCatch m, MonadIO m) =>
Path Abs -> Path Abs -> Excepts '[CopyError] m ()
installCabal' Path Abs
workdir Path Abs
binDir

  -- create symlink if this is the latest version
  [Version]
cVers <- m [Version]
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     [Version]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Version]
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      [Version])
-> m [Version]
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     [Version]
forall a b. (a -> b) -> a -> b
$ ([Either (Path Rel) Version] -> [Version])
-> m [Either (Path Rel) Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either (Path Rel) Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either (Path Rel) Version]
forall (m :: * -> *).
(MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m) =>
m [Either (Path Rel) Version]
getInstalledCabals
  let lInstCabal :: Maybe Version
lInstCabal = [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. [a] -> [a]
reverse ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort ([Version] -> Maybe Version) -> [Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Version]
cVers
  Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> (Version -> Bool) -> Maybe Version -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>=) Maybe Version
lInstCabal) (Excepts
   '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
     NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
     ArchiveResult]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
 MonadIO m) =>
Version -> Excepts '[NotInstalled] m ()
setCabal Version
ver

 where
  -- | Install an unpacked cabal distribution.
  installCabal' :: (MonadLogger m, MonadCatch m, MonadIO m)
                => Path Abs      -- ^ Path to the unpacked cabal bindist (where the executable resides)
                -> Path Abs      -- ^ Path to install to
                -> Excepts '[CopyError] m ()
  installCabal' :: Path Abs -> Path Abs -> Excepts '[CopyError] m ()
installCabal' Path Abs
path Path Abs
inst = do
    m () -> Excepts '[CopyError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError] m ())
-> m () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Installing cabal"
    let cabalFile :: Path Rel
cabalFile = [rel|cabal|]
    IO () -> Excepts '[CopyError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError] m ())
-> IO () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
createDirRecursive' Path Abs
inst
    Path Rel
destFileName <- m (Path Rel) -> Excepts '[CopyError] m (Path Rel)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Path Rel) -> Excepts '[CopyError] m (Path Rel))
-> m (Path Rel) -> Excepts '[CopyError] m (Path Rel)
forall a b. (a -> b) -> a -> b
$ ByteString -> m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
cabalFile ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Version -> ByteString
verToBS Version
ver)
    let destPath :: Path Abs
destPath = Path Abs
inst Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
destFileName
    (IOException -> Excepts '[CopyError] m ())
-> Excepts '[CopyError] m () -> Excepts '[CopyError] m ()
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (CopyError -> Excepts '[CopyError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (CopyError -> Excepts '[CopyError] m ())
-> (IOException -> CopyError)
-> IOException
-> Excepts '[CopyError] m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CopyError
CopyError (String -> CopyError)
-> (IOException -> String) -> IOException -> CopyError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall a. Show a => a -> String
show) (Excepts '[CopyError] m () -> Excepts '[CopyError] m ())
-> Excepts '[CopyError] m () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ IO () -> Excepts '[CopyError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError] m ())
-> IO () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> CopyMode -> IO ()
forall b1 b2. Path b1 -> Path b2 -> CopyMode -> IO ()
copyFile
      (Path Abs
path Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
cabalFile)
      Path Abs
destPath
      CopyMode
Overwrite
    m () -> Excepts '[CopyError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError] m ())
-> m () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> m ()
forall (m :: * -> *) a.
(MonadLogger m, MonadIO m) =>
Path a -> m ()
chmod_755 Path Abs
destPath


-- | Installs cabal into @~\/.ghcup\/bin/cabal-\<ver\>@ and
-- creates a default @cabal -> cabal-x.y.z.q@ symlink for
-- the latest installed version.
installCabalBin :: ( MonadMask m
                   , MonadCatch m
                   , MonadReader AppState m
                   , MonadLogger m
                   , MonadResource m
                   , MonadIO m
                   , MonadFail m
                   )
                => GHCupDownloads
                -> Version
                -> PlatformRequest
                -> Excepts
                     '[ AlreadyInstalled
                      , CopyError
                      , DigestError
                      , DownloadFailed
                      , NoDownload
                      , NotInstalled
                      , UnknownArchive
                      , TarDirDoesNotExist
#if !defined(TAR)
                      , ArchiveResult
#endif
                      ]
                     m
                     ()
installCabalBin :: GHCupDownloads
-> Version
-> PlatformRequest
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
installCabalBin GHCupDownloads
bDls Version
ver PlatformRequest
pfreq = do
  DownloadInfo
dlinfo <- Either NoDownload DownloadInfo
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Either e a -> Excepts es m a
lE (Either NoDownload DownloadInfo
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      DownloadInfo)
-> Either NoDownload DownloadInfo
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool
-> Version
-> PlatformRequest
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo Tool
Cabal Version
ver PlatformRequest
pfreq GHCupDownloads
bDls
  DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (m :: * -> *).
(MonadMask m, MonadCatch m, MonadReader AppState m, MonadLogger m,
 MonadResource m, MonadIO m, MonadFail m) =>
DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
installCabalBindist DownloadInfo
dlinfo Version
ver PlatformRequest
pfreq


-- | Like 'installHLSBin, except takes the 'DownloadInfo' as
-- argument instead of looking it up from 'GHCupDownloads'.
installHLSBindist :: ( MonadMask m
                     , MonadCatch m
                     , MonadReader AppState m
                     , MonadLogger m
                     , MonadResource m
                     , MonadIO m
                     , MonadFail m
                     )
                  => DownloadInfo
                  -> Version
                  -> PlatformRequest
                  -> Excepts
                       '[ AlreadyInstalled
                        , CopyError
                        , DigestError
                        , DownloadFailed
                        , NoDownload
                        , NotInstalled
                        , UnknownArchive
                        , TarDirDoesNotExist
#if !defined(TAR)
                        , ArchiveResult
#endif
                        ]
                       m
                       ()
installHLSBindist :: DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
installHLSBindist DownloadInfo
dlinfo Version
ver PlatformRequest{Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
_rVersion :: PlatformRequest -> Maybe Versioning
_rPlatform :: PlatformRequest -> Platform
_rArch :: PlatformRequest -> Architecture
..} = do
  m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|Requested to install hls version #{ver}|]

  AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..}} <- m AppState
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask

  Excepts
  '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
    NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
    ArchiveResult]
  m
  Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Version -> m Bool
forall (m :: * -> *).
(MonadIO m, MonadReader AppState m, MonadCatch m) =>
Version -> m Bool
hlsInstalled Version
ver))
    (AlreadyInstalled
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (AlreadyInstalled
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> AlreadyInstalled
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> AlreadyInstalled
AlreadyInstalled Tool
HLS Version
ver)

  -- download (or use cached version)
  Path Abs
dl                           <- Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed] m (Path Abs)
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      (Path Abs))
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Path Abs)
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (m :: * -> *).
(MonadMask m, MonadResource m, MonadThrow m, MonadLogger m,
 MonadIO m, MonadReader AppState m) =>
DownloadInfo
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
downloadCached DownloadInfo
dlinfo Maybe (Path Rel)
forall a. Maybe a
Nothing

  -- unpack
  Path Abs
tmpUnpack                    <- m (Path Abs)
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Path Abs)
forall (m :: * -> *).
(MonadResource m, MonadThrow m, MonadIO m) =>
m (Path Abs)
withGHCupTmpDir
  Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs
-> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadThrow m) =>
Path Abs
-> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir Path Abs
tmpUnpack Path Abs
dl
  Excepts
  '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
    NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
    ArchiveResult]
  m
  (Either ProcessError ())
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts
   '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
     NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
     ArchiveResult]
   m
   (Either ProcessError ())
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Either ProcessError ())
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ IO (Either ProcessError ())
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Either ProcessError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ProcessError ())
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      (Either ProcessError ()))
-> IO (Either ProcessError ())
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Either ProcessError ())
forall a b. (a -> b) -> a -> b
$ Platform -> Path Abs -> IO (Either ProcessError ())
darwinNotarization Platform
_rPlatform Path Abs
tmpUnpack

  -- the subdir of the archive where we do the work
  Path Abs
workdir <- Excepts
  '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
    NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
    ArchiveResult]
  m
  (Path Abs)
-> (TarDir
    -> Excepts
         '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
           NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
           ArchiveResult]
         m
         (Path Abs))
-> Maybe TarDir
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Path Abs)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Path Abs
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs
tmpUnpack) (Excepts '[TarDirDoesNotExist] m (Path Abs)
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m (Path Abs)
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      (Path Abs))
-> (TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs))
-> TarDir
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     (Path Abs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs)
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadThrow m, MonadCatch m) =>
Path Abs -> TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs)
intoSubdir Path Abs
tmpUnpack) (Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
-> DownloadInfo -> Maybe TarDir
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
dlSubdir DownloadInfo
dlinfo)

  Excepts '[CopyError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> Excepts '[CopyError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> Excepts '[CopyError] m ()
forall (m :: * -> *).
(MonadFail m, MonadLogger m, MonadCatch m, MonadIO m) =>
Path Abs -> Path Abs -> Excepts '[CopyError] m ()
installHLS' Path Abs
workdir Path Abs
binDir

  -- create symlink if this is the latest version
  [Version]
hlsVers <- m [Version]
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     [Version]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Version]
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      [Version])
-> m [Version]
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     [Version]
forall a b. (a -> b) -> a -> b
$ ([Either (Path Rel) Version] -> [Version])
-> m [Either (Path Rel) Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either (Path Rel) Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either (Path Rel) Version]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadCatch m) =>
m [Either (Path Rel) Version]
getInstalledHLSs
  let lInstHLS :: Maybe Version
lInstHLS = [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. [a] -> [a]
reverse ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort ([Version] -> Maybe Version) -> [Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Version]
hlsVers
  Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> (Version -> Bool) -> Maybe Version -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>=) Maybe Version
lInstHLS) (Excepts
   '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
     NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
     ArchiveResult]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadCatch m, MonadReader AppState m, MonadLogger m, MonadThrow m,
 MonadFail m, MonadIO m) =>
Version -> Excepts '[NotInstalled] m ()
setHLS Version
ver

 where
  -- | Install an unpacked hls distribution.
  installHLS' :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
                => Path Abs      -- ^ Path to the unpacked hls bindist (where the executable resides)
                -> Path Abs      -- ^ Path to install to
                -> Excepts '[CopyError] m ()
  installHLS' :: Path Abs -> Path Abs -> Excepts '[CopyError] m ()
installHLS' Path Abs
path Path Abs
inst = do
    m () -> Excepts '[CopyError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError] m ())
-> m () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Installing HLS"
    IO () -> Excepts '[CopyError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError] m ())
-> IO () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
createDirRecursive' Path Abs
inst

    -- install haskell-language-server-<ghcver>
    bins :: [Path Rel]
bins@(Path Rel
_:[Path Rel]
_) <- IO [Path Rel] -> Excepts '[CopyError] m [Path Rel]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Path Rel] -> Excepts '[CopyError] m [Path Rel])
-> IO [Path Rel] -> Excepts '[CopyError] m [Path Rel]
forall a b. (a -> b) -> a -> b
$ Path Abs -> Regex -> IO [Path Rel]
findFiles
      Path Abs
path
      (CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended
                     ExecOption
execBlank
                     ([s|^haskell-language-server-[0-9].*$|] :: ByteString)
      )
    [Path Rel]
-> (Path Rel -> Excepts '[CopyError] m ())
-> Excepts '[CopyError] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Rel]
bins ((Path Rel -> Excepts '[CopyError] m ())
 -> Excepts '[CopyError] m ())
-> (Path Rel -> Excepts '[CopyError] m ())
-> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ \Path Rel
f -> do
      Path Rel
toF <- ByteString -> Excepts '[CopyError] m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
f ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"~" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Version -> ByteString
verToBS Version
ver)
      (IOException -> Excepts '[CopyError] m ())
-> Excepts '[CopyError] m () -> Excepts '[CopyError] m ()
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (CopyError -> Excepts '[CopyError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (CopyError -> Excepts '[CopyError] m ())
-> (IOException -> CopyError)
-> IOException
-> Excepts '[CopyError] m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CopyError
CopyError (String -> CopyError)
-> (IOException -> String) -> IOException -> CopyError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall a. Show a => a -> String
show) (Excepts '[CopyError] m () -> Excepts '[CopyError] m ())
-> Excepts '[CopyError] m () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ IO () -> Excepts '[CopyError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError] m ())
-> IO () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> CopyMode -> IO ()
forall b1 b2. Path b1 -> Path b2 -> CopyMode -> IO ()
copyFile
        (Path Abs
path Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
f)
        (Path Abs
inst Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
toF)
        CopyMode
Overwrite
      m () -> Excepts '[CopyError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError] m ())
-> m () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> m ()
forall (m :: * -> *) a.
(MonadLogger m, MonadIO m) =>
Path a -> m ()
chmod_755 (Path Abs
inst Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
toF)

    -- install haskell-language-server-wrapper
    let wrapper :: Path Rel
wrapper = [rel|haskell-language-server-wrapper|]
    Path Rel
toF <- ByteString -> Excepts '[CopyError] m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
wrapper ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Version -> ByteString
verToBS Version
ver)
    (IOException -> Excepts '[CopyError] m ())
-> Excepts '[CopyError] m () -> Excepts '[CopyError] m ()
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (CopyError -> Excepts '[CopyError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (CopyError -> Excepts '[CopyError] m ())
-> (IOException -> CopyError)
-> IOException
-> Excepts '[CopyError] m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CopyError
CopyError (String -> CopyError)
-> (IOException -> String) -> IOException -> CopyError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall a. Show a => a -> String
show) (Excepts '[CopyError] m () -> Excepts '[CopyError] m ())
-> Excepts '[CopyError] m () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ IO () -> Excepts '[CopyError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError] m ())
-> IO () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> CopyMode -> IO ()
forall b1 b2. Path b1 -> Path b2 -> CopyMode -> IO ()
copyFile
      (Path Abs
path Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
wrapper)
      (Path Abs
inst Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
toF)
      CopyMode
Overwrite
    m () -> Excepts '[CopyError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError] m ())
-> m () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> m ()
forall (m :: * -> *) a.
(MonadLogger m, MonadIO m) =>
Path a -> m ()
chmod_755 (Path Abs
inst Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
toF)


-- | Installs hls binaries @haskell-language-server-\<ghcver\>@
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
installHLSBin :: ( MonadMask m
                 , MonadCatch m
                 , MonadReader AppState m
                 , MonadLogger m
                 , MonadResource m
                 , MonadIO m
                 , MonadFail m
                 )
              => GHCupDownloads
              -> Version
              -> PlatformRequest
              -> Excepts
                   '[ AlreadyInstalled
                    , CopyError
                    , DigestError
                    , DownloadFailed
                    , NoDownload
                    , NotInstalled
                    , UnknownArchive
                    , TarDirDoesNotExist
#if !defined(TAR)
                    , ArchiveResult
#endif
                    ]
                   m
                   ()
installHLSBin :: GHCupDownloads
-> Version
-> PlatformRequest
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
installHLSBin GHCupDownloads
bDls Version
ver PlatformRequest
pfreq = do
  DownloadInfo
dlinfo <- Either NoDownload DownloadInfo
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Either e a -> Excepts es m a
lE (Either NoDownload DownloadInfo
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
        NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
        ArchiveResult]
      m
      DownloadInfo)
-> Either NoDownload DownloadInfo
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool
-> Version
-> PlatformRequest
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo Tool
HLS Version
ver PlatformRequest
pfreq GHCupDownloads
bDls
  DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
forall (m :: * -> *).
(MonadMask m, MonadCatch m, MonadReader AppState m, MonadLogger m,
 MonadResource m, MonadIO m, MonadFail m) =>
DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
       NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
       ArchiveResult]
     m
     ()
installHLSBindist DownloadInfo
dlinfo Version
ver PlatformRequest
pfreq




    ---------------------
    --[ Set GHC/cabal ]--
    ---------------------



-- | Set GHC symlinks in @~\/.ghcup\/bin@ for the requested GHC version. The behavior depends
-- on `SetGHC`:
--
--   * SetGHCOnly: @~\/.ghcup\/bin\/ghc -> ~\/.ghcup\/ghc\/\<ver\>\/bin\/ghc@
--   * SetGHC_XY: @~\/.ghcup\/bin\/ghc-X.Y -> ~\/.ghcup\/ghc\/\<ver\>\/bin\/ghc@
--   * SetGHC_XYZ: @~\/.ghcup\/bin\/ghc-\<ver\> -> ~\/.ghcup\/ghc\/\<ver\>\/bin\/ghc@
--
-- Additionally creates a @~\/.ghcup\/share -> ~\/.ghcup\/ghc\/\<ver\>\/share symlink@
-- for 'SetGHCOnly' constructor.
setGHC :: ( MonadReader AppState m
          , MonadLogger m
          , MonadThrow m
          , MonadFail m
          , MonadIO m
          , MonadCatch m
          )
       => GHCTargetVersion
       -> SetGHC
       -> Excepts '[NotInstalled] m GHCTargetVersion
setGHC :: GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
ver SetGHC
sghc = do
  let verBS :: ByteString
verBS = Version -> ByteString
verToBS (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
  Path Abs
ghcdir                        <- m (Path Abs) -> Excepts '[NotInstalled] m (Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Path Abs) -> Excepts '[NotInstalled] m (Path Abs))
-> m (Path Abs) -> Excepts '[NotInstalled] m (Path Abs)
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m (Path Abs)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m (Path Abs)
ghcupGHCDir GHCTargetVersion
ver

  Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GHCTargetVersion -> m Bool
forall (m :: * -> *).
(MonadIO m, MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
ver) (NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
GHC GHCTargetVersion
ver))

  -- symlink destination
  AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..} } <- m AppState -> Excepts '[NotInstalled] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
createDirRecursive' Path Abs
binDir

  -- first delete the old symlinks (this fixes compatibility issues
  -- with old ghcup)
  case SetGHC
sghc of
    SetGHC
SetGHCOnly -> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
 MonadIO m) =>
Maybe Text -> Excepts '[NotInstalled] m ()
rmPlain (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
ver)
    SetGHC
SetGHC_XY  -> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadLogger m, MonadThrow m,
 MonadFail m, MonadReader AppState m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMajorSymlinks GHCTargetVersion
ver
    SetGHC
SetGHC_XYZ -> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadLogger m, MonadThrow m,
 MonadFail m, MonadReader AppState m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMinorSymlinks GHCTargetVersion
ver

  -- for ghc tools (ghc, ghci, haddock, ...)
  [Path Rel]
verfiles <- GHCTargetVersion -> Excepts '[NotInstalled] m [Path Rel]
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadFail m, MonadIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m [Path Rel]
ghcToolFiles GHCTargetVersion
ver
  [Path Rel]
-> (Path Rel -> Excepts '[NotInstalled] m (Maybe ()))
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Rel]
verfiles ((Path Rel -> Excepts '[NotInstalled] m (Maybe ()))
 -> Excepts '[NotInstalled] m ())
-> (Path Rel -> Excepts '[NotInstalled] m (Maybe ()))
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \Path Rel
file -> do
    Maybe (Path Rel)
mTargetFile <- case SetGHC
sghc of
      SetGHC
SetGHCOnly -> Maybe (Path Rel) -> Excepts '[NotInstalled] m (Maybe (Path Rel))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Path Rel) -> Excepts '[NotInstalled] m (Maybe (Path Rel)))
-> Maybe (Path Rel) -> Excepts '[NotInstalled] m (Maybe (Path Rel))
forall a b. (a -> b) -> a -> b
$ Path Rel -> Maybe (Path Rel)
forall a. a -> Maybe a
Just Path Rel
file
      SetGHC
SetGHC_XY  -> do
        Maybe CharPos
v' <-
          (ParseError -> Excepts '[NotInstalled] m (Maybe CharPos))
-> Excepts '[NotInstalled] m (Maybe CharPos)
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle
            (\(ParseError
e :: ParseError) -> m (Maybe CharPos) -> Excepts '[NotInstalled] m (Maybe CharPos)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe CharPos) -> Excepts '[NotInstalled] m (Maybe CharPos))
-> m (Maybe CharPos) -> Excepts '[NotInstalled] m (Maybe CharPos)
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn) [i|#{e}|] m () -> m (Maybe CharPos) -> m (Maybe CharPos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe CharPos -> m (Maybe CharPos)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CharPos
forall a. Maybe a
Nothing)
          (Excepts '[NotInstalled] m (Maybe CharPos)
 -> Excepts '[NotInstalled] m (Maybe CharPos))
-> Excepts '[NotInstalled] m (Maybe CharPos)
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall a b. (a -> b) -> a -> b
$ (CharPos -> Maybe CharPos)
-> Excepts '[NotInstalled] m CharPos
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CharPos -> Maybe CharPos
forall a. a -> Maybe a
Just
          (Excepts '[NotInstalled] m CharPos
 -> Excepts '[NotInstalled] m (Maybe CharPos))
-> Excepts '[NotInstalled] m CharPos
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m CharPos
forall (m :: * -> *). MonadThrow m => Version -> m CharPos
getMajorMinorV (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
        Maybe CharPos
-> (CharPos -> Excepts '[NotInstalled] m (Path Rel))
-> Excepts '[NotInstalled] m (Maybe (Path Rel))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe CharPos
v' ((CharPos -> Excepts '[NotInstalled] m (Path Rel))
 -> Excepts '[NotInstalled] m (Maybe (Path Rel)))
-> (CharPos -> Excepts '[NotInstalled] m (Path Rel))
-> Excepts '[NotInstalled] m (Maybe (Path Rel))
forall a b. (a -> b) -> a -> b
$ \(Int
mj, Int
mi) ->
          let major' :: ByteString
major' = Text -> ByteString
E.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Integral a => a -> Text
intToText Int
mj Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Integral a => a -> Text
intToText Int
mi
          in  ByteString -> Excepts '[NotInstalled] m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
file ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
B.singleton Word8
_hyphen ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
major')
      SetGHC
SetGHC_XYZ ->
        (Path Rel -> Maybe (Path Rel))
-> Excepts '[NotInstalled] m (Path Rel)
-> Excepts '[NotInstalled] m (Maybe (Path Rel))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path Rel -> Maybe (Path Rel)
forall a. a -> Maybe a
Just (Excepts '[NotInstalled] m (Path Rel)
 -> Excepts '[NotInstalled] m (Maybe (Path Rel)))
-> Excepts '[NotInstalled] m (Path Rel)
-> Excepts '[NotInstalled] m (Maybe (Path Rel))
forall a b. (a -> b) -> a -> b
$ ByteString -> Excepts '[NotInstalled] m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
file ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
B.singleton Word8
_hyphen ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
verBS)

    -- create symlink
    Maybe (Path Rel)
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m (Maybe ())
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (Path Rel)
mTargetFile ((Path Rel -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m (Maybe ()))
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m (Maybe ())
forall a b. (a -> b) -> a -> b
$ \Path Rel
targetFile -> do
      let fullF :: Path Abs
fullF = Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
targetFile
      ByteString
destL <- m ByteString -> Excepts '[NotInstalled] m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> Excepts '[NotInstalled] m ByteString)
-> m ByteString -> Excepts '[NotInstalled] m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> GHCTargetVersion -> m ByteString
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadIO m) =>
ByteString -> GHCTargetVersion -> m ByteString
ghcLinkDestination (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
file) GHCTargetVersion
ver
      m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|ln -s #{destL} #{toFilePath fullF}|]
      IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString -> IO ()
forall b. Path b -> ByteString -> IO ()
createSymlink Path Abs
fullF ByteString
destL

  -- create symlink for share dir
  Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Text -> Bool)
-> (GHCTargetVersion -> Maybe Text) -> GHCTargetVersion -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GHCTargetVersion -> Maybe Text
_tvTarget (GHCTargetVersion -> Bool) -> GHCTargetVersion -> Bool
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
ver) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString -> m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadLogger m) =>
Path Abs -> ByteString -> m ()
symlinkShareDir Path Abs
ghcdir ByteString
verBS

  GHCTargetVersion -> Excepts '[NotInstalled] m GHCTargetVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCTargetVersion
ver

 where

  symlinkShareDir :: (MonadReader AppState m, MonadIO m, MonadLogger m)
                  => Path Abs
                  -> ByteString
                  -> m ()
  symlinkShareDir :: Path Abs -> ByteString -> m ()
symlinkShareDir Path Abs
ghcdir ByteString
verBS = do
    AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..} } <- m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
    let destdir :: Path Abs
destdir = Path Abs
baseDir
    case SetGHC
sghc of
      SetGHC
SetGHCOnly -> do
        let sharedir :: Path Rel
sharedir     = [rel|share|]
        let fullsharedir :: Path Abs
fullsharedir = Path Abs
ghcdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
sharedir
        m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO Bool
forall b. Path b -> IO Bool
doesDirectoryExist Path Abs
fullsharedir) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          let fullF :: Path Abs
fullF   = Path Abs
destdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
sharedir
          let targetF :: ByteString
targetF = ByteString
"./ghc/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
verBS ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
sharedir
          $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|rm -f #{fullF}|]
          IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile Path Abs
fullF
          $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|ln -s #{targetF} #{fullF}|]
          IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString -> IO ()
forall b. Path b -> ByteString -> IO ()
createSymlink Path Abs
fullF ByteString
targetF
      SetGHC
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()



-- | Set the @~\/.ghcup\/bin\/cabal@ symlink.
setCabal :: (MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m, MonadIO m)
         => Version
         -> Excepts '[NotInstalled] m ()
setCabal :: Version -> Excepts '[NotInstalled] m ()
setCabal Version
ver = do
  let verBS :: ByteString
verBS = Version -> ByteString
verToBS Version
ver
  Path Rel
targetFile <- ByteString -> Excepts '[NotInstalled] m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (ByteString
"cabal-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
verBS)

  -- symlink destination
  AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..}} <- m AppState -> Excepts '[NotInstalled] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
createDirRecursive' Path Abs
binDir

  Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (IO Bool -> Excepts '[NotInstalled] m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Excepts '[NotInstalled] m Bool)
-> IO Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs -> IO Bool
forall b. Path b -> IO Bool
doesFileExist (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
targetFile))
    (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE
    (NotInstalled -> Excepts '[NotInstalled] m ())
-> NotInstalled -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
Cabal (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
ver)

  let cabalbin :: Path Abs
cabalbin = Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|cabal|]

  -- delete old file (may be binary or symlink)
  m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|rm -f #{toFilePath cabalbin}|]
  IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile
    Path Abs
cabalbin

  -- create symlink
  let destL :: ByteString
destL = Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
targetFile
  m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|ln -s #{destL} #{toFilePath cabalbin}|]
  IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString -> IO ()
forall b. Path b -> ByteString -> IO ()
createSymlink Path Abs
cabalbin ByteString
destL

  () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()




-- | Set the haskell-language-server symlinks.
setHLS :: ( MonadCatch m
          , MonadReader AppState m
          , MonadLogger m
          , MonadThrow m
          , MonadFail m
          , MonadIO m
          )
       => Version
       -> Excepts '[NotInstalled] m ()
setHLS :: Version -> Excepts '[NotInstalled] m ()
setHLS Version
ver = do
  AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..} } <- m AppState -> Excepts '[NotInstalled] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
createDirRecursive' Path Abs
binDir

  -- Delete old symlinks, since these might have different ghc versions than the
  -- selected version, so we could end up with stray or incorrect symlinks.
  [Path Rel]
oldSyms <- m [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [Path Rel]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadCatch m) =>
m [Path Rel]
hlsSymlinks
  [Path Rel]
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Rel]
oldSyms ((Path Rel -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \Path Rel
f -> do
    m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|rm #{toFilePath (binDir </> f)}|]
    IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
f)

  -- set haskell-language-server-<ghcver> symlinks
  [Path Rel]
bins <- m [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Path Rel] -> Excepts '[NotInstalled] m [Path Rel])
-> m [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
forall a b. (a -> b) -> a -> b
$ Version -> m [Path Rel]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m) =>
Version -> m [Path Rel]
hlsServerBinaries Version
ver
  Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Path Rel] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Path Rel]
bins) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (NotInstalled -> Excepts '[NotInstalled] m ())
-> NotInstalled -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
HLS (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
ver)

  [Path Rel]
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Rel]
bins ((Path Rel -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \Path Rel
f -> do
    let destL :: ByteString
destL = Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
f
    Path Rel
target <- ByteString -> Excepts '[NotInstalled] m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (ByteString -> Excepts '[NotInstalled] m (Path Rel))
-> (Path Rel -> ByteString)
-> Path Rel
-> Excepts '[NotInstalled] m (Path Rel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. [a] -> a
head ([ByteString] -> ByteString)
-> (Path Rel -> [ByteString]) -> Path Rel -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
B.split Word8
_tilde (ByteString -> [ByteString])
-> (Path Rel -> ByteString) -> Path Rel -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath (Path Rel -> Excepts '[NotInstalled] m (Path Rel))
-> Path Rel -> Excepts '[NotInstalled] m (Path Rel)
forall a b. (a -> b) -> a -> b
$ Path Rel
f

    m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|rm -f #{toFilePath (binDir </> target)}|]
    IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
target)

    m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|ln -s #{destL} #{toFilePath (binDir </> target)}|]
    IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString -> IO ()
forall b. Path b -> ByteString -> IO ()
createSymlink (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
target) ByteString
destL

  -- set haskell-language-server-wrapper symlink
  let destL :: ByteString
destL = ByteString
"haskell-language-server-wrapper-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Version -> ByteString
verToBS Version
ver
  let wrapper :: Path Abs
wrapper = Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|haskell-language-server-wrapper|]

  m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|rm -f #{toFilePath wrapper}|]
  IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile Path Abs
wrapper

  m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|ln -s #{destL} #{toFilePath wrapper}|]
  IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString -> IO ()
forall b. Path b -> ByteString -> IO ()
createSymlink Path Abs
wrapper ByteString
destL

  () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()





    ------------------
    --[ List tools ]--
    ------------------


-- | Filter data type for 'listVersions'.
data ListCriteria = ListInstalled
                  | ListSet
                  deriving Int -> ListCriteria -> ShowS
[ListCriteria] -> ShowS
ListCriteria -> String
(Int -> ListCriteria -> ShowS)
-> (ListCriteria -> String)
-> ([ListCriteria] -> ShowS)
-> Show ListCriteria
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCriteria] -> ShowS
$cshowList :: [ListCriteria] -> ShowS
show :: ListCriteria -> String
$cshow :: ListCriteria -> String
showsPrec :: Int -> ListCriteria -> ShowS
$cshowsPrec :: Int -> ListCriteria -> ShowS
Show

-- | A list result describes a single tool version
-- and various of its properties.
data ListResult = ListResult
  { ListResult -> Tool
lTool      :: Tool
  , ListResult -> Version
lVer       :: Version
  , ListResult -> Maybe Text
lCross     :: Maybe Text -- ^ currently only for GHC
  , ListResult -> [Tag]
lTag       :: [Tag]
  , ListResult -> Bool
lInstalled :: Bool
  , ListResult -> Bool
lSet       :: Bool -- ^ currently active version
  , ListResult -> Bool
fromSrc    :: Bool -- ^ compiled from source
  , ListResult -> Bool
lStray     :: Bool -- ^ not in download info
  , ListResult -> Bool
lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
  , ListResult -> Bool
hlsPowered :: Bool
  }
  deriving (ListResult -> ListResult -> Bool
(ListResult -> ListResult -> Bool)
-> (ListResult -> ListResult -> Bool) -> Eq ListResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListResult -> ListResult -> Bool
$c/= :: ListResult -> ListResult -> Bool
== :: ListResult -> ListResult -> Bool
$c== :: ListResult -> ListResult -> Bool
Eq, Eq ListResult
Eq ListResult
-> (ListResult -> ListResult -> Ordering)
-> (ListResult -> ListResult -> Bool)
-> (ListResult -> ListResult -> Bool)
-> (ListResult -> ListResult -> Bool)
-> (ListResult -> ListResult -> Bool)
-> (ListResult -> ListResult -> ListResult)
-> (ListResult -> ListResult -> ListResult)
-> Ord ListResult
ListResult -> ListResult -> Bool
ListResult -> ListResult -> Ordering
ListResult -> ListResult -> ListResult
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ListResult -> ListResult -> ListResult
$cmin :: ListResult -> ListResult -> ListResult
max :: ListResult -> ListResult -> ListResult
$cmax :: ListResult -> ListResult -> ListResult
>= :: ListResult -> ListResult -> Bool
$c>= :: ListResult -> ListResult -> Bool
> :: ListResult -> ListResult -> Bool
$c> :: ListResult -> ListResult -> Bool
<= :: ListResult -> ListResult -> Bool
$c<= :: ListResult -> ListResult -> Bool
< :: ListResult -> ListResult -> Bool
$c< :: ListResult -> ListResult -> Bool
compare :: ListResult -> ListResult -> Ordering
$ccompare :: ListResult -> ListResult -> Ordering
$cp1Ord :: Eq ListResult
Ord, Int -> ListResult -> ShowS
[ListResult] -> ShowS
ListResult -> String
(Int -> ListResult -> ShowS)
-> (ListResult -> String)
-> ([ListResult] -> ShowS)
-> Show ListResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListResult] -> ShowS
$cshowList :: [ListResult] -> ShowS
show :: ListResult -> String
$cshow :: ListResult -> String
showsPrec :: Int -> ListResult -> ShowS
$cshowsPrec :: Int -> ListResult -> ShowS
Show)


-- | Extract all available tool versions and their tags.
availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version [Tag]
availableToolVersions :: GHCupDownloads -> Tool -> Map Version [Tag]
availableToolVersions GHCupDownloads
av Tool
tool = Optic' A_Getter '[] GHCupDownloads (Map Version [Tag])
-> GHCupDownloads -> Map Version [Tag]
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view
  (Index GHCupDownloads
-> Lens' GHCupDownloads (Maybe (IxValue GHCupDownloads))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index GHCupDownloads
Tool
tool Optic
  A_Lens
  '[]
  GHCupDownloads
  GHCupDownloads
  (Maybe (Map Version VersionInfo))
  (Maybe (Map Version VersionInfo))
-> Optic
     An_Iso
     '[]
     (Maybe (Map Version VersionInfo))
     (Maybe (Map Version VersionInfo))
     (Map Version VersionInfo)
     (Map Version VersionInfo)
-> Optic
     A_Lens
     '[]
     GHCupDownloads
     GHCupDownloads
     (Map Version VersionInfo)
     (Map Version VersionInfo)
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Map Version VersionInfo
-> Optic
     An_Iso
     '[]
     (Maybe (Map Version VersionInfo))
     (Maybe (Map Version VersionInfo))
     (Map Version VersionInfo)
     (Map Version VersionInfo)
forall a. Eq a => a -> Iso' (Maybe a) a
non Map Version VersionInfo
forall k a. Map k a
Map.empty Optic
  A_Lens
  '[]
  GHCupDownloads
  GHCupDownloads
  (Map Version VersionInfo)
  (Map Version VersionInfo)
-> Optic
     A_Getter
     '[]
     (Map Version VersionInfo)
     (Map Version VersionInfo)
     (Map Version [Tag])
     (Map Version [Tag])
-> Optic' A_Getter '[] GHCupDownloads (Map Version [Tag])
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Map Version VersionInfo -> Map Version [Tag])
-> Optic
     A_Getter
     '[]
     (Map Version VersionInfo)
     (Map Version VersionInfo)
     (Map Version [Tag])
     (Map Version [Tag])
forall s a. (s -> a) -> Getter s a
to ((VersionInfo -> [Tag])
-> Map Version VersionInfo -> Map Version [Tag]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VersionInfo -> [Tag]
_viTags))
  GHCupDownloads
av


-- | List all versions from the download info, as well as stray
-- versions.
listVersions :: ( MonadCatch m
                , MonadLogger m
                , MonadThrow m
                , MonadLogger m
                , MonadIO m
                , MonadReader AppState m
                )
             => GHCupDownloads
             -> Maybe Tool
             -> Maybe ListCriteria
             -> PlatformRequest
             -> m [ListResult]
listVersions :: GHCupDownloads
-> Maybe Tool
-> Maybe ListCriteria
-> PlatformRequest
-> m [ListResult]
listVersions GHCupDownloads
av Maybe Tool
lt' Maybe ListCriteria
criteria PlatformRequest
pfreq = do
  -- some annoying work to avoid too much repeated IO
  Maybe Version
cSet <- m (Maybe Version)
forall (m :: * -> *).
(MonadLogger m, MonadReader AppState m, MonadIO m, MonadThrow m,
 MonadCatch m) =>
m (Maybe Version)
cabalSet
  [Either (Path Rel) Version]
cabals <- Maybe Version -> m [Either (Path Rel) Version]
forall (m :: * -> *).
(MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m) =>
Maybe Version -> m [Either (Path Rel) Version]
getInstalledCabals' Maybe Version
cSet
  Maybe Version
hlsSet' <- m (Maybe Version)
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) =>
m (Maybe Version)
hlsSet
  [Either (Path Rel) Version]
hlses <- m [Either (Path Rel) Version]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadCatch m) =>
m [Either (Path Rel) Version]
getInstalledHLSs

  Maybe Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> m [ListResult]
go Maybe Tool
lt' Maybe Version
cSet [Either (Path Rel) Version]
cabals Maybe Version
hlsSet' [Either (Path Rel) Version]
hlses
 where
  go :: Maybe Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> m [ListResult]
go Maybe Tool
lt Maybe Version
cSet [Either (Path Rel) Version]
cabals Maybe Version
hlsSet' [Either (Path Rel) Version]
hlses = do
    case Maybe Tool
lt of
      Just Tool
t -> do
        -- get versions from GHCupDownloads
        let avTools :: Map Version [Tag]
avTools = GHCupDownloads -> Tool -> Map Version [Tag]
availableToolVersions GHCupDownloads
av Tool
t
        [ListResult]
lr <- [ListResult] -> [ListResult]
filter' ([ListResult] -> [ListResult]) -> m [ListResult] -> m [ListResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Version, [Tag])]
-> ((Version, [Tag]) -> m ListResult) -> m [ListResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map Version [Tag] -> [(Version, [Tag])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Version [Tag]
avTools) (Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> (Version, [Tag])
-> m ListResult
forall (m :: * -> *).
(MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m) =>
Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> (Version, [Tag])
-> m ListResult
toListResult Tool
t Maybe Version
cSet [Either (Path Rel) Version]
cabals Maybe Version
hlsSet' [Either (Path Rel) Version]
hlses)

        case Tool
t of
          Tool
GHC -> do
            [ListResult]
slr <- Map Version [Tag] -> m [ListResult]
forall (m :: * -> *).
(MonadCatch m, MonadReader AppState m, MonadThrow m, MonadLogger m,
 MonadIO m) =>
Map Version [Tag] -> m [ListResult]
strayGHCs Map Version [Tag]
avTools
            [ListResult] -> m [ListResult]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ListResult] -> [ListResult]
forall a. Ord a => [a] -> [a]
sort ([ListResult]
slr [ListResult] -> [ListResult] -> [ListResult]
forall a. [a] -> [a] -> [a]
++ [ListResult]
lr))
          Tool
Cabal -> do
            [ListResult]
slr <- Map Version [Tag]
-> Maybe Version -> [Either (Path Rel) Version] -> m [ListResult]
forall (m :: * -> *).
(MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m,
 MonadIO m) =>
Map Version [Tag]
-> Maybe Version -> [Either (Path Rel) Version] -> m [ListResult]
strayCabals Map Version [Tag]
avTools Maybe Version
cSet [Either (Path Rel) Version]
cabals
            [ListResult] -> m [ListResult]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ListResult] -> [ListResult]
forall a. Ord a => [a] -> [a]
sort ([ListResult]
slr [ListResult] -> [ListResult] -> [ListResult]
forall a. [a] -> [a] -> [a]
++ [ListResult]
lr))
          Tool
HLS -> do
            [ListResult]
slr <- Map Version [Tag] -> m [ListResult]
forall (m :: * -> *).
(MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m,
 MonadIO m) =>
Map Version [Tag] -> m [ListResult]
strayHLS Map Version [Tag]
avTools
            [ListResult] -> m [ListResult]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ListResult] -> [ListResult]
forall a. Ord a => [a] -> [a]
sort ([ListResult]
slr [ListResult] -> [ListResult] -> [ListResult]
forall a. [a] -> [a] -> [a]
++ [ListResult]
lr))
          Tool
GHCup -> [ListResult] -> m [ListResult]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ListResult]
lr
      Maybe Tool
Nothing -> do
        [ListResult]
ghcvers   <- Maybe Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> m [ListResult]
go (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
GHC) Maybe Version
cSet [Either (Path Rel) Version]
cabals Maybe Version
hlsSet' [Either (Path Rel) Version]
hlses
        [ListResult]
cabalvers <- Maybe Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> m [ListResult]
go (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Cabal) Maybe Version
cSet [Either (Path Rel) Version]
cabals Maybe Version
hlsSet' [Either (Path Rel) Version]
hlses
        [ListResult]
hlsvers   <- Maybe Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> m [ListResult]
go (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
HLS) Maybe Version
cSet [Either (Path Rel) Version]
cabals Maybe Version
hlsSet' [Either (Path Rel) Version]
hlses
        [ListResult]
ghcupvers <- Maybe Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> m [ListResult]
go (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
GHCup) Maybe Version
cSet [Either (Path Rel) Version]
cabals Maybe Version
hlsSet' [Either (Path Rel) Version]
hlses
        [ListResult] -> m [ListResult]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ListResult]
ghcvers [ListResult] -> [ListResult] -> [ListResult]
forall a. Semigroup a => a -> a -> a
<> [ListResult]
cabalvers [ListResult] -> [ListResult] -> [ListResult]
forall a. Semigroup a => a -> a -> a
<> [ListResult]
hlsvers [ListResult] -> [ListResult] -> [ListResult]
forall a. Semigroup a => a -> a -> a
<> [ListResult]
ghcupvers)
  strayGHCs :: (MonadCatch m, MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m)
            => Map.Map Version [Tag]
            -> m [ListResult]
  strayGHCs :: Map Version [Tag] -> m [ListResult]
strayGHCs Map Version [Tag]
avTools = do
    [Either (Path Rel) GHCTargetVersion]
ghcs <- m [Either (Path Rel) GHCTargetVersion]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m) =>
m [Either (Path Rel) GHCTargetVersion]
getInstalledGHCs
    ([Maybe ListResult] -> [ListResult])
-> m [Maybe ListResult] -> m [ListResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe ListResult] -> [ListResult]
forall a. [Maybe a] -> [a]
catMaybes (m [Maybe ListResult] -> m [ListResult])
-> m [Maybe ListResult] -> m [ListResult]
forall a b. (a -> b) -> a -> b
$ [Either (Path Rel) GHCTargetVersion]
-> (Either (Path Rel) GHCTargetVersion -> m (Maybe ListResult))
-> m [Maybe ListResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Either (Path Rel) GHCTargetVersion]
ghcs ((Either (Path Rel) GHCTargetVersion -> m (Maybe ListResult))
 -> m [Maybe ListResult])
-> (Either (Path Rel) GHCTargetVersion -> m (Maybe ListResult))
-> m [Maybe ListResult]
forall a b. (a -> b) -> a -> b
$ \case
      Right tver :: GHCTargetVersion
tver@GHCTargetVersion{ _tvTarget :: GHCTargetVersion -> Maybe Text
_tvTarget = Maybe Text
Nothing, Version
_tvVersion :: Version
_tvVersion :: GHCTargetVersion -> Version
.. } -> do
        case Version -> Map Version [Tag] -> Maybe [Tag]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
_tvVersion Map Version [Tag]
avTools of
          Just [Tag]
_  -> Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing
          Maybe [Tag]
Nothing -> do
            Bool
lSet    <- (Maybe GHCTargetVersion -> Bool)
-> m (Maybe GHCTargetVersion) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool
-> (GHCTargetVersion -> Bool) -> Maybe GHCTargetVersion -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(GHCTargetVersion Maybe Text
_ Version
v ) -> Version
v Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
_tvVersion)) (m (Maybe GHCTargetVersion) -> m Bool)
-> m (Maybe GHCTargetVersion) -> m Bool
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe GHCTargetVersion)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadIO m) =>
Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet Maybe Text
forall a. Maybe a
Nothing
            Bool
fromSrc <- GHCTargetVersion -> m Bool
forall (m :: * -> *).
(MonadIO m, MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcSrcInstalled GHCTargetVersion
tver
            Bool
hlsPowered <- ([Version] -> Bool) -> m [Version] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Version
_tvVersion) m [Version]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) =>
m [Version]
hlsGHCVersions
            Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ListResult -> m (Maybe ListResult))
-> Maybe ListResult -> m (Maybe ListResult)
forall a b. (a -> b) -> a -> b
$ ListResult -> Maybe ListResult
forall a. a -> Maybe a
Just (ListResult -> Maybe ListResult) -> ListResult -> Maybe ListResult
forall a b. (a -> b) -> a -> b
$ ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult
              { lTool :: Tool
lTool      = Tool
GHC
              , lVer :: Version
lVer       = Version
_tvVersion
              , lCross :: Maybe Text
lCross     = Maybe Text
forall a. Maybe a
Nothing
              , lTag :: [Tag]
lTag       = []
              , lInstalled :: Bool
lInstalled = Bool
True
              , lStray :: Bool
lStray     = Maybe [Tag] -> Bool
forall a. Maybe a -> Bool
isNothing (Version -> Map Version [Tag] -> Maybe [Tag]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
_tvVersion Map Version [Tag]
avTools)
              , lNoBindist :: Bool
lNoBindist = Bool
False
              , Bool
hlsPowered :: Bool
fromSrc :: Bool
lSet :: Bool
hlsPowered :: Bool
fromSrc :: Bool
lSet :: Bool
..
              }
      Right tver :: GHCTargetVersion
tver@GHCTargetVersion{ Maybe Text
Version
_tvVersion :: Version
_tvTarget :: Maybe Text
_tvTarget :: GHCTargetVersion -> Maybe Text
_tvVersion :: GHCTargetVersion -> Version
.. } -> do
        Bool
lSet    <- (Maybe GHCTargetVersion -> Bool)
-> m (Maybe GHCTargetVersion) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool
-> (GHCTargetVersion -> Bool) -> Maybe GHCTargetVersion -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(GHCTargetVersion Maybe Text
_ Version
v ) -> Version
v Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
_tvVersion)) (m (Maybe GHCTargetVersion) -> m Bool)
-> m (Maybe GHCTargetVersion) -> m Bool
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe GHCTargetVersion)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadIO m) =>
Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet Maybe Text
_tvTarget
        Bool
fromSrc <- GHCTargetVersion -> m Bool
forall (m :: * -> *).
(MonadIO m, MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcSrcInstalled GHCTargetVersion
tver
        Bool
hlsPowered <- ([Version] -> Bool) -> m [Version] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Version
_tvVersion) m [Version]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) =>
m [Version]
hlsGHCVersions
        Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ListResult -> m (Maybe ListResult))
-> Maybe ListResult -> m (Maybe ListResult)
forall a b. (a -> b) -> a -> b
$ ListResult -> Maybe ListResult
forall a. a -> Maybe a
Just (ListResult -> Maybe ListResult) -> ListResult -> Maybe ListResult
forall a b. (a -> b) -> a -> b
$ ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult
          { lTool :: Tool
lTool      = Tool
GHC
          , lVer :: Version
lVer       = Version
_tvVersion
          , lCross :: Maybe Text
lCross     = Maybe Text
_tvTarget
          , lTag :: [Tag]
lTag       = []
          , lInstalled :: Bool
lInstalled = Bool
True
          , lStray :: Bool
lStray     = Bool
True -- NOTE: cross currently cannot be installed via bindist
          , lNoBindist :: Bool
lNoBindist = Bool
False
          , Bool
hlsPowered :: Bool
fromSrc :: Bool
lSet :: Bool
hlsPowered :: Bool
fromSrc :: Bool
lSet :: Bool
..
          }
      Left Path Rel
e -> do
        $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn)
          [i|Could not parse version of stray directory #{toFilePath e}|]
        Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing

  strayCabals :: (MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m)
            => Map.Map Version [Tag]
            -> Maybe Version
            -> [Either (Path Rel) Version]
            -> m [ListResult]
  strayCabals :: Map Version [Tag]
-> Maybe Version -> [Either (Path Rel) Version] -> m [ListResult]
strayCabals Map Version [Tag]
avTools Maybe Version
cSet [Either (Path Rel) Version]
cabals = do
    ([Maybe ListResult] -> [ListResult])
-> m [Maybe ListResult] -> m [ListResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe ListResult] -> [ListResult]
forall a. [Maybe a] -> [a]
catMaybes (m [Maybe ListResult] -> m [ListResult])
-> m [Maybe ListResult] -> m [ListResult]
forall a b. (a -> b) -> a -> b
$ [Either (Path Rel) Version]
-> (Either (Path Rel) Version -> m (Maybe ListResult))
-> m [Maybe ListResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Either (Path Rel) Version]
cabals ((Either (Path Rel) Version -> m (Maybe ListResult))
 -> m [Maybe ListResult])
-> (Either (Path Rel) Version -> m (Maybe ListResult))
-> m [Maybe ListResult]
forall a b. (a -> b) -> a -> b
$ \case
      Right Version
ver ->
        case Version -> Map Version [Tag] -> Maybe [Tag]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
ver Map Version [Tag]
avTools of
          Just [Tag]
_  -> Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing
          Maybe [Tag]
Nothing -> do
            let lSet :: Bool
lSet = Maybe Version
cSet Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver
            Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ListResult -> m (Maybe ListResult))
-> Maybe ListResult -> m (Maybe ListResult)
forall a b. (a -> b) -> a -> b
$ ListResult -> Maybe ListResult
forall a. a -> Maybe a
Just (ListResult -> Maybe ListResult) -> ListResult -> Maybe ListResult
forall a b. (a -> b) -> a -> b
$ ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult
              { lTool :: Tool
lTool      = Tool
Cabal
              , lVer :: Version
lVer       = Version
ver
              , lCross :: Maybe Text
lCross     = Maybe Text
forall a. Maybe a
Nothing
              , lTag :: [Tag]
lTag       = []
              , lInstalled :: Bool
lInstalled = Bool
True
              , lStray :: Bool
lStray     = Maybe [Tag] -> Bool
forall a. Maybe a -> Bool
isNothing (Version -> Map Version [Tag] -> Maybe [Tag]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
ver Map Version [Tag]
avTools)
              , lNoBindist :: Bool
lNoBindist = Bool
False
              , fromSrc :: Bool
fromSrc    = Bool
False -- actually, we don't know :>
              , hlsPowered :: Bool
hlsPowered = Bool
False
              , Bool
lSet :: Bool
lSet :: Bool
..
              }
      Left Path Rel
e -> do
        $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn)
          [i|Could not parse version of stray directory #{toFilePath e}|]
        Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing

  strayHLS :: (MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m)
           => Map.Map Version [Tag]
           -> m [ListResult]
  strayHLS :: Map Version [Tag] -> m [ListResult]
strayHLS Map Version [Tag]
avTools = do
    [Either (Path Rel) Version]
hlss <- m [Either (Path Rel) Version]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadCatch m) =>
m [Either (Path Rel) Version]
getInstalledHLSs
    ([Maybe ListResult] -> [ListResult])
-> m [Maybe ListResult] -> m [ListResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe ListResult] -> [ListResult]
forall a. [Maybe a] -> [a]
catMaybes (m [Maybe ListResult] -> m [ListResult])
-> m [Maybe ListResult] -> m [ListResult]
forall a b. (a -> b) -> a -> b
$ [Either (Path Rel) Version]
-> (Either (Path Rel) Version -> m (Maybe ListResult))
-> m [Maybe ListResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Either (Path Rel) Version]
hlss ((Either (Path Rel) Version -> m (Maybe ListResult))
 -> m [Maybe ListResult])
-> (Either (Path Rel) Version -> m (Maybe ListResult))
-> m [Maybe ListResult]
forall a b. (a -> b) -> a -> b
$ \case
      Right Version
ver ->
        case Version -> Map Version [Tag] -> Maybe [Tag]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
ver Map Version [Tag]
avTools of
          Just [Tag]
_  -> Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing
          Maybe [Tag]
Nothing -> do
            Bool
lSet    <- (Maybe Version -> Bool) -> m (Maybe Version) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver) m (Maybe Version)
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) =>
m (Maybe Version)
hlsSet
            Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ListResult -> m (Maybe ListResult))
-> Maybe ListResult -> m (Maybe ListResult)
forall a b. (a -> b) -> a -> b
$ ListResult -> Maybe ListResult
forall a. a -> Maybe a
Just (ListResult -> Maybe ListResult) -> ListResult -> Maybe ListResult
forall a b. (a -> b) -> a -> b
$ ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult
              { lTool :: Tool
lTool      = Tool
HLS
              , lVer :: Version
lVer       = Version
ver
              , lCross :: Maybe Text
lCross     = Maybe Text
forall a. Maybe a
Nothing
              , lTag :: [Tag]
lTag       = []
              , lInstalled :: Bool
lInstalled = Bool
True
              , lStray :: Bool
lStray     = Maybe [Tag] -> Bool
forall a. Maybe a -> Bool
isNothing (Version -> Map Version [Tag] -> Maybe [Tag]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
ver Map Version [Tag]
avTools)
              , lNoBindist :: Bool
lNoBindist = Bool
False
              , fromSrc :: Bool
fromSrc    = Bool
False -- actually, we don't know :>
              , hlsPowered :: Bool
hlsPowered = Bool
False
              , Bool
lSet :: Bool
lSet :: Bool
..
              }
      Left Path Rel
e -> do
        $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn)
          [i|Could not parse version of stray directory #{toFilePath e}|]
        Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing

  -- NOTE: this are not cross ones, because no bindists
  toListResult :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m)
               => Tool
               -> Maybe Version
               -> [Either (Path Rel) Version]
               -> Maybe Version
               -> [Either (Path Rel) Version]
               -> (Version, [Tag])
               -> m ListResult
  toListResult :: Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> (Version, [Tag])
-> m ListResult
toListResult Tool
t Maybe Version
cSet [Either (Path Rel) Version]
cabals Maybe Version
hlsSet' [Either (Path Rel) Version]
hlses (Version
v, [Tag]
tags) = case Tool
t of
    Tool
GHC -> do
      let lNoBindist :: Bool
lNoBindist = Either NoDownload DownloadInfo -> Bool
forall a b. Either a b -> Bool
isLeft (Either NoDownload DownloadInfo -> Bool)
-> Either NoDownload DownloadInfo -> Bool
forall a b. (a -> b) -> a -> b
$ Tool
-> Version
-> PlatformRequest
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo Tool
GHC Version
v PlatformRequest
pfreq GHCupDownloads
av
      let tver :: GHCTargetVersion
tver = Version -> GHCTargetVersion
mkTVer Version
v
      Bool
lSet       <- (Maybe GHCTargetVersion -> Bool)
-> m (Maybe GHCTargetVersion) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool
-> (GHCTargetVersion -> Bool) -> Maybe GHCTargetVersion -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(GHCTargetVersion Maybe Text
_ Version
v') -> Version
v' Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
v)) (m (Maybe GHCTargetVersion) -> m Bool)
-> m (Maybe GHCTargetVersion) -> m Bool
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe GHCTargetVersion)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadIO m) =>
Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet Maybe Text
forall a. Maybe a
Nothing
      Bool
lInstalled <- GHCTargetVersion -> m Bool
forall (m :: * -> *).
(MonadIO m, MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
tver
      Bool
fromSrc    <- GHCTargetVersion -> m Bool
forall (m :: * -> *).
(MonadIO m, MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcSrcInstalled GHCTargetVersion
tver
      Bool
hlsPowered <- ([Version] -> Bool) -> m [Version] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Version
v) m [Version]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) =>
m [Version]
hlsGHCVersions
      ListResult -> m ListResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult { lVer :: Version
lVer = Version
v, lCross :: Maybe Text
lCross = Maybe Text
forall a. Maybe a
Nothing , lTag :: [Tag]
lTag = [Tag]
tags, lTool :: Tool
lTool = Tool
t, lStray :: Bool
lStray = Bool
False, Bool
hlsPowered :: Bool
fromSrc :: Bool
lInstalled :: Bool
lSet :: Bool
lNoBindist :: Bool
hlsPowered :: Bool
lNoBindist :: Bool
fromSrc :: Bool
lSet :: Bool
lInstalled :: Bool
.. }
    Tool
Cabal -> do
      let lNoBindist :: Bool
lNoBindist = Either NoDownload DownloadInfo -> Bool
forall a b. Either a b -> Bool
isLeft (Either NoDownload DownloadInfo -> Bool)
-> Either NoDownload DownloadInfo -> Bool
forall a b. (a -> b) -> a -> b
$ Tool
-> Version
-> PlatformRequest
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo Tool
Cabal Version
v PlatformRequest
pfreq GHCupDownloads
av
      let lSet :: Bool
lSet = Maybe Version
cSet Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> Maybe Version
forall a. a -> Maybe a
Just Version
v
      let lInstalled :: Bool
lInstalled = Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Version
v ([Version] -> Bool) -> [Version] -> Bool
forall a b. (a -> b) -> a -> b
$ [Either (Path Rel) Version] -> [Version]
forall a b. [Either a b] -> [b]
rights [Either (Path Rel) Version]
cabals
      ListResult -> m ListResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult { lVer :: Version
lVer    = Version
v
                      , lCross :: Maybe Text
lCross  = Maybe Text
forall a. Maybe a
Nothing
                      , lTag :: [Tag]
lTag    = [Tag]
tags
                      , lTool :: Tool
lTool   = Tool
t
                      , fromSrc :: Bool
fromSrc = Bool
False
                      , lStray :: Bool
lStray  = Bool
False
                      , hlsPowered :: Bool
hlsPowered = Bool
False
                      , Bool
lInstalled :: Bool
lSet :: Bool
lNoBindist :: Bool
lNoBindist :: Bool
lSet :: Bool
lInstalled :: Bool
..
                      }
    Tool
GHCup -> do
      let lSet :: Bool
lSet       = PVP -> Text
prettyPVP PVP
ghcUpVer Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> Text
prettyVer Version
v
      let lInstalled :: Bool
lInstalled = Bool
lSet
      ListResult -> m ListResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult { lVer :: Version
lVer    = Version
v
                      , lTag :: [Tag]
lTag    = [Tag]
tags
                      , lCross :: Maybe Text
lCross  = Maybe Text
forall a. Maybe a
Nothing
                      , lTool :: Tool
lTool   = Tool
t
                      , fromSrc :: Bool
fromSrc = Bool
False
                      , lStray :: Bool
lStray  = Bool
False
                      , lNoBindist :: Bool
lNoBindist = Bool
False
                      , hlsPowered :: Bool
hlsPowered = Bool
False
                      , Bool
lInstalled :: Bool
lSet :: Bool
lSet :: Bool
lInstalled :: Bool
..
                      }
    Tool
HLS -> do
      let lNoBindist :: Bool
lNoBindist = Either NoDownload DownloadInfo -> Bool
forall a b. Either a b -> Bool
isLeft (Either NoDownload DownloadInfo -> Bool)
-> Either NoDownload DownloadInfo -> Bool
forall a b. (a -> b) -> a -> b
$ Tool
-> Version
-> PlatformRequest
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo Tool
HLS Version
v PlatformRequest
pfreq GHCupDownloads
av
      let lSet :: Bool
lSet = Maybe Version
hlsSet' Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> Maybe Version
forall a. a -> Maybe a
Just Version
v
      let lInstalled :: Bool
lInstalled = Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Version
v ([Version] -> Bool) -> [Version] -> Bool
forall a b. (a -> b) -> a -> b
$ [Either (Path Rel) Version] -> [Version]
forall a b. [Either a b] -> [b]
rights [Either (Path Rel) Version]
hlses
      ListResult -> m ListResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult { lVer :: Version
lVer    = Version
v
                      , lCross :: Maybe Text
lCross  = Maybe Text
forall a. Maybe a
Nothing
                      , lTag :: [Tag]
lTag    = [Tag]
tags
                      , lTool :: Tool
lTool   = Tool
t
                      , fromSrc :: Bool
fromSrc = Bool
False
                      , lStray :: Bool
lStray  = Bool
False
                      , hlsPowered :: Bool
hlsPowered = Bool
False
                      , Bool
lInstalled :: Bool
lSet :: Bool
lNoBindist :: Bool
lNoBindist :: Bool
lSet :: Bool
lInstalled :: Bool
..
                      }


  filter' :: [ListResult] -> [ListResult]
  filter' :: [ListResult] -> [ListResult]
filter' [ListResult]
lr = case Maybe ListCriteria
criteria of
    Maybe ListCriteria
Nothing            -> [ListResult]
lr
    Just ListCriteria
ListInstalled -> (ListResult -> Bool) -> [ListResult] -> [ListResult]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ListResult {Bool
[Tag]
Maybe Text
Version
Tool
hlsPowered :: Bool
lNoBindist :: Bool
lStray :: Bool
fromSrc :: Bool
lSet :: Bool
lInstalled :: Bool
lTag :: [Tag]
lCross :: Maybe Text
lVer :: Version
lTool :: Tool
hlsPowered :: ListResult -> Bool
lNoBindist :: ListResult -> Bool
lStray :: ListResult -> Bool
fromSrc :: ListResult -> Bool
lSet :: ListResult -> Bool
lInstalled :: ListResult -> Bool
lTag :: ListResult -> [Tag]
lCross :: ListResult -> Maybe Text
lVer :: ListResult -> Version
lTool :: ListResult -> Tool
..} -> Bool
lInstalled) [ListResult]
lr
    Just ListCriteria
ListSet       -> (ListResult -> Bool) -> [ListResult] -> [ListResult]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ListResult {Bool
[Tag]
Maybe Text
Version
Tool
hlsPowered :: Bool
lNoBindist :: Bool
lStray :: Bool
fromSrc :: Bool
lSet :: Bool
lInstalled :: Bool
lTag :: [Tag]
lCross :: Maybe Text
lVer :: Version
lTool :: Tool
hlsPowered :: ListResult -> Bool
lNoBindist :: ListResult -> Bool
lStray :: ListResult -> Bool
fromSrc :: ListResult -> Bool
lSet :: ListResult -> Bool
lInstalled :: ListResult -> Bool
lTag :: ListResult -> [Tag]
lCross :: ListResult -> Maybe Text
lVer :: ListResult -> Version
lTool :: ListResult -> Tool
..} -> Bool
lSet) [ListResult]
lr



    --------------------
    --[ GHC/cabal rm ]--
    --------------------


-- | Delete a ghc version and all its symlinks.
--
-- This may leave GHCup without a "set" version.
-- Will try to fix the ghc-x.y symlink after removal (e.g. to an
-- older version).
rmGHCVer :: ( MonadReader AppState m
            , MonadThrow m
            , MonadLogger m
            , MonadIO m
            , MonadFail m
            , MonadCatch m
            )
         => GHCTargetVersion
         -> Excepts '[NotInstalled] m ()
rmGHCVer :: GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmGHCVer GHCTargetVersion
ver = do
  Bool
isSetGHC <- m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ (Maybe GHCTargetVersion -> Bool)
-> m (Maybe GHCTargetVersion) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe GHCTargetVersion -> Maybe GHCTargetVersion -> Bool
forall a. Eq a => a -> a -> Bool
== GHCTargetVersion -> Maybe GHCTargetVersion
forall a. a -> Maybe a
Just GHCTargetVersion
ver) (m (Maybe GHCTargetVersion) -> m Bool)
-> m (Maybe GHCTargetVersion) -> m Bool
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe GHCTargetVersion)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadIO m) =>
Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
ver)

  Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m Bool
forall (m :: * -> *).
(MonadIO m, MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
ver) (NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
GHC GHCTargetVersion
ver))
  Path Abs
dir <- m (Path Abs) -> Excepts '[NotInstalled] m (Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Path Abs) -> Excepts '[NotInstalled] m (Path Abs))
-> m (Path Abs) -> Excepts '[NotInstalled] m (Path Abs)
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m (Path Abs)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m (Path Abs)
ghcupGHCDir GHCTargetVersion
ver

  -- this isn't atomic, order matters
  Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isSetGHC (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ do
    m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|Removing ghc symlinks|]
    Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
 MonadIO m) =>
Maybe Text -> Excepts '[NotInstalled] m ()
rmPlain (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
ver)

  m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|Removing ghc-x.y.z symlinks|]
  Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadLogger m, MonadThrow m,
 MonadFail m, MonadReader AppState m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMinorSymlinks GHCTargetVersion
ver

  m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|Removing/rewiring ghc-x.y symlinks|]
  -- first remove
  (ParseError -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\(ParseError
_ :: ParseError) -> () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadLogger m, MonadThrow m,
 MonadFail m, MonadReader AppState m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMajorSymlinks GHCTargetVersion
ver
  -- then fix them (e.g. with an earlier version)

  m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|Removing directory recursively: #{toFilePath dir}|]
  IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteDirRecursive Path Abs
dir

  Maybe CharPos
v' <-
    (ParseError -> Excepts '[NotInstalled] m (Maybe CharPos))
-> Excepts '[NotInstalled] m (Maybe CharPos)
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle
      (\(ParseError
e :: ParseError) -> m (Maybe CharPos) -> Excepts '[NotInstalled] m (Maybe CharPos)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe CharPos) -> Excepts '[NotInstalled] m (Maybe CharPos))
-> m (Maybe CharPos) -> Excepts '[NotInstalled] m (Maybe CharPos)
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn) [i|#{e}|] m () -> m (Maybe CharPos) -> m (Maybe CharPos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe CharPos -> m (Maybe CharPos)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CharPos
forall a. Maybe a
Nothing)
    (Excepts '[NotInstalled] m (Maybe CharPos)
 -> Excepts '[NotInstalled] m (Maybe CharPos))
-> Excepts '[NotInstalled] m (Maybe CharPos)
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall a b. (a -> b) -> a -> b
$ (CharPos -> Maybe CharPos)
-> Excepts '[NotInstalled] m CharPos
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CharPos -> Maybe CharPos
forall a. a -> Maybe a
Just
    (Excepts '[NotInstalled] m CharPos
 -> Excepts '[NotInstalled] m (Maybe CharPos))
-> Excepts '[NotInstalled] m CharPos
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m CharPos
forall (m :: * -> *). MonadThrow m => Version -> m CharPos
getMajorMinorV (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
  Maybe CharPos
-> (CharPos -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe CharPos
v' ((CharPos -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> (CharPos -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \(Int
mj, Int
mi) -> m (Maybe GHCTargetVersion)
-> Excepts '[NotInstalled] m (Maybe GHCTargetVersion)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Int -> Maybe Text -> m (Maybe GHCTargetVersion)
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m) =>
Int -> Int -> Maybe Text -> m (Maybe GHCTargetVersion)
getGHCForMajor Int
mj Int
mi (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
ver))
    Excepts '[NotInstalled] m (Maybe GHCTargetVersion)
-> (Maybe GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (GHCTargetVersion -> Excepts '[NotInstalled] m GHCTargetVersion)
-> Maybe GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\GHCTargetVersion
v -> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m GHCTargetVersion
 -> Excepts '[NotInstalled] m GHCTargetVersion)
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
forall (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
 MonadIO m, MonadCatch m) =>
GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
v SetGHC
SetGHC_XY)

  AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..} } <- m AppState -> Excepts '[NotInstalled] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask

  IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType
    (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile (Path Abs
baseDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|share|])


-- | Delete a cabal version. Will try to fix the @cabal@ symlink
-- after removal (e.g. setting it to an older version).
rmCabalVer :: (MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m, MonadFail m, MonadCatch m)
           => Version
           -> Excepts '[NotInstalled] m ()
rmCabalVer :: Version -> Excepts '[NotInstalled] m ()
rmCabalVer Version
ver = do
  Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Version -> m Bool
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadReader AppState m, MonadCatch m) =>
Version -> m Bool
cabalInstalled Version
ver) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
Cabal (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
ver))

  Maybe Version
cSet      <- m (Maybe Version) -> Excepts '[NotInstalled] m (Maybe Version)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Maybe Version)
forall (m :: * -> *).
(MonadLogger m, MonadReader AppState m, MonadIO m, MonadThrow m,
 MonadCatch m) =>
m (Maybe Version)
cabalSet

  AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..}} <- m AppState -> Excepts '[NotInstalled] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask

  Path Rel
cabalFile <- m (Path Rel) -> Excepts '[NotInstalled] m (Path Rel)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Path Rel) -> Excepts '[NotInstalled] m (Path Rel))
-> m (Path Rel) -> Excepts '[NotInstalled] m (Path Rel)
forall a b. (a -> b) -> a -> b
$ ByteString -> m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (ByteString
"cabal-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Version -> ByteString
verToBS Version
ver)
  IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
cabalFile)

  Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Version
cSet) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ do
    [Version]
cVers <- m [Version] -> Excepts '[NotInstalled] m [Version]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Version] -> Excepts '[NotInstalled] m [Version])
-> m [Version] -> Excepts '[NotInstalled] m [Version]
forall a b. (a -> b) -> a -> b
$ ([Either (Path Rel) Version] -> [Version])
-> m [Either (Path Rel) Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either (Path Rel) Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either (Path Rel) Version]
forall (m :: * -> *).
(MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m) =>
m [Either (Path Rel) Version]
getInstalledCabals
    case [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. [a] -> [a]
reverse ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort ([Version] -> Maybe Version) -> [Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Version]
cVers of
      Just Version
latestver -> Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
 MonadIO m) =>
Version -> Excepts '[NotInstalled] m ()
setCabal Version
latestver
      Maybe Version
Nothing        -> IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile
        (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|cabal|])


-- | Delete a hls version. Will try to fix the hls symlinks
-- after removal (e.g. setting it to an older version).
rmHLSVer :: (MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m, MonadFail m, MonadCatch m)
         => Version
         -> Excepts '[NotInstalled] m ()
rmHLSVer :: Version -> Excepts '[NotInstalled] m ()
rmHLSVer Version
ver = do
  Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Version -> m Bool
forall (m :: * -> *).
(MonadIO m, MonadReader AppState m, MonadCatch m) =>
Version -> m Bool
hlsInstalled Version
ver) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
HLS (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
ver))

  Maybe Version
isHlsSet      <- m (Maybe Version) -> Excepts '[NotInstalled] m (Maybe Version)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Maybe Version)
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) =>
m (Maybe Version)
hlsSet

  AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..}} <- m AppState -> Excepts '[NotInstalled] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask

  [Path Rel]
bins <- m [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Path Rel] -> Excepts '[NotInstalled] m [Path Rel])
-> m [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
forall a b. (a -> b) -> a -> b
$ Version -> m [Path Rel]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m) =>
Version -> m [Path Rel]
hlsAllBinaries Version
ver
  [Path Rel]
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Rel]
bins ((Path Rel -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \Path Rel
f -> IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
f)

  Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Version
isHlsSet) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ do
    -- delete all set symlinks
    [Path Rel]
oldSyms <- m [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [Path Rel]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadCatch m) =>
m [Path Rel]
hlsSymlinks
    [Path Rel]
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Rel]
oldSyms ((Path Rel -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \Path Rel
f -> do
      m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|rm #{toFilePath (binDir </> f)}|]
      IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
f)
    -- set latest hls
    [Version]
hlsVers <- m [Version] -> Excepts '[NotInstalled] m [Version]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Version] -> Excepts '[NotInstalled] m [Version])
-> m [Version] -> Excepts '[NotInstalled] m [Version]
forall a b. (a -> b) -> a -> b
$ ([Either (Path Rel) Version] -> [Version])
-> m [Either (Path Rel) Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either (Path Rel) Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either (Path Rel) Version]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadCatch m) =>
m [Either (Path Rel) Version]
getInstalledHLSs
    case [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. [a] -> [a]
reverse ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort ([Version] -> Maybe Version) -> [Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Version]
hlsVers of
      Just Version
latestver -> Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadCatch m, MonadReader AppState m, MonadLogger m, MonadThrow m,
 MonadFail m, MonadIO m) =>
Version -> Excepts '[NotInstalled] m ()
setHLS Version
latestver
      Maybe Version
Nothing        -> () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()




    ------------------
    --[ Debug info ]--
    ------------------


getDebugInfo :: (MonadReader AppState m, MonadLogger m, MonadCatch m, MonadIO m)
             => Excepts
                  '[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound]
                  m
                  DebugInfo
getDebugInfo :: Excepts
  '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
  m
  DebugInfo
getDebugInfo = do
  AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..}} <- m AppState
-> Excepts
     '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
     m
     AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  let diBaseDir :: Path Abs
diBaseDir  = Path Abs
baseDir
  let diBinDir :: Path Abs
diBinDir   = Path Abs
binDir
  Path Abs
diGHCDir       <- m (Path Abs)
-> Excepts
     '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
     m
     (Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Path Abs)
forall (m :: * -> *). MonadReader AppState m => m (Path Abs)
ghcupGHCBaseDir
  let diCacheDir :: Path Abs
diCacheDir = Path Abs
cacheDir
  Architecture
diArch         <- Either NoCompatibleArch Architecture
-> Excepts
     '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
     m
     Architecture
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Either e a -> Excepts es m a
lE Either NoCompatibleArch Architecture
getArchitecture
  PlatformResult
diPlatform     <- Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
-> Excepts
     '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
     m
     PlatformResult
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
forall (m :: * -> *).
(MonadLogger m, MonadCatch m, MonadIO m) =>
Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
getPlatform
  DebugInfo
-> Excepts
     '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
     m
     DebugInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DebugInfo
 -> Excepts
      '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
      m
      DebugInfo)
-> DebugInfo
-> Excepts
     '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
     m
     DebugInfo
forall a b. (a -> b) -> a -> b
$ DebugInfo :: Path Abs
-> Path Abs
-> Path Abs
-> Path Abs
-> Architecture
-> PlatformResult
-> DebugInfo
DebugInfo { Path Abs
PlatformResult
Architecture
diPlatform :: PlatformResult
diArch :: Architecture
diCacheDir :: Path Abs
diGHCDir :: Path Abs
diBinDir :: Path Abs
diBaseDir :: Path Abs
diPlatform :: PlatformResult
diArch :: Architecture
diCacheDir :: Path Abs
diGHCDir :: Path Abs
diBinDir :: Path Abs
diBaseDir :: Path Abs
.. }




    ---------------
    --[ Compile ]--
    ---------------


-- | Compile a GHC from source. This behaves wrt symlinks and installation
-- the same as 'installGHCBin'.
compileGHC :: ( MonadMask m
              , MonadReader AppState m
              , MonadThrow m
              , MonadResource m
              , MonadLogger m
              , MonadIO m
              , MonadFail m
              )
           => GHCupDownloads
           -> GHCTargetVersion           -- ^ version to install
           -> Either Version (Path Abs)  -- ^ version to bootstrap with
           -> Maybe Int                  -- ^ jobs
           -> Maybe (Path Abs)           -- ^ build config
           -> Maybe (Path Abs)           -- ^ patch directory
           -> [Text]                     -- ^ additional args to ./configure
           -> PlatformRequest
           -> Excepts
                '[ AlreadyInstalled
                 , BuildFailed
                 , DigestError
                 , DownloadFailed
                 , GHCupSetError
                 , NoDownload
                 , NotFoundInPATH
                 , PatchFailed
                 , UnknownArchive
                 , TarDirDoesNotExist
                 , NotInstalled
#if !defined(TAR)
                 , ArchiveResult
#endif
                 ]
                m
                ()
compileGHC :: GHCupDownloads
-> GHCTargetVersion
-> Either Version (Path Abs)
-> Maybe Int
-> Maybe (Path Abs)
-> Maybe (Path Abs)
-> [Text]
-> PlatformRequest
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
compileGHC GHCupDownloads
dls GHCTargetVersion
tver Either Version (Path Abs)
bstrap Maybe Int
jobs Maybe (Path Abs)
mbuildConfig Maybe (Path Abs)
patchdir [Text]
aargs pfreq :: PlatformRequest
pfreq@PlatformRequest{Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
_rVersion :: PlatformRequest -> Maybe Versioning
_rPlatform :: PlatformRequest -> Platform
_rArch :: PlatformRequest -> Architecture
..}
  = do
    m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|Requested to compile: #{tver} with #{bstrap}|]

    Bool
alreadyInstalled <- m Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      Bool)
-> m Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     Bool
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m Bool
forall (m :: * -> *).
(MonadIO m, MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
tver
    Bool
alreadySet <- (Maybe GHCTargetVersion -> Bool)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Maybe GHCTargetVersion)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe GHCTargetVersion -> Maybe GHCTargetVersion -> Bool
forall a. Eq a => a -> a -> Bool
== GHCTargetVersion -> Maybe GHCTargetVersion
forall a. a -> Maybe a
Just GHCTargetVersion
tver) (Excepts
   '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
     GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
     UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
   m
   (Maybe GHCTargetVersion)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      Bool)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Maybe GHCTargetVersion)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     Bool
forall a b. (a -> b) -> a -> b
$ m (Maybe GHCTargetVersion)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Maybe GHCTargetVersion)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe GHCTargetVersion)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      (Maybe GHCTargetVersion))
-> m (Maybe GHCTargetVersion)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Maybe GHCTargetVersion)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe GHCTargetVersion)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadIO m) =>
Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
tver)

    -- download source tarball
    DownloadInfo
dlInfo <-
      Optic' An_AffineTraversal '[] GHCupDownloads DownloadInfo
-> GHCupDownloads -> Maybe DownloadInfo
forall k (is :: [*]) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index GHCupDownloads
-> Optic'
     (IxKind GHCupDownloads) '[] GHCupDownloads (IxValue GHCupDownloads)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index GHCupDownloads
Tool
GHC Optic
  An_AffineTraversal
  '[]
  GHCupDownloads
  GHCupDownloads
  (Map Version VersionInfo)
  (Map Version VersionInfo)
-> Optic
     An_AffineTraversal
     '[]
     (Map Version VersionInfo)
     (Map Version VersionInfo)
     VersionInfo
     VersionInfo
-> Optic
     An_AffineTraversal
     '[]
     GHCupDownloads
     GHCupDownloads
     VersionInfo
     VersionInfo
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Version VersionInfo)
-> Optic'
     (IxKind (Map Version VersionInfo))
     '[]
     (Map Version VersionInfo)
     (IxValue (Map Version VersionInfo))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix (GHCTargetVersion
tver GHCTargetVersion
-> Optic' A_Lens '[] GHCTargetVersion Version -> Version
forall k s (is :: [*]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens '[] GHCTargetVersion Version
tvVersion) Optic
  An_AffineTraversal
  '[]
  GHCupDownloads
  GHCupDownloads
  VersionInfo
  VersionInfo
-> Optic
     A_Lens
     '[]
     VersionInfo
     VersionInfo
     (Maybe DownloadInfo)
     (Maybe DownloadInfo)
-> Optic
     An_AffineTraversal
     '[]
     GHCupDownloads
     GHCupDownloads
     (Maybe DownloadInfo)
     (Maybe DownloadInfo)
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  VersionInfo
  VersionInfo
  (Maybe DownloadInfo)
  (Maybe DownloadInfo)
viSourceDL Optic
  An_AffineTraversal
  '[]
  GHCupDownloads
  GHCupDownloads
  (Maybe DownloadInfo)
  (Maybe DownloadInfo)
-> Optic
     A_Prism
     '[]
     (Maybe DownloadInfo)
     (Maybe DownloadInfo)
     DownloadInfo
     DownloadInfo
-> Optic' An_AffineTraversal '[] GHCupDownloads DownloadInfo
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Prism
  '[]
  (Maybe DownloadInfo)
  (Maybe DownloadInfo)
  DownloadInfo
  DownloadInfo
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) GHCupDownloads
dls
        Maybe DownloadInfo
-> NoDownload
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? NoDownload
NoDownload
    Path Abs
dl        <- Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed] m (Path Abs)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      (Path Abs))
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Path Abs)
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (m :: * -> *).
(MonadMask m, MonadResource m, MonadThrow m, MonadLogger m,
 MonadIO m, MonadReader AppState m) =>
DownloadInfo
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
downloadCached DownloadInfo
dlInfo Maybe (Path Rel)
forall a. Maybe a
Nothing

    -- unpack
    Path Abs
tmpUnpack <- m (Path Abs)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Path Abs)
forall (m :: * -> *). (MonadThrow m, MonadIO m) => m (Path Abs)
mkGhcupTmpDir
    Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      ())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs
-> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadThrow m) =>
Path Abs
-> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir Path Abs
tmpUnpack Path Abs
dl
    Excepts
  '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
    GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
    UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
  m
  (Either ProcessError ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts
   '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
     GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
     UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
   m
   (Either ProcessError ())
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Either ProcessError ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ IO (Either ProcessError ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Either ProcessError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ProcessError ())
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      (Either ProcessError ()))
-> IO (Either ProcessError ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Either ProcessError ())
forall a b. (a -> b) -> a -> b
$ Platform -> Path Abs -> IO (Either ProcessError ())
darwinNotarization Platform
_rPlatform Path Abs
tmpUnpack

    Either (Path Rel) (Path Abs)
bghc <- case Either Version (Path Abs)
bstrap of
      Right Path Abs
g    -> Either (Path Rel) (Path Abs)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Either (Path Rel) (Path Abs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Path Rel) (Path Abs)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      (Either (Path Rel) (Path Abs)))
-> Either (Path Rel) (Path Abs)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Either (Path Rel) (Path Abs))
forall a b. (a -> b) -> a -> b
$ Path Abs -> Either (Path Rel) (Path Abs)
forall a b. b -> Either a b
Right Path Abs
g
      Left  Version
bver -> Path Rel -> Either (Path Rel) (Path Abs)
forall a b. a -> Either a b
Left (Path Rel -> Either (Path Rel) (Path Abs))
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Path Rel)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Either (Path Rel) (Path Abs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (ByteString
"ghc-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Version -> ByteString
verToBS Version
bver)
    Path Abs
workdir <- Excepts
  '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
    GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
    UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
  m
  (Path Abs)
-> (TarDir
    -> Excepts
         '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
           GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
           UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
         m
         (Path Abs))
-> Maybe TarDir
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Path Abs)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Path Abs
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs
tmpUnpack)
                     (Excepts '[TarDirDoesNotExist] m (Path Abs)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m (Path Abs)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      (Path Abs))
-> (TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs))
-> TarDir
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Path Abs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs)
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadThrow m, MonadCatch m) =>
Path Abs -> TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs)
intoSubdir Path Abs
tmpUnpack)
                     (Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
-> DownloadInfo -> Maybe TarDir
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
dlSubdir DownloadInfo
dlInfo)
    Path Abs
ghcdir         <- m (Path Abs)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Path Abs)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      (Path Abs))
-> m (Path Abs)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Path Abs)
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m (Path Abs)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m (Path Abs)
ghcupGHCDir GHCTargetVersion
tver

    (Path Abs
bindist, ByteString
bmk) <- Excepts '[BuildFailed] m (Path Abs, ByteString)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Path Abs, ByteString)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[BuildFailed] m (Path Abs, ByteString)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      (Path Abs, ByteString))
-> Excepts '[BuildFailed] m (Path Abs, ByteString)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     (Path Abs, ByteString)
forall a b. (a -> b) -> a -> b
$ Path Abs
-> Maybe (Path Abs)
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     (Path Abs, ByteString)
-> Excepts '[BuildFailed] m (Path Abs, ByteString)
forall (e :: [*]) (m :: * -> *) a.
(Show (V e), MonadReader AppState m, MonadIO m, MonadMask m) =>
Path Abs
-> Maybe (Path Abs) -> Excepts e m a -> Excepts '[BuildFailed] m a
runBuildAction
      Path Abs
tmpUnpack
      Maybe (Path Abs)
forall a. Maybe a
Nothing
      (do
        Path Abs
b   <- Either (Path Rel) (Path Abs)
-> Path Abs
-> Path Abs
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     (Path Abs)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadCatch m, MonadLogger m,
 MonadIO m, MonadFail m) =>
Either (Path Rel) (Path Abs)
-> Path Abs
-> Path Abs
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     (Path Abs)
compileBindist Either (Path Rel) (Path Abs)
bghc Path Abs
ghcdir Path Abs
workdir
        ByteString
bmk <- IO ByteString
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ByteString)
-> IO ByteString
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ByteString
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ByteString
forall b. Path b -> IO ByteString
readFileStrict (Path Abs -> Path Abs
forall b. Path b -> Path b
build_mk Path Abs
workdir)
        (Path Abs, ByteString)
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     (Path Abs, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs
b, ByteString
bmk)
      )

    Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadyInstalled (Excepts
   '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
     GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
     UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ do
      m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|Deleting existing installation|]
      Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m,
 MonadFail m, MonadCatch m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmGHCVer GHCTargetVersion
tver
    Excepts
  '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
  m
  ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      ())
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs
-> Maybe TarDir
-> Path Abs
-> Version
-> PlatformRequest
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     ()
forall (m :: * -> *).
(MonadMask m, MonadCatch m, MonadReader AppState m, MonadThrow m,
 MonadLogger m, MonadIO m) =>
Path Abs
-> Maybe TarDir
-> Path Abs
-> Version
-> PlatformRequest
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
     m
     ()
installPackedGHC Path Abs
bindist
                             (Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
-> DownloadInfo -> Maybe TarDir
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
dlSubdir DownloadInfo
dlInfo)
                             Path Abs
ghcdir
                             (GHCTargetVersion
tver GHCTargetVersion
-> Optic' A_Lens '[] GHCTargetVersion Version -> Version
forall k s (is :: [*]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens '[] GHCTargetVersion Version
tvVersion)
                             PlatformRequest
pfreq

    IO ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      ())
-> IO ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Maybe FileMode -> ByteString -> IO ()
forall b. Path b -> Maybe FileMode -> ByteString -> IO ()
writeFile (Path Abs
ghcdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
ghcUpSrcBuiltFile) (FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
newFilePerms) ByteString
bmk

    (V '[NotInstalled] -> GHCupSetError)
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll V '[NotInstalled] -> GHCupSetError
forall (es :: [*]). Show (V es) => V es -> GHCupSetError
GHCupSetError (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
 MonadIO m, MonadCatch m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
postGHCInstall GHCTargetVersion
tver

    -- restore
    Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadySet (Excepts
   '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
     GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
     UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
        GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
        UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
       GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
       UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts '[NotInstalled] m GHCTargetVersion
 -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
forall (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
 MonadIO m, MonadCatch m) =>
GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
tver SetGHC
SetGHCOnly

 where
  defaultConf :: ByteString
defaultConf = case GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
tver of
    Maybe Text
Nothing -> [s|
V=0
BUILD_MAN = NO
BUILD_SPHINX_HTML = NO
BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = YES|]
    Just Text
_ -> [s|
V=0
BUILD_MAN = NO
BUILD_SPHINX_HTML = NO
BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = NO
Stage1Only = YES|]

  compileBindist :: ( MonadReader AppState m
                    , MonadThrow m
                    , MonadCatch m
                    , MonadLogger m
                    , MonadIO m
                    , MonadFail m
                    )
                 => Either (Path Rel) (Path Abs)
                 -> Path Abs
                 -> Path Abs
                 -> Excepts
                      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed, ProcessError, NotFoundInPATH, CopyError]
                      m
                      (Path Abs)  -- ^ output path of bindist
  compileBindist :: Either (Path Rel) (Path Abs)
-> Path Abs
-> Path Abs
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     (Path Abs)
compileBindist Either (Path Rel) (Path Abs)
bghc Path Abs
ghcdir Path Abs
workdir = do
    m ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|configuring build|]
    Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall (m :: * -> *).
(MonadCatch m, MonadIO m) =>
Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
checkBuildConfig

    AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..} } <- m AppState
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask

    Maybe (Path Abs)
-> (Path Abs
    -> Excepts
         '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
           ProcessError, NotFoundInPATH, CopyError]
         m
         ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Path Abs)
patchdir ((Path Abs
  -> Excepts
       '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
         ProcessError, NotFoundInPATH, CopyError]
       m
       ())
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> (Path Abs
    -> Excepts
         '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
           ProcessError, NotFoundInPATH, CopyError]
         m
         ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ \Path Abs
dir -> Excepts '[PatchFailed] m ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[PatchFailed] m ()
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> Excepts '[PatchFailed] m ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> Excepts '[PatchFailed] m ()
forall (m :: * -> *).
(MonadLogger m, MonadIO m) =>
Path Abs -> Path Abs -> Excepts '[PatchFailed] m ()
applyPatches Path Abs
dir Path Abs
workdir

    [(ByteString, ByteString)]
cEnv <- IO [(ByteString, ByteString)]
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     [(ByteString, ByteString)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(ByteString, ByteString)]
getEnvironment

    if
      | GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
tver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [vver|8.8.0|] -> do
        Path Abs
bghcPath <- case Either (Path Rel) (Path Abs)
bghc of
          Right Path Abs
ghc' -> Path Abs
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs
ghc'
          Left  Path Rel
bver -> do
            [Path Abs]
spaths <- [Maybe (Path Abs)] -> [Path Abs]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Path Abs)] -> [Path Abs])
-> ([ByteString] -> [Maybe (Path Abs)])
-> [ByteString]
-> [Path Abs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Maybe (Path Abs))
-> [ByteString] -> [Maybe (Path Abs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Maybe (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs ([ByteString] -> [Path Abs])
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     [ByteString]
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     [Path Abs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [ByteString]
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     [ByteString]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [ByteString]
getSearchPath
            IO (Maybe (Path Abs)) -> m (Maybe (Path Abs))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Path Abs] -> Path Rel -> IO (Maybe (Path Abs))
searchPath [Path Abs]
spaths Path Rel
bver) m (Maybe (Path Abs))
-> NotFoundInPATH
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     (Path Abs)
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Maybe a) -> e -> Excepts es m a
!? Path Rel -> NotFoundInPATH
NotFoundInPATH Path Rel
bver
        m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ ByteString
-> Bool
-> [ByteString]
-> Path Rel
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> m (Either ProcessError ())
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m) =>
ByteString
-> Bool
-> [ByteString]
-> Path Rel
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> m (Either ProcessError ())
execLogged
          ByteString
"./configure"
          Bool
False
          (  [ByteString
"--prefix=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
ghcdir]
          [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
-> (Text -> [ByteString]) -> Maybe Text -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ByteString]
forall a. Monoid a => a
mempty
                    (\Text
x -> [ByteString
"--target=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
E.encodeUtf8 Text
x])
                    (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
tver)
          [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ (Text -> ByteString) -> [Text] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
E.encodeUtf8 [Text]
aargs
          )
          [rel|ghc-conf|]
          (Path Abs -> Maybe (Path Abs)
forall a. a -> Maybe a
Just Path Abs
workdir)
          ([(ByteString, ByteString)] -> Maybe [(ByteString, ByteString)]
forall a. a -> Maybe a
Just ((ByteString
"GHC", Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
bghcPath) (ByteString, ByteString)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. a -> [a] -> [a]
: [(ByteString, ByteString)]
cEnv))
      | Bool
otherwise -> do
        m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ ByteString
-> Bool
-> [ByteString]
-> Path Rel
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> m (Either ProcessError ())
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m) =>
ByteString
-> Bool
-> [ByteString]
-> Path Rel
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> m (Either ProcessError ())
execLogged
          ByteString
"./configure"
          Bool
False
          (  [ ByteString
"--prefix=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
ghcdir
             , ByteString
"--with-ghc=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (Path Rel -> ByteString)
-> (Path Abs -> ByteString)
-> Either (Path Rel) (Path Abs)
-> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Either (Path Rel) (Path Abs)
bghc
             ]
          [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
-> (Text -> [ByteString]) -> Maybe Text -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ByteString]
forall a. Monoid a => a
mempty
                   (\Text
x -> [ByteString
"--target=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
E.encodeUtf8 Text
x])
                   (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
tver)
          [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ (Text -> ByteString) -> [Text] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
E.encodeUtf8 [Text]
aargs
          )
          [rel|ghc-conf|]
          (Path Abs -> Maybe (Path Abs)
forall a. a -> Maybe a
Just Path Abs
workdir)
          ([(ByteString, ByteString)] -> Maybe [(ByteString, ByteString)]
forall a. a -> Maybe a
Just [(ByteString, ByteString)]
cEnv)

    case Maybe (Path Abs)
mbuildConfig of
      Just Path Abs
bc -> IOErrorType
-> FileDoesNotExistError
-> m ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (m :: * -> *) e (es' :: [*]) a.
(MonadCatch m, MonadIO m, Monad m, e :< es') =>
IOErrorType -> e -> m a -> Excepts es' m a
liftIOException
        IOErrorType
doesNotExistErrorType
        (ByteString -> FileDoesNotExistError
FileDoesNotExistError (ByteString -> FileDoesNotExistError)
-> ByteString -> FileDoesNotExistError
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
bc)
        (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> CopyMode -> IO ()
forall b1 b2. Path b1 -> Path b2 -> CopyMode -> IO ()
copyFile Path Abs
bc (Path Abs -> Path Abs
forall b. Path b -> Path b
build_mk Path Abs
workdir) CopyMode
Overwrite)
      Maybe (Path Abs)
Nothing ->
        IO ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> IO ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Maybe FileMode -> ByteString -> IO ()
forall b. Path b -> Maybe FileMode -> ByteString -> IO ()
writeFile (Path Abs -> Path Abs
forall b. Path b -> Path b
build_mk Path Abs
workdir) (FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
newFilePerms) ByteString
defaultConf

    m ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|Building (this may take a while)...|]
    m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Maybe (Path Abs) -> m (Either ProcessError ())
forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadReader AppState m) =>
[ByteString] -> Maybe (Path Abs) -> m (Either ProcessError ())
make ([ByteString] -> (Int -> [ByteString]) -> Maybe Int -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Int
j -> [ByteString
"-j" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fS (Int -> String
forall a. Show a => a -> String
show Int
j)]) Maybe Int
jobs) (Path Abs -> Maybe (Path Abs)
forall a. a -> Maybe a
Just Path Abs
workdir)

    m ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|Creating bindist...|]
    m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Maybe (Path Abs) -> m (Either ProcessError ())
forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadReader AppState m) =>
[ByteString] -> Maybe (Path Abs) -> m (Either ProcessError ())
make [ByteString
"binary-dist"] (Path Abs -> Maybe (Path Abs)
forall a. a -> Maybe a
Just Path Abs
workdir)
    [Path Rel
tar] <- IO [Path Rel]
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     [Path Rel]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Path Rel]
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      [Path Rel])
-> IO [Path Rel]
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     [Path Rel]
forall a b. (a -> b) -> a -> b
$ Path Abs -> Regex -> IO [Path Rel]
findFiles
      Path Abs
workdir
      (CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended
                     ExecOption
execBlank
                     ([s|^ghc-.*\.tar\..*$|] :: ByteString)
      )
    ByteString
c       <- IO ByteString
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ByteString)
-> IO ByteString
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ByteString
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ByteString
forall b. Path b -> IO ByteString
readFile (Path Abs
workdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
tar)
    Text
cDigest <-
      (Text -> Text)
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     Text
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
T.take Int
8)
      (Excepts
   '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
     ProcessError, NotFoundInPATH, CopyError]
   m
   Text
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      Text)
-> (ByteString
    -> Excepts
         '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
           ProcessError, NotFoundInPATH, CopyError]
         m
         Text)
-> ByteString
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Text
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
      (m Text
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      Text)
-> (ByteString -> m Text)
-> ByteString
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either UnicodeException Text -> m Text
forall a (m :: * -> *) b.
(Exception a, MonadThrow m) =>
Either a b -> m b
throwEither
      (Either UnicodeException Text -> m Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
E.decodeUtf8'
      (ByteString -> Either UnicodeException Text)
-> (ByteString -> ByteString)
-> ByteString
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.encode
      (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
SHA256.hashlazy
      (ByteString
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      Text)
-> ByteString
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     Text
forall a b. (a -> b) -> a -> b
$ ByteString
c
    Path Rel
tarName <-
      ByteString
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel
        [i|ghc-#{tVerToText tver}-#{pfReqToString pfreq}-#{cDigest}.tar#{takeExtension (toFilePath tar)}|]
    let tarPath :: Path Abs
tarPath = Path Abs
cacheDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
tarName
    (IOException
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (CopyError
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (CopyError
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> (IOException -> CopyError)
-> IOException
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CopyError
CopyError (String -> CopyError)
-> (IOException -> String) -> IOException -> CopyError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall a. Show a => a -> String
show) (Excepts
   '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
     ProcessError, NotFoundInPATH, CopyError]
   m
   ()
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ IO ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> IO ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> CopyMode -> IO ()
forall b1 b2. Path b1 -> Path b2 -> CopyMode -> IO ()
copyFile (Path Abs
workdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
tar)
                                                             Path Abs
tarPath
                                                             CopyMode
Strict
    m ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|Copied bindist to #{tarPath}|]
    Path Abs
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs
tarPath

  build_mk :: Path b -> Path b
build_mk Path b
workdir = Path b
workdir Path b -> Path Rel -> Path b
forall b. Path b -> Path Rel -> Path b
</> [rel|mk/build.mk|]

  checkBuildConfig :: (MonadCatch m, MonadIO m)
                   => Excepts
                        '[FileDoesNotExistError, InvalidBuildConfig]
                        m
                        ()
  checkBuildConfig :: Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
checkBuildConfig = do
    ByteString
c <- case Maybe (Path Abs)
mbuildConfig of
      Just Path Abs
bc -> do
        ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig] m ByteString
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig] m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOErrorType
-> FileDoesNotExistError
-> m ByteString
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig] m ByteString
forall (m :: * -> *) e (es' :: [*]) a.
(MonadCatch m, MonadIO m, Monad m, e :< es') =>
IOErrorType -> e -> m a -> Excepts es' m a
liftIOException
          IOErrorType
doesNotExistErrorType
          (ByteString -> FileDoesNotExistError
FileDoesNotExistError (ByteString -> FileDoesNotExistError)
-> ByteString -> FileDoesNotExistError
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
bc)
          (IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ByteString
forall b. Path b -> IO ByteString
readFile Path Abs
bc)
      Maybe (Path Abs)
Nothing -> ByteString
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig] m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
defaultConf
    let lines' :: [Text]
lines' = (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
T.strip ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decUTF8Safe ByteString
c

   -- for cross, we need Stage1Only
    case GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
tver of
      Just Text
_ -> Bool
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
"Stage1Only = YES" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
lines') (Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
 -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall a b. (a -> b) -> a -> b
$ InvalidBuildConfig
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE
        (Text -> InvalidBuildConfig
InvalidBuildConfig
          [s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
        )
      Maybe Text
Nothing -> () -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()




    ---------------------
    --[ Upgrade GHCup ]--
    ---------------------


-- | Upgrade ghcup and place it in @~\/.ghcup\/bin\/ghcup@,
-- if no path is provided.
upgradeGHCup :: ( MonadMask m
                , MonadReader AppState m
                , MonadCatch m
                , MonadLogger m
                , MonadThrow m
                , MonadResource m
                , MonadIO m
                )
             => GHCupDownloads
             -> Maybe (Path Abs)  -- ^ full file destination to write ghcup into
             -> Bool              -- ^ whether to force update regardless
                                  --   of currently installed version
             -> PlatformRequest
             -> Excepts
                  '[ CopyError
                   , DigestError
                   , DownloadFailed
                   , NoDownload
                   , NoUpdate
                   ]
                  m
                  Version
upgradeGHCup :: GHCupDownloads
-> Maybe (Path Abs)
-> Bool
-> PlatformRequest
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     Version
upgradeGHCup GHCupDownloads
dls Maybe (Path Abs)
mtarget Bool
force PlatformRequest
pfreq = do
  AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..}} <- m AppState
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  m ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
      m
      ())
-> m ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|Upgrading GHCup...|]
  let latestVer :: Version
latestVer = Maybe Version -> Version
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Version -> Version) -> Maybe Version -> Version
forall a b. (a -> b) -> a -> b
$ (Version, VersionInfo) -> Version
forall a b. (a, b) -> a
fst ((Version, VersionInfo) -> Version)
-> Maybe (Version, VersionInfo) -> Maybe Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatest GHCupDownloads
dls Tool
GHCup
  Bool
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
force Bool -> Bool -> Bool
&& (Version
latestVer Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
<= PVP -> Version
pvpToVersion PVP
ghcUpVer)) (Excepts
   '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
   m
   ()
 -> Excepts
      '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
      m
      ())
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall a b. (a -> b) -> a -> b
$ NoUpdate
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE NoUpdate
NoUpdate
  DownloadInfo
dli   <- Either NoDownload DownloadInfo
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Either e a -> Excepts es m a
lE (Either NoDownload DownloadInfo
 -> Excepts
      '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
      m
      DownloadInfo)
-> Either NoDownload DownloadInfo
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool
-> Version
-> PlatformRequest
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo Tool
GHCup Version
latestVer PlatformRequest
pfreq GHCupDownloads
dls
  Path Abs
tmp   <- m (Path Abs)
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     (Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Path Abs)
forall (m :: * -> *).
(MonadResource m, MonadThrow m, MonadIO m) =>
m (Path Abs)
withGHCupTmpDir
  let fn :: Path Rel
fn = [rel|ghcup|]
  Path Abs
p <- Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     (Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed] m (Path Abs)
 -> Excepts
      '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
      m
      (Path Abs))
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     (Path Abs)
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Path Abs
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (m :: * -> *).
(MonadMask m, MonadReader AppState m, MonadThrow m, MonadLogger m,
 MonadIO m) =>
DownloadInfo
-> Path Abs
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
download DownloadInfo
dli Path Abs
tmp (Path Rel -> Maybe (Path Rel)
forall a. a -> Maybe a
Just Path Rel
fn)
  let destDir :: Path Abs
destDir = Path Abs -> Path Abs
dirname Path Abs
destFile
      destFile :: Path Abs
destFile = Path Abs -> Maybe (Path Abs) -> Path Abs
forall a. a -> Maybe a -> a
fromMaybe (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
fn) Maybe (Path Abs)
mtarget
  m ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
      m
      ())
-> m ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|mkdir -p #{toFilePath destDir}|]
  IO ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
      m
      ())
-> IO ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
createDirRecursive' Path Abs
destDir
  m ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
      m
      ())
-> m ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|rm -f #{toFilePath destFile}|]
  IO ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
      m
      ())
-> IO ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
NoSuchThing (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile Path Abs
destFile
  m ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
      m
      ())
-> m ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|cp #{toFilePath p} #{toFilePath destFile}|]
  (IOException
 -> Excepts
      '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
      m
      ())
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (CopyError
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (CopyError
 -> Excepts
      '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
      m
      ())
-> (IOException -> CopyError)
-> IOException
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CopyError
CopyError (String -> CopyError)
-> (IOException -> String) -> IOException -> CopyError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall a. Show a => a -> String
show) (Excepts
   '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
   m
   ()
 -> Excepts
      '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
      m
      ())
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall a b. (a -> b) -> a -> b
$ IO ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
      m
      ())
-> IO ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> CopyMode -> IO ()
forall b1 b2. Path b1 -> Path b2 -> CopyMode -> IO ()
copyFile Path Abs
p
                                                           Path Abs
destFile
                                                           CopyMode
Overwrite
  m ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
      m
      ())
-> m ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> m ()
forall (m :: * -> *) a.
(MonadLogger m, MonadIO m) =>
Path a -> m ()
chmod_755 Path Abs
destFile

  IO Bool
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Path Abs -> IO Bool
isInPath Path Abs
destFile) Excepts
  '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
  m
  Bool
-> (Bool
    -> Excepts
         '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
         m
         ())
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> Bool
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (Excepts
   '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
   m
   ()
 -> Excepts
      '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
      m
      ())
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall a b. (a -> b) -> a -> b
$
    m ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
      m
      ())
-> m ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn) [i|"#{toFilePath (dirname destFile)}" is not in PATH! You have to add it in order to use ghcup.|]
  IO (Maybe (Path Abs))
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     (Maybe (Path Abs))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Path Abs -> IO (Maybe (Path Abs))
isShadowed Path Abs
destFile) Excepts
  '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
  m
  (Maybe (Path Abs))
-> (Maybe (Path Abs)
    -> Excepts
         '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
         m
         ())
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Path Abs)
Nothing -> ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just Path Abs
pa -> m ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
      m
      ())
-> m ()
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn) [i|ghcup is shadowed by "#{toFilePath pa}". The upgrade will not be in effect, unless you remove "#{toFilePath pa}" or make sure "#{toFilePath destDir}" comes before "#{toFilePath (dirname pa)}" in PATH.|]

  Version
-> Excepts
     '[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
     m
     Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
latestVer



    -------------
    --[ Other ]--
    -------------


-- | Creates @ghc-x.y.z@ and @ghc-x.y@ symlinks. This is used for
-- both installing from source and bindist.
postGHCInstall :: ( MonadReader AppState m
                  , MonadLogger m
                  , MonadThrow m
                  , MonadFail m
                  , MonadIO m
                  , MonadCatch m
                  )
               => GHCTargetVersion
               -> Excepts '[NotInstalled] m ()
postGHCInstall :: GHCTargetVersion -> Excepts '[NotInstalled] m ()
postGHCInstall ver :: GHCTargetVersion
ver@GHCTargetVersion {Maybe Text
Version
_tvVersion :: Version
_tvTarget :: Maybe Text
_tvTarget :: GHCTargetVersion -> Maybe Text
_tvVersion :: GHCTargetVersion -> Version
..} = do
  Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts '[NotInstalled] m GHCTargetVersion
 -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m GHCTargetVersion
 -> Excepts '[NotInstalled] m GHCTargetVersion)
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
forall (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
 MonadIO m, MonadCatch m) =>
GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
ver SetGHC
SetGHC_XYZ

  -- Create ghc-x.y symlinks. This may not be the current
  -- version, create it regardless.
  Maybe CharPos
v' <-
    (ParseError -> Excepts '[NotInstalled] m (Maybe CharPos))
-> Excepts '[NotInstalled] m (Maybe CharPos)
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\(ParseError
e :: ParseError) -> m (Maybe CharPos) -> Excepts '[NotInstalled] m (Maybe CharPos)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe CharPos) -> Excepts '[NotInstalled] m (Maybe CharPos))
-> m (Maybe CharPos) -> Excepts '[NotInstalled] m (Maybe CharPos)
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn) [i|#{e}|] m () -> m (Maybe CharPos) -> m (Maybe CharPos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe CharPos -> m (Maybe CharPos)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CharPos
forall a. Maybe a
Nothing)
    (Excepts '[NotInstalled] m (Maybe CharPos)
 -> Excepts '[NotInstalled] m (Maybe CharPos))
-> Excepts '[NotInstalled] m (Maybe CharPos)
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall a b. (a -> b) -> a -> b
$ (CharPos -> Maybe CharPos)
-> Excepts '[NotInstalled] m CharPos
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CharPos -> Maybe CharPos
forall a. a -> Maybe a
Just
    (Excepts '[NotInstalled] m CharPos
 -> Excepts '[NotInstalled] m (Maybe CharPos))
-> Excepts '[NotInstalled] m CharPos
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m CharPos
forall (m :: * -> *). MonadThrow m => Version -> m CharPos
getMajorMinorV Version
_tvVersion
  Maybe CharPos
-> (CharPos -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe CharPos
v' ((CharPos -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> (CharPos -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \(Int
mj, Int
mi) -> m (Maybe GHCTargetVersion)
-> Excepts '[NotInstalled] m (Maybe GHCTargetVersion)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Int -> Maybe Text -> m (Maybe GHCTargetVersion)
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m) =>
Int -> Int -> Maybe Text -> m (Maybe GHCTargetVersion)
getGHCForMajor Int
mj Int
mi Maybe Text
_tvTarget)
    Excepts '[NotInstalled] m (Maybe GHCTargetVersion)
-> (Maybe GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (GHCTargetVersion -> Excepts '[NotInstalled] m GHCTargetVersion)
-> Maybe GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\GHCTargetVersion
v -> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m GHCTargetVersion
 -> Excepts '[NotInstalled] m GHCTargetVersion)
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
forall (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
 MonadIO m, MonadCatch m) =>
GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
v SetGHC
SetGHC_XY)