diff --git a/src/IDE/Package.hs b/src/IDE/Package.hs index 2924ebb1..e12b2e9b 100644 --- a/src/IDE/Package.hs +++ b/src/IDE/Package.hs @@ -82,6 +82,7 @@ import System.Directory (canonicalizePath, setCurrentDirectory, doesFileExist, getDirectoryContents, doesDirectoryExist) import Prelude hiding (catch) +import Data.Char (isSpace) import Data.Maybe (mapMaybe, listToMaybe, fromMaybe, isNothing, isJust, fromJust, catMaybes) @@ -353,14 +354,11 @@ packageDoc' backgroundBuild jumpToWarnings package continuation = do catchIDE (do let dir = ipdPackageDir package useStack <- liftIO . doesFileExist $ dir "stack.yaml" - if useStack - then continuation True - else - runExternalTool' (__ "Documenting") (cabalCommand prefs) ("haddock" : ipdHaddockFlags package) dir $ do - mbLastOutput <- C.getZipSink $ const <$> C.ZipSink sinkLast <*> (C.ZipSink $ - logOutputForBuild package backgroundBuild jumpToWarnings) - lift $ postAsyncIDE reloadDoc - lift $ continuation (mbLastOutput == Just (ToolExit ExitSuccess))) + runExternalTool' (__ "Documenting") (if useStack then "stack" else cabalCommand prefs) ("haddock" : ipdHaddockFlags package) dir $ do + mbLastOutput <- C.getZipSink $ const <$> C.ZipSink sinkLast <*> (C.ZipSink $ + logOutputForBuild package backgroundBuild jumpToWarnings) + lift $ postAsyncIDE reloadDoc + lift $ continuation (mbLastOutput == Just (ToolExit ExitSuccess))) (\(e :: SomeException) -> print e) packageClean :: PackageAction @@ -681,21 +679,35 @@ packageSdist = do (\(e :: SomeException) -> print e) +-- | Open generated documentation for package packageOpenDoc :: PackageAction packageOpenDoc = do package <- ask - + let dir = ipdPackageDir package + useStack <- liftIO . doesFileExist $ dir "stack.yaml" + distDir <- if useStack + then do + --ask stack where its dist directory is + mvar <- liftIO newEmptyMVar + runExternalTool' "" "stack" ["path"] dir $ do + output <- CL.consume + liftIO . putMVar mvar $ head $ catMaybes $ map getDistOutput output + liftIO $ takeMVar mvar + else return "dist" liftIDE $ do prefs <- readIDE prefs - let path = ipdPackageDir package - "dist/doc/html" + let path = dir distDir + "doc/html" display (pkgName (ipdPackageId package)) "index.html" - dir = ipdPackageDir package - loadDoc . T.pack $ "file:///" ++ dir path + loadDoc . T.pack $ "file://" ++ path getDocumentation Nothing >>= \ p -> displayPane p False `catchIDE` (\(e :: SomeException) -> print e) + where + -- get dist directory from stack path output + getDistOutput (ToolOutput o) | Just t<-T.stripPrefix "dist-dir:" o = Just $ dropWhile isSpace $ T.unpack t + getDistOutput _ = Nothing runPackage :: (ProcessHandle -> IDEAction)