Skip to content

Add support for rts-options #434

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
sol wants to merge 1 commit into
base: main
Choose a base branch
from
Open

Add support for rts-options #434

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
29 changes: 26 additions & 3 deletions src/Hpack/Config.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -230,17 +230,19 @@ data ExecutableSection = ExecutableSection {
executableSectionMain :: Alias 'True "main-is" (Last FilePath)
, executableSectionOtherModules :: Maybe (List Module)
, executableSectionGeneratedOtherModules :: Maybe (List Module)
, executableSectionRtsOptions :: Maybe (List String)
} deriving (Eq, Show, Generic, FromValue)

instance Monoid ExecutableSection where
mempty = ExecutableSection mempty Nothing Nothing
mempty = ExecutableSection mempty Nothing Nothing Nothing
mappend = (<>)

instance Semigroup ExecutableSection where
a <> b = ExecutableSection {
executableSectionMain = executableSectionMain a <> executableSectionMain b
, executableSectionOtherModules = executableSectionOtherModules a <> executableSectionOtherModules b
, executableSectionGeneratedOtherModules = executableSectionGeneratedOtherModules a <> executableSectionGeneratedOtherModules b
, executableSectionRtsOptions = executableSectionRtsOptions a <> executableSectionRtsOptions b
}

data VerbatimValue =
Expand Down Expand Up @@ -1428,13 +1430,13 @@ fromLibrarySectionPlain LibrarySection{..} = Library {
}

getMentionedExecutableModules :: ExecutableSection -> [Module]
getMentionedExecutableModules (ExecutableSection (Alias (Last main)) otherModules generatedModules)=
getMentionedExecutableModules (ExecutableSection (Alias (Last main)) otherModules generatedModules _rtsOptions)=
maybe id (:) (toModule . Path.fromFilePath <$> main) $ fromMaybeList (otherModules <> generatedModules)

toExecutable :: FilePath -> String -> Section ExecutableSection -> IO (Section Executable)
toExecutable dir packageName_ =
inferModules dir packageName_ getMentionedExecutableModules getExecutableModules fromExecutableSection (fromExecutableSection [])
. expandMain
. expandRtsOptions . expandMain
where
fromExecutableSection :: [Module] -> [Module] -> ExecutableSection -> Executable
fromExecutableSection pathsModule inferableModules ExecutableSection{..} =
Expand All @@ -1443,12 +1445,33 @@ toExecutable dir packageName_ =
otherModules = maybe (inferableModules ++ pathsModule) fromList executableSectionOtherModules
generatedModules = maybe [] fromList executableSectionGeneratedOtherModules

expandRtsOptions :: Section ExecutableSection -> Section ExecutableSection
expandRtsOptions = flatten [] . expand
where
expand :: Section ExecutableSection -> Section ([String], ExecutableSection)
expand = fmap go
where
go :: ExecutableSection -> ([String], ExecutableSection)
go exec@ExecutableSection{..} = (fromMaybeList executableSectionRtsOptions, exec)

flatten :: [String] -> Section ([String], ExecutableSection) -> Section ExecutableSection
flatten outerRtsopts sect@Section{sectionData = (innerRtsopts, exec), ..} = sect{
sectionData = exec
, sectionGhcOptions = sectionGhcOptions ++ case innerRtsopts of
[] -> []
_ -> [show $ unwords ("-with-rtsopts" : rtsopts)]
, sectionConditionals = map (fmap $ flatten rtsopts) sectionConditionals
}
where
rtsopts = outerRtsopts ++ innerRtsopts

expandMain :: Section ExecutableSection -> Section ExecutableSection
expandMain = flatten . expand
where
expand :: Section ExecutableSection -> Section ([GhcOption], ExecutableSection)
expand = fmap go
where
go :: ExecutableSection -> ([GhcOption], ExecutableSection)
go exec@ExecutableSection{..} =
let
(mainSrcFile, ghcOptions) = maybe (Nothing, []) (first Just . parseMain) (getLast $ unAlias executableSectionMain)
Expand Down
30 changes: 30 additions & 0 deletions test/EndToEndSpec.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1676,6 +1676,36 @@ spec = around_ (inTempDirectoryNamed "foo") $ do
ghc-options: -main-is Foo
|]

describe "rts-options" $ do
it "maps rts-options to ghc-options" $ do
[i|
executable:
main: Main.hs
rts-options: -s -N
|] `shouldRenderTo` executable_ "foo" [i|
main-is: Main.hs
ghc-options: "-with-rtsopts -s -N"
Copy link
Collaborator

@tfausak tfausak Feb 15, 2023

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Do these need to be quoted, like -with-rtsopts='-s -N'? Or perhaps the flag can be duplicated, like -with-rtsopts=-s -with-rtsopts=-N.

Copy link
Owner Author

@sol sol Feb 16, 2023 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

From reading the motivation for this PR, this it's what I capture: Giving --with-rtsopts multiple times is not accumulative. That's the motivation for this PR in the first place.

Regarding quoting, I assume that what this PR currently does works with Cabal. I haven't tried it again just yet, but pretty sure that I tried when I originally wrote this.

--with-rtsopts='-s -N' may work as well, somebody would need to try. I'm fine with anything that works here, I'm not very opinionated on this.

Copy link
Collaborator

@tfausak tfausak Feb 17, 2023

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I just tried a bunch of things. Here are my findings:

  • -with-rtsopts=-N and -with-rtsopts -N: Works as expected. Doesn't matter if you include the equals sign or not.
  • -with-rtsopts=-N -K1k: Fails because it tries to pass -K1k to GHC rather than to the RTS.
  • -with-rtsopts=-N -with-rtsopts=-K1k: Clobbers the -N flag. Same as setting -with-rtsopts=-K1k.
  • -with-rtsopts='-N' and -with-rtsopts="-N": Fails because it doesn't interpret the quotes, which sends a literal '-N' to the RTS.
  • '-with-rtsopts=-N -K1k' and "-with-rtsopts=-N -K1k": Works! It doesn't matter if you use single or double quotes.

TL;DR: I'd recommend "-with-rtsopts opt1 opt2 ...".

Copy link
Collaborator

@tfausak tfausak Feb 17, 2023

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This Cabal issue is very related: haskell/cabal#4818

Copy link
Owner Author

@sol sol Feb 17, 2023

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Thanks @tfausak for doing all the heavy lifting.

I rarely talk about it in public, but I have had issues with RSI for several years now. when it flares up, I have to stay away from the computer. This is the reason why sometimes I'm less responsive than what I would hope to be.

The TL;DR of it is that I am away from the computer. We still need the read me update, change log entry and version bump. I can try to take care of it eventually. But if somebody wants to lend a hand, then that's still very much appreciated.

Releases are fully automated once the version bump hits main.

Copy link

@istathar istathar Feb 17, 2023

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'd be happy to do the README.md update etc today.

|]

context "inside a conditional" $ do
it "includes rts-options from outer scope" $ do
[i|
executable:
main: Main.hs
rts-options: -s
when:
condition: flag(use-threading)
rts-options: -N
|] `shouldRenderTo` executable "foo" [i|
main-is: Main.hs
ghc-options: "-with-rtsopts -s"
other-modules:
Paths_foo
default-language: Haskell2010
if flag(use-threading)
ghc-options: "-with-rtsopts -s -N"
|]

describe "when" $ do
it "accepts conditionals" $ do
[i|
Expand Down