diff --git a/cabal-install/Distribution/Client/CmdRun.hs b/cabal-install/Distribution/Client/CmdRun.hs index 6cc183637c394b124411c8ef61e81f26a2f149f0..f02fbbfc9d947ce7e751f33cbf73b239450b3f50 100644 --- a/cabal-install/Distribution/Client/CmdRun.hs +++ b/cabal-install/Distribution/Client/CmdRun.hs @@ -104,7 +104,7 @@ import qualified Text.Parsec as P import System.Directory ( getTemporaryDirectory, removeDirectoryRecursive, doesFileExist ) import System.FilePath - ( (</>), isValid, isPathSeparator ) + ( (</>), isValid, isPathSeparator, takeExtension ) runCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) @@ -171,8 +171,10 @@ runAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) let scriptOrError script err = do exists <- doesFileExist script + let pol | takeExtension script == ".lhs" = LiterateHaskell + | otherwise = PlainHaskell if exists - then BS.readFile script >>= handleScriptCase verbosity baseCtx tempDir + then BS.readFile script >>= handleScriptCase verbosity pol baseCtx tempDir else reportTargetSelectorProblems verbosity err (baseCtx', targetSelectors) <- @@ -339,9 +341,9 @@ parseScriptBlock str = readScriptBlock :: Verbosity -> BS.ByteString -> IO Executable readScriptBlock verbosity = parseString parseScriptBlock verbosity "script block" -readScriptBlockFromScript :: Verbosity -> BS.ByteString -> IO (Executable, BS.ByteString) -readScriptBlockFromScript verbosity str = do - str' <- case extractScriptBlock str of +readScriptBlockFromScript :: Verbosity -> PlainOrLiterate -> BS.ByteString -> IO (Executable, BS.ByteString) +readScriptBlockFromScript verbosity pol str = do + str' <- case extractScriptBlock pol 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" @@ -361,34 +363,48 @@ readScriptBlockFromScript verbosity str = do -- -- In case of missing or unterminated blocks a 'Left'-error is -- returned. -extractScriptBlock :: BS.ByteString -> Either String BS.ByteString -extractScriptBlock str = goPre (BS.lines str) +extractScriptBlock :: PlainOrLiterate -> BS.ByteString -> Either String BS.ByteString +extractScriptBlock _pol str = goPre (BS.lines str) where - isStartMarker = (== "{- cabal:") . stripTrailSpace - isEndMarker = (== "-}") . stripTrailSpace + isStartMarker = (== startMarker) . stripTrailSpace + isEndMarker = (== endMarker) . stripTrailSpace + stripTrailSpace = fst . BS.spanEnd isSpace -- before start marker goPre ls = case dropWhile (not . isStartMarker) ls of - [] -> Left "`{- cabal:` start marker not found" + [] -> Left $ "`" ++ BS.unpack startMarker ++ "` start marker not found" (_:ls') -> goBody [] ls' - goBody _ [] = Left "`-}` end marker not found" + goBody _ [] = Left $ "`" ++ BS.unpack endMarker ++ "` end marker not found" goBody acc (l:ls) | isEndMarker l = Right $! BS.unlines $ reverse acc | otherwise = goBody (l:acc) ls + startMarker, endMarker :: BS.ByteString + startMarker = fromString "{- cabal:" + endMarker = fromString "-}" + +data PlainOrLiterate + = PlainHaskell + | LiterateHaskell -handleScriptCase :: Verbosity - -> ProjectBaseContext - -> FilePath - -> BS.ByteString - -> IO (ProjectBaseContext, [TargetSelector]) -handleScriptCase verbosity baseCtx tempDir scriptContents = do - (executable, contents') <- readScriptBlockFromScript verbosity scriptContents +handleScriptCase + :: Verbosity + -> PlainOrLiterate + -> ProjectBaseContext + -> FilePath + -> BS.ByteString + -> IO (ProjectBaseContext, [TargetSelector]) +handleScriptCase verbosity pol baseCtx tempDir scriptContents = do + (executable, contents') <- readScriptBlockFromScript verbosity pol scriptContents -- We need to create a dummy package that lives in our dummy project. let + mainName = case pol of + PlainHaskell -> "Main.hs" + LiterateHaskell -> "Main.lhs" + sourcePackage = SourcePackage { packageInfoId = pkgId , SP.packageDescription = genericPackageDescription @@ -400,7 +416,7 @@ handleScriptCase verbosity baseCtx tempDir scriptContents = do , condExecutables = [("script", CondNode executable' targetBuildDepends [])] } executable' = executable - { modulePath = "Main.hs" + { modulePath = mainName , buildInfo = binfo { defaultLanguage = case defaultLanguage of @@ -417,7 +433,7 @@ handleScriptCase verbosity baseCtx tempDir scriptContents = do pkgId = fakePackageId writeGenericPackageDescription (tempDir </> "fake-package.cabal") genericPackageDescription - BS.writeFile (tempDir </> "Main.hs") contents' + BS.writeFile (tempDir </> mainName) contents' let baseCtx' = baseCtx diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.out new file mode 100644 index 0000000000000000000000000000000000000000..31d7de3ca732c25d1b9181bcb6cacb09116db808 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.out @@ -0,0 +1,8 @@ +# cabal v2-run +Resolving dependencies... +Build profile: -w ghc-<GHCVER> -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (first run) +Configuring executable 'script' for fake-package-0.. +Preprocessing executable 'script' for fake-package-0.. +Building executable 'script' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.project b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.project new file mode 100644 index 0000000000000000000000000000000000000000..5356e76f67c76ea1cf221ce38a73edef1002225e --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.project @@ -0,0 +1 @@ +packages: . \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.test.hs new file mode 100644 index 0000000000000000000000000000000000000000..64c858e8d0da597c7884dbfadc658e9ce172a3a3 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + res <- cabal' "v2-run" ["script.lhs"] + assertOutputContains "Hello World" res diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/script.cabal b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/script.cabal new file mode 100644 index 0000000000000000000000000000000000000000..56b2e9feb604141879dacfe9061ee423bed1ba3c --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/script.cabal @@ -0,0 +1,4 @@ +name: script +version: 1.0 +build-type: Simple +cabal-version: >= 1.10 diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/script.lhs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/script.lhs new file mode 100644 index 0000000000000000000000000000000000000000..f0365393f526b38e9638821327e22ae9b1e1fdb2 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/script.lhs @@ -0,0 +1,18 @@ +\iffalse +{- cabal: +build-depends: base >= 4.3 && <5 +-} +\fi +\documentclass{article} +\begin{document} +\begin{code} + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ScopedTypeVariables #-} + +import Prelude + +main :: IO () +main = putStrLn "Hello World" +\end{code} +\end{document}