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

76 lines
2.5 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]
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
2014-03-27 07:35:41 +00:00
, "Dependent packages: " ++ intercalate ", " (map fst pkgs)
2013-03-04 02:21:41 +00:00
]
where
currentDir = cradleCurrentDir cradle
2013-09-19 07:21:48 +00:00
mCabalFile = cradleCabalFile cradle
2014-03-19 06:01:32 +00:00
mCabalDir = cradleCabalDir cradle
rootDir = fromMaybe currentDir mCabalDir
2013-09-19 07:21:48 +00:00
cabal = isJust mCabalFile
cabalFile = fromMaybe "" mCabalFile
origGopts = ghcOpts opt
simpleCompilerOption = CompilerOptions origGopts [] []
fromCabalFile = parseCabalFile file >>= getCompilerOptions origGopts cradle
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
2014-03-27 07:35:41 +00:00
root _ cradle _ = return $ rootDir ++ "\n"
2014-03-20 07:21:48 +00:00
where
currentDir = cradleCurrentDir cradle
mCabalDir = cradleCabalDir cradle
rootDir = fromMaybe currentDir mCabalDir