From c5c6c431b5462f055eaa4bfe8bfb887d216c4a0a Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 12 Nov 2021 19:05:13 +0100 Subject: [PATCH] Allow remote URIs for --cabal-project-local wrt #281 --- app/ghcup/GHCup/OptParse/Common.hs | 4 ++-- app/ghcup/GHCup/OptParse/Compile.hs | 13 +++++++------ app/ghcup/GHCup/OptParse/Install.hs | 4 ++-- lib/GHCup.hs | 20 ++++++++++++++------ 4 files changed, 25 insertions(+), 16 deletions(-) diff --git a/app/ghcup/GHCup/OptParse/Common.hs b/app/ghcup/GHCup/OptParse/Common.hs index 8fd50c9..0bc9d4a 100644 --- a/app/ghcup/GHCup/OptParse/Common.hs +++ b/app/ghcup/GHCup/OptParse/Common.hs @@ -208,8 +208,8 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of ] -bindistParser :: String -> Either String URI -bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString +uriParser :: String -> Either String URI +uriParser = first show . parseURI strictURIParserOptions . UTF8.fromString absolutePathParser :: FilePath -> Either String FilePath diff --git a/app/ghcup/GHCup/OptParse/Compile.hs b/app/ghcup/GHCup/OptParse/Compile.hs index 65fee42..07a92dc 100644 --- a/app/ghcup/GHCup/OptParse/Compile.hs +++ b/app/ghcup/GHCup/OptParse/Compile.hs @@ -40,6 +40,7 @@ import Prelude hiding ( appendFile ) import System.Exit import Text.PrettyPrint.HughesPJClass ( prettyShow ) +import URI.ByteString hiding ( uriParser ) import qualified Data.Text as T import Control.Exception.Safe (MonadMask) import System.FilePath (isPathSeparator) @@ -84,8 +85,8 @@ data HLSCompileOptions = HLSCompileOptions , setCompile :: Bool , ovewrwiteVer :: Maybe Version , isolateDir :: Maybe FilePath - , cabalProject :: Maybe FilePath - , cabalProjectLocal :: Maybe FilePath + , cabalProject :: Maybe (Either FilePath URI) + , cabalProjectLocal :: Maybe URI , patchDir :: Maybe FilePath , targetGHCs :: [ToolVersion] , cabalArgs :: [Text] @@ -300,16 +301,16 @@ hlsCompileOpts = ) <*> optional (option - str + ((fmap Right $ eitherReader uriParser) <|> (fmap Left str)) (long "cabal-project" <> metavar "CABAL_PROJECT" <> help - "If relative, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. If absolute, will copy the file over." + "If relative filepath, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. Otherwise expects a full URI with https/http/file scheme." ) ) <*> optional (option - (eitherReader absolutePathParser) + (eitherReader uriParser) (long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help - "Absolute path to a cabal.project.local to be used for the build. Will be copied over." + "URI (https/http/file) to a cabal.project.local to be used for the build. Will be copied over." ) ) <*> optional diff --git a/app/ghcup/GHCup/OptParse/Install.hs b/app/ghcup/GHCup/OptParse/Install.hs index 386f90d..8fcac6a 100644 --- a/app/ghcup/GHCup/OptParse/Install.hs +++ b/app/ghcup/GHCup/OptParse/Install.hs @@ -37,7 +37,7 @@ import Options.Applicative.Help.Pretty ( text ) import Prelude hiding ( appendFile ) import System.Exit import Text.PrettyPrint.HughesPJClass ( prettyShow ) -import URI.ByteString +import URI.ByteString hiding ( uriParser ) import qualified Data.Text as T @@ -187,7 +187,7 @@ installOpts tool = <*> ( ( (,) <$> optional (option - (eitherReader bindistParser) + (eitherReader uriParser) (short 'u' <> long "url" <> metavar "BINDIST_URL" <> help "Install the specified version from this bindist" ) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index f5715dc..f3131d0 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -84,6 +84,7 @@ import System.IO.Error import System.IO.Temp import Text.PrettyPrint.HughesPJClass ( prettyShow ) import Text.Regex.Posix +import URI.ByteString import qualified Crypto.Hash.SHA256 as SHA256 import qualified Data.List.NonEmpty as NE @@ -750,8 +751,8 @@ compileHLS :: ( MonadMask m -> Maybe Int -> Maybe Version -> Maybe FilePath - -> Maybe FilePath - -> Maybe FilePath + -> Maybe (Either FilePath URI) + -> Maybe URI -> Maybe FilePath -> [Text] -- ^ additional args to cabal install -> Excepts '[ NoDownload @@ -836,7 +837,7 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc liftE $ runBuildAction workdir Nothing - (reThrowAll @_ @'[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed workdir) $ do + (reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed workdir) $ do let installDir = workdir "out" liftIO $ createDirRecursive' installDir @@ -845,14 +846,21 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc -- set up project files cp <- case cabalProject of - Just cp + Just (Left cp) | isAbsolute cp -> do copyFileE cp (workdir "cabal.project") pure "cabal.project" | otherwise -> pure (takeFileName cp) + Just (Right uri) -> do + tmpUnpack <- lift withGHCupTmpDir + cp <- liftE $ download uri Nothing Nothing tmpUnpack (Just "cabal.project") False + copyFileE cp (workdir "cabal.project") + pure "cabal.project" Nothing -> pure "cabal.project" - forM_ cabalProjectLocal $ \cpl -> copyFileE cpl (workdir cp <.> "local") - + forM_ cabalProjectLocal $ \uri -> do + tmpUnpack <- lift withGHCupTmpDir + cpl <- liftE $ download uri Nothing Nothing tmpUnpack (Just (cp <.> "local")) False + copyFileE cpl (workdir cp <.> "local") artifacts <- forM (sort ghcs) $ \ghc -> do let ghcInstallDir = installDir T.unpack (prettyVer ghc) liftIO $ createDirRecursive' installDir