More
This commit is contained in:
parent
ac91cbd32b
commit
b3eac9bf54
17
TODO.md
17
TODO.md
@ -1,5 +1,21 @@
|
|||||||
# TODOs and Remarks
|
# TODOs and Remarks
|
||||||
|
|
||||||
|
## New
|
||||||
|
|
||||||
|
* Downloads from URL
|
||||||
|
* set Set currently active GHC version
|
||||||
|
* list Show available GHCs and other tools
|
||||||
|
* upgrade Upgrade this script in-place
|
||||||
|
* rm Remove an already installed GHC
|
||||||
|
* debug-info Print debug info (e.g. detected system/distro)
|
||||||
|
* changelog Show the changelog of a GHC release (online)
|
||||||
|
* print-system-reqs Print an approximation of system requirements
|
||||||
|
|
||||||
|
* testing (especially distro detection -> unit tests)
|
||||||
|
|
||||||
|
|
||||||
|
## Old
|
||||||
|
|
||||||
* handling of SIGTERM and SIGUSR
|
* handling of SIGTERM and SIGUSR
|
||||||
* add support for RC/alpha/HEAD versions
|
* add support for RC/alpha/HEAD versions
|
||||||
* redo/rethink how tool tags works
|
* redo/rethink how tool tags works
|
||||||
@ -10,7 +26,6 @@
|
|||||||
|
|
||||||
* --copy-compiler-tools
|
* --copy-compiler-tools
|
||||||
* installing multiple versions in parallel?
|
* installing multiple versions in parallel?
|
||||||
* exception handling (checked exception library? Maybe effects system all the way?)
|
|
||||||
* how to version and extend the format of the downloads file? Compatibility?
|
* how to version and extend the format of the downloads file? Compatibility?
|
||||||
* how to propagate updates? Automatically? Might solve the versioning problem
|
* how to propagate updates? Automatically? Might solve the versioning problem
|
||||||
* installing musl on demand?
|
* installing musl on demand?
|
||||||
|
84
app/Main.hs
84
app/Main.hs
@ -1,6 +1,8 @@
|
|||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
@ -12,6 +14,7 @@ import Data.ByteString ( ByteString )
|
|||||||
import Data.Functor ( (<&>) )
|
import Data.Functor ( (<&>) )
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Semigroup ( (<>) )
|
import Data.Semigroup ( (<>) )
|
||||||
|
import Data.String.QQ
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
@ -29,6 +32,7 @@ import System.Exit
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
data Options = Options
|
data Options = Options
|
||||||
{ optVerbose :: Bool
|
{ optVerbose :: Bool
|
||||||
, optCache :: Bool
|
, optCache :: Bool
|
||||||
@ -102,50 +106,64 @@ installCabalOpts = InstallCabalOptions <$> optional
|
|||||||
|
|
||||||
|
|
||||||
toSettings :: Options -> Settings
|
toSettings :: Options -> Settings
|
||||||
toSettings Options{..} =
|
toSettings Options {..} = let cache = optCache in Settings { .. }
|
||||||
let cache = optCache
|
|
||||||
in Settings{..}
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TODO: something better than Show instance for errors
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
e <-
|
-- logger interpreter
|
||||||
|
let runLogger = runStderrLoggingT
|
||||||
|
|
||||||
customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
|
customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
|
||||||
>>= \opt@Options {..} -> do
|
>>= \opt@Options {..} -> do
|
||||||
let settings = toSettings opt
|
let settings = toSettings opt
|
||||||
-- wrapper to run effects with settings
|
-- wrapper to run effects with settings
|
||||||
let run = flip runReaderT settings . runStderrLoggingT . runE
|
let
|
||||||
@'[ FileError
|
runInstTool =
|
||||||
, ArchiveError
|
runLogger
|
||||||
, ProcessError
|
. flip runReaderT settings
|
||||||
, URLException
|
. runE
|
||||||
, PlatformResultError
|
@'[FileError, ArchiveError, ProcessError, URLException, PlatformResultError, NoDownload, NoCompatibleArch, DistroNotFound, TagNotFound, AlreadyInstalled]
|
||||||
, NoDownload
|
|
||||||
, NoCompatibleArch
|
|
||||||
, DistroNotFound
|
|
||||||
, TagNotFound
|
|
||||||
]
|
|
||||||
|
|
||||||
case optCommand of
|
case optCommand of
|
||||||
InstallGHC (InstallGHCOptions {..}) ->
|
InstallGHC (InstallGHCOptions {..}) ->
|
||||||
run
|
void
|
||||||
$ do
|
$ (runInstTool $ do
|
||||||
d <- liftIO $ ghcupBaseDir
|
v <- maybe
|
||||||
case ghcVer of
|
( getRecommended availableDownloads GHC
|
||||||
Just ver -> liftE $ installTool (ToolRequest GHC ver)
|
?? TagNotFound Recommended GHC
|
||||||
|
)
|
||||||
|
pure
|
||||||
|
ghcVer
|
||||||
|
liftE $ installTool (ToolRequest GHC v)
|
||||||
Nothing
|
Nothing
|
||||||
(OwnSpec availableDownloads)
|
(OwnSpec availableDownloads)
|
||||||
Nothing -> do
|
)
|
||||||
ver <-
|
>>= \case
|
||||||
getRecommended availableDownloads GHC
|
VRight _ -> pure ()
|
||||||
?? TagNotFound Recommended GHC
|
VLeft (V (AlreadyInstalled treq)) ->
|
||||||
liftE $ installTool (ToolRequest GHC ver) Nothing (OwnSpec availableDownloads)
|
runLogger $ $(logWarn)
|
||||||
InstallCabal (InstallCabalOptions {..}) -> undefined
|
(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 _ -> pure ()
|
||||||
|
VLeft (V (AlreadyInstalled treq)) ->
|
||||||
|
runLogger $ $(logWarn)
|
||||||
|
(T.pack (show treq) <> [s| already installed|])
|
||||||
|
VLeft e -> die (color Red $ show e)
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
|
|
||||||
-- print error, if any
|
|
||||||
-- case e of
|
|
||||||
-- Right () -> pure ()
|
|
||||||
-- Left t -> die (color Red $ t)
|
|
||||||
|
@ -10,6 +10,9 @@ package streamly
|
|||||||
package ghcup
|
package ghcup
|
||||||
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
|
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
|
||||||
|
|
||||||
|
package tar-bytestring
|
||||||
|
ghc-options: -O2
|
||||||
|
|
||||||
source-repository-package
|
source-repository-package
|
||||||
type: git
|
type: git
|
||||||
location: https://github.com/composewell/streamly
|
location: https://github.com/composewell/streamly
|
||||||
|
@ -31,6 +31,7 @@ common containers { build-depends: containers >= 0.6 }
|
|||||||
common generics-sop { build-depends: generics-sop >= 0.5 }
|
common generics-sop { build-depends: generics-sop >= 0.5 }
|
||||||
common haskus-utils-variant { build-depends: haskus-utils-variant >= 3.0 }
|
common haskus-utils-variant { build-depends: haskus-utils-variant >= 3.0 }
|
||||||
common hpath { build-depends: hpath >= 0.11 }
|
common hpath { build-depends: hpath >= 0.11 }
|
||||||
|
common hpath-directory { build-depends: hpath-directory >= 0.13.2 }
|
||||||
common hpath-filepath { build-depends: hpath-filepath >= 0.10.3 }
|
common hpath-filepath { build-depends: hpath-filepath >= 0.10.3 }
|
||||||
common hpath-io { build-depends: hpath-io >= 0.13.1 }
|
common hpath-io { build-depends: hpath-io >= 0.13.1 }
|
||||||
common hpath-posix { build-depends: hpath-posix >= 0.11.1 }
|
common hpath-posix { build-depends: hpath-posix >= 0.11.1 }
|
||||||
@ -92,6 +93,7 @@ library
|
|||||||
, generics-sop
|
, generics-sop
|
||||||
, haskus-utils-variant
|
, haskus-utils-variant
|
||||||
, hpath
|
, hpath
|
||||||
|
, hpath-directory
|
||||||
, hpath-filepath
|
, hpath-filepath
|
||||||
, hpath-io
|
, hpath-io
|
||||||
, hpath-posix
|
, hpath-posix
|
||||||
@ -145,6 +147,7 @@ executable ghcup
|
|||||||
, versions
|
, versions
|
||||||
, hpath
|
, hpath
|
||||||
, pretty-terminal
|
, pretty-terminal
|
||||||
|
, string-qq
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
-- other-modules:
|
-- other-modules:
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
|
214
lib/GHCup.hs
214
lib/GHCup.hs
@ -6,6 +6,7 @@
|
|||||||
{-# LANGUAGE QuasiQuotes #-}
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
|
||||||
-- TODO: handle SIGTERM, SIGUSR
|
-- TODO: handle SIGTERM, SIGUSR
|
||||||
module GHCup where
|
module GHCup where
|
||||||
@ -14,8 +15,10 @@ module GHCup where
|
|||||||
import qualified Codec.Archive.Tar as Tar
|
import qualified Codec.Archive.Tar as Tar
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
import Control.Monad.Fail ( MonadFail )
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
|
import Control.Monad.Cont
|
||||||
import Control.Monad.Trans.Maybe
|
import Control.Monad.Trans.Maybe
|
||||||
import Control.Monad.Trans.Class ( lift )
|
import Control.Monad.Trans.Class ( lift )
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
@ -55,11 +58,15 @@ import System.IO.Streams ( InputStream
|
|||||||
)
|
)
|
||||||
import qualified System.IO.Streams as Streams
|
import qualified System.IO.Streams as Streams
|
||||||
import System.Posix.FilePath ( takeExtension
|
import System.Posix.FilePath ( takeExtension
|
||||||
|
, takeFileName
|
||||||
, splitExtension
|
, splitExtension
|
||||||
)
|
)
|
||||||
import qualified System.Posix.FilePath as FP
|
import qualified System.Posix.FilePath as FP
|
||||||
|
import System.Posix.Files.ByteString ( readSymbolicLink )
|
||||||
import System.Posix.Env.ByteString ( getEnvDefault )
|
import System.Posix.Env.ByteString ( getEnvDefault )
|
||||||
import System.Posix.Temp.ByteString
|
import System.Posix.Temp.ByteString
|
||||||
|
import System.Posix.RawFilePath.Directory.Errors
|
||||||
|
( hideError )
|
||||||
import "unix" System.Posix.IO.ByteString
|
import "unix" System.Posix.IO.ByteString
|
||||||
hiding ( fdWrite )
|
hiding ( fdWrite )
|
||||||
import System.Posix.FD as FD
|
import System.Posix.FD as FD
|
||||||
@ -86,9 +93,10 @@ import URI.ByteString.QQ
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
data Settings = Settings {
|
data Settings = Settings
|
||||||
cache :: Bool
|
{ cache :: Bool
|
||||||
} deriving Show
|
}
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -116,12 +124,17 @@ data ArchiveError = UnknownArchive ByteString
|
|||||||
data URLException = UnsupportedURL
|
data URLException = UnsupportedURL
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
data FileError = CopyError
|
data FileError = CopyError String
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
data TagNotFound = TagNotFound Tag Tool
|
data TagNotFound = TagNotFound Tag Tool
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
|
data AlreadyInstalled = AlreadyInstalled ToolRequest
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
data NotInstalled = NotInstalled ToolRequest
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -180,7 +193,7 @@ availableDownloads = Map.fromList
|
|||||||
, ( Cabal
|
, ( Cabal
|
||||||
, Map.fromList
|
, Map.fromList
|
||||||
[ ( [ver|3.0.0.0|]
|
[ ( [ver|3.0.0.0|]
|
||||||
, VersionInfo [Latest] $ Map.fromList
|
, VersionInfo [Recommended, Latest] $ Map.fromList
|
||||||
[ ( A_64
|
[ ( A_64
|
||||||
, Map.fromList
|
, Map.fromList
|
||||||
[ ( Linux UnknownLinux
|
[ ( Linux UnknownLinux
|
||||||
@ -230,7 +243,11 @@ getDownloadInfo :: (MonadLogger m, MonadCatch m, MonadIO m)
|
|||||||
-> Maybe PlatformRequest
|
-> Maybe PlatformRequest
|
||||||
-> URLSource
|
-> URLSource
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[PlatformResultError, NoDownload, NoCompatibleArch, DistroNotFound]
|
'[ PlatformResultError
|
||||||
|
, NoDownload
|
||||||
|
, NoCompatibleArch
|
||||||
|
, DistroNotFound
|
||||||
|
]
|
||||||
m
|
m
|
||||||
DownloadInfo
|
DownloadInfo
|
||||||
getDownloadInfo (ToolRequest t v) mpfReq urlSource = do
|
getDownloadInfo (ToolRequest t v) mpfReq urlSource = do
|
||||||
@ -244,6 +261,7 @@ getDownloadInfo (ToolRequest t v) mpfReq urlSource = do
|
|||||||
pure $ PlatformRequest ar rp rv
|
pure $ PlatformRequest ar rp rv
|
||||||
|
|
||||||
dls <- case urlSource of
|
dls <- case urlSource of
|
||||||
|
-- TODO
|
||||||
GHCupURL -> fail "Not implemented"
|
GHCupURL -> fail "Not implemented"
|
||||||
OwnSource url -> fail "Not implemented"
|
OwnSource url -> fail "Not implemented"
|
||||||
OwnSpec dls -> pure dls
|
OwnSpec dls -> pure dls
|
||||||
@ -407,7 +425,7 @@ getArchitecture = case arch of
|
|||||||
|
|
||||||
getPlatform :: (MonadLogger m, MonadCatch m, MonadIO m)
|
getPlatform :: (MonadLogger m, MonadCatch m, MonadIO m)
|
||||||
=> Excepts
|
=> Excepts
|
||||||
'[PlatformResultError, DistroNotFound]
|
'[PlatformResultError , DistroNotFound]
|
||||||
m
|
m
|
||||||
PlatformResult
|
PlatformResult
|
||||||
getPlatform = do
|
getPlatform = do
|
||||||
@ -430,6 +448,7 @@ getPlatform = do
|
|||||||
getLinuxDistro :: (MonadCatch m, MonadIO m)
|
getLinuxDistro :: (MonadCatch m, MonadIO m)
|
||||||
=> Excepts '[DistroNotFound] m (LinuxDistro, Maybe Versioning)
|
=> Excepts '[DistroNotFound] m (LinuxDistro, Maybe Versioning)
|
||||||
getLinuxDistro = do
|
getLinuxDistro = do
|
||||||
|
-- TODO: don't do alternative on IO, because it hides bugs
|
||||||
(name, ver) <- handleIO (\_ -> throwE DistroNotFound) $ liftIO $ asum
|
(name, ver) <- handleIO (\_ -> throwE DistroNotFound) $ liftIO $ asum
|
||||||
[ try_os_release
|
[ try_os_release
|
||||||
, try_lsb_release_cmd
|
, try_lsb_release_cmd
|
||||||
@ -481,12 +500,10 @@ getLinuxDistro = do
|
|||||||
|
|
||||||
try_lsb_release_cmd :: IO (Text, Maybe Text)
|
try_lsb_release_cmd :: IO (Text, Maybe Text)
|
||||||
try_lsb_release_cmd = do
|
try_lsb_release_cmd = do
|
||||||
(Just _ ) <- findExecutable lsb_release_cmd
|
(Just _) <- findExecutable lsb_release_cmd
|
||||||
(Just name) <- (fmap . fmap) _stdOut
|
name <- fmap _stdOut $ executeOut lsb_release_cmd [[s|-si|]] Nothing
|
||||||
$ executeOut lsb_release_cmd [[s|-si|]] Nothing
|
ver <- fmap _stdOut $ executeOut lsb_release_cmd [[s|-sr|]] Nothing
|
||||||
ver <- (fmap . fmap) _stdOut
|
pure (E.decodeUtf8 name, Just $ E.decodeUtf8 ver)
|
||||||
$ executeOut lsb_release_cmd [[s|-sr|]] Nothing
|
|
||||||
pure (E.decodeUtf8 name, fmap E.decodeUtf8 ver)
|
|
||||||
|
|
||||||
try_lsb_release :: IO (Text, Maybe Text)
|
try_lsb_release :: IO (Text, Maybe Text)
|
||||||
try_lsb_release = do
|
try_lsb_release = do
|
||||||
@ -522,14 +539,18 @@ getLinuxDistro = do
|
|||||||
-- parseAvailableDownloads :: Maybe (Path Abs) -> IO AvailableDownloads
|
-- parseAvailableDownloads :: Maybe (Path Abs) -> IO AvailableDownloads
|
||||||
-- parseAvailableDownloads = undefined
|
-- parseAvailableDownloads = undefined
|
||||||
|
|
||||||
-- TODO: subdir to configure script in availableDownloads?
|
|
||||||
|
|
||||||
|
|
||||||
-------------------------
|
-------------------------
|
||||||
--[ Tool installation ]--
|
--[ Tool installation ]--
|
||||||
-------------------------
|
-------------------------
|
||||||
|
|
||||||
|
-- TODO: custom logger intepreter and pretty printing
|
||||||
|
|
||||||
|
-- | Install a tool, such as GHC or cabal.
|
||||||
|
--
|
||||||
|
-- This can fail in many ways. You may want to explicitly catch
|
||||||
|
-- `AlreadyInstalled` to not make it fatal.
|
||||||
installTool :: ( MonadThrow m
|
installTool :: ( MonadThrow m
|
||||||
, MonadReader Settings m
|
, MonadReader Settings m
|
||||||
, MonadLogger m
|
, MonadLogger m
|
||||||
@ -537,15 +558,29 @@ installTool :: ( MonadThrow m
|
|||||||
, MonadIO m
|
, MonadIO m
|
||||||
)
|
)
|
||||||
=> ToolRequest
|
=> ToolRequest
|
||||||
-> Maybe PlatformRequest
|
-> Maybe PlatformRequest -- ^ if Nothing, looks up current host platform
|
||||||
-> URLSource
|
-> URLSource
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[FileError, ArchiveError, ProcessError, URLException, PlatformResultError, NoDownload, NoCompatibleArch, DistroNotFound]
|
'[ AlreadyInstalled
|
||||||
|
, FileError
|
||||||
|
, ArchiveError
|
||||||
|
, ProcessError
|
||||||
|
, URLException
|
||||||
|
, PlatformResultError
|
||||||
|
, NoDownload
|
||||||
|
, NoCompatibleArch
|
||||||
|
, DistroNotFound
|
||||||
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installTool treq mpfReq urlSource = do
|
installTool treq mpfReq urlSource = do
|
||||||
Settings {..} <- lift ask
|
|
||||||
lift $ $(logDebug) ([s|Requested to install: |] <> showT treq)
|
lift $ $(logDebug) ([s|Requested to install: |] <> showT treq)
|
||||||
|
alreadyInstalled <- liftIO $ toolAlreadyInstalled treq
|
||||||
|
when alreadyInstalled $ (throwE $ AlreadyInstalled treq)
|
||||||
|
|
||||||
|
Settings {..} <- lift ask
|
||||||
|
|
||||||
|
-- download (or use cached version)
|
||||||
dlinfo <- liftE $ getDownloadInfo treq mpfReq urlSource
|
dlinfo <- liftE $ getDownloadInfo treq mpfReq urlSource
|
||||||
dl <- case cache of
|
dl <- case cache of
|
||||||
True -> do
|
True -> do
|
||||||
@ -559,25 +594,34 @@ installTool treq mpfReq urlSource = do
|
|||||||
False -> do
|
False -> do
|
||||||
tmp <- liftIO mkGhcupTmpDir
|
tmp <- liftIO mkGhcupTmpDir
|
||||||
liftE $ download' dlinfo tmp Nothing
|
liftE $ download' dlinfo tmp Nothing
|
||||||
|
|
||||||
|
-- unpack
|
||||||
unpacked <- liftE $ unpackToTmpDir dl
|
unpacked <- liftE $ unpackToTmpDir dl
|
||||||
ghcdir <- liftIO $ do
|
|
||||||
toolsubdir <- ghcupGHCDir
|
-- prepare paths
|
||||||
versubdir <- parseRel (E.encodeUtf8 . prettyVer . view toolVersion $ treq)
|
ghcdir <- liftIO $ ghcupGHCDir (view toolVersion $ treq)
|
||||||
pure (toolsubdir </> versubdir)
|
|
||||||
bindir <- liftIO ghcupBinDir
|
bindir <- liftIO ghcupBinDir
|
||||||
|
|
||||||
-- the subdir of the archive where we do the work
|
-- the subdir of the archive where we do the work
|
||||||
let archiveSubdir = maybe unpacked (unpacked </>) (view dlSubdir dlinfo)
|
let archiveSubdir = maybe unpacked (unpacked </>) (view dlSubdir dlinfo)
|
||||||
|
|
||||||
|
-- TODO: test if tool is already installed
|
||||||
case treq of
|
case treq of
|
||||||
(ToolRequest GHC ver) -> liftE $ installGHC archiveSubdir ghcdir
|
(ToolRequest GHC ver) -> liftE $ installGHC archiveSubdir ghcdir
|
||||||
(ToolRequest Cabal ver) -> liftE $ installCabal archiveSubdir bindir
|
(ToolRequest Cabal ver) -> liftE $ installCabal archiveSubdir bindir
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
|
|
||||||
|
toolAlreadyInstalled :: ToolRequest -> IO Bool
|
||||||
|
toolAlreadyInstalled ToolRequest {..} = case _tool of
|
||||||
|
GHC -> ghcInstalled _toolVersion
|
||||||
|
Cabal -> cabalInstalled _toolVersion
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- | Install an unpacked GHC distribution.
|
-- | Install an unpacked GHC distribution.
|
||||||
installGHC :: (MonadLogger m, MonadIO m)
|
installGHC :: (MonadLogger m, MonadIO m)
|
||||||
=> Path Abs -- ^ Path to the unpacked GHC bindist
|
=> Path Abs -- ^ Path to the unpacked GHC bindist (where the configure script resides)
|
||||||
-> Path Abs -- ^ Path to install to
|
-> Path Abs -- ^ Path to install to
|
||||||
-> Excepts '[ProcessError] m ()
|
-> Excepts '[ProcessError] m ()
|
||||||
installGHC path inst = do
|
installGHC path inst = do
|
||||||
@ -592,17 +636,93 @@ installGHC path inst = do
|
|||||||
|
|
||||||
-- | Install an unpacked cabal distribution.
|
-- | Install an unpacked cabal distribution.
|
||||||
installCabal :: (MonadLogger m, MonadCatch m, MonadIO m)
|
installCabal :: (MonadLogger m, MonadCatch m, MonadIO m)
|
||||||
=> Path Abs -- ^ Path to the unpacked cabal bindist
|
=> Path Abs -- ^ Path to the unpacked cabal bindist (where the executable resides)
|
||||||
-> Path Abs -- ^ Path to install to
|
-> Path Abs -- ^ Path to install to
|
||||||
-> Excepts '[FileError] m ()
|
-> Excepts '[FileError] m ()
|
||||||
installCabal path inst = do
|
installCabal path inst = do
|
||||||
lift $ $(logInfo) ([s|Installing cabal|])
|
lift $ $(logInfo) ([s|Installing cabal|])
|
||||||
let cabalFile = [rel|cabal|] :: Path Rel
|
let cabalFile = [rel|cabal|] :: Path Rel
|
||||||
handleIO (\_ -> throwE CopyError) $ liftIO $ copyFile (path </> cabalFile)
|
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||||
|
(path </> cabalFile)
|
||||||
(inst </> cabalFile)
|
(inst </> cabalFile)
|
||||||
Overwrite
|
Overwrite
|
||||||
|
|
||||||
|
|
||||||
|
-- | 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-<ver>
|
||||||
|
-- * SetGHCMajor: ~/.ghcup/bin/ghc-X.Y -> ~/.ghcup/ghc/<ver>/bin/ghc-<ver>
|
||||||
|
-- * SetGHCMinor: ~/.ghcup/bin/ghc-<ver> -> ~/.ghcup/ghc/<ver>/bin/ghc-<ver>
|
||||||
|
--
|
||||||
|
-- Additionally creates a ~/.ghcup/share -> ~/.ghcup/ghc/<ver>/share symlink
|
||||||
|
-- for `SetGHCOnly` constructor.
|
||||||
|
setGHC :: (MonadThrow m, MonadFail m, MonadIO m)
|
||||||
|
=> Version
|
||||||
|
-> SetGHC
|
||||||
|
-> Excepts '[NotInstalled] m ()
|
||||||
|
setGHC ver sghc = do
|
||||||
|
let verBS = E.encodeUtf8 $ prettyVer ver -- as ByteString
|
||||||
|
ghcdir <- liftIO $ ghcupGHCDir ver
|
||||||
|
|
||||||
|
-- symlink destination
|
||||||
|
destdir <- liftIO $ ghcupBinDir
|
||||||
|
|
||||||
|
-- for ghc tools (ghc, ghci, haddock, ...)
|
||||||
|
verfiles <- ghcToolFiles ghcdir
|
||||||
|
forM verfiles $ \file -> do
|
||||||
|
liftIO $ hideError doesNotExistErrorType $ deleteFile (destdir </> file)
|
||||||
|
targetFile <- case sghc of
|
||||||
|
SetGHCOnly -> pure file
|
||||||
|
SetGHCMajor -> do
|
||||||
|
major <- E.encodeUtf8 <$> getGHCMajor ver
|
||||||
|
parseRel (toFilePath file <> B.singleton _hyphen <> major)
|
||||||
|
SetGHCMinor -> parseRel (toFilePath file <> B.singleton _hyphen <> verBS)
|
||||||
|
liftIO $ createSymlink
|
||||||
|
(destdir </> targetFile)
|
||||||
|
([s|../ghc/|] <> verBS <> [s|/bin/|] <> toFilePath file)
|
||||||
|
|
||||||
|
-- create symlink for share dir
|
||||||
|
liftIO $ symlinkShareDir ghcdir destdir verBS
|
||||||
|
|
||||||
|
pure ()
|
||||||
|
|
||||||
|
where
|
||||||
|
-- get tool files from ~/.ghcup/bin/ghc/<ver>/bin/* while ignoring *-<ver> symlinks
|
||||||
|
ghcToolFiles :: (MonadThrow m, MonadFail m, MonadIO m)
|
||||||
|
=> Path Abs
|
||||||
|
-> Excepts '[NotInstalled] m [Path Rel]
|
||||||
|
ghcToolFiles ghcdir = do
|
||||||
|
-- fail if ghc is not installed
|
||||||
|
exists <- liftIO $ doesDirectoryExist ghcdir
|
||||||
|
whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir)
|
||||||
|
(throwE (NotInstalled $ ToolRequest GHC ver))
|
||||||
|
|
||||||
|
files <- liftIO $ getDirsFiles' (ghcdir </> ([rel|bin|] :: Path Rel))
|
||||||
|
-- figure out the <ver> suffix, because this might not be `Version` for
|
||||||
|
-- alpha/rc releases, but x.y.a.somedate.
|
||||||
|
(Just symver) <-
|
||||||
|
(B.stripPrefix [s|ghc-|] . takeFileName)
|
||||||
|
<$> (liftIO $ readSymbolicLink $ toFilePath
|
||||||
|
(ghcdir </> ([rel|bin/ghc|] :: Path Rel))
|
||||||
|
)
|
||||||
|
when (B.null symver)
|
||||||
|
(throwIO $ userError $ "Fatal: ghc symlink target is broken")
|
||||||
|
pure $ filter (\x -> not $ symver `B.isSuffixOf` toFilePath x) files
|
||||||
|
|
||||||
|
symlinkShareDir :: Path Abs -> Path Abs -> ByteString -> IO ()
|
||||||
|
symlinkShareDir ghcdir destdir verBS = case sghc of
|
||||||
|
SetGHCOnly -> do
|
||||||
|
let sharedir = [rel|share|] :: Path Rel
|
||||||
|
let fullsharedir = ghcdir </> sharedir
|
||||||
|
whenM (doesDirectoryExist fullsharedir) $ do
|
||||||
|
liftIO $ hideError doesNotExistErrorType $ deleteFile
|
||||||
|
(destdir </> sharedir)
|
||||||
|
createSymlink
|
||||||
|
(destdir </> sharedir)
|
||||||
|
([s|../ghc/|] <> verBS <> [s|/|] <> toFilePath sharedir)
|
||||||
|
_ -> pure ()
|
||||||
|
|
||||||
|
|
||||||
-----------------
|
-----------------
|
||||||
--[ Utilities ]--
|
--[ Utilities ]--
|
||||||
@ -614,8 +734,19 @@ ghcupBaseDir = do
|
|||||||
home <- liftIO getHomeDirectory
|
home <- liftIO getHomeDirectory
|
||||||
pure (home </> ([rel|.ghcup|] :: Path Rel))
|
pure (home </> ([rel|.ghcup|] :: Path Rel))
|
||||||
|
|
||||||
ghcupGHCDir :: IO (Path Abs)
|
ghcupGHCBaseDir :: IO (Path Abs)
|
||||||
ghcupGHCDir = ghcupBaseDir <&> (</> ([rel|ghc|] :: Path Rel))
|
ghcupGHCBaseDir = ghcupBaseDir <&> (</> ([rel|ghc|] :: Path Rel))
|
||||||
|
|
||||||
|
ghcupGHCDir :: Version -> IO (Path Abs)
|
||||||
|
ghcupGHCDir ver = do
|
||||||
|
ghcbasedir <- ghcupGHCBaseDir
|
||||||
|
verdir <- parseRel (E.encodeUtf8 $ prettyVer ver)
|
||||||
|
pure (ghcbasedir </> verdir)
|
||||||
|
|
||||||
|
ghcInstalled :: Version -> IO Bool
|
||||||
|
ghcInstalled ver = do
|
||||||
|
ghcdir <- ghcupGHCDir ver
|
||||||
|
doesDirectoryExist ghcdir
|
||||||
|
|
||||||
ghcupBinDir :: IO (Path Abs)
|
ghcupBinDir :: IO (Path Abs)
|
||||||
ghcupBinDir = ghcupBaseDir <&> (</> ([rel|bin|] :: Path Rel))
|
ghcupBinDir = ghcupBaseDir <&> (</> ([rel|bin|] :: Path Rel))
|
||||||
@ -623,6 +754,23 @@ ghcupBinDir = ghcupBaseDir <&> (</> ([rel|bin|] :: Path Rel))
|
|||||||
ghcupCacheDir :: IO (Path Abs)
|
ghcupCacheDir :: IO (Path Abs)
|
||||||
ghcupCacheDir = ghcupBaseDir <&> (</> ([rel|cache|] :: Path Rel))
|
ghcupCacheDir = ghcupBaseDir <&> (</> ([rel|cache|] :: Path Rel))
|
||||||
|
|
||||||
|
cabalInstalled :: Version -> IO Bool
|
||||||
|
cabalInstalled ver = do
|
||||||
|
cabalbin <- (</> ([rel|cabal|] :: Path Rel)) <$> ghcupBinDir
|
||||||
|
mc <- executeOut cabalbin [[s|--numeric-version|]] Nothing
|
||||||
|
let reportedVer = fst . B.spanEnd (== _lf) . _stdOut $ mc
|
||||||
|
pure (reportedVer == (E.encodeUtf8 $ prettyVer ver))
|
||||||
|
|
||||||
|
|
||||||
|
-- | We assume GHC is in semver format. I hope it is.
|
||||||
|
getGHCMajor :: MonadThrow m => Version -> m Text
|
||||||
|
getGHCMajor ver = do
|
||||||
|
semv <- case semver $ prettyVer ver of
|
||||||
|
Right v -> pure v
|
||||||
|
Left e -> throwM e
|
||||||
|
pure $ T.pack (show (_svMajor semv)) <> T.pack "." <> T.pack
|
||||||
|
(show (_svMinor semv))
|
||||||
|
|
||||||
|
|
||||||
urlBaseName :: MonadThrow m
|
urlBaseName :: MonadThrow m
|
||||||
=> ByteString -- ^ the url path (without scheme and host)
|
=> ByteString -- ^ the url path (without scheme and host)
|
||||||
@ -637,9 +785,7 @@ unpackToTmpDir :: (MonadLogger m, MonadIO m, MonadThrow m)
|
|||||||
-> Excepts '[ArchiveError] m (Path Abs)
|
-> Excepts '[ArchiveError] m (Path Abs)
|
||||||
unpackToTmpDir av = do
|
unpackToTmpDir av = do
|
||||||
lift $ $(logInfo) ([s|Unpacking: |] <> E.decodeUtf8 (toFilePath av))
|
lift $ $(logInfo) ([s|Unpacking: |] <> E.decodeUtf8 (toFilePath av))
|
||||||
fn <- basename av
|
fn <- toFilePath <$> basename av
|
||||||
let (fnrest, ext) = splitExtension $ toFilePath fn
|
|
||||||
let ext2 = takeExtension fnrest
|
|
||||||
tmpdir <- liftIO $ getEnvDefault [s|TMPDIR|] [s|/tmp|]
|
tmpdir <- liftIO $ getEnvDefault [s|TMPDIR|] [s|/tmp|]
|
||||||
tmp <- liftIO $ mkdtemp $ (tmpdir FP.</> [s|ghcup-|])
|
tmp <- liftIO $ mkdtemp $ (tmpdir FP.</> [s|ghcup-|])
|
||||||
let untar bs = do
|
let untar bs = do
|
||||||
@ -648,13 +794,13 @@ unpackToTmpDir av = do
|
|||||||
|
|
||||||
-- extract, depending on file extension
|
-- extract, depending on file extension
|
||||||
if
|
if
|
||||||
| ext == [s|.gz|], ext2 == [s|.tar|] -> liftIO
|
| [s|.tar.gz|] `B.isSuffixOf` fn -> liftIO
|
||||||
(untar . GZip.decompress =<< readFile av)
|
(untar . GZip.decompress =<< readFile av)
|
||||||
| ext == [s|.xz|], ext2 == [s|.tar|] -> do
|
| [s|.tar.xz|] `B.isSuffixOf` fn -> do
|
||||||
filecontents <- liftIO $ readFile av
|
filecontents <- liftIO $ readFile av
|
||||||
let decompressed = Lzma.decompress filecontents
|
let decompressed = Lzma.decompress filecontents
|
||||||
liftIO $ untar decompressed
|
liftIO $ untar decompressed
|
||||||
| ext == [s|.bz2|], ext2 == [s|.tar|] -> liftIO
|
| [s|.tar.bz2|] `B.isSuffixOf` fn -> liftIO
|
||||||
(untar . BZip.decompress =<< readFile av)
|
(untar . BZip.decompress =<< readFile av)
|
||||||
| ext == [s|.tar|] -> liftIO (untar =<< readFile av)
|
| [s|.tar|] `B.isSuffixOf` fn -> liftIO (untar =<< readFile av)
|
||||||
| otherwise -> throwE $ UnknownArchive ext
|
| otherwise -> throwE $ UnknownArchive fn
|
||||||
|
@ -107,13 +107,14 @@ findExecutable ex = do
|
|||||||
|
|
||||||
-- | Execute the given command and collect the stdout, stderr and the exit code.
|
-- | Execute the given command and collect the stdout, stderr and the exit code.
|
||||||
-- The command is run in a subprocess.
|
-- The command is run in a subprocess.
|
||||||
executeOut :: Path Rel -- ^ command as filename, e.g. 'ls'
|
executeOut :: Path b -- ^ command as filename, e.g. 'ls'
|
||||||
-> [ByteString] -- ^ arguments to the command
|
-> [ByteString] -- ^ arguments to the command
|
||||||
-> Maybe (Path Abs) -- ^ chdir to this path
|
-> Maybe (Path Abs) -- ^ chdir to this path
|
||||||
-> IO (Maybe CapturedProcess)
|
-> IO CapturedProcess
|
||||||
executeOut path args chdir = withRelPath path $ \fp -> captureOutStreams $ do
|
executeOut path args chdir =
|
||||||
|
captureOutStreams $ do
|
||||||
maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
|
maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
|
||||||
SPPB.executeFile fp True args Nothing
|
SPPB.executeFile (toFilePath path) True args Nothing
|
||||||
|
|
||||||
|
|
||||||
-- | Capture the stdout and stderr of the given action, which
|
-- | Capture the stdout and stderr of the given action, which
|
||||||
@ -121,7 +122,7 @@ executeOut path args chdir = withRelPath path $ \fp -> captureOutStreams $ do
|
|||||||
-- 'race' this to make sure it terminates.
|
-- 'race' this to make sure it terminates.
|
||||||
captureOutStreams :: IO a
|
captureOutStreams :: IO a
|
||||||
-- ^ the action to execute in a subprocess
|
-- ^ the action to execute in a subprocess
|
||||||
-> IO (Maybe CapturedProcess) -- TODO: shouldn't be maybe
|
-> IO CapturedProcess
|
||||||
captureOutStreams action =
|
captureOutStreams action =
|
||||||
actionWithPipes $ \(parentStdoutRead, childStdoutWrite) ->
|
actionWithPipes $ \(parentStdoutRead, childStdoutWrite) ->
|
||||||
actionWithPipes $ \(parentStderrRead, childStderrWrite) -> do
|
actionWithPipes $ \(parentStderrRead, childStderrWrite) -> do
|
||||||
@ -148,14 +149,11 @@ captureOutStreams action =
|
|||||||
Just (SPPB.Exited es) -> do
|
Just (SPPB.Exited es) -> do
|
||||||
stdout' <- L.toStrict <$> readFd parentStdoutRead
|
stdout' <- L.toStrict <$> readFd parentStdoutRead
|
||||||
stderr' <- L.toStrict <$> readFd parentStderrRead
|
stderr' <- L.toStrict <$> readFd parentStderrRead
|
||||||
pure $ Just $ CapturedProcess { _exitCode = es
|
pure $ CapturedProcess { _exitCode = es
|
||||||
, _stdOut = stdout'
|
, _stdOut = stdout'
|
||||||
, _stdErr = stderr'
|
, _stdErr = stderr'
|
||||||
}
|
}
|
||||||
_ -> do
|
_ -> throwIO $ userError $ ("No such PID " ++ show pid)
|
||||||
closeFd parentStdoutRead
|
|
||||||
closeFd parentStderrRead
|
|
||||||
pure $ Nothing
|
|
||||||
|
|
||||||
where
|
where
|
||||||
actionWithPipes a =
|
actionWithPipes a =
|
||||||
|
@ -6,6 +6,10 @@
|
|||||||
{-# LANGUAGE DeriveLift #-}
|
{-# LANGUAGE DeriveLift #-}
|
||||||
{-# LANGUAGE StandaloneDeriving #-}
|
{-# LANGUAGE StandaloneDeriving #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
|
||||||
module GHCup.Prelude where
|
module GHCup.Prelude where
|
||||||
|
|
||||||
@ -13,7 +17,7 @@ import Control.Applicative
|
|||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.Trans.Class ( lift )
|
import Control.Monad.Trans.Class ( lift )
|
||||||
import Control.Exception.Safe
|
import Control.Exception.Safe
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString ( ByteString )
|
||||||
import qualified Data.Strict.Maybe as S
|
import qualified Data.Strict.Maybe as S
|
||||||
import Data.Monoid ( (<>) )
|
import Data.Monoid ( (<>) )
|
||||||
import Data.String
|
import Data.String
|
||||||
@ -26,9 +30,11 @@ import qualified Data.ByteString.Lazy as L
|
|||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
import Language.Haskell.TH
|
import Language.Haskell.TH
|
||||||
import Language.Haskell.TH.Syntax (Exp(..), Lift)
|
import Language.Haskell.TH.Syntax ( Exp(..)
|
||||||
|
, Lift
|
||||||
|
)
|
||||||
import qualified Language.Haskell.TH.Syntax as TH
|
import qualified Language.Haskell.TH.Syntax as TH
|
||||||
import Language.Haskell.TH.Quote (QuasiQuoter(..))
|
import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
|
||||||
import GHC.Base
|
import GHC.Base
|
||||||
|
|
||||||
|
|
||||||
@ -114,6 +120,15 @@ lEM em = lift em >>= lE
|
|||||||
fromEither :: Either a b -> VEither '[a] b
|
fromEither :: Either a b -> VEither '[a] b
|
||||||
fromEither = either (VLeft . V) VRight
|
fromEither = either (VLeft . V) VRight
|
||||||
|
|
||||||
|
hideExcept :: forall e es es' a m
|
||||||
|
. (Monad m, e :< es, LiftVariant (Remove e es) es')
|
||||||
|
=> e
|
||||||
|
-> a
|
||||||
|
-> Excepts es m a
|
||||||
|
-> Excepts es' m a
|
||||||
|
hideExcept h a action =
|
||||||
|
catchLiftLeft ((\(x@e) -> pure a) :: (e -> Excepts es' m a)) action
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
deriving instance Lift Versioning
|
deriving instance Lift Versioning
|
||||||
@ -127,15 +142,14 @@ deriving instance Lift VUnit
|
|||||||
instance Lift Text
|
instance Lift Text
|
||||||
|
|
||||||
qq :: (Text -> Q Exp) -> QuasiQuoter
|
qq :: (Text -> Q Exp) -> QuasiQuoter
|
||||||
qq quoteExp' =
|
qq quoteExp' = QuasiQuoter
|
||||||
QuasiQuoter
|
|
||||||
{ quoteExp = (\s -> quoteExp' . T.pack $ s)
|
{ quoteExp = (\s -> quoteExp' . T.pack $ s)
|
||||||
, quotePat = \_ ->
|
, quotePat = \_ ->
|
||||||
fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"
|
fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"
|
||||||
, quoteType = \_ ->
|
, quoteType = \_ ->
|
||||||
fail "illegal QuasiQuote (allowed as expression only, used as a type)"
|
fail "illegal QuasiQuote (allowed as expression only, used as a type)"
|
||||||
, quoteDec = \_ ->
|
, quoteDec = \_ -> fail
|
||||||
fail "illegal QuasiQuote (allowed as expression only, used as a declaration)"
|
"illegal QuasiQuote (allowed as expression only, used as a declaration)"
|
||||||
}
|
}
|
||||||
|
|
||||||
ver :: QuasiQuoter
|
ver :: QuasiQuoter
|
||||||
@ -167,4 +181,3 @@ pver = qq mkV
|
|||||||
where
|
where
|
||||||
mkV :: Text -> Q Exp
|
mkV :: Text -> Q Exp
|
||||||
mkV = either (fail . show) TH.lift . pvp
|
mkV = either (fail . show) TH.lift . pvp
|
||||||
|
|
||||||
|
@ -9,28 +9,37 @@ import Data.Versions
|
|||||||
import URI.ByteString
|
import URI.ByteString
|
||||||
|
|
||||||
|
|
||||||
|
data SetGHC = SetGHCOnly -- ^ unversioned 'ghc'
|
||||||
|
| SetGHCMajor -- ^ ghc-x.y
|
||||||
|
| SetGHCMinor -- ^ ghc-x.y.z
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
|
||||||
data Tag = Latest
|
data Tag = Latest
|
||||||
| Recommended
|
| Recommended
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
data VersionInfo = VersionInfo {
|
data VersionInfo = VersionInfo
|
||||||
_viTags :: [Tag]
|
{ _viTags :: [Tag]
|
||||||
, _viArch :: ArchitectureSpec
|
, _viArch :: ArchitectureSpec
|
||||||
} deriving (Eq, Show)
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
data DownloadInfo = DownloadInfo {
|
data DownloadInfo = DownloadInfo
|
||||||
_dlUri :: URI
|
{ _dlUri :: URI
|
||||||
, _dlSubdir :: Maybe (Path Rel)
|
, _dlSubdir :: Maybe (Path Rel)
|
||||||
} deriving (Eq, Show)
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
data Tool = GHC
|
data Tool = GHC
|
||||||
| Cabal
|
| Cabal
|
||||||
deriving (Eq, GHC.Generic, Ord, Show)
|
deriving (Eq, GHC.Generic, Ord, Show)
|
||||||
|
|
||||||
data ToolRequest = ToolRequest {
|
data ToolRequest = ToolRequest
|
||||||
_tool :: Tool
|
{ _tool :: Tool
|
||||||
, _toolVersion :: Version
|
, _toolVersion :: Version
|
||||||
} deriving (Eq, Show)
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
data Architecture = A_64
|
data Architecture = A_64
|
||||||
| A_32
|
| A_32
|
||||||
@ -58,16 +67,18 @@ data Platform = Linux LinuxDistro
|
|||||||
| FreeBSD
|
| FreeBSD
|
||||||
deriving (Eq, GHC.Generic, Ord, Show)
|
deriving (Eq, GHC.Generic, Ord, Show)
|
||||||
|
|
||||||
data PlatformResult = PlatformResult {
|
data PlatformResult = PlatformResult
|
||||||
_platform :: Platform
|
{ _platform :: Platform
|
||||||
, _distroVersion :: Maybe Versioning
|
, _distroVersion :: Maybe Versioning
|
||||||
} deriving (Eq, Show)
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
data PlatformRequest = PlatformRequest {
|
data PlatformRequest = PlatformRequest
|
||||||
_rArch :: Architecture
|
{ _rArch :: Architecture
|
||||||
, _rPlatform :: Platform
|
, _rPlatform :: Platform
|
||||||
, _rVersion :: Maybe Versioning
|
, _rVersion :: Maybe Versioning
|
||||||
} deriving (Eq, Show)
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
type PlatformVersionSpec = Map (Maybe Versioning) DownloadInfo
|
type PlatformVersionSpec = Map (Maybe Versioning) DownloadInfo
|
||||||
type PlatformSpec = Map Platform PlatformVersionSpec
|
type PlatformSpec = Map Platform PlatformVersionSpec
|
||||||
|
Loading…
Reference in New Issue
Block a user