80f019c · obelisk · git.iko.soy

git.iko.soy/obelisk

Merge pull request #628 from obsidiansystems/eac@ob-hoogle

ob hoogle

commit80f019c45581e665f2c9c01341b704d7610171fd authorElliot Cameron <3noch@users.noreply.github.com> dateThu 30 Jan 2020, 19:16 (7 years ago) parent038f012 acc1ade

4 files changed+71−39

compare with master

unifiedsplit

ChangeLog.md+1 lib/command/src/Obelisk/Command.hs+7 lib/command/src/Obelisk/Command/Project.hs+45−38 lib/selftest/src/Obelisk/SelfTest.hs+18−1

ChangeLog.md+1

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

77* Add `Obelisk.Route.(?/)`, a convenience function for constructing routes nested in `Maybe`. ([#457](https://github.com/obsidiansystems/obelisk/pull/457))

88* 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))

910

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

1112

lib/command/src/Obelisk/Command.hs+7

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

9595 | ObCommand_Watch

9696 | ObCommand_Shell ShellOpts

9797 | ObCommand_Doc String [String] -- shell and list of packages

98+ | ObCommand_Hoogle String Int -- shell and port

9899 | ObCommand_Internal ObInternal

99100 deriving Show

100101

@@ -121,6 +122,7 @@ obCommand cfg = hsubparser

121122 <> footerDoc (Just $

122123 text "Hint: To open the documentation you can pipe the output of this command like"

123124 <$$> text "ob doc reflex reflex-dom-core | xargs -n1 xdg-open")

125+ , command "hoogle" $ info (ObCommand_Hoogle <$> shellFlags <*> portOpt 8080) $ progDesc "Run a hoogle server locally for your project's dependency tree"

124126 ])

125127 <|> subparser

126128 (mconcat

@@ -254,6 +256,9 @@ shellOpts = ShellOpts

254256 <$> shellFlags

255257 <*> optional (strArgument (metavar "COMMAND"))

256258

259+portOpt :: Int -> Parser Int

260+portOpt dfault = option auto (long "port" <> short 'p' <> help "Port number for server" <> showDefault <> value dfault <> metavar "INT")

261+

257262parserPrefs :: ParserPrefs

258263parserPrefs = defaultPrefs

259264 { prefShowHelpOnEmpty = True

@@ -387,6 +392,8 @@ ob = \case

387392 projectShell root False (_shellOpts_shell so) (_shellOpts_command so)

388393 ObCommand_Doc shell' pkgs -> withProjectRoot "." $ \root ->

389394 projectShell root False shell' (Just $ haddockCommand pkgs)

395+ ObCommand_Hoogle shell' port -> withProjectRoot "." $ \root -> do

396+ nixShellWithHoogle root True shell' $ Just $ "hoogle server -p " <> show port <> " --local"

390397 ObCommand_Internal icmd -> case icmd of

391398 ObInternal_RunStaticIO k -> liftIO (unsafeLookupStaticPtr @(ObeliskT IO ()) k) >>= \case -- TODO: DELETE

392399 Nothing -> failWith $ "ObInternal_RunStaticIO: no such StaticKey: " <> T.pack (show k)

lib/command/src/Obelisk/Command/Project.hs+45−38

@@ -6,6 +6,9 @@ module Obelisk.Command.Project

66 , findProjectObeliskCommand

77 , findProjectRoot

88 , initProject

9+ , nixShellRunConfig

10+ , nixShellRunProc

11+ , nixShellWithHoogle

912 , nixShellWithPkgs

1013 , obeliskDirName

1114 , projectShell

@@ -253,50 +256,54 @@ toNixPath :: FilePath -> FilePath

253256toNixPath root | "/" `isInfixOf` root = root

254257 | otherwise = "./" <> root

255258

259+nixShellRunConfig :: MonadObelisk m => FilePath -> Bool -> Maybe String -> m NixShellConfig

260+nixShellRunConfig root isPure command = do

261+ nixpkgsPath <- fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $

262+ proc nixExePath ["eval", "(import .obelisk/impl {}).nixpkgs.path"]

263+ nixRemote <- liftIO $ lookupEnv "NIX_REMOTE"

264+ pure $ def

265+ & nixShellConfig_pure .~ isPure

266+ & nixShellConfig_common . nixCmdConfig_target .~ (def & target_path .~ Nothing)

267+ & nixShellConfig_run .~ (command <&> \c -> mconcat

268+ [ "export NIX_PATH=nixpkgs=", T.unpack nixpkgsPath, "; "

269+ , maybe "" (\v -> "export NIX_REMOTE=" <> v <> "; ") nixRemote

270+ , c

271+ ])

272+

273+nixShellRunProc :: NixShellConfig -> ProcessSpec

274+nixShellRunProc cfg = setDelegateCtlc True $ proc "nix-shell" $ runNixShellConfig cfg

275+

256276nixShellWithPkgs :: MonadObelisk m => FilePath -> Bool -> Bool -> Map Text FilePath -> Maybe String -> m ()

257277nixShellWithPkgs root isPure chdirToRoot packageNamesAndPaths command = do

258278 packageNamesAndAbsPaths <- liftIO $ for packageNamesAndPaths makeAbsolute

259− nixpkgsPath <- fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $

260− proc nixExePath ["eval", "(import .obelisk/impl {}).nixpkgs.path"]

279+ defShellConfig <- nixShellRunConfig root isPure command

261280 let setCwd_ = if chdirToRoot then setCwd (Just root) else id

262− nixRemote <- liftIO $ lookupEnv "NIX_REMOTE"

263− (_, _, _, ph) <- createProcess_ "runNixShellAttr" $ setDelegateCtlc True $ setCwd_ $ proc "nix-shell" $

264− runNixShellConfig $ def

265− & nixShellConfig_pure .~ isPure

266− & nixShellConfig_common . nixCmdConfig_target .~ (def

267− & target_path .~ Nothing

268− & target_expr ?~

269− "{root, pkgs}: ((import root {}).passthru.__unstable__.self.extend (self: super: {\

270− \shellPackages = builtins.fromJSON pkgs; })\

271− \).project.shells.ghc"

272− )

273− & nixShellConfig_common . nixCmdConfig_args .~

274− [ rawArg "root" $ toNixPath $ if chdirToRoot then "." else root

275− , strArg "pkgs" (T.unpack $ decodeUtf8 $ BSL.toStrict $ Json.encode packageNamesAndAbsPaths)

276− ]

277− & nixShellConfig_run .~ (command <&> \c -> mconcat

278− [ "export NIX_PATH=nixpkgs=", T.unpack nixpkgsPath, "; "

279− , maybe "" (\v -> "export NIX_REMOTE=" <> v <> "; ") nixRemote

280− , c

281− ])

281+ (_, _, _, ph) <- createProcess_ "nixShellWithPkgs" $ setCwd_ $ nixShellRunProc $ defShellConfig

282+ & nixShellConfig_common . nixCmdConfig_target . target_expr ?~

283+ "{root, pkgs}: ((import root {}).passthru.__unstable__.self.extend (_: _: {\

284+ \shellPackages = builtins.fromJSON pkgs;\

285+ \})).project.shells.ghc"

286+ & nixShellConfig_common . nixCmdConfig_args .~

287+ [ rawArg "root" $ toNixPath $ if chdirToRoot then "." else root

288+ , strArg "pkgs" (T.unpack $ decodeUtf8 $ BSL.toStrict $ Json.encode packageNamesAndAbsPaths)

289+ ]

290+ void $ liftIO $ waitForProcess ph

291+

292+nixShellWithHoogle :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()

293+nixShellWithHoogle root isPure shell' command = do

294+ defShellConfig <- nixShellRunConfig root isPure command

295+ (_, _, _, ph) <- createProcess_ "nixShellWithHoogle" $ setCwd (Just root) $ nixShellRunProc $ defShellConfig

296+ & nixShellConfig_common . nixCmdConfig_target . target_expr ?~

297+ "{shell}: ((import ./. {}).passthru.__unstable__.self.extend (_: super: {\

298+ \userSettings = super.userSettings // { withHoogle = true; };\

299+ \})).project.shells.${shell}"

300+ & nixShellConfig_common . nixCmdConfig_args .~ [ strArg "shell" shell' ]

282301 void $ liftIO $ waitForProcess ph

283302

284303projectShell :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()

285304projectShell root isPure shellName command = do

286− nixpkgsPath <- fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $ proc nixExePath ["eval", "(import .obelisk/impl {}).nixpkgs.path"]

287− nixRemote <- liftIO $ lookupEnv "NIX_REMOTE"

288− (_, _, _, ph) <- createProcess_ "runNixShellAttr" $ setDelegateCtlc True $ setCwd (Just root) $ proc "nix-shell" $

289− [ "default.nix"] <>

290− ["--pure" | isPure] <>

291− [ "-A"

292− , "shells." <> shellName

293− ] <> case command of

294− Nothing -> []

295− Just c ->

296− -- TODO: Escape nixpkgsPath and nixRemote

297− [ "--run"

298− , "export NIX_PATH=nixpkgs=" <> T.unpack nixpkgsPath <> "; " <>

299− maybe "" (\v -> "export NIX_REMOTE=" <> v <> "; ") nixRemote <>

300− c

301− ]

305+ defShellConfig <- nixShellRunConfig root isPure command

306+ (_, _, _, ph) <- createProcess_ "runNixShellAttr" $ setCwd (Just root) $ nixShellRunProc $ defShellConfig

307+ & nixShellConfig_common . nixCmdConfig_target . target_path ?~ "default.nix"

308+ & nixShellConfig_common . nixCmdConfig_target . target_attr ?~ ("shells." <> shellName)

302309 void $ liftIO $ waitForProcess ph

lib/selftest/src/Obelisk/SelfTest.hs+18−1

@@ -318,10 +318,27 @@ main = do

318318 void $ errExit False $ runOb ["thunk", "update", toTextIgnore dir, "--branch", "dumble-palooza"]

319319 checkDir dir >>= liftIO . assertEqual "" startingContents

320320

321+ describe "ob hoogle" $ {- NOT parallel -} do

322+ it "starts a hoogle server on the given port" $ inTmpObInit $ \_ -> do

323+ [p0] <- liftIO $ getFreePorts 1

324+ maskExitSuccess $ runHandle "ob" ["hoogle", "--port", T.pack (show p0)] $ \stdout -> fix $ \loop -> do

325+ ln <- liftIO $ T.hGetLine stdout

326+ echo ln

327+ let search = "Server starting on port " <> T.pack (show p0)

328+ case search `T.isInfixOf` ln of

329+ False -> loop -- keep waiting

330+ True -> do

331+ let req uri = liftIO $ HTTP.parseRequest uri >>= flip HTTP.httpLbs httpManager

332+ req ("http://127.0.0.1:" <> show p0) >>= \r -> case HTTP.responseStatus r == HTTP.ok200 of

333+ False -> errorExit $ "Request to hoogle server failed: " <> T.pack (show r)

334+ True -> exit 0

335+

336+maskExitSuccess :: Sh () -> Sh ()

337+maskExitSuccess = handle_sh (\case ExitSuccess -> pure (); e -> throw e)

321338

322339-- | Run `ob run` in the given directory (maximum of one level deep)

323340testObRunInDir :: String -> [Text] -> Maybe FilePath -> HTTP.Manager -> Sh ()

324−testObRunInDir executable extraArgs mdir httpManager = handle_sh (\case ExitSuccess -> pure (); e -> throw e) $ do

341+testObRunInDir executable extraArgs mdir httpManager = maskExitSuccess $ do

325342 [p0, p1] <- liftIO $ getFreePorts 2

326343 let uri p = "http://localhost:" <> T.pack (show p) <> "/" -- trailing slash required for comparison

327344 writefile "config/common/route" $ uri p0