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

Yooo

Browse Source
This commit is contained in:
Julian Ospald 2020-03-01 02:21:40 +01:00
parent 998f194d23
commit 12da293100
5 changed files with 34 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
TODO.md
View File

@ -2,15 +2,15 @@
## New
* download progress
* proper subcommands: ghcup install ghc
* download progress
* upgrade Upgrade this script in-place
* maybe: changelog Show the changelog of a GHC release (online)
* maybe: print-system-reqs Print an approximation of system requirements
* testing (especially distro detection -> unit tests)
* TODO: cleanup temp files after use
## Old

2
app/ghcup/Main.hs
View File

@ -16,6 +16,7 @@ import GHCup.Types
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Bifunctor
import Data.Char
import Data.List ( intercalate )
@ -252,6 +253,7 @@ main = do
let runInstTool =
runLogger
. flip runReaderT settings
. runResourceT
. runE
@'[ AlreadyInstalled
, ArchiveError

13
ghcup.cabal
View File

@ -23,16 +23,16 @@ source-repository head
common HsOpenSSL { build-depends: HsOpenSSL >= 0.11 }
common aeson { build-depends: aeson >= 1.4 }
common aeson-pretty { build-depends: aeson-pretty >= 0.8.8 }
common attoparsec { build-depends: attoparsec >= 0.13 }
common ascii-string { build-depends: ascii-string >= 1.0 }
common async { build-depends: async >= 0.8 }
common attoparsec { build-depends: attoparsec >= 0.13 }
common base { build-depends: base >= 4.12 && < 5 }
common bytestring { build-depends: bytestring >= 0.10 }
common bzlib { build-depends: bzlib >= 0.5.0.5 }
common containers { build-depends: containers >= 0.6 }
common generics-sop { build-depends: generics-sop >= 0.5 }
common haskus-utils-variant { build-depends: haskus-utils-variant >= 3.0 }
common haskus-utils-types { build-depends: haskus-utils-types >= 1.5 }
common haskus-utils-variant { build-depends: haskus-utils-variant >= 3.0 }
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 }
@ -49,13 +49,14 @@ common optics-vl { build-depends: optics-vl >= 0.2 }
common optparse-applicative { build-depends: optparse-applicative >= 0.15.1.0 }
common parsec { build-depends: parsec >= 3.1 }
common pretty-terminal { build-depends: pretty-terminal >= 0.1.0.0 }
common resourcet { build-depends: resourcet >= 1.2.2 }
common safe { build-depends: safe >= 0.3.18 }
common safe-exceptions { build-depends: safe-exceptions >= 0.1 }
common streamly { build-depends: streamly >= 0.7 }
common streamly-bytestring { build-depends: streamly-bytestring >= 0.1.2 }
common strict-base { build-depends: strict-base >= 0.4 }
common string-qq { build-depends: string-qq >= 0.0.4 }
common string-interpolate { build-depends: string-interpolate >= 0.2.0.0 }
common string-qq { build-depends: string-qq >= 0.0.4 }
common table-layout { build-depends: table-layout >= 0.8 }
common tar-bytestring { build-depends: tar-bytestring >= 0.6.2.0 }
common template-haskell { build-depends: template-haskell >= 2.7 }
@ -98,8 +99,8 @@ library
, bzlib
, containers
, generics-sop
, haskus-utils-variant
, haskus-utils-types
, haskus-utils-variant
, hpath
, hpath-directory
, hpath-filepath
@ -115,13 +116,14 @@ library
, optics-vl
, parsec
, pretty-terminal
, resourcet
, safe
, safe-exceptions
, streamly
, streamly-bytestring
, strict-base
, string-qq
, string-interpolate
, string-qq
, tar-bytestring
, template-haskell
, text
@ -161,6 +163,7 @@ executable ghcup
, versions
, hpath
, pretty-terminal
, resourcet
, string-qq
, string-interpolate
, table-layout

22
lib/GHCup.hs
View File

@ -26,6 +26,8 @@ import Control.Monad.Fail ( MonadFail )
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.Class ( lift )
import Control.Monad.Trans.Resource
hiding ( throwM )
import Data.Aeson
import Data.Attoparsec.ByteString
import Data.ByteString ( ByteString )
@ -51,9 +53,7 @@ import Prelude hiding ( abs
import Safe
import System.IO.Error
import System.Info
import System.Posix.Env.ByteString ( getEnvDefault
, getEnv
)
import System.Posix.Env.ByteString ( getEnv )
import System.Posix.FilePath ( takeFileName )
import System.Posix.Files.ByteString ( readSymbolicLink )
import "unix" System.Posix.IO.ByteString
@ -62,7 +62,6 @@ import "unix-bytestring" System.Posix.IO.ByteString
( fdWrite )
import System.Posix.RawFilePath.Directory.Errors
( hideError )
import System.Posix.Temp.ByteString
import System.Posix.Types
import URI.ByteString
import URI.ByteString.QQ
@ -553,7 +552,8 @@ installTool :: ( MonadThrow m
, MonadCatch m
, MonadIO m
, MonadFail m
)
, MonadResource m
) -- tmp file
=> ToolRequest
-> Maybe PlatformRequest -- ^ if Nothing, looks up current host platform
-> Excepts
@ -591,7 +591,7 @@ installTool treq mpfReq = do
| fileExists -> pure $ cachfile
| otherwise -> liftE $ download dlinfo cachedir Nothing
False -> do
tmp <- liftIO mkGhcupTmpDir
tmp <- lift withGHCupTmpDir
liftE $ download dlinfo tmp Nothing
-- unpack
@ -821,7 +821,7 @@ rmGHCVer ver = do
lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|]
liftIO $ rmMinorSymlinks
lift $ $(logInfo) [i|Removing ghc-x.y symlinks|]
lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|]
liftE fixMajorSymlinks
when isSetGHC $ liftE $ do
@ -1011,15 +1011,15 @@ urlBaseName = parseRel . snd . B.breakEnd (== _slash) . urlDecode False
-- | Unpack an archive to a temporary directory and return that path.
unpackToTmpDir :: (MonadLogger m, MonadIO m, MonadThrow m)
unpackToTmpDir :: (MonadResource m -- temp file
, MonadLogger m, MonadIO m, MonadThrow m)
=> Path Abs -- ^ archive path
-> Excepts '[ArchiveError] m (Path Abs)
unpackToTmpDir av = do
let fp = E.decodeUtf8 (toFilePath av)
lift $ $(logInfo) [i|Unpacking: #{fp}|]
fn <- toFilePath <$> basename av
tmpdir <- liftIO $ getEnvDefault [s|TMPDIR|] [s|/tmp|]
tmp <- liftIO $ mkdtemp $ (tmpdir FP.</> [s|ghcup-|])
fn <- toFilePath <$> basename av
tmp <- toFilePath <$> lift withGHCupTmpDir
let untar bs = do
Tar.unpack tmp . Tar.read $ bs
parseAbs tmp

14
lib/GHCup/File.hs
View File

@ -5,6 +5,8 @@ module GHCup.File where
import Control.Exception.Safe
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import Data.ByteString
import Data.ByteString.Unsafe ( unsafeUseAsCStringLen )
import Data.Char
@ -186,13 +188,19 @@ toProcessError exe args mps = case mps of
Nothing -> Left $ NoSuchPid exe args
mkGhcupTmpDir :: IO (Path Abs)
mkGhcupTmpDir :: (MonadThrow m, MonadIO m) => m (Path Abs)
mkGhcupTmpDir = do
tmpdir <- getEnvDefault [s|TMPDIR|] [s|/tmp|]
tmp <- mkdtemp $ (tmpdir FP.</> [s|ghcup-|])
tmpdir <- liftIO $ getEnvDefault [s|TMPDIR|] [s|/tmp|]
tmp <- liftIO $ mkdtemp $ (tmpdir FP.</> [s|ghcup-|])
liftIO $ System.IO.putStrLn $ show tmp
parseAbs tmp
withGHCupTmpDir :: (MonadResource m, MonadThrow m, MonadIO m)
=> m (Path Abs)
withGHCupTmpDir = snd <$> allocate mkGhcupTmpDir deleteDirRecursive
getHomeDirectory :: IO (Path Abs)
getHomeDirectory = do
e <- getEnv [s|HOME|]