diff --git a/data/prefscoll.lkshp b/data/prefscoll.lkshp --- a/data/prefscoll.lkshp +++ b/data/prefscoll.lkshp @@ -1,4 +1,10 @@ Paths under which haskell sources for packages may be found: - ["~/Develop"] + [] Maybe a directory for unpacking cabal packages: - Just "~/Haskell" + Just "~/.leksah-0.8/packageSources" +Maybe an URL to load prebuild metadata : + Just "http://www.leksah.org" +Port number for server connection: + 11111 +End the server with last connection: + True 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.2 +version: 0.8.0.3 cabal-version: >= 1.2 build-type: Simple license: GPL @@ -26,7 +26,7 @@ pretty >=1.0.1.0, process >=1.0.1.0, time >= 1.1, deepseq >= 1.1, hslogger >= 1.0.7, network >= 2.2 && <= 3.0 if (impl(ghc >= 6.12)) - build-depends: haddock-leksah == 2.6.0 + build-depends: haddock >= 2.7.2 else build-depends: haddock-leksah == 2.5.0 if os(windows) @@ -59,7 +59,7 @@ ltk >=0.8 && <= 0.9, mtl >=1.1.0.2, parsec >=2.1.0.1, pretty >=1.0.1.0, process >=1.0.1.0, deepseq >= 1.1, network >= 2.2 && <= 3.0 if (impl(ghc >= 6.12)) - build-depends: haddock-leksah == 2.6.0 + build-depends: haddock >= 2.7.2 else build-depends: haddock-leksah == 2.5.0 diff --git a/src/IDE/HeaderParser.hs b/src/IDE/HeaderParser.hs --- a/src/IDE/HeaderParser.hs +++ b/src/IDE/HeaderParser.hs @@ -31,7 +31,7 @@ parseTheHeader :: FilePath -> IO ServerAnswer parseTheHeader filePath = do text <- readFile filePath - opts <- figureOutGhcOpts -- figureOutHaddockOpts + opts <- figureOutHaddockOpts parseResult <- liftIO $ myParseHeader filePath text opts case parseResult of Left str -> return (ServerFailed str) diff --git a/src/IDE/Metainfo/Collector.hs b/src/IDE/Metainfo/Collector.hs --- a/src/IDE/Metainfo/Collector.hs +++ b/src/IDE/Metainfo/Collector.hs @@ -55,18 +55,23 @@ setLevel) import System.Log.Handler.Simple(fileHandler) import Network(withSocketsDo) -import Network.Socket (SocketType(..), iNADDR_ANY, SockAddr(..),PortNumber(..)) +import Network.Socket + (inet_addr, SocketType(..), SockAddr(..), PortNumber(..)) import IDE.Utils.Server import System.IO (Handle, hPutStrLn, hGetLine, hFlush, hClose) import IDE.HeaderParser(parseTheHeader) import System.Process (system) import System.Exit (ExitCode(..)) import Distribution.Package (PackageIdentifier(..)) +import Data.IORef +import Control.Concurrent (throwTo, ThreadId, myThreadId) -- -------------------------------------------------------------------- -- Command line options -- + + getThisPackage :: PackageConfig -> PackageIdentifier #if MIN_VERSION_Cabal(1,8,0) getThisPackage = IPI.sourcePackageId @@ -87,6 +92,8 @@ | Debug | Verbosity String | LogFile String + | Forever + | EndWithLast deriving (Show,Eq) options :: [OptDescr Flag] @@ -111,6 +118,11 @@ "One of DEBUG, INFO, NOTICE, WARNING, ERROR, CRITICAL, ALERT, EMERGENCY" , Option ['l'] ["logfile"] (ReqArg LogFile "LogFile") "File path for logging messages" + , Option ['f'] ["forever"] (NoArg Forever) + "Don't end the server when last connection ends" + , Option ['c'] ["endWithLast"] (NoArg EndWithLast) + "End the server when last connection ends" + ] header :: String @@ -161,6 +173,9 @@ prefsPath <- getConfigFilePathForLoad strippedPreferencesFilename Nothing dataDir prefs <- readStrippedPrefs prefsPath debugM "leksah-server" $ "prefs " ++ show prefs + connRef <- newIORef [] + threadId <- myThreadId + localServerAddr <- inet_addr "127.0.0.1" if elem VersionF o then putStrLn $ "Leksah Haskell IDE (server), version " ++ showVersion version @@ -174,6 +189,13 @@ let sources = elem Sources o let rebuild = elem Rebuild o let debug = elem Debug o + let forever = elem Forever o + let endWithLast = elem EndWithLast o + let newPrefs = if forever && not endWithLast + then prefs{endWithLastConn = False} + else if not forever && endWithLast + then prefs{endWithLastConn = True} + else prefs if elem CollectSystem o then do debugM "leksah-server" "collectSystem" @@ -181,26 +203,45 @@ else case servers of (Nothing:_) -> do - running <- serveOne Nothing (server (PortNum (fromIntegral (serverPort prefs))) prefs) + running <- serveOne Nothing (server (PortNum (fromIntegral + (serverPort prefs))) newPrefs connRef threadId localServerAddr) waitFor running return () (Just ps:_) -> do let port = read ps - running <- serveOne Nothing (server (PortNum (fromIntegral port)) prefs) + running <- serveOne Nothing (server (PortNum + (fromIntegral port)) newPrefs connRef threadId localServerAddr) waitFor running return () _ -> return () - server port prefs = Server (SockAddrInet port iNADDR_ANY) Stream (doCommands prefs) + server port prefs connRef threadId hostAddr = Server (SockAddrInet port hostAddr) Stream + (doCommands prefs connRef threadId) -doCommands :: Prefs -> (Handle, t1, t2) -> IO () -doCommands prefs (h,n,p) = do +doCommands :: Prefs -> IORef [Handle] -> ThreadId -> (Handle, t1, t2) -> IO () +doCommands prefs connRef threadId (h,n,p) = do + atomicModifyIORef connRef (\ list -> (h : list, ())) + doCommands' prefs connRef threadId (h,n,p) + + +doCommands' :: Prefs -> IORef [Handle] -> ThreadId -> (Handle, t1, t2) -> IO () +doCommands' prefs connRef threadId (h,n,p) = do debugM "leksah-server" $ "***wait" mbLine <- catch (liftM Just (hGetLine h)) (\ (_e :: SomeException) -> do infoM "leksah-server" $ "***lost connection" hClose h - return Nothing) + atomicModifyIORef connRef (\ list -> (delete h list,())) + handles <- readIORef connRef + case handles of + [] -> do + when (endWithLastConn prefs) $ do + infoM "leksah-server" $ "***lost last connection - exiting" + throwTo threadId ExitSuccess + --exitSuccess + infoM "leksah-server" $ "***lost last connection - waiting" + return Nothing + _ -> return Nothing) case mbLine of Nothing -> return () Just line -> do @@ -229,7 +270,7 @@ (\ (e :: SomeException) -> do hPutStrLn h (show (ServerFailed (show e))) hFlush h) - doCommands prefs (h,n,p) + doCommands' prefs connRef threadId (h,n,p) collectSystem :: Prefs -> Bool -> Bool -> Bool -> IO() collectSystem prefs writeAscii forceRebuild findSources = do 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 @@ -23,14 +23,12 @@ (PackageDescr(..), TypeDescr(..), RealDescr(..), Descr(..), ModuleDescr(..), PackModule(..), SimpleDescr(..), packageIdentifierToString) -#if MIN_VERSION_haddock_leksah(2,6,0) -import Haddock.Types - (ExportItem(..), DeclInfo, - Interface(..),HsDoc(..)) -#else +#ifdef MIN_VERSION_haddock_leksah import Haddock.Types (ExportItem(..), DeclInfo, Interface(..)) +#else +import Documentation.Haddock #endif import Distribution.Text (simpleParse) import InstEnv (Instance(..)) @@ -50,7 +48,6 @@ import Name (getOccString,getSrcSpan) import PackageConfig (PackageConfig) -import Haddock.Interface (createInterfaces) import Distribution.Verbosity (verbose) import qualified Distribution.InstalledPackageInfo as IPI import IDE.StrippedPrefs (getUnpackDirectory, Prefs(..)) @@ -80,6 +77,11 @@ getThisPackage = IPI.package #endif +#ifdef MIN_VERSION_haddock_leksah +#else +type HsDoc = Doc +#endif + type NDoc = HsDoc Name isEmptyDoc :: NDoc -> Bool @@ -180,7 +182,7 @@ "Can't parse module name" descrs = extractDescrs (PM pid modName) (ifaceDeclMap interface) (ifaceExportItems interface) - (ifaceInstances interface) (ifaceLocals interface) + (ifaceInstances interface) [] --(ifaceLocals interface) imports = Map.empty --TODO #if MIN_VERSION_ghc(6,12,1) diff --git a/src/IDE/StrippedPrefs.hs b/src/IDE/StrippedPrefs.hs --- a/src/IDE/StrippedPrefs.hs +++ b/src/IDE/StrippedPrefs.hs @@ -38,6 +38,7 @@ , unpackDirectory :: Maybe FilePath , retreiveURL :: Maybe String , serverPort :: Int + , endWithLastConn :: Bool } deriving(Eq,Show) defaultPrefs :: Prefs @@ -46,6 +47,7 @@ , unpackDirectory = Nothing , retreiveURL = Just "http://www.leksah.org/" , serverPort = 11111 + , endWithLastConn = True } -- ------------------------------------------------------------ @@ -86,6 +88,12 @@ intParser serverPort (\b a -> a{serverPort = b}) + , mkFieldS + (paraName <<<- ParaName "End the server with last connection" $ emptyParams) + (PP.text . show) + boolParser + endWithLastConn + (\b a -> a{endWithLastConn = b}) ] -- ------------------------------------------------------------