git.iko.soy/obelisk
on master help sign in
Add an "ob shell" command
commit851967e67d5df125c4d8b522e702489eeb2a4526 authorCale Gibbard <cgibbard@gmail.com> dateThu 25 Apr 2019, 14:36 (7 years ago) parent67adcf3
2 files changed+26−6
compare with master
unifiedsplit
lib/command/src/Obelisk/Command.hs+20−1 lib/command/src/Obelisk/Command/Project.hs+6−5
lib/command/src/Obelisk/Command.hs+20−1
@@ -92,6 +92,7 @@ data ObCommand
9292 | ObCommand_Thunk ThunkCommand
9393 | ObCommand_Repl
9494 | ObCommand_Watch
95+ | ObCommand_Shell ShellOpts
9596 | ObCommand_Internal ObInternal
9697 deriving Show
9798
@@ -103,7 +104,7 @@ data ObInternal
103104inNixShell' :: MonadObelisk m => StaticPtr (ObeliskT IO ()) -> m ()
104105inNixShell' p = withProjectRoot "." $ \root -> do
105106 cmd <- liftIO $ unwords <$> mkCmd -- TODO: shell escape instead of unwords
106− projectShell root False "ghc" cmd
107+ projectShell root False "ghc" (Just cmd)
107108 where
108109 mkCmd = do
109110 argsCfg <- getArgsConfig
@@ -127,6 +128,7 @@ obCommand cfg = hsubparser
127128 , command "thunk" $ info (ObCommand_Thunk <$> thunkCommand) $ progDesc "Manipulate thunk directories"
128129 , command "repl" $ info (pure ObCommand_Repl) $ progDesc "Open an interactive interpreter"
129130 , command "watch" $ info (pure ObCommand_Watch) $ progDesc "Watch current project for errors and warnings"
131+ , command "shell" $ info (ObCommand_Shell <$> shellOpts) $ progDesc "Enter a shell with project dependencies"
130132 ])
131133 <|> subparser
132134 (mconcat
@@ -221,6 +223,21 @@ thunkCommand = hsubparser $ mconcat
221223 , command "pack" $ info (ThunkCommand_Pack <$> some thunkDirectoryParser) $ progDesc "Pack git checkout into thunk that points at the current branch's upstream"
222224 ]
223225
226+data ShellOpts
227+ = ShellOpts
228+ { _shellOpts_shell :: String
229+ , _shellOpts_command :: Maybe String
230+ }
231+ deriving Show
232+
233+shellOpts :: Parser ShellOpts
234+shellOpts = ShellOpts
235+ <$> ( flag' "ghc" (long "ghc" <> help "Enter a shell environment having ghc (default)")
236+ <|> flag "ghc" "ghcjs" (long "ghcjs" <> help "Enter a shell having ghcjs rather than ghc")
237+ <|> strOption (short 'A' <> long "argument" <> metavar "NIXARG" <> help "Use the environment specified by the given nix argument of `shells'")
238+ )
239+ <*> optional (strArgument (metavar "COMMAND"))
240+
224241parserPrefs :: ParserPrefs
225242parserPrefs = defaultPrefs
226243 { prefShowHelpOnEmpty = True
@@ -347,6 +364,8 @@ ob = \case
347364 ThunkCommand_Pack thunks -> forM_ thunks packThunk
348365 ObCommand_Repl -> runRepl
349366 ObCommand_Watch -> inNixShell' $ static runWatch
367+ ObCommand_Shell so -> withProjectRoot "." $ \root ->
368+ projectShell root False (_shellOpts_shell so) (_shellOpts_command so)
350369 ObCommand_Internal icmd -> case icmd of
351370 ObInternal_RunStaticIO k -> liftIO (unsafeLookupStaticPtr @(ObeliskT IO ()) k) >>= \case
352371 Nothing -> failWith $ "ObInternal_RunStaticIO: no such StaticKey: " <> T.pack (show k)
lib/command/src/Obelisk/Command/Project.hs+6−5
@@ -196,20 +196,21 @@ isWritableOnlyBy s uid = fileOwner s == uid && fileMode s .&. 0o22 == 0
196196-- | Run a command in the given shell for the current project
197197inProjectShell :: MonadObelisk m => String -> String -> m ()
198198inProjectShell shellName command = withProjectRoot "." $ \root ->
199− projectShell root True shellName command
199+ projectShell root True shellName (Just command)
200200
201201inImpureProjectShell :: MonadObelisk m => String -> String -> m ()
202202inImpureProjectShell shellName command = withProjectRoot "." $ \root ->
203− projectShell root False shellName command
203+ projectShell root False shellName (Just command)
204204
205−projectShell :: MonadObelisk m => FilePath -> Bool -> String -> String -> m ()
205+projectShell :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()
206206projectShell root isPure shellName command = do
207207 (_, _, _, ph) <- createProcess_ "runNixShellAttr" $ setCtlc $ setCwd (Just root) $ proc "nix-shell" $
208208 [ "--pure" | isPure ] <>
209209 [ "-A"
210210 , "shells." <> shellName
211− , "--run", command
212− ]
211+ ] <> case command of
212+ Nothing -> []
213+ Just c -> ["--run", c]
213214 void $ liftIO $ waitForProcess ph
214215
215216setCtlc :: CreateProcess -> CreateProcess