leksah-server 0.8.0.8 → 0.10.0

raw patch · 13 files changed

+123/−76 lines, 13 filesdep ~Cabaldep ~basedep ~containersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: Cabal, base, containers, directory, filepath, ghc, haddock, hslogger, ltk, mtl, time

API changes (from Hackage documentation)

Files

• RELEASE-NOTES +0/−6
• leksah-server.cabal +37/−21
• src/IDE/Core/CTypes.hs +1/−1
• src/IDE/HeaderParser.hs +2/−2
• src/IDE/Metainfo/PackageCollector.hs +5/−1
• src/IDE/Metainfo/SourceCollectorH.hs +9/−5
• src/IDE/Metainfo/SourceDB.hs +5/−3
• src/IDE/Metainfo/WorkspaceCollector.hs +9/−8
• src/IDE/Utils/FileUtils.hs +24/−14
• src/IDE/Utils/GHCUtils.hs +10/−2
• src/IDE/Utils/Server.hs +2/−3
• src/IDE/Utils/Tool.hs +18/−10
• src/IDE/Utils/Utils.hs +1/−0

@@ -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.--

@@ -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  

@@ -89,7 +89,7 @@ --  leksahVersion, configDirName :: String-leksahVersion = "0.8"+leksahVersion = "0.10" configDirName = ".leksah-" ++ leksahVersion  metadataVersion :: Integer

@@ -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)

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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                 _         -> []

@@ -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)); 

@@ -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 {

@@ -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<interactive>:1:0" output of+    case stripPrefix "\n<interactive>: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

@@ -29,6 +29,7 @@ leksahFlagFileExtension              = ".lkshf"  standardSessionFilename              =   "current" ++ leksahSessionFileExtension+emptySessionFilename                 =   "empty" ++ leksahSessionFileExtension packageSessionFilename               =   "leksah" ++ leksahSessionFileExtension standardKeymapFilename               =   "keymap" ++ leksahKeymapFileExtension standardCandyFilename                =   "candy" ++ leksahCandyFileExtension