diff --git a/RELEASE-NOTES b/RELEASE-NOTES deleted file mode 100644 --- a/RELEASE-NOTES +++ /dev/null @@ -1,6 +0,0 @@ - -leksah-server version: 0.8.0.7 Freitag, September 03 2010 - -- Changed haddock dependency because of incompatibility with new haddock release. - - diff --git a/leksah-server.cabal b/leksah-server.cabal --- a/leksah-server.cabal +++ b/leksah-server.cabal @@ -1,5 +1,5 @@ name: leksah-server -version: 0.8.0.8 +version: 0.10.0 cabal-version: >= 1.2 build-type: Simple license: GPL @@ -17,7 +17,7 @@ data-dir: "" tested-with: GHC ==6.10 || ==6.12 data-files: - data/prefscoll.lkshp, RELEASE-NOTES + data/prefscoll.lkshp flag curl Default: False Description: Use runs curl instead of wget (curl is the default on OSX) @@ -26,16 +26,20 @@ Default: False Description: Use libcurl instead of running wget +flag threaded + default: True + description: Build with support for multithreaded execution + library - build-depends: Cabal >=1.6.0.1 && <1.9, base >= 4.0.0.0 && <4.3, binary >=0.5.0.0 && <0.6, + build-depends: Cabal >=1.6.0.1 && <1.11, base >= 4.0.0.0 && <4.4, binary >=0.5.0.0 && <0.6, binary-shared >=0.8 && <0.9, bytestring >=0.9.0.1 && <0.10, - containers >=0.2.0.0 && <0.4, - directory >=1.0.0.2 && <1.1, filepath >=1.1.0.1 && <1.2, ghc >=6.10.1 && <6.13, - ltk >=0.8.0.8 && <0.9, mtl >=1.1.0.2 && <1.2, parsec >=2.1.0.1 && <2.2, - pretty >=1.0.1.0 && <1.1, process-leksah >=1.0.1.3 && <1.1, time >=1.1 && <1.2, deepseq >=1.1 && <1.2, - hslogger >= 1.0.7 && <1.1, network >=2.2 && <3.0 + containers >=0.2.0.0 && <0.5, + directory >=1.0.0.2 && <1.2, filepath >=1.1.0.1 && <1.3, ghc >=6.10.1 && <7.1, + ltk >=0.9 && <1.0, mtl >=1.1.0.2 && <2.1, parsec >=2.1.0.1 && <2.2, + pretty >=1.0.1.0 && <1.1, process-leksah >=1.0.1.3 && <1.1, time >=1.1 && <1.3, deepseq >=1.1 && <1.2, + hslogger >= 1.0.7 && <1.2, network >=2.2 && <3.0 if (impl(ghc >= 6.12)) - build-depends: haddock >= 2.7.2 && <2.8 + build-depends: haddock >= 2.7.2 && <2.10 else build-depends: haddock-leksah == 2.5.0 if os(windows) @@ -69,14 +73,15 @@ ghc-prof-options: -auto-all -prof executable leksah-server - build-depends: Cabal >=1.6.0.1 && <1.9, base >= 4.0.0.0 && <4.3, binary >=0.5.0.0 && <0.6, + build-depends: Cabal >=1.6.0.1 && <1.11, base >= 4.0.0.0 && <4.4, binary >=0.5.0.0 && <0.6, binary-shared >=0.8 && <0.9, bytestring >=0.9.0.1 && <0.10, - containers >=0.2.0.0 && <0.4, - directory >=1.0.0.2 && <1.1, filepath >=1.1.0.1 && <1.2, ghc >=6.10.1 && <6.13, - ltk >=0.8.0.8 && <0.9, mtl >=1.1.0.2 && <1.2, parsec >=2.1.0.1 && <2.2, - pretty >=1.0.1.0 && <1.1, process-leksah >=1.0.1.3 && <1.1, deepseq >= 1.1 && <1.2, network >= 2.2 && <3.0 + containers >=0.2.0.0 && <0.5, + directory >=1.0.0.2 && <1.2, filepath >=1.1.0.1 && <1.3, ghc >=6.10.1 && <7.1, + ltk >=0.9 && <1.0, mtl >=1.1.0.2 && <2.1, parsec >=2.1.0.1 && <2.2, + pretty >=1.0.1.0 && <1.1, process-leksah >=1.0.1.3 && <1.1, time >=1.1 && <1.3, deepseq >=1.1 && <1.2, + hslogger >= 1.0.7 && <1.2, network >=2.2 && <3.0 if (impl(ghc >= 6.12)) - build-depends: haddock >= 2.7.2 && <2.8 + build-depends: haddock >= 2.7.2 && <2.10 else build-depends: haddock-leksah == 2.5.0 @@ -102,10 +107,17 @@ IDE.Metainfo.WorkspaceCollector IDE.Metainfo.InterfaceCollector IDE.Metainfo.SourceCollectorH IDE.Metainfo.SourceDB IDE.Utils.Tool IDE.HeaderParser IDE.Metainfo.PackageCollector - if (impl(ghc >= 6.12)) - ghc-options: -Wall -fno-warn-unused-do-bind -ferror-spans -threaded -O2 + + if flag(threaded) + ghc-options: -threaded + + if impl(ghc >= 7.0) + ghc-options: -rtsopts + + if impl(ghc >= 6.12) + ghc-options: -Wall -fno-warn-unused-do-bind -ferror-spans -O2 else - ghc-options: -Wall -ferror-spans -threaded -O2 + ghc-options: -Wall -ferror-spans -O2 ghc-prof-options: -auto-all -prof executable leksahecho @@ -114,10 +126,14 @@ extensions: CPP hs-source-dirs: src ghc-prof-options: -auto-all -prof - ghc-shared-options: -auto-all -prof +-- ghc-shared-options: -auto-all -prof + + if flag(threaded) + ghc-options: -threaded + if (impl(ghc >= 6.12)) - ghc-options: -Wall -fno-warn-unused-do-bind -ferror-spans -threaded -O2 + ghc-options: -Wall -fno-warn-unused-do-bind -ferror-spans -O2 else - ghc-options: -Wall -ferror-spans -threaded -O2 + ghc-options: -Wall -ferror-spans -O2 diff --git a/src/IDE/Core/CTypes.hs b/src/IDE/Core/CTypes.hs --- a/src/IDE/Core/CTypes.hs +++ b/src/IDE/Core/CTypes.hs @@ -89,7 +89,7 @@ -- leksahVersion, configDirName :: String -leksahVersion = "0.8" +leksahVersion = "0.10" configDirName = ".leksah-" ++ leksahVersion metadataVersion :: Integer diff --git a/src/IDE/HeaderParser.hs b/src/IDE/HeaderParser.hs --- a/src/IDE/HeaderParser.hs +++ b/src/IDE/HeaderParser.hs @@ -26,12 +26,12 @@ import Control.Monad.Trans (liftIO) import Data.Maybe (mapMaybe) import Outputable(pprHsVar,showSDoc) -import IDE.Utils.FileUtils (figureOutHaddockOpts) +import IDE.Utils.FileUtils (figureOutGhcOpts) parseTheHeader :: FilePath -> IO ServerAnswer parseTheHeader filePath = do text <- readFile filePath - opts <- figureOutHaddockOpts + opts <- figureOutGhcOpts parseResult <- liftIO $ myParseHeader filePath text opts case parseResult of Left str -> return (ServerFailed str) diff --git a/src/IDE/Metainfo/PackageCollector.hs b/src/IDE/Metainfo/PackageCollector.hs --- a/src/IDE/Metainfo/PackageCollector.hs +++ b/src/IDE/Metainfo/PackageCollector.hs @@ -49,8 +49,12 @@ import Control.Monad (when) import System.IO (withBinaryFile, IOMode(..), hPutStr) #else +#ifdef MIN_VERSION_process_leksah import IDE.System.Process (system) +#else +import System.Process (system) #endif +#endif import Prelude hiding(catch) collectPackage :: Bool -> Prefs -> Int -> (PackageConfig,Int) -> IO PackageCollectStats @@ -128,7 +132,7 @@ withBinaryFile filePath WriteMode $ \ file -> do hPutStr file string) #elif defined(USE_CURL) - catch ((system $ "curl -OL " ++ fullUrl) >> return ()) + catch ((system $ "curl -OL --fail " ++ fullUrl) >> return ()) #else catch ((system $ "wget " ++ fullUrl) >> return ()) #endif diff --git a/src/IDE/Metainfo/SourceCollectorH.hs b/src/IDE/Metainfo/SourceCollectorH.hs --- a/src/IDE/Metainfo/SourceCollectorH.hs +++ b/src/IDE/Metainfo/SourceCollectorH.hs @@ -57,14 +57,14 @@ import IDE.StrippedPrefs (getUnpackDirectory, Prefs(..)) import IDE.Metainfo.SourceDB (sourceForPackage, getSourcesMap) import MonadUtils (liftIO) -import System.Directory (setCurrentDirectory, doesDirectoryExist,createDirectory,canonicalizePath) +import System.Directory (setCurrentDirectory, doesDirectoryExist,createDirectory) import System.FilePath ((<.>), dropFileName, ()) import Data.Maybe(mapMaybe) import IDE.Utils.GHCUtils (inGhcIO) import qualified Control.Exception as NewException (SomeException, catch) import IDE.Utils.Tool import Control.Monad (unless) -import IDE.Utils.FileUtils(figureOutHaddockOpts) +import IDE.Utils.FileUtils (figureOutGhcOpts, figureOutHaddockOpts,myCanonicalizePath) import Distribution.Package(PackageIdentifier) import GHC hiding(Id,Failed,Succeeded,ModuleName) import System.Log.Logger (warningM, debugM) @@ -135,8 +135,8 @@ packageFromSource :: FilePath -> PackageConfig -> IO (Maybe PackageDescr, PackageCollectStats) packageFromSource cabalPath packageConfig = do setCurrentDirectory dirPath - ghcFlags <- figureOutHaddockOpts - debugM "leksah-server" ("ghcFlags: " ++ show ghcFlags) + ghcFlags <- figureOutGhcOpts + debugM "leksah-server" ("ghcFlags: " ++ show ghcFlags) NewException.catch (inner ghcFlags) handler where _handler' (_e :: NewException.SomeException) = do @@ -147,10 +147,14 @@ return (Nothing, PackageCollectStats packageName Nothing False False (Just ("Ghc failed to process: " ++ show e))) inner ghcFlags = inGhcIO ghcFlags [Opt_Haddock] $ \ _flags -> do +#if MIN_VERSION_haddock(2,8,0) + (interfaces,_) <- processModules verbose (exportedMods ++ hiddenMods) [] [] +#else (interfaces,_) <- createInterfaces verbose (exportedMods ++ hiddenMods) [] [] +#endif liftIO $ print (length interfaces) let mods = map (interfaceToModuleDescr dirPath (getThisPackage packageConfig)) interfaces - sp <- liftIO $ canonicalizePath dirPath + sp <- liftIO $ myCanonicalizePath dirPath let pd = PackageDescr { pdPackage = getThisPackage packageConfig , pdModules = mods diff --git a/src/IDE/Metainfo/SourceDB.hs b/src/IDE/Metainfo/SourceDB.hs --- a/src/IDE/Metainfo/SourceDB.hs +++ b/src/IDE/Metainfo/SourceDB.hs @@ -30,8 +30,9 @@ import qualified Data.Map as Map (fromList, toList, fromListWith, lookup) import IDE.Utils.FileUtils - (getConfigFilePathForLoad, getConfigFilePathForSave, allCabalFiles) -import System.Directory (doesFileExist, canonicalizePath) + (myCanonicalizePath, getConfigFilePathForLoad, + getConfigFilePathForSave, allCabalFiles) +import System.Directory (doesFileExist) import Data.List (foldl') import qualified Text.PrettyPrint as PP (colon, (<>), text, ($$), vcat, Doc, render, char) @@ -86,7 +87,7 @@ Just dir -> dir : sourceDirs Nothing -> sourceDirs cabalFiles <- mapM allCabalFiles dirs - fCabalFiles <- mapM canonicalizePath $ concat cabalFiles + fCabalFiles <- mapM myCanonicalizePath $ concat cabalFiles mbPackages <- mapM (\fp -> parseCabal fp) fCabalFiles let pdToFiles = Map.fromListWith (++) $ map (\(Just p,o ) -> (p,o)) @@ -189,6 +190,7 @@ Right r -> do debugM "leksah-server" r return (Just r) + cabalMinimalParser :: CharParser () String cabalMinimalParser = do diff --git a/src/IDE/Metainfo/WorkspaceCollector.hs b/src/IDE/Metainfo/WorkspaceCollector.hs --- a/src/IDE/Metainfo/WorkspaceCollector.hs +++ b/src/IDE/Metainfo/WorkspaceCollector.hs @@ -58,7 +58,7 @@ import MyMissing(forceHead) import LoadIface(findAndReadIface) import Distribution.Text(display) -import TcRnMonad hiding (liftIO,MonadIO,LIE) +import TcRnMonad (initTcRnIf, IfGblEnv(..)) import qualified Maybes as M import IDE.Metainfo.InterfaceCollector import Data.Maybe @@ -101,7 +101,7 @@ -- | Test collectWorkspace :: PackageIdentifier -> [(String,FilePath)] -> Bool -> Bool -> FilePath -> IO() collectWorkspace packId moduleList forceRebuild writeAscii dir = do - debugM "leksah-server" $ "collectWorkspace called with " ++ show moduleList + debugM "leksah-server" $ "collectWorkspace called with modules " ++ show moduleList ++ " in folder " ++ dir collectorPath <- liftIO $ getCollectorPath let packageCollectorPath = collectorPath packageIdentifierToString packId when forceRebuild $ do @@ -110,9 +110,11 @@ -- Construct directory liftIO $ createDirectoryIfMissing True packageCollectorPath setCurrentDirectory dir - opts <- figureOutHaddockOpts -- figureOutGhcOpts - debugM "leksah-server" $ "before collect modules" - mapM_ (collectModule packageCollectorPath writeAscii packId opts) moduleList + opts1 <- figureOutGhcOpts + opts2 <- figureOutHaddockOpts + + debugM "leksah-server" $ ("before collect modules" ++ "\n\nopts1: " ++ show opts1 ++ "\n\n opt2: " ++ show opts2) + mapM_ (collectModule packageCollectorPath writeAscii packId opts1) moduleList debugM "leksah-server" $ "after collect modules" collectModule :: FilePath -> Bool -> PackageIdentifier -> [String] -> (String,FilePath) -> IO() @@ -141,7 +143,7 @@ collectModule' :: FilePath -> FilePath -> Bool -> PackageIdentifier -> [String] -> ModuleName -> IO() collectModule' sourcePath destPath writeAscii packId opts moduleName' = gcatch ( - inGhcIO opts [Opt_Haddock,Opt_Cpp] $ \ _dynFlags -> do + inGhcIO (opts++["-cpp"]) [Opt_Haddock] $ \ _dynFlags -> do session <- getSession (dynFlags3,fp') <- preprocess session (sourcePath,Nothing) mbInterfaceDescr <- mayGetInterfaceDescription packId moduleName' @@ -505,7 +507,6 @@ Just (L _ d) -> Just (BS.pack (printHsDoc d))) True - extractRecordFields :: Located (ConDecl RdrName) -> [SimpleDescr] extractRecordFields (L _ _decl@(ConDecl {con_details = RecCon flds})) = map extractRecordFields' flds @@ -610,7 +611,7 @@ mbIf <- mayGetInterfaceFile pid mn case mbIf of Nothing -> do - liftIO $ infoM "leksah-server" ("no interface file for " ++ show mn) + liftIO $ debugM "leksah-server" ("no interface file for " ++ show mn) return Nothing Just (mif,_) -> let allDescrs = extractExportedDescrH pid mif diff --git a/src/IDE/Utils/FileUtils.hs b/src/IDE/Utils/FileUtils.hs --- a/src/IDE/Utils/FileUtils.hs +++ b/src/IDE/Utils/FileUtils.hs @@ -20,7 +20,7 @@ , cabalFileName , allCabalFiles , getConfigFilePathForLoad -, hasConfigDir +, hasSavedConfigFile , getConfigDir , getConfigFilePathForSave , getCollectorPath @@ -39,6 +39,7 @@ , figureOutGhcOpts , figureOutHaddockOpts , allFilesWithExtensions +, myCanonicalizePath ) where import System.FilePath @@ -50,13 +51,9 @@ import qualified Data.List as List (init, elem) import Distribution.Simple.PreProcess.Unlit (unlit) import System.Directory - (doesDirectoryExist, - doesFileExist, - setCurrentDirectory, - getCurrentDirectory, - getDirectoryContents, - createDirectory, - getHomeDirectory) + (canonicalizePath, doesDirectoryExist, doesFileExist, + setCurrentDirectory, getCurrentDirectory, getDirectoryContents, + createDirectory, getHomeDirectory) import Text.ParserCombinators.Parsec.Language (haskellDef, haskell) #if MIN_VERSION_parsec(3,0,0) import qualified Text.ParserCombinators.Parsec.Token as P @@ -74,8 +71,13 @@ import qualified Data.Set as Set (empty, fromList) import Control.Monad.Trans (MonadIO(..)) import Distribution.Package (PackageIdentifier) +#ifdef MIN_VERSION_process_leksah import IDE.System.Process (waitForProcess, runCommand) +#else +import System.Process + (waitForProcess, runCommand) +#endif import Data.Char (ord) import Distribution.Text (simpleParse) @@ -88,6 +90,15 @@ haskellSrcExts :: [String] haskellSrcExts = ["hs","lhs","chs","hs.pp","lhs.pp","chs.pp","hsc"] +-- | canonicalizePath without crashing +myCanonicalizePath :: String -> IO String +myCanonicalizePath fp = do + exists <- doesFileExist fp + if exists + then canonicalizePath fp + else return fp + + -- | Returns True if the second path is a location which starts with the first path isSubPath :: FilePath -> FilePath -> Bool isSubPath fp1 fp2 = @@ -146,11 +157,10 @@ then return (Just filePath) else return Nothing -hasConfigDir :: IO Bool -hasConfigDir = do - d <- getHomeDirectory - let filePath = d configDirName - doesDirectoryExist filePath +hasSavedConfigFile :: String -> IO Bool +hasSavedConfigFile fn = do + savedConfigFile <- getConfigFilePathForSave fn + doesFileExist savedConfigFile getConfigFilePathForLoad :: String -> Maybe FilePath -> FilePath -> IO FilePath @@ -409,7 +419,7 @@ figureOutGhcOpts :: IO [String] figureOutGhcOpts = do debugM "leksah-server" "figureOutGhcOpts" - (!output,_) <- runTool' "runhaskell" ["Setup","build","--with-ghc=leksahecho"] Nothing + (!output,_) <- runTool' "cabal" ["build","--with-ghc=leksahecho"] Nothing let res = case catMaybes $ map (findMake . toolline) output of options:_ -> words options _ -> [] diff --git a/src/IDE/Utils/GHCUtils.hs b/src/IDE/Utils/GHCUtils.hs --- a/src/IDE/Utils/GHCUtils.hs +++ b/src/IDE/Utils/GHCUtils.hs @@ -77,7 +77,7 @@ (dynflags', rest, _) <- parseDynamicFlags dynflags flags_ if not (null rest) then do - liftIO $ warningM "leksah-server" ("No dynamic GHC options: " ++ (unwords (map unLoc rest))) + liftIO $ debugM "leksah-server" ("No dynamic GHC options: " ++ (unwords (map unLoc rest))) return dynflags' else return dynflags' @@ -138,7 +138,11 @@ let loc = mkSrcLoc (mkFastString src_filename) 1 0 +#if MIN_VERSION_ghc(7,0,1) + case unP P.parseModule (mkPState dflags buf' loc) of { +#else case unP P.parseModule (mkPState buf' loc dflags) of { +#endif PFailed span' err -> return (Left (mkPlainErrMsg span' err)); @@ -158,7 +162,7 @@ }} myParseHeader :: FilePath -> String -> [String] -> IO (Either String (HsModule RdrName)) -myParseHeader fp _str opts = inGhcIO opts [Opt_Cpp] $ \ _dynFlags -> do +myParseHeader fp _str opts = inGhcIO (opts++["-cpp"]) [] $ \ _dynFlags -> do session <- getSession (dynFlags',fp') <- preprocess session (fp,Nothing) liftIO $ do @@ -189,7 +193,11 @@ let loc = mkSrcLoc (mkFastString src_filename) 1 0 +#if MIN_VERSION_ghc(7,0,1) + case unP P.parseHeader (mkPState dflags buf' loc) of { +#else case unP P.parseHeader (mkPState buf' loc dflags) of { +#endif PFailed span' err -> return (Left (mkPlainErrMsg span' err)); diff --git a/src/IDE/Utils/Server.hs b/src/IDE/Utils/Server.hs --- a/src/IDE/Utils/Server.hs +++ b/src/IDE/Utils/Server.hs @@ -40,11 +40,11 @@ setUserAndGroup :: UserAndGroup -> IO () setUserAndGroup _ = return () --- |make an IP Address: (127,0,0,1) is the localhost +-- | make an IP Address: (127,0,0,1) is the localhost ipAddress :: (Word8, Word8, Word8, Word8) -> HostAddress ipAddress (a, b, c, d) = fromIntegral a + 0x100 * fromIntegral b + 0x10000 * fromIntegral c + 0x1000000 * fromIntegral d --- |the functionality of a server +-- | the functionality of a server type ServerRoutine = (Handle, HostName, PortNumber) -> IO () serverSocket' :: Server -> IO Socket @@ -59,7 +59,6 @@ infoM "leksah-server" $ ("Bind " ++ show (serverAddr server)) listen sock maxListenQueue return (sock, server) - -- |the specification of a serving process data Server = Server { diff --git a/src/IDE/Utils/Tool.hs b/src/IDE/Utils/Tool.hs --- a/src/IDE/Utils/Tool.hs +++ b/src/IDE/Utils/Tool.hs @@ -41,9 +41,15 @@ import Control.Monad (unless, when) import Data.List (stripPrefix) import Data.Maybe (isJust, catMaybes) +#ifdef MIN_VERSION_process_leksah import IDE.System.Process (proc, waitForProcess, ProcessHandle, createProcess, CreateProcess(..)) import IDE.System.Process.Internals (StdStream(..)) +#else +import System.Process + (proc, waitForProcess, ProcessHandle, createProcess, CreateProcess(..)) +import System.Process.Internals (StdStream(..)) +#endif import Control.DeepSeq import System.Log.Logger (debugM, criticalM) import System.Exit (ExitCode(..)) @@ -281,18 +287,20 @@ ghciStripExpectedError :: String -> Maybe (Int, String) ghciStripExpectedError output = - case stripPrefix "\n:1:0" output of + case stripPrefix "\n:1:" output of Just rest -> - case stripPrefix ": Not in scope: `" - (maybe rest id (stripPrefix "-28" rest)) of - Just rest2 -> - case stripMarker rest2 of - Just (n, rest3) -> - case stripPrefix "'\n" rest3 of - Just rest4 -> Just (n, rest4) + case span (/= ':') rest of + (cols, rest2) | cols == "0" || cols == "1" || cols == "0-28" || cols == "1-29" -> + case stripPrefix ": Not in scope: `" rest2 of + Just rest3 -> + case stripMarker rest3 of + Just (n, rest4) -> + case stripPrefix "'\n" rest4 of + Just rest5 -> Just (n, rest5) + Nothing -> Nothing Nothing -> Nothing Nothing -> Nothing - Nothing -> Nothing + _ -> Nothing Nothing -> Nothing ghciIsExpectedOutput :: Int -> String -> Bool @@ -424,7 +432,7 @@ ToolCommand (":set prompt " ++ ghciPrompt) startupOutputHandler debugM "leksah-server" $ "Working out GHCi options" forkIO $ do - (output, _) <- runTool "runhaskell" (["Setup","build","--with-ghc=leksahecho"] ++ buildFlags) Nothing + (output, _) <- runTool "cabal" (["build","--with-ghc=leksahecho"] ++ buildFlags) Nothing case catMaybes $ map (findMake . toolline) output of options:_ -> do let newOptions = filterUnwanted options diff --git a/src/IDE/Utils/Utils.hs b/src/IDE/Utils/Utils.hs --- a/src/IDE/Utils/Utils.hs +++ b/src/IDE/Utils/Utils.hs @@ -29,6 +29,7 @@ leksahFlagFileExtension = ".lkshf" standardSessionFilename = "current" ++ leksahSessionFileExtension +emptySessionFilename = "empty" ++ leksahSessionFileExtension packageSessionFilename = "leksah" ++ leksahSessionFileExtension standardKeymapFilename = "keymap" ++ leksahKeymapFileExtension standardCandyFilename = "candy" ++ leksahCandyFileExtension