diff --git a/hoogle.cabal b/hoogle.cabal --- a/hoogle.cabal +++ b/hoogle.cabal @@ -1,7 +1,7 @@ cabal-version: >= 1.6 build-type: Simple name: hoogle -version: 4.2.2 +version: 4.2.3 license: GPL license-file: docs/LICENSE category: Development diff --git a/src/CmdLine/Type.hs b/src/CmdLine/Type.hs --- a/src/CmdLine/Type.hs +++ b/src/CmdLine/Type.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} -{-# OPTIONS_GHC -fno-warn-missing-fields #-} +{-# OPTIONS_GHC -fno-warn-missing-fields -fno-cse #-} module CmdLine.Type( CmdLine(..), cmdLineMode, isWebCmdLine, blankSearch diff --git a/src/Hoogle/DataBase/Serialise.hs b/src/Hoogle/DataBase/Serialise.hs --- a/src/Hoogle/DataBase/Serialise.hs +++ b/src/Hoogle/DataBase/Serialise.hs @@ -9,10 +9,11 @@ import General.System import Hoogle.DataBase.Type +import Paths_hoogle(version) +import Data.Version --- FIXME: Has become hard coded, go back to minor version lumps -hooVersion = [4,0,0,5] +hooVersion = take 4 $ map fromIntegral (versionBranch version) ++ [0..] hooString = "HOOG" data Identity = Identity deriving (Show, Typeable) @@ -27,8 +28,8 @@ let showVer = intercalate "." . map show when (vr /= hooVersion) $ - error $ "Wrong hoogle database version: " ++ showVer vr ++ - " found, expected " ++ showVer hooVersion + error $ "Wrong hoogle database version: found " ++ showVer vr ++ ", " ++ + "expected " ++ showVer hooVersion return Identity diff --git a/src/Hoogle/Query/Parser.hs b/src/Hoogle/Query/Parser.hs --- a/src/Hoogle/Query/Parser.hs +++ b/src/Hoogle/Query/Parser.hs @@ -49,7 +49,7 @@ (do xs <- keyword `sepBy1` (char '.') ; spaces return $ case xs of [x] -> mempty{names=[x]} - xs -> mempty{names=[last xs],scope=[PlusModule $ intercalate "." $ init xs]} + xs -> mempty{names=[last xs],scope=[Scope True Module $ intercalate "." $ init xs]} ) operator = between (char '(') (char ')') op <|> op @@ -72,14 +72,10 @@ -- +Module.Name parseFlagScope :: Parser Query parseFlagScope = do - pm <- oneOf "+-" - let aPackage = if pm == '+' then PlusPackage else MinusPackage - aModule = if pm == '+' then PlusModule else MinusModule - modname = keyword `sepBy1` (char '.') - modu <- modname - case modu of - [x] -> return $ mempty{scope=[if isLower (head x) then aPackage x else aModule x]} - xs -> return $ mempty{scope=[aModule $ intercalate "." xs]} + pm <- fmap (== '+') $ oneOf "+-" + modu <- keyword `sepBy1` (char '.') + let typ = case modu of [x] | isLower (head x) -> Package; _ -> Module + return mempty{scope=[Scope pm typ $ intercalate "." modu]} keyword = do diff --git a/src/Hoogle/Query/Render.hs b/src/Hoogle/Query/Render.hs --- a/src/Hoogle/Query/Render.hs +++ b/src/Hoogle/Query/Render.hs @@ -23,10 +23,7 @@ showType = [renderTypeSig $ fromJust $ typeSig x] scp = [Str $ unwords $ map f $ scope x | scope x /= []] - f (PlusPackage x) = "+" ++ x - f (MinusPackage x) = "-" ++ x - f (PlusModule x) = "+" ++ x - f (MinusModule x) = "-" ++ x + f (Scope b _ x) = (if b then "+" else "-") ++ x renderTypeSig :: TypeSig -> TagStr diff --git a/src/Hoogle/Query/Type.hs b/src/Hoogle/Query/Type.hs --- a/src/Hoogle/Query/Type.hs +++ b/src/Hoogle/Query/Type.hs @@ -5,62 +5,7 @@ import General.Base import Hoogle.Type.All -{- -GOALS OF THE QUERY REWRITE: -Query stores enough data to round trip perfectly - -package:foo, module:foo, category:foo all work, all as a shortcut for +package:foo, ... -+package:foo, +package:bar --package:foo, -package:bar -+bar is a shortcut for +package:bar -+Bar is a shortcut for +module:Bar - -Type signatures need extending to contain _, * and ? - all of which mean wildcard - -Need a way to "tweak" type signatures. - -At it's heart, a query is a list of names, a type sig, and a list of scopes, in order. - -Need to augment this with a list of extra information, such that when the extra information -is replayed, it does the same job. - -Should really be [String], Maybe TypeSig, [Scope], those -> - -data QueryInfo = [String] (Maybe TypeSig) [Scope] -data Query = Query QueryInfo (QueryInfo -> String?) - - -"(a -" is assumed to be "(a -> _)" - -"Ord a =" - is assumed to be "Ord a => _" - -"(map > 1)" is total garbage... i think parse errors are still needed - -Should try and autocomplete at the end where possible - -Also need to support OR, AND and NOT. - -Perhaps have a tree: - -data Prop = Or Bool Prop Prop -- True is explicit OR - | And Bool Prop Prop -- True is explicit AND - | Not Bool Prop -- True is explicit NOT, otherwise is a "-" of the one after you - | Module Prefix String -- prefix is a string - "" for Foo.bar, otherwise "+" or "module:" - | Package Prefix String -- prefix is a string, "+" or "package" - | Name String -- just the name - | Type Bool TypeSig -- TypeSig needs extending to be full information, but otherwise the same. True is explicit "::" - | Bracket Prop -- explicit brackets - | Whitespace Int Prop Int -- explicit whitespace on either side - -Can now decompse parts easily and move more logic info the query. Also retain perfect information. - -Name and type searches are done separately and merged. Then traverse the tree applying everything else. - -Will need some pass at the start to decide which databases to use. That needs to impove anyway. --} - - -- | A query, representing a user input. data Query = Query {names :: [String] @@ -74,33 +19,26 @@ mappend (Query x1 x2 x3) (Query y1 y2 y3) = Query (x1++y1) (x2 `mplus` y2) (x3++y3) - -data Scope = PlusPackage String - | MinusPackage String - | PlusModule String - | MinusModule String - deriving (Eq, Show, Read, Data, Typeable) +data Scope = Scope Bool Category String deriving (Data,Typeable,Show,Eq) +data Category = Module | Package deriving (Data,Typeable,Show,Eq) -- | Given a query, return the list of packages that should be searched. Each package will be -- the name of a database, without any file path or extension included. queryDatabases :: Query -> [String] -queryDatabases x = if null ps then ["default"] else ps - where ps = [p | PlusPackage p <- scope x] +queryDatabases q = if null ps then ["default"] else ps + where ps = [p | Scope True Package p <- scope q] -- | Return those packages which are explicitly excluded (paired with 'False') -- or included (paired with 'True') in the query. queryPackages :: Query -> [(Bool, String)] -queryPackages = concatMap f . scope - where f (MinusPackage x) = [(False,x)] - f (PlusPackage x) = [(True ,x)] - f _ = [] +queryPackages q = [(b,s) | Scope b Package s <- scope q] + -- | Set the state of a package within a query. 'Nothing' means delete the package, -- 'Just' 'True' for add it, and 'Just' 'False' for remove it. querySetPackage :: Maybe Bool -> String -> Query -> Query -querySetPackage b x q = q{scope= filter f (scope q) ++ [if b then PlusPackage x else MinusPackage x | Just b <- [b]]} - where f (MinusPackage y) = x /= y - f (PlusPackage y) = x /= y +querySetPackage b x q = q{scope = filter f (scope q) ++ [Scope b Package x | Just b <- [b]]} + where f (Scope _ Package y) = x /= y f _ = True diff --git a/src/Hoogle/Search/Results.hs b/src/Hoogle/Search/Results.hs --- a/src/Hoogle/Search/Results.hs +++ b/src/Hoogle/Search/Results.hs @@ -70,12 +70,8 @@ f [] act = id f xs act = filter (act xs . resultEntry) - mods = filter isMod $ scope q - pkgs = [x | MinusPackage x <- scope q] - - isMod PlusModule{} = True - isMod MinusModule{} = True - isMod _ = False + mods = [x | x@(Scope _ Module _) <- scope q] + pkgs = [x | Scope False Package x <- scope q] -- pkgs is a non-empty list of MinusPackage values @@ -90,11 +86,10 @@ where myMods = map (fmap (map toLower . entryName . fromOnce) . listToMaybe . drop 1 . snd) $ entryLocations x - base = case head mods of MinusModule{} -> True; _ -> False + base = case head mods of Scope False Module _ -> True; _ -> False f z [] y = z - f z (PlusModule x:xs) y | doesMatch (map toLower x) y = f True xs y - f z (MinusModule x:xs) y | doesMatch (map toLower x) y = f False xs y + f z (Scope b Module x:xs) y | doesMatch (map toLower x) y = f b xs y f z (x:xs) y = f z xs y -- match if x is a module starting substring of y diff --git a/src/Recipe/Download.hs b/src/Recipe/Download.hs --- a/src/Recipe/Download.hs +++ b/src/Recipe/Download.hs @@ -12,7 +12,8 @@ createDirectoryIfMissing True "download" wget opt keywords "http://haskell.org/haskellwiki/Keywords" wget opt platform "http://code.galois.com/darcs/haskell-platform/haskell-platform.cabal" - wget opt inputBase "http://haskell.org/hoogle/base.txt" + wget opt "download/base.txt" "http://haskell.org/hoogle/base.txt" + wget opt "download/ghc.txt" "http://www.haskell.org/ghc/docs/latest/html/libraries/ghc/ghc.txt" downloadTarball opt cabals "http://hackage.haskell.org/packages/archive/00-index.tar.gz" downloadTarball opt inputs "http://hackage.haskell.org/packages/archive/00-hoogle.tar.gz" diff --git a/src/Recipe/Hackage.hs b/src/Recipe/Hackage.hs --- a/src/Recipe/Hackage.hs +++ b/src/Recipe/Hackage.hs @@ -45,6 +45,16 @@ makeDefault :: ([Name] -> IO ()) -> [FilePath] -> Name -> IO () +makeDefault make local "ghc" = do + had <- try $ readFileUtf8' "download/ghc.txt" + case had of + Left e -> putWarning $ "Warning: Exception when reading haddock for ghc, " ++ show (e :: SomeException) + Right had -> do + convertSrc make "ghc" $ unlines $ "@depends base" : concatMap f (haddockHacks $ lines had) + where + f x | "@package " `isPrefixOf` x = ["@url http://www.haskell.org/ghc/docs/latest/html/libraries/ghc/",x] + | otherwise = [x] + makeDefault make local name = do let base = name == "base" b1 <- doesDirectoryExist $ cabals name @@ -55,7 +65,7 @@ vc <- version cabals name vh <- if base then return vc else version inputs name when (vc /= vh) $ putStrLn $ "Warning: Version mismatch for " ++ name ++ " (cabal=" ++ vc ++ ", haddock=" ++ vh ++ ")" - let had = if base then inputBase else inputs name vh "doc" "html" name <.> "txt" + let had = if base then "download/base.txt" else inputs name vh "doc" "html" name <.> "txt" cab = cabals name vc name <.> "cabal" had <- try $ readFileUtf8' had case had of diff --git a/src/Recipe/Type.hs b/src/Recipe/Type.hs --- a/src/Recipe/Type.hs +++ b/src/Recipe/Type.hs @@ -1,7 +1,7 @@ module Recipe.Type( CmdLine(..), Name, noDeps, safeEncoding, - keywords, platform, cabals, inputs, inputBase, listing, version, + keywords, platform, cabals, inputs, listing, version, resetWarnings, putWarning, recapWarnings, outStr, outStrLn ) where @@ -33,7 +33,6 @@ platform = "download/haskell-platform.cabal" cabals = "download/hackage-cabal" inputs = "download/hackage-hoogle" -inputBase = "download/base.txt" -- FIXME: Temporary, until base.txt ends up on Hackage listing :: FilePath -> IO [Name] listing dir = do diff --git a/src/Test/Parse_Query.hs b/src/Test/Parse_Query.hs --- a/src/Test/Parse_Query.hs +++ b/src/Test/Parse_Query.hs @@ -23,13 +23,13 @@ "a -> b" === q{typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))} "(a b)" === q{typeSig = Just (TypeSig [] (TApp (TVar "a") [TVar "b"]))} "map :: a -> b" === q{names = ["map"], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))} - "+Data.Map map" === q{scope = [PlusModule "Data.Map"], names = ["map"]} - "a -> b +foo" === q{scope = [PlusPackage "foo"], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))} - "a -> b +foo-bar" === q{scope = [PlusPackage "foo-bar"], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))} - "Data.Map.map" === q{scope = [PlusModule "Data.Map"], names = ["map"]} + "+Data.Map map" === q{scope = [Scope True Module "Data.Map"], names = ["map"]} + "a -> b +foo" === q{scope = [Scope True Package "foo"], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))} + "a -> b +foo-bar" === q{scope = [Scope True Package "foo-bar"], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))} + "Data.Map.map" === q{scope = [Scope True Module "Data.Map"], names = ["map"]} "[a]" === q{typeSig = Just (TypeSig [] (TApp (TLit "[]") [TVar "a"]))} "++" === q{names = ["++"]} "(++)" === q{names = ["++"]} ":+:" === q{names = [":+:"]} - "bytestring-cvs +hackage" === q{scope=[PlusPackage "hackage"], names=["bytestring-cvs"]} + "bytestring-cvs +hackage" === q{scope=[Scope True Package "hackage"], names=["bytestring-cvs"]}