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

Add dlOutput to DownloadInfo

Browse Source
This commit is contained in:
Julian Ospald 2023-05-14 19:33:04 +08:00
parent 42bf21c86e
commit 210816769a
No known key found for this signature in database
GPG Key ID: CCC85C0E40C06A8C
6 changed files with 2999 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
app/ghcup/GHCup/OptParse/Install.hs
View File

@ -335,7 +335,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
runInstGHC s'{ settings = settings {noVerify = True}} $ do runInstGHC s'{ settings = settings {noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion instVer GHC (v, vi) <- liftE $ fromVersion instVer GHC
liftE $ runBothE' (installGHCBindist liftE $ runBothE' (installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing) (DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing)
(_tvVersion v) (_tvVersion v)
(maybe GHCupInternal IsolateDir isolateDir) (maybe GHCupInternal IsolateDir isolateDir)
forceInstall forceInstall
@ -405,7 +405,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
runInstTool s'{ settings = settings { noVerify = True}} $ do runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
liftE $ runBothE' (installCabalBindist liftE $ runBothE' (installCabalBindist
(DownloadInfo uri Nothing "" Nothing) (DownloadInfo uri Nothing "" Nothing Nothing)
v v
(maybe GHCupInternal IsolateDir isolateDir) (maybe GHCupInternal IsolateDir isolateDir)
forceInstall forceInstall
@ -455,7 +455,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
-- TODO: support legacy -- TODO: support legacy
liftE $ runBothE' (installHLSBindist liftE $ runBothE' (installHLSBindist
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing) (DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing)
v v
(maybe GHCupInternal IsolateDir isolateDir) (maybe GHCupInternal IsolateDir isolateDir)
forceInstall forceInstall
@ -504,7 +504,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
runInstTool s'{ settings = settings { noVerify = True}} $ do runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
liftE $ runBothE' (installStackBindist liftE $ runBothE' (installStackBindist
(DownloadInfo uri Nothing "" Nothing) (DownloadInfo uri Nothing "" Nothing Nothing)
v v
(maybe GHCupInternal IsolateDir isolateDir) (maybe GHCupInternal IsolateDir isolateDir)
forceInstall forceInstall

2
app/ghcup/GHCup/OptParse/Test.hs
View File

@ -174,7 +174,7 @@ test testCommand settings getAppState' runLogger = case testCommand of
Just uri -> do Just uri -> do
runTestGHC s'{ settings = settings {noVerify = True}} $ do runTestGHC s'{ settings = settings {noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion testVer GHC (v, vi) <- liftE $ fromVersion testVer GHC
liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing) (_tvVersion v) addMakeArgs liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing Nothing) (_tvVersion v) addMakeArgs
pure vi pure vi
) )
>>= \case >>= \case

10
lib/GHCup/Download.hs
View File

@ -633,7 +633,9 @@ downloadCached dli mfn = do
True -> downloadCached' dli mfn Nothing True -> downloadCached' dli mfn Nothing
False -> do False -> do
tmp <- lift withGHCupTmpDir tmp <- lift withGHCupTmpDir
liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) mfn False liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) outputFileName False
where
outputFileName = mfn <|> _dlOutput dli
downloadCached' :: ( MonadReader env m downloadCached' :: ( MonadReader env m
@ -652,7 +654,7 @@ downloadCached' :: ( MonadReader env m
downloadCached' dli mfn mDestDir = do downloadCached' dli mfn mDestDir = do
Dirs { cacheDir } <- lift getDirs Dirs { cacheDir } <- lift getDirs
let destDir = fromMaybe (fromGHCupPath cacheDir) mDestDir let destDir = fromMaybe (fromGHCupPath cacheDir) mDestDir
let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) mfn let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) outputFileName
let cachfile = destDir </> fn let cachfile = destDir </> fn
fileExists <- liftIO $ doesFileExist cachfile fileExists <- liftIO $ doesFileExist cachfile
if if
@ -660,7 +662,9 @@ downloadCached' dli mfn mDestDir = do
forM_ (view dlCSize dli) $ \s -> liftE $ checkCSize s cachfile forM_ (view dlCSize dli) $ \s -> liftE $ checkCSize s cachfile
liftE $ checkDigest (view dlHash dli) cachfile liftE $ checkDigest (view dlHash dli) cachfile
pure cachfile pure cachfile
| otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir mfn False | otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir outputFileName False
where
outputFileName = mfn <|> _dlOutput dli

1
lib/GHCup/Types.hs
View File

@ -275,6 +275,7 @@ data DownloadInfo = DownloadInfo
, _dlSubdir :: Maybe TarDir , _dlSubdir :: Maybe TarDir
, _dlHash :: Text , _dlHash :: Text
, _dlCSize :: Maybe Integer , _dlCSize :: Maybe Integer
, _dlOutput :: Maybe FilePath
} }
deriving (Eq, Ord, GHC.Generic, Show) deriving (Eq, Ord, GHC.Generic, Show)

1410
test/golden/unix/GHCupInfo.json
View File

File diff suppressed because it is too large Load Diff

1576
test/golden/windows/GHCupInfo.json
View File

File diff suppressed because it is too large Load Diff