hdevtools-0.1.6.1/src/0000755000000000000000000000000013215556242012646 5ustar0000000000000000hdevtools-0.1.6.1/src/Main.hs0000644000000000000000000000763413215556242014100 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" 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 <- if noStack args then return Nothing else 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 } extra' = extra { ceTemplateHaskell = not (noTH args) } 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.6.1/src/Cabal.hs0000644000000000000000000002540113176422300014177 0ustar0000000000000000{-# LANGUAGE CPP #-} module Cabal ( getPackageGhcOpts , findCabalFile, findFile ) 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 #if __GLASGOW_HASKELL__ < 802 import Distribution.Package (PackageIdentifier(..), PackageName) #endif 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(..), Component(..), componentName, getComponentLocalBuildInfo, componentBuildInfo) 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 import System.IO.Error (ioeGetErrorString) import System.Directory (doesFileExist, doesDirectoryExist, getDirectoryContents) import System.FilePath (takeDirectory, splitFileName, ()) -- 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)] ++ [ f (CBench bm) | bm <- benchmarks pkg_descr , buildable (benchmarkBuildInfo bm)] 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 -- TODO(SN): readPackageDescription is deprecated genPkgDescr <- readPackageDescription silent path distDir <- getDistDir -- TODO(SN): defaultProgramConfiguration is deprecated 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 baseDir = fst . splitFileName $ path case getGhcVersion localBuildInfo of Nothing -> return $ Left "GHC is not configured" Just ghcVersion -> do #if __GLASGOW_HASKELL__ < 802 let pkgDescr = localPkgDescr localBuildInfo let mbLibName = pkgLibName pkgDescr #endif 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 #if __GLASGOW_HASKELL__ < 802 , ghcOptPackages = overNubListR (filter (\(_, pkgId, _) -> Just (pkgName pkgId) /= mbLibName)) $ (ghcOptPackages ghcOpts') #endif , 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 -- TODO(SN): defaultProgramConfiguration is deprecated (ghcInfo, mbPlatform, _) <- GHC.configure silent Nothing Nothing defaultProgramConfiguration putStrLn $ "Configured GHC " ++ show ghcVersion ++ " " ++ show mbPlatform #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 #if __GLASGOW_HASKELL__ < 802 pkgLibName :: PackageDescription -> Maybe PackageName pkgLibName pkgDescr = if hasLibrary pkgDescr then Just $ pkgName . package $ pkgDescr else Nothing #endif 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 -- TODO(SN): getComponentLocalBuildInfo is deprecated as of Cabal-2.0.0.2 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) -- | looks for file matching a predicate starting from dir and going up until root findFile :: (FilePath -> Bool) -> FilePath -> IO (Maybe FilePath) findFile p dir = do allFiles <- getDirectoryContents dir case find p allFiles of Just cabalFile -> return $ Just $ dir cabalFile Nothing -> let parentDir = takeDirectory dir in if parentDir == dir then return Nothing else findFile p parentDir findCabalFile :: FilePath -> IO (Maybe FilePath) findCabalFile = findFile isCabalFile where isCabalFile :: FilePath -> Bool isCabalFile path = ".cabal" `isSuffixOf` path && length path > length ".cabal" hdevtools-0.1.6.1/src/Client.hs0000644000000000000000000000425212753550537014432 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.6.1/src/CommandArgs.hs0000644000000000000000000002222013215556242015373 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE CPP #-} module CommandArgs ( HDevTools(..) , loadHDevTools , pathArg ) where import Cabal (findFile) import Data.Version (showVersion) import Paths_hdevtools (version) import qualified Config import System.Console.CmdArgs.Implicit import System.Console.CmdArgs.Explicit (splitArgs) import System.Directory (getCurrentDirectory) import System.Environment (getProgName, withArgs, getArgs) import System.FilePath (takeDirectory) import System.Info (arch, os) 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 , noStack :: Bool } | Check { socket :: Maybe FilePath , ghcOpts :: [String] , cabalOpts :: [String] , path :: Maybe String , file :: String , json :: Bool , debug :: Bool , noStack :: Bool , noTH :: Bool } | ModuleFile { socket :: Maybe FilePath , ghcOpts :: [String] , cabalOpts :: [String] , module_ :: String , debug :: Bool , noStack :: Bool } | Info { socket :: Maybe FilePath , ghcOpts :: [String] , cabalOpts :: [String] , path :: Maybe String , file :: String , identifier :: String , debug :: Bool , noStack :: Bool , noTH :: Bool } | Type { socket :: Maybe FilePath , ghcOpts :: [String] , cabalOpts :: [String] , path :: Maybe String , file :: String , line :: Int , col :: Int , debug :: Bool , noStack :: Bool , noTH :: Bool } | FindSymbol { socket :: Maybe FilePath , ghcOpts :: [String] , cabalOpts :: [String] , symbol :: String , files :: [String] , debug :: Bool , noStack :: Bool , noTH :: 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 , noStack = False } dummyCheck :: HDevTools dummyCheck = Check { socket = Nothing , ghcOpts = [] , cabalOpts = [] , path = Nothing , file = "" , json = False , debug = False , noTH = False , noStack = False } dummyModuleFile :: HDevTools dummyModuleFile = ModuleFile { socket = Nothing , ghcOpts = [] , cabalOpts = [] , module_ = "" , debug = False , noStack = False } dummyInfo :: HDevTools dummyInfo = Info { socket = Nothing , ghcOpts = [] , cabalOpts = [] , path = Nothing , file = "" , identifier = "" , debug = False , noStack = False , noTH = False } dummyType :: HDevTools dummyType = Type { socket = Nothing , ghcOpts = [] , cabalOpts = [] , path = Nothing , file = "" , line = 0 , col = 0 , debug = False , noStack = False , noTH = False } dummyFindSymbol :: HDevTools dummyFindSymbol = FindSymbol { socket = Nothing , ghcOpts = [] , cabalOpts = [] , symbol = "" , files = [] , debug = False , noStack = False , noTH = 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" , noStack := def += name "S" += help "disable stack integration" ] += 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" , noStack := def += name "S" += help "disable stack integration" , noTH := def += help "disable template haskell" ] += 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" , noStack := def += name "S" += help "disable stack integration" ] += 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" , noStack := def += name "S" += help "disable stack integration" , noTH := def += help "disable template haskell" ] += 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" , noStack := def += name "S" += help "disable stack integration" , 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 , noTH := def += help "disable template haskell" ] += 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" , noStack := def += name "S" += help "disable stack integration" , noTH := def += help "disable template haskell" ] += 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 [name "v", groupname "Help"] += program progName += summary (progName ++ ": " ++ fullVersion) fileArg :: HDevTools -> Maybe String fileArg (Admin {}) = Nothing fileArg (ModuleFile {}) = Nothing fileArg a@(Check {}) = Just $ file a fileArg a@(Info {}) = Just $ file a fileArg a@(Type {}) = Just $ file a fileArg (FindSymbol {}) = Nothing pathArg' :: HDevTools -> Maybe String pathArg' (Admin {}) = Nothing pathArg' (ModuleFile {}) = Nothing pathArg' a@(Check {}) = path a pathArg' a@(Info {}) = path a pathArg' a@(Type {}) = path a pathArg' (FindSymbol {}) = Nothing pathArg :: HDevTools -> Maybe String pathArg a = case pathArg' a of Just x -> Just x Nothing -> fileArg a loadHDevTools :: IO HDevTools loadHDevTools = do progName <- getProgName cfg0 <- cmdArgs_ (full progName) dir <- maybe getCurrentDirectory (return . takeDirectory) $ pathArg cfg0 mConfig <- findFile (== ".hdevtoolsrc") dir perProject <- maybe (return []) (\f -> splitArgs `fmap` readFile f) mConfig args0 <- getArgs withArgs (args0 ++ perProject) $ cmdArgs_ (full progName) hdevtools-0.1.6.1/src/CommandLoop.hs0000644000000000000000000003414513215556242015421 0ustar0000000000000000{-# LANGUAGE CPP, ViewPatterns #-} module CommandLoop ( newCommandLoopState , Config(..) , CabalConfig(..) , updateConfig , startCommandLoop ) where import Control.Exception import Control.Applicative ((<|>)) import Control.Monad (when, void) 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 GhcPlugins as GHC import qualified ErrUtils as 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 , configTH :: Bool } 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 , configTH = ceTemplateHaskell cmdExtra } 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 initialConfig 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 do sendErrors (runCommand state clientSend initialConfig cmd) processNextCommand False sendErrors :: GHC.Ghc () -> GHC.Ghc () sendErrors action = do action `GHC.gcatch` ghcError `GHC.gcatch` sourceError `GHC.gcatch` unknownError where ghcError :: GHC.GhcException -> GHC.Ghc () ghcError = die . flip GHC.showGhcException "" unknownError :: SomeException -> GHC.Ghc () unknownError = die . show sourceError :: GHC.SourceError -> GHC.Ghc () sourceError = report die msg = liftIO $ mapM_ clientSend [ ClientStderr msg , ClientExit (ExitFailure 1) ] report (GHC.srcErrorMessages -> bag) = do flags <- GHC.getSessionDynFlags let msgs = map (Outputable.showSDoc flags) $ GHC.pprErrMsgBagWithLoc bag liftIO $ do mapM_ (logActionSend state clientSend GHC.SevError) msgs clientSend $ ClientExit ExitSuccess 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 "" loadTarget :: [FilePath] -> Config -> GHC.Ghc (Maybe GHC.SuccessFlag) loadTarget files conf = do let noPhase = Nothing targets <- mapM (flip GHC.guessTarget noPhase) files GHC.setTargets targets graph <- GHC.depanal [] True if configTH conf || (not $ GHC.needsTemplateHaskell graph) then do when (GHC.needsTemplateHaskell graph) $ do flags <- GHC.getSessionDynFlags void . GHC.setSessionDynFlags $ flags { GHC.hscTarget = GHC.HscInterpreted, GHC.ghcLink = GHC.LinkInMemory } Just <$> GHC.load GHC.LoadAllTargets else return Nothing withTargets :: ClientSend -> [FilePath] -> Config -> GHC.Ghc () -> GHC.Ghc () withTargets clientSend files conf act = do ret <- loadTarget files conf case ret of Nothing -> liftIO $ mapM_ clientSend [ClientStderr "Template haskell required but not activated", ClientExit (ExitFailure 1)] Just GHC.Failed -> liftIO $ mapM_ clientSend [ClientStderr "Failed to load targets", ClientExit (ExitFailure 1)] Just GHC.Succeeded -> act runCommand :: IORef State -> ClientSend -> Config -> Command -> GHC.Ghc () runCommand _ clientSend conf (CmdCheck file) = withTargets clientSend [file] conf (liftIO . clientSend . ClientExit $ ExitSuccess) runCommand _ clientSend _ (CmdModuleFile moduleName) = do target <- GHC.guessTarget moduleName Nothing GHC.setTargets [target] res <- GHC.load GHC.LoadAllTargets case res of GHC.Failed -> liftIO $ mapM_ clientSend [ ClientStderr "Error loading targets" , ClientExit (ExitFailure 1) ] GHC.Succeeded -> 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 conf (CmdInfo file identifier) = withTargets clientSend [file] conf $ 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 conf (CmdType file (line, col)) = withTargets clientSend [file] conf $ 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 conf (CmdFindSymbol 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 ret <- withTargets clientSend files conf $ do result <- withWarnings state False $ findSymbol symbol case result of [] -> liftIO $ mapM_ clientSend [ ClientStderr $ "Couldn't find modules containing '" ++ symbol ++ "'" , ClientExit (ExitFailure 1) ] modules -> liftIO $ mapM_ clientSend [ ClientStdout (intercalate "\n" modules) , ClientExit ExitSuccess ] -- reset the old log_action _ <- GHC.setSessionDynFlags dynFlags return ret #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.6.1/src/Daemonize.hs0000644000000000000000000000161012635015142015105 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.6.1/src/FindSymbol.hs0000644000000000000000000000571313176422300015247 0ustar0000000000000000{-# Language ScopedTypeVariables, CPP #-} module FindSymbol ( findSymbol ) where #if __GLASGOW_HASKELL__ >= 802 import GhcMonad (liftIO) #elif __GLASGOW_HASKELL__ >= 710 import GHC.PackageDb (exposedName) import GhcMonad (liftIO) #else import Control.Applicative ((<$>)) import qualified UniqFM #endif import Control.Exception import Control.Monad (filterM) import Data.List (find, nub) import Data.Maybe (catMaybes, isJust) import Exception (ghandle) import qualified GHC import qualified Packages as PKG import qualified Name type SymbolName = String type ModuleName = String findSymbol :: SymbolName -> GHC.Ghc [ModuleName] findSymbol symbol = do fileMods <- findSymbolInFile symbol pkgsMods <- findSymbolInPackages symbol return . nub . map (GHC.moduleNameString . GHC.moduleName) $ fileMods ++ pkgsMods findSymbolInFile :: SymbolName -> GHC.Ghc [GHC.Module] findSymbolInFile symbol = filterM (containsSymbol symbol) =<< 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__ >= 802 exposedModuleNames = do dynFlags <- GHC.getSessionDynFlags pkgConfigs <- liftIO $ fmap concat . (fmap . fmap) snd . PKG.readPackageConfigs $ dynFlags return $ map fst (concatMap exposedModules pkgConfigs) #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) #elif __GLASGOW_HASKELL__ >= 710 exposedModuleNames = do dynFlags <- GHC.getSessionDynFlags pkgConfigs <- liftIO $ PKG.readPackageConfigs dynFlags return $ map exposedName (concatMap exposedModules pkgConfigs) #else exposedModuleNames = concatMap exposedModules . UniqFM.eltsUFM . PKG.pkgIdMap . GHC.pkgState <$> GHC.getSessionDynFlags #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.6.1/src/Info.hs0000644000000000000000000002444513176422300014077 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 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 #if __GLASGOW_HASKELL__ >= 802 (Outputable.mkUserStyle dflags Outputable.neverQualify Outputable.AllTheWay) #else (Outputable.mkUserStyle Outputable.neverQualify Outputable.AllTheWay) #endif #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.6.1/src/Server.hs0000644000000000000000000000752112753550537014464 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.6.1/src/Stack.hs0000644000000000000000000001057213027152672014254 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 p = do ghc <- (trim <$>) <$> execStackInPath "path --compiler-exe" p case ghc of Just exe -> (trim <$>) <$> execInPath (exe ++ " --print-libdir") p Nothing -> return Nothing 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.6.1/src/Types.hs0000644000000000000000000000251712770047436014320 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 , ceTemplateHaskell :: Bool } deriving (Read, Show) emptyCommandExtra :: CommandExtra emptyCommandExtra = CommandExtra { cePath = Nothing , ceGhcOptions = [] , ceCabalFilePath = Nothing , ceCabalOptions = [] , ceStackYamlPath = Nothing , ceTemplateHaskell = True } 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.6.1/src/Util.hs0000644000000000000000000000055412635015142014115 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.6.1/LICENSE0000644000000000000000000000207412673221036013064 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.6.1/Setup.hs0000644000000000000000000000005612635015142013506 0ustar0000000000000000import Distribution.Simple main = defaultMain hdevtools-0.1.6.1/hdevtools.cabal0000644000000000000000000000663213215556242015061 0ustar0000000000000000name: hdevtools version: 0.1.6.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, 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 if impl(ghc >= 8.2) build-depends: ghc-boot >= 8.2 hdevtools-0.1.6.1/CHANGELOG.md0000644000000000000000000000262613215556301013672 0ustar0000000000000000# Changelog ## 0.1.6.1 - 2017-12-17 * Fixed `moduleinfo` command to load targets correctly. * Print version on `-v` command line option. * Fixed build with ghc-8.2.0. ## 0.1.6.0 - 2017-08-21 * Added handling of source errors: GHC `SourceError` and other exceptions are now correctly sent to the frontend process. This enables `hdevtools` to correctly report haskell syntax errors and improves visibility of exceptions leading the backend process to die. * `.hdevtoolsrc` file for project-specific configuration. * Use of `stack` can be turned off with `--nostack`. ## 0.1.5.0 - 2016-12-23 * (Re-)added template haskell support when required. Can be turned off using `--noth`. * Fixed system installed GHC libdir paths using stack. ## 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.6.1/README.md0000644000000000000000000002076613146642365013356 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 In general, you will need to pass to `hdevtools` the same GHC options that you would pass to GHCi. For projects with custom build systems, you can prevent `hdevtools` from detecting a global `stack.yaml` configuration with the argument `--nostack`. #### Specifying GHC Options in Vim #### 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' #### Specifying GHC Options with `.hdevtoolsrc` #### If an `.hdevtoolsrc` file is present, then `hdevtools` will parse arguments from the `.hdevtoolsrc` file after arguments from the command line. For example, for the above project, the `.hdevtoolsrc` file would contain: -g -isrc -g -Wall -g -hide-package -g transformers The `.hdevtoolsrc` file will be searched for in the target path and all parents of the target path, or, if the `hdevtools` command has no target, in `$PWD` and all parents of `$PWD`. 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