leksah-server 0.14.0.1 → 0.14.3.0
raw patch · 13 files changed
+92/−73 lines, 13 filesdep +HTTPdep +network-uridep −curldep ~leksah-serverdep ~network
Dependencies added: HTTP, network-uri
Dependencies removed: curl
Dependency ranges changed: leksah-server, network
Files
- leksah-server.cabal +21/−26
- src/IDE/Core/Serializable.hs +1/−0
- src/IDE/HeaderParser.hs +1/−0
- src/IDE/Metainfo/InterfaceCollector.hs +1/−0
- src/IDE/Metainfo/PackageCollector.hs +53/−37
- src/IDE/Metainfo/SourceCollectorH.hs +3/−2
- src/IDE/Metainfo/SourceDB.hs +1/−0
- src/IDE/Metainfo/WorkspaceCollector.hs +1/−0
- src/IDE/StrippedPrefs.hs +1/−1
- src/IDE/Utils/FileUtils.hs +1/−0
- src/IDE/Utils/Server.hs +4/−3
- src/IDE/Utils/Utils.hs +1/−1
- src/IDE/Utils/VersionUtils.hs +3/−3
leksah-server.cabal view
@@ -1,5 +1,5 @@ name: leksah-server-version: 0.14.0.1+version: 0.14.3.0 cabal-version: >= 1.10.2 build-type: Simple license: GPL@@ -18,18 +18,15 @@ tested-with: GHC ==7.4 || ==7.6 || ==7.8 data-files: data/prefscoll.lkshp-flag curl- Default: False- Description: Use runs curl instead of wget (curl is the default on OSX) -flag libcurl- Default: False- Description: Use libcurl instead of running wget- flag threaded default: True description: Build with support for multithreaded execution +flag network-uri+ description: Get Network.URI from the network-uri package+ default: True+ library default-language: Haskell98 build-depends: Cabal >=1.10.2.0 && <1.22, base >= 4.0.0.0 && <4.8, binary >=0.5.0.0 && <0.8,@@ -38,10 +35,11 @@ directory >=1.0.0.2 && <1.3, filepath >=1.1.0.1 && <1.4, ghc >=7.0.4 && <7.9, ltk >=0.14.0.0 && <0.15, parsec >=2.1.0.1 && <3.2, pretty >=1.0.1.0 && <1.2, time >=1.1 && <1.5, deepseq >=1.1 && <1.4,- hslogger >= 1.0.7 && <1.3, network >=2.2 && <3.0, conduit >= 1.0.8 && <1.3,+ hslogger >= 1.0.7 && <1.3, conduit >= 1.0.8 && <1.3, conduit-extra >=1.0.0.1 && <1.2, resourcet, attoparsec-conduit >=1.0.1.2 && <1.2, attoparsec >=0.10.0.3 && <0.13,- transformers >=0.2.2.0 && <0.5, strict >=0.3.2 && <0.4, text >=0.11.3.1 && <1.3+ transformers >=0.2.2.0 && <0.5, strict >=0.3.2 && <0.4, text >=0.11.3.1 && <1.3,+ HTTP >=4000.1.2 && <4000.3 if (impl(ghc >= 7.8)) build-depends: haddock >= 2.7.2 && <2.15 else@@ -70,12 +68,10 @@ else build-depends: unix >=2.3.1.0 && <2.8 - if flag(curl) || os(osx)- cpp-options: -DUSE_CURL-- if flag(libcurl)- build-depends: curl >=1.3.5 && <1.4- cpp-options: -DUSE_LIBCURL+ if flag(network-uri)+ build-depends: network-uri >=2.6 && <2.7, network >= 2.6 && <2.7+ else+ build-depends: network >=2.2 && <2.6 exposed-modules: IDE.Utils.GHCUtils IDE.Utils.Utils IDE.Utils.Tool IDE.Utils.FileUtils IDE.Core.CTypes IDE.Core.Serializable IDE.StrippedPrefs@@ -102,10 +98,11 @@ directory >=1.0.0.2 && <1.3, filepath >=1.1.0.1 && <1.6, ghc >=7.0.4 && <7.9, ltk >=0.14.0.0 && <0.15, parsec >=2.1.0.1 && <3.2, pretty >=1.0.1.0 && <1.2, time >=1.1 && <1.5, deepseq >=1.1 && <1.4,- hslogger >= 1.0.7 && <1.3, network >=2.2 && <3.0, conduit >= 1.0.8 && <1.3,+ hslogger >= 1.0.7 && <1.3, conduit >= 1.0.8 && <1.3, conduit-extra >=1.0.0.1 && <1.2, resourcet, attoparsec-conduit >=1.0.1.2 && <1.2, attoparsec >=0.10.0.3 && <0.13,- transformers >=0.2.2.0 && <0.5, strict >=0.3.2 && <0.4, text >=0.11.3.1 && <1.3+ transformers >=0.2.2.0 && <0.5, strict >=0.3.2 && <0.4, text >=0.11.3.1 && <1.3,+ HTTP >=4000.1.2 && <4000.3 if (impl(ghc >= 7.8)) build-depends: haddock >= 2.7.2 && <2.15 else@@ -134,16 +131,14 @@ else build-depends: unix >=2.3.1.0 && <2.8 + if flag(network-uri)+ build-depends: network-uri >=2.6 && <2.7, network >= 2.6 && <2.7+ else+ build-depends: network >=2.2 && <2.6+ if os(osx) ghc-options: -optl-headerpad_max_install_names - if flag(curl) || os(osx)- cpp-options: -DUSE_CURL-- if flag(libcurl)- build-depends: curl >=1.3.5 && <1.4- cpp-options: -DUSE_LIBCURL- main-is: IDE/Metainfo/Collector.hs buildable: True default-extensions: CPP@@ -199,7 +194,7 @@ hs-source-dirs: tests main-is: TestTool.hs build-depends: base >= 4.0.0.0 && <4.8, hslogger >= 1.0.7 && <1.3,- leksah-server == 0.14.0.1,+ leksah-server == 0.14.3.0, HUnit >=1.2 && <1.3, transformers >=0.2.2.0 && <0.5, conduit >= 1.0.8 && <1.3, conduit-extra >=1.0.0.1 && <1.2, resourcet
src/IDE/Core/Serializable.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -XScopedTypeVariables
src/IDE/HeaderParser.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- -- Module : IDE.HeaderParser
src/IDE/Metainfo/InterfaceCollector.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -XScopedTypeVariables -XFlexibleContexts#-} ----------------------------------------------------------------------------- --
src/IDE/Metainfo/PackageCollector.hs view
@@ -24,7 +24,7 @@ import PackageConfig (PackageConfig) import IDE.Metainfo.SourceCollectorH (findSourceForPackage, packageFromSource, PackageCollectStats(..))-import System.Log.Logger (debugM, infoM)+import System.Log.Logger (errorM, debugM, infoM) import IDE.Metainfo.InterfaceCollector (collectPackageFromHI) import IDE.Core.CTypes (getThisPackage, SimpleDescr(..), TypeDescr(..),@@ -33,7 +33,7 @@ PackageDescr(..), metadataVersion, leksahVersion, packageIdentifierToString) import IDE.Utils.FileUtils (getCollectorPath)-import System.Directory (doesFileExist, setCurrentDirectory)+import System.Directory (setCurrentDirectory) import IDE.Utils.Utils (leksahMetadataPathFileExtension, leksahMetadataSystemFileExtension)@@ -43,25 +43,25 @@ (fromListWith, fromList, keys, lookup) import Data.List (delete, nub) import Distribution.Text (display)-import Control.Exception (SomeException)-#if defined(USE_LIBCURL)-import Network.Curl (curlGetString_, CurlCode(..))-import Control.Monad (when)-import System.IO (withBinaryFile, IOMode(..))-import Data.ByteString (hPutStr)-#else-#ifdef MIN_VERSION_process_leksah-import IDE.System.Process (system)-#else-import System.Process (system)-#endif-#endif import Control.Monad.IO.Class (MonadIO, MonadIO(..)) import qualified Control.Exception as E (SomeException, catch) import IDE.Utils.Tool (runTool') import Data.Monoid ((<>)) import qualified Data.Text as T (unpack) import Data.Text (Text)+import Control.Applicative ((<$>))+import Network.HTTP.Proxy (Proxy(..), fetchProxy)+import Network.Browser+ (request, setAuthorityGen, setOutHandler, setErrHandler, setProxy,+ browse)+import Data.Char (isSpace)+import Network.URI (parseURI)+import Network.HTTP (rspBody, rspCode, Header(..), Request(..))+import Network.HTTP.Base (RequestMethod(..))+import Network.HTTP.Headers (HeaderName(..))+import qualified Data.ByteString as BS (writeFile, empty)+import qualified Paths_leksah_server (version)+import Distribution.System (buildArch, buildOS) collectPackage :: Bool -> Prefs -> Int -> (PackageConfig,Int) -> IO PackageCollectStats collectPackage writeAscii prefs numPackages (packageConfig, packageIndex) = do@@ -133,23 +133,37 @@ setCurrentDirectory collectorPath let fullUrl = T.unpack (retrieveURL prefs) <> "/metadata-" <> leksahVersion <> "/" <> T.unpack packString <> leksahMetadataSystemFileExtension filePath = collectorPath </> T.unpack packString <.> leksahMetadataSystemFileExtension- debugM "leksah-server" $ "collectPackage: before retreiving = " <> fullUrl-#if defined(USE_LIBCURL)- E.catch (do- (code, string) <- curlGetString_ fullUrl []- when (code == CurlOK) $- withBinaryFile filePath WriteMode $ \ file -> do- hPutStr file string)-#elif defined(USE_CURL)- E.catch ((system $ "curl -OL --fail " ++ fullUrl) >> return ())-#else- E.catch ((system $ "wget " ++ fullUrl) >> return ())-#endif- (\(e :: SomeException) ->- debugM "leksah-server" $ "collectPackage: Error when calling wget " ++ show e)- debugM "leksah-server" . T.unpack $ "collectPackage: after retreiving = " <> packString -- ++ " result = " ++ res- exist <- doesFileExist filePath- return exist++ case parseURI fullUrl of+ Nothing -> do+ errorM "leksah-server" $ "collectPackage: invalid URI = " <> fullUrl+ return False+ Just uri -> do+ debugM "leksah-server" $ "collectPackage: before retreiving = " <> fullUrl+ proxy <- filterEmptyProxy . trimProxyUri <$> fetchProxy True+ (_, rsp) <- browse $ do+ setProxy proxy+ setErrHandler (errorM "leksah-server")+ setOutHandler (debugM "leksah-server")+ setAuthorityGen (\_ _ -> return Nothing)+ request Request{ rqURI = uri+ , rqMethod = GET+ , rqHeaders = [Header HdrUserAgent userAgent]+ , rqBody = BS.empty }+ if rspCode rsp == (2,0,0)+ then do+ BS.writeFile filePath $ rspBody rsp+ return True+ else return False++ trimProxyUri (Proxy uri auth) = Proxy (trim uri) auth+ trimProxyUri p = p+ filterEmptyProxy (Proxy "" _) = NoProxy+ filterEmptyProxy p = p+ trim = f . f where f = reverse . dropWhile isSpace+ userAgent = concat [ "leksah-server/", display Paths_leksah_server.version+ , " (", display buildOS, "; ", display buildArch, ")"+ ] writeMerged packageDescrS packageDescrHi fpSource packageName = do let mergedPackageDescr = mergePackageDescrs packageDescrHi packageDescrS liftIO $ writeExtractedPackage writeAscii mergedPackageDescr@@ -157,10 +171,12 @@ runCabalConfigure fpSource = do let dirPath = dropFileName fpSource setCurrentDirectory dirPath- E.catch (runTool' "cabal" (["configure","--user"]) Nothing >> return ())- (\ (_e :: E.SomeException) -> do- debugM "leksah-server" "Can't configure"- return ())+ E.catch (do runTool' "cabal" ["clean"] Nothing+ runTool' "cabal" ["configure","--user"] Nothing+ return ())+ (\ (_e :: E.SomeException) -> do+ debugM "leksah-server" "Can't configure"+ return ()) writeExtractedPackage :: MonadIO m => Bool -> PackageDescr -> m () writeExtractedPackage writeAscii pd = do@@ -240,7 +256,7 @@ mergeDescr (Just (Real rdhi)) (Just (Real rdsrc)) = Real RealDescr { dscName' = dscName' rdhi- , dscMbTypeStr' = dscMbTypeStr' rdhi+ , dscMbTypeStr' = dscMbTypeStr' rdsrc , dscMbModu' = dscMbModu' rdsrc , dscMbLocation' = dscMbLocation' rdsrc , dscMbComment' = dscMbComment' rdsrc
src/IDE/Metainfo/SourceCollectorH.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} -----------------------------------------------------------------------------@@ -145,9 +146,9 @@ debugM "leksah-server" "would block" return ([]) handler (e :: NewException.SomeException) = do- warningM "leksah-server" ("Ghc failed to process: " ++ show e)+ warningM "leksah-server" ("Ghc failed to process: " ++ show e ++ " (" ++ cabalPath ++ ")") return (Nothing, PackageCollectStats packageName Nothing False False- (Just ("Ghc failed to process: " <> T.pack (show e))))+ (Just ("Ghc failed to process: " <> T.pack (show e) <> " (" <> T.pack cabalPath <> ")"))) inner ghcFlags = inGhcIO ghcFlags [Opt_Haddock] $ \ dflags -> do #if MIN_VERSION_haddock(2,8,0) (interfaces,_) <- processModules verbose (exportedMods ++ hiddenMods) [] []
src/IDE/Metainfo/SourceDB.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- --
src/IDE/Metainfo/WorkspaceCollector.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables, PatternGuards, OverloadedStrings #-} ----------------------------------------------------------------------------- --
src/IDE/StrippedPrefs.hs view
@@ -121,7 +121,7 @@ _ -> return p getSourceDirectories :: Prefs -> IO [FilePath]-getSourceDirectories = (mapM expandHomePath) . sourceDirectories+getSourceDirectories = mapM expandHomePath . sourceDirectories getUnpackDirectory :: Prefs -> IO (Maybe FilePath) getUnpackDirectory = maybe (return Nothing) (liftM Just . expandHomePath) . unpackDirectory
src/IDE/Utils/FileUtils.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-}
src/IDE/Utils/Server.hs view
@@ -33,6 +33,7 @@ import Data.Word import System.Log.Logger (infoM) import Data.Text (Text)+import Control.Monad (void) data UserAndGroup = UserAndGroup Text Text | UserWithDefaultGroup Text @@ -57,7 +58,7 @@ sock <- serverSocket' server setSocketOption sock ReuseAddr 1 bindSocket sock (serverAddr server)- infoM "leksah-server" $ ("Bind " ++ show (serverAddr server))+ infoM "leksah-server" $ "Bind " ++ show (serverAddr server) listen sock maxListenQueue return (sock, server) @@ -89,7 +90,7 @@ waitFor :: a -> IO () instance WaitFor (MVar a) where- waitFor mvar = readMVar mvar >> return ()+ waitFor mvar = void (readMVar mvar) instance WaitFor a => WaitFor [a] where waitFor = mapM_ waitFor@@ -100,7 +101,7 @@ acceptance :: Socket -> ServerRoutine -> IO () acceptance sock action = E.catch (do dta <- accept sock- forkIO (action dta) >> return ())+ void . forkIO $ action dta) (\(e :: SomeException) -> print e) >> acceptance sock action
src/IDE/Utils/Utils.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -XDeriveDataTypeable -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Utils.Utils
src/IDE/Utils/VersionUtils.hs view
@@ -35,13 +35,13 @@ else vers debugM "leksah-server" $ "Got GHC Version " ++ T.unpack vers2 return $ T.unpack vers2- ) $ \ (_ :: SomeException) -> error ("FileUtils>>getGhcVersion failed")+ ) $ \ (_ :: SomeException) -> error "FileUtils>>getGhcVersion failed" getGhcInfo :: IO Text getGhcInfo = E.catch (do (!output,_) <- runTool' "ghc" ["--info"] Nothing return . T.unlines $ map toolline output- ) $ \ (_ :: SomeException) -> error ("FileUtils>>getGhcInfo failed")+ ) $ \ (_ :: SomeException) -> error "FileUtils>>getGhcInfo failed" getHaddockVersion :: IO Text getHaddockVersion = E.catch (do@@ -51,7 +51,7 @@ then T.init vers else vers return vers2- ) $ \ (_ :: SomeException) -> error ("FileUtils>>getHaddockVersion failed")+ ) $ \ (_ :: SomeException) -> error "FileUtils>>getHaddockVersion failed"