hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix 'debug' command when ghc(-pkg) not on PATH

Browse Source
This commit is contained in:
Daniel Gröber 2017-01-23 01:17:22 +01:00
parent 01e84fffa4
commit 084688bb35
1 changed files with 14 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
GhcMod/Debug.hs
View File

@ -6,6 +6,7 @@ import Control.Monad
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.Char import Data.Char
import Data.Maybe
import Data.Version import Data.Version
import Data.List.Split import Data.List.Split
import System.Directory import System.Directory
@ -33,10 +34,17 @@ debugInfo = do
Options {..} <- options Options {..} <- options
Cradle {..} <- cradle Cradle {..} <- cradle
[ghcPath, ghcPkgPath] <- liftIO $
case cradleProject of
StackProject se ->
catMaybes <$> sequence [getStackGhcPath se, getStackGhcPkgPath se]
_ ->
return ["ghc", "ghc-pkg"]
cabal <- cabal <-
case cradleProject of case cradleProject of
CabalProject -> cabalDebug CabalProject -> cabalDebug ghcPkgPath
StackProject {} -> (++) <$> stackPaths <*> cabalDebug StackProject {} -> (++) <$> stackPaths <*> cabalDebug ghcPkgPath
_ -> return [] _ -> return []
pkgOpts <- packageGhcOptions pkgOpts <- packageGhcOptions
@ -44,7 +52,7 @@ debugInfo = do
readProc <- gmReadProcess readProc <- gmReadProcess
ghcVersion <- liftIO $ ghcVersion <- liftIO $
dropWhileEnd isSpace <$> readProc "ghc" ["--numeric-version"] "" dropWhileEnd isSpace <$> readProc ghcPath ["--numeric-version"] ""
return $ unlines $ return $ unlines $
[ "Version: ghc-mod-" ++ showVersion version [ "Version: ghc-mod-" ++ showVersion version
@ -67,8 +75,8 @@ stackPaths = do
, "Stack ghc-pkg executable:" ++ show ghcPkg , "Stack ghc-pkg executable:" ++ show ghcPkg
] ]
cabalDebug :: IOish m => GhcModT m [String] cabalDebug :: IOish m => FilePath -> GhcModT m [String]
cabalDebug = do cabalDebug ghcPkgPath = do
Cradle {..} <- cradle Cradle {..} <- cradle
mcs <- cabalResolvedComponents mcs <- cabalResolvedComponents
let entrypoints = Map.map gmcEntrypoints mcs let entrypoints = Map.map gmcEntrypoints mcs
@ -85,7 +93,7 @@ cabalDebug = do
dropWhileEnd isSpace <$> readProc "cabal" ["--numeric-version"] "" dropWhileEnd isSpace <$> readProc "cabal" ["--numeric-version"] ""
else return "" else return ""
packages <- liftIO $ readProc "ghc-pkg" ["list", "--simple-output"] "" packages <- liftIO $ readProc ghcPkgPath ["list", "--simple-output"] ""
let cabalPackages = filter ((== ["Cabal"]) . take 1 . splitOn "-") $ splitWhen isSpace packages let cabalPackages = filter ((== ["Cabal"]) . take 1 . splitOn "-") $ splitWhen isSpace packages
return $ return $