Allow remote URIs for --cabal-project-local wrt #281
This commit is contained in:
parent
71d78d2d72
commit
c5c6c431b5
@ -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
|
||||
|
@ -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
|
||||
|
@ -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"
|
||||
)
|
||||
|
20
lib/GHCup.hs
20
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
|
||||
|
Loading…
Reference in New Issue
Block a user