on master help sign in
Merge remote-tracking branch 'origin/cg-ob-doc' into cg-fullroute
commitcd207d6cdd2a6c49aeaae42636fd5e938babdf92 authorCale Gibbard <cgibbard@gmail.com> dateMon 24 Jun 2019, 11:50 (7 years ago) parentb6da1864f0ade7
1 file changed+27−4
lib/command/src/Obelisk/Command.hs+27−4
lib/command/src/Obelisk/Command.hs+27−4
@@ -20,6 +20,7 @@ import Data.Text.Encoding
2020import Data.Text.Encoding.Error (lenientDecode)
2121import GHC.StaticPtr
2222import Options.Applicative
23+import Options.Applicative.Help.Pretty (text, (<$$>))
2324import System.Directory
2425import System.Environment
2526import System.FilePath
@@ -93,6 +94,7 @@ data ObCommand
9394 | ObCommand_Repl
9495 | ObCommand_Watch
9596 | ObCommand_Shell ShellOpts
97+ | ObCommand_Doc String [String] -- shell and list of packages
9698 | ObCommand_Internal ObInternal
9799 deriving Show
98100
@@ -129,6 +131,11 @@ obCommand cfg = hsubparser
129131 , command "repl" $ info (pure ObCommand_Repl) $ progDesc "Open an interactive interpreter"
130132 , command "watch" $ info (pure ObCommand_Watch) $ progDesc "Watch current project for errors and warnings"
131133 , command "shell" $ info (ObCommand_Shell <$> shellOpts) $ progDesc "Enter a shell with project dependencies"
134+ , command "doc" $ info (ObCommand_Doc <$> shellFlags <*> packageNames) $
135+ progDesc "List paths to haddock documentation for specified packages"
136+ <> footerDoc (Just $
137+ text "Hint: To open the documentation you can pipe the output of this command like"
138+ <$$> text "ob doc reflex reflex-dom-core | xargs -n1 xdg-open")
132139 ])
133140 <|> subparser
134141 (mconcat
@@ -136,6 +143,9 @@ obCommand cfg = hsubparser
136143 , command "internal" (info (ObCommand_Internal <$> internalCommand) mempty)
137144 ])
138145
146+packageNames :: Parser [String]
147+packageNames = some (strArgument (metavar "PACKAGE-NAME..."))
148+
139149deployCommand :: ArgsConfig -> Parser DeployCommand
140150deployCommand cfg = hsubparser $ mconcat
141151 [ command "init" $ info (DeployCommand_Init <$> deployInitOpts) $ progDesc "Initialize a deployment configuration directory"
@@ -233,12 +243,15 @@ data ShellOpts
233243 }
234244 deriving Show
235245
246+shellFlags :: Parser String
247+shellFlags =
248+ flag' "ghc" (long "ghc" <> help "Enter a shell environment having ghc (default)")
249+ <|> flag "ghc" "ghcjs" (long "ghcjs" <> help "Enter a shell having ghcjs rather than ghc")
250+ <|> strOption (short 'A' <> long "argument" <> metavar "NIXARG" <> help "Use the environment specified by the given nix argument of `shells'")
251+
236252shellOpts :: Parser ShellOpts
237253shellOpts = ShellOpts
238− <$> ( flag' "ghc" (long "ghc" <> help "Enter a shell environment having ghc (default)")
239− <|> flag "ghc" "ghcjs" (long "ghcjs" <> help "Enter a shell having ghcjs rather than ghc")
240− <|> strOption (short 'A' <> long "argument" <> metavar "NIXARG" <> help "Use the environment specified by the given nix argument of `shells'")
241− )
254+ <$> shellFlags
242255 <*> optional (strArgument (metavar "COMMAND"))
243256
244257parserPrefs :: ParserPrefs
@@ -369,6 +382,8 @@ ob = \case
369382 ObCommand_Watch -> inNixShell' $ static runWatch
370383 ObCommand_Shell so -> withProjectRoot "." $ \root ->
371384 projectShell root False (_shellOpts_shell so) (_shellOpts_command so)
385+ ObCommand_Doc shell pkgs -> withProjectRoot "." $ \root ->
386+ projectShell root False shell (Just $ haddockCommand pkgs)
372387 ObCommand_Internal icmd -> case icmd of
373388 ObInternal_RunStaticIO k -> liftIO (unsafeLookupStaticPtr @(ObeliskT IO ()) k) >>= \case
374389 Nothing -> failWith $ "ObInternal_RunStaticIO: no such StaticKey: " <> T.pack (show k)
@@ -377,6 +392,14 @@ ob = \case
377392 liftIO $ runObelisk c $ deRefStaticPtr p
378393 ObInternal_CLIDemo -> cliDemo
379394
395+haddockCommand :: [String] -> String
396+haddockCommand pkgs = unwords
397+ [ "for p in"
398+ , unwords [getHaddockPath p ++ "/index.html" | p <- pkgs]
399+ , "; do echo $p; done"
400+ ]
401+ where getHaddockPath p = "$(ghc-pkg field " ++ p ++ " haddock-html --simple-output)"
402+
380403--TODO: Clean up all the magic strings throughout this codebase
381404
382405getArgsConfig :: IO ArgsConfig