Pull from upstream to make PR easier to merge

ndmitchell · Feb 8, 2024 · 58b5206 · 58b5206
2 parents d548d81 + ee364a4
commit 58b5206
Show file tree

Hide file tree

Showing 13 changed files with 25 additions and 17 deletions.
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
@@ -12,7 +12,7 @@ jobs:
       fail-fast: false
       matrix:
         os: [ubuntu-latest]
-        ghc: ['9.6', '9.4', '9.2', '9.0']
+        ghc: ['9.8', '9.6', '9.4']
         include:
         - os: windows-latest
         - os: macOS-latest

diff --git a/CHANGES.txt b/CHANGES.txt
@@ -1,6 +1,9 @@
 Changelog for Hoogle (* = API change, @ = database format change)
 
 	#411, switched to xdg directory and depracted legacy location
+5.0.18.4, released 2024-01-14
+    Don't test on GHC 9.2 or earlier
+    Fix up the output of /stats to account for API changes
     #380, move results before left anchors in tab focus order
 5.0.18.3, released 2021-12-24
     Compatibility with aeson-2.0

diff --git a/LICENSE b/LICENSE
@@ -1,4 +1,4 @@
-Copyright Neil Mitchell 2004-2023.
+Copyright Neil Mitchell 2004-2024.
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without

diff --git 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) [![Build status](https://img.shields.io/github/workflow/status/ndmitchell/hoogle/ci/master.svg)](https://github.com/ndmitchell/hoogle/actions)
+# 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) [![Build status](https://img.shields.io/github/actions/workflow/status/ndmitchell/hoogle/ci.yml?branch=master)](https://github.com/ndmitchell/hoogle/actions)
 
 Hoogle is a Haskell API search engine, which allows you to search many standard Haskell libraries by either function name, or by approximate type signature. The online version can be found at https://hoogle.haskell.org/ and searches [Stackage](https://www.stackage.org/).
 

diff --git a/hoogle.cabal b/hoogle.cabal
@@ -1,21 +1,21 @@
-cabal-version:      >= 1.18
+cabal-version:      1.18
 build-type:         Simple
 name:               hoogle
-version:            5.0.18.3
+version:            5.0.18.4
 license:            BSD3
 license-file:       LICENSE
 category:           Development
 author:             Neil Mitchell <[email protected]>
 maintainer:         Neil Mitchell <[email protected]>
-copyright:          Neil Mitchell 2004-2023
+copyright:          Neil Mitchell 2004-2024
 synopsis:           Haskell API Search
 description:
     Hoogle is a Haskell API search engine, which allows you to
     search many standard Haskell libraries by either function name,
     or by approximate type signature.
 homepage:           https://hoogle.haskell.org/
 bug-reports:        https://github.com/ndmitchell/hoogle/issues
-tested-with:        GHC==9.6, GHC==9.4, GHC==9.2, GHC==9.0
+tested-with:        GHC==9.8, GHC==9.6, GHC==9.4
 extra-doc-files:
     README.md
     CHANGES.txt
@@ -69,6 +69,7 @@ library
         mmap,
         process-extras,
         resourcet,
+        safe >= 0.3.20,
         storable-tuple,
         tar,
         template-haskell,

diff --git a/html/index.html b/html/index.html
@@ -33,6 +33,6 @@
 <div id="body">
 #{body}
         </div>
-        <div id="footer">&copy; <a href="http://ndmitchell.com">Neil Mitchell</a> 2004-2023, version #{version}</div>
+        <div id="footer">&copy; <a href="http://ndmitchell.com">Neil Mitchell</a> 2004-2024, version #{version}</div>
     </body>
 </html>
diff --git a/src/Action/Search.hs b/src/Action/Search.hs
@@ -20,6 +20,7 @@ import Data.Maybe
 import qualified Data.Set as Set
 import System.Directory
 import Text.Blaze.Renderer.Utf8
+import Safe
 
 import Action.CmdLine
 import General.Store
@@ -47,7 +48,7 @@ actionSearch Search{..} = replicateM_ repeat_ $ -- deliberately reopen the datab
             if null res then
                 putStrLn "No results found"
              else if info then do
-                 putStr $ targetInfo $ head res
+                 putStr $ targetInfo $ headErr res
              else do
                 let toShow = if numbers && not info then addCounter shown else shown
                 if | json -> LBS.putStrLn $ JSON.encode $ maybe id take count $ map unHTMLtargetItem res

diff --git a/src/Action/Server.hs b/src/Action/Server.hs
@@ -143,7 +143,7 @@ replyServer log local links haddock store cdn home htmlDir scope Input{..} = cas
         stats <- getStatsDebug
         pure $ case stats of
             Nothing -> OutputFail $ lbstrPack "GHC Statistics is not enabled, restart with +RTS -T"
-            Just x -> OutputText $ lbstrPack $ replace ", " "\n" $ takeWhile (/= '}') $ drop1 $ dropWhile (/= '{') $ show x
+            Just x -> OutputText $ lbstrPack x
     "haddock":xs | Just x <- haddock -> do
         let file = intercalate "/" $ x:xs
         pure $ OutputFile $ file ++ (if hasTrailingPathSeparator file then "index.html" else "")

diff --git a/src/General/Log.hs b/src/General/Log.hs
@@ -23,6 +23,7 @@ import General.Util
 import Data.Maybe
 import Data.List
 import Data.IORef.Extra
+import Safe
 import Prelude
 
 
@@ -97,8 +98,8 @@ instance Semigroup SummaryI where
     SummaryI x1 x2 x3 x4 x5 <> SummaryI y1 y2 y3 y4 y5 =
         SummaryI (f x1 y1) (x2+y2) (max x3 y3) (x4 <> y4) (x5+y5)
         -- more efficient union for the very common case of a single element
-        where f x y | Set.size x == 1 = Set.insert (head $ Set.toList x) y
-                    | Set.size y == 1 = Set.insert (head $ Set.toList y) x
+        where f x y | Set.size x == 1 = Set.insert (headErr $ Set.toList x) y
+                    | Set.size y == 1 = Set.insert (headErr $ Set.toList y) x
                     | otherwise = Set.union x y
 
 instance Monoid SummaryI where

diff --git a/src/Input/Cabal.hs b/src/Input/Cabal.hs
@@ -126,8 +126,8 @@ readCabal Settings{..} src = Package{..}
         packageDocs = find (not . null) $ ask "haddock-html"
 
         packageTags = map (both strPack) $ nubOrd $ concat
-            [ map (head xs,) $ concatMap cleanup $ concatMap ask xs
-            | xs <- [["license"],["category"],["author","maintainer"]]]
+            [ map (x,) $ concatMap cleanup $ concatMap ask xs
+            | xs@(x:_) <- [["license"],["category"],["author","maintainer"]]]
 
         -- split on things like "," "&" "and", then throw away email addresses, replace spaces with "-" and rename
         cleanup =

diff --git a/src/Input/Haddock.hs b/src/Input/Haddock.hs
@@ -16,6 +16,7 @@ import Control.Monad.Extra
 import Control.Exception.Extra
 import Data.Generics.Uniplate.Data
 import General.Str
+import Safe
 
 
 -- | An entry in the Hoogle DB
@@ -109,7 +110,7 @@ renderItem = keyword . focus
         focus (EPackage x) = renderPackage x
         focus (EDecl x) | [now] <- declNames x, (pre,stripPrefix now -> Just post) <- breakOn now $ pretty x =
             if "(" `isSuffixOf` pre && ")" `isPrefixOf` post then
-                init (escapeHTML pre) ++ name ("(" ++ highlight now ++ ")") ++ escapeHTML (tail post)
+                init (escapeHTML pre) ++ name ("(" ++ highlight now ++ ")") ++ escapeHTML (tailErr post)
             else
                 escapeHTML pre ++ name (highlight now) ++ escapeHTML post
         focus (EDecl x) = pretty x

diff --git a/src/Output/Types.hs b/src/Output/Types.hs
@@ -33,6 +33,7 @@ import Numeric.Extra
 import Prelude
 import System.FilePath
 import System.IO.Extra
+import Safe
 
 import General.IString
 import General.Store
@@ -54,7 +55,7 @@ writeTypes store debug xs = do
 searchTypes :: StoreRead -> Sig String -> [TargetId]
 searchTypes store q =
     take nMatches (concat [ search fps qry' | variantClass <- variants
-                                            , fpSig <- case head variantClass qry of
+                                            , fpSig <- case headErr variantClass qry of
                                                           (f:_) -> [f]
                                                           []    -> []
                                             , let fps = bestByFingerprint db nMatches fpSig

diff --git a/travis.hs b/travis.hs
@@ -8,7 +8,7 @@ main :: IO ()
 main = do
     let timed x = do
             putStrLn $ "\n\nSearching for " ++ x
-            (time,_) <- duration $ system_ $ "hoogle +RTS -T -M1.8G -K2000K -RTS " ++ show x
+            (time,_) <- duration $ system_ $ "hoogle +RTS -T -M2G -K10M -RTS " ++ show x
             putStrLn $ "Search " ++ show x ++ " took " ++ showDuration time
             putStrLn "\n\n"
     retry 3 $ timed "generate" >> sleep 10