diff --git a/CHANGES.txt b/CHANGES.txt --- a/CHANGES.txt +++ b/CHANGES.txt @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/hoogle.cabal b/hoogle.cabal --- a/hoogle.cabal +++ b/hoogle.cabal @@ -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 diff --git a/html/hoogle.css b/html/hoogle.css --- a/html/hoogle.css +++ b/html/hoogle.css @@ -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;} diff --git a/html/hoogle.js b/html/hoogle.js --- a/html/hoogle.js +++ b/html/hoogle.js @@ -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]; diff --git a/html/index.html b/html/index.html --- a/html/index.html +++ b/html/index.html @@ -26,7 +26,7 @@ - + diff --git a/src/Action/CmdLine.hs b/src/Action/CmdLine.hs --- a/src/Action/CmdLine.hs +++ b/src/Action/CmdLine.hs @@ -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)" diff --git a/src/Action/Server.hs b/src/Action/Server.hs --- a/src/Action/Server.hs +++ b/src/Action/Server.hs @@ -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 $ ["

" ++ renderQuery query ++ "

" ,""] ++ ["

No results found

" | null results] ++ ["
" ++ - "
" ++ displayItem query targetItem ++ "
" ++ - "
" ++ showFroms local haddock is ++ "
" ++ + "
" ++ + "" ++ displayItem query targetItem ++ "" ++ + (if not links then "" else "
Uses
") ++ + "
" ++ + "
" ++ showFroms local haddock is ++ "
" ++ "
" ++ targetDocs ++ "
" ++ "
" | 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 ++ "" +-- find the X bit +extractName :: String -> String +extractName x + | Just (_, x) <- stripInfix "" x + , Just (x, _) <- stripInfix "" 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" === "type family" diff --git a/src/General/Log.hs b/src/General/Log.hs --- a/src/General/Log.hs +++ b/src/General/Log.hs @@ -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] diff --git a/src/General/Util.hs b/src/General/Util.hs --- a/src/General/Util.hs +++ b/src/General/Util.hs @@ -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])