ghc-mod/Language/Haskell/GhcMod/Debug.hs

75 lines
2.4 KiB
Haskell
Raw Normal View History

2014-03-20 07:21:48 +00:00
module Language.Haskell.GhcMod.Debug (debugInfo, debug, rootInfo, root) where
2013-03-04 02:21:41 +00:00
2014-03-27 06:23:27 +00:00
import Control.Applicative ((<$>))
import Control.Exception.IOChoice ((||>))
import Control.Monad (void)
2014-03-27 06:08:07 +00:00
import CoreMonad (liftIO)
2013-03-04 02:21:41 +00:00
import Data.List (intercalate)
2014-03-27 06:23:27 +00:00
import Data.Maybe (fromMaybe, isJust, fromJust)
import GHC (Ghc)
2013-05-17 01:00:01 +00:00
import Language.Haskell.GhcMod.CabalApi
import Language.Haskell.GhcMod.GHCApi
import Language.Haskell.GhcMod.Types
2013-03-04 02:21:41 +00:00
----------------------------------------------------------------
2013-05-20 05:28:56 +00:00
-- | Obtaining debug information.
debugInfo :: Options
-> Cradle
2013-09-05 05:35:28 +00:00
-> FilePath -- ^ A target file.
2013-05-20 05:28:56 +00:00
-> IO String
debugInfo opt cradle fileName = unlines <$> withGHC fileName (debug opt cradle fileName)
2013-03-04 02:21:41 +00:00
2013-05-20 05:28:56 +00:00
-- | Obtaining debug information.
debug :: Options
-> Cradle
2013-09-05 05:35:28 +00:00
-> FilePath -- ^ A target file.
2013-05-20 05:28:56 +00:00
-> Ghc [String]
debug opt cradle fileName = do
2013-09-19 06:58:50 +00:00
CompilerOptions gopts incDir pkgs <-
2013-03-04 02:21:41 +00:00
if cabal then
2013-09-19 07:21:48 +00:00
liftIO (fromCabalFile ||> return simpleCompilerOption)
2013-03-04 02:21:41 +00:00
else
2013-09-19 07:21:48 +00:00
return simpleCompilerOption
2014-03-17 06:56:00 +00:00
void $ initializeFlagsWithCradle opt cradle gopts True
setTargetFiles [fileName]
2014-04-16 02:52:49 +00:00
mglibdir <- liftIO getSystemLibDir
2013-03-04 02:21:41 +00:00
return [
2014-03-19 06:01:32 +00:00
"Root directory: " ++ rootDir
, "Current directory: " ++ currentDir
2013-03-04 02:21:41 +00:00
, "Cabal file: " ++ cabalFile
2013-03-05 07:57:18 +00:00
, "GHC options: " ++ unwords gopts
, "Include directories: " ++ unwords incDir
, "Dependent packages: " ++ intercalate ", " (map showPkg pkgs)
2014-04-09 06:15:26 +00:00
, "System libraries: " ++ fromMaybe "" mglibdir
2013-03-04 02:21:41 +00:00
]
where
currentDir = cradleCurrentDir cradle
2013-09-19 07:21:48 +00:00
mCabalFile = cradleCabalFile cradle
rootDir = cradleRootDir cradle
2013-09-19 07:21:48 +00:00
cabal = isJust mCabalFile
cabalFile = fromMaybe "" mCabalFile
origGopts = ghcOpts opt
simpleCompilerOption = CompilerOptions origGopts [] []
fromCabalFile = do
pkgDesc <- parseCabalFile file
getCompilerOptions origGopts cradle pkgDesc
2013-09-19 07:21:48 +00:00
where
file = fromJust mCabalFile
2014-03-20 07:21:48 +00:00
----------------------------------------------------------------
-- | Obtaining root information.
rootInfo :: Options
-> Cradle
-> FilePath -- ^ A target file.
-> IO String
rootInfo opt cradle fileName = withGHC fileName (root opt cradle fileName)
-- | Obtaining root information.
root :: Options
-> Cradle
-> FilePath -- ^ A target file.
-> Ghc String
root _ cradle _ = return $ cradleRootDir cradle ++ "\n"