git.iko.soy/obelisk
on master help sign in
Allow passing custom RTS flags to ob profile

This allows custom flags to be provided by the user. For instance, there are multiple types of heap profiles that can be used to get different information from ob profile. These can be added with the --rts-flags option.

commit0743c6da65f3e55596113ec4524eccdb6b3bccb6 authorMatthew Bauer <mjbauer95@gmail.com> dateWed 19 Feb 2020, 11:37 (7 years ago) parent7ce5d5b
2 files changed+16−7
compare with master
unifiedsplit
lib/command/src/Obelisk/Command.hs+4−4 lib/command/src/Obelisk/Command/Run.hs+12−3
lib/command/src/Obelisk/Command.hs+4−4
@@ -89,7 +89,7 @@ data ObCommand
8989 = ObCommand_Init InitSource Bool
9090 | ObCommand_Deploy DeployCommand
9191 | ObCommand_Run
92− | ObCommand_Profile (Maybe FilePath)
92+ | ObCommand_Profile (Maybe FilePath) (Maybe String)
9393 | ObCommand_Thunk ThunkCommand
9494 | ObCommand_Repl
9595 | ObCommand_Watch
@@ -111,7 +111,7 @@ obCommand cfg = hsubparser
111111 [ command "init" $ info (ObCommand_Init <$> initSource <*> initForce) $ progDesc "Initialize an Obelisk project"
112112 , command "deploy" $ info (ObCommand_Deploy <$> deployCommand cfg) $ progDesc "Prepare a deployment for an Obelisk project"
113113 , command "run" $ info (pure ObCommand_Run) $ progDesc "Run current project in development mode"
114− , command "profile" $ info (ObCommand_Profile <$> optional (strOption (long "output" <> short 'o' <> help "Base output to use for profiling output. Suffixes are added to this based on the profiling type. Defaults to a timestamped path in the profile/ directory in the project's root." <> metavar "PATH"))) $ progDesc "Run current project with profiling enabled"
114+ , command "profile" $ info (ObCommand_Profile <$> (optional (strOption (long "output" <> short 'o' <> help "Base output to use for profiling output. Suffixes are added to this based on the profiling type. Defaults to a timestamped path in the profile/ directory in the project's root." <> metavar "PATH"))) <*> (optional (strOption (long "rts-flags" <> help "RTS Flags to pass to the executable" <> metavar "FLAGS")))) $ progDesc "Run current project with profiling enabled"
115115 , command "thunk" $ info (ObCommand_Thunk <$> thunkCommand) $ progDesc "Manipulate thunk directories"
116116 , command "repl" $ info (pure ObCommand_Repl) $ progDesc "Open an interactive interpreter"
117117 , command "watch" $ info (pure ObCommand_Watch) $ progDesc "Watch current project for errors and warnings"
@@ -370,13 +370,13 @@ ob = \case
370370 DeployCommand_Update -> deployUpdate "."
371371 DeployCommand_Test (platform, extraArgs) -> deployMobile platform extraArgs
372372 ObCommand_Run -> run
373− ObCommand_Profile mBasePath -> do
373+ ObCommand_Profile mBasePath rtsFlags -> do
374374 basePath <- case mBasePath of
375375 Just path -> pure path
376376 Nothing -> do
377377 time <- liftIO $ getCurrentTime
378378 pure $ "profile" </> formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" time
379− profile basePath
379+ profile basePath rtsFlags
380380 ObCommand_Thunk tc -> case tc of
381381 ThunkCommand_Update thunks config -> for_ thunks (updateThunkToLatest config)
382382 ThunkCommand_Unpack thunks -> for_ thunks unpackThunk
lib/command/src/Obelisk/Command/Run.hs+12−3
@@ -78,13 +78,15 @@ preprocessorIdentifier = "__preprocessor-apply-packages"
7878profile
7979 :: MonadObelisk m
8080 => FilePath
81+ -> Maybe String
8182 -> m ()
82−profile profileBaseName = withProjectRoot "." $ \root -> do
83+profile profileBaseName mRtsFlags = withProjectRoot "." $ \root -> do
8384 putLog Debug "Using profiled build of project."
8485 liftIO $ createDirectoryIfMissing False $ takeDirectory profileBaseName
8586 let -- Sane flags to enable by default, enable time profiling +
8687 -- closure heap profiling.
87− rtsFlags = [ "+RTS", "-p", "-po" <> profileBaseName, "-hc", "-RTS" ]
88+ defaultRtsFlags = [ "-p", "-hc" ]
89+ rtsFlags = maybe defaultRtsFlags words mRtsFlags
8890 nixBuildExpr = [hereLit|
8991with (import ./. {});
9092let
@@ -120,7 +122,14 @@ in obelisk.nixpkgs.runCommand "ob-run" {
120122 assets <- findProjectAssets root
121123 putLog Debug $ "Assets impurely loaded from: " <> assets
122124 freePort <- getFreePort
123− (_, _, _, ph) <- createProcess_ "runProfExe" $ setCwd (Just root) $ setDelegateCtlc True $ proc exePath ([show freePort, T.unpack assets, profileBaseName] <> rtsFlags)
125+ (_, _, _, ph) <- createProcess_ "runProfExe" $ setCwd (Just root) $ setDelegateCtlc True $ proc exePath $
126+ [ show freePort
127+ , T.unpack assets
128+ , profileBaseName
129+ , "+RTS"
130+ , "-po" <> profileBaseName ]
131+ <> rtsFlags
132+ <> ["-RTS"]
124133 _ <- liftIO $ waitForProcess ph
125134 pure ()
126135