hdevtools 0.1.2.1 → 0.1.2.2
raw patch · 9 files changed
+145/−37 lines, 9 filesdep +transformersdep ~processnew-uploader
Dependencies added: transformers
Dependency ranges changed: process
Files
- CHANGELOG.md +5/−0
- LICENSE +1/−1
- hdevtools.cabal +9/−6
- src/Cabal.hs +47/−21
- src/CommandArgs.hs +42/−4
- src/CommandLoop.hs +6/−4
- src/Main.hs +1/−0
- src/Stack.hs +32/−1
- src/Types.hs +2/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Changelog++## 0.1.2.2 - 2016-01-11++ * Added type checking support for tests and benchmarks in stack projects.
LICENSE view
@@ -1,4 +1,4 @@-Copyright (C) 2012 The hdevtools Authors (see AUTHORS file)+Copyright (C) 2015 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
hdevtools.cabal view
@@ -1,5 +1,5 @@ name: hdevtools-version: 0.1.2.1+version: 0.1.2.2 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@@ -30,17 +30,19 @@ license: MIT license-file: LICENSE author: Bit Connor-maintainer: schell.scivally@synapsegroup.com+maintainer: Sebastian Nagel <sebastian.nagel@ncoding.at>, + Ranjit Jhala <jhala@cs.ucsd.edu> copyright: See AUTHORS file category: Development-homepage: https://github.com/schell/hdevtools/-bug-reports: https://github.com/schell/hdevtools/issues/+homepage: https://github.com/hdevtools/hdevtools/+bug-reports: https://github.com/hdevtools/hdevtools/issues/ build-type: Simple cabal-version: >=1.8+extra-source-files: CHANGELOG.md source-repository head type: git- location: git://github.com/schell/hdevtools.git+ location: git://github.com/hdevtools/hdevtools.git executable hdevtools hs-source-dirs: src@@ -69,8 +71,9 @@ ghc-paths, syb, network,- process >= 1.2.3.0,+ process, time,+ transformers, unix if impl(ghc == 7.6.*)
src/Cabal.hs view
@@ -7,6 +7,9 @@ #ifdef ENABLE_CABAL 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@@ -24,12 +27,13 @@ #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, toFlag)+import Distribution.Simple.Setup (ConfigFlags(..), defaultConfigFlags, configureCommand, toFlag) #if __GLASGOW_HASKELL__ >= 709 import Distribution.Utils.NubList import qualified Distribution.Simple.GHC as GHC(configure)@@ -38,7 +42,7 @@ import Distribution.Version (Version(..)) import System.IO.Error (ioeGetErrorString)-import System.Directory (doesFileExist, getDirectoryContents)+import System.Directory (doesFileExist, doesDirectoryExist, getDirectoryContents) import System.FilePath (takeDirectory, splitFileName, (</>)) @@ -110,30 +114,44 @@ -- 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 -> IO (Either String [String])-getPackageGhcOpts path mbStack = do+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- let cfgFlags'' = (defaultConfigFlags defaultProgramConfiguration)- { configDistPref = toFlag $ takeDirectory path </> "dist"- -- TODO: figure out how to find out this flag- , configUserInstall = toFlag True- }- let cfgFlags' = stackifyFlags cfgFlags'' mbStack- let sandboxConfig = takeDirectory path </> "cabal.sandbox.config"- exists <- doesFileExist sandboxConfig+ distDir <- getDistDir - cfgFlags <- case exists of- False -> return cfgFlags'- True -> do- sandboxPackageDb <- getSandboxPackageDB sandboxConfig- return $ cfgFlags'- { configPackageDBs = [Just sandboxPackageDb]- }+ 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@@ -166,6 +184,14 @@ return $ Right $ renderGhcOptions ghcVersion ghcOpts #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@@ -217,8 +243,8 @@ # else -getPackageGhcOpts :: FilePath -> IO (Either String [String])-getPackageGhcOpts _ = return $ Right []+getPackageGhcOpts :: FilePath -> [String] -> IO (Either String [String])+getPackageGhcOpts _ _ = return $ Right [] findCabalFile :: FilePath -> IO (Maybe FilePath) findCabalFile _ = return Nothing
src/CommandArgs.hs view
@@ -53,17 +53,21 @@ | Check { socket :: Maybe FilePath , ghcOpts :: [String]+ , cabalOpts :: [String] , path :: Maybe String , file :: String+ , json :: Bool } | ModuleFile { socket :: Maybe FilePath , ghcOpts :: [String]+ , cabalOpts :: [String] , module_ :: String } | Info { socket :: Maybe FilePath , ghcOpts :: [String]+ , cabalOpts :: [String] , path :: Maybe String , file :: String , identifier :: String@@ -71,6 +75,7 @@ | Type { socket :: Maybe FilePath , ghcOpts :: [String]+ , cabalOpts :: [String] , path :: Maybe String , file :: String , line :: Int@@ -79,6 +84,7 @@ | FindSymbol { socket :: Maybe FilePath , ghcOpts :: [String]+ , cabalOpts :: [String] , symbol :: String , files :: [String] }@@ -86,25 +92,28 @@ dummyAdmin :: HDevTools dummyAdmin = Admin- { socket = Nothing+ { socket = Nothing , start_server = False- , noDaemon = False- , status = False- , stop_server = False+ , noDaemon = False+ , status = False+ , stop_server = False } dummyCheck :: HDevTools dummyCheck = Check { socket = Nothing , ghcOpts = []+ , cabalOpts = [] , path = Nothing , file = ""+ , json = False } dummyModuleFile :: HDevTools dummyModuleFile = ModuleFile { socket = Nothing , ghcOpts = []+ , cabalOpts = [] , module_ = "" } @@ -112,6 +121,7 @@ dummyInfo = Info { socket = Nothing , ghcOpts = []+ , cabalOpts = [] , path = Nothing , file = "" , identifier = ""@@ -121,6 +131,7 @@ dummyType = Type { socket = Nothing , ghcOpts = []+ , cabalOpts = [] , path = Nothing , file = "" , line = 0@@ -131,6 +142,7 @@ dummyFindSymbol = FindSymbol { socket = Nothing , ghcOpts = []+ , cabalOpts = [] , symbol = "" , files = [] }@@ -148,14 +160,25 @@ check = record dummyCheck [ socket := def += typFile += help "socket file to use" , ghcOpts := def += typ "OPTION" += help "ghc options"+#ifdef ENABLE_CABAL+ , cabalOpts := def += typ "OPTION" += help "cabal options"+#else+ , cabalOpts := def += ignore+#endif , path := def += typFile += help "path to target file" , file := def += typFile += argPos 0 += opt ""+ , json := def += help "render output as JSON" ] += 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"+#ifdef ENABLE_CABAL+ , cabalOpts := def += typ "OPTION" += help "cabal options"+#else+ , cabalOpts := def += ignore+#endif , module_ := def += typ "MODULE" += argPos 0 ] += help "Get the haskell source file corresponding to a module name" @@ -163,6 +186,11 @@ info = record dummyInfo [ socket := def += typFile += help "socket file to use" , ghcOpts := def += typ "OPTION" += help "ghc options"+#ifdef ENABLE_CABAL+ , cabalOpts := def += typ "OPTION" += help "cabal options"+#else+ , cabalOpts := def += ignore+#endif , path := def += typFile += help "path to target file" , file := def += typFile += argPos 0 += opt "" , identifier := def += typ "IDENTIFIER" += argPos 1@@ -172,6 +200,11 @@ type_ = record dummyType [ socket := def += typFile += help "socket file to use" , ghcOpts := def += typ "OPTION" += help "ghc options"+#ifdef ENABLE_CABAL+ , cabalOpts := def += typ "OPTION" += help "cabal options"+#else+ , cabalOpts := def += ignore+#endif , path := def += typFile += help "path to target file" , file := def += typFile += argPos 0 += opt "" , line := def += typ "LINE" += argPos 1@@ -182,6 +215,11 @@ findSymbol = record dummyFindSymbol [ socket := def += typFile += help "socket file to use" , ghcOpts := def += typ "OPTION" += help "ghc options"+#ifdef ENABLE_CABAL+ , cabalOpts := def += typ "OPTION" += help "cabal options"+#else+ , cabalOpts := def += ignore+#endif , symbol := def += typ "SYMBOL" += argPos 0 , files := def += typFile += args ] += help "List the modules where the given symbol could be found"
src/CommandLoop.hs view
@@ -46,14 +46,16 @@ data CabalConfig = CabalConfig { cabalConfigPath :: FilePath+ , cabalConfigOpts :: [String] , cabalConfigLastUpdatedAt :: EpochTime } deriving Eq -mkCabalConfig :: FilePath -> IO CabalConfig-mkCabalConfig path = do+mkCabalConfig :: FilePath -> [String] -> IO CabalConfig+mkCabalConfig path opts = do fileStatus <- getFileStatus path return $ CabalConfig { cabalConfigPath = path+ , cabalConfigOpts = opts , cabalConfigLastUpdatedAt = modificationTime fileStatus } @@ -66,7 +68,7 @@ newConfig :: CommandExtra -> IO Config newConfig cmdExtra = do- mbCabalConfig <- traverse mkCabalConfig $ ceCabalConfig cmdExtra+ mbCabalConfig <- traverse (\path -> mkCabalConfig path (ceCabalOptions cmdExtra)) $ ceCabalConfig cmdExtra mbStackConfig <- getStackConfig cmdExtra return $ Config { configGhcOpts = "-O0" : ceGhcOptions cmdExtra@@ -140,7 +142,7 @@ return $ Right [] Just cabalConfig -> do liftIO $ setCurrentDirectory . takeDirectory $ cabalConfigPath cabalConfig- liftIO $ getPackageGhcOpts (cabalConfigPath cabalConfig) (configStack config)+ liftIO $ getPackageGhcOpts (cabalConfigPath cabalConfig) (configStack config) (cabalConfigOpts cabalConfig) case eCabalGhcOpts of Left e -> return $ Left e Right cabalGhcOpts -> do
src/Main.hs view
@@ -60,6 +60,7 @@ { ceGhcOptions = ghcOpts args , ceCabalConfig = mCabalFile , cePath = argPath+ , ceCabalOptions = cabalOpts args } let defaultSocketPath = maybe "" takeDirectory mCabalFile </> defaultSocketFile let sock = fromMaybe defaultSocketPath $ socket args
src/Stack.hs view
@@ -8,9 +8,12 @@ import Data.Maybe (listToMaybe) import Data.Char (isSpace)+ #if __GLASGOW_HASKELL__ < 709 import Control.Applicative((<$>), (<*>))+import System.IO #endif+ import System.Process import System.FilePath import System.Directory@@ -18,6 +21,7 @@ import Control.Exception import Types + -- | This module adds support for `stack`, as follows: -- 1. Figure out if the target-file is in a stack project, -- 2. If `stack` in available in PATH, run `stack exec` to extract@@ -104,9 +108,35 @@ where f = reverse . dropWhile isSpace +#if __GLASGOW_HASKELL__ < 709 execInPath :: String -> FilePath -> IO (Maybe String) execInPath cmd p = do- eIOEstr <- (try $ readCreateProcess prc "" :: IO (Either IOError String))+ 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"@@ -115,3 +145,4 @@ Left _ -> Nothing where prc = (shell cmd) { cwd = Just $ takeDirectory p }+#endif
src/Types.hs view
@@ -12,12 +12,14 @@ { ceGhcOptions :: [String] , ceCabalConfig :: Maybe FilePath , cePath :: Maybe FilePath+ , ceCabalOptions :: [String] } deriving (Read, Show) emptyCommandExtra :: CommandExtra emptyCommandExtra = CommandExtra { ceGhcOptions = [] , ceCabalConfig = Nothing , cePath = Nothing+ , ceCabalOptions = [] } data ServerDirective