hoogle 5.0.17.5 → 5.0.17.6

raw patch · 10 files changed

+87/−36 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES.txt +5/−0
• README.md +2/−2
• hoogle.cabal +2/−2
• html/hoogle.css +9/−0
• html/hoogle.js +5/−3
• html/index.html +1/−1
• src/Action/CmdLine.hs +2/−0
• src/Action/Server.hs +30/−11
• src/General/Log.hs +25/−11
• src/General/Util.hs +6/−6

@@ -1,5 +1,10 @@ Changelog for Hoogle (* = breaking change) +5.0.17.6, released 2019-03-27+    #291, optimise the log parsing (5x speedup)+    #289, change to use autofocus attribute+    Add --links flag to integrate with https://codesearch.aelve.com/+    Remove warning about type search 5.0.17.5, released 2019-01-27 *   #285, remove accidental API break in 5.0.17.4     Lots of improvements in type search

@@ -1,4 +1,4 @@-# Hoogle [![Hackage version](https://img.shields.io/hackage/v/hoogle.svg?label=Hackage)](https://hackage.haskell.org/package/hoogle) [![Stackage version](https://www.stackage.org/package/hoogle/badge/nightly?label=Stackage)](https://www.stackage.org/package/hoogle) [![Linux Build Status](https://img.shields.io/travis/ndmitchell/hoogle/master.svg?label=Linux%20build)](https://travis-ci.org/ndmitchell/hoogle) [![Windows Build Status](https://img.shields.io/appveyor/ci/ndmitchell/hoogle/master.svg?label=Windows%20build)](https://ci.appveyor.com/project/ndmitchell/hoogle)+# Hoogle [![Hackage version](https://img.shields.io/hackage/v/hoogle.svg?label=Hackage)](https://hackage.haskell.org/package/hoogle) [![Stackage version](https://www.stackage.org/package/hoogle/badge/nightly?label=Stackage)](https://www.stackage.org/package/hoogle) [![Linux build status](https://img.shields.io/travis/ndmitchell/hoogle/master.svg?label=Linux%20build)](https://travis-ci.org/ndmitchell/hoogle) [![Windows build status](https://img.shields.io/appveyor/ci/ndmitchell/hoogle/master.svg?label=Windows%20build)](https://ci.appveyor.com/project/ndmitchell/hoogle)  ## Hoogle 4 vs Hoogle 5 @@ -116,7 +116,7 @@  # Background -Hoogle work is licensed under the [GPL version 2.0](https://github.com/ndmitchell/hoogle/blob/master/docs/LICENSE). Any patches are assumed to be dual licensed under the BSD license and the GPL, to allow re-licensing Hoogle under the BSD license in future, if that proves beneficial to the Haskell community. The work is intended to be helpful, open and free. If the license doesn't meet your needs then talk to me.+Hoogle work is licensed under the [BSD-3-Clause license](https://github.com/ndmitchell/hoogle/blob/master/docs/LICENSE).  ## Theoretical Foundations 

@@ -1,7 +1,7 @@ cabal-version:      >= 1.18 build-type:         Simple name:               hoogle-version:            5.0.17.5+version:            5.0.17.6 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.6.3, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2+tested-with:        GHC==8.6.4, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 extra-doc-files:     README.md     CHANGES.txt

@@ -262,6 +262,15 @@     color: #C4451D; } +.links {+    float: right;+    color: #CCCCCC;+}+.links a {+    color: #888;+    font-size: 12px;+}+ .c0{background-color: #fcc;} .c1{background-color: #cfc;} .c2{background-color: #ccf;}

@@ -72,7 +72,10 @@      function hit(){         if (!instant) return;-        function getScope(){return $scope && $scope.val() !== "set:stackage" ? $scope.val() : "";}+        function getScope(){+            var v = $scope ? $scope.val() : "";+            return v == null || v == "set:stackage" ? "" : v;+        }          var nowHoogle = $hoogle.val();         var nowScope = getScope();@@ -130,7 +133,6 @@  function newReal() {-    $hoogle.focus();     $hoogle.select();     var $body = $("#body"); @@ -381,7 +383,7 @@         {             contents["#" + key] = val;         },-        +         ask: function(key)         {             return contents["#" + key];

@@ -26,7 +26,7 @@     <a id="logo" href="#{home}">         <img src="#{cdn}hoogle.png" width="160" height="58" alt="Hoogle"     /></a>-    <input name="hoogle" id="hoogle" class="HOOGLE_REAL" type="text" autocomplete="off" accesskey="1" placeholder="Search for..." value="#{search}" />+    <input name="hoogle" id="hoogle" class="HOOGLE_REAL" type="text" autocomplete="off" autofocus="autofocus" accesskey="1" placeholder="Search for..." value="#{search}" />     <select name="scope" id="scope" data-live-search="true">#{tags}</select>     <input id="submit" type="submit" value="Search" /> </form>

@@ -50,6 +50,7 @@         ,logs :: FilePath         ,local :: Bool         ,haddock :: Maybe FilePath+        ,links :: Bool         ,language :: Language         ,scope :: String         ,home :: String@@ -134,6 +135,7 @@     ,local = False &= help "Allow following file:// links, restricts to 127.0.0.1  Set --host explicitely (including to '*' for any host) to override the localhost-only behaviour"     ,haddock = def &= help "Serve local haddocks from a specified directory"     ,scope = def &= help "Default scope to start with"+    ,links = def &= help "Display extra links"     ,home = "http://hoogle.haskell.org" &= typ "URL" &= help "Set the URL linked to by the Hoogle logo."     ,host = "" &= help "Set the host to bind on (e.g., an ip address; '!4' for ipv4-only; '!6' for ipv6-only; default: '*' for any host)."     ,https = def &= help "Start an https server (use --cert and --key to specify paths to the .pem files)"

@@ -14,8 +14,10 @@ import Paths_hoogle import Data.Maybe import Control.Monad+import Text.Read import System.IO.Extra import General.Str+import qualified Data.ByteString.Char8 as BS import qualified Data.Map as Map import System.Time.Extra import Data.Time.Clock@@ -49,7 +51,7 @@     putStr "Reading log..." >> hFlush stdout     time <- offsetTime     log <- logCreate (if logs == "" then Left stdout else Right logs) $-        \x -> "hoogle=" `isInfixOf` x && not ("is:ping" `isInfixOf` x)+        \x -> BS.pack "hoogle=" `BS.isInfixOf` x && not (BS.pack "is:ping" `BS.isInfixOf` x)     putStrLn . showDuration =<< time     evaluate spawned     dataDir <- case datadir of@@ -57,7 +59,7 @@         Nothing -> getDataDir     haddock <- maybe (return Nothing) (fmap Just . canonicalizePath) haddock     withSearch database $ \store ->-        server log cmd $ replyServer log local haddock store cdn home (dataDir </> "html") scope+        server log cmd $ replyServer log local links haddock store cdn home (dataDir </> "html") scope  actionReplay :: CmdLine -> IO () actionReplay Replay{..} = withBuffering stdout NoBuffering $ do@@ -66,7 +68,7 @@     (t,_) <- duration $ withSearch database $ \store -> do         log <- logNone         dataDir <- getDataDir-        let op = replyServer log False Nothing store "" "" (dataDir </> "html") scope+        let op = replyServer log False False Nothing store "" "" (dataDir </> "html") scope         replicateM_ repeat_ $ forM_ qs $ \x -> do             res <- op x             evaluate $ rnf res@@ -77,8 +79,8 @@ spawned :: UTCTime spawned = unsafePerformIO getCurrentTime -replyServer :: Log -> Bool -> Maybe FilePath -> StoreRead -> String -> String -> FilePath -> String -> Input -> IO Output-replyServer log local haddock store cdn home htmlDir scope Input{..} = case inputURL of+replyServer :: Log -> Bool -> Bool -> Maybe FilePath -> StoreRead -> String -> String -> FilePath -> String -> Input -> IO Output+replyServer log local links haddock store cdn home htmlDir scope Input{..} = case inputURL of     -- without -fno-state-hack things can get folded under this lambda     [] -> do         let grab name = [x | (a,x) <- inputArgs, a == name, x /= ""]@@ -86,7 +88,7 @@         let qSource = grab "hoogle" ++ filter (/= "set:stackage") qScope         let q = concatMap parseQuery qSource         let (q2, results) = search store q-        let body = showResults local haddock (filter ((/= "mode") . fst) inputArgs) q2 $+        let body = showResults local links haddock (filter ((/= "mode") . fst) inputArgs) q2 $                 dedupeTake 25 (\t -> t{targetURL="",targetPackage=Nothing, targetModule=Nothing}) results         case lookup "mode" $ reverse inputArgs of             Nothing | qSource /= [] -> fmap OutputHTML $ templateRender templateIndex $ map (second str)@@ -170,8 +172,8 @@             where k = key x  -showResults :: Bool -> Maybe FilePath -> [(String, String)] -> [Query] -> [[Target]] -> String-showResults local haddock args query results = unlines $+showResults :: Bool -> Bool -> Maybe FilePath -> [(String, String)] -> [Query] -> [[Target]] -> String+showResults local links haddock args query results = unlines $     ["<h1>" ++ renderQuery query ++ "</h1>"     ,"<ul id=left>"     ,"<li><b>Packages</b></li>"] ++@@ -179,12 +181,20 @@     ["</ul>"] ++     ["<p>No results found</p>" | null results] ++     ["<div class=result>" ++-     "<div class=ans><a href=\"" ++ showURL local haddock targetURL ++ "\">" ++ displayItem query targetItem ++ "</a></div>" ++-     "<div class=from>" ++ showFroms local haddock is  ++ "</div>" +++     "<div class=ans>" +++        "<a href=\"" ++ showURL local haddock targetURL ++ "\">" ++ displayItem query targetItem ++ "</a>" +++        (if not links then "" else "<div class=links><a href='" ++ useLink is ++ "'>Uses</a></div>") +++     "</div>" +++     "<div class=from>" ++ showFroms local haddock is ++ "</div>" ++      "<div class=\"doc newline shut\">" ++ targetDocs ++ "</div>" ++      "</div>"     | is@(Target{..}:_) <- results]     where+        useLink ts@(t:_)=+            "https://codesearch.aelve.com/haskell/search?query=" ++ escapeURL (extractName $ targetItem t) +++            "&filter=" ++ intercalate "|" (mapMaybe (fmap fst . targetModule) ts) +++            "&precise=on"+         add x = escapeHTML $ ("?" ++) $ intercalate "&" $ map (joinPair "=") $             case break ((==) "hoogle" . fst) args of                 (a,[]) -> a ++ [("hoogle",x)]@@ -195,6 +205,15 @@                     (if cat == "package" then "" else cat ++ ":") ++ val ++ "</a>"  +-- find the <span class=name>X</span> bit+extractName :: String -> String+extractName x+    | Just (_, x) <- stripInfix "<span class=name>" x+    , Just (x, _) <- stripInfix "</span>" x+    = unHTML x+extractName x = x++ itemCategories :: [Target] -> [(String,String)] itemCategories xs =     [("is","exact")] ++@@ -259,7 +278,7 @@         log <- logNone         dataDir <- getDataDir         let q === want = do-                OutputHTML (lbstrUnpack -> res) <- replyServer log False Nothing store "" "" (dataDir </> "html") "" (Input [] [("hoogle",q)])+                OutputHTML (lbstrUnpack -> res) <- replyServer log False False Nothing store "" "" (dataDir </> "html") "" (Input [] [("hoogle",q)])                 if want `isInfixOf` res then putChar '.' else fail $ "Bad substring: " ++ res         if sample then             "Wife" === "<b>type family</b>"

@@ -17,6 +17,7 @@ import qualified Data.IntSet as Set import qualified Data.Map.Strict as Map import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.ByteString.Char8 as BS import Data.Semigroup import General.Util import Data.Maybe@@ -37,7 +38,7 @@ logNone :: IO Log logNone = do ref <- newIORef Map.empty; return $ Log Nothing ref (const False) -logCreate :: Either Handle FilePath -> (String -> Bool) -> IO Log+logCreate :: Either Handle FilePath -> (BS.ByteString -> Bool) -> IO Log logCreate store interesting = do     (h, old) <- case store of         Left h -> return (h, Map.empty)@@ -45,13 +46,13 @@             b <- doesFileExist file             mp <- if not b then return Map.empty else withFile file ReadMode $ \h -> do                 src <- LBS.hGetContents h-                let xs = mapMaybe (parseLogLine interesting) $ LBS.lines src+                let xs = mapMaybe (parseLogLine interesting . LBS.toStrict) $ LBS.lines src                 return $! foldl' (\mp (k,v) -> Map.alter (Just . maybe v (<> v)) k mp) Map.empty xs             (,mp) <$> openFile file AppendMode     hSetBuffering h LineBuffering     var <- newVar h     ref <- newIORef old-    return $ Log (Just var) ref interesting+    return $ Log (Just var) ref (interesting . BS.pack)  logAddMessage :: Log -> String -> IO () logAddMessage Log{..} msg = do@@ -109,20 +110,33 @@  -- This noinline solves a massive memory leak at -O2, and I have no idea why {-# NOINLINE parseLogLine #-}-parseLogLine :: (String -> Bool) -> LBS.ByteString -> Maybe (Day, SummaryI)-parseLogLine interesting (LBS.words -> time:user:dur:query:err)-    | user /= LBS.pack "-"-    , Just [a, b, c] <- fmap (map fst) $ mapM LBS.readInt $ LBS.split '-' $ LBS.takeWhile (/= 'T') time+parseLogLine :: (BS.ByteString -> Bool) -> BS.ByteString -> Maybe (Day, SummaryI)+parseLogLine interesting (BS.words -> time:user:dur:query:err)+    | use && not isErr+    , user /= BS.singleton '-'+    , Just [a, b, c] <- fmap (map fst) $ mapM BS.readInt $ BS.split '-' $ BS.takeWhile (/= 'T') time     = Just (fromGregorian (fromIntegral a) b c, SummaryI         (if use then Set.singleton $ hash user else Set.empty)         (if use then 1 else 0)         (if use then dur2 else 0)         (toAverage $ if use then dur2 else 0)-        (if [LBS.pack "ERROR:"] `isPrefixOf` err then 1 else 0))-    where use = interesting $ LBS.unpack query-          dur2 = let s = LBS.unpack dur in fromMaybe 0 $-                 if '.' `elem` s then readMaybe s else (/ 1000) . intToDouble <$> readMaybe s+        (if isErr then 1 else 0))+    where use = interesting query+          isErr = [BS.pack "ERROR:"] `isPrefixOf` err+          dur2 = parseDuration dur parseLogLine _ _ = Nothing++-- Hoogle used to store whole numbers of milliseconds, then it switched to 4dp doubles with a guaranteed '.'+parseDuration :: BS.ByteString -> Double+parseDuration x+    | Just (whole, x) <- BS.readInt x+    = case BS.uncons x of+        Just ('.', x)+            | Just (frac, y) <- BS.readInt x+                -> intToDouble whole + (intToDouble frac / (10 ^ (BS.length x - BS.length y)))+            | otherwise -> 0+        _ -> intToDouble whole / 1000+parseDuration _ = 0   logSummary :: Log -> IO [Summary]

@@ -13,10 +13,10 @@     strict,     withs,     escapeHTML, unescapeHTML, unHTML, tag, tag_,+    escapeURL,     takeSortOn,     Average, toAverage, fromAverage,     inRanges,-    readMaybe,     parseTrailingVersion,     trimVersion,     exitFail,@@ -213,6 +213,11 @@ unHTML :: String -> String unHTML = unescapeHTML . innerTextHTML +escapeURL :: String -> String+escapeURL = concatMap $ \x ->+    if (isAscii x && isAlphaNum x) || x `elem` "-_.~" then [x]+    else '%' : showHex (ord x) ""+ isUpper1 (x:xs) = isUpper x isUpper1 _ = False @@ -287,11 +292,6 @@ instance Num a => Monoid (Average a) where     mempty = Average 0 0     mappend = (<>)---readMaybe :: Read a => String -> Maybe a-readMaybe s | [x] <- [x | (x,t) <- reads s, ("","") <- lex t] = Just x-            | otherwise = Nothing   data TakeSort k v = More !Int !(Map.Map k [v])