Allow remote URIs for --cabal-project-local wrt #281

This commit is contained in:
Julian Ospald 2021-11-12 19:05:13 +01:00
parent 71d78d2d72
commit c5c6c431b5
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
4 changed files with 25 additions and 16 deletions

View File

@ -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

View File

@ -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

View File

@ -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"
)

View File

@ -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