hdevtools-0.1.4.1/src/0000755000000000000000000000000012763017754012653 5ustar0000000000000000hdevtools-0.1.4.1/src/Main.hs0000644000000000000000000001072212763017754014075 0ustar0000000000000000{-# LANGUAGE CPP #-} module Main where #if __GLASGOW_HASKELL__ < 709 import Data.Traversable (traverse) #endif import Control.Monad (when) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import System.Directory (getCurrentDirectory) import System.Environment (getProgName) import System.IO (hPutStrLn, stderr) import System.FilePath ((), isAbsolute, takeDirectory) import Cabal (findCabalFile) import Client (getServerStatus, serverCommand, stopServer) import CommandArgs import Daemonize (daemonize) import Server (startServer, createListenSocket) import Stack (findStackYaml) import Types (Command(..), CommandExtra(..), emptyCommandExtra) absoluteFilePath :: FilePath -> IO FilePath absoluteFilePath p = if isAbsolute p then return p else do dir <- getCurrentDirectory return $ dir p defaultSocketFile :: FilePath defaultSocketFile = ".hdevtools.sock" fileArg :: HDevTools -> Maybe String fileArg (Admin {}) = Nothing fileArg (ModuleFile {}) = Nothing fileArg args@(Check {}) = Just $ file args fileArg args@(Info {}) = Just $ file args fileArg args@(Type {}) = Just $ file args fileArg (FindSymbol {}) = Nothing pathArg' :: HDevTools -> Maybe String pathArg' (Admin {}) = Nothing pathArg' (ModuleFile {}) = Nothing pathArg' args@(Check {}) = path args pathArg' args@(Info {}) = path args pathArg' args@(Type {}) = path args pathArg' (FindSymbol {}) = Nothing pathArg :: HDevTools -> Maybe String pathArg args = case pathArg' args of Just x -> Just x Nothing -> fileArg args main :: IO () main = do args <- loadHDevTools let argPath = pathArg args dir <- maybe getCurrentDirectory (return . takeDirectory) argPath mCabalFile <- findCabalFile dir >>= traverse absoluteFilePath when (debug args) . putStrLn $ "Cabal file: " <> show mCabalFile mStackYaml <- findStackYaml dir when (debug args) . putStrLn $ "Stack file: " <> show mStackYaml let extra = emptyCommandExtra { cePath = argPath , ceGhcOptions = ghcOpts args , ceCabalFilePath = mCabalFile , ceCabalOptions = cabalOpts args , ceStackYamlPath = mStackYaml } let defaultSocketPath = maybe "" takeDirectory mCabalFile defaultSocketFile let sock = fromMaybe defaultSocketPath $ socket args when (debug args) . putStrLn $ "Socket file: " <> show sock case args of Admin {} -> doAdmin sock args extra Check {} -> doCheck sock args extra ModuleFile {} -> doModuleFile sock args extra Info {} -> doInfo sock args extra Type {} -> doType sock args extra FindSymbol {} -> doFindSymbol sock args extra doAdmin :: FilePath -> HDevTools -> CommandExtra -> IO () doAdmin sock args cmdExtra | start_server args = if noDaemon args then startServer sock Nothing cmdExtra else do s <- createListenSocket sock daemonize True $ startServer sock (Just s) cmdExtra | status args = getServerStatus sock | stop_server args = stopServer sock | otherwise = do progName <- getProgName hPutStrLn stderr "You must provide a command. See:" hPutStrLn stderr $ progName ++ " --help" doModuleFile :: FilePath -> HDevTools -> CommandExtra -> IO () doModuleFile sock args extra = serverCommand sock (CmdModuleFile (module_ args)) extra doFileCommand :: String -> (HDevTools -> Command) -> FilePath -> HDevTools -> CommandExtra -> IO () doFileCommand cmdName cmd sock args extra | null (file args) = do progName <- getProgName hPutStrLn stderr "You must provide a haskell source file. See:" hPutStrLn stderr $ progName ++ " " ++ cmdName ++ " --help" | otherwise = do absFile <- absoluteFilePath $ file args let args' = args { file = absFile } serverCommand sock (cmd args') extra doCheck :: FilePath -> HDevTools -> CommandExtra -> IO () doCheck = doFileCommand "check" $ \args -> CmdCheck (file args) doInfo :: FilePath -> HDevTools -> CommandExtra -> IO () doInfo = doFileCommand "info" $ \args -> CmdInfo (file args) (identifier args) doType :: FilePath -> HDevTools -> CommandExtra -> IO () doType = doFileCommand "type" $ \args -> CmdType (file args) (line args, col args) doFindSymbol :: FilePath -> HDevTools -> CommandExtra -> IO () doFindSymbol sock args extra = serverCommand sock (CmdFindSymbol (symbol args) (files args)) extra hdevtools-0.1.4.1/src/Cabal.hs0000644000000000000000000003105712763017754014217 0ustar0000000000000000{-# LANGUAGE CPP #-} module Cabal ( getPackageGhcOpts , findCabalFile ) where import Stack import Control.Exception (IOException, catch) import Control.Monad (when) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State (execStateT, modify) import Data.Char (isSpace) import Data.List (foldl', nub, sort, find, isPrefixOf, isSuffixOf) #if __GLASGOW_HASKELL__ < 709 import Control.Applicative ((<$>)) import Data.Monoid (Monoid(..)) #endif import Distribution.Package (PackageIdentifier(..), PackageName) import Distribution.PackageDescription (PackageDescription(..), Executable(..), TestSuite(..), Benchmark(..), emptyHookedBuildInfo, buildable, libBuildInfo) import Distribution.PackageDescription.Parse (readPackageDescription) import Distribution.Simple.Configure (configure) import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), ComponentLocalBuildInfo(..), Component(..), ComponentName(..), #if !MIN_VERSION_Cabal(1,18,0) allComponentsBy, #endif componentBuildInfo, foldComponent) import Distribution.Simple.Compiler (PackageDB(..)) import Distribution.Simple.Command (CommandParse(..), commandParseArgs) import Distribution.Simple.GHC (componentGhcOptions) import Distribution.Simple.Program (defaultProgramConfiguration) import Distribution.Simple.Program.Db (lookupProgram) import Distribution.Simple.Program.Types (ConfiguredProgram(programVersion), simpleProgram) import Distribution.Simple.Program.GHC (GhcOptions(..), renderGhcOptions) import Distribution.Simple.Setup (ConfigFlags(..), defaultConfigFlags, configureCommand, toFlag) #if MIN_VERSION_Cabal(1,21,1) import Distribution.Utils.NubList #endif import qualified Distribution.Simple.GHC as GHC(configure) import Distribution.Verbosity (silent) import Distribution.Version (Version(..)) import System.IO.Error (ioeGetErrorString) import System.Directory (doesFileExist, doesDirectoryExist, getDirectoryContents) import System.FilePath (takeDirectory, splitFileName, ()) componentName :: Component -> ComponentName componentName = foldComponent (const CLibName) (CExeName . exeName) (CTestName . testName) (CBenchName . benchmarkName) getComponentLocalBuildInfo :: LocalBuildInfo -> ComponentName -> ComponentLocalBuildInfo #if MIN_VERSION_Cabal(1,18,0) getComponentLocalBuildInfo lbi cname = getLocalBuildInfo cname $ componentsConfigs lbi where getLocalBuildInfo cname' ((cname'', clbi, _):cfgs) = if cname' == cname'' then clbi else getLocalBuildInfo cname' cfgs getLocalBuildInfo _ [] = error $ "internal error: missing config" #else getComponentLocalBuildInfo lbi CLibName = case libraryConfig lbi of Nothing -> error $ "internal error: missing library config" Just clbi -> clbi getComponentLocalBuildInfo lbi (CExeName name) = case lookup name (executableConfigs lbi) of Nothing -> error $ "internal error: missing config for executable " ++ name Just clbi -> clbi getComponentLocalBuildInfo lbi (CTestName name) = case lookup name (testSuiteConfigs lbi) of Nothing -> error $ "internal error: missing config for test suite " ++ name Just clbi -> clbi getComponentLocalBuildInfo lbi (CBenchName name) = case lookup name (testSuiteConfigs lbi) of Nothing -> error $ "internal error: missing config for benchmark " ++ name Just clbi -> clbi #endif #if MIN_VERSION_Cabal(1,18,0) -- TODO: Fix callsites so we don't need `allComponentsBy`. It was taken from -- http://hackage.haskell.org/package/Cabal-1.16.0.3/docs/src/Distribution-Simple-LocalBuildInfo.html#allComponentsBy -- since it doesn't exist in Cabal 1.18.* -- -- | Obtains all components (libs, exes, or test suites), transformed by the -- given function. Useful for gathering dependencies with component context. allComponentsBy :: PackageDescription -> (Component -> a) -> [a] allComponentsBy pkg_descr f = [ f (CLib lib) | Just lib <- [library pkg_descr] , buildable (libBuildInfo lib) ] ++ [ f (CExe exe) | exe <- executables pkg_descr , buildable (buildInfo exe) ] ++ [ f (CTest tst) | tst <- testSuites pkg_descr , buildable (testBuildInfo tst) , testEnabled tst ] ++ [ f (CBench bm) | bm <- benchmarks pkg_descr , buildable (benchmarkBuildInfo bm) , benchmarkEnabled bm ] #endif stackifyFlags :: ConfigFlags -> Maybe StackConfig -> ConfigFlags stackifyFlags cfg Nothing = cfg stackifyFlags cfg (Just si) = cfg { configHcPath = toFlag ghc , configHcPkg = toFlag ghcPkg , configDistPref = toFlag dist , configPackageDBs = pdbs } where pdbs = [Nothing, Just GlobalPackageDB] ++ pdbs' pdbs' = Just . SpecificPackageDB <$> stackDbs si dist = stackDist si ghc = stackGhcBinDir si "ghc" ghcPkg = stackGhcBinDir si "ghc-pkg" -- via: https://groups.google.com/d/msg/haskell-stack/8HJ6DHAinU0/J68U6AXTsasJ -- cabal configure --package-db=clear --package-db=global --package-db=$(stack path --snapshot-pkg-db) --package-db=$(stack path --local-pkg-db) getPackageGhcOpts :: FilePath -> Maybe StackConfig -> [String] -> IO (Either String [String]) getPackageGhcOpts path mbStack opts = do getPackageGhcOpts' `catch` (\e -> do return $ Left $ "Cabal error: " ++ (ioeGetErrorString (e :: IOException))) where getPackageGhcOpts' :: IO (Either String [String]) getPackageGhcOpts' = do genPkgDescr <- readPackageDescription silent path distDir <- getDistDir let programCfg = defaultProgramConfiguration let initCfgFlags = (defaultConfigFlags programCfg) { configDistPref = toFlag distDir -- TODO: figure out how to find out this flag , configUserInstall = toFlag True -- configure with --enable-tests to include test dependencies/modules , configTests = toFlag True -- configure with --enable-benchmarks to include benchmark dependencies/modules , configBenchmarks = toFlag True } let initCfgFlags' = stackifyFlags initCfgFlags mbStack cfgFlags <- flip execStateT initCfgFlags' $ do let sandboxConfig = takeDirectory path "cabal.sandbox.config" exists <- lift $ doesFileExist sandboxConfig when (exists) $ do sandboxPackageDb <- lift $ getSandboxPackageDB sandboxConfig modify $ \x -> x { configPackageDBs = [Just sandboxPackageDb] } let cmdUI = configureCommand programCfg case commandParseArgs cmdUI True opts of CommandReadyToGo (modFlags, _) -> modify modFlags CommandErrors (e:_) -> error e _ -> return () localBuildInfo <- configure (genPkgDescr, emptyHookedBuildInfo) cfgFlags let pkgDescr = localPkgDescr localBuildInfo let baseDir = fst . splitFileName $ path case getGhcVersion localBuildInfo of Nothing -> return $ Left "GHC is not configured" Just ghcVersion -> do let mbLibName = pkgLibName pkgDescr let ghcOpts' = foldl' mappend mempty . map (getComponentGhcOptions localBuildInfo) . flip allComponentsBy (\c -> c) . localPkgDescr $ localBuildInfo -- FIX bug in GhcOptions' `mappend` #if MIN_VERSION_Cabal(1,21,1) -- API Change: -- Distribution.Simple.Program.GHC.GhcOptions now uses NubListR's -- GhcOptions { .. ghcOptPackages :: NubListR (InstalledPackageId, PackageId, ModuleRemaining) .. } ghcOpts = ghcOpts' { ghcOptExtra = overNubListR (filter (/= "-Werror")) $ ghcOptExtra ghcOpts' #if __GLASGOW_HASKELL__ >= 709 , ghcOptPackageDBs = sort $ nub (ghcOptPackageDBs ghcOpts') #endif , ghcOptPackages = overNubListR (filter (\(_, pkgId, _) -> Just (pkgName pkgId) /= mbLibName)) $ (ghcOptPackages ghcOpts') , ghcOptSourcePath = overNubListR (map (baseDir )) (ghcOptSourcePath ghcOpts') } #else -- GhcOptions { .. ghcOptPackages :: [(InstalledPackageId, PackageId)] .. } let ghcOpts = ghcOpts' { ghcOptExtra = filter (/= "-Werror") $ nub $ ghcOptExtra ghcOpts' , ghcOptPackages = filter (\(_, pkgId) -> Just (pkgName pkgId) /= mbLibName) $ nub (ghcOptPackages ghcOpts') , ghcOptSourcePath = map (baseDir ) (ghcOptSourcePath ghcOpts') } #endif #if MIN_VERSION_Cabal(1,18,0) -- API Change: -- Distribution.Simple.GHC.configure now returns (Compiler, Maybe Platform, ProgramConfiguration) -- It used to just return (Compiler, ProgramConfiguration) -- GHC.configure :: Verbosity -> Maybe FilePath -> Maybe FilePath -> ProgramConfiguration -- -> IO (Compiler, Maybe Platform, ProgramConfiguration) (ghcInfo, mbPlatform, _) <- GHC.configure silent Nothing Nothing defaultProgramConfiguration #else -- configure :: Verbosity -> Maybe FilePath -> Maybe FilePath -> ProgramConfiguration -- -> IO (Compiler, ProgramConfiguration) (ghcInfo, _) <- GHC.configure silent Nothing Nothing defaultProgramConfiguration -- let mbPlatform = Just (hostPlatform localBuildInfo) :: Maybe Platform #endif putStrLn $ "Configured GHC " ++ show ghcVersion #if MIN_VERSION_Cabal(1,18,0) ++ " " ++ show mbPlatform #endif #if MIN_VERSION_Cabal(1,23,2) -- API Change: -- Distribution.Simple.Program.GHC.renderGhcOptions now takes Platform argument -- renderGhcOptions :: Compiler -> Platform -> GhcOptions -> [String] return $ case mbPlatform of Just platform -> Right $ renderGhcOptions ghcInfo platform ghcOpts Nothing -> Left "GHC.configure did not return platform" #else #if MIN_VERSION_Cabal(1,20,0) -- renderGhcOptions :: Compiler -> GhcOptions -> [String] return $ Right $ renderGhcOptions ghcInfo ghcOpts #else -- renderGhcOptions :: Version -> GhcOptions -> [String] return $ Right $ renderGhcOptions ghcVersion ghcOpts #endif #endif -- returns the right 'dist' directory in the case of a sandbox getDistDir = do let dir = takeDirectory path "dist" exists <- doesDirectoryExist dir if not exists then return dir else do contents <- getDirectoryContents dir return . maybe dir (dir ) $ find ("dist-sandbox-" `isPrefixOf`) contents pkgLibName :: PackageDescription -> Maybe PackageName pkgLibName pkgDescr = if hasLibrary pkgDescr then Just $ pkgName . package $ pkgDescr else Nothing hasLibrary :: PackageDescription -> Bool hasLibrary = maybe False (\_ -> True) . library getComponentGhcOptions :: LocalBuildInfo -> Component -> GhcOptions getComponentGhcOptions lbi comp = componentGhcOptions silent lbi bi clbi (buildDir lbi) where bi = componentBuildInfo comp clbi = getComponentLocalBuildInfo lbi (componentName comp) getGhcVersion :: LocalBuildInfo -> Maybe Version getGhcVersion lbi = let db = withPrograms lbi in do ghc <- lookupProgram (simpleProgram "ghc") db programVersion ghc getSandboxPackageDB :: FilePath -> IO PackageDB getSandboxPackageDB sandboxPath = do contents <- readFile sandboxPath return $ SpecificPackageDB $ extractValue . parse $ contents where pkgDbKey = "package-db:" parse = head . filter (pkgDbKey `isPrefixOf`) . lines extractValue = fst . break (`elem` "\n\r") . dropWhile isSpace . drop (length pkgDbKey) findCabalFile :: FilePath -> IO (Maybe FilePath) findCabalFile dir = do allFiles <- getDirectoryContents dir let mbCabalFile = find (isCabalFile) allFiles case mbCabalFile of Just cabalFile -> return $ Just $ dir cabalFile Nothing -> let parentDir = takeDirectory dir in if parentDir == dir then return Nothing else findCabalFile parentDir where isCabalFile :: FilePath -> Bool isCabalFile path = ".cabal" `isSuffixOf` path && length path > length ".cabal" hdevtools-0.1.4.1/src/Client.hs0000644000000000000000000000425212753550537014430 0ustar0000000000000000module Client ( getServerStatus , stopServer , serverCommand ) where import Control.Exception (tryJust) import Control.Monad (guard) import Network (PortID(UnixSocket), connectTo) import System.Exit (exitFailure, exitWith) import System.IO (Handle, hClose, hFlush, hGetLine, hPutStrLn, stderr) import System.IO.Error (isDoesNotExistError) import Daemonize (daemonize) import Server (createListenSocket, startServer) import Types (ClientDirective(..), Command(..), CommandExtra(..), ServerDirective(..)) import Util (readMaybe) connect :: FilePath -> IO Handle connect sock = do connectTo "" (UnixSocket sock) getServerStatus :: FilePath -> IO () getServerStatus sock = do h <- connect sock hPutStrLn h $ show SrvStatus hFlush h startClientReadLoop h stopServer :: FilePath -> IO () stopServer sock = do h <- connect sock hPutStrLn h $ show SrvExit hFlush h startClientReadLoop h serverCommand :: FilePath -> Command -> CommandExtra -> IO () serverCommand sock cmd cmdExtra = do r <- tryJust (guard . isDoesNotExistError) (connect sock) case r of Right h -> do hPutStrLn h $ show (SrvCommand cmd cmdExtra) hFlush h startClientReadLoop h Left _ -> do s <- createListenSocket sock daemonize False $ startServer sock (Just s) cmdExtra serverCommand sock cmd cmdExtra startClientReadLoop :: Handle -> IO () startClientReadLoop h = do msg <- hGetLine h let clientDirective = readMaybe msg case clientDirective of Just (ClientStdout out) -> putStrLn out >> startClientReadLoop h Just (ClientStderr err) -> hPutStrLn stderr err >> startClientReadLoop h Just (ClientExit exitCode) -> hClose h >> exitWith exitCode Just (ClientUnexpectedError err) -> hClose h >> unexpectedError err Nothing -> do hClose h unexpectedError $ "The server sent an invalid message to the client: " ++ show msg unexpectedError :: String -> IO () unexpectedError err = do hPutStrLn stderr banner hPutStrLn stderr err hPutStrLn stderr banner exitFailure where banner = replicate 78 '*' hdevtools-0.1.4.1/src/CommandArgs.hs0000644000000000000000000001562012753550537015406 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE CPP #-} module CommandArgs ( HDevTools(..) , loadHDevTools ) where import Data.Version (showVersion) import Paths_hdevtools (version) import System.Console.CmdArgs.Implicit import System.Environment (getProgName) import System.Info (arch, os) import qualified Config programVersion :: String programVersion = "version " ++ showVersion version cabalVersion :: String cabalVersion = "cabal-" ++ VERSION_Cabal fullVersion :: String fullVersion = concat [ programVersion , " (" , "ghc-", Config.cProjectVersion, "-", arch, "-", os , ", ", cabalVersion , ")" ] data HDevTools = Admin { socket :: Maybe FilePath , ghcOpts :: [String] , start_server :: Bool , cabalOpts :: [String] , noDaemon :: Bool , status :: Bool , stop_server :: Bool , debug :: Bool } | Check { socket :: Maybe FilePath , ghcOpts :: [String] , cabalOpts :: [String] , path :: Maybe String , file :: String , json :: Bool , debug :: Bool } | ModuleFile { socket :: Maybe FilePath , ghcOpts :: [String] , cabalOpts :: [String] , module_ :: String , debug :: Bool } | Info { socket :: Maybe FilePath , ghcOpts :: [String] , cabalOpts :: [String] , path :: Maybe String , file :: String , identifier :: String , debug :: Bool } | Type { socket :: Maybe FilePath , ghcOpts :: [String] , cabalOpts :: [String] , path :: Maybe String , file :: String , line :: Int , col :: Int , debug :: Bool } | FindSymbol { socket :: Maybe FilePath , ghcOpts :: [String] , cabalOpts :: [String] , symbol :: String , files :: [String] , debug :: Bool } deriving (Show, Data, Typeable) dummyAdmin :: HDevTools dummyAdmin = Admin { socket = Nothing , ghcOpts = [] , cabalOpts = [] , start_server = False , noDaemon = False , status = False , stop_server = False , debug = False } dummyCheck :: HDevTools dummyCheck = Check { socket = Nothing , ghcOpts = [] , cabalOpts = [] , path = Nothing , file = "" , json = False , debug = False } dummyModuleFile :: HDevTools dummyModuleFile = ModuleFile { socket = Nothing , ghcOpts = [] , cabalOpts = [] , module_ = "" , debug = False } dummyInfo :: HDevTools dummyInfo = Info { socket = Nothing , ghcOpts = [] , cabalOpts = [] , path = Nothing , file = "" , identifier = "" , debug = False } dummyType :: HDevTools dummyType = Type { socket = Nothing , ghcOpts = [] , cabalOpts = [] , path = Nothing , file = "" , line = 0 , col = 0 , debug = False } dummyFindSymbol :: HDevTools dummyFindSymbol = FindSymbol { socket = Nothing , ghcOpts = [] , cabalOpts = [] , symbol = "" , files = [] , debug = False } admin :: Annotate Ann admin = record dummyAdmin [ socket := def += typFile += help "socket file to use" , ghcOpts := def += typ "OPTION" += help "ghc options" , cabalOpts := def += typ "OPTION" += help "cabal options" , start_server := def += help "start server" , noDaemon := def += help "do not daemonize (only if --start-server)" , status := def += help "show status of server" , stop_server := def += help "shutdown the server" , debug := def += help "enable debug output" ] += help "Interactions with the server" check :: Annotate Ann check = record dummyCheck [ socket := def += typFile += help "socket file to use" , ghcOpts := def += typ "OPTION" += help "ghc options" , cabalOpts := def += typ "OPTION" += help "cabal options" , path := def += typFile += help "path to target file" , file := def += typFile += argPos 0 += opt "" , json := def += help "render output as JSON" , debug := def += help "enable debug output" ] += help "Check a haskell source file for errors and warnings" moduleFile :: Annotate Ann moduleFile = record dummyModuleFile [ socket := def += typFile += help "socket file to use" , ghcOpts := def += typ "OPTION" += help "ghc options" , cabalOpts := def += typ "OPTION" += help "cabal options" , module_ := def += typ "MODULE" += argPos 0 , debug := def += help "enable debug output" ] += help "Get the haskell source file corresponding to a module name" info :: Annotate Ann info = record dummyInfo [ socket := def += typFile += help "socket file to use" , ghcOpts := def += typ "OPTION" += help "ghc options" , cabalOpts := def += typ "OPTION" += help "cabal options" , path := def += typFile += help "path to target file" , file := def += typFile += argPos 0 += opt "" , identifier := def += typ "IDENTIFIER" += argPos 1 , debug := def += help "enable debug output" ] += help "Get info from GHC about the specified identifier" type_ :: Annotate Ann type_ = record dummyType [ socket := def += typFile += help "socket file to use" , ghcOpts := def += typ "OPTION" += help "ghc options" , cabalOpts := def += typ "OPTION" += help "cabal options" , debug := def += help "enable debug output" , path := def += typFile += help "path to target file" , file := def += typFile += argPos 0 += opt "" , line := def += typ "LINE" += argPos 1 , col := def += typ "COLUMN" += argPos 2 ] += help "Get the type of the expression at the specified line and column" findSymbol :: Annotate Ann findSymbol = record dummyFindSymbol [ socket := def += typFile += help "socket file to use" , ghcOpts := def += typ "OPTION" += help "ghc options" , cabalOpts := def += typ "OPTION" += help "cabal options" , symbol := def += typ "SYMBOL" += argPos 0 , files := def += typFile += args , debug := def += help "enable debug output" ] += help "List the modules where the given symbol could be found" full :: String -> Annotate Ann full progName = modes_ [admin += auto, check, moduleFile, info, type_, findSymbol] += helpArg [name "h", groupname "Help"] += versionArg [groupname "Help"] += program progName += summary (progName ++ ": " ++ fullVersion) loadHDevTools :: IO HDevTools loadHDevTools = do progName <- getProgName (cmdArgs_ (full progName) :: IO HDevTools) hdevtools-0.1.4.1/src/CommandLoop.hs0000644000000000000000000002607612753550537015432 0ustar0000000000000000{-# LANGUAGE CPP #-} module CommandLoop ( newCommandLoopState , Config(..) , CabalConfig(..) , updateConfig , startCommandLoop ) where import Control.Applicative ((<|>)) import Control.Monad (when) import Data.IORef import Data.List (find, intercalate) #if __GLASGOW_HASKELL__ < 709 import Control.Applicative ((<$>)) import Data.Traversable (traverse) #endif import MonadUtils (MonadIO, liftIO) import System.Directory (setCurrentDirectory) import System.Exit (ExitCode(ExitFailure, ExitSuccess)) import System.FilePath (takeDirectory) import qualified ErrUtils import qualified Exception (ExceptionMonad) #if __GLASGOW_HASKELL__ >= 800 import qualified DynFlags #endif import qualified GHC import qualified GHC.Paths import qualified Outputable import System.Posix.Types (EpochTime) import System.Posix.Files (getFileStatus, modificationTime) import Types (ClientDirective(..), Command(..), CommandExtra(..)) import Info (getIdentifierInfo, getType) import FindSymbol (findSymbol) import Cabal (getPackageGhcOpts) import Stack type ClientSend = ClientDirective -> IO () data State = State { stateWarningsEnabled :: Bool } newCommandLoopState :: IO (IORef State) newCommandLoopState = do newIORef $ State { stateWarningsEnabled = True } data CabalConfig = CabalConfig { cabalConfigPath :: FilePath , cabalConfigOpts :: [String] , cabalConfigLastUpdatedAt :: EpochTime } deriving (Eq, Show) mkCabalConfig :: FilePath -> [String] -> IO CabalConfig mkCabalConfig path opts = do fileStatus <- getFileStatus path return $ CabalConfig { cabalConfigPath = path , cabalConfigOpts = opts , cabalConfigLastUpdatedAt = modificationTime fileStatus } data Config = Config { configGhcOpts :: [String] , configCabal :: Maybe CabalConfig , configStack :: Maybe StackConfig } deriving (Eq, Show) updateConfig :: Maybe Config -> CommandExtra -> IO Config updateConfig mConfig cmdExtra = do mbCabalConfig <- traverse (\path -> mkCabalConfig path (ceCabalOptions cmdExtra)) $ ceCabalFilePath cmdExtra mbStackConfig <- if (stackYaml <$> msc) == (ceStackYamlPath cmdExtra) then return msc else getStackConfig cmdExtra return $ Config { configGhcOpts = "-O0" : ceGhcOptions cmdExtra , configCabal = mbCabalConfig , configStack = mbStackConfig } where msc = mConfig >>= configStack type CommandObj = (Command, Config) withWarnings :: (MonadIO m, Exception.ExceptionMonad m) => IORef State -> Bool -> m a -> m a withWarnings state warningsValue action = do beforeState <- liftIO $ getWarnings liftIO $ setWarnings warningsValue action `GHC.gfinally` (liftIO $ setWarnings beforeState) where getWarnings :: IO Bool getWarnings = readIORef state >>= return . stateWarningsEnabled setWarnings :: Bool -> IO () setWarnings val = modifyIORef state $ \s -> s { stateWarningsEnabled = val } startCommandLoop :: IORef State -> ClientSend -> IO (Maybe CommandObj) -> Config -> Maybe Command -> IO () startCommandLoop state clientSend getNextCommand initialConfig mbInitialCommand = do continue <- GHC.runGhc ghcLibDir $ do configResult <- configSession state clientSend initialConfig case configResult of Left e -> do liftIO $ mapM_ clientSend [ ClientStderr e , ClientExit (ExitFailure 1) ] processNextCommand True Right _ -> do doMaybe mbInitialCommand $ \cmd -> sendErrors (runCommand state clientSend cmd) processNextCommand False case continue of Nothing -> -- Exit return () Just (cmd, config) -> startCommandLoop state clientSend getNextCommand config (Just cmd) where ghcLibDir = stackGhcLibDir <$> configStack initialConfig <|> Just GHC.Paths.libdir processNextCommand :: Bool -> GHC.Ghc (Maybe CommandObj) processNextCommand forceReconfig = do mbNextCmd <- liftIO getNextCommand case mbNextCmd of Nothing -> -- Exit return Nothing Just (cmd, config) -> if forceReconfig || (config /= initialConfig) then return (Just (cmd, config)) else sendErrors (runCommand state clientSend cmd) >> processNextCommand False sendErrors :: GHC.Ghc () -> GHC.Ghc () sendErrors action = GHC.gcatch action $ \e -> do liftIO $ mapM_ clientSend [ ClientStderr $ GHC.showGhcException e "" , ClientExit (ExitFailure 1) ] return () doMaybe :: Monad m => Maybe a -> (a -> m ()) -> m () doMaybe Nothing _ = return () doMaybe (Just x) f = f x configSession :: IORef State -> ClientSend -> Config -> GHC.Ghc (Either String ()) configSession state clientSend config = do eCabalGhcOpts <- case configCabal config of Nothing -> return $ Right [] Just cabalConfig -> do liftIO $ setCurrentDirectory . takeDirectory $ cabalConfigPath cabalConfig liftIO $ getPackageGhcOpts (cabalConfigPath cabalConfig) (configStack config) (cabalConfigOpts cabalConfig) case eCabalGhcOpts of Left e -> return $ Left e Right cabalGhcOpts -> do let allGhcOpts = cabalGhcOpts ++ configGhcOpts config GHC.gcatch (Right <$> updateDynFlags allGhcOpts) (fmap Left . handleGhcError) where updateDynFlags :: [String] -> GHC.Ghc () updateDynFlags ghcOpts = do initialDynFlags <- GHC.getSessionDynFlags let updatedDynFlags = initialDynFlags { GHC.log_action = logAction state clientSend , GHC.ghcLink = GHC.NoLink , GHC.hscTarget = GHC.HscNothing } (finalDynFlags, _, _) <- GHC.parseDynamicFlags updatedDynFlags (map GHC.noLoc ghcOpts) _ <- GHC.setSessionDynFlags finalDynFlags return () handleGhcError :: GHC.GhcException -> GHC.Ghc String handleGhcError e = return $ GHC.showGhcException e "" runCommand :: IORef State -> ClientSend -> Command -> GHC.Ghc () runCommand _ clientSend (CmdCheck file) = do let noPhase = Nothing target <- GHC.guessTarget file noPhase GHC.setTargets [target] let handler err = GHC.printException err >> return GHC.Failed flag <- GHC.handleSourceError handler (GHC.load GHC.LoadAllTargets) liftIO $ case flag of GHC.Succeeded -> clientSend (ClientExit ExitSuccess) GHC.Failed -> clientSend (ClientExit (ExitFailure 1)) runCommand _ clientSend (CmdModuleFile moduleName) = do moduleGraph <- GHC.getModuleGraph case find (moduleSummaryMatchesModuleName moduleName) moduleGraph of Nothing -> liftIO $ mapM_ clientSend [ ClientStderr "Module not found" , ClientExit (ExitFailure 1) ] Just modSummary -> case GHC.ml_hs_file (GHC.ms_location modSummary) of Nothing -> liftIO $ mapM_ clientSend [ ClientStderr "Module does not have a source file" , ClientExit (ExitFailure 1) ] Just file -> liftIO $ mapM_ clientSend [ ClientStdout file , ClientExit ExitSuccess ] where moduleSummaryMatchesModuleName modName modSummary = modName == (GHC.moduleNameString . GHC.moduleName . GHC.ms_mod) modSummary runCommand state clientSend (CmdInfo file identifier) = do result <- withWarnings state False $ getIdentifierInfo file identifier case result of Left err -> liftIO $ mapM_ clientSend [ ClientStderr err , ClientExit (ExitFailure 1) ] Right info -> liftIO $ mapM_ clientSend [ ClientStdout info , ClientExit ExitSuccess ] runCommand state clientSend (CmdType file (line, col)) = do result <- withWarnings state False $ getType file (line, col) case result of Left err -> liftIO $ mapM_ clientSend [ ClientStderr err , ClientExit (ExitFailure 1) ] Right types -> liftIO $ do mapM_ (clientSend . ClientStdout . formatType) types clientSend (ClientExit ExitSuccess) where formatType :: ((Int, Int, Int, Int), String) -> String formatType ((startLine, startCol, endLine, endCol), t) = concat [ show startLine , " " , show startCol , " " , show endLine , " " , show endCol , " " , "\"", t, "\"" ] runCommand state clientSend (CmdFindSymbol symbol files) = do result <- withWarnings state False $ findSymbol symbol files case result of [] -> liftIO $ mapM_ clientSend [ ClientStderr $ "Couldn't find modules containing '" ++ symbol ++ "'" , ClientExit (ExitFailure 1) ] modules -> liftIO $ mapM_ clientSend [ ClientStdout (formatModules modules) , ClientExit ExitSuccess ] where formatModules = intercalate "\n" #if __GLASGOW_HASKELL__ >= 800 logAction :: IORef State -> ClientSend -> GHC.DynFlags -> DynFlags.WarnReason -> GHC.Severity -> GHC.SrcSpan -> Outputable.PprStyle -> ErrUtils.MsgDoc -> IO () logAction state clientSend dflags _ severity srcspan style msg = let out = Outputable.renderWithStyle dflags fullMsg style _ = severity in logActionSend state clientSend severity out where fullMsg = ErrUtils.mkLocMessage severity srcspan msg #elif __GLASGOW_HASKELL__ >= 706 logAction :: IORef State -> ClientSend -> GHC.DynFlags -> GHC.Severity -> GHC.SrcSpan -> Outputable.PprStyle -> ErrUtils.MsgDoc -> IO () logAction state clientSend dflags severity srcspan style msg = let out = Outputable.renderWithStyle dflags fullMsg style _ = severity in logActionSend state clientSend severity out where fullMsg = ErrUtils.mkLocMessage severity srcspan msg #else logAction :: IORef State -> ClientSend -> GHC.Severity -> GHC.SrcSpan -> Outputable.PprStyle -> ErrUtils.Message -> IO () logAction state clientSend severity srcspan style msg = let out = Outputable.renderWithStyle fullMsg style _ = severity in logActionSend state clientSend severity out where fullMsg = ErrUtils.mkLocMessage srcspan msg #endif logActionSend :: IORef State -> ClientSend -> GHC.Severity -> String -> IO () logActionSend state clientSend severity out = do currentState <- readIORef state when (not (isWarning severity) || stateWarningsEnabled currentState) $ clientSend (ClientStdout out) where isWarning :: GHC.Severity -> Bool isWarning GHC.SevWarning = True isWarning _ = False hdevtools-0.1.4.1/src/Daemonize.hs0000644000000000000000000000161012635015142015103 0ustar0000000000000000module Daemonize ( daemonize ) where import Control.Monad (when) import System.Exit (ExitCode(ExitSuccess)) import System.Posix.Process (exitImmediately, createSession, forkProcess) import System.Posix.IO -- | This goes against the common daemon guidelines and does not change the -- current working directory! -- -- We need the daemon to stay in the current directory for the GHC API to work daemonize :: Bool -> IO () -> IO () daemonize exit program = do _ <- forkProcess child1 when exit $ exitImmediately ExitSuccess where child1 = do _ <- createSession _ <- forkProcess child2 exitImmediately ExitSuccess child2 = do mapM_ closeFd [stdInput, stdOutput, stdError] nullFd <- openFd "/dev/null" ReadWrite Nothing defaultFileFlags mapM_ (dupTo nullFd) [stdInput, stdOutput, stdError] closeFd nullFd program hdevtools-0.1.4.1/src/FindSymbol.hs0000644000000000000000000000705612735040577015263 0ustar0000000000000000{-# Language ScopedTypeVariables, CPP #-} module FindSymbol ( findSymbol ) where #if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>)) import qualified UniqFM #else import GHC.PackageDb (exposedName) import GhcMonad (liftIO) #endif import Control.Monad (filterM) import Control.Exception import Data.List (find, nub) import Data.Maybe (catMaybes, isJust) import qualified GHC import qualified Packages as PKG import qualified Name import Exception (ghandle) type SymbolName = String type ModuleName = String findSymbol :: SymbolName -> [FilePath] -> GHC.Ghc [ModuleName] findSymbol symbol files = do -- for the findsymbol command GHC shouldn't output any warnings -- or errors to stdout for the loaded source files, we're only -- interested in the module graph of the loaded targets dynFlags <- GHC.getSessionDynFlags _ <- GHC.setSessionDynFlags dynFlags { GHC.log_action = \_ _ _ _ _ -> #if __GLASGOW_HASKELL__ >= 800 return . return $ () } #else return () } #endif fileMods <- concat <$> mapM (findSymbolInFile symbol) files -- reset the old log_action _ <- GHC.setSessionDynFlags dynFlags pkgsMods <- findSymbolInPackages symbol return . nub . map (GHC.moduleNameString . GHC.moduleName) $ fileMods ++ pkgsMods findSymbolInFile :: SymbolName -> FilePath -> GHC.Ghc [GHC.Module] findSymbolInFile symbol file = do loadFile filterM (containsSymbol symbol) =<< fileModules where loadFile = do let noPhase = Nothing target <- GHC.guessTarget file noPhase GHC.setTargets [target] let handler err = GHC.printException err >> return GHC.Failed _ <- GHC.handleSourceError handler (GHC.load GHC.LoadAllTargets) return () fileModules = map GHC.ms_mod <$> GHC.getModuleGraph findSymbolInPackages :: SymbolName -> GHC.Ghc [GHC.Module] findSymbolInPackages symbol = filterM (containsSymbol symbol) =<< allExposedModules where allExposedModules :: GHC.Ghc [GHC.Module] allExposedModules = do modNames <- exposedModuleNames catMaybes <$> mapM findModule modNames where exposedModuleNames :: GHC.Ghc [GHC.ModuleName] #if __GLASGOW_HASKELL__ < 710 exposedModuleNames = concatMap exposedModules . UniqFM.eltsUFM . PKG.pkgIdMap . GHC.pkgState <$> GHC.getSessionDynFlags #elif __GLASGOW_HASKELL__ >= 800 exposedModuleNames = do dynFlags <- GHC.getSessionDynFlags pkgConfigs <- liftIO $ fmap concat . (fmap . fmap) snd . PKG.readPackageConfigs $ dynFlags return $ map exposedName (concatMap exposedModules pkgConfigs) #else exposedModuleNames = do dynFlags <- GHC.getSessionDynFlags pkgConfigs <- liftIO $ PKG.readPackageConfigs dynFlags return $ map exposedName (concatMap exposedModules pkgConfigs) #endif exposedModules pkg = if PKG.exposed pkg then PKG.exposedModules pkg else [] findModule :: GHC.ModuleName -> GHC.Ghc (Maybe GHC.Module) findModule moduleName = ghandle (\(_ :: SomeException) -> return Nothing) (Just <$> GHC.findModule moduleName Nothing) containsSymbol :: SymbolName -> GHC.Module -> GHC.Ghc Bool containsSymbol symbol module_ = isJust . find (== symbol) <$> allExportedSymbols where allExportedSymbols = ghandle (\(_ :: SomeException) -> return []) (do info <- GHC.getModuleInfo module_ return $ maybe [] (map Name.getOccString . GHC.modInfoExports) info) hdevtools-0.1.4.1/src/Info.hs0000644000000000000000000002503112735040577014101 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} module Info ( getIdentifierInfo , getType ) where import Control.Monad (liftM) import Data.Generics (GenericQ, mkQ, extQ, gmapQ) import Data.List (find, sortBy, intersperse) import Data.Maybe (catMaybes, fromMaybe) import Data.Typeable (Typeable) import MonadUtils (liftIO) import qualified CoreUtils import qualified Desugar #if __GLASGOW_HASKELL__ >= 706 import qualified DynFlags #endif #if __GLASGOW_HASKELL__ >= 708 import qualified HsExpr #else import qualified TcRnTypes #endif import qualified GHC import qualified HscTypes import qualified NameSet import qualified Outputable import qualified PprTyThing import qualified Pretty import qualified TcHsSyn getIdentifierInfo :: FilePath -> String -> GHC.Ghc (Either String String) getIdentifierInfo file identifier = withModSummary file $ \m -> do #if __GLASGOW_HASKELL__ >= 706 GHC.setContext [GHC.IIModule (GHC.moduleName (GHC.ms_mod m))] #elif __GLASGOW_HASKELL__ >= 704 GHC.setContext [GHC.IIModule (GHC.ms_mod m)] #else GHC.setContext [GHC.ms_mod m] [] #endif GHC.handleSourceError (return . Left . show) $ liftM Right (infoThing identifier) getType :: FilePath -> (Int, Int) -> GHC.Ghc (Either String [((Int, Int, Int, Int), String)]) getType file (line, col) = withModSummary file $ \m -> do p <- GHC.parseModule m typechecked <- GHC.typecheckModule p types <- processTypeCheckedModule typechecked (line, col) return (Right types) withModSummary :: String -> (HscTypes.ModSummary -> GHC.Ghc (Either String a)) -> GHC.Ghc (Either String a) withModSummary file action = do let noPhase = Nothing target <- GHC.guessTarget file noPhase GHC.setTargets [target] let handler err = GHC.printException err >> return GHC.Failed flag <- GHC.handleSourceError handler (GHC.load GHC.LoadAllTargets) case flag of GHC.Failed -> return (Left "Error loading targets") GHC.Succeeded -> do modSummary <- getModuleSummary file case modSummary of Nothing -> return (Left "Module not found in module graph") Just m -> action m getModuleSummary :: FilePath -> GHC.Ghc (Maybe GHC.ModSummary) getModuleSummary file = do moduleGraph <- GHC.getModuleGraph case find (moduleSummaryMatchesFilePath file) moduleGraph of Nothing -> return Nothing Just moduleSummary -> return (Just moduleSummary) moduleSummaryMatchesFilePath :: FilePath -> GHC.ModSummary -> Bool moduleSummaryMatchesFilePath file moduleSummary = let location = GHC.ms_location moduleSummary location_file = GHC.ml_hs_file location in case location_file of Just f -> f == file Nothing -> False ------------------------------------------------------------------------------ -- Most of the following code was taken from the source code of 'ghc-mod' (with -- some stylistic changes) -- -- ghc-mod: -- http://www.mew.org/~kazu/proj/ghc-mod/ -- https://github.com/kazu-yamamoto/ghc-mod/ processTypeCheckedModule :: GHC.TypecheckedModule -> (Int, Int) -> GHC.Ghc [((Int, Int, Int, Int), String)] processTypeCheckedModule tcm (line, col) = do let tcs = GHC.tm_typechecked_source tcm bs = listifySpans tcs (line, col) :: [GHC.LHsBind GHC.Id] es = listifySpans tcs (line, col) :: [GHC.LHsExpr GHC.Id] ps = listifySpans tcs (line, col) :: [GHC.LPat GHC.Id] bts <- mapM (getTypeLHsBind tcm) bs ets <- mapM (getTypeLHsExpr tcm) es pts <- mapM (getTypeLPat tcm) ps #if __GLASGOW_HASKELL__ >= 706 dflags <- DynFlags.getDynFlags return $ map (toTup dflags) $ #else return $ map toTup $ #endif sortBy cmp $ catMaybes $ concat [ets, bts, pts] where cmp (a, _) (b, _) | a `GHC.isSubspanOf` b = LT | b `GHC.isSubspanOf` a = GT | otherwise = EQ #if __GLASGOW_HASKELL__ >= 706 toTup :: GHC.DynFlags -> (GHC.SrcSpan, GHC.Type) -> ((Int, Int, Int, Int), String) toTup dflags (spn, typ) = (fourInts spn, pretty dflags typ) #else toTup :: (GHC.SrcSpan, GHC.Type) -> ((Int, Int, Int, Int), String) toTup (spn, typ) = (fourInts spn, pretty typ) #endif fourInts :: GHC.SrcSpan -> (Int, Int, Int, Int) fourInts = fromMaybe (0, 0, 0, 0) . getSrcSpan getSrcSpan :: GHC.SrcSpan -> Maybe (Int, Int, Int, Int) getSrcSpan (GHC.RealSrcSpan spn) = Just (GHC.srcSpanStartLine spn , GHC.srcSpanStartCol spn , GHC.srcSpanEndLine spn , GHC.srcSpanEndCol spn) getSrcSpan _ = Nothing getTypeLHsBind :: GHC.TypecheckedModule -> GHC.LHsBind GHC.Id -> GHC.Ghc (Maybe (GHC.SrcSpan, GHC.Type)) #if __GLASGOW_HASKELL__ >= 708 getTypeLHsBind _ (GHC.L spn GHC.FunBind{GHC.fun_matches = grp}) = return $ Just (spn, HsExpr.mg_res_ty grp) #else getTypeLHsBind _ (GHC.L spn GHC.FunBind{GHC.fun_matches = GHC.MatchGroup _ typ}) = return $ Just (spn, typ) #endif getTypeLHsBind _ _ = return Nothing getTypeLHsExpr :: GHC.TypecheckedModule -> GHC.LHsExpr GHC.Id -> GHC.Ghc (Maybe (GHC.SrcSpan, GHC.Type)) #if __GLASGOW_HASKELL__ >= 708 getTypeLHsExpr _ e = do #else getTypeLHsExpr tcm e = do #endif hs_env <- GHC.getSession #if __GLASGOW_HASKELL__ >= 708 (_, mbe) <- liftIO $ Desugar.deSugarExpr hs_env e #else let modu = GHC.ms_mod $ GHC.pm_mod_summary $ GHC.tm_parsed_module tcm rn_env = TcRnTypes.tcg_rdr_env $ fst $ GHC.tm_internals_ tcm ty_env = TcRnTypes.tcg_type_env $ fst $ GHC.tm_internals_ tcm (_, mbe) <- liftIO $ Desugar.deSugarExpr hs_env modu rn_env ty_env e #endif return () case mbe of Nothing -> return Nothing Just expr -> return $ Just (GHC.getLoc e, CoreUtils.exprType expr) getTypeLPat :: GHC.TypecheckedModule -> GHC.LPat GHC.Id -> GHC.Ghc (Maybe (GHC.SrcSpan, GHC.Type)) getTypeLPat _ (GHC.L spn pat) = return $ Just (spn, TcHsSyn.hsPatType pat) listifySpans :: Typeable a => GHC.TypecheckedSource -> (Int, Int) -> [GHC.Located a] listifySpans tcs lc = listifyStaged TypeChecker p tcs where p (GHC.L spn _) = GHC.isGoodSrcSpan spn && spn `GHC.spans` lc listifyStaged :: Typeable r => Stage -> (r -> Bool) -> GenericQ [r] listifyStaged s p = everythingStaged s (++) [] ([] `mkQ` (\x -> [x | p x])) #if __GLASGOW_HASKELL__ >= 706 pretty :: GHC.DynFlags -> GHC.Type -> String pretty dflags = #else pretty :: GHC.Type -> String pretty = #endif #if __GLASGOW_HASKELL__ >= 800 Pretty.renderStyle Pretty.style{ Pretty.lineLength = 0, Pretty.mode = Pretty.OneLineMode } #elif __GLASGOW_HASKELL__ >= 708 Pretty.showDoc Pretty.OneLineMode 0 #else Pretty.showDocWith Pretty.OneLineMode #endif #if __GLASGOW_HASKELL__ >= 706 . Outputable.withPprStyleDoc dflags #else . Outputable.withPprStyleDoc #endif (Outputable.mkUserStyle Outputable.neverQualify Outputable.AllTheWay) #if __GLASGOW_HASKELL__ >= 708 . PprTyThing.pprTypeForUser #else . PprTyThing.pprTypeForUser False #endif ------------------------------------------------------------------------------ -- The following was taken from 'ghc-syb-utils' -- -- ghc-syb-utils: -- https://github.com/nominolo/ghc-syb -- | Ghc Ast types tend to have undefined holes, to be filled -- by later compiler phases. We tag Asts with their source, -- so that we can avoid such holes based on who generated the Asts. data Stage = Parser | Renamer | TypeChecker deriving (Eq,Ord,Show) -- | Like 'everything', but avoid known potholes, based on the 'Stage' that -- generated the Ast. everythingStaged :: Stage -> (r -> r -> r) -> r -> GenericQ r -> GenericQ r everythingStaged stage k z f x | (const False `extQ` postTcType `extQ` fixity `extQ` nameSet) x = z | otherwise = foldl k (f x) (gmapQ (everythingStaged stage k z f) x) where nameSet = const (stage `elem` [Parser,TypeChecker]) :: NameSet.NameSet -> Bool #if __GLASGOW_HASKELL__ >= 709 postTcType = const (stage Bool #else postTcType = const (stage Bool #endif fixity = const (stage Bool ------------------------------------------------------------------------------ -- The following code was taken from GHC's ghc/InteractiveUI.hs (with some -- stylistic changes) infoThing :: String -> GHC.Ghc String infoThing str = do names <- GHC.parseName str #if __GLASGOW_HASKELL__ >= 708 mb_stuffs <- mapM (GHC.getInfo False) names let filtered = filterOutChildren (\(t,_f,_i,_) -> t) (catMaybes mb_stuffs) #else mb_stuffs <- mapM GHC.getInfo names let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs) #endif unqual <- GHC.getPrintUnqual #if __GLASGOW_HASKELL__ >= 706 dflags <- DynFlags.getDynFlags return $ Outputable.showSDocForUser dflags unqual $ #else return $ Outputable.showSDocForUser unqual $ #endif #if __GLASGOW_HASKELL__ >= 708 Outputable.vcat (intersperse (Outputable.text "") $ map pprInfo filtered) #else Outputable.vcat (intersperse (Outputable.text "") $ map (pprInfo False) filtered) #endif -- Filter out names whose parent is also there Good -- example is '[]', which is both a type and data -- constructor in the same type filterOutChildren :: (a -> HscTypes.TyThing) -> [a] -> [a] filterOutChildren get_thing xs = filter (not . has_parent) xs where all_names = NameSet.mkNameSet (map (GHC.getName . get_thing) xs) #if __GLASGOW_HASKELL__ >= 704 has_parent x = case HscTypes.tyThingParent_maybe (get_thing x) of #else has_parent x = case PprTyThing.pprTyThingParent_maybe (get_thing x) of #endif Just p -> GHC.getName p `NameSet.elemNameSet` all_names Nothing -> False #if __GLASGOW_HASKELL__ >= 708 pprInfo :: (HscTypes.TyThing, GHC.Fixity, [GHC.ClsInst], [GHC.FamInst]) -> Outputable.SDoc pprInfo (thing, fixity, insts, _) = PprTyThing.pprTyThingInContextLoc thing #elif __GLASGOW_HASKELL__ >= 706 pprInfo :: PprTyThing.PrintExplicitForalls -> (HscTypes.TyThing, GHC.Fixity, [GHC.ClsInst]) -> Outputable.SDoc pprInfo pefas (thing, fixity, insts) = PprTyThing.pprTyThingInContextLoc pefas thing #else pprInfo :: PprTyThing.PrintExplicitForalls -> (HscTypes.TyThing, GHC.Fixity, [GHC.Instance]) -> Outputable.SDoc pprInfo pefas (thing, fixity, insts) = PprTyThing.pprTyThingInContextLoc pefas thing #endif Outputable.$$ show_fixity fixity Outputable.$$ Outputable.vcat (map GHC.pprInstance insts) where show_fixity fix | fix == GHC.defaultFixity = Outputable.empty | otherwise = Outputable.ppr fix Outputable.<+> Outputable.ppr (GHC.getName thing) hdevtools-0.1.4.1/src/Main.hs0000644000000000000000000001072212763017754014075 0ustar0000000000000000{-# LANGUAGE CPP #-} module Main where #if __GLASGOW_HASKELL__ < 709 import Data.Traversable (traverse) #endif import Control.Monad (when) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import System.Directory (getCurrentDirectory) import System.Environment (getProgName) import System.IO (hPutStrLn, stderr) import System.FilePath ((), isAbsolute, takeDirectory) import Cabal (findCabalFile) import Client (getServerStatus, serverCommand, stopServer) import CommandArgs import Daemonize (daemonize) import Server (startServer, createListenSocket) import Stack (findStackYaml) import Types (Command(..), CommandExtra(..), emptyCommandExtra) absoluteFilePath :: FilePath -> IO FilePath absoluteFilePath p = if isAbsolute p then return p else do dir <- getCurrentDirectory return $ dir p defaultSocketFile :: FilePath defaultSocketFile = ".hdevtools.sock" fileArg :: HDevTools -> Maybe String fileArg (Admin {}) = Nothing fileArg (ModuleFile {}) = Nothing fileArg args@(Check {}) = Just $ file args fileArg args@(Info {}) = Just $ file args fileArg args@(Type {}) = Just $ file args fileArg (FindSymbol {}) = Nothing pathArg' :: HDevTools -> Maybe String pathArg' (Admin {}) = Nothing pathArg' (ModuleFile {}) = Nothing pathArg' args@(Check {}) = path args pathArg' args@(Info {}) = path args pathArg' args@(Type {}) = path args pathArg' (FindSymbol {}) = Nothing pathArg :: HDevTools -> Maybe String pathArg args = case pathArg' args of Just x -> Just x Nothing -> fileArg args main :: IO () main = do args <- loadHDevTools let argPath = pathArg args dir <- maybe getCurrentDirectory (return . takeDirectory) argPath mCabalFile <- findCabalFile dir >>= traverse absoluteFilePath when (debug args) . putStrLn $ "Cabal file: " <> show mCabalFile mStackYaml <- findStackYaml dir when (debug args) . putStrLn $ "Stack file: " <> show mStackYaml let extra = emptyCommandExtra { cePath = argPath , ceGhcOptions = ghcOpts args , ceCabalFilePath = mCabalFile , ceCabalOptions = cabalOpts args , ceStackYamlPath = mStackYaml } let defaultSocketPath = maybe "" takeDirectory mCabalFile defaultSocketFile let sock = fromMaybe defaultSocketPath $ socket args when (debug args) . putStrLn $ "Socket file: " <> show sock case args of Admin {} -> doAdmin sock args extra Check {} -> doCheck sock args extra ModuleFile {} -> doModuleFile sock args extra Info {} -> doInfo sock args extra Type {} -> doType sock args extra FindSymbol {} -> doFindSymbol sock args extra doAdmin :: FilePath -> HDevTools -> CommandExtra -> IO () doAdmin sock args cmdExtra | start_server args = if noDaemon args then startServer sock Nothing cmdExtra else do s <- createListenSocket sock daemonize True $ startServer sock (Just s) cmdExtra | status args = getServerStatus sock | stop_server args = stopServer sock | otherwise = do progName <- getProgName hPutStrLn stderr "You must provide a command. See:" hPutStrLn stderr $ progName ++ " --help" doModuleFile :: FilePath -> HDevTools -> CommandExtra -> IO () doModuleFile sock args extra = serverCommand sock (CmdModuleFile (module_ args)) extra doFileCommand :: String -> (HDevTools -> Command) -> FilePath -> HDevTools -> CommandExtra -> IO () doFileCommand cmdName cmd sock args extra | null (file args) = do progName <- getProgName hPutStrLn stderr "You must provide a haskell source file. See:" hPutStrLn stderr $ progName ++ " " ++ cmdName ++ " --help" | otherwise = do absFile <- absoluteFilePath $ file args let args' = args { file = absFile } serverCommand sock (cmd args') extra doCheck :: FilePath -> HDevTools -> CommandExtra -> IO () doCheck = doFileCommand "check" $ \args -> CmdCheck (file args) doInfo :: FilePath -> HDevTools -> CommandExtra -> IO () doInfo = doFileCommand "info" $ \args -> CmdInfo (file args) (identifier args) doType :: FilePath -> HDevTools -> CommandExtra -> IO () doType = doFileCommand "type" $ \args -> CmdType (file args) (line args, col args) doFindSymbol :: FilePath -> HDevTools -> CommandExtra -> IO () doFindSymbol sock args extra = serverCommand sock (CmdFindSymbol (symbol args) (files args)) extra hdevtools-0.1.4.1/src/Server.hs0000644000000000000000000000752112753550537014462 0ustar0000000000000000module Server where import Control.Exception (bracket, finally, handleJust, tryJust) import Control.Monad (guard) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import GHC.IO.Exception (IOErrorType(ResourceVanished)) import Network (PortID(UnixSocket), Socket, accept, listenOn, sClose) import System.Directory (removeFile) import System.Exit (ExitCode(ExitSuccess)) import System.IO (Handle, hClose, hFlush, hGetLine, hPutStrLn) import System.IO.Error (ioeGetErrorType, isAlreadyInUseError, isDoesNotExistError) import CommandLoop (newCommandLoopState, Config, updateConfig, startCommandLoop) import Types (ClientDirective(..), Command, CommandExtra(..), ServerDirective(..)) import Util (readMaybe) createListenSocket :: FilePath -> IO Socket createListenSocket socketPath = do r <- tryJust (guard . isAlreadyInUseError) $ listenOn (UnixSocket socketPath) case r of Right socket -> return socket Left _ -> do removeFile socketPath listenOn (UnixSocket socketPath) startServer :: FilePath -> Maybe Socket -> CommandExtra -> IO () startServer socketPath mbSock cmdExtra = do case mbSock of Nothing -> bracket (createListenSocket socketPath) cleanup go Just sock -> (go sock) `finally` (cleanup sock) where cleanup :: Socket -> IO () cleanup sock = do sClose sock removeSocketFile go :: Socket -> IO () go sock = do state <- newCommandLoopState currentClient <- newIORef Nothing configRef <- newIORef Nothing config <- updateConfig Nothing cmdExtra startCommandLoop state (clientSend currentClient) (getNextCommand currentClient sock configRef) config Nothing removeSocketFile :: IO () removeSocketFile = do -- Ignore possible error if socket file does not exist _ <- tryJust (guard . isDoesNotExistError) $ removeFile socketPath return () clientSend :: IORef (Maybe Handle) -> ClientDirective -> IO () clientSend currentClient clientDirective = do mbH <- readIORef currentClient case mbH of Just h -> ignoreEPipe $ do hPutStrLn h (show clientDirective) hFlush h Nothing -> return () where -- EPIPE means that the client is no longer there. ignoreEPipe = handleJust (guard . isEPipe) (const $ return ()) isEPipe = (==ResourceVanished) . ioeGetErrorType getNextCommand :: IORef (Maybe Handle) -> Socket -> IORef (Maybe Config) -> IO (Maybe (Command, Config)) getNextCommand currentClient sock config = do checkCurrent <- readIORef currentClient case checkCurrent of Just h -> hClose h Nothing -> return () (h, _, _) <- accept sock writeIORef currentClient (Just h) msg <- hGetLine h -- TODO catch exception let serverDirective = readMaybe msg case serverDirective of Nothing -> do clientSend currentClient $ ClientUnexpectedError $ "The client sent an invalid message to the server: " ++ show msg getNextCommand currentClient sock config Just (SrvCommand cmd cmdExtra) -> do curConfig <- readIORef config config' <- updateConfig curConfig cmdExtra writeIORef config (Just config') return $ Just (cmd, config') Just SrvStatus -> do mapM_ (clientSend currentClient) $ [ ClientStdout "Server is running." , ClientExit ExitSuccess ] getNextCommand currentClient sock config Just SrvExit -> do mapM_ (clientSend currentClient) $ [ ClientStdout "Shutting down server." , ClientExit ExitSuccess ] -- Must close the handle here because we are exiting the loop so it -- won't be closed in the code above hClose h return Nothing hdevtools-0.1.4.1/src/Stack.hs0000644000000000000000000001037112763017647014257 0ustar0000000000000000{-# LANGUAGE CPP #-} module Stack ( -- * The bits of information needed from `stack` StackConfig (..) , findStackYaml , getStackConfig ) where import Data.Char (isSpace) #if __GLASGOW_HASKELL__ < 709 import Control.Applicative((<$>), (<*>)) import System.IO #endif import System.Process import System.FilePath import System.Directory import Control.Monad (filterM) import Control.Exception import Types -- TODO: Move into Types? data StackConfig = StackConfig { stackYaml :: FilePath , stackDist :: FilePath , stackDbs :: [FilePath] , stackGhcBinDir :: FilePath , stackGhcLibDir :: FilePath } deriving (Eq, Show) -- | Search for a @stack.yaml@ upwards in given file path tree. findStackYaml :: FilePath -> IO (Maybe FilePath) findStackYaml = fmap (fmap trim) . execStackInPath "path --config-location" -- | Run @stack path@ to compute @StackConfig@ getStackConfig :: CommandExtra -> IO (Maybe StackConfig) getStackConfig CommandExtra { ceStackYamlPath = Nothing } = return Nothing getStackConfig CommandExtra { ceStackYamlPath = Just p } = do dbs <- getStackDbs root dist <- getStackDist root ghcBinDir <- getStackGhcBinDir root ghcLibDir <- getStackGhcLibDir root return $ StackConfig p <$> dist <*> dbs <*> ghcBinDir <*> ghcLibDir where root = takeDirectory p getStackGhcBinDir :: FilePath -> IO (Maybe FilePath) getStackGhcBinDir = fmap (fmap trim) . execStackInPath "path --compiler-bin" getStackGhcLibDir :: FilePath -> IO (Maybe FilePath) getStackGhcLibDir = fmap (fmap takeDirectory) . execStackInPath "path --global-pkg-db" getStackDist :: FilePath -> IO (Maybe FilePath) getStackDist p = (trim <$>) <$> execStackInPath "path --dist-dir" p getStackDbs :: FilePath -> IO (Maybe [FilePath]) getStackDbs p = execStackInPath "path --ghc-package-path" p >>= maybe (return Nothing) (\pp -> return <$> extractDbs pp) extractDbs :: String -> IO [FilePath] extractDbs = filterM doesDirectoryExist . stringPaths stringPaths :: String -> [String] stringPaths = splitBy ':' . trim -------------------------------------------------------------------------------- -- | Generic Helpers -------------------------------------------------------------------------------- splitBy :: Char -> String -> [String] splitBy c str | null str' = [x] | otherwise = x : splitBy c (tail str') where (x, str') = span (c /=) str trim :: String -> String trim = f . f where f = reverse . dropWhile isSpace -- Execute stack command in path (if stack is available) execStackInPath :: String -> FilePath -> IO (Maybe String) execStackInPath a p = findExecutable "stack" >>= maybe (return Nothing) (const $ execInPath ("stack " ++ a) p) #if __GLASGOW_HASKELL__ < 709 execInPath :: String -> FilePath -> IO (Maybe String) execInPath cmd p = do eIOEstr <- try $ createProcess prc :: IO (Either IOError ProcH) case eIOEstr of Right (_, Just h, _, _) -> Just <$> getClose h Right (_, Nothing, _, _) -> return Nothing -- This error is most likely "/bin/sh: stack: command not found" -- which is caused by the package containing a stack.yaml file but -- no stack command is in the PATH. Left _ -> return Nothing where prc = (shell cmd) { cwd = Just $ takeDirectory p } getClose :: Handle -> IO String getClose h = do str <- hGetContents h hClose h return str type ProcH = (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -- Not deleting this because this is likely more robust than the above! (but -- only works on process-1.2.3.0 onwards #else execInPath :: String -> FilePath -> IO (Maybe String) execInPath cmd p = do eIOEstr <- try $ readCreateProcess prc "" :: IO (Either IOError String) return $ case eIOEstr of Right s -> Just s -- This error is most likely "/bin/sh: stack: command not found" -- which is caused by the package containing a stack.yaml file but -- no stack command is in the PATH. Left _ -> Nothing where prc = (shell cmd) { cwd = Just p } #endif hdevtools-0.1.4.1/src/Types.hs0000644000000000000000000000236512753552762014323 0ustar0000000000000000module Types ( ServerDirective(..) , ClientDirective(..) , Command(..) , CommandExtra(..) , emptyCommandExtra ) where import System.Exit (ExitCode) data CommandExtra = CommandExtra { cePath :: Maybe FilePath , ceGhcOptions :: [String] , ceCabalFilePath :: Maybe FilePath , ceCabalOptions :: [String] , ceStackYamlPath :: Maybe FilePath } deriving (Read, Show) emptyCommandExtra :: CommandExtra emptyCommandExtra = CommandExtra { cePath = Nothing , ceGhcOptions = [] , ceCabalFilePath = Nothing , ceCabalOptions = [] , ceStackYamlPath = Nothing } data ServerDirective = SrvCommand Command CommandExtra | SrvStatus | SrvExit deriving (Read, Show) data ClientDirective = ClientStdout String | ClientStderr String | ClientExit ExitCode | ClientUnexpectedError String -- ^ For unexpected errors that should not happen deriving (Read, Show) data Command = CmdCheck FilePath | CmdModuleFile String | CmdInfo FilePath String | CmdType FilePath (Int, Int) | CmdFindSymbol String [String] deriving (Read, Show) hdevtools-0.1.4.1/src/Util.hs0000644000000000000000000000055412635015142014113 0ustar0000000000000000module Util ( readMaybe ) where -- Taken from: -- http://stackoverflow.com/questions/8066850/why-doesnt-haskells-prelude-read-return-a-maybe/8080084#8080084 readMaybe :: (Read a) => String -> Maybe a readMaybe s = case [x | (x,t) <- reads s, ("","") <- lex t] of [x] -> Just x _ -> Nothing hdevtools-0.1.4.1/LICENSE0000644000000000000000000000207412673221036013062 0ustar0000000000000000Copyright (C) 2016 The hdevtools Authors (see AUTHORS file) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. hdevtools-0.1.4.1/Setup.hs0000644000000000000000000000005612635015142013504 0ustar0000000000000000import Distribution.Simple main = defaultMain hdevtools-0.1.4.1/hdevtools.cabal0000644000000000000000000000657212763017754015071 0ustar0000000000000000name: hdevtools version: 0.1.4.1 synopsis: Persistent GHC powered background server for FAST haskell development tools license: MIT license-file: LICENSE author: Bit Connor maintainer: Sebastian Nagel , Ranjit Jhala copyright: See AUTHORS file category: Development homepage: https://github.com/hdevtools/hdevtools/ bug-reports: https://github.com/hdevtools/hdevtools/issues/ build-type: Simple cabal-version: >=1.8 description: 'hdevtools' is a backend for text editor plugins, to allow for things such as syntax and type checking of Haskell code, and retrieving type information, all directly from within your text editor. . The advantage that 'hdevtools' has over competitors, is that it runs silently in a persistent background process, and therefore is able to keeps all of your Haskell modules and dependent libraries loaded in memory. This way, when you change only a single source file, only it needs to be reloaded and rechecked, instead of having to reload everything. . This makes 'hdevtools' very fast for checking syntax and type errors (runs just as fast as the ':reload' command in GHCi). . In fact, syntax and type checking is so fast, that you can safely enable auto checking on every save. Even for huge projects, checking is nearly instant. . Once you start using 'hdevtools' and you get used to having your errors shown to you instantly (without having to switch back and forth between GHCi and your editor), and shown directly on your code, in your editor (without having to wait forever for GHC to run) you will wonder how you ever lived without it. . In addition to checking Haskell source code for errors, 'hdevtools' has tools for getting info about identifiers, and getting type information for snippets of code. extra-source-files: CHANGELOG.md README.md source-repository head type: git location: git://github.com/hdevtools/hdevtools.git executable hdevtools hs-source-dirs: src ghc-options: -Wall main-is: Main.hs other-modules: Cabal, Client, CommandArgs, CommandLoop, Daemonize, FindSymbol, Info, Main, Server, Stack, Types, Util, Paths_hdevtools build-depends: base == 4.*, cmdargs, directory, filepath, ghc >= 7.2, ghc-paths, syb, network, process, time, transformers, unix if impl(ghc == 7.6.*) build-depends: Cabal >= 1.16 if impl(ghc >= 7.7) build-depends: Cabal >= 1.18 if impl(ghc >= 7.9 && < 8.0) build-depends: Cabal >= 1.22, bin-package-db if impl(ghc >= 8.0) build-depends: Cabal >= 1.24, ghc-boot >= 8.0 hdevtools-0.1.4.1/CHANGELOG.md0000644000000000000000000000126012763017775013677 0ustar0000000000000000# Changelog ## 0.1.4.1 - 2016-09-04 * Do not try to execute `stack` commands if not available. ## 0.1.4.0 - 2016-08-08 * Determine GHC libdir and binaries using stack. ## 0.1.3.2 - 2016-06-09 * Added GHC 8.0.x support ## 0.1.3.1 - 2016-05-13 * Added support for new Cabal versions * Do not generate code, fixing inline-c modules typechecking ## 0.1.3.0 - 2016-02-29 * Improved performance in stack projects: The stack configuration is updated only when the passed path implies a different `stack.yaml`. Performance improved substantially from roughly ~1s to ~0.3s. ## 0.1.2.2 - 2016-01-11 * Added type checking support for tests and benchmarks in stack projects. hdevtools-0.1.4.1/README.md0000644000000000000000000001746212753550537013355 0ustar0000000000000000hdevtools ========= Persistent GHC powered background server for FAST Haskell development tools About ----- `hdevtools` is a backend for text editor plugins, to allow for things such as syntax and type checking of Haskell code, and retrieving type information, all directly from within your text editor. The advantage that `hdevtools` has over competitors, is that it runs silently in a persistent background process, and therefore is able to keeps all of your Haskell modules and dependent libraries loaded in memory. This way, when you change only a single source file, only it needs to be reloaded and rechecked, instead of having to reload everything. This makes `hdevtools` very fast for checking syntax and type errors (runs just as fast as the `:reload` command in GHCi). In fact, syntax and type checking is so fast, that you can safely enable auto checking on every save. Even for huge projects, checking is nearly instant. Once you start using `hdevtools` and you get used to having your errors shown to you instantly (without having to switch back and forth between GHCi and your editor), and shown directly on your code, in your editor (without having to wait forever for GHC to run) you will wonder how you ever lived without it. In addition to checking Haskell source code for errors, `hdevtools` has tools for getting info about identifiers, and getting type information for snippets of code. Text Editor Integration ----------------------- `hdevtools` is designed to be integrated into text editors. The list of current editor plugins that supply this integration is below. But before you do anything, you must first install `hdevtools` itself. The easiest way is from [Stackage][14] using [stack][15]: ``` $ stack install hdevtools ``` **Note:** `hdevtools` automatically discovers compiler and libraries installed via stack. Alternatively one can install from [Hackage][1] via cabal install: ``` $ cabal install hdevtools ``` Then you should install one or more of the following editor plugins: ### Vim - [Syntastic][2] ### [Syntastic][2] is a popular syntax checking plugin for Vim, and is the recommended Vim integration of `hdevtools` syntax and type checking. Recent versions of Syntastic(since Sep. 2012) have builtin support for `hdevtools`. Simply install `hdevtools` (as above) and [Syntastic][2], and it will automatically check your Haskell files. [Syntastic][2] will respect the `g:hdevtools_options` variable (the same one as used by [vim-hdevtools][3], see below). See the section "Specifying GHC Options" below for details how to use it. ### Vim - [vim-hdevtools][3] ### In addition to Syntastic, it is recommended that you also use [`vim-hdevtools`][3] for additional functionality. [`vim-hdevtools`][3] offers integration with the rest of the `hdevtools` tools, including retrieving info about the identifier under the cursor, and getting the type of the code under the cursor. Refer to its documentation for more details. ### Emacs - [flycheck][5] ### [Flycheck][5] is a modern batteries-included syntax checker for Emacs, and there is a [flycheck-hdevtools][6] checker available. ### Atom - [linter][8] ### There are *two* packages for the [Atom](https://atom.io) editor: + [linter-hdevtools][8] quickly finds and underlines type errors in Haskell files, + [hover-tooltips-hdevtools][9] displays the types of identifiers under the mouse. ### Sublime - [SublimeLinter][10] [SublimeLinter][10] is a plugin for Sublime Text 3 that provides a framework for linting code. The [SublimeLinter-contrib-hdevtools][11] plugin uses `hdevtools` to typecheck Haskell code. ### Manual Editor Integration for any Editor ### Most editors allow you to run a `make` command, and will then parse the output for errors and show line numbers, allowing you to jump between errors. The `hdevtools check` command is suitable for such usage. For example, in Vim something like this will work: :let &makeprg='hdevtools check %' (Vim will replace the `%` character with the name of the current file). Then you can run :make And Vim will invoke `hdevtools` to check the current file for errors, and then show a list of them and allow jumping to them. See the "Command Line Usage" section below for more information. Command Line Usage ------------------ Note: When using one of the above editor plugins, you don't really need to know this. ### Available Commands and Help ### For the list of commands available, run: $ hdevtools --help To get help for a specific command, run: $ hdevtools [COMMAND] --help For example: $ hdevtools check --help ### The `hdevtools` background process ### The first time `hdevtools` runs a command, it will spawn a background process that will remain running forever. You can check the status of this background process by running: $ hdevtools --status You can shutdown the background process by running: $ hdevtools --stop-server Communication with the background process is done through a unix socket file. The default name is `.hdevtools.sock`, in the current directory. This allows you to use `hdevtools` with multiple projects simultaneously, without the background processes getting in the way of each other. You can use a different socket file name with the `--socket` option, which should be used for each invocation of `hdevtools`. Remember that when telling `hdevtools` to check a Haskell file, paths are relative to the path of the background process, not your current directory. This can cause problems, and therefore it is recommended that you leave the socket file as the default, and always run `hdevtools` from the same directory. You can specify the path to a target file with the `--path` option. This is useful for integration with IDEs that submit a *copy* of the original source file (in a temporary directory) to `hdevtools` making it impossible to extract the `.cabal` information for the file's project. In such cases, you can run as: $ hdevtools check -p /path/to/file.hs /tmp/file.hs and `hdevtools` will use the given path to obtain the `.cabal` information. ### Specifying GHC Options ### For most non-trivial projects, you will need to tell `hdevtools` about additional GHC options that your project requires. All `hdevtools` commands accept a `-g` flag for this purpose. For example: * Your project source code is in the directory `src` * You want to use the GHC option `-Wall` * You want to hide the package `transformers` to prevent conflicts Invoke `hdevtools` with something like this: $ hdevtools check -g -isrc -g -Wall -g -hide-package -g transformers Foo.hs Notice that a `-g` flag is inserted before each GHC option. Don't try to string multiple GHC options together after a single `-g` flag: This won't work: $ hdevtools check -g '-hide-package transformers' Foo.hs The Vim plugins allow setting GHC options in the `g:hdevtools_options` variable. For example, for the above project, put the following in your `.vimrc`: let g:hdevtools_options = '-g -isrc -g -Wall -g -hide-package -g transformers' In general, you will need to pass to `hdevtools` the same GHC options that you would pass to GHCi. Credits ------- * `hdevtools` was inspired by [ghcmod][4]. * development moved here from [bitc/hdevtools][12] and [schell/hdevtools][13]. [1]: http://hackage.haskell.org/package/hdevtools [2]: https://github.com/scrooloose/syntastic [3]: https://github.com/bitc/vim-hdevtools [4]: http://www.mew.org/~kazu/proj/ghc-mod/en/ [5]: https://github.com/flycheck/flycheck [6]: https://github.com/flycheck/flycheck-hdevtools [7]: https://atom.io [8]: https://atom.io/packages/linter-hdevtools [9]: https://atom.io/packages/hover-tooltips-hdevtools [10]: sublimelinter.com [11]: https://packagecontrol.io/packages/SublimeLinter-contrib-hdevtools [12]: https://github.com/bitc/hdevtools [13]: https://github.com/schell/hdevtools [14]: https://www.stackage.org/package/hdevtools [15]: haskellstack.org