876957b · obelisk · git.iko.soy

git.iko.soy/obelisk

Clean lint and style

commit876957b4e7f0f8dedb27e8b0cdce4db3208e7cb0 authorElliot Cameron <eacameron@gmail.com> dateThu 20 Feb 2020, 12:16 (7 years ago) parenta505c20

2 files changed+45−41

compare with master

unifiedsplit

lib/command/src/Obelisk/Command.hs+21−17 lib/command/src/Obelisk/Command/Run.hs+24−24

lib/command/src/Obelisk/Command.hs+21−17

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

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

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

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

112− , command "profile" $ info (ObCommand_Profile <$> profileOutputFlag <*> profileRtsFlag) $ progDesc "Run current project with profiling enabled"

112+ , command "profile" $ info (uncurry ObCommand_Profile <$> profileCommand) $ progDesc "Run current project with profiling enabled"

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

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

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

@@ -135,7 +135,7 @@ deployCommand cfg = hsubparser $ mconcat

135135 where

136136 platformP = hsubparser $ mconcat

137137 [ command "android" $ info (pure (Android, [])) mempty

138− , command "ios" $ info ((,) <$> pure IOS <*> (fmap pure $ strArgument (metavar "TEAMID" <> help "Your Team ID - found in the Apple developer portal"))) mempty

138+ , command "ios" $ info ((,) <$> pure IOS <*> fmap pure (strArgument (metavar "TEAMID" <> help "Your Team ID - found in the Apple developer portal"))) mempty

139139 ]

140140

141141 remoteBuilderParser :: Parser (Maybe RemoteBuilder)

@@ -185,6 +185,25 @@ data DeployInitOpts = DeployInitOpts

185185 }

186186 deriving Show

187187

188+profileCommand :: Parser (String, [String])

189+profileCommand = (,)

190+ <$> strOption

191+ ( long "output"

192+ <> short 'o'

193+ <> 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."

194+ <> metavar "PATH"

195+ <> value "profile/%Y-%m-%dT%H:%M:%S"

196+ <> showDefault

197+ )

198+ <*> (words <$> strOption

199+ ( long "rts-flags"

200+ <> help "RTS Flags to pass to the executable."

201+ <> value "-p -hc"

202+ <> metavar "FLAGS"

203+ <> showDefault

204+ ))

205+

206+

188207--TODO: Result should provide normalised path and also original user input for error reporting.

189208thunkDirectoryParser :: Parser FilePath

190209thunkDirectoryParser = fmap (dropTrailingPathSeparator . normalise) . strArgument $ mconcat

@@ -224,21 +243,6 @@ thunkCommand = hsubparser $ mconcat

224243 , command "pack" $ info (ThunkCommand_Pack <$> some thunkDirectoryParser <*> thunkPackConfig) $ progDesc "Pack git checkout into thunk that points at the current branch's upstream"

225244 ]

226245

227−profileRtsFlag :: Parser [String]

228−profileRtsFlag = words <$> strOption ( long "rts-flags"

229− <> help "RTS Flags to pass to the executable."

230− <> value "-p -hc"

231− <> metavar "FLAGS"

232− <> showDefault)

233−

234−profileOutputFlag :: Parser String

235−profileOutputFlag = strOption ( long "output"

236− <> short 'o'

237− <> 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."

238− <> metavar "PATH"

239− <> value "profile/%Y-%m-%dT%H:%M:%S"

240− <> showDefault)

241−

242246data ShellOpts

243247 = ShellOpts

244248 { _shellOpts_shell :: String

lib/command/src/Obelisk/Command/Run.hs+24−24

@@ -10,7 +10,7 @@ module Obelisk.Command.Run where

1010import Control.Arrow ((&&&))

1111import Control.Exception (Exception, bracket)

1212import Control.Lens (ifor, (.~), (&))

13−import Control.Monad (filterM, unless)

13+import Control.Monad (filterM, unless, void)

1414import Control.Monad.Except (runExceptT, throwError)

1515import Control.Monad.IO.Class (liftIO)

1616import Control.Monad.Reader (MonadIO)

@@ -26,7 +26,7 @@ import qualified Data.Set as Set

2626import Data.String.Here (hereLit)

2727import Data.Text (Text)

2828import qualified Data.Text as T

29−import Data.Time.Clock

29+import Data.Time.Clock (getCurrentTime)

3030import Data.Time.Format (formatTime, defaultTimeLocale)

3131import Data.Traversable (for)

3232import Debug.Trace (trace)

@@ -87,14 +87,33 @@ profile

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

8888 putLog Debug "Using profiled build of project."

8989

90− time <- liftIO $ getCurrentTime

90+ time <- liftIO getCurrentTime

9191 let profileBaseName = formatTime defaultTimeLocale profileBasePattern time

9292

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

9494

9595 liftIO $ createDirectoryIfMissing False $ takeDirectory profileBaseName

9696

97− let nixBuildExpr = [hereLit|

97+ exePath <- nixCmd $ NixCmd_Build $ def

98+ & nixBuildConfig_outLink .~ OutLink_None

99+ & nixCmdConfig_target .~ Target

100+ { _target_path = Nothing

101+ , _target_attr = Nothing

102+ , _target_expr = Just nixBuildExpr }

103+ assets <- findProjectAssets root

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

105+ freePort <- getFreePort

106+ (_, _, _, ph) <- createProcess_ "runProfExe" $ setCwd (Just root) $ setDelegateCtlc True $ proc exePath $

107+ [ show freePort

108+ , T.unpack assets

109+ , profileBaseName

110+ , "+RTS"

111+ , "-po" <> profileBaseName

112+ ] <> rtsFlags

113+ <> [ "-RTS" ]

114+ void $ waitForProcess ph

115+ where

116+ nixBuildExpr = [hereLit|

98117with (import ./. {});

99118let

100119 exeSource = obelisk.nixpkgs.writeText "ob-run" ''

@@ -120,25 +139,6 @@ in obelisk.nixpkgs.runCommand "ob-run" {

120139 buildInputs = [ (profiled.ghc.ghcWithPackages (p: [ p.backend p.frontend])) ];

121140} "ghc -x hs -prof -fno-prof-auto -threaded ${exeSource} -o $out"

122141|]

123− exePath <- nixCmd $ NixCmd_Build $ def

124− & nixBuildConfig_outLink .~ OutLink_None

125− & nixCmdConfig_target .~ Target

126− { _target_path = Nothing

127− , _target_attr = Nothing

128− , _target_expr = Just nixBuildExpr }

129− assets <- findProjectAssets root

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

131− freePort <- getFreePort

132− (_, _, _, ph) <- createProcess_ "runProfExe" $ setCwd (Just root) $ setDelegateCtlc True $ proc exePath $

133− [ show freePort

134− , T.unpack assets

135− , profileBaseName

136− , "+RTS"

137− , "-po" <> profileBaseName

138− ] <> rtsFlags

139− <> [ "-RTS" ]

140− _ <- waitForProcess ph

141− pure ()

142142

143143run

144144 :: MonadObelisk m

@@ -336,7 +336,7 @@ withGhciScript packageInfos pathBase f = do

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

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

338338 ]

339− dotGhci = unlines $

339+ dotGhci = unlines

340340 -- TODO: Shell escape

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

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