diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index a9cf6c27227..e3b1f4459a8 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -33,7 +33,7 @@ import Distribution.Verbosity import Distribution.Simple.Utils ( wrapText, die' ) import Distribution.Client.ScriptUtils - ( AcceptNoTargets(..), withContextAndSelectors, updateAndPersistScriptContext, TargetContext(..) ) + ( AcceptNoTargets(..), withContextAndSelectors, updateContextAndWriteProjectFile, TargetContext(..) ) import qualified Data.Map as Map @@ -98,7 +98,7 @@ defaultBuildFlags = BuildFlags -- buildAction :: NixStyleFlags BuildFlags -> [String] -> GlobalFlags -> IO () buildAction flags@NixStyleFlags { extraFlags = buildFlags, ..} targetStrings globalFlags - = withContextAndSelectors RejectNoTargets "" Nothing flags targetStrings globalFlags $ \targetCtx ctx targetSelectors -> do + = withContextAndSelectors RejectNoTargets Nothing flags targetStrings globalFlags $ \targetCtx ctx targetSelectors -> do -- TODO: This flags defaults business is ugly let onlyConfigure = fromFlag (buildOnlyConfigure defaultBuildFlags <> buildOnlyConfigure buildFlags) @@ -107,9 +107,9 @@ buildAction flags@NixStyleFlags { extraFlags = buildFlags, ..} targetStrings glo | otherwise = TargetActionBuild baseCtx <- case targetCtx of - ProjectContext -> return ctx - GlobalContext -> return ctx - ScriptContext path exemeta contents -> updateAndPersistScriptContext ctx path exemeta contents + ProjectContext -> return ctx + GlobalContext -> return ctx + ScriptContext path exemeta -> updateContextAndWriteProjectFile ctx path exemeta buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do diff --git a/cabal-install/src/Distribution/Client/CmdRepl.hs b/cabal-install/src/Distribution/Client/CmdRepl.hs index 9fb161f3819..a09750b3770 100644 --- a/cabal-install/src/Distribution/Client/CmdRepl.hs +++ b/cabal-install/src/Distribution/Client/CmdRepl.hs @@ -45,7 +45,8 @@ import Distribution.Client.ProjectPlanning.Types ( elabOrderExeDependencies ) import Distribution.Client.ScriptUtils ( AcceptNoTargets(..), withContextAndSelectors, TargetContext(..) - , updateContextAndWriteProjectFile, fakeProjectSourcePackage, lSrcpkgDescription ) + , updateContextAndWriteProjectFile, updateContextAndWriteProjectFile' + , fakeProjectSourcePackage, lSrcpkgDescription ) import Distribution.Client.Setup ( GlobalFlags, ConfigFlags(..) ) import qualified Distribution.Client.Setup as Client @@ -77,8 +78,6 @@ import Distribution.Types.CondTree ( CondTree(..), traverseCondTreeC ) import Distribution.Types.Dependency ( Dependency(..), mainLibSet ) -import Distribution.Types.Executable - ( Executable(..) ) import Distribution.Types.Library ( Library(..), emptyLibrary ) import Distribution.Types.Version @@ -87,8 +86,6 @@ import Distribution.Types.VersionRange ( anyVersion ) import Distribution.Utils.Generic ( safeHead ) -import Distribution.Utils.Path - ( unsafeMakeSymbolicPath ) import Distribution.Verbosity ( normal, lessVerbose ) import Distribution.Simple.Utils @@ -101,9 +98,9 @@ import Data.List import qualified Data.Map as Map import qualified Data.Set as Set import System.Directory - ( getCurrentDirectory, doesFileExist, canonicalizePath) + ( doesFileExist, getCurrentDirectory ) import System.FilePath - ( (), dropDrive, joinPath, splitPath, dropFileName, takeFileName ) + ( () ) data EnvFlags = EnvFlags { envPackages :: [Dependency] @@ -190,7 +187,7 @@ replCommand = Client.installCommand { -- replAction :: NixStyleFlags (ReplOptions, EnvFlags) -> [String] -> GlobalFlags -> IO () replAction flags@NixStyleFlags { extraFlags = (replFlags, envFlags), ..} targetStrings globalFlags - = withContextAndSelectors AcceptNoTargets "repl:" (Just LibKind) flags targetStrings globalFlags $ \targetCtx ctx targetSelectors -> do + = withContextAndSelectors AcceptNoTargets (Just LibKind) flags targetStrings globalFlags $ \targetCtx ctx targetSelectors -> do when (buildSettingOnlyDeps (buildSettings ctx)) $ die' verbosity $ "The repl command does not support '--only-dependencies'. " ++ "You may wish to use 'build --only-dependencies' and then " @@ -215,26 +212,15 @@ replAction flags@NixStyleFlags { extraFlags = (replFlags, envFlags), ..} targetS } baseDep = Dependency "base" anyVersion mainLibSet - (,) GlobalRepl <$> updateContextAndWriteProjectFile ctx sourcePackage - ScriptContext scriptPath scriptExecutable _ -> do + (,) GlobalRepl <$> updateContextAndWriteProjectFile' ctx sourcePackage + ScriptContext scriptPath scriptExecutable -> do unless (length targetStrings == 1) $ die' verbosity $ "'repl' takes a single argument which should be a script: " ++ unwords targetStrings existsScriptPath <- doesFileExist scriptPath unless existsScriptPath $ die' verbosity $ "'repl' takes a single argument which should be a script: " ++ unwords targetStrings - -- We want to use the script dir in hs-source-dirs, but hs-source-dirs wants a relpath from the projectRoot - -- and ghci also needs to be able to find that script from cwd using that relpath - backtoscript <- doublyRelativePath projectRoot (dropFileName scriptPath) - let - sourcePackage = fakeProjectSourcePackage projectRoot - & lSrcpkgDescription . L.condExecutables - .~ [("script", CondNode executable (targetBuildDepends $ buildInfo executable) [])] - executable = scriptExecutable - & L.modulePath .~ takeFileName scriptPath - & L.hsSourceDirs .~ [unsafeMakeSymbolicPath backtoscript] - - (,) GlobalRepl <$> updateContextAndWriteProjectFile ctx sourcePackage + (,) GlobalRepl <$> updateContextAndWriteProjectFile ctx scriptPath scriptExecutable (originalComponent, baseCtx') <- if null (envPackages envFlags) then return (Nothing, baseCtx) @@ -357,20 +343,6 @@ data OriginalComponentInfo = OriginalComponentInfo data ReplType = ProjectRepl | GlobalRepl deriving (Show, Eq) --- Workaround for hs-script-dirs not taking absolute paths. --- Construct a path to b that is relative to both a and cwd. -doublyRelativePath :: FilePath -> FilePath -> IO FilePath -doublyRelativePath a b = do - cpa <- dropDrive <$> canonicalizePath a - cwd <- dropDrive <$> getCurrentDirectory - cpb <- dropDrive <$> canonicalizePath b - let cpaSegs = splitPath cpa - cwdSegs = splitPath cwd - -- Make sure we get all the way down to root from either a or b - toRoot = joinPath . map (const "..") $ if length cpaSegs > length cwdSegs then cpaSegs else cwdSegs - -- Climb down to b from root - return $ toRoot cpb - addDepsToProjectTarget :: [Dependency] -> PackageId -> ProjectBaseContext diff --git a/cabal-install/src/Distribution/Client/CmdRun.hs b/cabal-install/src/Distribution/Client/CmdRun.hs index 693d8a898c0..4fb3823b435 100644 --- a/cabal-install/src/Distribution/Client/CmdRun.hs +++ b/cabal-install/src/Distribution/Client/CmdRun.hs @@ -61,7 +61,7 @@ import Distribution.Simple.Program.Run import Distribution.Types.UnitId ( UnitId ) import Distribution.Client.ScriptUtils - ( AcceptNoTargets(..), withContextAndSelectors, updateAndPersistScriptContext, TargetContext(..) ) + ( AcceptNoTargets(..), withContextAndSelectors, updateContextAndWriteProjectFile, TargetContext(..) ) import qualified Data.Set as Set import System.Directory @@ -119,11 +119,11 @@ runCommand = CommandUI -- runAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO () runAction flags@NixStyleFlags {..} targetStrings globalFlags - = withContextAndSelectors RejectNoTargets "" (Just ExeKind) flags targetStrings globalFlags $ \targetCtx ctx targetSelectors -> do + = withContextAndSelectors RejectNoTargets (Just ExeKind) flags targetStrings globalFlags $ \targetCtx ctx targetSelectors -> do baseCtx <- case targetCtx of - ProjectContext -> return ctx - GlobalContext -> return ctx - ScriptContext path exemeta contents -> updateAndPersistScriptContext ctx path exemeta contents + ProjectContext -> return ctx + GlobalContext -> return ctx + ScriptContext path exemeta -> updateContextAndWriteProjectFile ctx path exemeta buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs index 91033ceca35..ed9a7857c35 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -8,7 +8,7 @@ module Distribution.Client.ScriptUtils ( getScriptCacheDirectoryRoot, getScriptHash, getScriptCacheDirectory, ensureScriptCacheDirectory, withContextAndSelectors, AcceptNoTargets(..), TargetContext(..), - updateContextAndWriteProjectFile, updateAndPersistScriptContext, + updateContextAndWriteProjectFile, updateContextAndWriteProjectFile', fakeProjectSourcePackage, lSrcpkgDescription ) where @@ -72,6 +72,8 @@ import Distribution.Types.PackageDescription ( PackageDescription(..), emptyPackageDescription ) import Distribution.Types.PackageName.Magic ( fakePackageId, fakePackageCabalFileName ) +import Distribution.Utils.Path + ( unsafeMakeSymbolicPath ) import Language.Haskell.Extension ( Language(..) ) import Distribution.Client.HashValue @@ -87,9 +89,9 @@ import qualified Data.ByteString.Char8 as BS import Data.ByteString.Lazy () import qualified Text.Parsec as P import System.Directory - ( getTemporaryDirectory, removeDirectoryRecursive, doesFileExist, canonicalizePath ) + ( canonicalizePath, doesFileExist, getCurrentDirectory, getTemporaryDirectory, removeDirectoryRecursive ) import System.FilePath - ( (), takeExtension ) + ( (), dropDrive, dropFileName, joinPath, splitPath, takeFileName ) -- | Get the directory where script builds are cached. @@ -100,37 +102,27 @@ getScriptCacheDirectoryRoot = do cabalDir <- getCabalDir return $ cabalDir "script-builds" --- | Get the hash of (@prefix@ ++ the script's absolute path) +-- | Get the hash of a script's absolute path) -- --- Two hashes for the same @prefix@ will be the same whenever --- the absolute path is the same. Two hashes with different --- @prefix@ will always differ. --- --- @prefix@ must not contain path separator characters because --- it could cause unwanted collisions. -getScriptHash :: String -> FilePath -> IO String -getScriptHash prefix script - | '/' `notElem` prefix && '\\' `notElem` prefix = showHashValue . hashValue . fromString . (prefix ++) <$> canonicalizePath script - | otherwise = error "getScriptHash: prefix must not contain '/' or '\\'" +-- Two hashes will be the same as long as the absolute paths +-- are the same. +getScriptHash :: FilePath -> IO String +getScriptHash script = showHashValue . hashValue . fromString <$> canonicalizePath script -- | Get the directory for caching a script build. -- -- The only identity of a script is it's absolute path, so append the -- hashed path to @CABAL_DIR\/script-builds\/@ to get the cache directory. --- --- @prefix@ must not contain path separator characters. -getScriptCacheDirectory :: String -> FilePath -> IO FilePath -getScriptCacheDirectory prefix script = () <$> getScriptCacheDirectoryRoot <*> getScriptHash prefix script +getScriptCacheDirectory :: FilePath -> IO FilePath +getScriptCacheDirectory script = () <$> getScriptCacheDirectoryRoot <*> getScriptHash script -- | Get the directory for caching a script build and ensure it exists. -- -- The only identity of a script is it's absolute path, so append the -- hashed path to @CABAL_DIR\/script-builds\/@ to get the cache directory. --- --- @prefix@ must not contain path separator characters. -ensureScriptCacheDirectory :: Verbosity -> String -> FilePath -> IO FilePath -ensureScriptCacheDirectory verbosity prefix script = do - cacheDir <- getScriptCacheDirectory prefix script +ensureScriptCacheDirectory :: Verbosity -> FilePath -> IO FilePath +ensureScriptCacheDirectory verbosity script = do + cacheDir <- getScriptCacheDirectory script createDirectoryIfMissingVerbose verbosity True cacheDir return cacheDir @@ -144,9 +136,9 @@ data AcceptNoTargets data TargetContext = ProjectContext -- ^ The target selectors are part of a project. | GlobalContext -- ^ The target selectors are from the global context. - | ScriptContext FilePath Executable BS.ByteString + | ScriptContext FilePath Executable -- ^ The target selectors refer to a script. Contains the path to the script and - -- the executable of contents parsed from the script + -- the executable metadata parsed from the script deriving (Eq, Show) -- | Determine whether the targets represent regular targets or a script @@ -157,7 +149,6 @@ data TargetContext -- delete it after the action finishes. withContextAndSelectors :: AcceptNoTargets -- ^ What your command should do when no targets are found. - -> String -- ^ A prefix to add to the path before hashing, if you don't want to use the default cache dir. -> Maybe ComponentKind -- ^ A target filter -> NixStyleFlags a -- ^ Command line flags -> [String] -- ^ Target strings or a script and args. @@ -165,7 +156,7 @@ withContextAndSelectors -> (TargetContext -> ProjectBaseContext -> [TargetSelector] -> IO b) -- ^ The body of your command action. -> IO b -withContextAndSelectors noTargets cachePrefix kind flags@NixStyleFlags {..} targetStrings globalFlags act +withContextAndSelectors noTargets kind flags@NixStyleFlags {..} targetStrings globalFlags act = withTemporaryTempDirectory $ \mkTmpDir -> do (tc, ctx) <- withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag with (without mkTmpDir) @@ -203,16 +194,16 @@ withContextAndSelectors noTargets cachePrefix kind flags@NixStyleFlags {..} targ exists <- doesFileExist script if exists then do -- In the script case we always want a dummy context even when ignoreProject is False - let mkCacheDir = ensureScriptCacheDirectory verbosity cachePrefix script + let mkCacheDir = ensureScriptCacheDirectory verbosity script (_, ctx) <- withProjectOrGlobalConfig verbosity (Flag True) globalConfigFlag with (without mkCacheDir) let projectRoot = distProjectRootDirectory $ distDirLayout ctx writeFile (projectRoot "scriptlocation") =<< canonicalizePath script - (executable, contents) <- readScriptBlockFromScript verbosity =<< BS.readFile script + executable <- readScriptBlockFromScript verbosity =<< BS.readFile script let executable' = executable & L.buildInfo . L.defaultLanguage %~ maybe (Just Haskell2010) Just - return (ScriptContext script executable' contents, ctx, defaultTarget) + return (ScriptContext script executable', ctx, defaultTarget) else reportTargetSelectorProblems verbosity err withTemporaryTempDirectory :: (IO FilePath -> IO a) -> IO a @@ -229,8 +220,8 @@ withTemporaryTempDirectory act = newEmptyMVar >>= \m -> bracket (getMkTmp m) (rm rmTmp m _ = tryTakeMVar m >>= maybe (return ()) (handleDoesNotExist () . removeDirectoryRecursive) -- | Add the 'SourcePackage' to the context and use it to write a .cabal file. -updateContextAndWriteProjectFile :: ProjectBaseContext -> SourcePackage (PackageLocation (Maybe FilePath)) -> IO ProjectBaseContext -updateContextAndWriteProjectFile ctx srcPkg = do +updateContextAndWriteProjectFile' :: ProjectBaseContext -> SourcePackage (PackageLocation (Maybe FilePath)) -> IO ProjectBaseContext +updateContextAndWriteProjectFile' ctx srcPkg = do let projectRoot = distProjectRootDirectory $ distDirLayout ctx projectFile = projectRoot fakePackageCabalFileName writeProjectFile = writeGenericPackageDescription (projectRoot fakePackageCabalFileName) (srcpkgDescription srcPkg) @@ -244,20 +235,38 @@ updateContextAndWriteProjectFile ctx srcPkg = do else writeProjectFile return (ctx & lLocalPackages %~ (++ [SpecificSourcePackage srcPkg])) --- Write a .cabal file and the script source file (Main.hs or Main.lhs) --- and add add the executable metadata to the base context. -updateAndPersistScriptContext :: ProjectBaseContext -> FilePath -> Executable -> BS.ByteString -> IO ProjectBaseContext -updateAndPersistScriptContext ctx scriptPath scriptExecutable scriptContents = do +-- | Add add the executable metadata to the context and write a .cabal file. +updateContextAndWriteProjectFile :: ProjectBaseContext -> FilePath -> Executable -> IO ProjectBaseContext +updateContextAndWriteProjectFile ctx scriptPath scriptExecutable = do let projectRoot = distProjectRootDirectory $ distDirLayout ctx - mainName = if takeExtension scriptPath == ".lhs" then "Main.lhs" else "Main.hs" - sourcePackage = fakeProjectSourcePackage projectRoot - & lSrcpkgDescription . L.condExecutables - .~ [("script", CondNode executable (targetBuildDepends $ buildInfo executable) [])] - executable = scriptExecutable & L.modulePath .~ mainName - - BS.writeFile (projectRoot mainName) scriptContents - updateContextAndWriteProjectFile ctx sourcePackage + -- We want to use the script dir in hs-source-dirs, but hs-source-dirs wants a relpath from the projectRoot + -- and ghci also needs to be able to find that script from cwd using that relpath + backtoscript <- doublyRelativePath projectRoot scriptPath + let + sourcePackage = fakeProjectSourcePackage projectRoot + & lSrcpkgDescription . L.condExecutables + .~ [("script", CondNode executable (targetBuildDepends $ buildInfo executable) [])] + executable = scriptExecutable + & L.modulePath .~ takeFileName scriptPath + & L.hsSourceDirs %~ (unsafeMakeSymbolicPath backtoscript :) + + updateContextAndWriteProjectFile' ctx sourcePackage + +-- | Workaround for hs-script-dirs not taking absolute paths. +-- Construct a path to scriptPath that is relative to both +-- the project rood and working directory. +doublyRelativePath :: FilePath -> FilePath -> IO FilePath +doublyRelativePath projectRoot scriptPath = do + prd <- dropDrive <$> canonicalizePath projectRoot + cwd <- dropDrive <$> getCurrentDirectory + spd <- dropDrive . dropFileName <$> canonicalizePath scriptPath + let prdSegs = splitPath prd + cwdSegs = splitPath cwd + -- Make sure we get all the way down to root from either a or b + toRoot = joinPath . map (const "..") $ if length prdSegs > length cwdSegs then prdSegs else cwdSegs + -- Climb down to b from root + return $ toRoot spd parseScriptBlock :: BS.ByteString -> ParseResult Executable parseScriptBlock str = @@ -279,16 +288,14 @@ readScriptBlock verbosity = parseString parseScriptBlock verbosity "script block -- -- * @-}@ -- --- Return the metadata and the contents of the file without the #! line. -readScriptBlockFromScript :: Verbosity -> BS.ByteString -> IO (Executable, BS.ByteString) +-- Return the metadata. +readScriptBlockFromScript :: Verbosity -> BS.ByteString -> IO Executable readScriptBlockFromScript verbosity str = do str' <- case extractScriptBlock str of Left e -> die' verbosity $ "Failed extracting script block: " ++ e Right x -> return x when (BS.all isSpace str') $ warn verbosity "Empty script block" - (\x -> (x, noShebang)) <$> readScriptBlock verbosity str' - where - noShebang = BS.unlines . filter (not . BS.isPrefixOf "#!") . BS.lines $ str + readScriptBlock verbosity str' -- | Extract the first encountered script metadata block started end -- terminated by the tokens diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.out index 732deece540..1bb1a5b78c4 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.out @@ -4,5 +4,6 @@ Build profile: -w ghc- -O1 In order, the following will be built: - fake-package-0 (exe:script) (first run) Configuring executable 'script' for fake-package-0.. +Warning: 'hs-source-dirs: ' is a relative path outside of the source tree. This will not work when generating a tarball with 'sdist'. Preprocessing executable 'script' for fake-package-0.. Building executable 'script' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.test.hs index 93434c243cd..db31636dc42 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.test.hs +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.test.hs @@ -4,8 +4,7 @@ main = cabalTest . void $ do cabal' "v2-build" ["script.hs"] env <- getTestEnv - cacheDir <- getScriptCacheDirectory "" (testCurrentDir env "script.hs") + cacheDir <- getScriptCacheDirectory $ testCurrentDir env "script.hs" shouldExist $ cacheDir "fake-package.cabal" - shouldExist $ cacheDir "Main.hs" shouldExist $ cacheDir "scriptlocation" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out new file mode 100644 index 00000000000..b0655570836 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out @@ -0,0 +1,14 @@ +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (first run) +Configuring executable 'script' for fake-package-0.. +Warning: 'hs-source-dirs: ' is a relative path outside of the source tree. This will not work when generating a tarball with 'sdist'. +Preprocessing executable 'script' for fake-package-0.. +Building executable 'script' for fake-package-0.. +# cabal v2-repl +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (ephemeral targets) +Preprocessing executable 'script' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.test.hs new file mode 100644 index 00000000000..9c0f021da5d --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +main = cabalTest . void $ do + cabal' "v2-build" ["script.hs"] + cabalWithStdin "v2-repl" ["script.hs"] "" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/script.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/script.hs new file mode 100644 index 00000000000..cd2fae4e8f4 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/script.hs @@ -0,0 +1,6 @@ +{- cabal: +build-depends: base +-} + +main :: IO () +main = putStrLn "Hello World" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.out index 238ec82dc8a..a9548f08d31 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.out @@ -4,6 +4,7 @@ Build profile: -w ghc- -O1 In order, the following will be built: - fake-package-0 (exe:script) (first run) Configuring executable 'script' for fake-package-0.. +Warning: 'hs-source-dirs: ' is a relative path outside of the source tree. This will not work when generating a tarball with 'sdist'. Preprocessing executable 'script' for fake-package-0.. Building executable 'script' for fake-package-0.. # cabal v2-run diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.out index a3a2453901c..f104a4884aa 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.out @@ -4,6 +4,7 @@ Build profile: -w ghc- -O1 In order, the following will be built: - fake-package-0 (exe:script) (first run) Configuring executable 'script' for fake-package-0.. +Warning: 'hs-source-dirs: ' is a relative path outside of the source tree. This will not work when generating a tarball with 'sdist'. Preprocessing executable 'script' for fake-package-0.. Building executable 'script' for fake-package-0.. # cabal v2-build diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.out index 4d11e547d3e..2df9eadc0c5 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.out @@ -4,6 +4,7 @@ Build profile: -w ghc- -O1 In order, the following will be built: - fake-package-0 (exe:script) (first run) Configuring executable 'script' for fake-package-0.. +Warning: 'hs-source-dirs: ' is a relative path outside of the source tree. This will not work when generating a tarball with 'sdist'. Preprocessing executable 'script' for fake-package-0.. Building executable 'script' for fake-package-0.. # cabal v2-build @@ -12,6 +13,7 @@ Build profile: -w ghc- -O1 In order, the following will be built: - fake-package-0 (exe:script) (configuration changed) Configuring executable 'script' for fake-package-0.. +Warning: 'hs-source-dirs: ' is a relative path outside of the source tree. This will not work when generating a tarball with 'sdist'. Preprocessing executable 'script' for fake-package-0.. Building executable 'script' for fake-package-0.. # cabal v2-clean diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.test.hs index 007a00cc8c3..8063d229034 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.test.hs +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.test.hs @@ -11,8 +11,8 @@ main = cabalTest . void $ do liftIO $ removeFile (td "script2.hs") cabal' "v2-clean" [] - cacheDir <- getScriptCacheDirectory "" (td "script.hs") - cacheDir2 <- getScriptCacheDirectory "" (td "script2.hs") + cacheDir <- getScriptCacheDirectory (td "script.hs") + cacheDir2 <- getScriptCacheDirectory (td "script2.hs") shouldDirectoryExist cacheDir shouldDirectoryNotExist cacheDir2 diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.out index 4d11e547d3e..2df9eadc0c5 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.out @@ -4,6 +4,7 @@ Build profile: -w ghc- -O1 In order, the following will be built: - fake-package-0 (exe:script) (first run) Configuring executable 'script' for fake-package-0.. +Warning: 'hs-source-dirs: ' is a relative path outside of the source tree. This will not work when generating a tarball with 'sdist'. Preprocessing executable 'script' for fake-package-0.. Building executable 'script' for fake-package-0.. # cabal v2-build @@ -12,6 +13,7 @@ Build profile: -w ghc- -O1 In order, the following will be built: - fake-package-0 (exe:script) (configuration changed) Configuring executable 'script' for fake-package-0.. +Warning: 'hs-source-dirs: ' is a relative path outside of the source tree. This will not work when generating a tarball with 'sdist'. Preprocessing executable 'script' for fake-package-0.. Building executable 'script' for fake-package-0.. # cabal v2-clean diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.test.hs index e2dfccc6e2c..39ba5185e94 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.test.hs +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.test.hs @@ -11,8 +11,8 @@ main = cabalTest . void $ do liftIO $ removeFile (td "script2.hs") cabal' "v2-clean" ["script.hs"] - cacheDir <- getScriptCacheDirectory "" (td "script.hs") - cacheDir2 <- getScriptCacheDirectory "" (td "script2.hs") + cacheDir <- getScriptCacheDirectory (td "script.hs") + cacheDir2 <- getScriptCacheDirectory (td "script2.hs") shouldDirectoryNotExist cacheDir shouldDirectoryNotExist cacheDir2 diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.out index 7fe551a7e71..1c376584e11 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.out @@ -4,6 +4,7 @@ Build profile: -w ghc- -O1 In order, the following will be built: - fake-package-0 (exe:script) (first run) Configuring executable 'script' for fake-package-0.. +Warning: 'hs-source-dirs: ' is a relative path outside of the source tree. This will not work when generating a tarball with 'sdist'. Preprocessing executable 'script' for fake-package-0.. Building executable 'script' for fake-package-0.. # cabal v2-clean diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.test.hs index cccfba8942e..d3870ce1520 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.test.hs +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.test.hs @@ -5,7 +5,7 @@ main = cabalTest . void $ do cabal' "v2-clean" ["script.hs"] env <- getTestEnv - cacheDir <- getScriptCacheDirectory "" (testCurrentDir env "script.hs") + cacheDir <- getScriptCacheDirectory (testCurrentDir env "script.hs") shouldDirectoryNotExist cacheDir shouldDirectoryNotExist (testDistDir env) diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.test.hs index dbe97ea38c3..f453256b186 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.test.hs +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.test.hs @@ -5,8 +5,7 @@ main = cabalTest . void $ do assertOutputContains "Hello World" res env <- getTestEnv - cacheDir <- getScriptCacheDirectory "repl:" (testCurrentDir env "script.hs") + cacheDir <- getScriptCacheDirectory $ testCurrentDir env "script.hs" shouldExist $ cacheDir "fake-package.cabal" shouldExist $ cacheDir "scriptlocation" - shouldNotExist $ cacheDir "Main.hs" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.out index 31d7de3ca73..ce76cbacd69 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.out @@ -4,5 +4,6 @@ Build profile: -w ghc- -O1 In order, the following will be built: - fake-package-0 (exe:script) (first run) Configuring executable 'script' for fake-package-0.. +Warning: 'hs-source-dirs: ' is a relative path outside of the source tree. This will not work when generating a tarball with 'sdist'. Preprocessing executable 'script' for fake-package-0.. Building executable 'script' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.test.hs index 98873d58d14..045c88117d7 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.test.hs +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.test.hs @@ -5,8 +5,7 @@ main = cabalTest $ do assertOutputContains "Hello World" res env <- getTestEnv - cacheDir <- getScriptCacheDirectory "" (testCurrentDir env "script.hs") + cacheDir <- getScriptCacheDirectory (testCurrentDir env "script.hs") shouldExist $ cacheDir "fake-package.cabal" - shouldExist $ cacheDir "Main.hs" shouldExist $ cacheDir "scriptlocation" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.out index 31d7de3ca73..ce76cbacd69 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.out @@ -4,5 +4,6 @@ Build profile: -w ghc- -O1 In order, the following will be built: - fake-package-0 (exe:script) (first run) Configuring executable 'script' for fake-package-0.. +Warning: 'hs-source-dirs: ' is a relative path outside of the source tree. This will not work when generating a tarball with 'sdist'. Preprocessing executable 'script' for fake-package-0.. Building executable 'script' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptMultiModule/A.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptMultiModule/A.hs new file mode 100644 index 00000000000..6f1817649be --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptMultiModule/A.hs @@ -0,0 +1,3 @@ +module A where + +helloworld = "Hello World" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptMultiModule/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptMultiModule/cabal.out new file mode 100644 index 00000000000..ce76cbacd69 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptMultiModule/cabal.out @@ -0,0 +1,9 @@ +# cabal v2-run +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (first run) +Configuring executable 'script' for fake-package-0.. +Warning: 'hs-source-dirs: ' is a relative path outside of the source tree. This will not work when generating a tarball with 'sdist'. +Preprocessing executable 'script' for fake-package-0.. +Building executable 'script' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptMultiModule/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptMultiModule/cabal.test.hs new file mode 100644 index 00000000000..ee9110853e8 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptMultiModule/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + res <- cabal' "v2-run" ["script.hs"] + assertOutputContains "Hello World" res diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptMultiModule/script.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptMultiModule/script.hs new file mode 100644 index 00000000000..3714be53e50 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptMultiModule/script.hs @@ -0,0 +1,10 @@ +#! /usr/bin/env cabal +{- cabal: +build-depends: base >= 4.3 && <5 +other-modules: A +-} + +import A (helloworld) + +main :: IO () +main = putStrLn helloworld diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.out index 65fdda7f736..f53cbfda420 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.out @@ -4,6 +4,7 @@ Build profile: -w ghc- -O1 In order, the following will be built: - fake-package-0 (exe:script) (first run) Configuring executable 'script' for fake-package-0.. +Warning: 'hs-source-dirs: ' is a relative path outside of the source tree. This will not work when generating a tarball with 'sdist'. Preprocessing executable 'script' for fake-package-0.. Building executable 'script' for fake-package-0.. # cabal v2-run diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 64edf3d1e51..18715f3e315 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -752,10 +752,10 @@ concatOutput :: String -> String concatOutput = unwords . lines . filter ((/=) '\r') -- | The directory where script build artifacts are expected to be cached -getScriptCacheDirectory :: String -> FilePath -> TestM FilePath -getScriptCacheDirectory prefix script = do +getScriptCacheDirectory :: FilePath -> TestM FilePath +getScriptCacheDirectory script = do cabalDir <- testCabalDir `fmap` getTestEnv - hashinput <- liftIO $ (prefix ++) `fmap` canonicalizePath script + hashinput <- liftIO $ canonicalizePath script let hash = C.unpack . Base16.encode . SHA256.hash . C.pack $ hashinput return $ cabalDir "script-builds" hash diff --git a/doc/cabal-commands.rst b/doc/cabal-commands.rst index e9e29e08d63..f15650e7d68 100644 --- a/doc/cabal-commands.rst +++ b/doc/cabal-commands.rst @@ -337,7 +337,8 @@ cannot be excluded for technical reasons). $ cabal v2-repl path/to/script -The configuration information for the script is cached under the cabal directory. +The configuration information for the script is cached under the cabal directory +and can be pre-built with ``cabal v2-build path/to/script``. See ``cabal v2-run`` for more information on scripts. cabal v2-run @@ -383,7 +384,9 @@ a script that looks like: {- cabal: build-depends: base ^>= 4.11 , shelly ^>= 1.8.1 + other-modules: M -} + import M main :: IO () main = do