Add obelisk profiling feature

ChangeLog.md

@@ -22,6 +22,9 @@ This project's release branch is `master`. This log is written from the perspect
 * `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))
 * Fix a bug in the plain git thunk loader for thunks marked as 'private' when the revision is not in the default branch. ([#648](https://github.com/obsidiansystems/obelisk/pull/648))
 * Improve handling of runtime nix dependencies. This may fix some issues encountered particularly by users on systems other than NixOS.
+* Add `ob profile` command to run Obelisk project with profiling. `ob
+profile` works like ob run, but instead of using ghci, it builds an
+executable that is built with profiling enabled.
 
 ## v0.4.0.0 - 2020-01-10
 

default.nix

@@ -17,10 +17,8 @@ let
     openssh
   ];
 
-  getReflexPlatform = sys: reflex-platform-func {
-    inherit iosSdkVersion config;
-    system = sys;
-    enableLibraryProfiling = profiling;
+  getReflexPlatform = { system, enableLibraryProfiling ? profiling }: reflex-platform-func {
+    inherit iosSdkVersion config system enableLibraryProfiling;
 
     nixpkgsOverlays = [
       (self: super: {
@@ -102,7 +100,7 @@ let
     ];
   };
 
-  reflex-platform = getReflexPlatform system;
+  reflex-platform = getReflexPlatform { inherit system; };
   inherit (reflex-platform) hackGet nixpkgs;
   pkgs = nixpkgs;
 
@@ -261,7 +259,7 @@ in rec {
   # An Obelisk project is a reflex-platform project with a predefined layout and role for each component
   project = base': projectDefinition:
     let
-      projectOut = sys: let reflexPlatformProject = (getReflexPlatform sys).project; in reflexPlatformProject (args@{ nixpkgs, ... }:
+      projectOut = { system, enableLibraryProfiling ? profiling }: let reflexPlatformProject = (getReflexPlatform { inherit system enableLibraryProfiling; }).project; in reflexPlatformProject (args@{ nixpkgs, ... }:
         let
           inherit (lib.strings) hasPrefix;
           mkProject =
@@ -366,7 +364,7 @@ in rec {
               });
             in allConfig;
         in (mkProject (projectDefinition args)).projectConfig);
-      mainProjectOut = projectOut system;
+      mainProjectOut = projectOut { inherit system; };
       serverOn = projectInst: version: serverExe
         projectInst.ghc.backend
         mainProjectOut.ghcjs.frontend
@@ -376,6 +374,7 @@ in rec {
       linuxExe = serverOn (projectOut "x86_64-linux");
       dummyVersion = "Version number is only available for deployments";
     in mainProjectOut // {
+      profiled = projectOut { inherit system; enableLibraryProfiling = true; };
       linuxExeConfigurable = linuxExe;
       linuxExe = linuxExe dummyVersion;
       exe = serverOn mainProjectOut dummyVersion;

dep/reflex-platform/github.json

@@ -1,8 +1,8 @@
 {
   "owner": "reflex-frp",
   "repo": "reflex-platform",
-  "branch": "master",
+  "branch": "bump-reflex-0-6-4-1",
   "private": false,
-  "rev": "5429278830e1555a577f2550e045ce7f7164aa65",
-  "sha256": "1lp86cgccmim573rarsjny5vh0ygkfp5afq7006li0k9w2sw2d4c"
+  "rev": "38060894cb377160d1217305334f7f11202042d4",
+  "sha256": "0n47fcwj9szy3aqip0smmxdsp9fr78985rdslpmx2zdlkswmm5r1"
 }

lib/cliapp/src/Obelisk/CliApp.hs

@@ -51,6 +51,7 @@ module Obelisk.CliApp
   , setDelegateCtlc
   , setEnvOverride
   , shell
+  , waitForProcess
   ) where
 
 import Control.Monad.Log (Severity (..))

lib/cliapp/src/Obelisk/CliApp/Process.hs

@@ -28,6 +28,7 @@ module Obelisk.CliApp.Process
   , setDelegateCtlc
   , setEnvOverride
   , shell
+  , waitForProcess
   ) where
 
 import Control.Monad ((<=<), join, void)
@@ -51,7 +52,7 @@ import System.IO (Handle)
 import System.IO.Streams (InputStream, handleToInputStream)
 import qualified System.IO.Streams as Streams
 import System.IO.Streams.Concurrent (concurrentMerge)
-import System.Process (CreateProcess, ProcessHandle, StdStream (CreatePipe), std_err, std_out, waitForProcess)
+import System.Process (CreateProcess, ProcessHandle, StdStream (CreatePipe), std_err, std_out)
 import qualified System.Process as Process
 import qualified Data.Aeson as Aeson
 
@@ -143,7 +144,7 @@ readProcessAndLogOutput (sev_out, sev_err) process = do
   outText <- liftIO $ T.decodeUtf8With lenientDecode <$> BS.hGetContents out
   putLogRaw sev_out outText
 
-  liftIO (waitForProcess p) >>= \case
+  waitForProcess p >>= \case
     ExitSuccess -> pure outText
     ExitFailure code -> throwError $ review asProcessFailure $ ProcessFailure (Process.cmdspec $ _processSpec_createProcess process) code
 
@@ -218,7 +219,7 @@ withProcess process f = do -- TODO: Use bracket.
 
   f out err  -- Pass the handles to the passed function
 
-  liftIO (waitForProcess p) >>= \case
+  waitForProcess p >>= \case
     ExitSuccess -> return (out, err)
     ExitFailure code -> throwError $ review asProcessFailure $ ProcessFailure (Process.cmdspec $ _processSpec_createProcess process) code
 
@@ -235,6 +236,10 @@ streamToLog stream = fix $ \loop -> do
     Nothing -> return ()
     Just (sev, line) -> putLogRaw sev (T.decodeUtf8With lenientDecode line) >> loop
 
+-- | Wrapper around `System.Process.waitForProcess`
+waitForProcess :: MonadIO m => ProcessHandle -> m ExitCode
+waitForProcess = liftIO . Process.waitForProcess
+
 -- | Pretty print a 'CmdSpec'
 reconstructCommand :: Process.CmdSpec -> Text
 reconstructCommand p = case p of

lib/command/src/Obelisk/Command.hs

@@ -87,6 +87,7 @@ data ObCommand
    = ObCommand_Init InitSource Bool
    | ObCommand_Deploy DeployCommand
    | ObCommand_Run
+   | ObCommand_Profile String [String]
    | ObCommand_Thunk ThunkCommand
    | ObCommand_Repl
    | ObCommand_Watch
@@ -108,6 +109,7 @@ obCommand cfg = hsubparser
     [ command "init" $ info (ObCommand_Init <$> initSource <*> initForce) $ progDesc "Initialize an Obelisk project"
     , command "deploy" $ info (ObCommand_Deploy <$> deployCommand cfg) $ progDesc "Prepare a deployment for an Obelisk project"
     , command "run" $ info (pure ObCommand_Run) $ progDesc "Run current project in development mode"
+    , command "profile" $ info (uncurry ObCommand_Profile <$> profileCommand) $ progDesc "Run current project with profiling enabled"
     , command "thunk" $ info (ObCommand_Thunk <$> thunkCommand) $ progDesc "Manipulate thunk directories"
     , command "repl" $ info (pure ObCommand_Repl) $ progDesc "Open an interactive interpreter"
     , command "watch" $ info (pure ObCommand_Watch) $ progDesc "Watch current project for errors and warnings"
@@ -133,7 +135,7 @@ deployCommand cfg = hsubparser $ mconcat
   where
     platformP = hsubparser $ mconcat
       [ command "android" $ info (pure (Android, [])) mempty
-      , command "ios"     $ info ((,) <$> pure IOS <*> (fmap pure $ strArgument (metavar "TEAMID" <> help "Your Team ID - found in the Apple developer portal"))) mempty
+      , command "ios" $ info ((,) <$> pure IOS <*> fmap pure (strArgument (metavar "TEAMID" <> help "Your Team ID - found in the Apple developer portal"))) mempty
       ]
 
     remoteBuilderParser :: Parser (Maybe RemoteBuilder)
@@ -183,6 +185,25 @@ data DeployInitOpts = DeployInitOpts
   }
   deriving Show
 
+profileCommand :: Parser (String, [String])
+profileCommand = (,)
+  <$> 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"
+    <> value "profile/%Y-%m-%dT%H:%M:%S"
+    <> showDefault
+    )
+  <*> (words <$> strOption
+    (  long "rts-flags"
+    <> help "RTS Flags to pass to the executable."
+    <> value "-p -hc"
+    <> metavar "FLAGS"
+    <> showDefault
+    ))
+
+
 --TODO: Result should provide normalised path and also original user input for error reporting.
 thunkDirectoryParser :: Parser FilePath
 thunkDirectoryParser = fmap (dropTrailingPathSeparator . normalise) . strArgument $ mconcat
@@ -366,6 +387,7 @@ ob = \case
     DeployCommand_Update -> deployUpdate "."
     DeployCommand_Test (platform, extraArgs) -> deployMobile platform extraArgs
   ObCommand_Run -> run
+  ObCommand_Profile basePath rtsFlags -> profile basePath rtsFlags
   ObCommand_Thunk tc -> case tc of
     ThunkCommand_Update thunks config -> for_ thunks (updateThunkToLatest config)
     ThunkCommand_Unpack thunks -> for_ thunks unpackThunk

lib/command/src/Obelisk/Command/Project.hs

@@ -5,6 +5,7 @@ module Obelisk.Command.Project
   ( InitSource (..)
   , findProjectObeliskCommand
   , findProjectRoot
+  , findProjectAssets
   , initProject
   , nixShellRunConfig
   , nixShellRunProc
@@ -41,7 +42,6 @@ import System.IO.Temp
 import System.IO.Unsafe (unsafePerformIO)
 import System.Posix (FileStatus, FileMode, CMode (..), UserID, deviceID, fileID, fileMode, fileOwner, getFileStatus, getRealUserID)
 import System.Posix.Files
-import System.Process (waitForProcess)
 
 import GitHub.Data.GitData (Branch)
 import GitHub.Data.Name (Name)
@@ -50,7 +50,7 @@ import Obelisk.App (MonadObelisk)
 import Obelisk.CliApp
 import Obelisk.Command.Nix
 import Obelisk.Command.Thunk
-import Obelisk.Command.Utils (nixExePath)
+import Obelisk.Command.Utils (nixExePath, nixBuildExePath)
 
 --TODO: Make this module resilient to random exceptions
 
@@ -287,7 +287,7 @@ nixShellWithPkgs root isPure chdirToRoot packageNamesAndPaths command = do
         [ rawArg "root" $ toNixPath $ if chdirToRoot then "." else root
         , strArg "pkgs" (T.unpack $ decodeUtf8 $ BSL.toStrict $ Json.encode packageNamesAndAbsPaths)
         ]
-  void $ liftIO $ waitForProcess ph
+  void $ waitForProcess ph
 
 nixShellWithHoogle :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()
 nixShellWithHoogle root isPure shell' command = do
@@ -298,12 +298,32 @@ nixShellWithHoogle root isPure shell' command = do
           \userSettings = super.userSettings // { withHoogle = true; };\
         \})).project.shells.${shell}"
     & nixShellConfig_common . nixCmdConfig_args .~ [ strArg "shell" shell' ]
-  void $ liftIO $ waitForProcess ph
+  void $ waitForProcess ph
 
 projectShell :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()
 projectShell root isPure shellName command = do
   defShellConfig <- nixShellRunConfig root isPure command
   (_, _, _, ph) <- createProcess_ "runNixShellAttr" $ setCwd (Just root) $ nixShellRunProc $ defShellConfig
     & nixShellConfig_common . nixCmdConfig_target . target_path ?~ "default.nix"
     & nixShellConfig_common . nixCmdConfig_target . target_attr ?~ ("shells." <> shellName)
-  void $ liftIO $ waitForProcess ph
+  void $ waitForProcess ph
+
+findProjectAssets :: MonadObelisk m => FilePath -> m Text
+findProjectAssets root = do
+  isDerivation <- readProcessAndLogStderr Debug $ setCwd (Just root) $
+    proc nixExePath
+      [ "eval"
+      , "(let a = import ./. {}; in toString (a.reflex.nixpkgs.lib.isDerivation a.passthru.staticFilesImpure))"
+      , "--raw"
+      -- `--raw` is not available with old nix-instantiate. It drops quotation
+      -- marks and trailing newline, so is very convenient for shelling out.
+      ]
+  -- Check whether the impure static files are a derivation (and so must be built)
+  if isDerivation == "1"
+    then fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $ -- Strip whitespace here because nix-build has no --raw option
+      proc nixBuildExePath
+        [ "--no-out-link"
+        , "-E", "(import ./. {}).passthru.staticFilesImpure"
+        ]
+    else readProcessAndLogStderr Debug $ setCwd (Just root) $
+      proc nixExePath ["eval", "-f", ".", "passthru.staticFilesImpure", "--raw"]