53d3dff · obelisk · git.iko.soy

git.iko.soy/obelisk

Add ob profile command

53d3dffMatthew Bauer7 years ago

ChangeLog.md+3

@@ -8,6 +8,9 @@ This project's release branch is `master`. This log is written from the perspect

8* Add local unpacked packages to the `ob run`, `ob watch`, and `ob repl` sessions. Any `.cabal` or hpack package inside the current obelisk project will be loaded into the session. For `ob run`/`ob watch` this means the session will automatically reload when you save a source file in any of those packages. For `ob repl` it means that `:r` will reload changes to any of those packages. There are some edge cases where this integration is still rough. Report any issues you encounter. ([#489](https://github.com/obsidiansystems/obelisk/pull/489))

9* Add `ob hoogle` command to start a local [Hoogle](https://hoogle.haskell.org/) server for the project. ([#628](https://github.com/obsidiansystems/obelisk/pull/628))

10* `ob thunk pack` will now attempt to automatically detect if the thunk is a private or public repo. To avoid this detection, specify `--private` or `--public` manually. ([#607](https://github.com/obsidiansystems/obelisk/pull/607))

11+* Add `ob profile` command to run Obelisk project with profiling. `ob

12+profile` works like ob run, but instead of using ghci, it builds an

13+executable that is built with profiling enabled.

12## v0.4.0.0 - 2020-01-10

15## v0.4.0.0 - 2020-01-10

lib/command/src/Obelisk/Command.hs+4−1

@@ -87,6 +87,7 @@ data ObCommand

87 = ObCommand_Init InitSource Bool

88 | ObCommand_Deploy DeployCommand

89 | ObCommand_Run

90+ | ObCommand_Profile

90 | ObCommand_Thunk ThunkCommand

91 | ObCommand_Thunk ThunkCommand

91 | ObCommand_Repl

92 | ObCommand_Repl

92 | ObCommand_Watch

93 | ObCommand_Watch

@@ -108,6 +109,7 @@ obCommand cfg = hsubparser

108 [ command "init" $ info (ObCommand_Init <$> initSource <*> initForce) $ progDesc "Initialize an Obelisk project"

109 [ command "init" $ info (ObCommand_Init <$> initSource <*> initForce) $ progDesc "Initialize an Obelisk project"

109 , command "deploy" $ info (ObCommand_Deploy <$> deployCommand cfg) $ progDesc "Prepare a deployment for an Obelisk project"

110 , command "deploy" $ info (ObCommand_Deploy <$> deployCommand cfg) $ progDesc "Prepare a deployment for an Obelisk project"

110 , command "run" $ info (pure ObCommand_Run) $ progDesc "Run current project in development mode"

111 , command "run" $ info (pure ObCommand_Run) $ progDesc "Run current project in development mode"

112+ , command "profile" $ info (pure ObCommand_Profile) $ progDesc "Run current project with profiling enabled"

111 , command "thunk" $ info (ObCommand_Thunk <$> thunkCommand) $ progDesc "Manipulate thunk directories"

113 , command "thunk" $ info (ObCommand_Thunk <$> thunkCommand) $ progDesc "Manipulate thunk directories"

112 , command "repl" $ info (pure ObCommand_Repl) $ progDesc "Open an interactive interpreter"

114 , command "repl" $ info (pure ObCommand_Repl) $ progDesc "Open an interactive interpreter"

113 , command "watch" $ info (pure ObCommand_Watch) $ progDesc "Watch current project for errors and warnings"

115 , command "watch" $ info (pure ObCommand_Watch) $ progDesc "Watch current project for errors and warnings"

@@ -365,7 +367,8 @@ ob = \case

365 Just RemoteBuilder_ObeliskVM -> (:[]) <$> VmBuilder.getNixBuildersArg

367 Just RemoteBuilder_ObeliskVM -> (:[]) <$> VmBuilder.getNixBuildersArg

366 DeployCommand_Update -> deployUpdate "."

368 DeployCommand_Update -> deployUpdate "."

367 DeployCommand_Test (platform, extraArgs) -> deployMobile platform extraArgs

369 DeployCommand_Test (platform, extraArgs) -> deployMobile platform extraArgs

368− ObCommand_Run -> run

370+ ObCommand_Run -> run False

371+ ObCommand_Profile -> run True

369 ObCommand_Thunk tc -> case tc of

372 ObCommand_Thunk tc -> case tc of

370 ThunkCommand_Update thunks config -> for_ thunks (updateThunkToLatest config)

373 ThunkCommand_Update thunks config -> for_ thunks (updateThunkToLatest config)

371 ThunkCommand_Unpack thunks -> for_ thunks unpackThunk

374 ThunkCommand_Unpack thunks -> for_ thunks unpackThunk

lib/command/src/Obelisk/Command/Run.hs+67−20

@@ -42,12 +42,15 @@ import Language.Haskell.Extension

42import Network.Socket hiding (Debug)

43import System.Directory

44import System.Environment (getExecutablePath)

45+import System.Exit (ExitCode (ExitSuccess, ExitFailure))

45import System.FilePath

46import System.FilePath

46import qualified System.Info

47import qualified System.Info

48+import System.IO (hPutStr, hFlush, hClose)

47−import System.IO.Temp (withSystemTempDirectory)

49+import System.IO.Temp (withSystemTempDirectory, withSystemTempFile)

50+import System.Process (waitForProcess)

49import Obelisk.App (MonadObelisk)

52import Obelisk.App (MonadObelisk)

50−import Obelisk.CliApp (Severity (..) , failWith, putLog, proc, readCreateProcessWithExitCode)

53+import Obelisk.CliApp (Severity (..) , failWith, putLog, proc, readCreateProcessWithExitCode, setCwd, setDelegateCtlc, createProcess_)

51import Obelisk.Command.Project (obeliskDirName, toObeliskDir, withProjectRoot, nixShellWithPkgs, findProjectAssets)

54import Obelisk.Command.Project (obeliskDirName, toObeliskDir, withProjectRoot, nixShellWithPkgs, findProjectAssets)

52import Obelisk.Command.Thunk (attrCacheFileName)

55import Obelisk.Command.Thunk (attrCacheFileName)

53import Obelisk.Command.Utils (findExePath, ghcidExePath)

56import Obelisk.Command.Utils (findExePath, ghcidExePath)

@@ -71,20 +74,67 @@ data CabalPackageInfo = CabalPackageInfo

71preprocessorIdentifier :: String

74preprocessorIdentifier :: String

72preprocessorIdentifier = "__preprocessor-apply-packages"

75preprocessorIdentifier = "__preprocessor-apply-packages"

77+-- | Imports needed to use Obelisk.Run

78+obRunImports :: [String]

79+obRunImports = [ "import qualified Obelisk.Run"

80+ , "import qualified Frontend"

81+ , "import qualified Backend" ]

82+

83+run

74−run :: MonadObelisk m => m ()

84+ :: MonadObelisk m

85+ => Bool

86+ -- ^ Whether to enable profiling in the current project

87+ -> m ()

75−run = withProjectRoot "." $ \root -> do

88+run profiled = withProjectRoot "." $ \root -> do

76 pkgs <- fmap toList . parsePackagesOrFail =<< getLocalPkgs root

89 pkgs <- fmap toList . parsePackagesOrFail =<< getLocalPkgs root

77− withGhciScript pkgs root $ \dotGhciPath -> do

78− freePort <- getFreePort

90+ freePort <- getFreePort

79− assets <- findProjectAssets root

91+ assets <- findProjectAssets root

80− putLog Debug $ "Assets impurely loaded from: " <> assets

92+ putLog Debug $ "Assets impurely loaded from: " <> assets

81− runGhcid root True dotGhciPath pkgs $ Just $ unwords

93+ let obRunExpr = unwords

82− [ "Obelisk.Run.run"

94+ [ "Obelisk.Run.run"

83− , show freePort

95+ , show freePort

84− , "(Obelisk.Run.runServeAsset " ++ show assets ++ ")"

96+ , "(Obelisk.Run.runServeAsset " ++ show assets ++ ")"

85− , "Backend.backend"

97+ , "Backend.backend"

86− , "Frontend.frontend"

98+ , "Frontend.frontend"

87− ]

99+ ]

100+ case profiled of

101+ True -> do

102+ putLog Debug "Using profiled build of project."

103+ let exeSource =

104+ unlines $

105+ [ "module Main where"

106+ , "import Control.Concurrent"

107+ , "import Control.Monad.Fix"

108+ , "import Reflex.Profiled" ]

109+ <> obRunImports <>

110+ [ "main :: IO ()"

111+ , "main = do"

112+ , " forkIO $ fix $ \\rec -> do"

113+ -- TODO: make this filename customizable

114+ , " writeProfilingData \"ob-run.rfprof\""

115+ -- write every .1 seconds.

116+ -- TODO: perhaps it should only write once at the end of ecah run

117+ , " threadDelay 10000"

118+ , " rec"

119+ , " " <> obRunExpr]

120+ -- sane flags to enable by default, enable time profiling + closure heap profiling

121+ rtsFlags = [ "+RTS", "-p", "-hc", "-RTS" ]

122+ withSystemTempFile "ob-run-profiled.hs" $ \hsFname hsHandle -> withSystemTempFile "ob-run" $ \exeFname exeHandle -> do

123+ liftIO $ hPutStr hsHandle exeSource

124+ liftIO $ hFlush hsHandle

125+ (_, _, _, ph1) <- createProcess_ "nixGhcWithProfiling" $ setCwd (Just root) $ proc "nix-shell" [ "-p", "((import ./. {}).profiled.ghc.ghcWithPackages (p: [ p.backend p.frontend]))", "--run", unwords [ "ghc", "-x", "hs", "-prof", "-fprof-auto", hsFname, "-o", exeFname ] ]

126+ code <- liftIO $ waitForProcess ph1

127+ case code of

128+ ExitSuccess -> do

129+ liftIO $ hClose exeHandle

130+ (_, _, _, ph2) <- createProcess_ "runProfExe" $ setCwd (Just root) $ setDelegateCtlc True $ proc exeFname rtsFlags

131+ _ <- liftIO $ waitForProcess ph2

132+ pure ()

133+ ExitFailure _ -> do

134+ pure ()

135+ False ->

136+ withGhciScript pkgs root $ \dotGhciPath -> do

137+ runGhcid root True dotGhciPath pkgs $ Just obRunExpr

138

89runRepl :: MonadObelisk m => m ()

139runRepl :: MonadObelisk m => m ()

90runRepl = withProjectRoot "." $ \root -> do

140runRepl = withProjectRoot "." $ \root -> do

@@ -256,15 +306,12 @@ withGhciScript packageInfos pathBase f = do

256 , [ "Backend" | "backend" `Set.member` packageNames ]

306 , [ "Backend" | "backend" `Set.member` packageNames ]

257 , [ "Frontend" | "frontend" `Set.member` packageNames ]

307 , [ "Frontend" | "frontend" `Set.member` packageNames ]

258 ]

308 ]

259− dotGhci = unlines

309+ dotGhci = unlines $

260 -- TODO: Shell escape

310 -- TODO: Shell escape

261 [ ":set -F -pgmF " <> selfExe <> " -optF " <> preprocessorIdentifier <> " " <> unwords (map (("-optF " <>) . makeRelative pathBase . _cabalPackageInfo_packageFile) packageInfos)

311 [ ":set -F -pgmF " <> selfExe <> " -optF " <> preprocessorIdentifier <> " " <> unwords (map (("-optF " <>) . makeRelative pathBase . _cabalPackageInfo_packageFile) packageInfos)

262 , ":set -i" <> intercalate ":" (packageInfos >>= rootedSourceDirs)

312 , ":set -i" <> intercalate ":" (packageInfos >>= rootedSourceDirs)

263 , if null modulesToLoad then "" else ":load " <> unwords modulesToLoad

313 , if null modulesToLoad then "" else ":load " <> unwords modulesToLoad

264− , "import qualified Obelisk.Run"

314+ ] <> obRunImports

265− , "import qualified Frontend"

266− , "import qualified Backend"

267− ]

268 withSystemTempDirectory "ob-ghci" $ \fp -> do

315 withSystemTempDirectory "ob-ghci" $ \fp -> do

269 let dotGhciPath = fp </> ".ghci"

316 let dotGhciPath = fp </> ".ghci"

270 liftIO $ writeFile dotGhciPath dotGhci

317 liftIO $ writeFile dotGhciPath dotGhci