hdevtools 0.1.1.9 → 0.1.2.0
raw patch · 6 files changed
+60/−5 lines, 6 filesdep +bin-package-db
Dependencies added: bin-package-db
Files
- hdevtools.cabal +4/−2
- src/Cabal.hs +7/−1
- src/CommandArgs.hs +23/−1
- src/CommandLoop.hs +18/−1
- src/Main.hs +7/−0
- src/Types.hs +1/−0
hdevtools.cabal view
@@ -1,5 +1,5 @@ name: hdevtools-version: 0.1.1.9+version: 0.1.2.0 synopsis: Persistent GHC powered background server for FAST haskell development tools description: 'hdevtools' is a backend for text editor plugins, to allow for things such as@@ -81,5 +81,7 @@ cpp-options: -DENABLE_CABAL if impl(ghc >= 7.9)- build-depends: Cabal >= 1.22+ build-depends: Cabal >= 1.22,+ bin-package-db+ cpp-options: -DENABLE_CABAL
src/Cabal.hs view
@@ -10,6 +10,7 @@ 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)@@ -138,10 +139,11 @@ let baseDir = fst . splitFileName $ path case getGhcVersion localBuildInfo of Nothing -> return $ Left "GHC is not configured"++#if __GLASGOW_HASKELL__ >= 709 Just _ -> do let mbLibName = pkgLibName pkgDescr let ghcOpts' = foldl' mappend mempty $ map (getComponentGhcOptions localBuildInfo) $ flip allComponentsBy (\c -> c) . localPkgDescr $ localBuildInfo-#if __GLASGOW_HASKELL__ >= 709 -- FIX bug in GhcOptions' `mappend` ghcOpts = ghcOpts' { ghcOptExtra = overNubListR (filter (/= "-Werror")) $ ghcOptExtra ghcOpts' , ghcOptPackageDBs = sort $ nub (ghcOptPackageDBs ghcOpts')@@ -153,6 +155,10 @@ return $ Right $ renderGhcOptions ghcInfo ghcOpts #else+ Just ghcVersion -> do+ let mbLibName = pkgLibName pkgDescr+ let ghcOpts' = foldl' mappend mempty $ map (getComponentGhcOptions localBuildInfo) $ flip allComponentsBy (\c -> c) . localPkgDescr $ localBuildInfo+ ghcOpts = ghcOpts' { ghcOptExtra = filter (/= "-Werror") $ nub $ ghcOptExtra ghcOpts' , ghcOptPackages = filter (\(_, pkgId) -> Just (pkgName pkgId) /= mbLibName) $ nub (ghcOptPackages ghcOpts') , ghcOptSourcePath = map (baseDir </>) (ghcOptSourcePath ghcOpts')
src/CommandArgs.hs view
@@ -76,6 +76,12 @@ , line :: Int , col :: Int }+ | FindSymbol+ { socket :: Maybe FilePath+ , ghcOpts :: [String]+ , symbol :: String+ , files :: [String]+ } deriving (Show, Data, Typeable) dummyAdmin :: HDevTools@@ -121,6 +127,14 @@ , col = 0 } +dummyFindSymbol :: HDevTools+dummyFindSymbol = FindSymbol+ { socket = Nothing+ , ghcOpts = []+ , symbol = ""+ , files = []+ }+ admin :: Annotate Ann admin = record dummyAdmin [ socket := def += typFile += help "socket file to use"@@ -164,8 +178,16 @@ , 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"+ , symbol := def += typ "SYMBOL" += argPos 0+ , files := def += typFile += args+ ] += help "List the modules where the given symbol could be found"+ full :: String -> Annotate Ann-full progName = modes_ [admin += auto, check, moduleFile, info, type_]+full progName = modes_ [admin += auto, check, moduleFile, info, type_, findSymbol] += helpArg [name "h", groupname "Help"] += versionArg [groupname "Help"] += program progName
src/CommandLoop.hs view
@@ -9,8 +9,9 @@ import Control.Monad (when) import Data.IORef-import Data.List (find)+import Data.List (find, intercalate) #if __GLASGOW_HASKELL__ < 709+import Control.Applicative ((<$>)) import Data.Traversable (traverse) #endif import MonadUtils (MonadIO, liftIO)@@ -27,6 +28,7 @@ import Types (ClientDirective(..), Command(..), CommandExtra(..)) import Info (getIdentifierInfo, getType)+import FindSymbol (findSymbol) import Cabal (getPackageGhcOpts) import Stack @@ -229,6 +231,21 @@ , 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__ >= 706 logAction :: IORef State -> ClientSend -> GHC.DynFlags -> GHC.Severity -> GHC.SrcSpan -> Outputable.PprStyle -> ErrUtils.MsgDoc -> IO ()
src/Main.hs view
@@ -35,6 +35,7 @@ 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@@ -42,6 +43,7 @@ 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@@ -67,6 +69,7 @@ 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 _extra@@ -108,3 +111,7 @@ 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
src/Types.hs view
@@ -38,4 +38,5 @@ | CmdModuleFile String | CmdInfo FilePath String | CmdType FilePath (Int, Int)+ | CmdFindSymbol String [String] deriving (Read, Show)