Yooo
This commit is contained in:
parent
998f194d23
commit
12da293100
4
TODO.md
4
TODO.md
@ -2,15 +2,15 @@
|
|||||||
|
|
||||||
## New
|
## New
|
||||||
|
|
||||||
* download progress
|
* proper subcommands: ghcup install ghc
|
||||||
|
|
||||||
|
* download progress
|
||||||
* upgrade Upgrade this script in-place
|
* upgrade Upgrade this script in-place
|
||||||
* maybe: changelog Show the changelog of a GHC release (online)
|
* maybe: changelog Show the changelog of a GHC release (online)
|
||||||
* maybe: print-system-reqs Print an approximation of system requirements
|
* maybe: print-system-reqs Print an approximation of system requirements
|
||||||
|
|
||||||
* testing (especially distro detection -> unit tests)
|
* testing (especially distro detection -> unit tests)
|
||||||
|
|
||||||
* TODO: cleanup temp files after use
|
|
||||||
|
|
||||||
## Old
|
## Old
|
||||||
|
|
||||||
|
@ -16,6 +16,7 @@ import GHCup.Types
|
|||||||
|
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
|
import Control.Monad.Trans.Resource
|
||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import Data.List ( intercalate )
|
import Data.List ( intercalate )
|
||||||
@ -252,6 +253,7 @@ main = do
|
|||||||
let runInstTool =
|
let runInstTool =
|
||||||
runLogger
|
runLogger
|
||||||
. flip runReaderT settings
|
. flip runReaderT settings
|
||||||
|
. runResourceT
|
||||||
. runE
|
. runE
|
||||||
@'[ AlreadyInstalled
|
@'[ AlreadyInstalled
|
||||||
, ArchiveError
|
, ArchiveError
|
||||||
|
13
ghcup.cabal
13
ghcup.cabal
@ -23,16 +23,16 @@ source-repository head
|
|||||||
common HsOpenSSL { build-depends: HsOpenSSL >= 0.11 }
|
common HsOpenSSL { build-depends: HsOpenSSL >= 0.11 }
|
||||||
common aeson { build-depends: aeson >= 1.4 }
|
common aeson { build-depends: aeson >= 1.4 }
|
||||||
common aeson-pretty { build-depends: aeson-pretty >= 0.8.8 }
|
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 ascii-string { build-depends: ascii-string >= 1.0 }
|
||||||
common async { build-depends: async >= 0.8 }
|
common async { build-depends: async >= 0.8 }
|
||||||
|
common attoparsec { build-depends: attoparsec >= 0.13 }
|
||||||
common base { build-depends: base >= 4.12 && < 5 }
|
common base { build-depends: base >= 4.12 && < 5 }
|
||||||
common bytestring { build-depends: bytestring >= 0.10 }
|
common bytestring { build-depends: bytestring >= 0.10 }
|
||||||
common bzlib { build-depends: bzlib >= 0.5.0.5 }
|
common bzlib { build-depends: bzlib >= 0.5.0.5 }
|
||||||
common containers { build-depends: containers >= 0.6 }
|
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-types { build-depends: haskus-utils-types >= 1.5 }
|
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 { build-depends: hpath >= 0.11 }
|
||||||
common hpath-directory { build-depends: hpath-directory >= 0.13.2 }
|
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 }
|
||||||
@ -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 optparse-applicative { build-depends: optparse-applicative >= 0.15.1.0 }
|
||||||
common parsec { build-depends: parsec >= 3.1 }
|
common parsec { build-depends: parsec >= 3.1 }
|
||||||
common pretty-terminal { build-depends: pretty-terminal >= 0.1.0.0 }
|
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 { build-depends: safe >= 0.3.18 }
|
||||||
common safe-exceptions { build-depends: safe-exceptions >= 0.1 }
|
common safe-exceptions { build-depends: safe-exceptions >= 0.1 }
|
||||||
common streamly { build-depends: streamly >= 0.7 }
|
common streamly { build-depends: streamly >= 0.7 }
|
||||||
common streamly-bytestring { build-depends: streamly-bytestring >= 0.1.2 }
|
common streamly-bytestring { build-depends: streamly-bytestring >= 0.1.2 }
|
||||||
common strict-base { build-depends: strict-base >= 0.4 }
|
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-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 table-layout { build-depends: table-layout >= 0.8 }
|
||||||
common tar-bytestring { build-depends: tar-bytestring >= 0.6.2.0 }
|
common tar-bytestring { build-depends: tar-bytestring >= 0.6.2.0 }
|
||||||
common template-haskell { build-depends: template-haskell >= 2.7 }
|
common template-haskell { build-depends: template-haskell >= 2.7 }
|
||||||
@ -98,8 +99,8 @@ library
|
|||||||
, bzlib
|
, bzlib
|
||||||
, containers
|
, containers
|
||||||
, generics-sop
|
, generics-sop
|
||||||
, haskus-utils-variant
|
|
||||||
, haskus-utils-types
|
, haskus-utils-types
|
||||||
|
, haskus-utils-variant
|
||||||
, hpath
|
, hpath
|
||||||
, hpath-directory
|
, hpath-directory
|
||||||
, hpath-filepath
|
, hpath-filepath
|
||||||
@ -115,13 +116,14 @@ library
|
|||||||
, optics-vl
|
, optics-vl
|
||||||
, parsec
|
, parsec
|
||||||
, pretty-terminal
|
, pretty-terminal
|
||||||
|
, resourcet
|
||||||
, safe
|
, safe
|
||||||
, safe-exceptions
|
, safe-exceptions
|
||||||
, streamly
|
, streamly
|
||||||
, streamly-bytestring
|
, streamly-bytestring
|
||||||
, strict-base
|
, strict-base
|
||||||
, string-qq
|
|
||||||
, string-interpolate
|
, string-interpolate
|
||||||
|
, string-qq
|
||||||
, tar-bytestring
|
, tar-bytestring
|
||||||
, template-haskell
|
, template-haskell
|
||||||
, text
|
, text
|
||||||
@ -161,6 +163,7 @@ executable ghcup
|
|||||||
, versions
|
, versions
|
||||||
, hpath
|
, hpath
|
||||||
, pretty-terminal
|
, pretty-terminal
|
||||||
|
, resourcet
|
||||||
, string-qq
|
, string-qq
|
||||||
, string-interpolate
|
, string-interpolate
|
||||||
, table-layout
|
, table-layout
|
||||||
|
20
lib/GHCup.hs
20
lib/GHCup.hs
@ -26,6 +26,8 @@ import Control.Monad.Fail ( MonadFail )
|
|||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.Trans.Class ( lift )
|
import Control.Monad.Trans.Class ( lift )
|
||||||
|
import Control.Monad.Trans.Resource
|
||||||
|
hiding ( throwM )
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.Attoparsec.ByteString
|
import Data.Attoparsec.ByteString
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
@ -51,9 +53,7 @@ import Prelude hiding ( abs
|
|||||||
import Safe
|
import Safe
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
import System.Info
|
import System.Info
|
||||||
import System.Posix.Env.ByteString ( getEnvDefault
|
import System.Posix.Env.ByteString ( getEnv )
|
||||||
, getEnv
|
|
||||||
)
|
|
||||||
import System.Posix.FilePath ( takeFileName )
|
import System.Posix.FilePath ( takeFileName )
|
||||||
import System.Posix.Files.ByteString ( readSymbolicLink )
|
import System.Posix.Files.ByteString ( readSymbolicLink )
|
||||||
import "unix" System.Posix.IO.ByteString
|
import "unix" System.Posix.IO.ByteString
|
||||||
@ -62,7 +62,6 @@ import "unix-bytestring" System.Posix.IO.ByteString
|
|||||||
( fdWrite )
|
( fdWrite )
|
||||||
import System.Posix.RawFilePath.Directory.Errors
|
import System.Posix.RawFilePath.Directory.Errors
|
||||||
( hideError )
|
( hideError )
|
||||||
import System.Posix.Temp.ByteString
|
|
||||||
import System.Posix.Types
|
import System.Posix.Types
|
||||||
import URI.ByteString
|
import URI.ByteString
|
||||||
import URI.ByteString.QQ
|
import URI.ByteString.QQ
|
||||||
@ -553,7 +552,8 @@ installTool :: ( MonadThrow m
|
|||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
, MonadResource m
|
||||||
|
) -- tmp file
|
||||||
=> ToolRequest
|
=> ToolRequest
|
||||||
-> Maybe PlatformRequest -- ^ if Nothing, looks up current host platform
|
-> Maybe PlatformRequest -- ^ if Nothing, looks up current host platform
|
||||||
-> Excepts
|
-> Excepts
|
||||||
@ -591,7 +591,7 @@ installTool treq mpfReq = do
|
|||||||
| fileExists -> pure $ cachfile
|
| fileExists -> pure $ cachfile
|
||||||
| otherwise -> liftE $ download dlinfo cachedir Nothing
|
| otherwise -> liftE $ download dlinfo cachedir Nothing
|
||||||
False -> do
|
False -> do
|
||||||
tmp <- liftIO mkGhcupTmpDir
|
tmp <- lift withGHCupTmpDir
|
||||||
liftE $ download dlinfo tmp Nothing
|
liftE $ download dlinfo tmp Nothing
|
||||||
|
|
||||||
-- unpack
|
-- unpack
|
||||||
@ -821,7 +821,7 @@ rmGHCVer ver = do
|
|||||||
lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|]
|
lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|]
|
||||||
liftIO $ rmMinorSymlinks
|
liftIO $ rmMinorSymlinks
|
||||||
|
|
||||||
lift $ $(logInfo) [i|Removing ghc-x.y symlinks|]
|
lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|]
|
||||||
liftE fixMajorSymlinks
|
liftE fixMajorSymlinks
|
||||||
|
|
||||||
when isSetGHC $ liftE $ do
|
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.
|
-- | 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
|
=> Path Abs -- ^ archive path
|
||||||
-> Excepts '[ArchiveError] m (Path Abs)
|
-> Excepts '[ArchiveError] m (Path Abs)
|
||||||
unpackToTmpDir av = do
|
unpackToTmpDir av = do
|
||||||
let fp = E.decodeUtf8 (toFilePath av)
|
let fp = E.decodeUtf8 (toFilePath av)
|
||||||
lift $ $(logInfo) [i|Unpacking: #{fp}|]
|
lift $ $(logInfo) [i|Unpacking: #{fp}|]
|
||||||
fn <- toFilePath <$> basename av
|
fn <- toFilePath <$> basename av
|
||||||
tmpdir <- liftIO $ getEnvDefault [s|TMPDIR|] [s|/tmp|]
|
tmp <- toFilePath <$> lift withGHCupTmpDir
|
||||||
tmp <- liftIO $ mkdtemp $ (tmpdir FP.</> [s|ghcup-|])
|
|
||||||
let untar bs = do
|
let untar bs = do
|
||||||
Tar.unpack tmp . Tar.read $ bs
|
Tar.unpack tmp . Tar.read $ bs
|
||||||
parseAbs tmp
|
parseAbs tmp
|
||||||
|
@ -5,6 +5,8 @@ module GHCup.File where
|
|||||||
|
|
||||||
import Control.Exception.Safe
|
import Control.Exception.Safe
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
import Control.Monad.Trans.Resource
|
||||||
import Data.ByteString
|
import Data.ByteString
|
||||||
import Data.ByteString.Unsafe ( unsafeUseAsCStringLen )
|
import Data.ByteString.Unsafe ( unsafeUseAsCStringLen )
|
||||||
import Data.Char
|
import Data.Char
|
||||||
@ -186,13 +188,19 @@ toProcessError exe args mps = case mps of
|
|||||||
Nothing -> Left $ NoSuchPid exe args
|
Nothing -> Left $ NoSuchPid exe args
|
||||||
|
|
||||||
|
|
||||||
mkGhcupTmpDir :: IO (Path Abs)
|
mkGhcupTmpDir :: (MonadThrow m, MonadIO m) => m (Path Abs)
|
||||||
mkGhcupTmpDir = do
|
mkGhcupTmpDir = do
|
||||||
tmpdir <- getEnvDefault [s|TMPDIR|] [s|/tmp|]
|
tmpdir <- liftIO $ getEnvDefault [s|TMPDIR|] [s|/tmp|]
|
||||||
tmp <- mkdtemp $ (tmpdir FP.</> [s|ghcup-|])
|
tmp <- liftIO $ mkdtemp $ (tmpdir FP.</> [s|ghcup-|])
|
||||||
|
liftIO $ System.IO.putStrLn $ show tmp
|
||||||
parseAbs tmp
|
parseAbs tmp
|
||||||
|
|
||||||
|
|
||||||
|
withGHCupTmpDir :: (MonadResource m, MonadThrow m, MonadIO m)
|
||||||
|
=> m (Path Abs)
|
||||||
|
withGHCupTmpDir = snd <$> allocate mkGhcupTmpDir deleteDirRecursive
|
||||||
|
|
||||||
|
|
||||||
getHomeDirectory :: IO (Path Abs)
|
getHomeDirectory :: IO (Path Abs)
|
||||||
getHomeDirectory = do
|
getHomeDirectory = do
|
||||||
e <- getEnv [s|HOME|]
|
e <- getEnv [s|HOME|]
|
||||||
|
Loading…
Reference in New Issue
Block a user