packages feed

hoogle 5.0.17.1 → 5.0.17.2

raw patch · 13 files changed

+111/−73 lines, 13 filesdep ~conduitdep ~conduit-extradep ~networkPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: conduit, conduit-extra, network

API changes (from Hackage documentation)

Files

CHANGES.txt view
@@ -1,6 +1,10 @@ Changelog for Hoogle -2.0.17.1, released 2018-01-27+5.0.17.2, released 2018-03-16+    Remove support for GHC 7.10+    Require conduit-1.3.0+    #245, add support for GHC 8.4+5.0.17.1, released 2018-01-27     #238, only identify the database by the first three version components     #236, in --local mode replace file:// links in Haddock pages 5.0.17, released 2018-01-17
hoogle.cabal view
@@ -1,7 +1,7 @@ cabal-version:      >= 1.18 build-type:         Simple name:               hoogle-version:            5.0.17.1+version:            5.0.17.2 license:            BSD3 license-file:       LICENSE category:           Development@@ -15,7 +15,7 @@     or by approximate type signature. homepage:           http://hoogle.haskell.org/ bug-reports:        https://github.com/ndmitchell/hoogle/issues-tested-with:        GHC==8.2.2, GHC==8.0.2, GHC==7.10.3+tested-with:        GHC==8.4.1, GHC==8.2.2, GHC==8.0.2 extra-doc-files:     README.md     CHANGES.txt@@ -58,8 +58,8 @@         binary,         bytestring >= 0.10.2.0,         cmdargs,-        conduit,-        conduit-extra,+        conduit >= 1.3.0,+        conduit-extra >= 1.2.3.2,         connection,         containers >= 0.5,         deepseq,
src/Action/Generate.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE ViewPatterns, TupleSections, RecordWildCards, ScopedTypeVariables, PatternGuards #-}-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- getGCStats became getRTSStats  module Action.Generate(actionGenerate) where @@ -35,8 +34,6 @@ import General.Store import General.Timing import General.Str-import System.Mem-import GHC.Stats import Action.CmdLine import General.Conduit @@ -95,7 +92,7 @@  type Download = String -> URL -> IO FilePath -readHaskellOnline :: Timing -> Settings -> Download -> IO (Map.Map String Package, Set.Set String, Source IO (String, URL, LStr))+readHaskellOnline :: Timing -> Settings -> Download -> IO (Map.Map String Package, Set.Set String, ConduitT () (String, URL, LStr) IO ()) readHaskellOnline timing settings download = do     stackage <- download "haskell-stackage.txt" "https://www.stackage.org/lts/cabal.config"     platform <- download "haskell-platform.txt" "https://raw.githubusercontent.com/haskell/haskell-platform/master/hptool/src/Releases2015.hs"@@ -123,7 +120,7 @@     return (cbl, want, source)  -readHaskellDirs :: Timing -> Settings -> [FilePath] -> IO (Map.Map String Package, Set.Set String, Source IO (String, URL, LStr))+readHaskellDirs :: Timing -> Settings -> [FilePath] -> IO (Map.Map String Package, Set.Set String, ConduitT () (String, URL, LStr) IO ()) readHaskellDirs timing settings dirs = do     files <- concatMapM listFilesRecursive dirs     -- We reverse/sort the list because of #206@@ -148,7 +145,7 @@         let pkg = readCabal settings src         return (takeBaseName fp, pkg) -readFregeOnline :: Timing -> Download -> IO (Map.Map String Package, Set.Set String, Source IO (String, URL, LStr))+readFregeOnline :: Timing -> Download -> IO (Map.Map String Package, Set.Set String, ConduitT () (String, URL, LStr) IO ()) readFregeOnline timing download = do     frege <- download "frege-frege.txt" "http://try.frege-lang.org/hoogle-frege.txt"     let source = do@@ -157,7 +154,7 @@     return (Map.empty, Set.singleton "frege", source)  -readHaskellGhcpkg :: Timing -> Settings -> IO (Map.Map String Package, Set.Set String, Source IO (String, URL, LStr))+readHaskellGhcpkg :: Timing -> Settings -> IO (Map.Map String Package, Set.Set String, ConduitT () (String, URL, LStr) IO ()) readHaskellGhcpkg timing settings = do     cbl <- timed timing "Reading ghc-pkg" $ readGhcPkg settings     let source =@@ -173,7 +170,7 @@                     in Map.map (\p -> p{packageTags = ts ++ packageTags p}) cbl     return (cbl, Map.keysSet cbl, source) -readHaskellHaddock :: Timing -> Settings -> FilePath -> IO (Map.Map String Package, Set.Set String, Source IO (String, URL, LStr))+readHaskellHaddock :: Timing -> Settings -> FilePath -> IO (Map.Map String Package, Set.Set String, ConduitT () (String, URL, LStr) IO ()) readHaskellHaddock timing settings docBaseDir = do     cbl <- timed timing "Reading ghc-pkg" $ readGhcPkg settings     let source =@@ -195,7 +192,6 @@ actionGenerate g@Generate{..} = withTiming (if debug then Just $ replaceExtension database "timing" else Nothing) $ \timing -> do     putStrLn "Starting generate"     createDirectoryIfMissing True $ takeDirectory database-    gcStats <- getGCStatsEnabled      download <- return $ downloadInput timing insecure download (takeDirectory database)     settings <- loadSettings@@ -218,18 +214,18 @@             itemWarn <- newIORef 0             let warning msg = do modifyIORef itemWarn succ; hPutStrLn warnings msg -            let consume :: Conduit (Int, (String, URL, LStr)) IO (Maybe Target, [Item])+            let consume :: ConduitM (Int, (String, URL, LStr)) (Maybe Target, [Item]) IO ()                 consume = awaitForever $ \(i, (pkg, url, body)) -> do                     timedOverwrite timing ("[" ++ show i ++ "/" ++ show (Set.size want) ++ "] " ++ pkg) $                         parseHoogle (\msg -> warning $ pkg ++ ":" ++ msg) url body              writeItems store $ \items -> do                 xs <- runConduit $-                    source =$=-                    filterC (flip Set.member want . fst3) =$=+                    source .|+                    filterC (flip Set.member want . fst3) .|                     void ((|$|)-                        (zipFromC 1 =$= consume)-                        (do seen <- fmap Set.fromList $ mapC fst3 =$= sinkList+                        (zipFromC 1 .| consume)+                        (do seen <- fmap Set.fromList $ mapC fst3 .| sinkList                              let missing = [x | x <- Set.toList $ want `Set.difference` seen                                              , fmap packageLibrary (Map.lookup x cbl) /= Just False]@@ -251,26 +247,25 @@                                 else                                     return ()                             ))-                    =$= pipelineC 10 (items =$= sinkList)+                    .| pipelineC 10 (items .| sinkList)                  itemWarn <- readIORef itemWarn                 when (itemWarn > 0) $                     putStrLn $ "Found " ++ show itemWarn ++ " warnings when processing items"                 return [(a,b) | (a,bs) <- xs, b <- bs] -        itemsMb <- if not gcStats then return 0 else do performGC; GCStats{..} <- getGCStats; return $ currentBytesUsed `div` (1024*1024)+        itemsMemory <- getStatsCurrentLiveBytes         xs <- timed timing "Reodering items" $ return $! reorderItems settings (\s -> maybe 1 negate $ Map.lookup s popularity) xs         timed timing "Writing tags" $ writeTags store (`Set.member` want) (\x -> maybe [] (map (both T.unpack) . packageTags) $ Map.lookup x cbl) xs         timed timing "Writing names" $ writeNames store xs         timed timing "Writing types" $ writeTypes store (if debug then Just $ dropExtension database else Nothing) xs -        when gcStats $ do-            stats@GCStats{..} <- getGCStats-            x <- getVerbosity-            when (x >= Loud) $-                print stats-            when (x >= Normal) $ do-                putStrLn $ "Peak of " ++ show peakMegabytesAllocated ++ "Mb, " ++ show itemsMb ++ "Mb for items"+        x <- getVerbosity+        when (x >= Loud) $+            maybe (return ()) print =<< getStatsDebug+        when (x >= Normal) $ do+            whenJustM getStatsPeakAllocBytes $ \x ->+                putStrLn $ "Peak of " ++ x ++ ", " ++ fromMaybe "unknown" itemsMemory ++ " for items"      when debug $         writeFile (database `replaceExtension` "store") $ unlines stats
src/Action/Server.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE ViewPatterns, TupleSections, RecordWildCards, ScopedTypeVariables, PatternGuards #-}-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- getGCStats became getRTSStats  module Action.Server(actionServer, actionReplay, action_server_test_, action_server_test) where @@ -23,7 +22,6 @@ import Data.Time.Calendar import System.IO.Unsafe import Numeric.Extra-import GHC.Stats import System.Info.Extra  import Output.Tags@@ -115,12 +113,10 @@         log <- displayLog <$> logSummary log         OutputHTML <$> templateRender templateLog [("data",str log)]     ["stats"] -> do-        stats <- getGCStatsEnabled-        if stats then do-            x <- getGCStats-            return $ OutputText $ lstrPack $ replace ", " "\n" $ takeWhile (/= '}') $ drop 1 $ dropWhile (/= '{') $ show x-         else-            return $ OutputFail $ lstrPack "GHC Statistics is not enabled, restart with +RTS -T"+        stats <- getStatsDebug+        return $ case stats of+            Nothing -> OutputFail $ lstrPack "GHC Statistics is not enabled, restart with +RTS -T"+            Just x -> OutputText $ lstrPack $ replace ", " "\n" $ takeWhile (/= '}') $ drop 1 $ dropWhile (/= '{') $ show x     "haddock":xs | Just x <- haddock -> do         let file = intercalate "/" $ filter (not . (== "..")) (x:xs)         return $ OutputFile $ file ++ (if hasTrailingPathSeparator file then "index.html" else "")
src/General/Conduit.hs view
@@ -1,5 +1,4 @@-{-# LANGUAGE NoMonomorphismRestriction, PatternGuards, Rank2Types, CPP #-}-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- QSem was deprecated in 7.6, but then undeprecated+{-# LANGUAGE NoMonomorphismRestriction, PatternGuards, CPP #-}  module General.Conduit(     module Data.Conduit, MonadIO, liftIO,@@ -10,6 +9,7 @@     zipFromC, linesCR     ) where +import Data.Void import Data.Conduit import Data.Conduit.List as C import Data.Conduit.Binary as C@@ -30,18 +30,18 @@ mapAccumMC f = C.mapAccumM (\x a -> a `seq` f a x) filterC = C.filter -zipFromC :: (Monad m, Enum i) => i -> Conduit a m (i, a)+zipFromC :: (Monad m, Enum i) => i -> ConduitM a (i, a) m () zipFromC = void . mapAccumC (\i x -> (succ i, (i,x)))  (|$|) :: Monad m => ConduitM i o m r1 -> ConduitM i o m r2 -> ConduitM i o m (r1,r2) (|$|) a b = getZipConduit $ (,) <$> ZipConduit a <*> ZipConduit b -sinkList :: Monad m => Consumer a m [a]+sinkList :: Monad m => ConduitM a o m [a] sinkList = consume  -- | Group things while they have the same function result, only return the last value. --   Conduit version of @groupOnLast f = map last . groupOn f@.-groupOnLastC :: (Monad m, Eq b) => (a -> b) -> Conduit a m a+groupOnLastC :: (Monad m, Eq b) => (a -> b) -> ConduitM a a m () groupOnLastC op = do     x <- await     whenJust x $ \x -> f (op x) x@@ -53,16 +53,16 @@                 f k2 v2  -linesCR :: Monad m => Conduit Str m Str-linesCR = C.lines =$= mapC f+linesCR :: Monad m => ConduitM Str Str m ()+linesCR = C.lines .| mapC f     where f x | Just (x, '\r') <- BS.unsnoc x = x               | otherwise = x -sourceLStr :: Monad m => LStr -> Producer m Str+sourceLStr :: Monad m => LStr -> ConduitM i Str m () sourceLStr = sourceList . lstrToChunks  -pipelineC :: Int -> Consumer o IO r -> Consumer o IO r+pipelineC :: Int -> ConduitM o Void IO r -> ConduitM o Void IO r pipelineC buffer sink = do     sem <- liftIO $ newQSem buffer  -- how many are in flow, to avoid memory leaks     chan <- liftIO newChan          -- the items in flow (type o)@@ -74,7 +74,7 @@                 x <- liftIO $ readChan chan                 liftIO $ signalQSem sem                 whenJust x yield-                return $ isJust x) =$=+                return $ isJust x) .|             sink     awaitForever $ \x -> liftIO $ do         waitQSem sem
src/General/Timing.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE RecordWildCards #-}-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- getGCStats became getRTSStats  module General.Timing(Timing, withTiming, timed, timedOverwrite) where @@ -9,7 +8,6 @@ import Control.Monad.Extra import System.IO import General.Util-import GHC.Stats import Control.Monad.IO.Class  @@ -68,8 +66,7 @@     let time = end - start     liftIO $ modifyIORef timingStore ((msg,time):) -    stats <- liftIO getGCStatsEnabled-    s <- if not stats then return "" else do GCStats{..} <- liftIO getGCStats; return $ " (" ++ show peakMegabytesAllocated ++ "Mb)"+    s <- maybe "" (\x -> " (" ++ x ++ ")") <$> liftIO getStatsPeakAllocBytes     undo2 <- out $ showDuration time ++ s      old <- liftIO $ readIORef timingOverwrite
src/General/Util.hs view
@@ -20,6 +20,7 @@     trimVersion,     exitFail,     prettyTable,+    getStatsPeakAllocBytes, getStatsCurrentLiveBytes, getStatsDebug,     hackagePackageURL, hackageModuleURL, hackageDeclURL, ghcModuleURL,     minimum', maximum',     general_util_test@@ -48,11 +49,61 @@ import Data.Int import System.IO import System.Exit+import System.Mem+import GHC.Stats import Prelude   -- | A URL, complete with a @https:@ prefix. type URL = String++#if __GLASGOW_HASKELL__ >= 802+#define RTS_STATS 1+#endif++showMb :: (Show a, Integral a) => a -> String+#if RTS_STATS+showMb x = show x ++ "Mb"+#else+showMb x = show (x `mod` (1024*1024)) ++ "Mb"+#endif+++#if RTS_STATS+withRTSStats :: (RTSStats -> a) -> IO (Maybe a)+withRTSStats f = ifM getRTSStatsEnabled (Just . f <$> getRTSStats) (return Nothing)+#else+withGCStats :: (GCStats -> a) -> IO (Maybe a)+withGCStats f = ifM getGCStatsEnabled (Just . f <$> getGCStats) (return Nothing)+#endif++getStatsCurrentLiveBytes :: IO (Maybe String)+getStatsCurrentLiveBytes = do+    performGC+#if RTS_STATS+    withRTSStats $ showMb . gcdetails_live_bytes . gc+#else+    withGCStats $ showMb . currentBytesUsed+#endif++getStatsPeakAllocBytes :: IO (Maybe String)+getStatsPeakAllocBytes = do+#if RTS_STATS+    withRTSStats $ showMb . max_mem_in_use_bytes+#else+    withGCStats $ showMb . peakMegabytesAllocated+#endif++getStatsDebug :: IO (Maybe String)+getStatsDebug = do+    let dump = replace ", " "\n" . takeWhile (/= '}') . drop 1 . dropWhile (/= '{') . show+#if RTS_STATS+    withRTSStats dump+#else+    withGCStats dump+#endif++  exitFail :: String -> IO () exitFail msg = do
src/General/Web.hs view
@@ -1,17 +1,11 @@-{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, CPP, ViewPatterns, RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, ViewPatterns, RecordWildCards #-}  module General.Web(     Input(..), Output(..), readInput, server     ) where --- #define PROFILE---- For some reason, profiling stops working if I import warp--- Tracked as https://github.com/yesodweb/wai/issues/311-#ifndef PROFILE import Network.Wai.Handler.Warp hiding (Port, Handle) import Network.Wai.Handler.WarpTLS-#endif  import Action.CmdLine import Network.Wai.Logger@@ -31,6 +25,7 @@ import System.Time.Extra import General.Log import Network.URI+import Prelude   data Input = Input@@ -59,9 +54,6 @@   server :: Log -> CmdLine -> (Input -> IO Output) -> IO ()-#ifdef PROFILE-server _ _ _ = return ()-#else server log Server{..} act = do     let         host' = fromString $@@ -101,4 +93,3 @@                 OutputHTML msg -> responseLBS status200 [("content-type","text/html")] msg  contentType = [(".html","text/html"),(".css","text/css"),(".js","text/javascript")]-#endif
src/Input/Cabal.hs view
@@ -99,9 +99,9 @@ -- rely on the fact the highest version is last (using lastValues) parseCabalTarball settings tarfile = do     res <- runConduit $-        (sourceList =<< liftIO (tarballReadFiles tarfile)) =$=-        mapC (first takeBaseName) =$= groupOnLastC fst =$= mapMC (\x -> do evaluate $ rnf x; return x) =$=-        pipelineC 10 (mapC (second $ readCabal settings . lstrUnpack) =$= mapMC (\x -> do evaluate $ rnf x; return x) =$= sinkList)+        (sourceList =<< liftIO (tarballReadFiles tarfile)) .|+        mapC (first takeBaseName) .| groupOnLastC fst .| mapMC (\x -> do evaluate $ rnf x; return x) .|+        pipelineC 10 (mapC (second $ readCabal settings . lstrUnpack) .| mapMC (\x -> do evaluate $ rnf x; return x) .| sinkList)     return $ Map.fromList res
src/Input/Download.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE TupleSections #-}-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- Use conduitManagerSettings to work with http-conduit-2.1.6 and below  module Input.Download(downloadInput) where @@ -31,8 +30,8 @@  downloadFile :: Bool -> FilePath -> String -> IO () downloadFile insecure file url = withSocketsDo $ do-    request <- C.parseUrl url+    let request = C.parseRequest_ url     manager <- C.newManager $ C.mkManagerSettings (TLSSettingsSimple insecure False False) Nothing     runResourceT $ do         response <- C.http request manager-        C.responseBody response C.$$ sinkFile file+        C.runConduit $ C.responseBody response C..| sinkFile file
src/Input/Haddock.hs view
@@ -27,10 +27,10 @@ fakePackage name desc = (Just $ Target (hackagePackageURL name) Nothing Nothing "package" (renderPackage name) desc, [IPackage name])  -- | Given a file name (for errors), feed in lines to the conduit and emit either errors or items-parseHoogle :: Monad m => (String -> m ()) -> URL -> LStr -> Producer m (Maybe Target, [Item])-parseHoogle warning url body = sourceLStr body =$= linesCR =$= zipFromC 1 =$= parserC warning =$= hierarchyC url =$= mapC (\x -> rnf x `seq` x)+parseHoogle :: Monad m => (String -> m ()) -> URL -> LStr -> ConduitM i (Maybe Target, [Item]) m ()+parseHoogle warning url body = sourceLStr body .| linesCR .| zipFromC 1 .| parserC warning .| hierarchyC url .| mapC (\x -> rnf x `seq` x) -parserC :: Monad m => (String -> m ()) -> Conduit (Int, Str) m (Target, Entry)+parserC :: Monad m => (String -> m ()) -> ConduitM (Int, Str) (Target, Entry) m () parserC warning = f [] ""     where         f com url = do@@ -60,7 +60,7 @@ reformat = unlines . map strUnpack  -hierarchyC :: Monad m => URL -> Conduit (Target, Entry) m (Maybe Target, [Item])+hierarchyC :: Monad m => URL -> ConduitM (Target, Entry) (Maybe Target, [Item]) m () hierarchyC packageUrl = void $ mapAccumC f (Nothing, Nothing)     where         f (pkg, mod) (t, EPackage x) = ((Just (x, url), Nothing), (Just t{targetURL=url}, [IPackage x]))
src/Input/Settings.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE RecordWildCards, PatternGuards, TemplateHaskell #-}+{-# LANGUAGE RecordWildCards, PatternGuards, TemplateHaskell, CPP #-}   -- | Module for reading settings files.@@ -53,7 +53,12 @@ loadSettings :: IO Settings loadSettings = do     dataDir <- getDataDir+#ifdef PROFILE+    -- profiling and TemplateHaskell don't play well+    let backup = ""+#else     let backup = $(runIO (readFileUTF8 "misc/settings.txt") >>= lift)+#endif     src <- readFileSettings (dataDir </> "misc/settings.txt") backup     return $ createSettings src
src/Output/Items.hs view
@@ -37,7 +37,7 @@  -- write all the URLs, docs and enough info to pretty print it to a result -- and replace each with an identifier (index in the space) - big reduction in memory-writeItems :: StoreWrite -> (Conduit (Maybe Target, item) IO (Maybe TargetId, item) -> IO a) -> IO a+writeItems :: StoreWrite -> (ConduitM (Maybe Target, item) (Maybe TargetId, item) IO () -> IO a) -> IO a writeItems store act = act $ do     void $ (\f -> mapAccumMC f 0) $ \pos (target, item) -> case target of         Nothing -> return (pos, (Nothing, item))