hoogle 4.2.23 → 4.2.24

raw patch · 15 files changed

+184/−211 lines, 15 filesdep −HUnitdep −hoogledep −hspec

Dependencies removed: HUnit, hoogle, hspec, hspec-expectations, system-fileio

Files

• datadir/resources/search.xml +2/−2
• hoogle.cabal +7/−15
• src/Console/All.hs +3/−4
• src/Console/Test.hs +1/−0
• src/Data/Heap.hs +0/−75
• src/Data/TypeMap.hs +0/−41
• src/General/Heap.hs +75/−0
• src/General/TypeMap.hs +41/−0
• src/General/Web.hs +11/−0
• src/Hoogle/DataBase/TypeSearch/Graphs.hs +1/−1
• src/Recipe/Download.hs +2/−2
• src/Recipe/Keyword.hs +8/−7
• src/Test.hs +23/−0
• src/Web/Server.hs +10/−1
• test/HoogleSpec.hs +0/−63

@@ -11,8 +11,8 @@     <Url type="text/html" template="http://haskell.org/hoogle/?hoogle={searchTerms}"/>     <Url type="application/x-suggestions+json" template="http://haskell.org/hoogle/?hoogle={searchTerms}&amp;mode=suggest"/> -    <Image height="16" width="16" type="image/png">http://haskell.org/hoogle/datadir/resources/favicon.png</Image>-    <Image height="64" width="64" type="image/png">http://haskell.org/hoogle/datadir/resources/favicon64.png</Image>+    <Image height="16" width="16" type="image/png">http://haskell.org/hoogle/res/favicon.png</Image>+    <Image height="64" width="64" type="image/png">http://haskell.org/hoogle/res/favicon64.png</Image>     <Developer>Neil Mitchell</Developer>     <AdultContent>false</AdultContent>     <Language>en-us</Language>

@@ -1,7 +1,7 @@ cabal-version:      >= 1.10 build-type:         Simple name:               hoogle-version:            4.2.23+version:            4.2.24 license:            BSD3 license-file:       docs/LICENSE category:           Development@@ -15,7 +15,7 @@     or by approximate type signature. homepage:           http://www.haskell.org/hoogle/ bug-reports:        https://github.com/ndmitchell/hoogle/issues-stability:          Beta+tested-with:        GHC==7.6.3, GHC==7.4.2 extra-source-files: README.txt                     datadir/*.txt @@ -72,8 +72,8 @@         Hoogle.Language.Haskell      other-modules:-        Data.Heap-        Data.TypeMap+        General.Heap+        General.TypeMap         General.Base         General.System         General.Util@@ -172,17 +172,9 @@         Web.Template  test-suite hoogle-test-    main-is: HoogleSpec.hs-    hs-source-dirs: test+    main-is: Test.hs+    hs-source-dirs: src     default-language: Haskell98      type: exitcode-stdio-1.0-    build-depends:-        base >=3,-        hoogle,-        conduit >= 0.2,-        system-fileio >= 0.3.11,-        transformers >= 0.2,-        HUnit >= 1.2.5,-        hspec >= 1.4.4,-        hspec-expectations >= 0.3+    build-depends: base >= 3, process, directory, filepath

@@ -29,10 +29,9 @@ action (Test files _) = do     testPrepare     fails <- fmap sum $ mapM (testFile action) files-    putStrLn $-      if fails == 0-        then "Tests passed"-        else "TEST FAILURES (" ++ show fails ++ ")"+    if fails == 0 then putStrLn "Tests passed" else do+        putStrLn $ "TEST FAILURES (" ++ show fails ++ ")"+        exitFailure  action (Rank file) = rank file 

@@ -22,6 +22,7 @@     putStrLn "Converting testdata"     performGC -- clean up the databases     dat <- getDataDir+    createDirectoryIfMissing True $ dat </> "databases"     src <- readFileUtf8 $ dat </> "testdata.txt"     let (errs, dbOld) = createDatabase Haskell [] src     unless (null errs) $ error $ unlines $ "Couldn't convert testdata database:" : map show errs

@@ -1,75 +0,0 @@--module Data.Heap(-    Heap, empty,-    fromList, toList, elems,-    singleton,-    insert, insertList,-    pop, popUntil, popWhile-    ) where--import Prelude-import qualified Data.Map as Map----- (k,v) pairs are stored in reverse order--newtype Heap k v = Heap (Map.Map k [(k,v)])--empty :: Heap k v-empty = Heap Map.empty---fromList :: Ord k => [(k,v)] -> Heap k v-fromList xs = insertList xs empty---toList :: Heap k v -> [(k,v)]-toList (Heap mp) = concatMap reverse $ Map.elems mp---elems :: Heap k v -> [v]-elems (Heap mp) = concatMap (reverse . map snd) $ Map.elems mp---singleton :: Ord k => k -> v -> Heap k v-singleton k v = insert k v empty----- insert a value with a cost, does NOT overwrite values-insert :: Ord k => k -> v -> Heap k v -> Heap k v-insert k v (Heap xs) = Heap $ Map.insertWith (++) k [(k,v)] xs---insertList :: Ord k => [(k,v)] -> Heap k v -> Heap k v-insertList xs mp = foldr (uncurry insert) mp xs----- retrieve the lowest value (can use minView in the future)--- does NOT guarantee to be the first one inserted at that level-pop :: Ord k => Heap k v -> Maybe ((k,v), Heap k v)-pop (Heap mp) | Map.null mp = Nothing-              | null kvs    = Just ((k1,v1), Heap mp2)-              | otherwise   = Just ((k1,v1), Heap $ Map.insert k kvs mp2)-    where-        ((k,(k1,v1):kvs),mp2) = Map.deleteFindMin mp----- until you reach this key, do not pop those at this key--- guarantees to return by order, then insertion time-popUntil :: Ord k => k -> Heap k v -> ([v], Heap k v)-popUntil x = popBy (< x)----- until you reach this key, and then pop those at this key--- guarantees to return by order, then insertion time-popWhile :: Ord k => k -> Heap k v -> ([v], Heap k v)-popWhile x = popBy (<= x)---popBy :: Ord k => (k -> Bool) -> Heap k v -> ([v], Heap k v)-popBy cmp (Heap mp)-    | Map.null mp || not (cmp k) = ([], Heap mp)-    | otherwise = (reverse (map snd kvs) ++ res, mp3)-        where-            ((k,kvs),mp2) = Map.deleteFindMin mp-            (res,mp3) = popBy cmp (Heap mp2)

@@ -1,41 +0,0 @@-{-# LANGUAGE CPP #-}--module Data.TypeMap(-    TypeMap, empty,-    lookup, insert, find-    ) where--import Prelude hiding (lookup)-import Data.Dynamic-import Data.Maybe-import qualified Data.Map as Map--newtype TypeMap = TypeMap (Map.Map TypeRep Dynamic)---empty :: TypeMap-empty = TypeMap Map.empty---lookup :: Typeable a => TypeMap -> Maybe a-lookup (TypeMap mp) = res-    where res = fmap (fromJust . fromDynamic) $ Map.lookup (typeOf $ fromJust res) mp---find :: Typeable a => TypeMap -> a-find mp = res-    where res = fromMaybe (error msg) $ lookup mp-          msg = "Data.TypeMap.find, couldn't find " ++ show (typeOf res)---insert :: Typeable a => a -> TypeMap -> TypeMap-insert a (TypeMap mp) = TypeMap $ Map.insert (typeOf a) (toDyn a) mp---#if __GLASGOW_HASKELL__ < 702-instance Ord TypeRep where-    compare a b = compare (splitTyConApp a) (splitTyConApp b)--instance Ord TyCon where-    compare a b = compare (tyConString a) (tyConString b)-#endif

@@ -0,0 +1,75 @@++module General.Heap(+    Heap, empty,+    fromList, toList, elems,+    singleton,+    insert, insertList,+    pop, popUntil, popWhile+    ) where++import Prelude+import qualified Data.Map as Map+++-- (k,v) pairs are stored in reverse order++newtype Heap k v = Heap (Map.Map k [(k,v)])++empty :: Heap k v+empty = Heap Map.empty+++fromList :: Ord k => [(k,v)] -> Heap k v+fromList xs = insertList xs empty+++toList :: Heap k v -> [(k,v)]+toList (Heap mp) = concatMap reverse $ Map.elems mp+++elems :: Heap k v -> [v]+elems (Heap mp) = concatMap (reverse . map snd) $ Map.elems mp+++singleton :: Ord k => k -> v -> Heap k v+singleton k v = insert k v empty+++-- insert a value with a cost, does NOT overwrite values+insert :: Ord k => k -> v -> Heap k v -> Heap k v+insert k v (Heap xs) = Heap $ Map.insertWith (++) k [(k,v)] xs+++insertList :: Ord k => [(k,v)] -> Heap k v -> Heap k v+insertList xs mp = foldr (uncurry insert) mp xs+++-- retrieve the lowest value (can use minView in the future)+-- does NOT guarantee to be the first one inserted at that level+pop :: Ord k => Heap k v -> Maybe ((k,v), Heap k v)+pop (Heap mp) | Map.null mp = Nothing+              | null kvs    = Just ((k1,v1), Heap mp2)+              | otherwise   = Just ((k1,v1), Heap $ Map.insert k kvs mp2)+    where+        ((k,(k1,v1):kvs),mp2) = Map.deleteFindMin mp+++-- until you reach this key, do not pop those at this key+-- guarantees to return by order, then insertion time+popUntil :: Ord k => k -> Heap k v -> ([v], Heap k v)+popUntil x = popBy (< x)+++-- until you reach this key, and then pop those at this key+-- guarantees to return by order, then insertion time+popWhile :: Ord k => k -> Heap k v -> ([v], Heap k v)+popWhile x = popBy (<= x)+++popBy :: Ord k => (k -> Bool) -> Heap k v -> ([v], Heap k v)+popBy cmp (Heap mp)+    | Map.null mp || not (cmp k) = ([], Heap mp)+    | otherwise = (reverse (map snd kvs) ++ res, mp3)+        where+            ((k,kvs),mp2) = Map.deleteFindMin mp+            (res,mp3) = popBy cmp (Heap mp2)

@@ -0,0 +1,41 @@+{-# LANGUAGE CPP #-}++module General.TypeMap(+    TypeMap, empty,+    lookup, insert, find+    ) where++import Prelude hiding (lookup)+import Data.Dynamic+import Data.Maybe+import qualified Data.Map as Map++newtype TypeMap = TypeMap (Map.Map TypeRep Dynamic)+++empty :: TypeMap+empty = TypeMap Map.empty+++lookup :: Typeable a => TypeMap -> Maybe a+lookup (TypeMap mp) = res+    where res = fmap (fromJust . fromDynamic) $ Map.lookup (typeOf $ fromJust res) mp+++find :: Typeable a => TypeMap -> a+find mp = res+    where res = fromMaybe (error msg) $ lookup mp+          msg = "General.TypeMap.find, couldn't find " ++ show (typeOf res)+++insert :: Typeable a => a -> TypeMap -> TypeMap+insert a (TypeMap mp) = TypeMap $ Map.insert (typeOf a) (toDyn a) mp+++#if __GLASGOW_HASKELL__ < 702+instance Ord TypeRep where+    compare a b = compare (splitTyConApp a) (splitTyConApp b)++instance Ord TyCon where+    compare a b = compare (tyConString a) (tyConString b)+#endif

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-}  {- |@@ -15,6 +16,9 @@ import General.System import General.Base import Network.Wai+#if MIN_VERSION_wai(2, 0, 0)+import Network.Wai.Internal+#endif import Network.HTTP.Types import Data.CaseInsensitive(original) import qualified Data.ByteString.Lazy.Char8 as LBS@@ -34,10 +38,17 @@  responseFlatten :: Response -> IO (Status, ResponseHeaders, LBString) responseFlatten r = do+#if MIN_VERSION_wai(2, 0, 0)+    let (s,hs,withSrc) = responseToSource r+    chunks <- withSrc $ \src -> src $$ consume+    let res = toLazyByteString $ mconcat [x | Chunk x <- chunks]+    return (s,hs,res)+#else     let (s,hs,rest) = responseSource r     chunks <- runResourceT $ rest $$ consume     let res = toLazyByteString $ mconcat [x | Chunk x <- chunks]     return (s,hs,res)+#endif   responseEvaluate :: Response -> IO ()

@@ -11,7 +11,7 @@  import Hoogle.Store.All import qualified Data.IntMap as IntMap-import qualified Data.Heap as Heap+import qualified General.Heap as Heap import General.Base import General.Util import Control.Monad.Trans.State

@@ -47,8 +47,8 @@                 , (inputs <.> "txt", inputs <.> "tar.gz", "http://old.hackage.haskell.org/packages/archive/00-hoogle.tar.gz")                 ]     withDownloader opt downloader items-    extractTarball cabals-    extractTarball inputs+    doesFileExist (cabals <.> "tar.gz") >>= \b -> when b $ extractTarball cabals+    doesFileExist (inputs <.> "tar.gz") >>= \b -> when b $ extractTarball inputs   check :: String -> IO (Maybe FilePath)

@@ -13,10 +13,9 @@  translate :: String -> String translate src = unlines $ keywordPrefix ++ items-    where items = concatMap keywordFormat $ drop 1 $ partitions (~== "<a name>") $+    where items = concatMap keywordFormat $ partitions (~== "<span class='mw-headline' id>") $                   takeWhile (~/= "<div class=printfooter>") $ parseTags src - keywordPrefix =     ["-- Hoogle documentation, generated by Hoogle"     ,"-- From http://www.haskell.org/haskellwiki/Keywords"@@ -33,17 +32,16 @@         noUnderscore "_" = "_"         noUnderscore xs = map (\x -> if x == '_' then ' ' else x) xs -        name = words $ f $ fromAttrib "name" (head x)+        name = words $ f $ fromAttrib "id" (head x)         docs = zipWith (++) ("-- | " : repeat "--   ") $                intercalate [""] $-               map (docFormat . takeWhile (~/= "<div class=editsection>")) $+               map docFormat $                partitions isBlock x          g x | isAlpha x || x `elem` "_-:" = [x]             | otherwise = '.' : map toUpper (showHex (ord x) "") --        isBlock (TagOpen x _) = x `elem` ["p","pre"]+        isBlock (TagOpen x _) = x `elem` ["p","pre","ul"]         isBlock _ = False          f ('.':'2':'C':'_':xs) = ' ' : f xs@@ -56,7 +54,7 @@ docFormat :: [Tag String] -> [String] docFormat (TagOpen "pre" _:xs) = ["<pre>"] ++ map (drop n) ys ++ ["</pre>"]     where-        ys = lines $ innerText xs+        ys = lines $ reverse $ dropWhile isSpace $ reverse $ innerText xs         n = minimum $ map (length . takeWhile isSpace) ys  docFormat (TagOpen "p" _:xs) = g 0 [] $ words $ f xs@@ -73,3 +71,6 @@          h (TagText x) = unwords (lines x)         h _ = ""++docFormat (TagOpen "ul" _:xs) =+    ["<ul><li>"] ++ intercalate ["</li><li>"] [docFormat (TagOpen "p" []:x) | x <- partitions (~== "<li>") xs] ++ ["</li></ul>"]

@@ -0,0 +1,23 @@++module Main(main) where++import Control.Monad+import System.Cmd+import System.Directory+import System.Exit+import System.FilePath+++main :: IO ()+main = do+    let files = ["./dist/build/hoogle/hoogle.exe","./dist/build/hoogle/hoogle"+                ,"./hoogle.exe","./hoogle"+                ,"../hoogle/hoogle.exe","../hoogle/hoogle"]+    found <- filterM doesFileExist files+    let hoogle args = do+            let cmd = normalise (head (found ++ ["hoogle"])) ++ " " ++ args+            res <- system cmd+            when (res /= ExitSuccess) $ error $ "Command: " ++ cmd ++ "\nFailed with: " ++ show res++    hoogle "data"+    hoogle "test --example"

@@ -1,4 +1,4 @@-{-# LANGUAGE RecordWildCards, ScopedTypeVariables, PatternGuards #-}+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, PatternGuards, CPP #-}  module Web.Server(server) where @@ -16,6 +16,9 @@ import Data.Time.Clock  import Network.Wai+#if MIN_VERSION_wai(2, 0, 0)+import Network.Wai.Internal+#endif import Network.Wai.Handler.Warp  @@ -34,9 +37,15 @@         return res  +#if MIN_VERSION_wai(2, 0, 0)+exception :: Maybe Request -> SomeException -> IO ()+exception _ e | Just (_ :: InvalidRequest) <- fromException e = return ()+              | otherwise = putStrLn $ "Error: " ++ show e+#else exception :: SomeException -> IO () exception e | Just (_ :: InvalidRequest) <- fromException e = return ()             | otherwise = putStrLn $ "Error: " ++ show e+#endif   respArgs :: CmdLine -> IO (IO ResponseArgs)

@@ -1,63 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Main where--import           Control.Monad-import           Control.Monad.IO.Class-import           Data.Monoid-import           Filesystem (isDirectory, isFile)-import qualified Hoogle as H-import           System.Environment-import           System.Exit-import           System.IO-import           Test.HUnit-import           Test.Hspec (Spec, describe, it, hspec)-import           Test.Hspec.Expectations-import           Test.Hspec.HUnit ()-import           Test.Hspec.Runner--main :: IO ()-main = do-    env <- getEnvironment-    hoogledb <- liftIO $-        readFileUtf8 "datadir/testdata.txt"-            >>= return . snd . H.createDatabase H.Haskell []-    hspec $ hoogleSpec hoogledb--readFileUtf8 x = do-    h <- openFile x ReadMode-    hSetEncoding h utf8-    hGetContents h--hoogleSpec :: H.Database -> Spec-hoogleSpec db = do-    describe "Basic functionality" $ do-        it "finds 'snd'" $ do-            let q = H.parseQuery undefined "snd"-            map (H.self . snd) (H.search db (either mempty id q))-                @?= [H.Tags [ H.TagBold (H.Tags [H.TagEmph (H.Str "snd")])-                            , H.Str " :: "-                            , H.Str "(a,b)"-                            , H.Str " -> "-                            , H.Str "b" ]]--        it "finds four instances of 'fst'" $ do-            let q = H.parseQuery undefined "fst"-            length (H.search db (either mempty id q)) @?= 4--        it "finds two 'Foo.Bar.fst*' inexactly" $ do-            let q = H.parseQuery undefined "fst +Foo.Bar"-            length (H.search db (either mempty id q)) @?= 2--        it "finds 'Foo.Bar.fst' exactly" $ do-            let q = H.parseQuery undefined "fst +Foo.Bar"-            map (H.self . snd)-                (H.search db (H.queryExact (Just H.UnclassifiedItem)-                                           (either mempty id q)))-                @?= [H.Tags [ H.TagBold (H.Tags [H.TagEmph (H.Str "fst")])-                            , H.Str " :: "-                            , H.Str "(Unit,Unit)"-                            , H.Str " -> "-                            , H.Str "Unit" ]]---- Smoke.hs ends here