178 lines
5.4 KiB
Haskell
178 lines
5.4 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
|
|
module Main where
|
|
|
|
import Control.Monad.Logger
|
|
import Control.Monad.Reader
|
|
import Control.Monad.IO.Class
|
|
import Data.Bifunctor
|
|
import Data.ByteString ( ByteString )
|
|
import Data.Functor ( (<&>) )
|
|
import Data.Maybe
|
|
import Data.Semigroup ( (<>) )
|
|
import Data.String.QQ
|
|
import Data.Text ( Text )
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as E
|
|
import Data.Traversable
|
|
import Data.Versions
|
|
import GHCup
|
|
import GHCup.File
|
|
import GHCup.Prelude
|
|
import GHCup.Types
|
|
import Haskus.Utils.Variant.Excepts
|
|
import HPath
|
|
import Options.Applicative
|
|
import System.Console.Pretty
|
|
import System.Exit
|
|
|
|
|
|
|
|
|
|
data Options = Options
|
|
{ optVerbose :: Bool
|
|
, optCache :: Bool
|
|
, optCommand :: Command
|
|
}
|
|
|
|
data Command
|
|
= InstallGHC InstallGHCOptions
|
|
| InstallCabal InstallCabalOptions
|
|
|
|
data InstallGHCOptions = InstallGHCOptions
|
|
{ ghcVer :: Maybe Version
|
|
}
|
|
|
|
data InstallCabalOptions = InstallCabalOptions
|
|
{ cabalVer :: Maybe Version
|
|
}
|
|
|
|
|
|
opts :: Parser Options
|
|
opts =
|
|
Options
|
|
<$> switch
|
|
(short 'v' <> long "verbose" <> help "Whether to enable verbosity")
|
|
<*> switch (short 'c' <> long "cache" <> help "Whether to cache downloads")
|
|
<*> com
|
|
|
|
|
|
com :: Parser Command
|
|
com = subparser
|
|
( command
|
|
"install-ghc"
|
|
( InstallGHC
|
|
<$> (info (installGHCOpts <**> helper)
|
|
(progDesc "Install a GHC version")
|
|
)
|
|
)
|
|
<> command
|
|
"install-cabal"
|
|
( InstallCabal
|
|
<$> (info (installCabalOpts <**> helper)
|
|
(progDesc "Install a cabal-install version")
|
|
)
|
|
)
|
|
)
|
|
|
|
installGHCOpts :: Parser InstallGHCOptions
|
|
installGHCOpts = InstallGHCOptions <$> optional
|
|
(option
|
|
(eitherReader
|
|
(\s -> bimap (const "Not a valid version") id . version . T.pack $ s)
|
|
)
|
|
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
|
"The GHC version to install"
|
|
)
|
|
)
|
|
|
|
|
|
installCabalOpts :: Parser InstallCabalOptions
|
|
installCabalOpts = InstallCabalOptions <$> optional
|
|
(option
|
|
(eitherReader
|
|
(\s -> bimap (const "Not a valid version") id . version . T.pack $ s)
|
|
)
|
|
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
|
"The Cabal version to install"
|
|
)
|
|
)
|
|
|
|
|
|
toSettings :: Options -> Settings
|
|
toSettings Options {..} = let cache = optCache in Settings { .. }
|
|
|
|
|
|
-- TODO: something better than Show instance for errors
|
|
|
|
main :: IO ()
|
|
main = do
|
|
-- logger interpreter
|
|
let runLogger = runStderrLoggingT
|
|
|
|
customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
|
|
>>= \opt@Options {..} -> do
|
|
let settings = toSettings opt
|
|
-- wrapper to run effects with settings
|
|
let runInstTool =
|
|
runLogger
|
|
. flip runReaderT settings
|
|
. runE
|
|
@'[ FileError
|
|
, ArchiveError
|
|
, ProcessError
|
|
, URLException
|
|
, PlatformResultError
|
|
, NoDownload
|
|
, NoCompatibleArch
|
|
, DistroNotFound
|
|
, TagNotFound
|
|
, AlreadyInstalled
|
|
, NotInstalled
|
|
]
|
|
|
|
case optCommand of
|
|
InstallGHC (InstallGHCOptions {..}) ->
|
|
void
|
|
$ (runInstTool $ do
|
|
v <- maybe
|
|
( getRecommended availableDownloads GHC
|
|
?? TagNotFound Recommended GHC
|
|
)
|
|
pure
|
|
ghcVer
|
|
liftE $ installTool (ToolRequest GHC v)
|
|
Nothing
|
|
(OwnSpec availableDownloads)
|
|
)
|
|
>>= \case
|
|
VRight _ -> runLogger $ $(logInfo) ([s|GHC installation successful|])
|
|
VLeft (V (AlreadyInstalled treq)) ->
|
|
runLogger $ $(logWarn)
|
|
(T.pack (show treq) <> [s| already installed|])
|
|
VLeft e -> die (color Red $ show e)
|
|
InstallCabal (InstallCabalOptions {..}) ->
|
|
void
|
|
$ (runInstTool $ do
|
|
v <- maybe
|
|
( getRecommended availableDownloads Cabal
|
|
?? TagNotFound Recommended Cabal
|
|
)
|
|
pure
|
|
cabalVer
|
|
liftE $ installTool (ToolRequest Cabal v)
|
|
Nothing
|
|
(OwnSpec availableDownloads)
|
|
)
|
|
>>= \case
|
|
VRight _ -> runLogger $ $(logInfo) ([s|Cabal installation successful|])
|
|
VLeft (V (AlreadyInstalled treq)) ->
|
|
runLogger $ $(logWarn)
|
|
(T.pack (show treq) <> [s| already installed|])
|
|
VLeft e -> die (color Red $ show e)
|
|
pure ()
|