213 lines
5.3 KiB
Haskell
213 lines
5.3 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE RankNTypes #-}
|
|
|
|
module GHCup.OptParse.UnSet where
|
|
|
|
|
|
|
|
|
|
import GHCup
|
|
import GHCup.Errors
|
|
import GHCup.Types
|
|
import GHCup.Prelude.Logger
|
|
import GHCup.Prelude.String.QQ
|
|
|
|
#if !MIN_VERSION_base(4,13,0)
|
|
import Control.Monad.Fail ( MonadFail )
|
|
#endif
|
|
import Control.Monad.Reader
|
|
import Control.Monad.Trans.Resource
|
|
import Data.Functor
|
|
import Data.Maybe
|
|
import Haskus.Utils.Variant.Excepts
|
|
import Options.Applicative hiding ( style )
|
|
import Options.Applicative.Help.Pretty ( text )
|
|
import Prelude hiding ( appendFile )
|
|
import System.Exit
|
|
|
|
import qualified Data.Text as T
|
|
import Control.Exception.Safe (MonadMask)
|
|
import GHCup.Types.Optics
|
|
|
|
|
|
|
|
|
|
----------------
|
|
--[ Commands ]--
|
|
----------------
|
|
|
|
|
|
data UnsetCommand = UnsetGHC UnsetOptions
|
|
| UnsetCabal UnsetOptions
|
|
| UnsetHLS UnsetOptions
|
|
| UnsetStack UnsetOptions
|
|
deriving (Eq, Show)
|
|
|
|
|
|
|
|
|
|
---------------
|
|
--[ Options ]--
|
|
---------------
|
|
|
|
|
|
data UnsetOptions = UnsetOptions
|
|
{ sToolVer :: Maybe T.Text -- target platform triple
|
|
} deriving (Eq, Show)
|
|
|
|
|
|
|
|
|
|
---------------
|
|
--[ Parsers ]--
|
|
---------------
|
|
|
|
|
|
unsetParser :: Parser UnsetCommand
|
|
unsetParser =
|
|
subparser
|
|
( command
|
|
"ghc"
|
|
( UnsetGHC
|
|
<$> info
|
|
(unsetOpts <**> helper)
|
|
( progDesc "Unset GHC version"
|
|
<> footerDoc (Just $ text unsetGHCFooter)
|
|
)
|
|
)
|
|
<> command
|
|
"cabal"
|
|
( UnsetCabal
|
|
<$> info
|
|
(unsetOpts <**> helper)
|
|
( progDesc "Unset Cabal version"
|
|
<> footerDoc (Just $ text unsetCabalFooter)
|
|
)
|
|
)
|
|
<> command
|
|
"hls"
|
|
( UnsetHLS
|
|
<$> info
|
|
(unsetOpts <**> helper)
|
|
( progDesc "Unset haskell-language-server version"
|
|
<> footerDoc (Just $ text unsetHLSFooter)
|
|
)
|
|
)
|
|
<> command
|
|
"stack"
|
|
( UnsetStack
|
|
<$> info
|
|
(unsetOpts <**> helper)
|
|
( progDesc "Unset stack version"
|
|
<> footerDoc (Just $ text unsetStackFooter)
|
|
)
|
|
)
|
|
)
|
|
where
|
|
unsetGHCFooter :: String
|
|
unsetGHCFooter = [s|Discussion:
|
|
Unsets the the current GHC version. That means there won't
|
|
be a ~/.ghcup/bin/ghc anymore.
|
|
|
|
Examples:
|
|
# unset ghc
|
|
ghcup unset ghc
|
|
|
|
# unset ghc for the target version
|
|
ghcup unset ghc armv7-unknown-linux-gnueabihf|]
|
|
|
|
unsetCabalFooter :: String
|
|
unsetCabalFooter = [s|Discussion:
|
|
Unsets the the current Cabal version.|]
|
|
|
|
unsetStackFooter :: String
|
|
unsetStackFooter = [s|Discussion:
|
|
Unsets the the current Stack version.|]
|
|
|
|
unsetHLSFooter :: String
|
|
unsetHLSFooter = [s|Discussion:
|
|
Unsets the the current haskell-language-server version.|]
|
|
|
|
|
|
unsetOpts :: Parser UnsetOptions
|
|
unsetOpts = UnsetOptions . fmap T.pack <$> optional (argument str (metavar "TRIPLE"))
|
|
|
|
|
|
|
|
--------------
|
|
--[ Footer ]--
|
|
--------------
|
|
|
|
|
|
unsetFooter :: String
|
|
unsetFooter = [s|Discussion:
|
|
Unsets the currently active GHC or cabal version.|]
|
|
|
|
|
|
|
|
|
|
---------------------------
|
|
--[ Effect interpreters ]--
|
|
---------------------------
|
|
|
|
|
|
type UnsetEffects = '[ NotInstalled ]
|
|
|
|
|
|
runUnsetGHC :: (ReaderT env m (VEither UnsetEffects a) -> m (VEither UnsetEffects a))
|
|
-> Excepts UnsetEffects (ReaderT env m) a
|
|
-> m (VEither UnsetEffects a)
|
|
runUnsetGHC runLeanAppState =
|
|
runLeanAppState
|
|
. runE
|
|
@UnsetEffects
|
|
|
|
|
|
|
|
------------------
|
|
--[ Entrypoint ]--
|
|
------------------
|
|
|
|
|
|
|
|
unset :: ( Monad m
|
|
, MonadMask m
|
|
, MonadUnliftIO m
|
|
, MonadFail m
|
|
, HasDirs env
|
|
, HasLog env
|
|
)
|
|
=> UnsetCommand
|
|
-> (ReaderT env m (VEither UnsetEffects ())
|
|
-> m (VEither UnsetEffects ()))
|
|
-> (ReaderT LeanAppState m () -> m ())
|
|
-> m ExitCode
|
|
unset unsetCommand runLeanAppState runLogger = case unsetCommand of
|
|
(UnsetGHC (UnsetOptions triple)) -> runUnsetGHC runLeanAppState (unsetGHC triple)
|
|
>>= \case
|
|
VRight _ -> do
|
|
runLogger $ logInfo "GHC successfully unset"
|
|
pure ExitSuccess
|
|
VLeft e -> do
|
|
runLogger $ logError $ T.pack $ prettyHFError e
|
|
pure $ ExitFailure 14
|
|
(UnsetCabal (UnsetOptions _)) -> do
|
|
void $ runLeanAppState (VRight <$> unsetCabal)
|
|
runLogger $ logInfo "Cabal successfully unset"
|
|
pure ExitSuccess
|
|
(UnsetHLS (UnsetOptions _)) -> do
|
|
void $ runLeanAppState (VRight <$> unsetHLS)
|
|
runLogger $ logInfo "HLS successfully unset"
|
|
pure ExitSuccess
|
|
(UnsetStack (UnsetOptions _)) -> do
|
|
void $ runLeanAppState (VRight <$> unsetStack)
|
|
runLogger $ logInfo "Stack successfully unset"
|
|
pure ExitSuccess
|