Skip to content

Commit

Permalink
Add haddock --open flag. commercialhaskell#1396
Browse files Browse the repository at this point in the history
  • Loading branch information
sjakobi committed Apr 9, 2016
1 parent 10b7cbc commit 3d7b46f
Show file tree
Hide file tree
Showing 11 changed files with 83 additions and 10 deletions.
1 change: 1 addition & 0 deletions ChangeLog.md
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,7 @@ Behavior changes:

Other enhancements:

* `stack haddock --open [PACKAGE]` opens the local haddocks in the browser.
* Experimental support for `--split-objs` added.
* `git` packages with submodules are supported by passing the `--recursive`
flag to `git clone`.
Expand Down
3 changes: 2 additions & 1 deletion src/Stack/Build.hs
Original file line number Diff line number Diff line change
Expand Up @@ -83,7 +83,7 @@ build setLocalFiles mbuildLk boptsCli = fixCodePage $ do
let profiling = boptsLibProfile bopts || boptsExeProfile bopts
menv <- getMinimalEnvOverride

(_, mbp, locals, extraToBuild, sourceMap) <- loadSourceMap NeedTargets boptsCli
(targets, mbp, locals, extraToBuild, sourceMap) <- loadSourceMap NeedTargets boptsCli

-- Set local files, necessary for file watching
stackYaml <- asks $ bcStackYaml . getBuildConfig
Expand Down Expand Up @@ -126,6 +126,7 @@ build setLocalFiles mbuildLk boptsCli = fixCodePage $ do
snapshotDumpPkgs
localDumpPkgs
installedMap
targets
plan

-- | If all the tasks are local, they don't mutate anything outside of our local directory.
Expand Down
22 changes: 18 additions & 4 deletions src/Stack/Build/Execute.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@ module Stack.Build.Execute
) where

import Control.Applicative
import Control.Arrow ((&&&))
import Control.Arrow ((&&&), second)
import Control.Concurrent.Execute
import Control.Concurrent.MVar.Lifted
import Control.Concurrent.STM
Expand Down Expand Up @@ -56,6 +56,7 @@ import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import Data.Time.Clock (getCurrentTime)
import Data.Traversable (forM)
import Data.Tuple
import qualified Distribution.PackageDescription as C
import Distribution.System (OS (Windows),
Platform (Platform))
Expand All @@ -69,6 +70,7 @@ import Stack.Build.Cache
import Stack.Build.Haddock
import Stack.Build.Installed
import Stack.Build.Source
import Stack.Build.Target
import Stack.Config
import Stack.Constants
import Stack.Coverage
Expand Down Expand Up @@ -342,11 +344,12 @@ executePlan :: M env m
-> [DumpPackage () ()] -- ^ snapshot packages
-> [DumpPackage () ()] -- ^ local packages
-> InstalledMap
-> Map PackageName SimpleTarget
-> Plan
-> m ()
executePlan menv boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages installedMap plan = do
executePlan menv boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages installedMap targets plan = do
bopts <- asks (configBuild . getConfig)
withExecuteEnv menv bopts boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages (executePlan' installedMap plan)
withExecuteEnv menv bopts boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages (executePlan' installedMap targets plan)

unless (Map.null $ planInstallExes plan) $ do
snapBin <- (</> bindirSuffix) `liftM` installationRootDeps
Expand Down Expand Up @@ -468,10 +471,11 @@ windowsRenameCopy src dest = do
-- | Perform the actual plan (internal)
executePlan' :: M env m
=> InstalledMap
-> Map PackageName SimpleTarget
-> Plan
-> ExecuteEnv
-> m ()
executePlan' installedMap0 plan ee@ExecuteEnv {..} = do
executePlan' installedMap0 targets plan ee@ExecuteEnv {..} = do
when (toCoverage $ boptsTestOpts eeBuildOpts) deleteHpcReports
wc <- getWhichCompiler
cv <- asks $ envConfigCompilerVersion . getEnvConfig
Expand Down Expand Up @@ -548,6 +552,16 @@ executePlan' installedMap0 plan ee@ExecuteEnv {..} = do
generateLocalHaddockIndex eeEnvOverride wc eeBaseConfigOpts localDumpPkgs eeLocals
generateDepsHaddockIndex eeEnvOverride wc eeBaseConfigOpts eeGlobalDumpPkgs snapshotDumpPkgs localDumpPkgs eeLocals
generateSnapHaddockIndex eeEnvOverride wc eeBaseConfigOpts eeGlobalDumpPkgs snapshotDumpPkgs
when (boptsOpenHaddocks eeBuildOpts) $ do
let planPkgs, localPkgs, installedPkgs, availablePkgs
:: Map PackageName (PackageIdentifier, InstallLocation)
planPkgs = Map.map (taskProvides &&& taskLocation) (planTasks plan)
localPkgs =
Map.fromList
[(packageName p, (packageIdentifier p, Local)) | p <- map lpPackage eeLocals]
installedPkgs = Map.map (swap . second installedPackageIdentifier) installedMap'
availablePkgs = Map.unions [planPkgs, localPkgs, installedPkgs]
openHaddocksInBrowser eeBaseConfigOpts availablePkgs (Map.keysSet targets)
where
installedMap' = Map.difference installedMap0
$ Map.fromList
Expand Down
37 changes: 35 additions & 2 deletions src/Stack/Build/Haddock.hs
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@ module Stack.Build.Haddock
( generateLocalHaddockIndex
, generateDepsHaddockIndex
, generateSnapHaddockIndex
, openHaddocksInBrowser
, shouldHaddockPackage
, shouldHaddockDeps
) where
Expand All @@ -20,6 +21,7 @@ import Control.Monad
import Control.Monad.Catch (MonadCatch)
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import qualified Data.Foldable as F
import Data.Function
Expand All @@ -39,12 +41,39 @@ import Path
import Path.Extra
import Path.IO
import Prelude
import Stack.Types.Build
import Stack.PackageDump
import Stack.Types
import qualified System.FilePath as FP
import System.IO.Error (isDoesNotExistError)
import System.Process.Read
import Web.Browser (openBrowser)

openHaddocksInBrowser
:: (MonadIO m, MonadReader env m, HasBuildConfig env, MonadThrow m)
=> BaseConfigOpts
-> Map PackageName (PackageIdentifier, InstallLocation)
-- ^ Available packages and their locations for the current project
-> Set PackageName
-- ^ Build targets as determined by 'Stack.Build.Source.loadSourceMap'
-> m ()
openHaddocksInBrowser bco pkgLocations buildTargets = do
let cliTargets = (boptsCLITargets . bcoBuildOptsCLI) bco
docDir <-
case (cliTargets, map (`Map.lookup` pkgLocations) (Set.toList buildTargets)) of
([_], [Just (pkgId, iloc)]) -> do
pkgRelDir <- (parseRelDir . show) pkgId
let docLocation =
case iloc of
Snap -> snapDocDir bco
Local -> localDocDir bco
return (docLocation </> pkgRelDir)
_ -> do
inGlobalProject <- asks (bcImplicitGlobal . getBuildConfig)
return $
if inGlobalProject
then snapDocDir bco
else localDepsDocDir bco
(liftIO . void . openBrowser . toFilePath . haddockIndexFile) docDir

-- | Determine whether we should haddock for a package.
shouldHaddockPackage :: BuildOpts
Expand Down Expand Up @@ -100,7 +129,7 @@ generateDepsHaddockIndex
-> m ()
generateDepsHaddockIndex envOverride wc bco globalDumpPkgs snapshotDumpPkgs localDumpPkgs locals = do
let deps = (mapMaybe (`lookupDumpPackage` allDumpPkgs) . nubOrd . findTransitiveDepends . mapMaybe getGhcPkgId) locals
depDocDir = localDocDir bco </> $(mkRelDir "all")
depDocDir = localDepsDocDir bco
generateHaddockIndex
"local packages and dependencies"
envOverride
Expand Down Expand Up @@ -247,6 +276,10 @@ haddockIndexFile destDir = destDir </> $(mkRelFile "index.html")
localDocDir :: BaseConfigOpts -> Path Abs Dir
localDocDir bco = bcoLocalInstallRoot bco </> docDirSuffix

-- | Path of documentation directory for the dependencies of local packages
localDepsDocDir :: BaseConfigOpts -> Path Abs Dir
localDepsDocDir bco = localDocDir bco </> $(mkRelDir "all")

-- | Path of snapshot packages documentation directory.
snapDocDir :: BaseConfigOpts -> Path Abs Dir
snapDocDir bco = bcoSnapInstallRoot bco </> docDirSuffix
3 changes: 3 additions & 0 deletions src/Stack/Config/Build.hs
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,9 @@ buildOptsFromMonoid BuildOptsMonoid{..} = BuildOpts
, boptsHaddock = fromMaybe
(boptsHaddock defaultBuildOpts)
buildMonoidHaddock
, boptsOpenHaddocks = fromMaybe
(boptsOpenHaddocks defaultBuildOpts)
buildMonoidOpenHaddocks
, boptsHaddockDeps = buildMonoidHaddockDeps
, boptsInstallExes = fromMaybe
(boptsInstallExes defaultBuildOpts)
Expand Down
7 changes: 6 additions & 1 deletion src/Stack/Options.hs
Original file line number Diff line number Diff line change
Expand Up @@ -356,7 +356,7 @@ buildOptsMonoidParser hide0 =
\exception" <>
hide)
options =
BuildOptsMonoid <$> libProfiling <*> exeProfiling <*> haddock <*>
BuildOptsMonoid <$> libProfiling <*> exeProfiling <*> haddock <*> openHaddocks <*>
haddockDeps <*> copyBins <*> preFetch <*> keepGoing <*> forceDirty <*>
tests <*> testOptsParser hide0 <*> benches <*> benchOptsParser hide0 <*> reconfigure <*>
cabalVerbose <*> splitObjs
Expand All @@ -375,6 +375,11 @@ buildOptsMonoidParser hide0 =
"haddock"
"generating Haddocks the package(s) in this directory/configuration"
hide
openHaddocks =
maybeBoolFlags
"open"
"opening the local Haddock documentation in the browser"
hide
haddockDeps =
maybeBoolFlags "haddock-deps" "building Haddocks for dependencies" hide
copyBins =
Expand Down
1 change: 1 addition & 0 deletions src/Stack/Types/Build.hs
Original file line number Diff line number Diff line change
Expand Up @@ -549,6 +549,7 @@ data BaseConfigOpts = BaseConfigOpts
, bcoBuildOptsCLI :: !BuildOptsCLI
, bcoExtraDBs :: ![(Path Abs Dir)]
}
deriving Show

-- | Render a @BaseConfigOpts@ to an actual list of options
configureOpts :: EnvConfig
Expand Down
10 changes: 10 additions & 0 deletions src/Stack/Types/Config/Build.hs
Original file line number Diff line number Diff line change
Expand Up @@ -37,6 +37,8 @@ data BuildOpts =
,boptsExeProfile :: !Bool
,boptsHaddock :: !Bool
-- ^ Build haddocks?
,boptsOpenHaddocks :: !Bool
-- ^ Open haddocks in the browser?
,boptsHaddockDeps :: !(Maybe Bool)
-- ^ Build haddocks for dependencies?
,boptsInstallExes :: !Bool
Expand Down Expand Up @@ -74,6 +76,7 @@ defaultBuildOpts = BuildOpts
{ boptsLibProfile = False
, boptsExeProfile = False
, boptsHaddock = False
, boptsOpenHaddocks = False
, boptsHaddockDeps = Nothing
, boptsInstallExes = False
, boptsPreFetch = False
Expand Down Expand Up @@ -128,6 +131,7 @@ data BuildOptsMonoid = BuildOptsMonoid
{ buildMonoidLibProfile :: !(Maybe Bool)
, buildMonoidExeProfile :: !(Maybe Bool)
, buildMonoidHaddock :: !(Maybe Bool)
, buildMonoidOpenHaddocks :: !(Maybe Bool)
, buildMonoidHaddockDeps :: !(Maybe Bool)
, buildMonoidInstallExes :: !(Maybe Bool)
, buildMonoidPreFetch :: !(Maybe Bool)
Expand All @@ -147,6 +151,7 @@ instance FromJSON (WithJSONWarnings BuildOptsMonoid) where
(\o -> do buildMonoidLibProfile <- o ..:? buildMonoidLibProfileArgName
buildMonoidExeProfile <- o ..:? buildMonoidExeProfileArgName
buildMonoidHaddock <- o ..:? buildMonoidHaddockArgName
buildMonoidOpenHaddocks <- o ..:? buildMonoidOpenHaddocksArgName
buildMonoidHaddockDeps <- o ..:? buildMonoidHaddockDepsArgName
buildMonoidInstallExes <- o ..:? buildMonoidInstallExesArgName
buildMonoidPreFetch <- o ..:? buildMonoidPreFetchArgName
Expand All @@ -170,6 +175,9 @@ buildMonoidExeProfileArgName = "executable-profiling"
buildMonoidHaddockArgName :: Text
buildMonoidHaddockArgName = "haddock"

buildMonoidOpenHaddocksArgName :: Text
buildMonoidOpenHaddocksArgName = "open-haddocks"

buildMonoidHaddockDepsArgName :: Text
buildMonoidHaddockDepsArgName = "haddock-deps"

Expand Down Expand Up @@ -211,6 +219,7 @@ instance Monoid BuildOptsMonoid where
{buildMonoidLibProfile = Nothing
,buildMonoidExeProfile = Nothing
,buildMonoidHaddock = Nothing
,buildMonoidOpenHaddocks = Nothing
,buildMonoidHaddockDeps = Nothing
,buildMonoidInstallExes = Nothing
,buildMonoidPreFetch = Nothing
Expand All @@ -229,6 +238,7 @@ instance Monoid BuildOptsMonoid where
{buildMonoidLibProfile = buildMonoidLibProfile l <|> buildMonoidLibProfile r
,buildMonoidExeProfile = buildMonoidExeProfile l <|> buildMonoidExeProfile r
,buildMonoidHaddock = buildMonoidHaddock l <|> buildMonoidHaddock r
,buildMonoidOpenHaddocks = buildMonoidOpenHaddocks l <|> buildMonoidOpenHaddocks r
,buildMonoidHaddockDeps = buildMonoidHaddockDeps l <|> buildMonoidHaddockDeps r
,buildMonoidInstallExes = buildMonoidInstallExes l <|> buildMonoidInstallExes r
,buildMonoidPreFetch = buildMonoidPreFetch l <|> buildMonoidPreFetch r
Expand Down
7 changes: 5 additions & 2 deletions src/Stack/Types/Package.hs
Original file line number Diff line number Diff line change
Expand Up @@ -414,7 +414,10 @@ type InstalledMap = Map PackageName (InstallLocation, Installed)
data Installed = Library PackageIdentifier GhcPkgId | Executable PackageIdentifier
deriving (Show, Eq, Ord)

installedPackageIdentifier :: Installed -> PackageIdentifier
installedPackageIdentifier (Library pid _) = pid
installedPackageIdentifier (Executable pid) = pid

-- | Get the installed Version.
installedVersion :: Installed -> Version
installedVersion (Library (PackageIdentifier _ v) _) = v
installedVersion (Executable (PackageIdentifier _ v)) = v
installedVersion = packageIdentifierVersion . installedPackageIdentifier
1 change: 1 addition & 0 deletions stack-7.8.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -26,3 +26,4 @@ extra-deps:
- base-compat-0.9.0
- hpack-0.10.0
- microlens-0.4.1.0
- open-browser-0.2.1.0
1 change: 1 addition & 0 deletions stack.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -175,6 +175,7 @@ library
, monad-control
, monad-logger >= 0.3.13.1
, mtl >= 2.1.3.1
, open-browser >= 0.2.1
, optparse-applicative >= 0.11 && < 0.13
, path >= 0.5.1
, path-io >= 1.1.0 && < 2.0.0
Expand Down

0 comments on commit 3d7b46f

Please sign in to comment.