This commit is contained in:
rodič
f6efca778a
revize
8e533e2465
1
TODO.md
1
TODO.md
|
|
@ -6,6 +6,7 @@
|
|||
* mirror support
|
||||
* checksums
|
||||
* check for new version on start
|
||||
* tarball tags as well as version tags?
|
||||
|
||||
* --copy-compiler-tools
|
||||
* installing multiple versions in parallel?
|
||||
|
|
|
|||
|
|
@ -1,5 +1,7 @@
|
|||
packages: ./ghcup.cabal
|
||||
|
||||
with-compiler: ghc-8.6.5
|
||||
|
||||
optimization: 2
|
||||
|
||||
package streamly
|
||||
|
|
@ -7,3 +9,8 @@ package streamly
|
|||
|
||||
package ghcup
|
||||
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/composewell/streamly
|
||||
tag: b8178cd08f7fc8180e4de83bde4b239cb0cfb31c
|
||||
|
|
|
|||
|
|
@ -40,6 +40,7 @@ common parsec { build-depends: parsec >= 3.1 }
|
|||
common safe-exceptions { build-depends: safe-exceptions >= 0.1 }
|
||||
common streamly { build-depends: streamly >= 0.7 }
|
||||
common strict-base { build-depends: strict-base >= 0.4 }
|
||||
common tar-bytestring { build-depends: tar-bytestring >= 0.6.1 }
|
||||
common template-haskell { build-depends: template-haskell >= 2.7 }
|
||||
common text { build-depends: text >= 1.2 }
|
||||
common text-icu { build-depends: text-icu >= 0.7 }
|
||||
|
|
@ -88,6 +89,7 @@ library
|
|||
, safe-exceptions
|
||||
, streamly
|
||||
, strict-base
|
||||
, tar-bytestring
|
||||
, template-haskell
|
||||
, text
|
||||
, text-icu
|
||||
|
|
|
|||
25
lib/GHCup.hs
25
lib/GHCup.hs
|
|
@ -191,6 +191,7 @@ getLinuxDistro = do
|
|||
| hasWord name ["exherbo"] -> Exherbo
|
||||
| hasWord name ["gentoo"] -> Gentoo
|
||||
| otherwise -> UnknownLinux
|
||||
recreateSymlink undefined undefined Overwrite
|
||||
pure (distro, parsedVer)
|
||||
where
|
||||
hasWord t matches = foldr
|
||||
|
|
@ -208,8 +209,8 @@ getLinuxDistro = do
|
|||
os_release = [abs|/etc/os-release|]
|
||||
lsb_release :: Path Abs
|
||||
lsb_release = [abs|/etc/lsb-release|]
|
||||
lsb_release_cmd :: Path Fn
|
||||
lsb_release_cmd = [fn|lsb-release|]
|
||||
lsb_release_cmd :: Path Rel
|
||||
lsb_release_cmd = [rel|lsb-release|]
|
||||
redhat_release :: Path Abs
|
||||
redhat_release = [abs|/etc/redhat-release|]
|
||||
debian_version :: Path Abs
|
||||
|
|
@ -269,12 +270,12 @@ getLinuxDistro = do
|
|||
-- 2. otherwise create a random file
|
||||
--
|
||||
-- The file must not exist.
|
||||
download :: Bool -- ^ https?
|
||||
-> String -- ^ host (e.g. "www.example.com")
|
||||
-> String -- ^ path (e.g. "/my/file")
|
||||
-> Maybe Integer -- ^ optional port (e.g. 3000)
|
||||
-> Path Abs -- ^ destination directory to download into
|
||||
-> Maybe (Path Fn) -- ^ optionally provided filename
|
||||
download :: Bool -- ^ https?
|
||||
-> String -- ^ host (e.g. "www.example.com")
|
||||
-> String -- ^ path (e.g. "/my/file")
|
||||
-> Maybe Integer -- ^ optional port (e.g. 3000)
|
||||
-> Path Abs -- ^ destination directory to download into
|
||||
-> Maybe (Path Rel) -- ^ optionally provided filename
|
||||
-> IO (Path Abs)
|
||||
download https host path port dest mfn = do
|
||||
fromJust <$> downloadInternal https host path port (Right (dest, mfn))
|
||||
|
|
@ -283,7 +284,7 @@ download https host path port dest mfn = do
|
|||
-- throw an exception if the url type or host protocol is not supported.
|
||||
--
|
||||
-- Only Absolute HTTP/HTTPS is supported.
|
||||
download' :: URL -> Path Abs -> Maybe (Path Fn) -> IO (Path Abs)
|
||||
download' :: URL -> Path Abs -> Maybe (Path Rel) -> IO (Path Abs)
|
||||
download' url dest mfn = case url of
|
||||
URL { url_type = Absolute (Host { protocol = HTTP https, host = host, port = port }), url_path = path, url_params = [] }
|
||||
-> download https host path port dest mfn
|
||||
|
|
@ -306,7 +307,7 @@ downloadInternal :: Bool
|
|||
-> String
|
||||
-> String
|
||||
-> Maybe Integer
|
||||
-> Either Fd (Path Abs, Maybe (Path Fn))
|
||||
-> Either Fd (Path Abs, Maybe (Path Rel))
|
||||
-> IO (Maybe (Path Abs))
|
||||
downloadInternal https host path port dest = do
|
||||
c <- case https of
|
||||
|
|
@ -345,7 +346,7 @@ downloadInternal https host path port dest = do
|
|||
|
||||
where
|
||||
-- Manage to find a file we can write the body into.
|
||||
getFile :: Path Abs -> Maybe (Path Fn) -> IO (Fd, Path Abs)
|
||||
getFile :: Path Abs -> Maybe (Path Rel) -> IO (Fd, Path Abs)
|
||||
getFile dest mfn = do
|
||||
-- destination dir must exist
|
||||
hideError AlreadyExists $ createDirRecursive newDirPerms dest
|
||||
|
|
@ -358,7 +359,7 @@ downloadInternal https host path port dest = do
|
|||
-- ...otherwise try to infer the filename from the URL path
|
||||
case (snd . T.breakOnEnd (fS "/") . T.pack) <$> decString False path of
|
||||
Just x -> do
|
||||
fn' <- parseFn (C.pack $ T.unpack x)
|
||||
fn' <- parseRel (C.pack $ T.unpack x)
|
||||
let fp = dest </> fn'
|
||||
fmap (, fp) $ createRegularFileFd newFilePerms fp
|
||||
Nothing -> do
|
||||
|
|
|
|||
|
|
@ -49,24 +49,11 @@ data CapturedProcess = CapturedProcess {
|
|||
makeLenses ''CapturedProcess
|
||||
|
||||
|
||||
-- |Checks whether a file is executable. Follows symlinks.
|
||||
--
|
||||
-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False).
|
||||
--
|
||||
-- Throws:
|
||||
--
|
||||
-- - `NoSuchThing` if the file does not exist
|
||||
--
|
||||
-- Note: calls `access`
|
||||
isExecutable :: Path b -> IO Bool
|
||||
isExecutable p = fileAccess (toFilePath p) False False True
|
||||
|
||||
|
||||
readFd :: Fd -> IO L.ByteString
|
||||
readFd fd = do
|
||||
handle' <- fdToHandle fd
|
||||
let stream =
|
||||
(S.unfold (SU.finally hClose FH.readChunks) handle')
|
||||
(S.unfold (SU.finallyIO hClose FH.readChunks) handle')
|
||||
>>= arrayToByteString
|
||||
toLazyByteString <$> S.fold FL.mconcat (fmap byteString stream)
|
||||
|
||||
|
|
@ -89,7 +76,7 @@ readFileLines p = do
|
|||
--
|
||||
-- This shouldn't throw IO exceptions, unless getting the environment variable
|
||||
-- PATH does.
|
||||
findExecutable :: RelC r => Path r -> IO (Maybe (Path Abs))
|
||||
findExecutable :: Path Rel -> IO (Maybe (Path Abs))
|
||||
findExecutable ex = do
|
||||
sPaths <- fmap catMaybes . (fmap . fmap) parseAbs $ getSearchPath
|
||||
-- We don't want exceptions to mess up our result. If we can't
|
||||
|
|
@ -102,10 +89,10 @@ findExecutable ex = do
|
|||
|
||||
-- | Execute the given command and collect the stdout, stderr and the exit code.
|
||||
-- The command is run in a subprocess.
|
||||
executeOut :: Path Fn -- ^ command as filename, e.g. 'ls'
|
||||
-> [ByteString] -- ^ arguments to the command
|
||||
executeOut :: Path Rel -- ^ command as filename, e.g. 'ls'
|
||||
-> [ByteString] -- ^ arguments to the command
|
||||
-> IO (Maybe CapturedProcess)
|
||||
executeOut path args = withFnPath path
|
||||
executeOut path args = withRelPath path
|
||||
$ \fp -> captureOutStreams $ SPPB.executeFile fp True args Nothing
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -6,16 +6,7 @@ import Data.Map.Strict ( Map )
|
|||
import Network.URL
|
||||
import qualified GHC.Generics as GHC
|
||||
import Data.Versions
|
||||
import HPath
|
||||
import System.Posix.Types
|
||||
|
||||
data DownloadDestination = DPath {
|
||||
dDestDir :: Path Abs
|
||||
, dFileName :: Maybe (Path Fn)
|
||||
} |
|
||||
Fd {
|
||||
dFd :: Fd
|
||||
}
|
||||
|
||||
data Tool = GHC
|
||||
| Cabal
|
||||
|
|
|
|||
|
|
@ -0,0 +1,66 @@
|
|||
#!/usr/bin/env bash
|
||||
|
||||
set -eu
|
||||
|
||||
status_message() {
|
||||
printf "\\033[0;32m%s\\033[0m\\n" "$1"
|
||||
}
|
||||
|
||||
error_message() {
|
||||
printf "\\033[0;31m%s\\033[0m\\n" "$1"
|
||||
}
|
||||
|
||||
SCRIPTPATH="$( cd "$(dirname "$0")" ; pwd -P )"
|
||||
CACHE_LOCATION="${HOME}/.cabal/packages/hackage.haskell.org/01-index.cache"
|
||||
|
||||
if [ ! -f "${CACHE_LOCATION}" ] ; then
|
||||
error_message "${CACHE_LOCATION} does not exist, did you run 'cabal update'?"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [ ! -f "${SCRIPTPATH}/cabal.project" ] ; then
|
||||
error_message "Could not find ${SCRIPTPATH}/cabal.project, skipping index state update."
|
||||
exit 3
|
||||
fi
|
||||
|
||||
cabal v2-update
|
||||
|
||||
arch=$(getconf LONG_BIT)
|
||||
|
||||
case "${arch}" in
|
||||
32)
|
||||
byte_size=4
|
||||
magic_word="CABA1002"
|
||||
;;
|
||||
64)
|
||||
byte_size=8
|
||||
magic_word="00000000CABA1002"
|
||||
;;
|
||||
*)
|
||||
error_message "Unknown architecture (long bit): ${arch}"
|
||||
exit 2
|
||||
;;
|
||||
esac
|
||||
|
||||
# This is the logic to parse the binary format of 01-index.cache.
|
||||
# The first word is a magic 'caba1002', the second one is the timestamp in unix epoch.
|
||||
# Better than copying the cabal-install source code.
|
||||
if [ "$(xxd -u -p -l${byte_size} -s 0 "${CACHE_LOCATION}")" != "${magic_word}" ] ; then
|
||||
error_message "Magic word does not match!"
|
||||
exit 4
|
||||
fi
|
||||
cache_timestamp=$(echo "ibase=16;obase=A;$(xxd -u -p -l${byte_size} -s ${byte_size} "${CACHE_LOCATION}")" | bc)
|
||||
|
||||
# If we got junk from the binary file, this should fail.
|
||||
cache_date=$(date --utc --date "@${cache_timestamp}" "+%FT%TZ")
|
||||
|
||||
|
||||
status_message "Updating index state in ${SCRIPTPATH}/cabal.project"
|
||||
|
||||
if grep -q "^index-state: .*" "${SCRIPTPATH}/cabal.project" ; then
|
||||
awk '/index-state:/ {gsub(/.*/, "index-state: '${cache_date}'")}; { print }' "${SCRIPTPATH}/cabal.project" > "${SCRIPTPATH}/cabal.project.tmp"
|
||||
mv "${SCRIPTPATH}/cabal.project.tmp" "${SCRIPTPATH}/cabal.project"
|
||||
else
|
||||
printf "index-state: %s\n" "${cache_date}" >> "${SCRIPTPATH}/cabal.project"
|
||||
fi
|
||||
|
||||
Načítá se…
Odkázat v novém úkolu