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

35
app/ghcup-gen/AvailableDownloads.hs → app/ghcup-gen/BinaryDownloads.hs
View File

@@ -1,24 +1,20 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DuplicateRecordFields #-}
module AvailableDownloads where
module BinaryDownloads where
import qualified Data.Map as M
import GHCup.Prelude
import GHCup.Types
import GHCup.Utils.Prelude
import Data.String.QQ
import HPath
import URI.ByteString.QQ
import qualified Data.Map as M
-- TODO: version quasiquoter
availableDownloads :: AvailableDownloads
availableDownloads = M.fromList
binaryDownloads :: BinaryDownloads
binaryDownloads = M.fromList
[ ( GHC
, M.fromList
[ ( [vver|8.6.5|]
@@ -31,6 +27,7 @@ availableDownloads = M.fromList
, DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-fedora27-linux.tar.xz|]
(Just ([rel|ghc-8.6.5|] :: Path Rel))
[s|5f871a3eaf808acb2420fdeef9318698|]
)
]
)
@@ -38,8 +35,9 @@ availableDownloads = M.fromList
, M.fromList
[ ( Nothing
, DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-deb9-linux.tar.xz|]
[uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-fedora27-linux.tar.xz|]
(Just ([rel|ghc-8.6.5|] :: Path Rel))
[s|5f871a3eaf808acb2420fdeef9318698|]
)
]
)
@@ -49,11 +47,13 @@ availableDownloads = M.fromList
, DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-debian9-linux.tar.xz|]
(Just ([rel|ghc-8.6.5|] :: Path Rel))
[s|5f871a3eaf808acb2420fdeef9318698|]
)
, ( Just $ [vers|8|]
, DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-debian8-linux.tar.xz|]
[uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-debian9-linux.tar.xz|]
(Just ([rel|ghc-8.6.5|] :: Path Rel))
[s|5f871a3eaf808acb2420fdeef9318698|]
)
]
)
@@ -62,7 +62,7 @@ availableDownloads = M.fromList
]
),
( [vver|8.4.4|]
, VersionInfo [Latest] $ M.fromList
, VersionInfo [] $ M.fromList
[ ( A_64
, M.fromList
[ ( Linux UnknownLinux
@@ -71,6 +71,7 @@ availableDownloads = M.fromList
, DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-fedora27-linux.tar.xz|]
(Just ([rel|ghc-8.4.4|] :: Path Rel))
[s|86785f41d228168461859e40956973fb|]
)
]
)
@@ -78,8 +79,9 @@ availableDownloads = M.fromList
, M.fromList
[ ( Nothing
, DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-deb9-linux.tar.xz|]
[uri|https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-fedora27-linux.tar.xz|]
(Just ([rel|ghc-8.4.4|] :: Path Rel))
[s|f943a245c54c2f2dcb354dceeff886e1|]
)
]
)
@@ -89,11 +91,13 @@ availableDownloads = M.fromList
, DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-debian9-linux.tar.xz|]
(Just ([rel|ghc-8.6.5|] :: Path Rel))
[s|f943a245c54c2f2dcb354dceeff886e1|]
)
, ( Just $ [vers|8|]
, DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-debian8-linux.tar.xz|]
(Just ([rel|ghc-8.6.5|] :: Path Rel))
[s|f943a245c54c2f2dcb354dceeff886e1|]
)
]
)
@@ -115,6 +119,7 @@ availableDownloads = M.fromList
, DownloadInfo
[uri|https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-x86_64-unknown-linux.tar.xz|]
Nothing
[s|32352d2259909970e6ff04faf61bbfac|]
)
]
)

11
app/ghcup-gen/GHCupDownloads.hs Normal file
View File

@@ -0,0 +1,11 @@
module GHCupDownloads where
import GHCup.Types
import BinaryDownloads
import SourceDownloads
ghcupDownloads :: GHCupDownloads
ghcupDownloads = GHCupDownloads { _binaryDownloads = binaryDownloads
, _sourceDownloads = sourceDownloads
}

14
app/ghcup-gen/Main.hs
View File

@@ -8,19 +8,21 @@
module Main where
import AvailableDownloads
import GHCup.Types.JSON ( )
import GHCup.Utils.Logger
import GHCupDownloads
import Data.Aeson ( eitherDecode )
import Data.Aeson.Encode.Pretty
import qualified Data.ByteString.Lazy as L
import Data.Semigroup ( (<>) )
import GHCup.Types.JSON ( )
import Options.Applicative hiding ( style )
import GHCup.Logger
import System.Console.Pretty
import System.Exit
import System.IO ( stdout )
import Validate
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
data Options = Options
@@ -120,7 +122,7 @@ main = do
GenJSON gopts -> do
let
bs = encodePretty' (defConfig { confIndent = Spaces 2 })
availableDownloads
ghcupDownloads
case gopts of
GenJSONOpts { output = Nothing } -> L.hPutStr stdout bs
GenJSONOpts { output = Just StdOutput } -> L.hPutStr stdout bs
@@ -140,4 +142,4 @@ main = do
av <- case eitherDecode contents of
Right r -> pure r
Left e -> die (color Red $ show e)
myLoggerTStdout (validate av) >>= exitWith
myLoggerT (LoggerConfig True (B.hPut stdout)) (validate av) >>= exitWith

26
app/ghcup-gen/SourceDownloads.hs Normal file
View File

@@ -0,0 +1,26 @@
{-# LANGUAGE QuasiQuotes #-}
module SourceDownloads where
import GHCup.Types
import GHCup.Utils.Prelude
import Data.String.QQ
import HPath
import URI.ByteString.QQ
import qualified Data.Map as M
-- TODO: source tarballs
-- TODO: reference tarballs
sourceDownloads :: SourceDownloads
sourceDownloads = M.fromList
[ ( [vver|8.6.5|]
, DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-src.tar.xz|]
(Just ([rel|ghc-8.6.5|] :: Path Rel))
[s|b47726aaf302eb87b4970fcee924d45d|]
)
]

13
app/ghcup-gen/Validate.hs
View File

@@ -34,20 +34,23 @@ instance Exception ValidationError
-- TODO: test that GHC is in semver
validate :: (Monad m, MonadLogger m, MonadThrow m, MonadIO m)
=> AvailableDownloads
=> GHCupDownloads
-> m ExitCode
validate av = do
validate GHCupDownloads{..} = do
ref <- liftIO $ newIORef 0
-- * verify binary downloads * --
flip runReaderT ref $ do
-- unique tags
forM_ (M.toList av) $ \(t, _) -> checkUniqueTags t
forM_ (M.toList _binaryDownloads) $ \(t, _) -> checkUniqueTags t
-- required platforms
forM_ (M.toList av) $ \(t, versions) ->
forM_ (M.toList _binaryDownloads) $ \(t, versions) ->
forM_ (M.toList versions) $ \(v, vi) ->
forM_ (M.toList $ _viArch vi) $ \(arch, pspecs) -> do
checkHasRequiredPlatforms t v arch (M.keys pspecs)
-- exit
e <- liftIO $ readIORef ref
if e > 0 then pure $ ExitFailure e else pure ExitSuccess
@@ -65,7 +68,7 @@ validate av = do
[i|FreeBSD missing for #{t} #{v'} #{arch}|]
checkUniqueTags tool = do
let allTags = join $ fmap snd $ availableToolVersions av tool
let allTags = join $ fmap snd $ availableToolVersions _binaryDownloads tool
let nonUnique =
fmap fst
. filter (\(_, b) -> not b)

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