hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Lala

Browse Source
This commit is contained in:
Julian Ospald
2020-03-03 01:59:19 +01:00
parent d598c42d19
commit 62b249db2d
20 changed files with 1254 additions and 763 deletions
Download Patch File Download Diff File Expand all files Collapse all files

128
app/ghcup/Main.hs
View File

@@ -9,10 +9,13 @@
module Main where
import GHCup
import GHCup.File
import GHCup.Logger
import GHCup.Prelude
import GHCup.Download
import GHCup.Errors
import GHCup.Types
import GHCup.Utils
import GHCup.Utils.File
import GHCup.Utils.Logger
import GHCup.Utils.Prelude
import Control.Monad.Logger
import Control.Monad.Reader
@@ -25,16 +28,19 @@ import Data.String.Interpolate
import Data.String.QQ
import Data.Versions
import Haskus.Utils.Variant.Excepts
import HPath
import Options.Applicative hiding ( style )
import System.Console.Pretty
import System.Exit
import System.IO
import Text.Read
import Text.Layout.Table
import URI.ByteString
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
@@ -56,6 +62,7 @@ data Command
| List ListOptions
| Rm RmOptions
| DInfo
| Compile CompileOptions
data ToolVersion = ToolVersion Version
| ToolTag Tag
@@ -82,6 +89,14 @@ data RmOptions = RmOptions
}
data CompileOptions = CompileOptions
{ ghcVer :: Version
, bootstrapVer :: Version
, jobs :: Maybe Int
, buildConfig :: Maybe (Path Abs)
}
opts :: Parser Options
opts =
Options
@@ -139,6 +154,13 @@ com =
(progDesc "Remove a GHC version installed by ghcup")
)
)
<> command
"compile"
( Compile
<$> (info (compileOpts <**> helper)
(progDesc "Compile GHC from source")
)
)
<> commandGroup "GHC commands:"
<> hidden
)
@@ -195,17 +217,50 @@ listOpts =
)
rmOpts :: Parser RmOptions
rmOpts =
RmOptions
rmOpts = RmOptions <$> versionParser
compileOpts :: Parser CompileOptions
compileOpts =
CompileOptions
<$> (option
(eitherReader
(bimap (const "Not a valid version") id . version . T.pack)
)
(short 'v' <> long "version" <> metavar "VERSION" <> help
"The GHC version to remove"
"The GHC version to compile"
)
)
<*> (option
(eitherReader
(bimap (const "Not a valid version") id . version . T.pack)
)
( short 'b'
<> long "bootstrap-version"
<> metavar "BOOTSTRAP_VERSION"
<> help "The GHC version to bootstrap with (must be installed)"
)
)
<*> optional
(option
(eitherReader (readEither @Int))
(short 'j' <> long "jobs" <> metavar "JOBS" <> help
"How many jobs to use for make"
)
)
<*> optional
(option
(eitherReader
(\x ->
bimap show id . parseAbs . E.encodeUtf8 . T.pack $ x :: Either
String
(Path Abs)
)
)
(short 'c' <> long "config" <> metavar "CONFIG" <> help
"Absolute path to build config file"
)
)
versionParser :: Parser Version
@@ -285,6 +340,7 @@ main = do
, ProcessError
, TagNotFound
, URLException
, DigestError
]
let runSetGHC =
@@ -313,13 +369,31 @@ main = do
. runE
@'[PlatformResultError , NoCompatibleArch , DistroNotFound]
let runCompileGHC =
runLogger
. flip runReaderT settings
. runResourceT
. runE
@'[ AlreadyInstalled
, NotInstalled
, GHCNotFound
, ArchiveError
, ProcessError
, URLException
, DigestError
, BuildConfigNotFound
, FileDoesNotExistError
, URLException
, JSONError
]
case optCommand of
Install (InstallGHC InstallOptions {..}) ->
void
$ (runInstTool $ do
av <- liftE getDownloads
v <- liftE $ fromVersion av instVer GHC
liftE $ installTool (ToolRequest GHC v) Nothing
dls <- _binaryDownloads <$> liftE getDownloads
v <- liftE $ fromVersion dls instVer GHC
liftE $ installTool dls (ToolRequest GHC v) Nothing
)
>>= \case
VRight _ -> runLogger
@@ -329,12 +403,12 @@ main = do
(T.pack (show treq) <> [s| already installed|])
VLeft e ->
runLogger ($(logError) [i|#{e}|]) >> exitFailure
Install (InstallGHC InstallOptions {..}) ->
Install (InstallCabal InstallOptions {..}) ->
void
$ (runInstTool $ do
av <- liftE getDownloads
v <- liftE $ fromVersion av instVer Cabal
liftE $ installTool (ToolRequest Cabal v) Nothing
dls <- _binaryDownloads <$> liftE getDownloads
v <- liftE $ fromVersion dls instVer Cabal
liftE $ installTool dls (ToolRequest Cabal v) Nothing
)
>>= \case
VRight _ -> runLogger
@@ -348,8 +422,8 @@ main = do
SetGHC (SetGHCOptions {..}) ->
void
$ (runSetGHC $ do
av <- liftE getDownloads
v <- liftE $ fromVersion av ghcVer GHC
dls <- _binaryDownloads <$> liftE getDownloads
v <- liftE $ fromVersion dls ghcVer GHC
liftE $ setGHC v SetGHCOnly
)
>>= \case
@@ -361,7 +435,8 @@ main = do
List (ListOptions {..}) ->
void
$ (runListGHC $ do
liftE $ listVersions lTool lCriteria
dls <- _binaryDownloads <$> liftE getDownloads
liftIO $ listVersions dls lTool lCriteria
)
>>= \case
VRight r -> liftIO $ printListResult r
@@ -387,11 +462,28 @@ main = do
VRight dinfo -> putStrLn $ show dinfo
VLeft e ->
runLogger ($(logError) [i|#{e}|]) >> exitFailure
Compile (CompileOptions {..}) ->
void
$ (runCompileGHC $ do
dls <- _sourceDownloads <$> liftE getDownloads
liftE $ compileGHC dls ghcVer bootstrapVer jobs buildConfig
)
>>= \case
VRight _ ->
runLogger $ $(logInfo)
([s|GHC successfully compiled and installed|])
VLeft (V (AlreadyInstalled treq)) ->
runLogger $ $(logWarn)
(T.pack (show treq) <> [s| already installed|])
VLeft e ->
runLogger ($(logError) [i|#{e}|]) >> exitFailure
pure ()
fromVersion :: Monad m
=> AvailableDownloads
=> BinaryDownloads
-> Maybe ToolVersion
-> Tool
-> Excepts '[TagNotFound] m Version