38e68c0 · obelisk · git.iko.soy

git.iko.soy/obelisk

on master help sign in

Make commmand line argument handling more clear for ob profile

38e68c0Matthew Bauer7 years ago

lib/command/src/Obelisk/Command.hs+3−11

compare with master

unifiedsplit

@@ -16,8 +16,6 @@ import Data.List

16import qualified Data.Text as T

17import Data.Text.Encoding

18import Data.Text.Encoding.Error (lenientDecode)

19−import Data.Time.Clock

20−import Data.Time.Format (formatTime, defaultTimeLocale)

21import GHC.StaticPtr

19import GHC.StaticPtr

22import Options.Applicative

20import Options.Applicative

23import Options.Applicative.Help.Pretty (text, (<$$>))

21import Options.Applicative.Help.Pretty (text, (<$$>))

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

89 = ObCommand_Init InitSource Bool

87 = ObCommand_Init InitSource Bool

90 | ObCommand_Deploy DeployCommand

88 | ObCommand_Deploy DeployCommand

91 | ObCommand_Run

89 | ObCommand_Run

92− | ObCommand_Profile (Maybe FilePath) String

90+ | ObCommand_Profile String [String]

93 | ObCommand_Thunk ThunkCommand

91 | ObCommand_Thunk ThunkCommand

94 | ObCommand_Repl

92 | ObCommand_Repl

95 | ObCommand_Watch

93 | ObCommand_Watch

@@ -111,7 +109,7 @@ obCommand cfg = hsubparser

111 [ 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"

112 , 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"

113 , 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"

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"))) <*> (strOption (long "rts-flags" <> help "RTS Flags to pass to the executable." <> value "-p -hc" <> metavar "FLAGS" <> showDefault))) $ progDesc "Run current project with profiling enabled"

112+ , command "profile" $ info (ObCommand_Profile <$> (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))) $ progDesc "Run current project with profiling enabled"

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

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

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

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

117 , 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"

@@ -370,13 +368,7 @@ ob = \case

370 DeployCommand_Update -> deployUpdate "."

368 DeployCommand_Update -> deployUpdate "."

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

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

372 ObCommand_Run -> run

370 ObCommand_Run -> run

373− ObCommand_Profile mBasePath rtsFlags -> do

374− basePath <- case mBasePath of

375− Just path -> pure path

376− Nothing -> do

377− time <- liftIO $ getCurrentTime

378− pure $ "profile" </> formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" time

379− profile basePath rtsFlags

371+ ObCommand_Profile basePath rtsFlags -> profile basePath rtsFlags

380 ObCommand_Thunk tc -> case tc of

372 ObCommand_Thunk tc -> case tc of

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

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

382 ThunkCommand_Unpack thunks -> for_ thunks unpackThunk

374 ThunkCommand_Unpack thunks -> for_ thunks unpackThunk

lib/command/src/Obelisk/Command/Run.hs+13−4

@@ -26,6 +26,8 @@ import qualified Data.Set as Set

26import Data.String.Here (hereLit)

27import Data.Text (Text)

28import qualified Data.Text as T

29+import Data.Time.Clock

30+import Data.Time.Format (formatTime, defaultTimeLocale)

29import Data.Traversable (for)

31import Data.Traversable (for)

30import Debug.Trace (trace)

32import Debug.Trace (trace)

31import Distribution.Compiler (CompilerFlavor(..))

33import Distribution.Compiler (CompilerFlavor(..))

@@ -77,12 +79,19 @@ preprocessorIdentifier = "__preprocessor-apply-packages"

78profile

80profile

79 :: MonadObelisk m

81 :: MonadObelisk m

80− => FilePath

82+ => String

81− -> String

83+ -> [String]

82 -> m ()

84 -> m ()

83−profile profileBaseName rtsFlags = withProjectRoot "." $ \root -> do

85+profile profileBasePattern rtsFlags = withProjectRoot "." $ \root -> do

84 putLog Debug "Using profiled build of project."

86 putLog Debug "Using profiled build of project."

87+

88+ time <- liftIO $ getCurrentTime

89+ let profileBaseName = formatTime defaultTimeLocale profileBasePattern time

90+

91+ putLog Debug $ T.pack $ "Storing profiled data under base name of " <> profileBaseName

92+

85 liftIO $ createDirectoryIfMissing False $ takeDirectory profileBaseName

93 liftIO $ createDirectoryIfMissing False $ takeDirectory profileBaseName

94+

86 let nixBuildExpr = [hereLit|

95 let nixBuildExpr = [hereLit|

87with (import ./. {});

96with (import ./. {});

88let

97let

@@ -124,7 +133,7 @@ in obelisk.nixpkgs.runCommand "ob-run" {

124 , profileBaseName

133 , profileBaseName

125 , "+RTS"

134 , "+RTS"

126 , "-po" <> profileBaseName

135 , "-po" <> profileBaseName

127− ] <> words rtsFlags

136+ ] <> rtsFlags

128 <> [ "-RTS" ]

137 <> [ "-RTS" ]

129 _ <- liftIO $ waitForProcess ph

138 _ <- liftIO $ waitForProcess ph

130 pure ()

139 pure ()