hoogle 4.2.2 → 4.2.3

raw patch · 11 files changed

+44/−107 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hoogle.cabal +1/−1
• src/CmdLine/Type.hs +1/−1
• src/Hoogle/DataBase/Serialise.hs +5/−4
• src/Hoogle/Query/Parser.hs +5/−9
• src/Hoogle/Query/Render.hs +1/−4
• src/Hoogle/Query/Type.hs +8/−70
• src/Hoogle/Search/Results.hs +4/−9
• src/Recipe/Download.hs +2/−1
• src/Recipe/Hackage.hs +11/−1
• src/Recipe/Type.hs +1/−2
• src/Test/Parse_Query.hs +5/−5

@@ -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

@@ -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

@@ -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  

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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" 

@@ -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

@@ -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

@@ -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"]}