hoogle-4.2.23/0000755000000000000000000000000012222103576011245 5ustar0000000000000000hoogle-4.2.23/Setup.hs0000644000000000000000000000005612222103576012702 0ustar0000000000000000import Distribution.Simple main = defaultMain hoogle-4.2.23/README.txt0000644000000000000000000000166312222103576012751 0ustar0000000000000000Hoogle - a Haskell API search. This repo is being migrated to git and from my laptop. Command Line Version -------------------- To invoke Hoogle type: hoogle "[a] -> [b]" Note the quotes, otherwise you will redirect the output to the file [b]. To ensure you have data files for the Hackage modules, you will first need to type: hoogle data Which will download and build Hoogle databases. Web Version ----------- A web version is available at http://www.haskell.org/hoogle All the appropriate documentation/credits/reference material is on the Haskell wiki at http://www.haskell.org/haskellwiki/Hoogle Folders ------- The folders in the distribution, and their meaning are: data - tools to generate a hoogle data file docs - documentation on hoogle misc - presentations, icons, emacs scripts, logos src - source code web - additional resources for the web front end (css, jpg etc.) hoogle-4.2.23/hoogle.cabal0000644000000000000000000001136712222103576013516 0ustar0000000000000000cabal-version: >= 1.10 build-type: Simple name: hoogle version: 4.2.23 license: BSD3 license-file: docs/LICENSE category: Development author: Neil Mitchell maintainer: Neil Mitchell copyright: Neil Mitchell 2004-2013 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: http://www.haskell.org/hoogle/ bug-reports: https://github.com/ndmitchell/hoogle/issues stability: Beta extra-source-files: README.txt datadir/*.txt data-dir: datadir data-files: resources/*.css resources/*.gif resources/*.ico resources/*.js resources/*.png resources/*.html resources/search.xml source-repository head type: git location: https://github.com/ndmitchell/hoogle.git library hs-source-dirs: src default-language: Haskell98 build-depends: base > 4 && < 5, array, containers, directory, filepath, process, random, safe, binary, bytestring >= 0.9, conduit >= 0.2, parsec >= 2.1, deepseq >= 1.1, text >= 0.11, transformers >= 0.2, uniplate >= 1.6, blaze-builder >= 0.2, case-insensitive >= 0.2, http-types >= 0.7, wai >= 1.1, haskell-src-exts >= 1.14 && < 1.15 if !os(mingw32) build-depends: unix exposed-modules: Hoogle -- modules that I would conditionally expose, were it not for -- http://hackage.haskell.org/trac/hackage/ticket/776 other-modules: Hoogle.DataBase.All Hoogle.Type.All Hoogle.Query.All Hoogle.Score.All Hoogle.Search.All Hoogle.Language.Haskell other-modules: Data.Heap Data.TypeMap General.Base General.System General.Util General.Web Hoogle.DataBase.Aliases Hoogle.DataBase.Instances Hoogle.DataBase.Items Hoogle.DataBase.Serialise Hoogle.DataBase.SubstrSearch Hoogle.DataBase.Suggest Hoogle.DataBase.Type Hoogle.DataBase.TypeSearch.Binding Hoogle.DataBase.TypeSearch.EntryInfo Hoogle.DataBase.TypeSearch.Graph Hoogle.DataBase.TypeSearch.Graphs Hoogle.DataBase.TypeSearch.Result Hoogle.DataBase.TypeSearch.TypeScore Hoogle.DataBase.TypeSearch.All Hoogle.Type.Docs Hoogle.Type.Item Hoogle.Type.Language Hoogle.Type.TagStr Hoogle.Type.TypeSig Hoogle.Type.ParseError Hoogle.Type.Result Hoogle.Query.Parser Hoogle.Query.Render Hoogle.Query.Suggest Hoogle.Query.Type Hoogle.Score.Scoring Hoogle.Score.Type Hoogle.Search.Results Hoogle.Store.All Hoogle.Store.ReadBuffer Hoogle.Store.Type Hoogle.Store.WriteBuffer Paths_hoogle executable hoogle main-is: Main.hs hs-source-dirs: src default-language: Haskell98 build-depends: base > 4 && < 5, bytestring, filepath, directory, process, random, array, containers, time, old-locale, safe, aeson >= 0.6.1, cmdargs >= 0.7, deepseq >= 1.1, tagsoup >= 0.11, blaze-builder >= 0.2, http-types >= 0.7, case-insensitive >= 0.2, text >= 0.11, transformers >= 0.2, uniplate >= 1.6, conduit >= 0.2, parsec >= 2.1, wai >= 1.1, warp >= 1.1, Cabal >= 1.8, haskell-src-exts >= 1.14 && < 1.15 if !os(mingw32) build-depends: unix other-modules: CmdLine.All CmdLine.Load CmdLine.Type Console.All Console.Log Console.Rank Console.Search Console.Test Paths_hoogle Recipe.All Recipe.Cabal Recipe.Download Recipe.General Recipe.Hackage Recipe.Haddock Recipe.Keyword Recipe.Type Test.All Test.Docs Test.General Test.Parse_Query Test.Parse_TypeSig Web.All Web.Page Web.Response Web.Server Web.Template test-suite hoogle-test main-is: HoogleSpec.hs hs-source-dirs: test 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 hoogle-4.2.23/test/0000755000000000000000000000000012222103576012224 5ustar0000000000000000hoogle-4.2.23/test/HoogleSpec.hs0000644000000000000000000000422412222103576014612 0ustar0000000000000000{-# 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 hoogle-4.2.23/src/0000755000000000000000000000000012222103576012034 5ustar0000000000000000hoogle-4.2.23/src/Main.hs0000644000000000000000000000030412222103576013251 0ustar0000000000000000 module Main where import CmdLine.All import Console.All as Console import Web.All as Web main :: IO () main = do q <- cmdLine if isWebCmdLine q then Web.action q else Console.action q hoogle-4.2.23/src/Hoogle.hs0000644000000000000000000001172212222103576013610 0ustar0000000000000000 -- | The Hoogle API. To perform a search you call 'search' with a 'Database' (obtained by 'loadDatabase') and a -- 'Query' (obtained by 'parseQuery'). module Hoogle( -- * Utility types TagStr(..), showTagText, showTagANSI, showTagHTML, showTagHTMLWith, H.ParseError(..), URL, H.Language(..), -- * Database Database, loadDatabase, saveDatabase, createDatabase, showDatabase, -- * Query Query, parseQuery, H.renderQuery, H.queryDatabases, H.queryPackages, H.querySetPackage, -- * Score Score, H.scoring, -- * Search Result(..), search, suggestions, completions, queryExact, H.ItemKind(..) ) where import Hoogle.Store.All import General.Base import General.System import Hoogle.Type.TagStr import qualified Hoogle.DataBase.All as H import qualified Hoogle.Query.All as H import qualified Hoogle.Score.All as H import qualified Hoogle.Search.All as H import qualified Hoogle.Type.All as H import qualified Hoogle.Language.Haskell as H import Hoogle.Query.All(Query, exactSearch) import Hoogle.Score.All(Score) -- * Database -- | A Hoogle database, containing a set of functions/items which can be searched. The 'Database' type is used -- for a variety of purposes: -- -- [Creation] A database is created by merging existing databases with the 'Monoid' instance and 'mappend', -- or by creating a new 'Database' from an input file with 'createDatabase'. -- -- [Serialization] A database is saved to disk with 'saveDatabase' and loaded from disk with 'loadDatabase'. -- -- [Searching] A database is searched using 'search'. newtype Database = Database [H.DataBase] toDataBase (Database x) = H.combineDataBase x fromDataBase x = Database [x] instance NFData Database where rnf (Database a) = rnf a instance Monoid Database where mempty = Database [] mappend (Database xs) (Database ys) = Database $ xs ++ ys instance Show Database where show = show . toDataBase -- | Save a database to a file. saveDatabase :: FilePath -> Database -> IO () saveDatabase file x = do performGC H.saveDataBase file $ toDataBase x -- | Load a database from a file. If the database was not saved with the same version of Hoogle, -- it will probably throw an error. loadDatabase :: FilePath -> IO Database loadDatabase = fmap fromDataBase . H.loadDataBase -- | Create a database from an input definition. Source files for Hoogle databases are usually -- stored in UTF8 format, and should be read using 'hSetEncoding' and 'utf8'. createDatabase :: H.Language -- ^ Which format the input definition is in. -> [Database] -- ^ A list of databases which contain definitions this input definition relies upon (e.g. types, aliases, instances). -> String -- ^ The input definitions, usually with one definition per line, in a format specified by the 'Language'. -> ([H.ParseError], Database) -- ^ A pair containing any parse errors present in the input definition, and the database ignoring any parse errors. createDatabase _ dbs src = (err, fromDataBase $ H.createDataBase xs res) where (err,res) = H.parseInputHaskell src xs = concat [x | Database x <- dbs] -- | Show debugging information on some parts of the database. If the second argument -- is 'Nothing' the whole database will be shown. Otherwise, the listed parts will be shown. showDatabase :: Database -> Maybe [String] -> String showDatabase x sects = concatMap (`H.showDataBase` toDataBase x) $ fromMaybe [""] sects -- Hoogle.Query -- | Parse a query for a given language, returning either a parse error, or a query. parseQuery :: H.Language -> String -> Either H.ParseError Query parseQuery _ = H.parseQuery -- Hoogle.Search -- Invariant: locations will not be empty data Result = Result {locations :: [(URL, [(URL, String)])] -- your location, your parents ,self :: TagStr -- ^ Rendered view for the entry, including name/keywords/type as appropriate, colors matching 'renderQuery' ,docs :: TagStr -- ^ Documentation for the entry } deriving (Eq, Show) toResult :: H.Result -> (Score,Result) toResult r@(H.Result ent view score) = (score, Result parents self docs) where self = H.renderResult r parents = map (second $ map f) $ H.entryLocations ent f = (H.entryURL &&& H.entryName) . fromOnce docs = H.renderDocs $ H.entryDocs ent -- | Perform a search. The results are returned lazily. search :: Database -> Query -> [(Score,Result)] search (Database xs) q = map toResult $ H.search xs q -- | Given a query and a database optionally give a list of what the user might have meant. suggestions :: Database -> Query -> Maybe TagStr suggestions (Database dbs) q = H.suggestQuery dbs q -- | Given a query string and a database return a list of the possible completions for the search. completions :: Database -> String -> [String] completions x = H.completions (toDataBase x) -- | Given a query, set whether it is an exact query. queryExact :: Maybe H.ItemKind -> Query -> Query queryExact kind q = q { exactSearch = kind }hoogle-4.2.23/src/Web/0000755000000000000000000000000012222103576012551 5ustar0000000000000000hoogle-4.2.23/src/Web/Template.hs0000644000000000000000000001311112222103576014655 0ustar0000000000000000{-# LANGUAGE PatternGuards, RecordWildCards #-} module Web.Template( main, escapeURL, escapeHTML, reload ) where import General.Base import General.System import General.Web main :: IO () main = do [from,to,modname] <- getArgs src <- readFile from writeFileBinary to $ generate modname $ resolve $ parse src --------------------------------------------------------------------- -- TYPE data Template = Template {templateName :: String ,templateArgs :: [String] ,templateExport :: Bool ,templateContents :: [Fragment] } data Fragment = Out String -- ^ Output some text | Att Esc String -- ^ Output an attribute (and how to escape it) | Set String String -- ^ Set an attribute to a value | Call String -- ^ Call another template data Esc = EscNone | EscHtml | EscUrl deriving Eq escapeStr e = case e of EscHtml -> "escapeHTML "; EscUrl -> "escapeURL "; _ -> "" escape e = case e of EscHtml -> escapeHTML; EscUrl -> escapeURL; _ -> id joinOut (Out x:Out y:zs) = joinOut $ Out (x++y) : zs joinOut (x:xs) = x : joinOut xs joinOut [] = [] getTemplate :: [Template] -> String -> Template getTemplate ts x = case find ((==) x . templateName) ts of Nothing -> error $ "Could not find template " ++ x Just y -> y --------------------------------------------------------------------- -- OUTPUT -- Given a set of templates/args you need available, and a piece of sour reload :: String -- ^ The source code -> [(String,[String])] -- ^ A set of templates/args you need avaialble -> [[String] -> String] -- ^ A list of functions which match the templates/args reload src want = map f want where ts = resolve $ parse src f (name,args) | templateArgs t /= args = error $ "Arguments for template " ++ name ++ " differ, expected " ++ show args ++ ", got " ++ show (templateArgs t) | otherwise = reloadTemplate t where t = getTemplate ts name reloadTemplate :: Template -> ([String] -> String) reloadTemplate t as = concatMap f $ templateContents t where atts = zip (templateArgs t) as f (Out x) = x f (Att e x) = escape e $ fromJust $ lookup x atts --------------------------------------------------------------------- -- OUTPUT generate :: String -> [Template] -> String generate name xs = unlines $ ["-- AUTO GENERATED - do not modify" ,"module " ++ name ++ "(Templates(..), defaultTemplates, loadTemplates) where" ,"import Web.Template" ,"" ,"data Templates = Templates"] ++ zipWith (++) (" {":repeat " ,") [templateName t ++ " :: " ++ intercalate " -> " (replicate (length (templateArgs t) + 1) "String") | t <- ts] ++ [" }" ,"" ,"defaultTemplates :: Templates" ,"defaultTemplates = Templates" ++ concatMap ((++) " _" . templateName) ts ,"" ,"loadTemplates :: String -> Templates" ,"loadTemplates x = Templates" ++ concatMap ((++) " _" . templateName) ts ," where" ," [" ++ intercalate "," (map ((++) "__" . templateName) ts) ++ "] = reload x $"] ++ [" " ++ show (templateName t, templateArgs t) ++ " :" | t <- ts] ++ [" []"] ++ [" _" ++ unwords (templateName t:templateArgs t) ++ " = __" ++ templateName t ++ " [" ++ intercalate "," (templateArgs t) ++ "]" | t <- ts] ++ concatMap generateTemplate ts where ts = nubBy ((==) `on` templateName) $ filter templateExport xs generateTemplate :: Template -> [String] generateTemplate Template{..} = "" : (unwords (('_':templateName) : templateArgs) ++ " = \"\"") : map ((++) " " . f) templateContents where f (Out x) = "++ " ++ show x f (Att e x) = "++ " ++ escapeStr e ++ x --------------------------------------------------------------------- -- RESOLVE -- | Eliminate Set and Call, fill in the template arguments resolve :: [Template] -> [Template] resolve xs = map (resolveFree . resolveSet . resolveCall xs) xs resolveFree t = t{templateArgs=args} where seen = nub [x | Att _ x <- templateContents t] args = nub $ filter (`elem` seen) (templateArgs t) ++ seen resolveSet t = t{templateContents = joinOut $ f [] $ templateContents t} where f seen (Set x y:xs) = f ((x,y):seen) xs f seen (Att e y:xs) | Just v <- lookup y seen = Out (escape e v) : f seen xs f seen (x:xs) = x : f seen xs f seen [] = [] resolveCall args t = t{templateContents = concatMap f $ templateContents t} where f (Call x) = concatMap f $ templateContents $ getTemplate args x f x = [x] --------------------------------------------------------------------- -- PARSING parse :: String -> [Template] parse = f . dropWhile (not . isPrefixOf "#") . filter (not . all isSpace) . lines where f (x:xs) = Template name args exp (parseTemplate $ unlines a) : f b where (a,b) = break ("#" `isPrefixOf`) xs ys = words $ dropWhile (== '#') x exp = ["export"] `isPrefixOf` ys name:args = if exp then tail ys else ys f [] = [] parseTemplate :: String -> [Fragment] parseTemplate = f where f [] = [] f ('$':xs) = g a : f (drop 1 b) where (a,b) = break (== '$') xs f xs = Out a : f b where (a,b) = break (== '$') xs g ('!':xs) = Att EscNone xs g ('&':xs) = Att EscHtml xs g ('%':xs) = Att EscUrl xs g ('#':xs) = Call xs g xs | (a,'=':b) <- break (== '=') xs = Set a b g x = error $ "Templating error, perhaps you forgot the escape format? $" ++ x ++ "$" hoogle-4.2.23/src/Web/Server.hs0000644000000000000000000001224212222103576014354 0ustar0000000000000000{-# LANGUAGE RecordWildCards, ScopedTypeVariables, PatternGuards #-} module Web.Server(server) where import General.Base import General.Web import CmdLine.All import Web.Response import Network.HTTP.Types import Web.Page import System.IO.Unsafe(unsafeInterleaveIO) import Control.Monad.IO.Class import General.System import Control.Concurrent import Control.Exception import Data.Time.Clock import Network.Wai import Network.Wai.Handler.Warp server :: CmdLine -> IO () server q@Server{..} = do resp <- respArgs q v <- newMVar () putStrLn $ "Starting Hoogle Server on port " ++ show port runSettings defaultSettings{settingsOnException=exception, settingsPort=port} $ \r -> liftIO $ do start <- getCurrentTime res <- talk resp q r responseEvaluate res stop <- getCurrentTime let t = floor $ diffUTCTime stop start * 1000 withMVar v $ const $ putStrLn $ bsUnpack (rawPathInfo r) ++ bsUnpack (rawQueryString r) ++ " ms:" ++ show t return res exception :: SomeException -> IO () exception e | Just (_ :: InvalidRequest) <- fromException e = return () | otherwise = putStrLn $ "Error: " ++ show e respArgs :: CmdLine -> IO (IO ResponseArgs) respArgs Server{..} = do t <- getTemplate if dynamic then return $ args t else do x <- args t; return $ return x where getTemplate | null template = return $ return defaultTemplates | otherwise = do let get = do x <- fmap (loadTemplates . unlines) $ mapM readFile' template putStrLn "Templates loaded" return x if dynamic then buffer template get else return get modTime ext = unsafeInterleaveIO $ do x <- getModificationTime $ resources "hoogle" <.> ext return $ map (\x -> if isSpace x then '_' else x) $ show x args t = do css <- modTime "css"; js <- modTime "js" t <- t return $ responseArgs{updatedCss=css, updatedJs=js, templates=t} -- | Given a set of paths something relies on, and a value to generate it, return something that generates it minimally buffer :: [FilePath] -> IO a -> IO (IO a) buffer files act = do val <- act ts <- mapM getModificationTime files ref <- newMVar (ts,val) return $ modifyMVar ref $ \(ts,val) -> do ts2 <- mapM getModificationTime files if ts == ts2 then return ((ts,val),val) else do val <- act return ((ts2,val),val) -- FIXME: Avoid all the conversions to/from LBS talk :: IO ResponseArgs -> CmdLine -> Request -> IO Response talk resp Server{..} r@Request{rawPathInfo=path_, rawQueryString=query_} | path `elem` ["/","/hoogle"] = do let args = parseHttpQueryArgs $ drop 1 query cmd <- cmdLineWeb args resp <- resp r <- response resp cmd{databases=databases} if local_ then rewriteFileLinks r else return r | path == "/res/search.xml" = serveSearch resources (fmap bsUnpack $ join $ lookup (fromString "domain") $ queryString r) | takeDirectory path == "/res" = serveFile True (resources takeFileName path) False | local_, Just path <- stripPrefix "/file/" path = let hasDrive = "/" `isPrefixOf` path && ":" `isPrefixOf` (drop 2 path) in serveFile False (if hasDrive then drop 1 path else path) local_ | otherwise = return $ responseNotFound $ show path where (path,query) = (bsUnpack path_, bsUnpack query_) serveSearch :: FilePath -> Maybe String -> IO Response serveSearch resources domain = do r <- serveFile True (resources "search.xml") False case domain of Nothing -> return r Just x -> responseRewrite (lbsReplace (fromString "http://haskell.org/hoogle/") (fromString x)) r serveFile :: Bool -> FilePath -> Bool -> IO Response serveFile cache file rewriteLinks = do b <- doesFileExist file if not b then return $ responseNotFound file else (if rewriteLinks then rewriteHaddockFileLinks else return) $ ResponseFile ok200 hdr file Nothing where hdr = [(hContentType, fromString $ contentExt $ takeExtension file)] ++ [(hCacheControl, fromString "max-age=604800" {- 1 week -}) | cache] rewriteFileLinks :: Response -> IO Response rewriteFileLinks = responseRewrite $ lbsReplace (fromString "href='file://") (fromString "href='/file/") replaceLetter :: LBString -> Char -> LBString replaceLetter lbs letter = lbsReplace (fromString $ "href=\""++[letter]++":") (fromString $ "href=\"/file/"++[letter]++":") lbs replaceDriveLetters :: LBString -> LBString replaceDriveLetters lbs = foldl replaceLetter lbs (['A' .. 'Z'] ++ ['a' .. 'z']) replaceLeadingSlash :: LBString -> LBString replaceLeadingSlash = lbsReplace (fromString "href=\"/") (fromString "href=\"/file//") rewriteHaddockFileLinks :: Response -> IO Response rewriteHaddockFileLinks = responseRewrite $ replaceDriveLetters . replaceLeadingSlash contentExt ".png" = "image/png" contentExt ".css" = "text/css" contentExt ".js" = "text/javascript" contentExt ".html" = "text/html" contentExt ".htm" = "text/html" contentExt ".xml" = "application/opensearchdescription+xml" contentExt _ = "text/plain" hoogle-4.2.23/src/Web/Response.hs0000644000000000000000000002004012222103576014677 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} module Web.Response(response, ResponseArgs(..), responseArgs) where import CmdLine.All import Hoogle import General.Base import General.System import General.Web import Web.Page import Data.Generics.Uniplate import qualified Data.Aeson as J import qualified Data.ByteString.Lazy.Char8 as LBS import Data.Time.Clock import Data.Time.Format import System.Locale import Network.Wai import Network.HTTP.Types(hContentType) import System.IO.Unsafe(unsafeInterleaveIO) import qualified Paths_hoogle(version) import Data.Version(showVersion) logFile = "log.txt" version = showVersion Paths_hoogle.version data ResponseArgs = ResponseArgs {updatedCss :: String ,updatedJs :: String ,templates :: Templates } responseArgs = ResponseArgs version version defaultTemplates response :: ResponseArgs -> CmdLine -> IO Response response ResponseArgs{..} q = do logMessage q let response x ys = responseOK ((hContentType, fromString x) : ys) . fromString dbs <- unsafeInterleaveIO $ case queryParsed q of Left _ -> return mempty Right x -> fmap snd $ loadQueryDatabases (databases q) (fromRight $ queryParsed q) case web q of Just "suggest" -> fmap (response "application/json" []) $ runSuggest q Just "embed" -> return $ response "text/html" [hdr] $ runEmbed dbs q where hdr = (fromString "Access-Control-Allow-Origin", fromString "*") Just "ajax" -> return $ response "text/html" [] $ runQuery templates True dbs q Just "json" -> return $ responseOK [(hContentType, fromString "application/json")] $ runJson dbs q Just "web" -> return $ response "text/html" [] $ header templates updatedCss updatedJs (queryText q) ['-' | queryText q /= ""] ++ runQuery templates False dbs q ++ footer templates version mode -> return $ response "text/html" [] $ "Unknown webmode: " ++ fromMaybe "none" mode logMessage :: CmdLine -> IO () logMessage q = do time <- getCurrentTime args <- fmap (fromMaybe [("hoogle",queryText q)]) cgiArgs ip <- fmap (fromMaybe "0") $ getEnvVar "REMOTE_ADDR" let shw x = if all isAlphaNum x then x else show x appendFile logFile $ (++ "\n") $ unwords $ [formatTime defaultTimeLocale "%FT%T" time ,ip] ++ [shw a ++ "=" ++ shw b | (a,b) <- args] runSuggest :: CmdLine -> IO String runSuggest cq@Search{queryText=q} = do (_, db) <- loadQueryDatabases (databases cq) mempty let res = completions db q return $ "[" ++ show q ++ "," ++ show res ++ "]" runSuggest _ = return "" runEmbed :: Database -> CmdLine -> String runEmbed dbs Search{queryParsed = Left err} = "Parse error: " ++& errorMessage err ++ "" runEmbed dbs cq@Search{queryParsed = Right q} | null now = "No results found" | otherwise = unlines ["" ++ showTagHTML (transform f $ self $ snd x) ++ "" | x <- now, let url = fromList "" $ map fst $ locations $ snd x] where now = take (maybe 10 (max 1) $ count cq) $ search dbs q f (TagEmph x) = TagBold x f (TagBold x) = x f x = x runJson :: Database -> CmdLine -> LBS.ByteString runJson dbs Search{queryParsed = Left err} = J.encode $ J.object [ fromString "version" J..= version , fromString "parseError" J..= show err ] runJson dbs cq@Search{queryParsed = Right q} = J.encode $ J.object [ fromString "version" J..= version , fromString "results" J..= results ] where results | q == mempty = [] | otherwise = now start2 = maybe 0 (subtract 1 . max 0) $ start cq count2 = maybe 20 (max 1) $ count cq now = map (f . snd) $ take count2 $ drop start2 $ search dbs q f Result{..} = J.object [ fromString "location" J..= (head $ map fst locations ++ [""]) , fromString "self" J..= showTagText self , fromString "docs" J..= showTagText docs ] runQuery :: Templates -> Bool -> Database -> CmdLine -> String runQuery templates ajax dbs Search{queryParsed = Left err} = parseError templates (showTagHTMLWith f $ parseInput err) (errorMessage err) where f (TagEmph x) = Just $ "" ++ showTagHTMLWith f x ++ "" f _ = Nothing runQuery templates ajax dbs q | fromRight (queryParsed q) == mempty = welcome templates runQuery templates ajax dbs cq@Search{queryParsed = Right q, queryText = qt} = unlines $ (if prefix then ["

" ++ qstr ++ "

"] ++ ["" | not $ null pkgs] ++ ["

" ++ showTag sug ++ "

" | Just sug <- [suggestions dbs q]] ++ if null res then ["

No results found

"] else concat (pre ++ now) else concat now) ++ ["

Show more results

" | not $ null post] where prefix = not $ ajax && start2 /= 0 -- show from the start, with header start2 = maybe 0 (subtract 1 . max 0) $ start cq count2 = maybe 20 (max 1) $ count cq src = search dbs q res = [renderRes i (i /= 0 && i == start2 && prefix) x | (i,(_,x)) <- zip [0..] src] (pre,res2) = splitAt start2 res (now,post) = splitAt count2 res2 also = concatMap f (take (5 + length minus) $ nub $ minus ++ pkgs) where minus = [x | (False,x) <- queryPackages q] f x | (True,lx) `elem` queryPackages q = let q2 = showTagText $ renderQuery $ querySetPackage Nothing lx q in "
  • " ++ x ++ "
    • " | (False,lx) `elem` queryPackages q = let q2 = showTagText $ renderQuery $ querySetPackage Nothing lx q in "
  • " ++ x ++ "
    • " | otherwise = let link b = searchLink $ showTagText $ renderQuery $ querySetPackage (Just b) lx q in "
  • " ++ "" ++ x ++ "
    • " where lx = map toLower x pkgs = [x | (_, (_,x):_) <- concatMap (locations . snd) $ take (start2+count2) src] urlMore = searchLink qt ++ "&start=" ++ show (start2+count2+1) ++ "#more" qstr = showTagHTML (renderQuery q) renderRes :: Int -> Bool -> Result -> [String] renderRes i more Result{..} = ["" | more] ++ ["
    " ++ href selfUrl (showTagHTMLWith url self) ++ "
    "] ++ ["
    " ++ intercalate ", " [unwords $ zipWith (f u) [1..] ps | (u,ps) <- locations] ++ "
    " | not $ null locations] ++ ["
    " ++ showTag docs ++ "
    " | let s = showTagText docs, s /= ""] where selfUrl = head $ map fst locations ++ [""] f u cls (url,text) = "" ++ text ++ "" where url2 = if url == takeWhile (/= '#') u then u else url url (TagBold x) | null selfUrl = Just $ "" ++ showTagHTML (transform g x) ++ "" | otherwise = Just $ "" ++ showTagHTML (transform g x) ++ "" url _ = Nothing g (TagEmph x) = TagBold x g x = x href url x = if null url then x else "" ++ x ++ "" showTag :: TagStr -> String showTag = showTagHTML . transform f where f (TagLink "" x) = TagLink (if any (`isPrefixOf` str) ["http:","https:"] then str else searchLink str) x where str = showTagText x f x = x searchLink :: String -> URL searchLink x = "?hoogle=" ++% x hoogle-4.2.23/src/Web/Page.hs0000644000000000000000000001233112222103576013761 0ustar0000000000000000-- AUTO GENERATED - do not modify module Web.Page(Templates(..), defaultTemplates, loadTemplates) where import Web.Template data Templates = Templates {header :: String -> String -> String -> String -> String ,footer :: String -> String ,welcome :: String ,parseError :: String -> String -> String } defaultTemplates :: Templates defaultTemplates = Templates _header _footer _welcome _parseError loadTemplates :: String -> Templates loadTemplates x = Templates _header _footer _welcome _parseError where [__header,__footer,__welcome,__parseError] = reload x $ ("header",["css","js","query","queryHyphen"]) : ("footer",["version"]) : ("welcome",[]) : ("parseError",["errFormat","errMessage"]) : [] _header css js query queryHyphen = __header [css,js,query,queryHyphen] _footer version = __footer [version] _welcome = __welcome [] _parseError errFormat errMessage = __parseError [errFormat,errMessage] _header css js query queryHyphen = "" ++ "\n\n \n \n " ++ escapeHTML query ++ " " ++ escapeHTML queryHyphen ++ " Hoogle\n \n \n\t\t\n \n \n \n \n \n \n\n
    \n \n \"Hoogle\"\n\n \n \n
    \n
    \n" _footer version = "" ++ "
    \n
    \n
    © Neil Mitchell 2004-2013, version " ++ escapeHTML version ++ "
    \n \n\n" _welcome = "" ++ "

    Welcome to Hoogle

    \n\n

    \n Hoogle is a Haskell API search engine, which allows you to search many standard Haskell libraries\n by either function name, or by approximate type signature.\n

    \n

    \n Example searches:
    \n map\n
    \n (a -> b) -> [a] -> [b]\n
    \n Ord a => [a] -> [a]\n
    \n Data.Map.insert\n
    \n\t
    Enter your own search at the top of the page.\n

    \n

    \n The Hoogle manual contains more details,\n including further details on search queries, how to install Hoogle as a command line application\n and how to integrate Hoogle with Firefox/Emacs/Vim etc.\n

    \n

    \n I am very interested in any feedback you may have. Please\n email me, or add an entry to my\n bug tracker.\n

    \n" _parseError errFormat errMessage = "" ++ "

    " ++ errFormat ++ "

    \n

    \n\tParse error: " ++ escapeHTML errMessage ++ "\n

    \n\tFor information on what queries should look like, see the\n\tuser manual.\n

    \n" hoogle-4.2.23/src/Web/All.hs0000644000000000000000000000033012222103576013611 0ustar0000000000000000 module Web.All(action) where import CmdLine.All import General.Web import Web.Server import Web.Response action :: CmdLine -> IO () action q@Server{} = server q action q = cgiResponse =<< response responseArgs q hoogle-4.2.23/src/Test/0000755000000000000000000000000012222103576012753 5ustar0000000000000000hoogle-4.2.23/src/Test/Parse_TypeSig.hs0000644000000000000000000000737112222103576016035 0ustar0000000000000000 module Test.Parse_TypeSig(parse_TypeSig) where import Test.General import Data.Maybe import Hoogle.Type.All import Hoogle.Query.All parse_TypeSig = do let parseTypeSig x = either Left (Right . fromMaybe (error $ "Couldn't find type in: " ++ x) . typeSig) $ parseQuery (":: " ++ x) let (===) = parseTest parseTypeSig -- really basic stuff "a" === TypeSig [] (TVar "a") "a_" === TypeSig [] (TVar "a_") "_" === TypeSig [] (TVar "_") "_a" === TypeSig [] (TVar "_a") "A" === TypeSig [] (TLit "A") "A_" === TypeSig [] (TLit "A_") "m a" === TypeSig [] (TApp (TVar "m") [TVar "a"]) "M a b" === TypeSig [] (TApp (TLit "M") [TVar "a",TVar "b"]) -- lists and tuples "[a]" === TypeSig [] (TApp (TLit "[]") [TVar "a"]) "[] a" === TypeSig [] (TApp (TLit "[]") [TVar "a"]) "()" === TypeSig [] (TLit "()") "(a)" === TypeSig [] (TVar "a") "(a,b)" === TypeSig [] (TApp (TLit "(,)") [TVar "a",TVar "b"]) "(,) a b" === TypeSig [] (TApp (TLit "(,)") [TVar "a",TVar "b"]) "Foo [a]" === TypeSig [] (TApp (TLit "Foo") [TApp (TLit "[]") [TVar "a"]]) -- functions "(->)" === TypeSig [] (TLit "->") "a -> b" === TypeSig [] (TFun [TVar "a",TVar "b"]) "a->b->c" === TypeSig [] (TFun [TVar "a",TVar "b",TVar "c"]) "a -> (b -> c)" === TypeSig [] (TFun [TVar "a",TVar "b",TVar "c"]) "(a -> b) -> c" === TypeSig [] (TFun [TFun [TVar "a",TVar "b"],TVar "c"]) "M (a b) c" === TypeSig [] (TApp (TLit "M") [TApp (TVar "a") [TVar "b"],TVar "c"]) "(-#)" === TypeSig [] (TLit "-#") "a -# b" === TypeSig [] (TApp (TLit "-#") [TVar "a",TVar "b"]) -- classes "Eq a => a" === TypeSig [TApp (TLit "Eq") [TVar "a"]] (TVar "a") "Class a b => a b" === TypeSig [TApp (TLit "Class") [TVar "a",TVar "b"]] (TApp (TVar "a") [TVar "b"]) "(Ord a, Eq b) => a -> b" === TypeSig [TApp (TLit "Ord") [TVar "a"],TApp (TLit "Eq") [TVar "b"]] (TFun [TVar "a",TVar "b"]) -- forall "forall a . a -> a" === TypeSig [] (TFun [TVar "a", TVar "a"]) "forall a b . a -> a" === TypeSig [] (TFun [TVar "a", TVar "a"]) "(forall a . a -> a) -> b -> b" === TypeSig [] (TFun [TFun [TVar "a", TVar "a"], TVar "b", TVar "b"]) "(forall a . Data a => a -> a) -> b -> b" === TypeSig [] (TFun [TFun [TVar "a", TVar "a"], TVar "b", TVar "b"]) -- type operators "(:+:) a b" === TypeSig [] (TApp (TLit ":+:") [TVar "a", TVar "b"]) "(+++) a b" === TypeSig [] (TApp (TLit "+++") [TVar "a", TVar "b"]) "a :+: b" === TypeSig [] (TApp (TLit ":+:") [TVar "a", TVar "b"]) "a +++ b" === TypeSig [] (TApp (TLit "+++") [TVar "a", TVar "b"]) -- unboxed values "Int#" === TypeSig [] (TLit "Int#") "State# RealWorld" === TypeSig [] (TApp (TLit "State#") [TLit "RealWorld"]) "(# a, b #)" === TypeSig [] (TApp (TLit "(#,#)") [TVar "a",TVar "b"]) "(#,#) a b" === TypeSig [] (TApp (TLit "(#,#)") [TVar "a",TVar "b"]) -- parallel arrays "[:a:]" === TypeSig [] (TApp (TLit "[::]") [TVar "a"]) "[::] a" === TypeSig [] (TApp (TLit "[::]") [TVar "a"]) -- real examples "(a -> b) -> [a] -> [b]" === TypeSig [] (TFun [TFun [TVar "a",TVar "b"],TApp (TLit "[]") [TVar "a"],TApp (TLit "[]") [TVar "b"]]) "Monad a => (b -> a c) -> [b] -> a [c]" === TypeSig [TApp (TLit "Monad") [TVar "a"]] (TFun [TFun [TVar "b",TApp (TVar "a") [TVar "c"]],TApp (TLit "[]") [TVar "b"],TApp (TVar "a") [TApp (TLit "[]") [TVar "c"]]]) "GraphM m gr => Node -> m (gr a b) -> m (Maybe [Node])" === TypeSig [TApp (TLit "GraphM") [TVar "m",TVar "gr"]] (TFun [TLit "Node",TApp (TVar "m") [TApp (TVar "gr") [TVar "a",TVar "b"]],TApp (TVar "m") [TApp (TLit "Maybe") [TApp (TLit "[]") [TLit "Node"]]]]) "Ix a => Array a b -> a -> b" === TypeSig [TApp (TLit "Ix") [TVar "a"]] (TFun [TApp (TLit "Array") [TVar "a",TVar "b"],TVar "a",TVar "b"]) hoogle-4.2.23/src/Test/Parse_Query.hs0000644000000000000000000000270712222103576015554 0ustar0000000000000000 module Test.Parse_Query(parse_Query) where import General.Base import Test.General import Hoogle.Query.All import Hoogle.Type.All parse_Query = do let (===) = parseTest parseQuery q = mempty "map" === q{names = ["map"]} "#" === q{names = ["#"]} "c#" === q{names = ["c#"]} "-" === q{names = ["-"]} "/" === q{names = ["/"]} "->" === q{names = ["->"]} "foldl'" === q{names = ["foldl'"]} "fold'l" === q{names = ["fold'l"]} "Int#" === q{names = ["Int#"]} "concat map" === q{names = ["concat","map"]} "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 = [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=[Scope True Package "hackage"], names=["bytestring-cvs"]} hoogle-4.2.23/src/Test/General.hs0000644000000000000000000000225112222103576014664 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-methods #-} module Test.General where --------------------------------------------------------------------- -- The Test Monad data Test a = Test instance Monad Test where a >> b = a `seq` b instance Show (Test a) where show x = x `seq` "All tests passed" pass :: Test () pass = Test parseTest f input output = case f input of Left x -> err "Parse failed" (show x) Right x -> if x == output then pass else err "Parse not equal" (show x) where err pre post = error $ pre ++ ":\n " ++ input ++ "\n " ++ show output ++ "\n " ++ post parseTest2 f input output = case f input of (x:xs,_) -> err "Parse failed" (show x) ([], x) -> if x == output then pass else err "Parse not equal" (show x) where err pre post = error $ pre ++ ":\n " ++ input ++ "\n " ++ show output ++ "\n " ++ post --------------------------------------------------------------------- -- The List Monad data List a b = List {fromList :: [a]} instance Monad (List a) where List a >> List b = List (a++b) pair :: a -> b -> List (a,b) c pair a b = List [(a,b)] hoogle-4.2.23/src/Test/Docs.hs0000644000000000000000000000054312222103576014201 0ustar0000000000000000 module Test.Docs(docs) where import Test.General import Hoogle.Type.TagStr import Hoogle.Type.Docs docs = do let a === b = if renderDocs (readDocsHTML a) == b then pass else error $ "differences in docs " ++ show (renderDocs (readDocsHTML a)) "foo" === Str "foo" "foo bar baz" === Tags [Str "foo ", TagEmph (Str "bar"), Str " baz"] hoogle-4.2.23/src/Test/All.hs0000644000000000000000000000025612222103576014022 0ustar0000000000000000 module Test.All(test) where import Test.Parse_TypeSig import Test.Parse_Query import Test.Docs test :: IO () test = print $ do parse_TypeSig parse_Query docs hoogle-4.2.23/src/Recipe/0000755000000000000000000000000012222103576013243 5ustar0000000000000000hoogle-4.2.23/src/Recipe/Type.hs0000644000000000000000000000413012222103576014516 0ustar0000000000000000 module Recipe.Type( CmdLine(..), Name, noDeps, safeEncoding, keywords, platform, cabals, inputs, listing, version, resetWarnings, putWarning, recapWarnings, outStr, outStrLn ) where import CmdLine.All import Control.Concurrent import System.IO.Unsafe import General.Base import General.System type Name = String noDeps :: [Name] -> IO () noDeps [] = return () noDeps xs = error "Internal error: package with no dependencies had dependencies" -- | Lots of things go slightly wrong if you use characters > 127 in places, this just replaces them with ? safeEncoding :: String -> String safeEncoding = map (\x -> if x <= '\0' || x > '\127' then '?' else x) --------------------------------------------------------------------- -- DOWNLOADED INFORMATION keywords = "download/keyword.txt" platform = "download/haskell-platform.cabal" cabals = "download/hackage-cabal" inputs = "download/hackage-hoogle" listing :: FilePath -> IO [Name] listing dir = do xs <- getDirectoryContents dir return $ sortBy (comparing $ map toLower) $ filter (`notElem` [".","..","preferred-versions"]) xs version :: FilePath -> Name -> IO String version dir x = do ys <- getDirectoryContents $ dir x when (null ys) $ error $ "Couldn't find version for " ++ x ++ " in " ++ dir let f = map (read :: String -> Int) . words . map (\x -> if x == '.' then ' ' else x) return $ maximumBy (comparing f) $ filter (all (not . isAlpha)) ys --------------------------------------------------------------------- -- WARNING MESSAGES {-# NOINLINE warnings #-} warnings :: MVar [String] warnings = unsafePerformIO $ newMVar [] putWarning :: String -> IO () putWarning x = do outStrLn x modifyMVar_ warnings $ return . (x:) recapWarnings :: IO () recapWarnings = do xs <- readMVar warnings mapM_ outStrLn $ reverse xs resetWarnings :: IO () resetWarnings = modifyMVar_ warnings $ const $ return [] outputLock :: MVar () outputLock = unsafePerformIO $ newMVar () outStr, outStrLn :: String -> IO () outStr x = withMVar outputLock $ \_ -> do putStr x; hFlush stdout outStrLn x = outStr $ x ++ "\n" hoogle-4.2.23/src/Recipe/Keyword.hs0000644000000000000000000000453112222103576015226 0ustar0000000000000000 module Recipe.Keyword(makeKeyword) where import General.Base import Text.HTML.TagSoup import Recipe.Type import Recipe.General makeKeyword :: IO () makeKeyword = convertSrc noDeps [] "keyword" . translate =<< readFileUtf8' keywords translate :: String -> String translate src = unlines $ keywordPrefix ++ items where items = concatMap keywordFormat $ drop 1 $ partitions (~== "") $ takeWhile (~/= "
    ") $ parseTags src keywordPrefix = ["-- Hoogle documentation, generated by Hoogle" ,"-- From http://www.haskell.org/haskellwiki/Keywords" ,"-- See Hoogle, http://www.haskell.org/hoogle/" ,"" ,"-- | Haskell keywords, always available" ,"@url http://haskell.org/haskellwiki/Keywords" ,"@package keyword" ] keywordFormat x = concat ["" : docs ++ ["@url #" ++ concatMap g n, "@entry keyword " ++ noUnderscore n] | n <- name] where noUnderscore "_" = "_" noUnderscore xs = map (\x -> if x == '_' then ' ' else x) xs name = words $ f $ fromAttrib "name" (head x) docs = zipWith (++) ("-- | " : repeat "-- ") $ intercalate [""] $ map (docFormat . takeWhile (~/= "
    ")) $ partitions isBlock x g x | isAlpha x || x `elem` "_-:" = [x] | otherwise = '.' : map toUpper (showHex (ord x) "") isBlock (TagOpen x _) = x `elem` ["p","pre"] isBlock _ = False f ('.':'2':'C':'_':xs) = ' ' : f xs f ('.':a:b:xs) = chr res : f xs where [(res,"")] = readHex [a,b] f (x:xs) = x : f xs f [] = [] docFormat :: [Tag String] -> [String] docFormat (TagOpen "pre" _:xs) = ["
    "] ++ map (drop n) ys ++ ["
    "] where ys = lines $ innerText xs n = minimum $ map (length . takeWhile isSpace) ys docFormat (TagOpen "p" _:xs) = g 0 [] $ words $ f xs where g n acc [] = [unwords $ reverse acc | acc /= []] g n acc (x:xs) | nx+1+n > 70 = g n acc [] ++ g nx [x] xs | otherwise = g (n+nx+1) (x:acc) xs where nx = length x f (TagOpen "code" _:xs) = "" ++ innerText a ++ "" ++ f (drop 1 b) where (a,b) = break (~== "") xs f (x:xs) = h x ++ f xs f [] = [] h (TagText x) = unwords (lines x) h _ = "" hoogle-4.2.23/src/Recipe/Haddock.hs0000644000000000000000000001320712222103576015137 0ustar0000000000000000{-# LANGUAGE PatternGuards #-} module Recipe.Haddock( haddockToHTML, haddockHacks ) where import General.Base import General.Web import qualified Text.Read as R data Chunk = Verb [String] | Blk [String] | Li [String] | Numb [String] | Defn [(String,String)] | Para String deriving (Ord,Eq) haddockToHTML :: String -> [String] haddockToHTML = intercalate [""] . map (concatMap linewrap . convert) . join . map classify . paragraphs . lines where empty = all isSpace para = unwords . map trim paragraphs = filter (not . all empty) . groupBy (\x y -> not (empty x) && not (empty y)) classify xs = case trim (head xs) of "@" | trim (last xs) == "@", length xs > 1 -> Blk $ tail $ init xs '>':_ | all ((">" `isPrefixOf`) . ltrim) xs -> Verb $ map (tail . ltrim) xs '[':ys | (cs, ']':zs) <- break (==']') ys -> Defn [(trim cs, para $ zs : tail xs)] '*':ys -> Li [para $ ys : tail xs] '-':ys -> Li [para $ ys : tail xs] '(':ys | (cs, ')':zs) <- break (==')') ys , all isDigit cs -> Numb [para $ zs : tail xs] c:ys | isDigit c , '.':zs <- dropWhile isDigit ys -> Numb [para $ zs : tail xs] _ -> Para $ para xs join (Li xs : Li ys : zs) = join $ Li (xs ++ ys) : zs join (Numb xs : Numb ys : zs) = join $ Numb (xs ++ ys) : zs join (Defn xs : Defn ys : zs) = join $ Defn (xs ++ ys) : zs join (x : ys) = x : join ys join [] = [] convert (Verb xs) = ["
    "] ++ map escapeHTML xs ++ ["
    "] convert (Blk xs) = ["
    "] ++ map parseInline xs ++ ["
    "] convert (Li xs) = ["
      "] ++ ["
    • " ++ x ++ "
      • " | x <- map parseInline xs] ++ ["
    "] convert (Numb xs) = convert $ Li xs convert (Defn xs) = intersperse "" [parseInline a ++ ": " ++ parseInline b | (a,b) <- xs] convert (Para s) = [parseInline s] linewrap x | length x > 80 = (a ++ c) : linewrap (drop 1 d) where (a,b) = splitAt 60 x (c,d) = break (== ' ') b linewrap x = [x | x /= ""] parseInline :: String -> String parseInline = concat . bits where tag x y = "<" ++ x ++ ">" ++ y ++ "" table = [("@", "@", Just . tag "tt" . parseInline) ,("/", "/", Just . tag "i" . parseInline) ,("<", ">", check (not . any isSpace) (tag "a")) ,("\"","\"", check isModuleName (tag "a")) ,("\'","\'", check isQName (tag "a"))] check f g s = if f s then Just (g s) else Nothing sel1 (a,_,_) = a bits :: String -> [String] bits xs | (st,end,mk):_ <- filter (flip isPrefixOf xs . sel1) table , xs <- drop (length st) xs , Just (now,next) <- close "" end xs , Just r <- mk (reverse now) = r : bits next bits ('\\':x:xs) = escapeHTML [x] : bits xs bits (x:xs) = escapeHTML [x] : bits xs bits [] = [] close acc end xs | end `isPrefixOf` xs = Just (acc, drop (length end) xs) close acc end ('\\':x:xs) = close (x:'\\':acc) end xs close acc end (x:xs) = close (x:acc) end xs close acc end "" = Nothing isModuleName :: String -> Bool isModuleName = all ok . splitModuleString where ok s | [(R.Ident (y:ys), "")] <- R.readPrec_to_S R.lexP 0 s = isUpper y ok _ = False splitModuleString :: String -> [String] splitModuleString = wordsBy (== '.') wordsBy :: (a -> Bool) -> [a] -> [[a]] wordsBy f xs = case dropWhile f xs of [] -> [] ys -> w : wordsBy f zs where (w, zs) = break f ys isQName :: String -> Bool isQName xs = case R.readPrec_to_S R.lexP 0 xs of [(R.Ident (y:ys), '.':zs)] | isUpper y -> isQName zs [(R.Ident ys, "")] -> True [(R.Symbol ys, "")] -> True _ -> False --------------------------------------------------------------------- -- HADDOCK HACKS -- Eliminate @version -- Change :*: to (:*:), Haddock bug -- Change !!Int to !Int, Haddock bug -- Change instance [overlap ok] to instance, Haddock bug -- Change instance [incoherent] to instance, Haddock bug -- Change !Int to Int, HSE bug -- Drop everything after where, Haddock bug haddockHacks :: Maybe URL -> [String] -> [String] haddockHacks loc src = maybe id haddockPackageUrl loc (translate src) where translate :: [String] -> [String] translate = map (unwords . g . map f . words) . filter (not . isPrefixOf "@version ") f "::" = "::" f (':':xs) = "(:" ++ xs ++ ")" f ('!':'!':x:xs) | isAlpha x = xs f ('!':x:xs) | isAlpha x || x `elem` "[(" = x:xs f x | x `elem` ["[overlap","ok]","[incoherent]"] = "" f x = x g ("where":xs) = [] g (x:xs) = x : g xs g [] = [] haddockPackageUrl :: URL -> [String] -> [String] haddockPackageUrl x = concatMap f where f y | "@package " `isPrefixOf` y = ["@url " ++ x, y] | otherwise = [y] hoogle-4.2.23/src/Recipe/Hackage.hs0000644000000000000000000001074612222103576015132 0ustar0000000000000000 module Recipe.Hackage(makePlatform, makeDefault, makePackage, makeAll) where import Recipe.Type import Recipe.Cabal import Recipe.General import Recipe.Haddock import General.Base import General.System import General.Util import General.Web import Control.Exception -- FIXME: This is a list of hack avoid = words "ghc-prim integer integer-simple integer-gmp rts ghc Win32" makePlatform :: ([Name] -> IO ()) -> IO () makePlatform make = do xs <- listPlatform forM_ xs $ \(name,ver) -> do v2 <- version cabals name when (ver /= v2) $ putStrLn $ "Warning: Version mismatch for " ++ name ++ " (platform=" ++ ver ++ ", cabal=" ++ v2 ++ ")" combine make "platform" (map fst xs) False makeAll :: ([Name] -> IO ()) -> IO () makeAll make = do xs <- listing inputs make xs -- create a database containing an entry for each package in hackage makePackage :: IO () makePackage = do xs <- listing cabals xs <- forM xs $ \name -> do ver <- version cabals name let file = cabals name ver name <.> "cabal" src <- readCabal file return $ case src of Nothing -> [] Just src -> [""] ++ zipWith (++) ("-- | " : repeat "-- ") (cabalDescription src) ++ ["--","-- Version " ++ ver, "@url package/" ++ name, "@entry package " ++ name] convertSrc noDeps [] "package" $ unlines $ "@url http://hackage.haskell.org/" : "@package package" : concat xs 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 loc <- findLocal local "ghc" convertSrc make ["base"] "ghc" $ unlines $ "@depends base" : haddockHacks (url loc) (lines had) where url loc = if isNothing loc then Just "http://www.haskell.org/ghc/docs/latest/html/libraries/ghc/" else loc makeDefault make local name = do let base = name == "base" b1 <- doesDirectoryExist $ cabals name b2 <- doesDirectoryExist $ inputs name if not base && (not b1 || not b2) then putWarning $ "Warning: " ++ name ++ " couldn't find both Cabal and Haddock inputs" else do 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 "download/base.txt" else inputs name vh "doc" "html" name <.> "txt" cab = cabals name vc name <.> "cabal" had <- try $ readFileUtf8' had case had of Left e -> putWarning $ "Warning: Exception when reading haddock for " ++ name ++ ", " ++ show (e :: SomeException) Right had -> do deps <- fmap (maybe [] cabalDepends) $ readCabal cab let cleanDeps = deps \\ (name:avoid) loc <- findLocal local name convertSrc make cleanDeps name $ unlines $ ["@depends " ++ a | a <- cleanDeps] ++ haddockHacks loc (lines had) -- try and find a local filepath findLocal :: [FilePath] -> Name -> IO (Maybe URL) findLocal paths name = fmap (listToMaybe . concat . concat) $ forM paths $ \p -> do xs <- getDirectoryContents p xs <- return [p x | x <- reverse $ sort xs, name == fst (rbreak (== '-') x)] -- make sure highest version comes first forM xs $ \x -> do b <- doesDirectoryExist $ x "html" x <- return $ if b then x "html" else x b <- doesFileExist $ x "doc-index.html" return [filePathToURL $ x "index.html" | b] --------------------------------------------------------------------- -- READ PLATFORM listPlatform :: IO [(Name,String)] listPlatform = do src <- readFile platform let xs = takeWhile (not . isPrefixOf "build-tools:" . ltrim) $ dropWhile (not . isPrefixOf "build-depends:" . ltrim) $ lines src return [(name, takeWhile (\x -> x == '.' || isDigit x) $ drop 1 b) | x <- xs, (a,_:b) <- [break (== '=') x], let name = trim $ dropWhile (== '-') $ trim a , not $ avoid name] where avoid x = ("haskell" `isPrefixOf` x && all isDigit (drop 7 x)) || (x `elem` words "Cabal hpc Win32") hoogle-4.2.23/src/Recipe/General.hs0000644000000000000000000000254312222103576015160 0ustar0000000000000000 module Recipe.General(convertSrc, convert, combine) where import Recipe.Type import Hoogle import General.Base import General.System import System.Console.CmdArgs.Verbosity txt x = map toLower x <.> "txt" hoo x = map toLower x <.> "hoo" convertSrc :: ([Name] -> IO ()) -> [Name] -> Name -> String -> IO () convertSrc make deps x src = do writeFileUtf8 (txt x) src make deps convert (map hoo deps) x (hoo x) src ---- convert a single database convert :: [FilePath] -> Name -> FilePath -> String -> IO () convert deps x out src = do deps2 <- filterM doesFileExist deps when (deps /= deps2) $ putWarning $ "Warning: " ++ x ++ " doesn't know about dependencies on " ++ unwords (deps \\ deps2) dbs <- mapM loadDatabase deps2 let (err,db) = createDatabase Haskell dbs src unless (null err) $ outStrLn $ "Skipped " ++ show (length err) ++ " warnings in " ++ x whenLoud $ outStr $ unlines $ map show err outStr $ "Converting " ++ x ++ "... " performGC saveDatabase out db outStrLn "done" -- combine multiple databases combine :: ([Name] -> IO ()) -> Name -> [Name] -> Bool -> IO () combine make x deps force = do make deps dbs <- mapM (loadDatabase . hoo) deps outStr $ "Creating " ++ x ++ " from " ++ show (length deps) ++ " databases... " performGC saveDatabase (hoo x) $ mconcat dbs outStrLn "done" hoogle-4.2.23/src/Recipe/Download.hs0000644000000000000000000000671012222103576015352 0ustar0000000000000000 module Recipe.Download(download) where import General.Base import General.System import Recipe.Type type Downloader = FilePath -> URL -> String wget :: Downloader wget fp url = "wget -nv " ++ url ++ " --output-document=" ++ fp curl :: Downloader curl fp url = "curl -sSL " ++ url ++ " --output " ++ fp findDownloader :: IO Downloader findDownloader = do dl <- liftM2 mplus (check "wget") (check "curl") when (isNothing dl) $ error "Could not find downloader, neither curl nor wget are on the $PATH." return $ matchDl (fromJust dl) where matchDl d | "wget" `isInfixOf` d = wget | "curl" `isInfixOf` d = curl withDownloader :: CmdLine -> Downloader -> [(FilePath, FilePath, URL)] -> IO () withDownloader opt downloader items = let sys = fmap (== ExitSuccess) . system download (f, f', u) = do b <- doesFileExist f when (not b || redownload opt) $ do res <- sys (downloader f' u) unless res $ do b <- doesFileExist f' when b $ removeFile f' error $ "Failed to download: " ++ u doesFileExist f' in forM_ items download -- download everything required for the recipes download :: CmdLine -> IO () download opt = do createDirectoryIfMissing True "download" downloader <- findDownloader let items = [ (keywords, keywords, "http://www.haskell.org/haskellwiki/Keywords") , (platform, platform, "http://code.galois.com/darcs/haskell-platform/haskell-platform.cabal") , ("download/base.txt", "download/base.txt", "http://www.haskell.org/hoogle/base.txt") , ("download/ghc.txt", "download/ghc.txt", "http://www.haskell.org/ghc/docs/latest/html/libraries/ghc/ghc.txt") , (cabals <.> "txt", cabals <.> "tar.gz", "http://hackage.haskell.org/packages/archive/00-index.tar.gz") , (inputs <.> "txt", inputs <.> "tar.gz", "http://old.hackage.haskell.org/packages/archive/00-hoogle.tar.gz") ] withDownloader opt downloader items extractTarball cabals extractTarball inputs check :: String -> IO (Maybe FilePath) check name = do res <- findExecutable name when (isNothing res) $ do putStrLn $ "WARNING: Could not find command line program " ++ name ++ "." when isWindows $ putStrLn $ " You may be able to install it from:\n " ++ url return res where srcList = [ ("gzip", "http://gnuwin32.sourceforge.net/packages/gzip.htm") , ("tar", "http://gnuwin32.sourceforge.net/packages/gtar.htm") , ("wget", "http://gnuwin32.sourceforge.net/packages/wget.htm") , ("curl", "http://curl.haxx.se/download.html") ] url = fromJust . lookup name $ srcList extractTarball :: FilePath -> IO () extractTarball out = do createDirectoryIfMissing True out withDirectory out $ do hasGzip <- check "gzip" hasTar <- check "tar" when (any isNothing [hasGzip, hasTar]) $ error "Could not extract tarball(s), could not find either gzip or tar on the $PATH." putStrLn "Extracting tarball... " system_ $ "gzip --decompress --stdout --force .." takeFileName out <.> "tar.gz > .." takeFileName out <.> "tar" system_ $ "tar -xf .." takeFileName out <.> "tar" putStrLn "Finished extracting tarball" writeFile (out <.> "txt") "" hoogle-4.2.23/src/Recipe/Cabal.hs0000644000000000000000000000257412222103576014611 0ustar0000000000000000 module Recipe.Cabal( Cabal(..), readCabal ) where import Distribution.Compiler import Distribution.Package import Distribution.PackageDescription import Distribution.PackageDescription.Configuration import Distribution.PackageDescription.Parse import Distribution.System import Distribution.Text import Distribution.Verbosity import Distribution.Version import Recipe.Haddock import Recipe.Type import Control.Exception ghcVersion = [7,4,1] data Cabal = Cabal {cabalName :: String ,cabalVersion :: String ,cabalDescription :: [String] ,cabalDepends :: [String] } deriving Show readCabal :: FilePath -> IO (Maybe Cabal) readCabal file = handle (\e -> do putWarning $ "Failure when reading " ++ file ++ ", " ++ show (e :: SomeException) return Nothing) $ fmap Just $ do pkg <- readPackageDescription silent file let plat = Platform I386 Linux comp = CompilerId GHC (Version ghcVersion []) pkg <- return $ case finalizePackageDescription [] (const True) plat comp [] pkg of Left _ -> flattenPackageDescription pkg Right (pkg,_) -> pkg return $ Cabal (display $ pkgName $ package pkg) (display $ pkgVersion $ package pkg) (haddockToHTML $ description pkg) [display x | Just l <- [library pkg], Dependency x _ <- targetBuildDepends $ libBuildInfo l] hoogle-4.2.23/src/Recipe/All.hs0000644000000000000000000000554712222103576014322 0ustar0000000000000000-- Recipe actions: -- Download to foo.src in most cases, then extract to foo.txt, which can later be compiled to foo.hoo module Recipe.All(recipes) where import General.Base import General.System import Control.Concurrent import qualified Data.Map as Map import Recipe.Type import Recipe.Download import Recipe.Keyword import Recipe.General import Recipe.Hackage -- CmdLine is guaranteed to be a constructor of type Data recipes :: CmdLine -> IO () recipes opt = withModeGlobalRead $ do hSetBuffering stdout NoBuffering createDirectoryIfMissing True $ datadir opt withDirectory (datadir opt) $ do resetWarnings download opt let ys = parseRules $ actions opt make opt (filter (not . null . snd) ys) (map fst ys) recapWarnings putStrLn "Data generation complete" -- If I switch to the parallel-io library then it segfaults, due to GHC bug: -- http://hackage.haskell.org/trac/ghc/ticket/4850 -- import "parallel-io" Control.Concurrent.ParallelIO.Local withPool i f = f () extraWorkerWhileBlocked _ = id parallel_ _ = sequence_ data Status = Built | Building (MVar ()) make :: CmdLine -> [(Name,[Name])] -> [Name] -> IO () make opt rules xs = withPool (threads opt) $ \pool -> do ref <- newMVar Map.empty fs ref pool [] xs where fs ref pool rec xs = parallel_ pool $ map (f ref pool rec) xs f ref pool rec x | x `elem` rec = outStrLn $ "Warning: Package database appears to be recursive, " ++ x | otherwise = join $ modifyMVar ref $ \mp -> case Map.lookup x mp of Just Built -> return (mp, return ()) Just (Building v) -> return $ (,) mp $ extraWorkerWhileBlocked pool $ readMVar v Nothing -> do v <- newEmptyMVar return $ (,) (Map.insert x (Building v) mp) $ do build (fs ref pool $ x:rec) opt rules x modifyMVar_ ref $ \mp -> return $ Map.insert x Built mp putMVar v () build :: ([Name] -> IO ()) -> CmdLine -> [(Name,[Name])] -> Name -> IO () build makeRec opt rules x = do outStrLn $ "Starting " ++ x case lookup x rules of Just ys -> combine makeRec x ys True _ -> case x of "keyword" -> makeKeyword "default" -> combine makeRec x ["keyword","package","platform"] False "platform" -> makePlatform makeRec "package" -> makePackage "all" -> makeAll makeRec _ -> makeDefault makeRec (local opt) x outStrLn $ "Finished " ++ x parseRules :: [String] -> [(Name,[Name])] parseRules [] = [("default",[])] parseRules xs = map parseRule xs parseRule :: String -> (Name,[Name]) parseRule x = (a, uncommas $ drop 1 b) where (a,b) = break (== '=') x uncommas = words . map (\x -> if x == ',' then ' ' else x) hoogle-4.2.23/src/Hoogle/0000755000000000000000000000000012222103576013251 5ustar0000000000000000hoogle-4.2.23/src/Hoogle/Type/0000755000000000000000000000000012222103576014172 5ustar0000000000000000hoogle-4.2.23/src/Hoogle/Type/TypeSig.hs0000644000000000000000000001230212222103576016110 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Hoogle.Type.TypeSig where import Hoogle.Store.All import General.Base import Data.Generics.UniplateOn --------------------------------------------------------------------- -- DATA TYPE WITH CONTEXT -- FULL TYPE data TypeSig = TypeSig Constraint Type deriving (Eq,Ord,Data,Typeable) instance NFData TypeSig where rnf (TypeSig a b) = rnf (a,b) type Constraint = [Type] -- CONSTRICTED TYPE -- first argument is a list of contexts, (Context,Variable) type TypeContext = [(String,String)] data TypeSimp = TypeSimp TypeContext Type deriving (Eq,Ord,Data,Typeable) instance Show TypeSimp where show (TypeSimp c t) = show $ TypeSig [TApp (TLit a) [TVar b] | (a,b) <- c] t --------------------------------------------------------------------- -- DATA TYPES data Type = TApp Type [Type] -- a list of types, first one being the constructor | TLit String -- bound variables, Maybe, ":", "(,)", "(,,)" (tuple) | TVar String -- unbound variables, "a" | TFun [Type] deriving (Eq,Ord,Data,Typeable) instance NFData Type where rnf (TApp a b) = rnf (a,b) rnf (TLit a) = rnf a rnf (TVar a) = rnf a rnf (TFun a) = rnf a tApp :: Type -> [Type] -> Type tApp t [] = t tApp t ts = TApp t ts fromTFun :: Type -> [Type] fromTFun (TFun x) = x fromTFun x = [x] isTLit, isTVar :: Type -> Bool isTLit TLit{} = True; isTLit _ = False isTVar TVar{} = True; isTVar _ = False fromTApp :: Type -> (Type, [Type]) fromTApp (TApp x y) = (x,y) fromTApp x = (x,[]) isTLitTuple :: String -> Bool isTLitTuple x = ',' `elem` x insertTApp, removeTApp :: Type -> Type insertTApp = transform f where f (TApp (TApp x []) y) = TApp x y f (TApp x y) = TApp x y f (TFun x) = TFun x f x = TApp x [] removeTApp = transform f where f (TApp x []) = x f x = x --------------------------------------------------------------------- -- UNIPLATE INSTANCES instance Uniplate Type where uniplate (TApp x xs) = (x:xs, \(x:xs) -> TApp x xs) uniplate (TFun xs) = (xs, TFun) uniplate x = ([], \[] -> x) onTypeSig :: BiplateType TypeSig Type onTypeSig (TypeSig xs x) = (x:xs, \(x:xs) -> TypeSig xs x) transformSig = transformOn onTypeSig universeSig = universeOn onTypeSig variables :: Type -> [String] variables x = [v | TVar v <- universe x] variablesSig :: TypeSig -> [String] variablesSig x = [v | TVar v <- universeSig x] --------------------------------------------------------------------- -- STORE INSTANCES instance Store TypeSig where put (TypeSig a b) = put2 a b get = get2 TypeSig instance Store Type where put (TApp a b) = putByte 0 >> put2 a b put (TLit a) = putByte 1 >> put1 a put (TVar a) = putByte 2 >> put1 a put (TFun a) = putByte 3 >> put1 a get = do i <- getByte case i of 0 -> get2 TApp 1 -> get1 TLit 2 -> get1 TVar 3 -> get1 TFun --------------------------------------------------------------------- -- SHOW INSTANCES showConstraint :: Constraint -> String showConstraint [] = "" showConstraint [x] = show x ++ " => " showConstraint xs = "(" ++ intercalate ", " (map show xs) ++ ") => " -- TODO: show (TLit ":+:") should be "(:+:)" instance Show Type where showsPrec i x = showString $ f i x where -- Show lists and tuples specially f i (TApp (TLit "[]") [x]) = "[" ++ show x ++ "]" f i (TApp (TLit ('(':tup)) xs) | not (null tup) && last tup == ')' && all (== ',') (init tup) && length tup == length xs = b True $ intercalate ", " $ map show xs -- Should parallel lists and unboxed tuples specially f i (TApp (TLit "[::]") [x]) = "[:" ++ show x ++ ":]" f i (TApp (TLit ('(':'#':tup)) xs) | "#)" `isSuffixOf` tup && all (== ',') (drop 2 $ reverse tup) && length tup - 1 == length xs = "(# " ++ intercalate ", " (map show xs) ++ " #)" f i (TLit x) = x f i (TVar x) = x f i (TApp x xs) = b (i > 1) $ unwords $ map (f 2) (x:xs) f i (TFun xs) = b (i > 0) $ intercalate " -> " $ map (f 1) xs b True x = "(" ++ x ++ ")" b False x = x instance Show TypeSig where show (TypeSig x xs) = showConstraint x ++ show xs -- shows an element within a function -- to get brackets right after splitFun showFun :: Type -> String showFun x = showsPrec 1 x "" --------------------------------------------------------------------- -- OPERATIONS normaliseTypeSig :: TypeSig -> TypeSig normaliseTypeSig = transformOn onTypeSig normaliseType normaliseType :: Type -> Type normaliseType = transform f where f (TApp x []) = x f (TApp (TLit "->") xs) = f $ TFun xs f (TFun [x]) = x f (TFun xs) = TFun $ g xs f x = x g [] = [] g [TFun xs] = g xs g (x:xs) = x : g xs splitFun :: Type -> [Type] splitFun (TFun xs) = xs splitFun x = [x] renameVars :: (String -> String) -> TypeSig -> TypeSig renameVars f = transformOn onTypeSig g where g (TVar x) = TVar $ f x g x = x hoogle-4.2.23/src/Hoogle/Type/TagStr.hs0000644000000000000000000001056512222103576015741 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} -- | A module representing strings with formatting. module Hoogle.Type.TagStr( TagStr(..), tags, showTagText, showTagANSI, showTagHTML, showTagHTMLWith, formatTags ) where import General.Base import General.Web import Data.Generics.Uniplate import Hoogle.Store.All data TagStr = Str String -- ^ Plain text. | Tags [TagStr] -- ^ A list of tags one after another. | TagBold TagStr -- ^ Bold text. | TagEmph TagStr -- ^ Underlined/italic text. | TagLink String TagStr -- ^ A hyperlink to a URL. | TagColor Int TagStr -- ^ Colored text. Index into a 0-based palette. Text without any 'TagColor' should be black. deriving (Data,Typeable,Ord,Show,Eq) instance NFData TagStr where rnf (Str a) = rnf a rnf (Tags a) = rnf a rnf (TagBold a) = rnf a rnf (TagEmph a) = rnf a rnf (TagLink a b) = rnf (a,b) rnf (TagColor a b) = rnf (a,b) instance Monoid TagStr where mempty = Str "" mappend x y = tags [x,y] mconcat = tags instance Uniplate TagStr where uniplate (Tags xs) = (xs, Tags) uniplate (TagBold x) = ([x], \[x] -> TagBold x) uniplate (TagEmph x) = ([x], \[x] -> TagEmph x) uniplate (TagLink i x) = ([x], \[x] -> TagLink i x) uniplate (TagColor i x) = ([x], \[x] -> TagColor i x) uniplate x = ([], const x) instance Store TagStr where put (Str x) = putByte 0 >> put1 x put (Tags x) = putByte 1 >> put1 x put (TagBold x) = putByte 2 >> put1 x put (TagEmph x) = putByte 3 >> put1 x put (TagLink x y) = putByte 4 >> put2 x y put (TagColor x y) = putByte 5 >> put2 x y get = do i <- getByte case i of 0 -> get1 Str 1 -> get1 Tags 2 -> get1 TagBold 3 -> get1 TagEmph 4 -> get2 TagLink 5 -> get2 TagColor -- | Smart constructor for 'Tags' tags :: [TagStr] -> TagStr tags xs = case f xs of [x] -> x xs -> Tags xs where f (Str a:Str b:xs) = f $ Str (a++b):xs f (x:xs) = x : f xs f [] = [] -- | Show a 'TagStr' as a string, without any formatting. showTagText :: TagStr -> String showTagText x = concat [y | Str y <- universe x] -- | Show a 'TagStr' on a console with ANSI escape sequences. showTagANSI :: TagStr -> String showTagANSI x = f [] x where f a (Str x) = x f a t = case getCode t of Nothing -> g a Just val -> tag (val:a) ++ g (val:a) ++ tag a where g a = concatMap (f a) (children t) getCode (TagBold _) = Just "1" getCode (TagLink url _) = if null url then Nothing else Just "4" getCode (TagEmph _) = Just "4" getCode (TagColor n _) | n <= 5 && n >= 0 = Just ['3', intToDigit (n + 1)] getCode _ = Nothing tag stack = chr 27 : '[' : intercalate ";" ("0":reverse stack) ++ "m" -- | Show a 'TagStr' as HTML, using CSS classes for color styling. showTagHTML :: TagStr -> String showTagHTML = showTagHTMLWith (const Nothing) -- | Show TagStr with an override for specific tags. showTagHTMLWith :: (TagStr -> Maybe String) -> TagStr -> String showTagHTMLWith f x = g x where g x | isJust (f x) = fromJust $ f x g (Str x) = nbsp $ escapeHTML x g (Tags xs) = concatMap g xs g (TagBold x) = htmlTag "b" $ showTagHTML x g (TagEmph x) = htmlTag "i" $ showTagHTML x g (TagLink url x) = "    " ++ showTagHTML x ++ "" g (TagColor i x) = "" ++ showTagHTML x ++ "" nbsp (' ':' ':xs) = "  " ++ nbsp xs nbsp (x:xs) = x : nbsp xs nbsp [] = [] -- each position is a 0-based start and end index -- currently not allowed to overlap formatTags :: String -> [((Int,Int),TagStr -> TagStr)] -> TagStr formatTags o y = tags $ f o 0 $ sortBy (comparing $ fst . fst) y where f x i [] = str x f x i (((from,to),op):ss) | i > from = error $ "TagStr.formatTags, not allowed overlapping formats on: " ++ o | otherwise = str a ++ [op $ Str c] ++ f d to ss where (a,b) = splitAt (from-i) x (c,d) = splitAt (to-from) b tags [] = Str "" tags [x] = x tags xs = Tags xs str x = [Str x | x /= ""] hoogle-4.2.23/src/Hoogle/Type/Result.hs0000644000000000000000000000063612222103576016011 0ustar0000000000000000 module Hoogle.Type.Result where import Hoogle.Type.TagStr import Hoogle.Type.Item import Hoogle.Score.All data Result = Result {resultEntry :: Entry ,resultView :: [EntryView] ,resultScore :: Score } deriving (Eq, Show) -- return the entry rendered with respect to the EntryView renderResult :: Result -> TagStr renderResult r = renderEntryText (resultView r) $ entryText $ resultEntry r hoogle-4.2.23/src/Hoogle/Type/ParseError.hs0000644000000000000000000000205412222103576016613 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Hoogle.Type.ParseError where import Hoogle.Type.TagStr import Data.Data -- | Data type representing a parse error. All indecies are 1-based. data ParseError = ParseError {lineNo :: Int -- ^ Line number on which the error occured, 1 for the first line of a file. ,columnNo :: Int -- ^ Column number on which the error occured, 1 for the first character of a line. ,errorMessage :: String -- ^ Error message caused by the parse error. ,parseInput :: TagStr -- ^ Input string which caused the error - sometimes with a 'TagEmph' to indicate which part was incorrect. } deriving (Ord,Eq,Data,Typeable) instance Show ParseError where show (ParseError line col err _) = "Parse error " ++ show line ++ ":" ++ show col ++ ": " ++ err parseErrorWith :: Int -> Int -> String -> String -> ParseError parseErrorWith line col err text = ParseError line col err $ Tags [Str pre, TagEmph $ Str $ post ++ post2] where (pre,post) = splitAt (col-1) text post2 = if null post then " " else "" hoogle-4.2.23/src/Hoogle/Type/Language.hs0000644000000000000000000000047112222103576016253 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Hoogle.Type.Language where import General.Base -- | The languages supported by Hoogle. data Language = Haskell -- ^ The Haskell language (), along with many GHC specific extensions. deriving (Enum,Read,Show,Eq,Ord,Bounded,Data,Typeable) hoogle-4.2.23/src/Hoogle/Type/Item.hs0000644000000000000000000001234612222103576015432 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-} module Hoogle.Type.Item where import General.Base import General.Util import Hoogle.Store.All import Hoogle.Type.Docs import Hoogle.Type.TagStr import Hoogle.Type.TypeSig import Data.Generics.Uniplate type Input = ([Fact], [TextItem]) data ItemKind = PackageItem | ModuleItem | FunctionItem | DataCtorItem | TypeCtorItem | TypeSynonymItem | ClassItem | InstanceItem | UnclassifiedItem deriving (Data,Typeable,Show,Eq,Enum) instance NFData ItemKind where rnf = rnf . fromEnum data TextItem = TextItem {itemLevel :: Int -- 0 = package, 1 = module, >2 = entry ,itemKind :: ItemKind ,itemKey :: String -- how i should be searched for (name for most things, last module component for modules) ,itemName :: String -- what is the full text representation of me (key for most things, A.B.C for modules) ,itemType :: Maybe TypeSig ,itemDisp :: TagStr -- TagColor 0 for result type, TagColor 1.. for arg types, TagBold for name ,itemURL :: URL ,itemDocs :: String ,itemPriority :: Int -- priority, 0 is highest priority } deriving Show data Fact = FactAlias TypeSig TypeSig | FactInstance TypeSig | FactDataKind String Int | FactClassKind String Int | FactCtorType String String -- Ctor, Data deriving Show -- Invariant: locations will not be empty data Entry = Entry {entryLocations :: [(URL, [Once Entry])] ,entryKind :: ItemKind ,entryLevel :: Int ,entryName :: String ,entryText :: TagStr ,entryDocs :: Docs ,entryPriority :: Int ,entryKey :: String -- used only for rebuilding combined databases ,entryType :: Maybe TypeSig -- used only for rebuilding combined databases } deriving (Eq, Typeable) instance NFData Entry where rnf ent@(Entry a b c d e f g h i) = rnf (map (second $ map (f . fromOnce)) a,b,c,d,e,f,g,h,i) where f ent2 = if entryUnique ent == entryUnique ent2 then () else rnf ent2 -- | Figure out what makes this entry different from others entryUnique Entry{..} = (entryName, entryText, entryDocs, entryKey, entryType) -- | Join two entries that are equal under entryUnique entryJoin e1 e2 = e1 {entryPriority = min (entryPriority e1) (entryPriority e2) ,entryLocations = nubOn (map (entryName . fromOnce) . snd) $ concatMap entryLocations $ if entryScore e1 < entryScore e2 then [e1,e2] else [e2,e1]} entryURL e = head $ map fst (entryLocations e) ++ [""] data EntryView = FocusOn String -- characters in the range should be focused | ArgPosNum Int Int -- argument a b, a is remapped to b deriving (Eq, Show) renderEntryText :: [EntryView] -> TagStr -> TagStr renderEntryText view = transform f where cols = [(b+1,a+1) | ArgPosNum a b <- view] strs = [map toLower x | FocusOn x <- view] f (TagColor i x) = maybe x (`TagColor` x) $ lookup i $ [(0,0)|cols/=[]] ++ cols f (TagBold (Str xs)) = TagBold $ Tags $ g xs f x = x g xs | ss /= [] = TagEmph (Str a) : g b where ss = filter (`isPrefixOf` map toLower xs) strs (a,b) = splitAt (maximum $ map length ss) xs g (x:xs) = Str [x] : g xs g [] = [] -- TODO: EntryScore is over-prescriptive, and not overly useful -- Have name and type scores to it themselves, using name only -- to break ties when merging -- the entry priority -- the name of the entry, in lower case -- the name of the entry data EntryScore = EntryScore Int String String deriving (Eq,Ord) entryScore :: Entry -> EntryScore entryScore e = EntryScore (entryPriority e) (map toLower $ entryName e) (entryName e) instance Show Entry where show = showTagText . entryText instance Store Entry where put (Entry a b c d e f g h i) = put9 a b c d e f g h i get = get9 Entry instance Store Fact where put (FactAlias x y) = putByte 0 >> put2 x y put (FactInstance x) = putByte 1 >> put1 x put (FactDataKind x y) = putByte 2 >> put2 x y put (FactClassKind x y) = putByte 3 >> put2 x y put (FactCtorType x y) = putByte 4 >> put2 x y get = do i <- getByte case i of 0 -> get2 FactAlias 1 -> get1 FactInstance 2 -> get2 FactDataKind 3 -> get2 FactClassKind 4 -> get2 FactCtorType instance Store ItemKind where put PackageItem = putByte 0 put ModuleItem = putByte 1 put FunctionItem = putByte 2 put DataCtorItem = putByte 4 put TypeCtorItem = putByte 5 put TypeSynonymItem = putByte 6 put ClassItem = putByte 7 put InstanceItem = putByte 8 put UnclassifiedItem = putByte 9 get = do i <- getByte case i of 0 -> get0 PackageItem 1 -> get0 ModuleItem 2 -> get0 FunctionItem 3 -> get0 FunctionItem 4 -> get0 DataCtorItem 5 -> get0 TypeCtorItem 6 -> get0 TypeSynonymItem 7 -> get0 ClassItem 8 -> get0 InstanceItem 9 -> get0 UnclassifiedItem hoogle-4.2.23/src/Hoogle/Type/Docs.hs0000644000000000000000000000454312222103576015424 0ustar0000000000000000 module Hoogle.Type.Docs( Docs, readDocsHTML, renderDocs ) where import General.Base import Hoogle.Type.TagStr import Hoogle.Store.All import Data.ByteString.Char8(ByteString,pack,unpack) newtype Docs = Docs ByteString deriving (Eq,Ord) instance Store Docs where put (Docs x) = put1 x get = get1 Docs readDocsHTML :: String -> Docs readDocsHTML = Docs . pack renderDocs :: Docs -> TagStr renderDocs (Docs xs) = tags $ f False $ parseHTML $ unpack xs where nl = Char '\n' -- boolean, are you in a pre block f False (Char '\n':Char '\n':xs) = Str "\n\n" : f False (dropWhile (== nl) xs) f False (Char '\n':xs) = Str " " : f False xs f True (Char '\n':xs) = Str "\n" : Str "> " : f True xs -- TODO: tt is ignored, add a TagMonospage? f pre (Tag "tt" x:xs) = f pre (x++xs) f pre (Tag [t,'l'] x:xs) | t `elem` "ou" = tail $ f pre (filter (/= nl) x ++ xs) f pre (Tag "pre" x:xs) = let ys = init $ tail $ f True x in if null ys then ys else init ys ++ f pre xs f pre (Tag "li" x:xs) = Str "\n" : Str "* " : f pre x ++ f pre xs f pre (Tag "a" x:xs) = TagLink "" (tags $ f pre x) : f pre xs f pre (Tag "i" x:xs) = TagEmph (tags $ f pre x) : f pre xs f pre (Tag "em" x:xs) = TagEmph (tags $ f pre x) : f pre xs f pre (Tag "b" x:xs) = TagBold (tags $ f pre x) : f pre xs f pre (Tag n x:xs) = Str (show (Tag n x)) : f pre xs f pre (Char x:xs) = Str [x] : f pre xs f pre [] = [] --------------------------------------------------------------------- -- PARSER type Tags = [Tag] data Tag = Char Char | Tag String Tags deriving (Eq,Show) parseHTML :: String -> Tags parseHTML = fst . readHTML ">" readHTML :: String -> String -> (Tags, String) readHTML name = f where f ('&':'a':'m':'p':';':xs) = g xs $ Char '&' f ('&':'g':'t':';':xs) = g xs $ Char '>' f ('&':'l':'t':';':xs) = g xs $ Char '<' f ('<':'/':xs) | a == name = ([], drop 1 b) where (a,b) = break (== '>') xs f ('<':xs) | not $ "/" `isPrefixOf` xs = g d $ Tag a c where (a,b) = break (== '>') xs (c,d) = readHTML a $ drop 1 b f (x:xs) = g xs $ Char x f [] = ([],[]) g rest add = (add:a,b) where (a,b) = f rest hoogle-4.2.23/src/Hoogle/Type/All.hs0000644000000000000000000000043612222103576015241 0ustar0000000000000000 module Hoogle.Type.All(module X) where import Hoogle.Type.Docs as X import Hoogle.Type.Item as X import Hoogle.Type.Language as X import Hoogle.Type.ParseError as X import Hoogle.Type.Result as X import Hoogle.Type.TagStr as X import Hoogle.Type.TypeSig as X hoogle-4.2.23/src/Hoogle/Store/0000755000000000000000000000000012222103576014345 5ustar0000000000000000hoogle-4.2.23/src/Hoogle/Store/WriteBuffer.hs0000644000000000000000000000621712222103576017133 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, RecordWildCards #-} -- I tried switching to blaze-builder, but this buffer is massively faster module Hoogle.Store.WriteBuffer( Buffer, withBuffer, putStorable, putByteString, patch, getPos ) where import General.Base import General.System import Data.IORef import Foreign import qualified Data.ByteString as BS import qualified Data.ByteString.Internal as BS import General.Util bufferSize = 10000 :: Word32 -- (number in file, number in buffer) data Buffer = Buffer {handle :: Handle -- the handle we are writing to ,ptr :: Ptr () -- the current buffer ,inFile :: IORef Word32 -- the number of bytes on the disk ,inBuffer :: IORef Word32 -- the number of bytes in the buffer ,patchup :: IORef [Patchup] } data Patchup = !Word32 := !Word32 writeRef ref v = v `seq` writeIORef ref v modifyRef ref f = writeRef ref . f =<< readIORef ref withBuffer :: Handle -> (Buffer -> IO a) -> IO a withBuffer handle f = do inFile <- newIORef . fromInteger =<< hTell handle inBuffer <- newIORef 0 patchup <- newIORef [] allocaBytes (fromIntegral bufferSize) $ \ptr -> do res <- f $ Buffer handle ptr inFile inBuffer patchup inBuf <- readIORef inBuffer when (inBuf > 0) $ hPutBuf handle ptr (fromIntegral inBuf) xs <- fmap (sortOn $ \(a := b) -> a) $ readIORef patchup forM_ xs $ \(pos := val) -> do hSeek handle AbsoluteSeek $ toInteger pos poke (castPtr ptr) val hPutBuf handle ptr $ sizeOf val return res put :: Buffer -> Word32 -> (Handle -> IO ()) -> (Ptr a -> Int -> IO ()) -> IO () put _ 0 _ _ = return () put Buffer{..} sz toFile toBuffer = do inBuf <- readIORef inBuffer if inBuf + sz >= bufferSize then do when (inBuf > 0) $ hPutBuf handle ptr $ fromIntegral inBuf if sz >= bufferSize `div` 2 then do toFile handle modifyRef inFile (+ (inBuf+sz)) writeRef inBuffer 0 else do toBuffer (castPtr ptr) 0 modifyRef inFile (+inBuf) writeRef inBuffer sz else do toBuffer (castPtr ptr) $ fromIntegral inBuf writeIORef inBuffer (inBuf+sz) putStorable :: Storable a => Buffer -> a -> IO () putStorable buf x = put buf (fromIntegral sz) (\h -> allocaBytes (sizeOf x) $ \ptr -> poke ptr x >> hPutBuf h ptr sz) (\ptr pos -> pokeByteOff ptr pos x) where sz = sizeOf x putByteString :: Buffer -> BS.ByteString -> IO () putByteString buf x = put buf (fromIntegral $ BS.length x) (`BS.hPut` x) $ \ptr pos -> let (fp,offset,len) = BS.toForeignPtr x in withForeignPtr fp $ \p -> BS.memcpy (plusPtr ptr pos) (plusPtr p offset) (fromIntegral len) getPos :: Buffer -> IO Word32 getPos Buffer{..} = liftM2 (+) (readIORef inFile) (readIORef inBuffer) -- Patch at position p, with value v. p must be in the past. -- Return True if you succeeded, False if that is already on disk patch :: Buffer -> Word32 -> Word32 -> IO () patch Buffer{..} p v = do i <- readIORef inFile if p >= i then pokeByteOff ptr (fromIntegral $ p-i) v else modifyRef patchup $ (:) (p := v) hoogle-4.2.23/src/Hoogle/Store/Type.hs0000644000000000000000000001255012222103576015625 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-} module Hoogle.Store.Type( Once, once, fromOnce, putOnce, getOnce, SPut, runSPut, putByteString, putStorable, putDefer, SGet, runSGet, getByteString, getStorable, getDefer, getLazyList ) where import General.Base import General.System import Control.Monad.IO.Class import Control.Monad.Trans.Reader import qualified Data.IntMap as IntMap import Data.IORef import Data.Typeable import Foreign import System.IO.Unsafe import qualified Hoogle.Store.ReadBuffer as R import qualified Hoogle.Store.WriteBuffer as W -- | Turn on to see file statistics stats = False -- | All once values are equal with respect to keyOnce -- If you create it with 'once' it will have the same key. -- If two are loaded from a file they are equal. data Once a = Once {_onceKey :: Int, valueOnce :: a} deriving Typeable instance NFData a => NFData (Once a) where rnf (Once a b) = rnf (a,b) fromOnce :: Once a -> a fromOnce = valueOnce -- | Given how many you would like to allocate, return your base address onceKeys :: Int -> IO Int onceKeys = System.IO.Unsafe.unsafePerformIO $ do ref <- newIORef 0 return $ \n -> atomicModifyIORef ref $ \x -> (x+n, x) --------------------------------------------------------------------- -- PUT data SPutS = SPutS {putBuffer :: W.Buffer ,putOnces :: IORef (IntMap.IntMap PutOnce) ,putPending :: IORef [SPut ()] } type SPut a = ReaderT SPutS IO a modifyRef f x = liftIO . (`modifyIORef` x) =<< asks f readPos = liftIO . W.getPos =<< asks putBuffer runSPut :: FilePath -> SPut () -> IO () runSPut file act = withBinaryFile file WriteMode $ \h -> do pending <- newIORef [act] once <- newIORef IntMap.empty W.withBuffer h $ \buffer -> do let flush = do xs <- liftIO $ readIORef pending liftIO $ writeIORef pending [] forM_ xs $ \x -> do x flush runReaderT flush $ SPutS buffer once pending putByteString :: BString -> SPut () putByteString x = do buf <- asks putBuffer liftIO $ W.putByteString buf x putStorable :: Storable a => a -> SPut () putStorable x = do buf <- asks putBuffer liftIO $ W.putStorable buf x putDefer :: SPut () -> SPut () putDefer act = do pos <- readPos putStorable (0 :: Word32) modifyRef putPending $ (:) $ do val <- readPos buf <- asks putBuffer liftIO $ W.patch buf pos val act {-# NOINLINE once #-} once :: a -> Once a once x = System.IO.Unsafe.unsafePerformIO $ do key <- onceKeys 1 return $ Once key x type PutOnce = Either [Word32] Word32 putOnce :: (a -> SPut ()) -> Once a -> SPut () putOnce act (Once key x) = do ref <- asks putOnces mp <- liftIO $ readIORef ref case fromMaybe (Left []) $ IntMap.lookup key mp of -- written out at this address Right val -> putStorable val -- [] is has not been added to the defer list -- (:) is on defer list but not yet written, these are places that need back patching Left poss -> do pos <- readPos liftIO $ writeIORef ref $ IntMap.insert key (Left $ pos:poss) mp putStorable (0 :: Word32) when (null poss) $ modifyRef putPending $ (:) $ do val <- readPos mp <- liftIO $ readIORef ref let Left poss = mp IntMap.! key buf <- asks putBuffer liftIO $ forM_ poss $ \pos -> W.patch buf pos val liftIO $ writeIORef ref $ IntMap.insert key (Right val) mp act x --------------------------------------------------------------------- -- GET -- getPtr is the pointer you have, how much is left valid, data SGetS = SGetS {getBuffer :: R.Buffer, onceBase :: Int} type SGet a = ReaderT SGetS IO a runSGet :: Typeable a => FilePath -> SGet a -> IO a runSGet file m = do h <- openBinaryFile file ReadMode sz <- hFileSize h buf <- R.newBuffer h one <- onceKeys $ fromIntegral sz runReaderT (getDeferFrom 0 m) $ SGetS buf one getStorable :: Typeable a => Storable a => SGet a getStorable = do buf <- asks getBuffer res <- liftIO $ R.getStorable buf when stats $ liftIO $ putStrLn $ "Reading storable " ++ show (sizeOf res) return res getByteString :: Word32 -> SGet BString getByteString len = do buf <- asks getBuffer when stats $ liftIO $ putStrLn $ "Reading bytestring " ++ show len liftIO $ R.getByteString buf $ fromIntegral len getDefer :: Typeable a => SGet a -> SGet a getDefer get = do pos :: Word32 <- getStorable getDeferFrom pos get getDeferFrom :: forall a . Typeable a => Word32 -> SGet a -> SGet a getDeferFrom pos get = do s <- ask liftIO $ unsafeInterleaveIO $ do when stats $ putStrLn $ "Read at " ++ show (typeOf (undefined :: a)) R.setPos (getBuffer s) pos runReaderT get s getOnce :: Typeable a => SGet a -> SGet (Once a) getOnce get = do pos :: Word32 <- getStorable x <- getDeferFrom pos get one <- asks onceBase return $ Once (fromIntegral pos + one) x getLazyList :: SGet a -> Int -> Int -> SGet [a] getLazyList get size n = do s <- ask pos <- liftIO $ R.getPos $ getBuffer s liftIO $ forM [0..n-1] $ \i -> unsafeInterleaveIO $ do R.setPos (getBuffer s) (pos + fromIntegral (i * size)) runReaderT get s hoogle-4.2.23/src/Hoogle/Store/ReadBuffer.hs0000644000000000000000000000211112222103576016701 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, RecordWildCards #-} module Hoogle.Store.ReadBuffer( Buffer, newBuffer, setPos, getPos, getStorable, getByteString, ) where import General.Base import General.System import Foreign import qualified Data.ByteString as BS bufferSize = 100 :: Int data Buffer = Buffer {handle :: Handle, fptr :: ForeignPtr ()} newBuffer :: Handle -> IO Buffer newBuffer handle = do ptr <- mallocForeignPtrBytes bufferSize return $ Buffer handle ptr getPos :: Buffer -> IO Word32 getPos Buffer{..} = fmap fromIntegral $ hTell handle setPos :: Buffer -> Word32 -> IO () setPos b@Buffer{..} pos = do hSeek handle AbsoluteSeek $ fromIntegral pos getStorable :: forall a . Storable a => Buffer -> IO a getStorable Buffer{..} = do let n = sizeOf (undefined :: a) when (n > bufferSize) $ error $ "Buffer size overflow in getStorable" withForeignPtr fptr $ \ptr -> do hGetBuf handle ptr $ sizeOf (undefined :: a) peek $ castPtr ptr getByteString :: Buffer -> Int -> IO BString getByteString Buffer{..} n = BS.hGet handle n hoogle-4.2.23/src/Hoogle/Store/All.hs0000644000000000000000000001532112222103576015413 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} module Hoogle.Store.All( SPut, SGet, runSPut, runSGet, Once, fromOnce, once, getDefer, putDefer, module Hoogle.Store.All ) where import General.Base import Foreign(sizeOf) import Hoogle.Store.Type import qualified Data.Map as Map import qualified Data.ByteString as BS import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Array class Store a where put :: a -> SPut () get :: SGet a -- FIXME: unnecessary, just do an accumulator building up in reverse getList :: Int -> SGet [a] getList n = replicateM n get putList :: [a] -> SPut () putList = mapM_ put size :: a -> Maybe Int -- may not look at the size argument size _ = Nothing newtype Defer a = Defer {fromDefer :: a} instance NFData a => NFData (Defer a) where rnf = rnf . fromDefer instance Eq a => Eq (Defer a) where a == b = fromDefer a == fromDefer b instance Ord a => Ord (Defer a) where compare a b = compare (fromDefer a) (fromDefer b) instance Show a => Show (Defer a) where show = show . fromDefer instance (Typeable a, Store a) => Store (Defer a) where put = putDefer . put . fromDefer get = fmap Defer $ getDefer get size _ = Just 4 instance Eq a => Eq (Once a) where a == b = fromOnce a == fromOnce b instance Ord a => Ord (Once a) where compare a b = compare (fromOnce a) (fromOnce b) instance Show a => Show (Once a) where show = show . fromOnce instance (Typeable a, Store a) => Store (Once a) where put = putOnce put get = getOnce get size _ = Just 4 errorSGet :: String -> SGet a errorSGet typ = error $ "Store.get(" ++ typ ++ "), corrupt database" get0 f = return f get1 f = do x1 <- get; return (f x1) get2 f = do x1 <- get; x2 <- get; return (f x1 x2) get3 f = do x1 <- get; x2 <- get; x3 <- get; return (f x1 x2 x3) get4 f = do x1 <- get; x2 <- get; x3 <- get; x4 <- get; return (f x1 x2 x3 x4) get5 f = do x1 <- get; x2 <- get; x3 <- get; x4 <- get; x5 <- get; return (f x1 x2 x3 x4 x5) get6 f = do x1 <- get; x2 <- get; x3 <- get; x4 <- get; x5 <- get; x6 <- get; return (f x1 x2 x3 x4 x5 x6) get7 f = do x1 <- get; x2 <- get; x3 <- get; x4 <- get; x5 <- get; x6 <- get; x7 <- get; return (f x1 x2 x3 x4 x5 x6 x7) get8 f = do x1 <- get; x2 <- get; x3 <- get; x4 <- get; x5 <- get; x6 <- get; x7 <- get; x8 <- get; return (f x1 x2 x3 x4 x5 x6 x7 x8) get9 f = do x1 <- get; x2 <- get; x3 <- get; x4 <- get; x5 <- get; x6 <- get; x7 <- get; x8 <- get; x9 <- get; return (f x1 x2 x3 x4 x5 x6 x7 x8 x9) put0 = return () :: SPut () put1 x1 = put x1 put2 x1 x2 = put x1 >> put x2 put3 x1 x2 x3 = put x1 >> put x2 >> put x3 put4 x1 x2 x3 x4 = put x1 >> put x2 >> put x3 >> put x4 put5 x1 x2 x3 x4 x5 = put x1 >> put x2 >> put x3 >> put x4 >> put x5 put6 x1 x2 x3 x4 x5 x6 = put x1 >> put x2 >> put x3 >> put x4 >> put x5 >> put x6 put7 x1 x2 x3 x4 x5 x6 x7 = put x1 >> put x2 >> put x3 >> put x4 >> put x5 >> put x6 >> put x7 put8 x1 x2 x3 x4 x5 x6 x7 x8 = put x1 >> put x2 >> put x3 >> put x4 >> put x5 >> put x6 >> put x7 >> put x8 put9 x1 x2 x3 x4 x5 x6 x7 x8 x9 = put x1 >> put x2 >> put x3 >> put x4 >> put x5 >> put x6 >> put x7 >> put x8 >> put x9 putByte :: Word8 -> SPut (); putByte = put getByte :: SGet Word8; getByte = get putWord32 :: Word32 -> SPut (); putWord32 = put getWord32 :: SGet Word32; getWord32 = get instance Store Word8 where put = putStorable get = getStorable size = Just . sizeOf instance Store Word32 where put = putStorable get = getStorable size = Just . sizeOf instance Store Int32 where put = putStorable get = getStorable size = Just . sizeOf instance Store Int where put x = putStorable (fromIntegral x :: Int32) get = fmap fromIntegral (getStorable :: SGet Int32) size _ = size (0 :: Int32) instance Store Char where put x | x < '\x80' = putByte . fromIntegral . ord $ x -- ASCII | otherwise = putByteString . T.encodeUtf8 . T.singleton $ x get = do c0 <- getByte n <- case c0 of _ | c0 < 0x80 -> return 0 -- ASCII _ | c0 < 0xc0 -> fail "invalid UTF8 sequence" _ | c0 < 0xe0 -> return 1 _ | c0 < 0xf0 -> return 2 _ | c0 < 0xf8 -> return 3 _ | c0 < 0xfc -> return 4 _ | c0 < 0xfe -> return 5 if n > 0 then fmap (T.head . T.decodeUtf8 . BS.cons c0) $ getByteString n else return $ chr $ fromIntegral $ c0 -- ASCII putList = putByteString . T.encodeUtf8 . T.pack instance Store Bool where put x = put $ if x then '1' else '0' get = fmap (== '1') get size _ = size '1' instance Store () where put () = return () get = return () size _ = Just 0 instance (Store a, Store b) => Store (a,b) where put (a,b) = put2 a b get = get2 (,) size ~(a,b) = liftM2 (+) (size a) (size b) instance (Store a, Store b, Store c) => Store (a,b,c) where put (a,b,c) = put3 a b c get = get3 (,,) size ~(a,b,c) = liftM3 (\a b c -> a + b + c) (size a) (size b) (size c) instance Store a => Store (Maybe a) where put Nothing = putByte 0 put (Just a) = putByte 1 >> put a get = do i <- getByte case i of 0 -> get0 Nothing 1 -> get1 Just _ -> errorSGet "Maybe" instance (Store a, Store b) => Store (Either a b) where put (Left a) = putByte 0 >> put a put (Right a) = putByte 1 >> put a get = do i <- getByte case i of 0 -> get1 Left 1 -> get1 Right _ -> errorSGet "Either" -- strategy: write out a byte, 255 = length is an int, anything else = len instance Store a => Store [a] where put xs = do let n = fromIntegral (length xs) let mx = maxBound :: Word8 if n >= fromIntegral mx then putByte mx >> putWord32 n else putByte (fromIntegral n) putList xs get = do n <- getByte n <- if n == maxBound then getWord32 else return $ fromIntegral n getList $ fromIntegral n instance Store BS.ByteString where put x = do putWord32 $ fromIntegral $ BS.length x putByteString x get = do n <- getWord32 getByteString n instance (Ix i, Store i, Store e) => Store (Array i e) where put x = do put $ bounds x putList $ elems x get = do bnd <- get fmap (listArray bnd) $ case size (undefined :: e) of Nothing -> getList $ rangeSize bnd Just sz -> getLazyList get sz (rangeSize bnd) instance (Typeable k, Typeable v, Ord k, Store k, Store v) => Store (Map.Map k v) where put = putDefer . put . Prelude.map (second Defer) . Map.toAscList get = getDefer $ fmap (Map.fromAscList . Prelude.map (second fromDefer)) get hoogle-4.2.23/src/Hoogle/Search/0000755000000000000000000000000012222103576014456 5ustar0000000000000000hoogle-4.2.23/src/Hoogle/Search/Results.hs0000644000000000000000000000627412222103576016464 0ustar0000000000000000 module Hoogle.Search.Results( mergeDataBaseResults, mergeQueryResults ) where import General.Base import General.Util import qualified Data.Map as Map import Hoogle.Store.All import Hoogle.Type.All import Hoogle.Query.All --------------------------------------------------------------------- -- KEYS data Key k v = Key k v instance Eq k => Eq (Key k v) where Key k1 v1 == Key k2 v2 = k1 == k2 instance Ord k => Ord (Key k v) where compare (Key k1 v1) (Key k2 v2) = compare k1 k2 toKey f v = Key (f v) v fromKey (Key k v) = v --------------------------------------------------------------------- -- MERGE DATABASE mergeDataBaseResults :: [[Result]] -> [Result] mergeDataBaseResults = map fromKey . fold [] merge . map (map $ toKey f) where f r = (resultScore r, entryScore $ resultEntry r) --------------------------------------------------------------------- -- MERGE QUERY -- each query is correct, elements can be ordered by entry Id mergeQueryResults :: Query -> [[Result]] -> [Result] mergeQueryResults q = filterResults q . joinResults -- join the results of multiple searches -- FIXME: this looks like a disaster - fully strict joinResults :: [[Result]] -> [Result] joinResults [] = [] joinResults [x] = x joinResults xs = Map.elems $ fold1 (Map.intersectionWith join) $ map asSet xs where asSet = Map.fromList . map (entryUnique . resultEntry &&& id) join r1 r2 = r1{resultScore = resultScore r1 <> resultScore r2 ,resultView = resultView r1 ++ resultView r2 ,resultEntry = resultEntry r1 `entryJoin` resultEntry r2} --------------------------------------------------------------------- -- FILTER -- | Apply the PlusModule, MinusModule and MinusPackage modes filterResults :: Query -> [Result] -> [Result] filterResults q = f mods (correctModule (exactSearch q)) . f pkgs correctPackage where f [] act = id f xs act = filter (act xs . resultEntry) mods = [x | x@(Scope _ Module _) <- scope q] pkgs = [x | Scope False Package x <- scope q] -- pkgs is a non-empty list of MinusPackage values correctPackage :: [String] -> Entry -> Bool correctPackage pkgs x = null myPkgs || any (maybe True (`notElem` map (map toLower) pkgs)) myPkgs where myPkgs = map (fmap (map toLower . entryName . fromOnce) . listToMaybe . snd) $ entryLocations x -- mods is a non-empty list of PlusModule/MinusModule correctModule :: Maybe ItemKind -> [Scope] -> Entry -> Bool correctModule kind mods x = null myMods || any (maybe True (f base mods)) myMods where myMods = map (fmap (map (if isJust kind then id else toLower) . entryName . fromOnce) . listToMaybe . drop 1 . snd) $ entryLocations x base = case head mods of Scope False Module _ -> True; _ -> False f z [] y = z f z (Scope b Module x:xs) y | doesMatch (map (if isJust kind then id else 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 doesMatch x y = if isJust kind then x == y else x `isPrefixOf` y || ('.':x) `isInfixOf` y hoogle-4.2.23/src/Hoogle/Search/All.hs0000644000000000000000000000217312222103576015525 0ustar0000000000000000 module Hoogle.Search.All(search) where import Data.List (sortBy) import Data.Maybe import Data.Ord (comparing) import Hoogle.DataBase.All import Hoogle.Query.All import Hoogle.Search.Results import Hoogle.Type.All import Hoogle.Store.All -- return all the results, lazily search :: [DataBase] -> Query -> [Result] search databases query = getResults query databases getResults :: Query -> [DataBase] -> [Result] getResults query = sortBy ((if invertResults query then flip else id) $ comparing resultScore) . mergeDataBaseResults . map (mergeQueryResults query . f) where f d = [ typeSearch d q | Just q <- [typeSig query], isNothing (exactSearch query) ] ++ map (nameSearch d (exactSearch query)) (names query) nameSearch :: DataBase -> Maybe ItemKind -> String -> [Result] nameSearch db kind query = [ Result (fromOnce e) [v] s | (e,v,s) <- (maybe searchName searchExactName kind) db query ] typeSearch :: DataBase -> TypeSig -> [Result] typeSearch db query = [Result (fromOnce e) v s | (e,v,s) <- searchType db query] hoogle-4.2.23/src/Hoogle/Score/0000755000000000000000000000000012222103576014324 5ustar0000000000000000hoogle-4.2.23/src/Hoogle/Score/Type.hs0000644000000000000000000000407412222103576015606 0ustar0000000000000000 module Hoogle.Score.Type( Score, TypeCost(..), TextMatch(..), textScore, typeScore, scoreCosts, cost ) where import Data.List import Data.Monoid data TypeCost = CostAliasFwd | CostAliasBwd | CostUnbox | CostRebox | CostRestrict | CostUnrestrict | CostDupVarResult | CostDupVarQuery | CostInstanceDel | CostInstanceAdd | CostDeadArg | CostArgReorder deriving (Show,Eq,Ord,Enum,Bounded) cost :: TypeCost -> Int cost CostAliasFwd = 1 -- 1..1000 cost CostAliasBwd = 1 -- 1..997 cost CostUnbox = 5 -- 5..1000 cost CostRebox = 4 -- 4..999 cost CostRestrict = 5 -- 5..1000 cost CostUnrestrict = 4 -- 4..1000 cost CostDupVarResult = 4 -- 4..999 cost CostDupVarQuery = 5 -- 5..1000 cost CostInstanceDel = 4 -- 4..999 cost CostInstanceAdd = 4 -- 4..999 cost CostDeadArg = 3 -- 3..998 cost CostArgReorder = 1 -- 1..1000 data TextMatch = MatchExact | MatchPrefix | MatchExactCI -- exact letter match, but case mismatch | MatchPrefixCI | MatchSubstr deriving (Show,Eq,Ord,Enum,Bounded) -- | A score, representing how close a match is. Lower scores are better. data Score = Score Int [TypeCost] [TextMatch] instance Monoid Score where mempty = Score 0 [] [] mappend (Score x1 x2 x3) (Score y1 y2 y3) = Score (x1+y1) (sort $ x2++y2) (sort $ x3++y3) textScore :: TextMatch -> Score textScore x = Score 0 [] [x] typeScore :: [TypeCost] -> Score typeScore xs = Score (sum $ map cost xs) (sort xs) [] scoreCosts :: Score -> [TypeCost] scoreCosts (Score _ x _) = x instance Show Score where show (Score _ a b) = intercalate "+" $ map (drop 4 . show) a ++ map (drop 5 . show) b instance Eq Score where Score x1 x2 [] == Score y1 y2 y3 = [] == y3 || x1 == y1 Score x1 x2 x3 == Score y1 y2 [] = x3 == [] || x1 == y1 Score x1 x2 x3 == Score y1 y2 y3 = head x3 == head y3 || x1 == y1 instance Ord Score where compare (Score x1 x2 x3) (Score y1 y2 y3) = compare (x3,x1) (y3,y1) hoogle-4.2.23/src/Hoogle/Score/Scoring.hs0000644000000000000000000000430112222103576016262 0ustar0000000000000000 module Hoogle.Score.Scoring(scoring) where import Hoogle.Score.Type import Data.List import Control.Arrow import Data.Ord import Data.Maybe import Control.Monad import System.Random -- | Given a set of scores, where the first is lower than the second, returns details for how to rank scores. -- This function is in the 'IO' monad since it may require randomness, and it may output status messages while solving, -- particularly if in Verbose mode. scoring :: [(Score,Score)] -> IO String scoring xs = do let cost ys = sum [max 0 $ 1 + vals a - vals b | (a,b) <- xs ,let vals = sum . map (fromRange . fromJust . flip lookup ys) . scoreCosts] config <- solveConfig cost [(x::TypeCost, toRange [1..10]) | x <- [minBound..maxBound]] return $ unlines ["cost " ++ show a ++ " = " ++ show (fromRange b) | (a,b) <- config] --------------------------------------------------------------------- -- SOLVER type Cost = Int -- zipper on the value data Range a = Range [a] a [a] deriving Show toRange (x:xs) = Range [] x xs fromRange (Range _ x _) = x type Config = [(TypeCost,Range Int)] bestConfig f = snd . minimumBy (comparing fst) . map (f &&& id) nextRange (Range a b c) = [Range as a (b:c) | a:as <- [a]] ++ [Range (b:a) c cs | c:cs <- [c]] nextConfig = perturb $ \(a,b) -> map ((,) a) $ nextRange b randomRange (Range x y z) = do let xs = reverse x ++ y:z i <- randomRIO (0,length xs-1) let (x2,y2:z2) = splitAt i xs return $ Range (reverse x2) y2 z2 randomConfig = mapM $ \(a,b) -> fmap ((,) a) $ randomRange b -- | Greedy hill climbing to improve a config improveConfig :: (Config -> Cost) -> Config -> Config improveConfig f now | f next < f now = improveConfig f next | otherwise = now where next = bestConfig f $ nextConfig now -- | Try and minimize the cost of the config solveConfig :: (Config -> Cost) -> Config -> IO Config solveConfig f x = fmap (bestConfig f) $ replicateM 25 $ do putChar '.' y <- randomConfig x let z = improveConfig f y print (f y,f z) return z -- | Perturb one value in the list perturb :: (a -> [a]) -> [a] -> [[a]] perturb f [] = [[]] perturb f (x:xs) = map (:xs) (f x) ++ map (x:) (perturb f xs) hoogle-4.2.23/src/Hoogle/Score/All.hs0000644000000000000000000000031412222103576015366 0ustar0000000000000000 module Hoogle.Score.All( module Hoogle.Score.Scoring, Score, TypeCost(..), TextMatch(..), textScore, typeScore, scoreCosts, cost ) where import Hoogle.Score.Scoring import Hoogle.Score.Type hoogle-4.2.23/src/Hoogle/Query/0000755000000000000000000000000012222103576014356 5ustar0000000000000000hoogle-4.2.23/src/Hoogle/Query/Type.hs0000644000000000000000000000356712222103576015646 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Hoogle.Query.Type where import General.Base import Hoogle.Type.All -- | A query, representing a user input. data Query = Query {names :: [String] ,typeSig :: Maybe TypeSig ,scope :: [Scope] ,exactSearch :: Maybe ItemKind ,invertResults :: Bool } deriving (Data,Typeable,Show,Eq) instance Monoid Query where mempty = Query [] Nothing [] Nothing False mappend (Query x1 x2 x3 x4 x5) (Query y1 y2 y3 y4 y5) = Query (x1++y1) (x2 `mplus` y2) (x3++y3) (merge x4 y4) (x5 || y5) where merge Nothing Nothing = Nothing merge (Just x) Nothing = Just x merge Nothing (Just y) = Just y merge (Just UnclassifiedItem) (Just y) = Just y merge (Just x) (Just UnclassifiedItem) = Just x merge (Just x) (Just _) = Just x 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 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 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) ++ [Scope b Package x | Just b <- [b]]} where f (Scope _ Package y) = x /= y f _ = True hoogle-4.2.23/src/Hoogle/Query/Suggest.hs0000644000000000000000000000375112222103576016341 0ustar0000000000000000 module Hoogle.Query.Suggest(suggestQuery) where import General.Base import General.Util import Hoogle.DataBase.All import Hoogle.Query.Type import Hoogle.Query.Render import Hoogle.Type.All suggestQuery :: [DataBase] -> Query -> Maybe TagStr -- They searched for Google (pay homage) suggestQuery db q | "google" `elem` map (map toLower) (names q) = Just $ Tags [TagLink "http://www.google.com/" (Str "Google"), Str " rocks!"] -- They searched for ?oogle (mock) suggestQuery db q | any f (names q) = Just $ Str "Can't think of anything more interesting to search for?" where f x = length x == 6 && "oogle" `isSuffixOf` x -- They searched for "Int to Float", they meant "Int -> Float" suggestQuery db q@Query{typeSig=Nothing, names=names} | length parts > 1 && all (not . null) parts = Just $ didYouMean q2 where parts = split "to" names q2 = fixup db $ q{names = [] ,typeSig = Just $ TypeSig [] t2} t2 = TFun $ map (toApp . map toLitVar) parts -- They search for "Maybe a", did they mean ":: Maybe a" suggestQuery db q@Query{typeSig=Nothing, names=names} | length names > 1 && all f names = Just $ didYouMean q2 where q2 = fixup db $ q{names = [], typeSig = Just $ TypeSig [] $ toApp $ map toLitVar names} f (x:xs) = if null xs then isLower x else isUpper x -- See what the type signature suggests from the database suggestQuery db q@Query{typeSig=Just t} = case suggestion db t of Nothing -> Nothing Just (Left s) -> Just $ TagBold $ Str s Just (Right t) -> Just $ didYouMean $ q{typeSig = Just t} suggestQuery db q = Nothing didYouMean :: Query -> TagStr didYouMean q = Tags [TagBold $ Str "Did you mean: ", TagLink "" $ Str s] where s = showTagText $ renderQuery q fixup :: [DataBase] -> Query -> Query fixup db q@Query{typeSig=Just t} = case suggestion db t of Just (Right t) -> q{typeSig=Just t} _ -> q fixup db q = q toLitVar xs@(x:_) = if isLower x then TVar xs else TLit xs toApp (x:xs) = TApp x xs hoogle-4.2.23/src/Hoogle/Query/Render.hs0000644000000000000000000000263712222103576016141 0ustar0000000000000000 module Hoogle.Query.Render(renderQuery) where import General.Base import Data.Generics.Uniplate import Hoogle.Query.Type import Hoogle.Type.All -- | Render a query, in particular using 'TagColor' for any type signature argument positions. renderQuery :: Query -> TagStr renderQuery x = Tags $ namesig ++ [Str " " | namesig /= [] && scp /= []] ++ scp where namesig = case (null (names x), isNothing (typeSig x)) of (True, True) -> [] (True, False) -> [Str ":: " | namelike] ++ showType (False, True) -> showName _ -> showName ++ [Str " :: "] ++ showType where namelike = and [isAlpha y || isSpace y | Str xs <- universe $ Tags showType , y:ys <- [dropWhile isSpace xs]] showName = intersperse (Str " ") $ map (TagBold . Str) (names x) showType = [renderTypeSig $ fromJust $ typeSig x] scp = [Str $ unwords $ map f $ scope x | scope x /= []] f (Scope b _ x) = (if b then "+" else "-") ++ x renderTypeSig :: TypeSig -> TagStr renderTypeSig (TypeSig con args) = Tags $ Str (showConstraint con) : intersperse (Str " -> ") (zipWith TagColor [1..] (map (Str . showFun) finit) ++ [TagColor 0 $ Str $ showFun flast]) where (finit, flast) = (init funcs, last funcs) funcs = splitFun args hoogle-4.2.23/src/Hoogle/Query/Parser.hs0000644000000000000000000001730212222103576016151 0ustar0000000000000000 module Hoogle.Query.Parser(parseQuery) where import Control.Applicative ((*>)) import General.Base import Hoogle.Query.Type import Hoogle.Type.All as Hoogle import Text.ParserCombinators.Parsec hiding (ParseError) import qualified Text.ParserCombinators.Parsec as Parsec parseQuery :: String -> Either ParseError Query parseQuery x = case bracketer x of Left err -> Left err Right _ -> case parse parsecQuery "" x of Left err -> Left $ toParseError x err Right x -> Right x toParseError :: String -> Parsec.ParseError -> Hoogle.ParseError toParseError src x = parseErrorWith (sourceLine pos) (sourceColumn pos) (show x) src where pos = errorPos x ascSymbols = "->!#$%&*+./<=?@\\^|~:" optionBool :: Parser a -> Parser Bool optionBool p = (p >> return True) <|> return False --------------------------------------------------------------------- -- QUERY PARSEC parsecQuery :: Parser Query parsecQuery = do spaces ; try (end names) <|> (end types) where end f = do x <- f; eof; return x names = do a <- many (flag <|> name) b <- option mempty (string "::" >> spaces >> types) let res@Query{names=names} = mappend (mconcat a) b (op,nop) = partition ((`elem` ascSymbols) . head) names if op /= [] && nop /= [] then fail "Combination of operators and names" else return res handleMatch xs = case xs of [x] -> mempty{names=[x]} xs -> mempty{names=[last xs] ,scope=[Scope True Module $ intercalate "." $ init xs]} name = (do xs <- char '*' *> keyword `sepBy1` (char '.') ; spaces return $ (handleMatch xs) { invertResults = True } <|> do x <- operator ; spaces ; return mempty{names=[x]}) <|> (do xs <- keyword `sepBy1` (char '.') ; spaces return $ handleMatch xs ) operator = between (char '(') (char ')') op <|> op op = try $ do res <- many1 $ satisfy (`elem` ascSymbols) if res == "::" then fail ":: is not an operator name" else return res types = do a <- flags b <- parsecTypeSig c <- flags return $ mconcat [a,mempty{typeSig=Just b},c] flag = try $ do x <- parseFlagScope; spaces; return x flags = fmap mconcat $ many flag -- deal with the parsing of: -- -package -- +Module.Name parseFlagScope :: Parser Query parseFlagScope = do 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 x <- letter xs <- many $ satisfy $ \x -> isAlphaNum x || x `elem` "_'#-" return $ x:xs --------------------------------------------------------------------- -- TYPESIG PARSEC parsecTypeSig :: Parser TypeSig parsecTypeSig = do whites c <- context t <- typ0 return $ normaliseTypeSig $ TypeSig c t where -- all the parser must swallow up all trailing white space after them context = try acontext <|> return [] acontext = do x <- conitems <|> fmap (:[]) conitem white $ string "=>" return x conitems = between (wchar '(') (wchar ')') $ conitem `sepBy1` wchar ',' conitem = typ1 typ0 = function typ1 = application typ2 = forAll <|> tuple <|> list <|> atom <|> bang bang = wchar '!' >> typ2 forAll = do try (white $ string "forall") many atom wchar '.' TypeSig con typ <- parsecTypeSig return typ -- match (a,b) and (,) -- also pick up ( -> ) tuple = do char '(' hash <- optionBool $ char '#' let close = white $ string $ ['#'|hash] ++ ")" whites (do wchar ',' xs <- many $ wchar ',' close return $ tLit hash (length xs + 1) ) <|> (do sym <- white keysymbol close return $ TLit sym ) <|> (do xs <- typ0 `sepBy` wchar ',' close return $ case xs of [] -> TLit "()" [x] -> x xs -> TApp (tLit hash $ length xs - 1) xs ) where tLit hash n = TLit $ "(" ++ h ++ replicate n ',' ++ h ++ ")" where h = ['#'|hash] atom = do x <- satisfy (\x -> isAlpha x || x == '_') xs <- many $ satisfy (\x -> isAlphaNum x || x `elem` "_'#") whites return $ (if isLower x || x == '_' then TVar else TLit) (x:xs) -- may be [a], or [] (then application takes the a after it) list = do char '[' colon <- optionBool $ char ':' spaces let close = white $ string $ [':'|colon] ++ "]" lit = TLit $ if colon then "[::]" else "[]" (close >> return lit) <|> (do x <- typ0 close return $ TApp lit [x]) application = do (x:xs) <- many1 (white typ2) return $ TApp x xs function = do lhs <- typ1 (do op <- white keysymbol; rhs <- function; return $ TApp (TLit op) [lhs,rhs]) <|> return lhs wchar c = white $ char c white x = do y <- x ; whites ; return y whites = many whiteChar whiteChar = oneOf " \v\f\t\r" keysymbol = try $ do x <- many1 $ satisfy (\x -> isSymbol x || x `elem` ascSymbols) if x `elem` reservedSym then fail "Bad symbol" else return x reservedSym = ["::","=>",".","=","#",":","-","+","/","--"] -------------------------------------------------------------------- -- BRACKETER openBrackets = "([" shutBrackets = ")]" data Bracket = Bracket Char [Bracket] -- Char is one of '(' or '[' | NoBracket Char deriving Show bracketer :: String -> Either ParseError [Bracket] bracketer xs = case readBracket (1,xs) of Left (msg,from,to) -> f msg from to Right (res,(i,_:_)) -> f "Unexpected closing bracket" i (1+length xs) Right (res,_) -> Right res where f msg from to = Left $ ParseError 1 from msg $ formatTags xs [((from-1,to-1),TagEmph)] type StrPos = (Int,String) -- Given a list of pos/chars return either a failure (msg,start,end) or some bracket and the remaining chars readBracket :: StrPos -> Either (String,Int,Int) ([Bracket], StrPos) readBracket (i,"") = Right ([],(i,"")) readBracket (i, x:xs) | x `elem` shutBrackets = Right ([], (i,x:xs)) | x `elem` openBrackets = case readBracket (i+1,xs) of Left e -> Left e Right (_, (j,[])) -> Left ("Closing bracket expected", i, j) Right (res, (j,y:ys)) | elemIndex x openBrackets /= elemIndex y shutBrackets -> Left ("Bracket mismatch", i, j+1) | otherwise -> case readBracket (j+1,ys) of Left e -> Left e Right (a,b) -> Right (Bracket x res:a, b) | otherwise = case readBracket (i+1,xs) of Left e -> Left e Right (a,b) -> Right (NoBracket x:a, b) hoogle-4.2.23/src/Hoogle/Query/All.hs0000644000000000000000000000026212222103576015422 0ustar0000000000000000 module Hoogle.Query.All(module X) where import Hoogle.Query.Type as X import Hoogle.Query.Parser as X import Hoogle.Query.Render as X import Hoogle.Query.Suggest as X hoogle-4.2.23/src/Hoogle/Language/0000755000000000000000000000000012222103576014774 5ustar0000000000000000hoogle-4.2.23/src/Hoogle/Language/Haskell.hs0000644000000000000000000002513312222103576016717 0ustar0000000000000000{-# LANGUAGE PatternGuards #-} module Hoogle.Language.Haskell(parseInputHaskell) where import General.Base import General.Util import Hoogle.Type.All import Language.Haskell.Exts.Annotated hiding (TypeSig,Type) import qualified Language.Haskell.Exts.Annotated as HSE import Data.Generics.Uniplate.Data type S = SrcSpanInfo parseInputHaskell :: String -> ([ParseError], Input) parseInputHaskell = join . f [] "" . zip [1..] . lines where f com url [] = [] f com url ((i,s):is) | "-- | " `isPrefixOf` s = f [drop 5 s] url is | "--" `isPrefixOf` s = f ([dropWhile isSpace $ drop 2 s | com /= []] ++ com) url is | "@url " `isPrefixOf` s = f com (drop 5 s) is | all isSpace s = f [] "" is | otherwise = (case parseLine i s of Left y -> Left y Right (as,bs) -> Right (as,[b{itemURL=if null url then itemURL b else url, itemDocs=unlines $ reverse com} | b <- bs])) : f [] "" is join xs = (err, (concat as, ripple setPriority $ ripple setModuleURL $ concat bs)) where (err,items) = unzipEithers xs (as,bs) = unzip items parseLine :: Int -> String -> Either ParseError ([Fact],[TextItem]) parseLine line x | "(##)" `isPrefixOf` x = Left $ parseErrorWith line 1 "Skipping due to HSE bug #206" "(##)" parseLine line ('@':str) = case a of "entry" | b <- words b, b /= [] -> Right $ itemEntry b "package" | [b] <- words b, b /= "" -> Right $ itemPackage b _ -> Left $ parseErrorWith line 2 ("Unknown attribute: " ++ a) $ '@':str where (a,b) = break isSpace str parseLine line x | ["module",a] <- words x = Right $ itemModule $ split '.' a parseLine line x | not continue = res | otherwise = fromMaybe res $ fmap Right $ parseTuple x `mappend` parseCtor x where (continue,res) = parseFunction line x parseFunction line x = case parseDeclWithMode defaultParseMode{extensions=exts} $ x ++ ex of ParseOk y -> (,) False $ maybe (Left $ parseErrorWith line 1 "Can't translate" $ x ++ ex) Right $ transDecl x y ParseFailed pos msg -> (,) True $ Left $ parseErrorWith line (srcColumn pos) msg $ x ++ ex where ex = if "newtype " `isPrefixOf` x then " = N T" else " " -- space to work around HSE bug #205 parseTuple o@('(':xs) | ")" `isPrefixOf` rest , ParseOk y <- parseDeclWithMode defaultParseMode{extensions=exts} $ replicate (length com + 2) 'a' ++ drop 1 rest = transDecl o $ f y where (com,rest) = span (== ',') xs f (HSE.TypeSig sl [Ident sl2 _] ty) = HSE.TypeSig sl [Ident sl2 $ '(':com++")"] ty parseTuple _ = Nothing parseCtor x = case parseDeclWithMode defaultParseMode{extensions=exts} $ "data Data where " ++ x of ParseOk y -> transDecl x $ fmap (subtractCols 16) y _ -> Nothing exts = map EnableExtension [EmptyDataDecls,TypeOperators,ExplicitForAll,GADTs,KindSignatures,MultiParamTypeClasses ,TypeFamilies,FlexibleContexts,FunctionalDependencies,ImplicitParams,MagicHash,UnboxedTuples] subtractCols :: Int -> SrcSpanInfo -> SrcSpanInfo subtractCols n (SrcSpanInfo x xs) = SrcSpanInfo (f x) (map f xs) where f x = x{srcSpanStartColumn=srcSpanStartColumn x - n, srcSpanEndColumn=srcSpanEndColumn x - n} textItem = TextItem 2 UnclassifiedItem "" "" Nothing (Str "") "" "" 0 fact x y = (x,[y]) itemPackage x = fact [] $ textItem{itemLevel=0, itemKey="", itemName=x, itemKind=PackageItem, itemURL="http://hackage.haskell.org/package/" ++ x ++ "/", itemDisp=Tags [emph "package",space,bold x]} itemEntry (x:xs) = fact [] $ textItem{itemName=y, itemKey=y, itemDisp= if null xs then bold x else Tags [emph x,space,bold y]} where y = if null xs then x else unwords xs itemModule xs = fact [] $ textItem{itemLevel=1, itemKey=last xs, itemName=intercalate "." xs, itemURL="", itemKind=ModuleItem, itemDisp=Tags [emph "module",Str $ " " ++ concatMap (++".") (init xs),bold $ last xs]} -- apply things that need to ripple down, priorities and module URL's ripple :: (Maybe TextItem -> Maybe TextItem -> TextItem -> TextItem) -> [TextItem] -> [TextItem] ripple f = fs Nothing Nothing where fs a b [] = [] fs a b (x:xs) = f a2 b2 x : fs a2 b2 xs where a2 = if itemLevel x == 0 then Just x else a b2 = if itemLevel x == 1 then Just x else b -- base::Prelude is priority 0 -- base, but not inside GHC is priority 1 -- Everything else is priority 2 setPriority pkg mod x = x{itemPriority = pri} where pri = if pkg2 == "base" && not ("GHC." `isPrefixOf` mod2) then (if mod2 == "Prelude" then 0 else 1) else 2 mod2 = maybe "" itemName mod pkg2 = maybe "" itemName pkg setModuleURL (Just pkg) _ x | itemLevel x == 1 = x{itemURL=if null $ itemURL x then f $ itemName x else itemURL x} where f xs = if "http://hackage.haskell.org/package/" `isPrefixOf` itemURL pkg then "http://hackage.haskell.org/packages/archive/" ++ itemName pkg ++ "/latest/doc/html/" ++ file else takeDirectory (itemURL pkg) ++ "/" ++ file where file = reps '.' '-' xs ++ ".html" setModuleURL _ _ x = x --------------------------------------------------------------------- -- TRANSLATE THINGS transDecl :: String -> Decl S -> Maybe ([Fact],[TextItem]) transDecl x (GDataDecl s dat ctxt hd _ [] _) = transDecl x $ DataDecl s dat ctxt hd [] Nothing transDecl x (GDataDecl _ _ _ _ _ [GadtDecl s name ty] _) = transDecl x $ HSE.TypeSig s [name] ty transDecl x (HSE.TypeSig _ [name] tyy) = Just $ fact (ctr++kinds False typ) $ textItem{itemName=nam,itemKey=nam, itemType=Just typ, itemKind=kind, itemURL="#v:" ++ esc nam, itemDisp=formatTags x $ (cols snam,TagBold) : zipWith (\i a -> (cols a,TagColor i)) [1..] as ++ [(cols b,TagColor 0)]} where (snam,nam) = findName name (as,b) = initLast $ typeArgsPos tyy ctr = [FactCtorType nam y | ctorStart $ head nam, TLit y <- [fst $ fromTApp $ last $ fromTFun ty]] typ@(TypeSig _ ty) = transTypeSig tyy ctorStart x = isUpper x || x `elem` ":(" kind | ctorStart $ head nam = DataCtorItem | otherwise = FunctionItem transDecl x (ClassDecl s ctxt hd _ _) = Just $ fact (kinds True $ transDeclHead ctxt hd) $ textItem {itemName=nam, itemKey=nam, itemKind=ClassItem ,itemURL="#t:" ++ esc nam ,itemDisp=x `formatTags` [(cols $ head $ srcInfoPoints s, TagEmph),(cols snam,TagBold)]} where (snam,nam) = findName hd transDecl x (TypeDecl s hd ty) = Just $ fact (FactAlias from to:kinds False from++kinds False to) $ textItem {itemName=nam, itemKey=nam, itemKind=TypeSynonymItem ,itemURL="#t:" ++ esc nam ,itemDisp=x `formatTags` [(cols $ head $ srcInfoPoints s, TagEmph),(cols snam,TagBold)]} where (snam,nam) = findName hd from = transDeclHead Nothing hd to = transTypeSig ty transDecl x (DataDecl _ dat ctxt hd _ _) = Just $ fact (kinds False $ transDeclHead ctxt hd) $ textItem {itemName=nam, itemKey=nam, itemKind=TypeCtorItem ,itemURL="#t:" ++ esc nam ,itemDisp=x `formatTags` [(cols $ srcInfoSpan $ ann dat, TagEmph),(cols snam,TagBold)]} where (snam,nam) = findName hd transDecl x (InstDecl _ ctxt hd _) = Just (FactInstance t:kinds True t, []) where t = transInstHead ctxt hd transDecl _ _ = Nothing esc = concatMap f where f x | isAlphaNum x = [x] | otherwise = "-" ++ show (ord x) ++ "-" typeArgsPos :: HSE.Type S -> [SrcSpan] typeArgsPos (TyForall _ _ _ x) = typeArgsPos x typeArgsPos (TyFun _ x y) = srcInfoSpan (ann x) : typeArgsPos y typeArgsPos (TyParen _ x) = typeArgsPos x typeArgsPos x = [srcInfoSpan $ ann x] cols :: SrcSpan -> (Int,Int) cols x = (srcSpanStartColumn x - 1, srcSpanEndColumn x - 1) findName :: Data a => a -> (SrcSpan,String) findName x = case universeBi x of Ident s x : _ -> (srcInfoSpan s,x) Symbol s x : _ -> (srcInfoSpan s,x) unbracket ('(':xs) | ")" `isSuffixOf` xs && nub ys `notElem` ["",","] = ys where ys = init xs unbracket x = x transType :: HSE.Type S -> Type transType (TyForall _ _ _ x) = transType x transType (TyFun _ x y) = TFun $ transType x : fromTFun (transType y) transType (TyTuple _ x xs) = tApp (TLit $ "(" ++ h ++ replicate (length xs - 1) ',' ++ h ++ ")") $ map transType xs where h = ['#' | x == Unboxed] transType (TyList _ x) = TApp (TLit "[]") [transType x] transType (TyApp _ x y) = tApp a (b ++ [transType y]) where (a,b) = fromTApp $ transType x transType (TyVar _ x) = TVar $ prettyPrint x transType (TyCon _ x) = TLit $ unbracket $ prettyPrint x transType (TyParen _ x) = transType x transType (TyInfix _ y1 x y2) = TApp (TLit $ unbracket $ prettyPrint x) [transType y1, transType y2] transType (TyKind _ x _) = transType x transContext :: Maybe (Context S) -> Constraint transContext = maybe [] g where g (CxSingle _ x) = f x g (CxTuple _ xs) = concatMap f xs g (CxParen _ x) = g x g _ = [] f (ClassA _ x ys) = [TApp (TLit $ unbracket $ prettyPrint x) $ map transType ys] f (InfixA s y1 x y2) = f $ ClassA s x [y1,y2] f _ = [] transTypeSig :: HSE.Type S -> TypeSig transTypeSig (TyParen _ x) = transTypeSig x transTypeSig (TyForall _ _ con ty) = TypeSig (transContext con) $ transType ty transTypeSig x = TypeSig [] $ transType x transDeclHead :: Maybe (Context S) -> DeclHead S -> TypeSig transDeclHead x y = TypeSig (transContext x) $ f y where f (DHead _ name vars) = TApp (TLit $ unbracket $ prettyPrint name) $ map transVar vars f (DHParen _ x) = f x f (DHInfix s x y z) = f $ DHead s y [x,z] transInstHead :: Maybe (Context S) -> InstHead S -> TypeSig transInstHead x y = TypeSig (transContext x) $ f y where f (IHead _ name vars) = TApp (TLit $ unbracket $ prettyPrint name) $ map transType vars f (IHParen _ x) = f x f (IHInfix s x y z) = f $ IHead s y [x,z] transVar :: TyVarBind S -> Type transVar (KindedVar _ nam _) = TVar $ prettyPrint nam transVar (UnkindedVar _ nam) = TVar $ prettyPrint nam --------------------------------------------------------------------- emph = TagEmph . Str bold = TagBold . Str space = Str " " -- collect the kind facts, True for the outer fact is about a class kinds :: Bool -> TypeSig -> [Fact] kinds cls (TypeSig x y) = concatMap (f True) x ++ f cls y where f cls (TApp (TLit c) ys) = add cls c (length ys) ++ if cls then [] else concatMap (f False) ys f cls (TLit c) = add cls c 0 f cls x = if cls then [] else concatMap (f False) $ children x add cls c i = [(if cls then FactClassKind else FactDataKind) c i | not $ isTLitTuple c] hoogle-4.2.23/src/Hoogle/DataBase/0000755000000000000000000000000012222103576014715 5ustar0000000000000000hoogle-4.2.23/src/Hoogle/DataBase/Type.hs0000644000000000000000000000315212222103576016173 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Hoogle.DataBase.Type(module Hoogle.DataBase.Type, module X) where import Hoogle.DataBase.Items as X import Hoogle.DataBase.Suggest as X import Hoogle.DataBase.Aliases as X import Hoogle.DataBase.Instances as X import Hoogle.DataBase.SubstrSearch as X import Hoogle.DataBase.TypeSearch.All as X import Hoogle.Store.All import Hoogle.Type.All import General.Base -- suggest, aliases and instances are used for linking with packages -- that depend on this database data DataBase = DataBase {items :: Items ,nameSearch :: SubstrSearch (Once Entry) ,typeSearch :: TypeSearch ,suggest :: Suggest ,aliases :: Aliases ,instances :: Instances } deriving Typeable instance NFData DataBase where rnf (DataBase a b c d e f) = rnf (a,b,c,d,e,f) instance Store DataBase where put (DataBase a b c d e f) = put6 a b c d e f get = get6 DataBase instance Show DataBase where show = concatMap snd . showDataBaseParts showDataBaseParts :: DataBase -> [(String,String)] showDataBaseParts (DataBase a b c d e f) = let name * val = (name, "= " ++ name ++ " =\n\n" ++ show val ++ "\n") in ["Items" * a,"NameSearch" * b, "TypeSearch" * c ,"Suggest" * d, "Aliases" * e, "Instances" * f] showDataBase :: String -> DataBase -> String showDataBase "" d = show d showDataBase x d | null r = "Error: Unknown database part, " ++ x | length r > 1 = "Error: Ambiguous database part, " ++ x | otherwise = head r where r = [b | (a,b) <- showDataBaseParts d, lower x `isPrefixOf` lower a] hoogle-4.2.23/src/Hoogle/DataBase/Suggest.hs0000644000000000000000000001256712222103576016705 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Hoogle.DataBase.Suggest(Suggest, createSuggest, askSuggest) where import General.Base import General.Util import Hoogle.Store.All import qualified Data.Map as Map import Hoogle.Type.All import Data.Generics.Uniplate newtype Suggest = Suggest {fromSuggest :: Map.Map String SuggestItem} -- if something is both a data and a ctor, no need to mention the ctor data SuggestItem = SuggestItem {suggestCtor :: Maybe String -- constructor (and who the type is) ,suggestData :: [(String,Int)] -- data type, name (case correct), and possible kinds ,suggestClass :: [(String,Int)] -- class, name (case correct), kinds } deriving Typeable instance NFData Suggest where rnf (Suggest a) = rnf a instance NFData SuggestItem where rnf (SuggestItem a b c) = rnf (a,b,c) instance Show Suggest where show (Suggest x) = show x instance Show SuggestItem where show (SuggestItem a b c) = intercalate ", " $ ["ctor " ++ x | Just x <- [a]] ++ f "data" b ++ f "class" c where f msg xs = [msg ++ " " ++ a ++ " " ++ show b | (a,b) <- xs] instance Store Suggest where put (Suggest x) = put x get = get1 Suggest instance Store SuggestItem where put (SuggestItem a b c) = put3 a b c get = get3 SuggestItem instance Monoid Suggest where mempty = mergeSuggest [] mappend x y = mergeSuggest [x,y] mconcat = mergeSuggest -- note: do not look inside class's for data type information -- as they may have higher-kinds and get it wrong createSuggest :: [Suggest] -> [Fact] -> Suggest createSuggest deps xs = mergeSuggest (s:deps) where s = Suggest res res = foldl f Map.empty $ concatMap getTextItem xs where f m (s,i) = Map.insertWith joinItem (map toLower s) i m sData c n = (c, SuggestItem Nothing [(c,n)] []) sClass c n = (c, SuggestItem Nothing [] [(c,n)]) getTextItem :: Fact -> [(String,SuggestItem)] getTextItem (FactDataKind a b) = [sData a b] getTextItem (FactClassKind a b) = [sClass a b] getTextItem (FactCtorType a b) = [(a, SuggestItem (Just b) [] [])] getTextItem _ = [] mergeSuggest :: [Suggest] -> Suggest mergeSuggest = Suggest . Map.unionsWith joinItem . map fromSuggest joinItem :: SuggestItem -> SuggestItem -> SuggestItem joinItem (SuggestItem a1 b1 c1) (SuggestItem a2 b2 c2) = SuggestItem (if null b1 && null b2 then a1 `mplus` a2 else Nothing) (f b1 b2) (f c1 c2) where f x y = map (second maximum) $ sortGroupFsts $ x ++ y askSuggest :: [Suggest] -> TypeSig -> Maybe (Either String TypeSig) askSuggest sug q@(TypeSig con typ) | q2 /= q = Just (Right q2) | not $ null datas = unknown "type" datas | not $ null classes = unknown "class" classes | otherwise = Nothing where tries = map fromSuggest sug get x = case mapMaybe (Map.lookup $ map toLower x) tries of [] -> Nothing xs -> Just $ foldr1 joinItem xs con2 = map (improve get True) con typ2 = improve get False typ q2 = contextTrim $ insertVars $ TypeSig con2 typ2 insertVars = transformSig (\x -> if x == TVar "" then TVar var else x) var = head $ filter (/= "") $ variables typ2 ++ concatMap variables con2 ++ ["a"] -- figure out if you have a totally unknown thing -- classes = [x | c <- con, (TLit x,_) <- [fromTApp c], bad True x] datas = [x | TLit x <- concatMap universe $ typ : concatMap (snd . fromTApp) con , not $ isTLitTuple x, bad False x] unknown typ (x:_) = Just $ Left $ "Warning: Unknown " ++ typ ++ " " ++ x bad cls name = case get name of Nothing -> True Just i | cls -> null $ suggestClass i | otherwise -> null (suggestData i) && isNothing (suggestCtor i) -- remove context which doesn't reference variables in the RHS contextTrim :: TypeSig -> TypeSig contextTrim (TypeSig con typ) = TypeSig (filter (not . bad) con) typ where var = variables typ bad x = isTVar (fst $ fromTApp x) || null (variables x `intersect` var) improve :: (String -> Maybe SuggestItem) -> Bool -> Type -> Type improve get cls typ | not cls = f $ transform (improveName nameTyp) typ | otherwise = improveArity arity $ tApp (improveName nameCls t1) (map (transform (improveName nameTyp)) ts) where (t1,ts) = fromTApp typ nameTyp = maybe [] (\x -> maybeToList (suggestCtor x) ++ map fst (suggestData x)) . get nameCls = maybe [] (map fst . suggestClass) . get arity x = lookup x . (if cls then suggestClass else suggestData) =<< get x f x = case improveArity arity x of TApp x xs -> TApp x (map f xs) x -> descend f x -- Given a name, return its arity improveArity :: (String -> Maybe Int) -> Type -> Type improveArity f o = case fromTApp o of (TLit x, xs) -> case f x of Just i -> tApp (TLit x) $ take i $ xs ++ repeat (TVar "") _ -> o _ -> o -- Given a name, return the names it could possibly be improveName :: (String -> [String]) -> Type -> Type improveName f (TLit x) | ys /= [] && x `notElem` ys = TLit (head ys) where ys = f x improveName f (TVar x) | length x > 1 && ys /= [] = TLit (head ys) where ys = f x improveName f x = x hoogle-4.2.23/src/Hoogle/DataBase/SubstrSearch.hs0000644000000000000000000001615012222103576017664 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Hoogle.DataBase.SubstrSearch (SubstrSearch, createSubstrSearch ,searchSubstrSearch ,searchExactSearch ,completionsSubstrSearch ) where import Hoogle.Store.All import qualified Data.Set as Set import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BS import qualified Data.ByteString.Char8 as BSC import qualified Data.Char as C import General.Base import Data.Array import Hoogle.Type.All import Hoogle.Score.All {- Format 2: -- build a Huffman table huffman :: Eq a => [a] -> Huffman a -- encode a value using the table -- return the first 32 bits of the encoding, and a mask (will be all 1's if more than 32 bits) encode :: Huffman a -> [a] -> (Word32, Word32) -- We have 4 buckets, one per priority level - Prelude first, then base, then platform, then anything data Substr a = Substr [Bucket a] -- Each bucket contains the encoding of each entry (a pointer to it) along -- with the Word32 prefix of each string -- the 31'st bit is 1 if the string comes from the start of a string -- and the 32'nd bit is 1 if the string contains upper case letters -- within each entry, the tree is used to find shifts -- items are sorted by prefixes data Bucket a = Bucket {answers :: [a], prefixes :: [Word32], tree :: Tree} -- at each tree point the range is the start/end index where you may find things with that prefix -- if the Maybe is Just then all the points in that range are shifted by one bit data Tree = Tree {range :: (Int, Int), rest :: Maybe (Tree, Tree)} -} -- idea for speed improvement -- store as one long bytestring with \0 between the words, then do findSubstrings to find the indexes -- store the lengths in a separate bytestring then use index to step through them, retrieving the data as Word8 via foldl -- store the links in another bytestring with the lengths, but only unpack them when they are needed -- can even make length==0 code for it's the same string as before, to compress it and reduce searching -- was previously ~ 0.047 seconds {- Description: Data is stored flattened. For default we expect ~200Kb of disk usage. -} -- keys are sorted after being made lower case data SubstrSearch a = SubstrSearch {text :: BString -- all the bytestrings, in preference order ,lens :: BString -- a list of lengths ,inds :: Array Int a -- the results } deriving Typeable instance NFData a => NFData (SubstrSearch a) where rnf (SubstrSearch a b c) = rnf (a `seq` (),b `seq` (),c) -- | Create a substring search index. Values are returned in order where possible. createSubstrSearch :: [(String,a)] -> SubstrSearch a createSubstrSearch xs = SubstrSearch (fromString $ concat ts2) (BS.pack $ map fromIntegral ls2) (listArray (0,length is-1) is) where (ts,is) = unzip xs (ts2,ls2) = f "" ts f x (y:ys) = first (y:) $ second (length y:) $ f y ys f x [] = ([],[]) data S a = S {sCount :: !Int -- which one are we on ,sFocus :: !BS.ByteString -- where we are in the string ,sPrefix :: ![(a,EntryView,Score)] -- the prefixes ,sInfix :: ![(a,EntryView,Score)] -- the infixes } toChar :: Word8 -> Char toChar = C.chr . fromIntegral -- | Unsafe version of 'fromChar' ascii :: Char -> Word8 ascii = fromIntegral . C.ord {-# INLINE ascii #-} searchSubstrSearch :: SubstrSearch a -> String -> [(a, EntryView, Score)] searchSubstrSearch x y = reverse (sPrefix sN) ++ reverse (sInfix sN) where view = FocusOn y match = bsMatch (BSC.pack y) sN = BS.foldl f s0 $ lens x s0 = S 0 (text x) [] [] f s ii = addCount $ moveFocus i $ maybe id addMatch t s where t = match i $ BS.map (ascii . toChar) $ BS.unsafeTake i $ sFocus s i = fromIntegral ii addCount s = s{sCount=sCount s+1} moveFocus i s = s{sFocus=BS.unsafeDrop i $ sFocus s} addMatch MatchSubstr s = s{sInfix =(inds x ! sCount s,view,textScore MatchSubstr):sInfix s} addMatch t s = s{sPrefix=(inds x ! sCount s,view,textScore t):sPrefix s} searchExactSearch :: SubstrSearch a -> String -> [(a, EntryView, Score)] searchExactSearch x y = reverse (sPrefix sN) where view = FocusOn y match = bsMatch (BSC.pack y) sN = BS.foldl f s0 $ lens x s0 = S 0 (text x) [] [] f s ii = addCount $ moveFocus i $ maybe id addMatch t s where t = match i $ BS.unsafeTake i $ sFocus s i = fromIntegral ii addCount s = s{sCount=sCount s+1} moveFocus i s = s{sFocus=BS.unsafeDrop i $ sFocus s} addMatch MatchExact s = s{sPrefix=(inds x ! sCount s,view,textScore MatchExact):sPrefix s} addMatch _ s = s data S2 = S2 {_s2Focus :: !BS.ByteString -- where we are in the string ,s2Result :: Set.Set BS.ByteString } completionsSubstrSearch :: SubstrSearch a -> String -> [String] completionsSubstrSearch x y = map (\x -> y ++ drop ny (BSC.unpack x)) $ take 10 $ Set.toAscList $ s2Result $ BS.foldl f (S2 (text x) Set.empty) $ lens x where ny = length y ly = fromString $ map toLower y f (S2 foc res) ii = S2 (BS.unsafeDrop i foc) (if ly `BS.isPrefixOf` x then Set.insert x res else res) where x = BS.map (ascii . toLower . toChar) $ BS.unsafeTake i foc i = fromIntegral ii instance Show a => Show (SubstrSearch a) where show x = "SubstrSearch" instance (Typeable a, Store a) => Store (SubstrSearch a) where put (SubstrSearch a b c) = putDefer $ put3 a b c get = getDefer $ get3 SubstrSearch -- if first word is empty, always return Exact/Prefix -- if first word is a single letter, do elemIndex -- if first word is multiple, do isPrefixOf's but only up until n from the end -- partially apply on the first word bsMatch :: BS.ByteString -> Int -> BS.ByteString -> Maybe TextMatch bsMatch x | nx == 0 = \ny _ -> Just $ if ny == 0 then MatchExact else MatchPrefix | nx == 1 = let c = BS.head x in \ny y -> maybe (bsCharMatch MatchExactCI MatchPrefixCI False (BS.head (bsLower x)) ny (bsLower y)) Just (bsCharMatch MatchExact MatchPrefix True (BS.head x) ny y) | otherwise = \ny y -> maybe (bsWordMatch MatchExactCI MatchPrefixCI False (bsLower x) ny (bsLower y)) Just (bsWordMatch MatchExact MatchPrefix True x ny y) where nx = BS.length x bsLower = BS.map (ascii . toLower . toChar) bsCharMatch exactKind prefixKind ignoreSubstr c ny y = case BS.elemIndex c y of Nothing -> Nothing Just 0 -> Just $ if ny == 1 then exactKind else prefixKind Just _ | ignoreSubstr -> Nothing | otherwise -> Just MatchSubstr bsWordMatch exactKind prefixKind ignoreSubstr x' ny y = if BS.isPrefixOf x' y then Just (if nx == ny then exactKind else prefixKind) else if not ignoreSubstr && BS.isInfixOf x' y then Just MatchSubstr else Nothinghoogle-4.2.23/src/Hoogle/DataBase/Serialise.hs0000644000000000000000000000233312222103576017172 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Hoogle.DataBase.Serialise( saveDataBase, loadDataBase ) where import Hoogle.Store.All import General.Base import General.System import Hoogle.DataBase.Type import Paths_hoogle(version) import Data.Version hooVersion = take 4 $ map fromIntegral (versionBranch version) ++ [0..] hooString = "HOOG" data Identity = Identity deriving (Show, Typeable) instance Store Identity where put Identity = mapM_ put hooString >> mapM_ putByte hooVersion get = do cs <- replicateM 4 get vr <- replicateM 4 getByte when (cs /= hooString) $ error $ "Not a hoogle database" let showVer = intercalate "." . map show when (vr /= hooVersion) $ error $ "Wrong hoogle database version: found " ++ showVer vr ++ ", " ++ "expected " ++ showVer hooVersion return Identity saveDataBase :: FilePath -> DataBase -> IO () saveDataBase file db = runSPut file $ put (Identity, db) loadDataBase :: FilePath -> IO DataBase loadDataBase file = do sz <- withFile file ReadMode hFileSize when (sz < 12) $ error $ "Not a hoogle database: " ++ file (Identity,db) <- runSGet file get return db hoogle-4.2.23/src/Hoogle/DataBase/Items.hs0000644000000000000000000000430212222103576016331 0ustar0000000000000000{-# LANGUAGE RecordWildCards, PatternGuards #-} module Hoogle.DataBase.Items(Items, createItems, entriesItems) where import General.Base import General.Util import General.Web import Hoogle.Type.All import qualified Data.Map as Map import Hoogle.Store.All -- Invariant: items are by order of EntryScore newtype Items = Items {fromItems :: Defer [Once Entry]} instance NFData Items where rnf (Items a) = rnf a entriesItems :: Items -> [Once Entry] entriesItems = fromDefer . fromItems instance Store Items where put (Items a) = put1 a get = get1 Items instance Show Items where show (Items x) = "== Entries ==\n\n" ++ show x instance Monoid Items where mempty = mergeItems [] mappend x y = mergeItems [x,y] mconcat = mergeItems createItems :: [TextItem] -> Items createItems xs = mergeItems [Items $ Defer $ fs Nothing Nothing xs] where fs pkg mod [] = [] fs pkg mod (x:xs) = r : fs pkg2 mod2 xs where r = f pkg2 mod2 x pkg2 = if itemLevel x == 0 then Just r else pkg mod2 = if itemLevel x == 1 then Just r else mod f pkg mod TextItem{..} = once $ Entry [(url, catMaybes [pkg,mod])] itemKind itemLevel itemName itemDisp (readDocsHTML itemDocs) itemPriority itemKey itemType where url | Just pkg <- pkg, itemLevel == 1 || (itemLevel > 1 && isNothing mod) = entryURL (fromOnce pkg) `combineURL` itemURL | Just mod <- mod, itemLevel > 1 = entryURL (fromOnce mod) `combineURL` itemURL | otherwise = itemURL -- | Given a set of items, which may or may not individually satisfy the entryScore invariant, -- make it so they _do_ satisfy the invariant. -- Also merge any pair of items which are similar enough. -- -- If something which is a parent gets merged, then it will still point into the database, -- but it won't be very useful. mergeItems :: [Items] -> Items mergeItems = Items . Defer . sortOn (entryScore . fromOnce) . Map.elems . foldl' add Map.empty . concatMap entriesItems where add mp x = Map.insertWith (\x1 x2 -> once $ entryJoin (fromOnce x1) (fromOnce x2)) (entryUnique $ fromOnce x) x mp hoogle-4.2.23/src/Hoogle/DataBase/Instances.hs0000644000000000000000000000321012222103576017174 0ustar0000000000000000 module Hoogle.DataBase.Instances( Instances, createInstances, normInstances, hasInstance ) where import General.Base import Hoogle.Type.All import Hoogle.Store.All import qualified Data.Map as Map -- Map type [classes] newtype Instances = Instances {fromInstances :: Map.Map String [String]} instance NFData Instances where rnf (Instances a) = rnf a instance Show Instances where show (Instances mp) = unlines $ map f $ Map.toList mp where f (v,cs) = "instance " ++ v ++ " <= " ++ unwords cs instance Store Instances where put = put1 . fromInstances get = get1 Instances createInstances :: [Instances] -> [Fact] -> Instances createInstances deps xs = mergeInstances (i:deps) where i = Instances $ foldl f Map.empty ys ys = [(v, c) | FactInstance (TypeSig [] (TApp (TLit c) vs)) <- xs, TLit v <- vs] f mp (v,c) = Map.insertWith (++) v [c] mp instance Monoid Instances where mempty = mergeInstances [] mappend x y = mergeInstances [x,y] mconcat = mergeInstances mergeInstances :: [Instances] -> Instances mergeInstances = Instances . Map.unionsWith (\x y -> nub $ x ++ y) . map fromInstances -- Convert: -- MPTC a b |-> MPTC a, MPTC b -- C (M a) |-> C a -- Do not load Instances ever normInstances :: Instances -> TypeSig -> TypeSimp normInstances _ (TypeSig a b) = TypeSimp con b where con = sort $ nub [(c,v) | TApp (TLit c) xs <- a, x <- xs, v <- variables x, v `elem` vs] vs = variables b -- hasInstance _ C M, does C M exist hasInstance :: Instances -> String -> String -> Bool hasInstance (Instances mp) c m = c `elem` Map.findWithDefault [] m mp hoogle-4.2.23/src/Hoogle/DataBase/All.hs0000644000000000000000000000424112222103576015762 0ustar0000000000000000 module Hoogle.DataBase.All (DataBase, showDataBase ,module Hoogle.DataBase.All ,module Hoogle.DataBase.Serialise ) where import Hoogle.Store.All import Data.Monoid import Hoogle.DataBase.Type import Hoogle.Type.All import Hoogle.Score.All import Hoogle.DataBase.Serialise createDataBase :: [DataBase] -> Input -> DataBase createDataBase deps (facts,xs) = DataBase items ns (createTypeSearch as is tys) (createSuggest (map suggest deps) facts) as is where items = createItems xs ys = entriesItems items ns = createSubstrSearch [(k, y) | y <- ys, let k = entryKey $ fromOnce y, k /= ""] as = createAliases (map aliases deps) facts is = createInstances (map instances deps) facts tys = [(sig, x) | x <- ys, Just sig <- [entryType $ fromOnce x]] combineDataBase :: [DataBase] -> DataBase combineDataBase [db] = db combineDataBase dbs = DataBase items_ ns (createTypeSearch as is tys) ss as is where items_ = mconcat $ map items dbs ys = entriesItems items_ ns = createSubstrSearch [(entryKey $ fromOnce y, y) | y <- ys] ss = mconcat $ map suggest dbs as = mconcat $ map aliases dbs is = mconcat $ map instances dbs tys = [(sig, x) | x <- ys, Just sig <- [entryType $ fromOnce x]] searchName :: DataBase -> String -> [(Once Entry,EntryView,Score)] searchName db = searchSubstrSearch (nameSearch db) searchExactName :: ItemKind -> DataBase -> String -> [(Once Entry,EntryView,Score)] searchExactName kind db = filter' . searchExactSearch (nameSearch db) where filter' = if kind == UnclassifiedItem then id else filter (\(ent,_,_) -> kind == entryKind (fromOnce ent)) searchType :: DataBase -> TypeSig -> [(Once Entry,[EntryView],Score)] -- although aliases and instances are given, they are usually not used searchType db = searchTypeSearch (aliases db) (instances db) (typeSearch db) suggestion :: [DataBase] -> TypeSig -> Maybe (Either String TypeSig) suggestion db = askSuggest (map suggest db) completions :: DataBase -> String -> [String] completions db = completionsSubstrSearch (nameSearch db) hoogle-4.2.23/src/Hoogle/DataBase/Aliases.hs0000644000000000000000000000577312222103576016646 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Hoogle.DataBase.Aliases( Aliases, createAliases, normAliases ) where import Hoogle.Type.All import qualified Data.Map as Map import Hoogle.Store.All import Data.Generics.Uniplate import General.Base import Safe newtype Aliases = Aliases {fromAliases :: Map.Map String Alias} instance NFData Aliases where rnf (Aliases a) = rnf a instance Store Aliases where put = put . fromAliases get = get1 Aliases instance Show Aliases where show (Aliases mp) = unlines [ unwords $ "type" : s : vs ++ ["=", show t] | (s,Alias vs t) <- Map.toList mp] data Alias = Alias {_args :: [String] -- the free variables ,rhs :: Type -- the resulting type } deriving Typeable instance NFData Alias where rnf (Alias a b) = rnf (a,b) instance Store Alias where put (Alias a b) = put2 a b get = get2 Alias createAliases :: [Aliases] -> [Fact] -> Aliases createAliases deps ti = mergeAliases (a:deps) where a = Aliases $ transitiveClosure $ Map.fromList [ (name, Alias [v | TVar v <- args] rhs) | FactAlias (TypeSig _ lhs) (TypeSig _ rhs) <- ti , let (TLit name, args) = fromTApp lhs] -- the first is the most important instance Monoid Aliases where mempty = mergeAliases [] mappend x y = mergeAliases [x,y] mconcat = mergeAliases mergeAliases :: [Aliases] -> Aliases mergeAliases [x] = x mergeAliases xs = Aliases $ transitiveClosure $ Map.unions $ map fromAliases xs -- Must be careful with aliases which expand back to themselves -- i.e. template-haskell has "type Doc = PprM Doc" -- probably the result of unqualifying names transitiveClosure :: Map.Map String Alias -> Map.Map String Alias transitiveClosure mp = Map.mapWithKey (\k x -> x{rhs = f [k] $ rhs x}) mp where f :: [String] -> Type -> Type f seen t = case [(name,x) | (name,x) <- followAliases (Aliases mp) t, name `notElem` seen] of [] -> t (name,x):_ -> f (name:seen) x -- perform a 1-step alias following followAliases :: Aliases -> Type -> [(String,Type)] followAliases as t = [ (s, gen x2) | (x, gen) <- contexts t , Just (s,x2) <- [followAlias as x]] followAlias :: Aliases -> Type -> Maybe (String, Type) followAlias (Aliases mp) (TApp (TLit x) xs) | isJust m && length xs == length vs = Just (x, transform f rhs) where m@ ~(Just (Alias vs rhs)) = Map.lookup x mp rep = zip vs xs f (TVar v) = lookupJustDef (TVar v) v rep f x = x followAlias as (TLit x) = followAlias as (TApp (TLit x) []) followAlias _ _ = Nothing normAliases :: Aliases -> Type -> ([String], Type) normAliases as t = first (sort . nub) $ f t where f t = case followAlias as t2 of Nothing -> (concat ss, t2) Just (s,t2) -> (s : concat ss, t2) where (cs, gen) = uniplate t (ss, css) = unzip $ map f cs t2 = gen css hoogle-4.2.23/src/Hoogle/DataBase/TypeSearch/0000755000000000000000000000000012222103576016764 5ustar0000000000000000hoogle-4.2.23/src/Hoogle/DataBase/TypeSearch/TypeScore.hs0000644000000000000000000000443112222103576021237 0ustar0000000000000000 module Hoogle.DataBase.TypeSearch.TypeScore( TypeScore, newTypeScore, costTypeScore, costsTypeScore ) where import General.Base import Hoogle.Score.All import Hoogle.DataBase.TypeSearch.Binding import Hoogle.DataBase.TypeSearch.EntryInfo import Hoogle.DataBase.Instances import Hoogle.Type.All data TypeScore = TypeScore {costTypeScore :: !Int ,badargs :: Int ,badorder :: Bool ,bind :: Binding ,badInstance :: (TypeContext, TypeContext) ,badAlias :: ([String], [String]) } instance Show TypeScore where show t = unwords $ ['#' : show (costTypeScore t)] ++ replicate (badargs t) "badarg" ++ ["badorder" | badorder t] ++ [show $ bind t] ++ both inst (badInstance t) ++ both alis (badAlias t) where both f (a,b) = map (f "+") a ++ map (f "-") b inst op (c,v) = c ++ op ++ v alis op c = op ++ c instance Eq TypeScore where (==) = (==) `on` costTypeScore instance Ord TypeScore where compare = comparing costTypeScore newTypeScore :: Instances -> EntryInfo -> EntryInfo -> Bool -> Binding -> TypeScore newTypeScore is query result inorder bs = t{costTypeScore = calcScore t} where t = TypeScore 0 (entryInfoArity result - entryInfoArity query) (not inorder) bs (entryInfoContext query `diff` ctx) (entryInfoAlias query `diff` entryInfoAlias result) diff a b = (a \\ b, b \\ a) ctx = nub $ concat [f c b | (c,v) <- entryInfoContext result, (b, TVar a) <- bindings bs, a == v] f c (TVar v) = [(c,v)] f c (TLit l) = [(c,l) | not $ hasInstance is c l] calcScore :: TypeScore -> Int calcScore t = costBinding (bind t) + sum (map cost $ costsTypeScoreLocal t) costsTypeScoreLocal :: TypeScore -> [TypeCost] costsTypeScoreLocal t = CostDeadArg *+ badargs t ++ [CostArgReorder | badorder t] ++ CostAliasFwd *+ length (fst $ badAlias t) ++ CostAliasBwd *+ length (snd $ badAlias t) ++ CostInstanceAdd *+ length (fst $ badInstance t) ++ CostInstanceDel *+ length (snd $ badInstance t) where (*+) = flip replicate costsTypeScore :: TypeScore -> [TypeCost] costsTypeScore t = costsBinding (bind t) ++ costsTypeScoreLocal t hoogle-4.2.23/src/Hoogle/DataBase/TypeSearch/Result.hs0000644000000000000000000000623512222103576020604 0ustar0000000000000000 module Hoogle.DataBase.TypeSearch.Result( module Hoogle.DataBase.TypeSearch.Result, module Hoogle.DataBase.TypeSearch.EntryInfo ) where import Hoogle.DataBase.TypeSearch.TypeScore import Hoogle.DataBase.TypeSearch.Binding import Hoogle.DataBase.TypeSearch.EntryInfo import Hoogle.DataBase.Instances import Hoogle.Type.All hiding (Result) import General.Base import Hoogle.Store.All import qualified Data.IntSet as IntSet type ArgPos = Int -- the return from searching a graph, nearly type Result = (Once EntryInfo,[EntryView],TypeScore) type ResultReal = (Once Entry, [EntryView], TypeScore) flattenResults :: [Result] -> [(Once Entry, [EntryView], TypeScore)] flattenResults xs = [(a,b,c) | (as,b,c) <- xs, a <- entryInfoEntries $ fromOnce as] -- the result information from a whole type (many ResultArg) -- number of lacking args, entry data, info (result:args) data ResultAll = ResultAll Int (Once EntryInfo) [[ResultArg]] deriving Show -- the result information from one single type graph (argument/result) -- this result points at entry.id, argument, with such a score data ResultArg = ResultArg {resultArgEntry :: Once EntryInfo ,resultArgPos :: ArgPos ,resultArgBind :: Binding } deriving Show newResultAll :: EntryInfo -> Once EntryInfo -> Maybe ResultAll newResultAll query e | bad < 0 || bad > 2 = Nothing | otherwise = Just $ ResultAll bad e $ replicate (arityResult + 1) [] where arityQuery = entryInfoArity query arityResult = entryInfoArity $ fromOnce e bad = arityResult - arityQuery addResultAll :: Instances -> EntryInfo -> (Maybe ArgPos, ResultArg) -> ResultAll -> (ResultAll, [Result]) addResultAll is query (pos,res) (ResultAll i e info) = (ResultAll i e info2 ,mapMaybe (\(r:rs) -> newGraphsResults is query e rs r) path) where ind = maybe 0 (+1) pos info2 = zipWith (\i x -> [res|i==ind] ++ x) [0..] info -- path returns a path through the ResultArg's -- must skip badarg items -- must take one element from 0 -- must use res from ind path :: [[ResultArg]] path = f i set $ zip [0..] info where set = if ind == 0 then IntSet.empty else IntSet.singleton (resultArgPos res) f bad set [] = [[] | bad == 0] f bad set ((i,x):xs) | i == ind = map (res:) $ f bad set xs | i == 0 = [r:rs | r <- x, rs <- f bad set xs] | otherwise = (if bad > 0 then f (bad-1) set xs else []) ++ [r:rs | r <- x, let rp = resultArgPos r, not $ rp `IntSet.member` set , rs <- f bad (IntSet.insert rp set) xs] newGraphsResults :: Instances -> EntryInfo -> Once EntryInfo -> [ResultArg] -> ResultArg -> Maybe Result newGraphsResults is query e args res = do b <- mergeBindings $ map resultArgBind $ args ++ [res] let aps = map resultArgPos args s = newTypeScore is query (fromOnce e) (aps == sort aps) b view = zipWith ArgPosNum [0..] aps -- need to fake at least one ArgPosNum, so we know we have some highlight info view2 = [ArgPosNum (-1) (-1) | null view] ++ view return (e, view2, s) hoogle-4.2.23/src/Hoogle/DataBase/TypeSearch/Graphs.hs0000644000000000000000000001052112222103576020543 0ustar0000000000000000 module Hoogle.DataBase.TypeSearch.Graphs where import Hoogle.DataBase.TypeSearch.Graph import Hoogle.DataBase.TypeSearch.Binding import Hoogle.DataBase.TypeSearch.Result import Hoogle.DataBase.Instances import Hoogle.DataBase.Aliases import Hoogle.DataBase.TypeSearch.TypeScore import Hoogle.Type.All hiding (Result) import Hoogle.Store.All import qualified Data.IntMap as IntMap import qualified Data.Heap as Heap import General.Base import General.Util import Control.Monad.Trans.State -- for resGraph, the associated ArgPos is the arity of the function data Graphs = Graphs {argGraph :: Graph -- the arguments ,resGraph :: Graph -- the results } instance NFData Graphs where rnf (Graphs a b) = rnf (a,b) instance Show Graphs where show (Graphs a b) = "== Arguments ==\n\n" ++ show a ++ "\n== Results ==\n\n" ++ show b instance Store Graphs where put (Graphs a b) = put2 a b get = get2 Graphs --------------------------------------------------------------------- -- GRAPHS CONSTRUCTION newGraphs :: Aliases -> Instances -> [(TypeSig, Once Entry)] -> Graphs newGraphs as is xs = Graphs argGraph resGraph where entries = [ (t2, e2{entryInfoKey=i, entryInfoEntries=map snd ys}) | (i, ys@(((t2,e2),_):_)) <- zip [0..] $ sortGroupFst $ map (\(t,e) -> (normType as is t, e)) xs] argGraph = newGraph (concat args) resGraph = newGraph res (args,res) = unzip [ initLast $ zipWith (\i t -> (lnk, i, t)) [0..] $ fromTFun t | (t, e) <- entries, let lnk = once e] normType :: Aliases -> Instances -> TypeSig -> (Type, EntryInfo) normType as is t = (t3, EntryInfo 0 [] (length (fromTFun t3) - 1) c2 a) where TypeSimp c2 t2 = normInstances is t (a,t3) = normAliases as t2 --------------------------------------------------------------------- -- GRAPHS SEARCHING -- sorted by TypeScore graphsSearch :: Aliases -> Instances -> Graphs -> TypeSig -> [ResultReal] graphsSearch as is gs t = resultsCombine is query ans where ans = mergesBy (comparing $ resultArgBind . snd) $ f Nothing (resGraph gs) res : zipWith (\i -> f (Just i) (argGraph gs)) [0..] args f a g = map ((,) a) . graphSearch g (args,res) = initLast $ fromTFun ts (ts,query) = normType as is t data S = S {infos :: IntMap.IntMap (Maybe ResultAll) -- Int = Once EntryInfo ,pending :: Heap.Heap Int Result ,todo :: [(Maybe ArgPos, ResultArg)] ,instances :: Instances ,query :: EntryInfo } resultsCombine :: Instances -> EntryInfo -> [(Maybe ArgPos, ResultArg)] -> [ResultReal] resultsCombine is query xs = flattenResults $ evalState delResult s0 where s0 = S IntMap.empty Heap.empty xs is query -- Heap -> answer delResult :: State S [Result] delResult = do pending <- gets pending todo <- gets todo case todo of [] -> concatMapM f $ Heap.elems pending t:odo -> do let (res,hp) = Heap.popWhile (costBinding $ resultArgBind $ snd t) pending modify $ \s -> s{todo=odo, pending=hp} ans1 <- concatMapM f res uncurry addResult t ans2 <- delResult return $ ans1 ++ ans2 where f r = do infos <- gets infos (Just res,infos) <- return $ IntMap.updateLookupWithKey (\_ _ -> Just Nothing) (entryInfoKey $ fromOnce $ fst3 r) infos if isNothing res then return [] else do modify $ \s -> s{infos=infos} return [r] -- todo -> heap/info addResult :: Maybe ArgPos -> ResultArg -> State S () addResult arg val = do let entId = entryInfoKey $ fromOnce $ resultArgEntry val infs <- gets infos is <- gets instances query <- gets query let def = newResultAll query (resultArgEntry val) case IntMap.lookup entId infs of Just Nothing -> return () Nothing | isNothing def -> modify $ \s -> s{infos = IntMap.insert entId Nothing $ infos s} x -> do let inf = fromJust $ fromMaybe def x (inf,res) <- return $ addResultAll is query (arg,val) inf res <- return $ map (costTypeScore . thd3 &&& id) res modify $ \s -> s {infos = IntMap.insert entId (Just inf) $ infos s ,pending = Heap.insertList res (pending s) } hoogle-4.2.23/src/Hoogle/DataBase/TypeSearch/Graph.hs0000644000000000000000000000544512222103576020371 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-| Search for a type signature and context through a graph. Return results in best-first order, taking account of which nodes and edges have already been paid for. -} module Hoogle.DataBase.TypeSearch.Graph( Graph, newGraph, graphSearch ) where import Hoogle.DataBase.TypeSearch.Binding import Hoogle.DataBase.TypeSearch.Result import Hoogle.Type.All import Data.Generics.Uniplate import Hoogle.Store.All import qualified Data.Map as Map import General.Base import General.Util newtype Graph = Graph (Map.Map Type [Node]) -- the Type's are stored in reverse, to make box/unbox computations quicker data Node = Node [Type] [(Once EntryInfo,ArgPos)] deriving Typeable instance NFData Graph where rnf (Graph a) = rnf a instance NFData Node where rnf (Node a b) = rnf (a,b) instance Show Graph where show (Graph mp) = unlines $ concatMap f $ Map.toList mp where f (t,ns) = show (transform g t) : map ((" "++) . show) ns g x = if x == TVar "" then TVar "_" else x instance Show Node where show (Node t xs) = unwords $ map show t ++ "=" : ["?." ++ show b | (a,b) <- xs] instance Store Graph where put (Graph a) = put1 a get = get1 Graph instance Store Node where put (Node a b) = put2 a b get = get2 Node --------------------------------------------------------------------- -- GRAPH CONSTRUCTION typeStructure :: Type -> Type typeStructure = transform f where f x = if isTLit x || isTVar x then TVar "" else x typeUnstructure :: Type -> [Type] typeUnstructure = reverse . filter (\x -> isTLit x || isTVar x) . universe newGraph :: [(Once EntryInfo, ArgPos, Type)] -> Graph newGraph = Graph . Map.map newNode . foldl' f Map.empty where f mp x = Map.insertWith (++) (typeStructure $ thd3 x) [x] mp newNode :: [(Once EntryInfo, ArgPos, Type)] -> [Node] newNode = map (uncurry Node) . sortGroupFsts . map (\(a,b,c) -> (typeUnstructure c,(a,b))) --------------------------------------------------------------------- -- GRAPH SEARCHING -- must search for each (node,bindings) pair, rather than just nodes graphSearch :: Graph -> Type -> [ResultArg] graphSearch (Graph mp) t = [ResultArg e p b | (b,ep) <- sortFst xs, (e,p) <- ep] where xs = f newBinding s ++ f newBindingRebox (TApp (TVar "") [s]) ++ concat [f newBindingUnbox x | TApp (TVar "") [x] <- [s]] u = typeUnstructure t s = typeStructure t f bind x = mapMaybe (graphCheck bind u) $ Map.findWithDefault [] x mp graphCheck :: Binding -> [Type] -> Node -> Maybe (Binding, [(Once EntryInfo,ArgPos)]) graphCheck b xs (Node ys res) = do b <- f b (zip xs ys) return (b, res) where f b [] = Just b f b (x:xs) = do b <- addBinding x b f b xs hoogle-4.2.23/src/Hoogle/DataBase/TypeSearch/EntryInfo.hs0000644000000000000000000000202112222103576021230 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Hoogle.DataBase.TypeSearch.EntryInfo where import Hoogle.Store.All import Hoogle.Type.All import General.Base -- the information about an entry, including the arity data EntryInfo = EntryInfo {entryInfoKey :: Int -- allow cheap equality ,entryInfoEntries :: [Once Entry] ,entryInfoArity :: Int ,entryInfoContext :: TypeContext ,entryInfoAlias :: [String] } deriving (Show,Typeable) instance NFData EntryInfo where rnf (EntryInfo a b c d e) = rnf (a,b,c,d,e) instance Ord EntryInfo where compare (EntryInfo _ [] x1 x2 x3) (EntryInfo _ [] y1 y2 y3) = compare (x1,x2,x3) (y1,y2,y3) compare _ _ = error "Ord EntryInfo, can't compare EntryInfo's with items in them" instance Eq EntryInfo where EntryInfo _ [] x1 x2 x3 == EntryInfo _ [] y1 y2 y3 = (x1,x2,x3) == (y1,y2,y3) _ == _ = error "Eq EntryInfo, can't compare EntryInfo's with items in them" instance Store EntryInfo where put (EntryInfo a b c d e) = put5 a b c d e get = get5 EntryInfo hoogle-4.2.23/src/Hoogle/DataBase/TypeSearch/Binding.hs0000644000000000000000000000735612222103576020705 0ustar0000000000000000{-| Deal with variable bindings/alpha renaming in searches And with restrictions Deals with how the query is mapped to the result -} module Hoogle.DataBase.TypeSearch.Binding( Binding, newBinding, newBindingUnbox, newBindingRebox, addBinding, costBinding, costsBinding, mergeBindings, bindings ) where import Hoogle.Type.All import Hoogle.Score.All import Data.Function import General.Base import qualified Data.Map as Map import qualified Data.Set as Set type Var = String type Lit = String type Bind = Map.Map Var (Maybe Lit, Set.Set Var) data Binding = Binding !Int [Box] Bind Bind data Box = Unbox | Rebox deriving (Show,Eq) instance Show Binding where show b@(Binding _ box _ _) = unwords $ map (map toLower . show) box ++ map f (bindings b) where f (a,b) = show a ++ "=" ++ show b instance Eq Binding where (==) = (==) `on` costBinding instance Ord Binding where compare = comparing costBinding costBinding :: Binding -> Int costBinding (Binding x _ _ _) = x newBinding, newBindingUnbox, newBindingRebox :: Binding newBinding = Binding 0 [] Map.empty Map.empty newBindingUnbox = Binding (cost CostUnbox) [Unbox] Map.empty Map.empty newBindingRebox = Binding (cost CostRebox) [Rebox] Map.empty Map.empty costIf b v = if b then cost v else 0 addBinding :: (Type, Type) -> Binding -> Maybe Binding addBinding (TVar a, TVar b) (Binding c box x y) = Just $ Binding c2 box x2 y2 where (x2,cx) = addVar a b x (y2,cy) = addVar b a y c2 = c + costIf cx CostDupVarQuery + costIf cy CostDupVarResult addBinding (TVar a, TLit b) (Binding c box x y) = do (x2,cx) <- addLit a b x return $ Binding (c + costIf cx CostRestrict) box x2 y addBinding (TLit a, TVar b) (Binding c box x y) = do (y2,cy) <- addLit b a y return $ Binding (c + costIf cy CostUnrestrict) box x y2 addBinding (TLit a, TLit b) bind = if a == b then Just bind else Nothing addVar :: Var -> Var -> Bind -> (Bind, Bool) addVar a b mp = case Map.lookup a mp of Nothing -> (Map.insert a (Nothing, Set.singleton b) mp, False) Just (l, vs) | b `Set.member` vs -> (mp, False) | otherwise -> (Map.insert a (l, Set.insert b vs) mp, True) addLit :: Var -> Lit -> Bind -> Maybe (Bind, Bool) addLit a b mp | l == Just b = Just (mp, False) | isJust l = Nothing | otherwise = Just (Map.insert a (Just b, vs) mp, True) where (l, vs) = Map.findWithDefault (Nothing, Set.empty) a mp mergeBindings :: [Binding] -> Maybe Binding mergeBindings bs = do let (box,ls,rs) = unzip3 [(b,l,r) | Binding _ b l r <- bs] (bl,br) = (Map.unionsWith f ls, Map.unionsWith f rs) res i = Binding i (concat box) bl br s <- costsBindingLocal (res 0) return $ res (sum $ map cost s) where f (l1,vs1) (l2,vs2) | l1 /= l2 && isJust l1 && isJust l2 = (Just "", vs1) | otherwise = (l1 `mplus` l2, Set.union vs1 vs2) costsBindingLocal :: Binding -> Maybe [TypeCost] costsBindingLocal (Binding _ box l r) = do let cb = [if b == Unbox then CostUnbox else CostRebox | b <- box] cl <- f CostDupVarQuery CostRestrict l cr <- f CostDupVarResult CostUnrestrict r return $ cb++cl++cr where f var restrict = concatMapM g . Map.elems where g (Just "", _) = Nothing g (l, vs) = Just $ [restrict|isJust l] ++ replicate (max 0 $ Set.size vs - 1) var costsBinding :: Binding -> [TypeCost] costsBinding = fromJust . costsBindingLocal bindings :: Binding -> [(Type, Type)] bindings (Binding _ _ a b) = [(TVar v, t) | (v,(l,vs)) <- Map.toList a, t <- [TLit l | Just l <- [l]] ++ map TVar (Set.toList vs)] ++ [(TLit l, TVar v) | (v,(Just l,_)) <- Map.toList b] hoogle-4.2.23/src/Hoogle/DataBase/TypeSearch/All.hs0000644000000000000000000000236512222103576020036 0ustar0000000000000000 -- TODO: Aliases and Instances from imported packages should be -- used when searching. module Hoogle.DataBase.TypeSearch.All( createTypeSearch, TypeSearch, searchTypeSearch, TypeScore ) where import Hoogle.DataBase.TypeSearch.Graphs import Hoogle.DataBase.TypeSearch.TypeScore import Hoogle.DataBase.Instances import Hoogle.DataBase.Aliases import Hoogle.Store.All import Hoogle.Type.All import Hoogle.Score.All import General.Base newtype TypeSearch = TypeSearch Graphs instance NFData TypeSearch where rnf (TypeSearch a) = rnf a instance Show TypeSearch where show (TypeSearch x) = show x instance Store TypeSearch where put (TypeSearch x) = put x get = get1 TypeSearch --------------------------------------------------------------------- -- CREATION createTypeSearch :: Aliases -> Instances -> [(TypeSig, Once Entry)] -> TypeSearch createTypeSearch aliases instances xs = TypeSearch $ newGraphs aliases instances xs --------------------------------------------------------------------- -- SEARCHING searchTypeSearch :: Aliases -> Instances -> TypeSearch -> TypeSig -> [(Once Entry,[EntryView],Score)] searchTypeSearch as is (TypeSearch g) t = [(a, b, typeScore $ costsTypeScore c) | (a,b,c) <- graphsSearch as is g t] hoogle-4.2.23/src/General/0000755000000000000000000000000012222103576013411 5ustar0000000000000000hoogle-4.2.23/src/General/Web.hs0000644000000000000000000001117312222103576014465 0ustar0000000000000000{-# LANGUAGE PatternGuards #-} {- | General web utility functions. -} module General.Web( responseOK, responseNotFound, responseFlatten, responseEvaluate, responseRewrite, URL, filePathToURL, combineURL, escapeURL, (++%), unescapeURL, escapeHTML, (++&), htmlTag, Args, cgiArgs, cgiResponse, parseHttpQueryArgs ) where import General.System import General.Base import Network.Wai import Network.HTTP.Types import Data.CaseInsensitive(original) import qualified Data.ByteString.Lazy.Char8 as LBS import Blaze.ByteString.Builder(toLazyByteString) import Data.Conduit.List(consume) import Data.Conduit(($$),Flush,runResourceT,Flush(Chunk)) type Args = [(String, String)] --------------------------------------------------------------------- -- WAI STUFF responseOK = responseLBS status200 responseNotFound x = responseLBS status404 [] $ fromString $ "File not found: " ++ x responseFlatten :: Response -> IO (Status, ResponseHeaders, LBString) responseFlatten r = do let (s,hs,rest) = responseSource r chunks <- runResourceT $ rest $$ consume let res = toLazyByteString $ mconcat [x | Chunk x <- chunks] return (s,hs,res) responseEvaluate :: Response -> IO () responseEvaluate (ResponseBuilder _ _ x) = LBS.length (toLazyByteString x) `seq` return () responseEvaluate _ = return () responseRewrite :: (LBString -> LBString) -> Response -> IO Response responseRewrite f r = do (a,b,c) <- responseFlatten r return $ responseLBS a b $ f c --------------------------------------------------------------------- -- HTML STUFF -- | Take a piece of text and escape all the HTML special bits escapeHTML :: String -> String escapeHTML = concatMap f where f '<' = "<" f '>' = ">" f '&' = "&" f '\"' = """ f x = [x] -- | Escape the second argument as HTML before appending (++&) :: String -> String -> String a ++& b = a ++ escapeHTML b htmlTag :: String -> String -> String htmlTag x y = "<" ++ x ++ ">" ++ y ++ "" --------------------------------------------------------------------- -- URL STUFF filePathToURL :: FilePath -> URL filePathToURL xs = "file://" ++ ['/' | not $ "/" `isPrefixOf` ys] ++ ys where ys = map (\x -> if isPathSeparator x then '/' else x) xs combineURL :: String -> String -> String combineURL a b | any (`isPrefixOf` b) ["http:","https:","file:"] = b | otherwise = a ++ b -- | Take an escape encoded string, and return the original unescapeURL :: String -> String unescapeURL ('+':xs) = ' ' : unescapeURL xs unescapeURL ('%':a:b:xs) | [(v,"")] <- readHex [a,b] = chr v : unescapeURL xs unescapeURL (x:xs) = x : unescapeURL xs unescapeURL [] = [] escapeURL :: String -> String escapeURL = concatMap f where f x | isAlphaNum x || x `elem` "-" = [x] | x == ' ' = "+" | otherwise = '%' : ['0'|length s == 1] ++ s where s = showHex (ord x) "" -- | Escape the second argument as a CGI query string before appending (++%) :: String -> String -> String a ++% b = a ++ escapeURL b --------------------------------------------------------------------- -- CGI STUFF -- The BOA server does not set QUERY_STRING if it would be blank. -- However, it does always set REQUEST_URI. cgiVariable :: IO (Maybe String) cgiVariable = do str <- getEnvVar "QUERY_STRING" if isJust str then return str else fmap (fmap $ const "") $ getEnvVar "REQUEST_URI" cgiArgs :: IO (Maybe Args) cgiArgs = do x <- cgiVariable return $ case x of Nothing -> Nothing Just y -> Just $ parseHttpQueryArgs $ ['=' | '=' `notElem` y] ++ y cgiResponse :: Response -> IO () cgiResponse r = do (status,headers,body) <- responseFlatten r LBS.putStr $ LBS.unlines $ [LBS.fromChunks [original a, fromString ": ", b] | (a,b) <- headers] ++ [fromString "",body] --------------------------------------------------------------------- -- HTTP STUFF parseHttpQueryArgs :: String -> Args parseHttpQueryArgs xs = mapMaybe (f . splitPair "=") $ splitList "&" xs where f Nothing = Nothing f (Just (a,b)) = Just (unescapeURL a, unescapeURL b) splitList :: Eq a => [a] -> [a] -> [[a]] splitList find str = if isJust q then a : splitList find b else [str] where q = splitPair find str Just (a, b) = q splitPair :: Eq a => [a] -> [a] -> Maybe ([a], [a]) splitPair find str = f str where f [] = Nothing f x | isPrefixOf find x = Just ([], drop (length find) x) | otherwise = if isJust q then Just (head x:a, b) else Nothing where q = f (tail x) Just (a, b) = q hoogle-4.2.23/src/General/Util.hs0000644000000000000000000000527112222103576014667 0ustar0000000000000000 module General.Util where import General.Base -- | Only append strings if neither one is empty (++?) :: String -> String -> String a ++? b = if null a || null b then [] else a ++ b sortOn f = sortBy (comparing f) groupOn f = groupBy ((==) `on` f) nubOn f = nubBy ((==) `on` f) sortFst mr = sortOn fst mr groupFst mr = groupOn fst mr groupFsts :: Eq k => [(k,v)] -> [(k,[v])] groupFsts = map (fst . head &&& map snd) . groupFst sortGroupFsts mr = groupFsts . sortFst $ mr sortGroupFst mr = groupFst . sortFst $ mr fold :: a -> (a -> a -> a) -> [a] -> a fold x f [] = x fold x f xs = fold1 f xs fold1 :: (a -> a -> a) -> [a] -> a fold1 f [x] = x fold1 f xs = f (fold1 f a) (fold1 f b) where (a,b) = halves xs halves :: [a] -> ([a],[a]) halves [] = ([], []) halves (x:xs) = (x:b,a) where (a,b) = halves xs merge :: Ord a => [a] -> [a] -> [a] merge xs [] = xs merge [] ys = ys merge (x:xs) (y:ys) | x <= y = x : merge xs (y:ys) | otherwise = y : merge (x:xs) ys mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a] mergeBy f xs [] = xs mergeBy f [] ys = ys mergeBy f (x:xs) (y:ys) | f x y /= GT = x : mergeBy f xs (y:ys) | otherwise = y : mergeBy f (x:xs) ys merges :: Ord a => [[a]] -> [a] merges = fold [] merge mergesBy :: (a -> a -> Ordering) -> [[a]] -> [a] mergesBy f = fold [] (mergeBy f) split :: Eq a => a -> [a] -> [[a]] split x [] = [] split x xs = if null b then [a] else a : split x (tail b) where (a,b) = break (== x) xs rep from to x = if x == from then to else x reps from to = map (rep from to) -- | Like splitAt, but also return the number of items that were split. -- For performance. splitAtLength :: Int -> [a] -> (Int,[a],[a]) splitAtLength n xs = f n xs where f i xs | i == 0 = (n,[],xs) f i [] = (n-i,[],[]) f i (x:xs) = (a,x:b,c) where (a,b,c) = f (i-1) xs rbreak f xs = case break f $ reverse xs of (_, []) -> (xs, []) (as, b:bs) -> (reverse bs, b:reverse as) compareCaseless :: String -> String -> Ordering compareCaseless x = compare (map toLower x) . map toLower -- compare strings, but with an ordering that puts 'a' < 'A' < 'b' < 'B' compareString :: String -> String -> Ordering compareString (x:xs) (y:ys) = case compareChar x y of EQ -> compareString xs ys x -> x compareString [] [] = EQ compareString xs ys = if null xs then LT else GT compareChar :: Char -> Char -> Ordering compareChar x y = case (compare x y, compare (toLower x) (toLower y)) of (EQ, _) -> EQ (x, EQ) -> if x == GT then LT else GT (_, x ) -> x findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a) findM p [] = return Nothing findM p (x:xs) = do v <- p x if v then return $ Just x else findM p xs hoogle-4.2.23/src/General/System.hs0000644000000000000000000000361112222103576015232 0ustar0000000000000000{-# LANGUAGE CPP, ScopedTypeVariables #-} -- | Module for system like things in base/directory/etc, or could plausibly be added. module General.System(module General.System, module X) where import System.Cmd as X import System.Directory as X import System.Environment as X import System.Exit as X import System.IO as X import System.Mem as X (performGC) import General.Base import qualified Control.Exception as E #if __GLASGOW_HASKELL__ >= 612 import GHC.IO.Handle(hDuplicate,hDuplicateTo) #endif #ifndef mingw32_HOST_OS import System.Posix(setFileCreationMask) #else setFileCreationMask :: Int -> IO Int setFileCreationMask _ = return 0 #endif isWindows :: Bool #ifdef mingw32_HOST_OS isWindows = True #else isWindows = False #endif withDirectory dir cmd = E.bracket (do x <- getCurrentDirectory; setCurrentDirectory dir; return x) setCurrentDirectory (const cmd) withModeGlobalRead :: IO () -> IO () withModeGlobalRead act = E.bracket (setFileCreationMask 0o022) (\x -> setFileCreationMask x >> return ()) (const act) -- FIXME: This could use a lot more bracket calls! captureOutput :: IO () -> IO (Maybe String) #if __GLASGOW_HASKELL__ < 612 captureOutput act = return Nothing #else captureOutput act = do tmp <- getTemporaryDirectory (f,h) <- openTempFile tmp "hlint" sto <- hDuplicate stdout ste <- hDuplicate stderr hDuplicateTo h stdout hDuplicateTo h stderr hClose h act hDuplicateTo sto stdout hDuplicateTo ste stderr res <- readFile' f removeFile f return $ Just res #endif system_ :: String -> IO () system_ x = do res <- system x when (res /= ExitSuccess) $ error $ "System command failed: " ++ x exitMessage :: [String] -> IO a exitMessage msg = putStr (unlines msg) >> exitFailure getEnvVar :: String -> IO (Maybe String) getEnvVar x = E.catch (fmap Just $ getEnv x) (\(x :: E.SomeException) -> return Nothing) hoogle-4.2.23/src/General/Base.hs0000644000000000000000000000605712222103576014627 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | Module for "pure" things in the base, and things I think should -- have been in base, or could plausibly be added. module General.Base(module General.Base, module X) where import Control.Arrow as X import Control.DeepSeq as X import Control.Monad as X import Data.Char as X import Data.Data as X (Data,Typeable) import Data.Either as X (partitionEithers) import Data.Function as X import Data.List as X import Data.Maybe as X import Data.Monoid as X import Data.Ord as X import Data.String as X import Data.Int as X import Data.Word as X import Debug.Trace as X (trace) import Numeric as X (readHex,showHex) import System.FilePath as X hiding (combine) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS import System.IO type LBString = LBS.ByteString type BString = BS.ByteString lbsUnpack = LBS.unpack bsUnpack = BS.unpack bsReplace :: BString -> BString -> BString -> BString bsReplace find rep = BS.concat . f where nfind = BS.length find f x | BS.null b = [a] | otherwise = a : rep : f (BS.drop nfind b) where (a,b) = BS.breakSubstring find x lbsReplace :: LBString -> LBString -> LBString -> LBString lbsReplace find rep x = LBS.fromChunks [bsReplace (f find) (f rep) (f x)] where f = BS.concat . LBS.toChunks -- | A URL, or internet address. These addresses will usually start with either -- @http:\/\/@ or @file:\/\/@. type URL = String fst3 (a,b,c) = a snd3 (a,b,c) = b thd3 (a,b,c) = c swap (a,b) = (b,a) fromLeft (Left x) = x fromRight (Right x) = x isLeft Left{} = True; isLeft _ = False isRight Right{} = True; isRight _ = False concatMapM f = liftM concat . mapM f unzipEithers :: [Either a b] -> ([a],[b]) unzipEithers [] = ([],[]) unzipEithers (Left x:xs) = (x:a,b) where (a,b) = unzipEithers xs unzipEithers (Right x:xs) = (a,x:b) where (a,b) = unzipEithers xs initLast :: [a] -> ([a], a) initLast [] = error "initLast, empty list []" initLast [x] = ([], x) initLast (x:xs) = (x:a, b) where (a,b) = initLast xs lower = map toLower upper = map toUpper readFile' x = do src <- readFile x length src `seq` return src readFileUtf8' :: FilePath -> IO String readFileUtf8' x = do src <- readFileUtf8 x length src `seq` return src readFileUtf8 :: FilePath -> IO String #if __GLASGOW_HASKELL__ < 612 readFileUtf8 x = readFile x #else readFileUtf8 x = do h <- openFile x ReadMode hSetEncoding h utf8 hGetContents h #endif writeFileUtf8 :: FilePath -> String -> IO () #if __GLASGOW_HASKELL__ < 612 writeFileUtf8 x y = writeFile x y #else writeFileUtf8 x y = withFile x WriteMode $ \h -> do hSetEncoding h utf8 hPutStr h y #endif writeFileBinary :: FilePath -> String -> IO () writeFileBinary x y = withBinaryFile x WriteMode $ \h -> hPutStr h y ltrim = dropWhile isSpace rtrim = reverse . ltrim . reverse trim = ltrim . rtrim chop :: ([a] -> (b, [a])) -> [a] -> [b] chop _ [] = [] chop f as = b : chop f as' where (b, as') = f as fromList :: a -> [a] -> a fromList x [] = x fromList x (y:ys) = y hoogle-4.2.23/src/Data/0000755000000000000000000000000012222103576012705 5ustar0000000000000000hoogle-4.2.23/src/Data/TypeMap.hs0000644000000000000000000000170312222103576014621 0ustar0000000000000000{-# 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 hoogle-4.2.23/src/Data/Heap.hs0000644000000000000000000000374612222103576014130 0ustar0000000000000000 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) hoogle-4.2.23/src/Console/0000755000000000000000000000000012222103576013436 5ustar0000000000000000hoogle-4.2.23/src/Console/Test.hs0000644000000000000000000000767012222103576014723 0ustar0000000000000000{-# LANGUAGE RecordWildCards,PatternGuards,ScopedTypeVariables #-} -- | Standalone tests are dependent only on themselves, example tests -- require a fully build Hoogle database. module Console.Test(testPrepare, testFile) where import Hoogle import General.Base import General.System import Paths_hoogle import CmdLine.All import Test.All import Control.Exception import System.Console.CmdArgs testPrepare :: IO () testPrepare = do putStrLn "Running static tests" test putStrLn "Converting testdata" performGC -- clean up the databases dat <- getDataDir src <- readFileUtf8 $ dat "testdata.txt" let (errs, dbOld) = createDatabase Haskell [] src unless (null errs) $ error $ unlines $ "Couldn't convert testdata database:" : map show errs let dbfile = dat "databases/testdata.hoo" saveDatabase dbfile dbOld db <- loadDatabase dbfile when (show dbOld /= show db) $ error "Database did not save properly" testFile :: (CmdLine -> IO ()) -> FilePath -> IO Int testFile run srcfile = do putStrLn $ "Testing " ++ srcfile src <- readFile' srcfile xs <- mapM (runTest run) $ parseTests src return $ length $ filter not xs data Testcase = Testcase {testLine :: Int ,testQuery :: String ,testResults :: [String] } parseTests :: String -> [Testcase] parseTests = f . zip [1..] . lines where f ((i,x):xs) | "--" `isPrefixOf` x = f xs | all isSpace x = f xs | otherwise = Testcase i x (map snd a) : f b where (a,b) = break (all isSpace . snd) xs f [] = [] parseArgs :: String -> [String] parseArgs "" = [] parseArgs ('\"':xs) = a : parseArgs (drop 1 b) where (a,b) = break (== '\"') xs parseArgs xs = a : parseArgs (dropWhile isSpace b) where (a,b) = break isSpace xs runTest :: (CmdLine -> IO ()) -> Testcase -> IO Bool runTest run Testcase{..} = do whenLoud $ putStrLn $ "Testing: " ++ testQuery args <- withArgs (parseArgs testQuery) cmdLine res <- try $ captureOutput $ run args case res of Left (x :: SomeException) -> putStrLn ("Error, test crashed: " ++ testQuery ++ ", with " ++ show x) >> return False Right Nothing -> putStrLn "Can't run tests on GHC < 6.12" >> return False Right (Just x) -> case matchOutput testResults (lines x) of Nothing -> return True Just x -> do putStrLn $ "Failed test on line " ++ show testLine ++ "\n" ++ x return False -- support @reoder, @not, @exact, @now matchOutput :: [String] -> [String] -> Maybe String -- Nothing is success matchOutput want got = f want ([],got) where f [] _ = Nothing f (x:xs) a = case match (code x) a of Nothing -> Just $ "Failed to match: " ++ x Just a -> f xs a code ('@':xs) = second (drop 1) $ break (== ' ') xs code xs = ("",xs) -- given (code,match) (past,future) return Nothing for failure or a new (past,future) match :: (String,String) -> ([String],[String]) -> Maybe ([String],[String]) match ("not",x) (past,future) | Just (a,b) <- find x future = Nothing | otherwise = Just ([],future) match ("reorder",x) (past,future) | Just (a,b) <- find x past = Just (a++b, future) | Just (a,b) <- find x future = Just (past++a, b) | otherwise = Nothing match ("now",x) (past,future) | Just ([],b) <- find x future = Just ([],b) | otherwise = Nothing match ("",x) (past,future) | Just (a,b) <- find x future = Just (a,b) | otherwise = Nothing match (code,x) _ = error $ "Unknown test code: " ++ code -- given a needle, return Maybe the bits before and after find :: String -> [String] -> Maybe ([String],[String]) find x ys = if null b then Nothing else Just (a,tail b) where (a,b) = break (\y -> words x `isInfixOf` words y) ys hoogle-4.2.23/src/Console/Search.hs0000644000000000000000000000514112222103576015200 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} module Console.Search(actionSearch) where import CmdLine.All import General.Base import General.System import System.Console.CmdArgs import Hoogle actionSearch :: CmdLine -> Query -> IO () actionSearch flags q = do (missing,dbs) <- loadQueryDatabases (databases flags) q unless (null missing) $ do n <- availableDatabases (databases flags) exitMessage $ ("Could not find some databases: " ++ unwords missing) : "Searching in:" : map (" "++) (databases flags) ++ [""] ++ (if null n then ["There are no available databases, generate them with: hoogle data"] else ["Either the package does not exist or has not been generated"] ++ ["Generate more databases with: hoogle data all" | length n < 100] ++ ["Found " ++ show (length n) ++ " databases, including: " ++ unwords (take 5 n) | not $ null n]) let sug = suggestions dbs q when (isJust sug) $ putStrLn $ showTag $ fromJust sug verbose <- isLoud when verbose $ putStrLn "= ANSWERS =" when (color flags) $ putStrLn $ "Searching for: " ++ showTag (renderQuery q) let res = restrict $ concatMap expand $ search dbs q if null res then putStrLn "No results found" else if info flags then do let Result{..} = snd $ head res putStrLns 2 $ disp verbose $ head res putStrLns 2 $ showTag docs case locations of (_,(_,p):_):_ -> putStrLn $ "From package " ++ p _ -> return () putStrLns 1 $ showTag self else putStr $ unlines $ map (disp verbose) res where restrict | start2 == 0 && count2 == maxBound = id | otherwise = take count2 . drop start2 where start2 = maybe 0 (subtract 1) $ start flags count2 = fromMaybe maxBound $ count flags showTag = if color flags then showTagANSI else showTagText expand (s,r) | null $ locations r = [(s,r)] | otherwise = [(s,r{locations=[p]}) | p <- locations r] disp verbose (s,Result{..}) = (case locations of (_,_:(_,m):_):_ -> m ++ " "; _ -> "") ++ showTag self ++ (if verbose then " -- " ++ show s else "") ++ (if link flags then " -- " ++ head (map fst locations ++ [""]) else "") -- Put out a string with some blank links following -- Do not put out the blank lines if no text output putStrLns :: Int -> String -> IO () putStrLns n xs = when (xs /= "") $ do putStr xs putStr $ replicate n '\n' hoogle-4.2.23/src/Console/Rank.hs0000644000000000000000000000211712222103576014666 0ustar0000000000000000 module Console.Rank(rank) where import General.Base import Hoogle rank :: FilePath -> IO () rank file = do src <- readFile' file res <- scoring $ scores $ parse $ lines src putStrLn res scores :: ([String], [(String,[String])]) -> [(Score,Score)] scores (pre,xs) = concatMap trans [ [ fst $ head $ search db q ++ [error $ "Did not find in " ++ query ++ ", " ++ y] | y <- ys , let (err,db) = createDatabase Haskell [] $ unlines $ pre ++ ["a::" ++ y] , null err || error "Errors while converting rank database" ] | (query,ys) <- xs, let q = right ("Could not parse query: " ++ query) $ parseQuery Haskell query] where right msg = either (\e -> error $ msg ++ "\n" ++ show e) id trans (x:xs) = map ((,) x) xs ++ trans xs trans [] = [] parse :: [String] -> ([String], [(String,[String])]) parse src = (db, [(drop 6 x, filter isReal $ takeWhile (not . isRank) xs) | x:xs <- tails rest, isRank x]) where isReal x = not $ all isSpace x || "--" `isPrefixOf` x isRank = isPrefixOf "@rank " (db,rest) = break isRank src hoogle-4.2.23/src/Console/Log.hs0000644000000000000000000001452612222103576014523 0ustar0000000000000000{-# LANGUAGE PatternGuards, RecordWildCards, ScopedTypeVariables #-} -- | Analyse the log files. It's a three stage process. -- 1, parse each line separately. -- 2, collapse searches done between lines (instant, ajax, suggest) -- 3, draw overall statistics module Console.Log(logFiles) where import General.Base import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.Map as Map logFiles :: [FilePath] -> IO () logFiles xs = do es <- mapM readEntries xs print $ mconcat $ map (stats . groupEntries) es --------------------------------------------------------------------- -- STATISTICS data Stats = Stats {hits :: !Int ,searches :: !Int ,common :: !(Map.Map LBString Int) } instance Show Stats where show Stats{..} = unlines ["Hits: " ++ show hits ,"Searches: " ++ show searches ,"Unique: " ++ show (Map.size common) ,"Top: " ++ fromList "" (map (LBS.unpack . fst) top) ] where top = take 20 $ sortBy (comparing $ negate . snd) $ Map.toList common instance Monoid Stats where mempty = Stats 0 0 Map.empty mappend (Stats x1 x2 x3) (Stats y1 y2 y3) = Stats (x1+y1) (x2+y2) (Map.unionWith (+) x3 y3) stats :: [Entry] -> Stats stats = foldl' f mempty where f s@Stats{..} Entry{..} = s {hits = 1 + hits ,searches = (if LBS.null search then 0 else 1) + searches ,common = if LBS.null search then common else Map.insertWith' (+) search 1 common } --------------------------------------------------------------------- -- GROUP ENTRIES groupEntries :: [Entry] -> [Entry] groupEntries = id --------------------------------------------------------------------- -- READ ENTRIES data Entry = Entry {search :: LBString -- the search performed, "" for blank ,extra :: [(LBString,LBString)] -- extra parameters ,date :: Maybe (Int,Int,Int) -- date the search was performed ,time :: Maybe (Int,Int,Int) -- time the search was performed ,unique :: Maybe String -- maybe a uniquely identifying string ,instant :: Maybe Int -- number of times you hit with instant for this query ,suggest :: Maybe Int -- number of times you hit with suggest for this query } deriving (Eq, Show) entry = Entry LBS.empty [] Nothing Nothing Nothing Nothing Nothing readEntries :: FilePath -> IO [Entry] readEntries x = do src <- LBS.readFile x return $ mapMaybe readEntry $ LBS.lines src qstr = map LBS.pack ["","q","hoogle"] readEntry :: LBString -> Maybe Entry -- log format v1 readEntry x | Just ('[',x) <- LBS.uncons x = do y <- readList x let (a,b) = partition (flip elem qstr . fst) y return entry{search=fromList LBS.empty $ map snd a, extra = b} where readList x = do ('(',x) <- LBS.uncons x (a,x) <- readShowString x (',',x) <- LBS.uncons x (b,x) <- readShowString x (')',x) <- LBS.uncons x case LBS.uncons x of Just (',',x) -> do ys <- readList x return $ (a,b):ys Just (']',x) -> do return [(a,b)] _ -> Nothing -- log format v2 readEntry o@x | LBS.length x > 10 && LBS.index x 10 == ' ' = do (d,x) <- readDate x (' ',x) <- LBS.uncons x (s,x) <- readShowString x args <- readArgs $ LBS.dropWhile isSpace x return entry{search = s, date = Just d, extra = filter (flip notElem qstr . fst) args} where readArgs x | Just ('?',x) <- LBS.uncons x = do (a,x) <- return $ LBS.break (== '=') x ('=',x) <- LBS.uncons x (b,x) <- readQuoteString x x <- return $ LBS.dropWhile isSpace x ys <- readArgs x return $ (a,b) : ys | otherwise = Just [] -- log format v3 readEntry x | LBS.length x > 10 && LBS.index x 10 == 'T' = do ((d,t),x) <- readDateTime x (' ',x) <- LBS.uncons x (u,x) <- return $ first LBS.unpack $ LBS.break (== ' ') x args <- readArgs $ LBS.dropWhile isSpace x let (a,b) = partition (flip elem qstr . fst) args return entry{date = Just d, time = Just t, extra = b, search=fromList LBS.empty $ map snd a, unique = if u == "0" then Nothing else Just u} where readArgs x | LBS.null x = Just [] | otherwise = do (a,x) <- readShortString x ('=',x) <- LBS.uncons x (b,x) <- readShortString x ys <- readArgs $ LBS.dropWhile isSpace x return $ (a,b):ys readEntry _ = Nothing --------------------------------------------------------------------- -- READ UTILITIES readDate :: LBString -> Maybe ((Int,Int,Int), LBString) readDate x = do (d1,x) <- LBS.readInt x ('-',x) <- LBS.uncons x (d2,x) <- LBS.readInt x ('-',x) <- LBS.uncons x (d3,x) <- LBS.readInt x return ((d1,d2,d2),x) readDateTime :: LBString -> Maybe (((Int,Int,Int),(Int,Int,Int)), LBString) readDateTime x = do (d,x) <- readDate x ('T',x) <- LBS.uncons x (t1,x) <- LBS.readInt x (':',x) <- LBS.uncons x (t2,x) <- LBS.readInt x (':',x) <- LBS.uncons x (t3,x) <- LBS.readInt x return ((d,(t1,t2,t3)),x) -- | String, as produced by show readShowString :: LBString -> Maybe (LBString, LBString) readShowString o@x = do ('\"',x) <- LBS.uncons x (a,x) <- return $ LBS.break (== '\"') x if '\\' `LBS.elem` a then do [(a,x)] <- return $ reads $ LBS.unpack o return (LBS.pack a, LBS.pack x) else do ('\"',x) <- LBS.uncons x return (a, x) -- | Either a string produced by show, or a isAlphaNum terminated chunk readShortString :: LBString -> Maybe (LBString, LBString) readShortString x | Just ('\"',_) <- LBS.uncons x = readShowString x | otherwise = Just $ LBS.span isAlphaNum x -- | Either a space terminated chunk, or a quote terminated chunk readQuoteString :: LBString -> Maybe (LBString, LBString) readQuoteString x | Just ('\"',x) <- LBS.uncons x = do (a,x) <- return $ LBS.break (== '\"') x ('\"',x) <- LBS.uncons x return (a, LBS.dropWhile isSpace x) readQuoteString x = do (a,x) <- return $ LBS.break (== ' ') x return (a, LBS.dropWhile isSpace x) hoogle-4.2.23/src/Console/All.hs0000644000000000000000000000455412222103576014512 0ustar0000000000000000 module Console.All(action) where import CmdLine.All import Recipe.All import Recipe.General import Recipe.Haddock import Console.Log import Console.Search import Console.Test import Console.Rank import General.Base import General.System import General.Web import Hoogle action :: CmdLine -> IO () action x@Search{repeat_=i} | i /= 1 = replicateM_ i $ action x{repeat_=1} action x@Search{queryParsed = Left err} = exitMessage ["Parse error:", " " ++ showTag (parseInput err) ,replicate (columnNo err) ' ' ++ " ^" ,errorMessage err] where showTag = if color x then showTagANSI else showTagText action (Test files _) = do testPrepare fails <- fmap sum $ mapM (testFile action) files putStrLn $ if fails == 0 then "Tests passed" else "TEST FAILURES (" ++ show fails ++ ")" action (Rank file) = rank file action x@Data{} = recipes x action (Log files) = logFiles files action (Convert from to doc merge haddock) = do when (any isUpper $ takeBaseName to) $ putStrLn $ "Warning: Hoogle databases should be all lower case, " ++ takeBaseName to putStrLn $ "Converting " ++ from src <- readFileUtf8 from convert merge (takeBaseName from) to $ unlines $ addLocalDoc doc (lines src) where addLocalDoc :: Maybe FilePath -> [String] -> [String] addLocalDoc doc = if haddock then haddockHacks $ addDoc doc else id addDoc :: Maybe FilePath -> Maybe URL addDoc = addGhcDoc . fmap (\x -> if "http://" `isPrefixOf` x then x else filePathToURL $ x "index.html") addGhcDoc :: Maybe URL -> Maybe URL addGhcDoc x = if isNothing x && takeBaseName from == "ghc" then Just "http://www.haskell.org/ghc/docs/latest/html/libraries/ghc/" else x action (Combine from to) = do putStrLn $ "Combining " ++ show (length from) ++ " databases" xs <- mapM loadDatabase from saveDatabase to $ mconcat xs action (Dump file sections) = do d <- loadDatabase file putStrLn $ "File: " ++ file putStr $ showDatabase d $ if null sections then Nothing else Just sections action q@Search{} | fromRight (queryParsed q) == mempty = exitMessage ["No query entered" ,"Try --help for command line options"] action q@Search{} = actionSearch q (fromRight $ queryParsed q) hoogle-4.2.23/src/CmdLine/0000755000000000000000000000000012222103576013347 5ustar0000000000000000hoogle-4.2.23/src/CmdLine/Type.hs0000644000000000000000000001152712222103576014632 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_GHC -fno-warn-missing-fields -fno-cse #-} module CmdLine.Type( CmdLine(..), cmdLineMode, isWebCmdLine, blankSearch ) where import System.Console.CmdArgs import Paths_hoogle(version) import Data.Version(showVersion) import Hoogle isWebCmdLine Search{web=Just _} = True isWebCmdLine Server{} = True isWebCmdLine _ = False data CmdLine = Search {color :: Bool ,link :: Bool ,info :: Bool ,exact :: Bool ,databases :: [FilePath] ,start :: Maybe Int ,count :: Maybe Int ,web :: Maybe String ,repeat_ :: Int ,queryChunks :: [String] ,queryParsed :: Either ParseError Query ,queryText :: String } | Data {redownload :: Bool, local :: [String], datadir :: FilePath, threads :: Int, actions :: [String]} | Server {port :: Int, local_ :: Bool, databases :: [FilePath], resources :: FilePath, dynamic :: Bool, template :: [FilePath]} | Combine {srcfiles :: [FilePath], outfile :: String} | Convert {srcfile :: String, outfile :: String, doc :: Maybe String, merge :: [String], haddock :: Bool} | Log {logfiles :: [FilePath]} | Test {testFiles :: [String], example :: Bool} | Dump {database :: String, section :: [String]} | Rank {srcfile :: FilePath} deriving (Data,Typeable,Show) emptyParseError = ParseError 0 0 "" $ Str "" blankSearch = Search False False False False [] Nothing Nothing Nothing 1 [] (Left emptyParseError) "" cmdLineMode = cmdArgsMode $ modes [search_ &= auto,data_,server,combine,convert,test,dump,rank,log_] &= verbosity &= program "hoogle" &= summary ("Hoogle v" ++ showVersion version ++ ", (C) Neil Mitchell 2004-2012\nhttp://haskell.org/hoogle") search_ = Search {web = def &= typ "MODE" &= opt "web" &= help "Operate as a web tool" ,start = def &= help "Start displaying results from this point on (1 based)" ,count = def &= name "n" &= help "Maximum number of results to return" ,queryChunks = def &= args &= typ "QUERY" ,info = def &= help "Give extended information about the first result" ,exact = def &= help "Match names exactly when searching" ,link = def &= help "Give URL's for each result" ,color = def &= name "colour" &= help "Use colored output (requires ANSI terminal)" ,databases = ["."] &= typDir &= help "Directories to search for databases" ,repeat_ = 1 &= help "Run the search multiple times (for benchmarking)" ,queryParsed = Left emptyParseError &= ignore ,queryText = "" &= ignore } &= help "Perform a search" test = Test {testFiles = def &= typFile &= args ,example = def &= help "Test the full examples" } &= help "Run tests" server = Server {port = 80 &= typ "INT" &= help "Port number" ,resources = "" &= typDir &= help "Directory to use for resources (images, CSS etc)" ,local_ = def &= help "Rewrite and serve file: links (potential security hole)" ,dynamic = def &= name "x" &= help "Allow resource files to change during execution" ,template = def &= typFile &= help "Template files to use instead of default definitions" } &= help "Start a Hoogle server" dump = Dump {database = def &= argPos 0 &= typ "DATABASE" ,section = def &= args &= typ "SECTION" } &= help "Dump sections of a database to stdout" rank = Rank {srcfile = def &= argPos 0 &= typ "RANKFILE" &= opt "" } &= help "Generate ranking information" combine = Combine {srcfiles = def &= args &= typ "DATABASE" ,outfile = "default.hoo" &= typFile &= help "Output file (defaults to default.hoo)" } &= help "Combine multiple databases into one" convert = Convert {srcfile = def &= argPos 0 &= typ "INPUT" ,outfile = def &= argPos 1 &= typ "DATABASE" &= opt "" ,doc = def &= typDir &= help "Path to the root of local or Hackage documentation for the package (implies --haddock)" ,merge = def &= typ "DATABASE" &= help "Merge other databases" ,haddock = def &= help "Apply haddock-specific hacks" } &= help "Convert an input file to a database" data_ = Data {datadir = def &= typDir &= help "Database directory" ,redownload = def &= help "Redownload all files from the web" ,threads = def &= typ "INT" &= name "j" &= help "Number of threads to use" &= ignore -- ignore until it works ,actions = def &= args &= typ "RULE" ,local = def &= opt "" &= typ "FILEPATH" &= help "Use local documentation if available" } &= help "Generate Hoogle databases" &= details ["Each argument should be the name of a database you want to generate" ,"optionally followed by which files to combine. Common options:" ,"" ," data default -- equivalent to no arguments" ," data all" ] log_ = Log {logfiles = def &= args &= typ "LOGFILE" } &= help "Analyse log files" hoogle-4.2.23/src/CmdLine/Load.hs0000644000000000000000000000234512222103576014566 0ustar0000000000000000 module CmdLine.Load(loadQueryDatabases, availableDatabases) where import Hoogle import General.Base import General.Util import General.System -- | Given a list of search directories, and a query, load the databases you -- need, and return a list of those that you couldn't find loadQueryDatabases :: [FilePath] -> Query -> IO ([String],Database) loadQueryDatabases paths q = do let findFile = findM doesFileExist let xs = queryDatabases q fmap (second mconcat . partitionEithers) $ forM xs $ \x -> do r <- findFile [p x <.> "hoo" | p <- paths] case r of Nothing -> do r <- findFile [p x <.> "txt" | p <- paths] case r of Nothing -> return $ Left x Just x -> do src <- readFileUtf8 x return $ Right $ snd $ createDatabase Haskell [] src Just x -> fmap Right $ loadDatabase x availableDatabases :: [FilePath] -> IO [String] availableDatabases xs = fmap (sortBy compareString . nub . concat) $ forM xs $ \x -> do b <- doesDirectoryExist x ys <- if b then getDirectoryContents x else return [] return [dropExtension y | y <- ys, takeExtension y == ".hoo"] hoogle-4.2.23/src/CmdLine/All.hs0000644000000000000000000000720312222103576014415 0ustar0000000000000000{-| Parse a query, that may have come from either a CGI variable or the command line arguments. Need to return the following pieces of information: * Was there a query, or was nothing entered * Are you wanting to operate in Web mode or Command Line mode. Adding a Web parameter to Command Line gives you Web mode. * Which flags were specified, and which were erroneous. -} module CmdLine.All( cmdLine, cmdLineWeb, CmdLine(..), isWebCmdLine, module CmdLine.Load ) where import General.Base import General.System import CmdLine.Type import CmdLine.Load import General.Web import System.Console.CmdArgs import Hoogle import Hoogle.Query.Type import GHC.Conc(numCapabilities) import Paths_hoogle import Safe --------------------------------------------------------------------- -- CMDLINE EXPANSION cmdLineExpand :: CmdLine -> IO CmdLine cmdLineExpand x@Search{} = do db <- expandDatabases $ databases x return x { queryText = s , queryParsed = (\q -> q { exactSearch = if exact x then Just UnclassifiedItem else Nothing }) `fmap` parseQuery Haskell s , databases = db } where s = unwords $ queryChunks x cmdLineExpand x@Server{} = do dat <- getDataDir db <- expandDatabases $ databases x let res = if null $ resources x then dat "resources" else resources x return x{databases=db, resources=res} cmdLineExpand x@Test{} = do dat <- getDataDir let files1 = if null $ testFiles x then [dat "tests.txt"] else testFiles x files2 = [dat "examples.txt" | example x] return x{testFiles = files1 ++ files2} cmdLineExpand x@Rank{} = do file <- if null $ srcfile x then fmap ( "rank.txt") getDataDir else return $ srcfile x return x{srcfile=file} cmdLineExpand x@Data{} = do dir <- if null $ datadir x then fmap ( "databases") getDataDir else return $ datadir x let thrd = if threads x == 0 then numCapabilities else threads x loc <- if all null (local x) && not (null $ local x) then guessLocal else return $ local x return x{datadir=dir, threads=thrd, local=loc} cmdLineExpand x@Convert{} = return x{haddock = haddock x || isJust (doc x), outfile = if null (outfile x) then replaceExtension (srcfile x) "hoo" else outfile x} cmdLineExpand x = return x expandDatabases x = do d <- getDataDir return $ x ++ [d "databases"] guessLocal = do ghc <- findExecutable "ghc" home <- getHomeDirectory lib <- getLibDir let xs = [takeDirectory (takeDirectory lib) "doc" {- Windows, installed with Cabal -} ] ++ [takeDirectory (takeDirectory ghc) "doc/html/libraries" | Just ghc <- [ghc] {- Windows, installed by GHC -} ] ++ [home ".cabal/share/doc" {- Linux -} ] filterM doesDirectoryExist xs --------------------------------------------------------------------- -- QUERY CONVERSION cmdLine :: IO CmdLine cmdLine = do r <- cgiArgs case r of Just y -> cmdLineWeb y Nothing -> cmdLineArgs cmdLineArgs :: IO CmdLine cmdLineArgs = cmdLineExpand =<< cmdArgsRun cmdLineMode cmdLineWeb :: [(String,String)] -> IO CmdLine cmdLineWeb args = cmdLineExpand $ blankSearch {web=Just $ fromMaybe "web" $ ask ["mode"] ,start=askInt ["start"], count=askInt ["count"] ,exact=fromMaybe 0 (askInt ["exact"]) == 1 ,queryChunks = mapMaybe ask [["prefix"],["q","hoogle"],["suffix"]]} where ask x = listToMaybe [b | (a,b) <- args, a `elem` x] askInt x = readMay =<< ask x hoogle-4.2.23/docs/0000755000000000000000000000000012222103576012175 5ustar0000000000000000hoogle-4.2.23/docs/LICENSE0000644000000000000000000000276412222103576013213 0ustar0000000000000000Copyright Neil Mitchell 2004-2013. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Neil Mitchell nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hoogle-4.2.23/datadir/0000755000000000000000000000000012222103576012655 5ustar0000000000000000hoogle-4.2.23/datadir/tests.txt0000644000000000000000000000400312222103576014555 0ustar0000000000000000-- these tests only rely on the testdata database id +testdata id map +testdata map fmap @reorder unfmap "(a -> b) -> [a] -> [b]" +testdata map fmap unfmap "(a -> b) -> [a] -> [b]" +testdata map flipmap "a -> b" +testdata unsafeCoerce "(c,d) -> d" +testdata snd fst "(c,d) -> c" +testdata fst snd "Bool -> Bool -> Bool" +testdata (==) "Bool -> Bool" +testdata not (==) :: String +testdata string chars [Char] +testdata chars string "Functor m => (a -> b) -> m a -> m b" +testdata fmap unfmap eq -- tests that arguments are not reused "Int -> Int -> Int" +testdata @not int2 -- test that instances are applied properly "Bar -> Bar" +testdata ordId @reorder id nonId -- test that packages can be searched for pkg +testdata pkg1 @reorder pkg2 map --link +testdata Testdata map :: (a -> b) -> [a] -> [b] -- http://hackage.haskell.org/packages/archive/testdata/latest/doc/html/Testdata.html#v:map == --link +testdata Testdata (==) :: Eq a => a -> a -> Bool -- http://hackage.haskell.org/packages/archive/testdata/latest/doc/html/Testdata.html#v:-61--61- -- check for perservation of forall everywhere +testdata everywhere :: Data a => (forall local. Data local => local -> local) -> a -> a -- preservation of functional dependencies rd2 +testdata class Eq2 a b => Ord2 a b | a -> b :: Just a +testdata Did you mean: :: Maybe a +testdata :: Maybe +testdata Did you mean: :: Maybe a +testdata -- check that () is known, not a warning, and is the first result :: () +testdata @now () :: () to +testdata No results a to b +testdata Did you mean: a -> b +testdata a to to b +testdata No results -- case insensitive module names BAR.bar_foo +testdata bar_foo -- lower case module prefixes via . bar.bar_foo +testdata bar_foo -- #372, proper searching for modules foo.bar_foo +testdata bar_foo bar.foo.bar_foo +testdata bar_foo bar.fo.bar_foo +testdata bar_foo ba.foo.bar_foo +testdata @now No results ar.foo bar_foo +testdata @now No results "Alias1 (Alias1 a) -> a" +testdata aliases "Alias2 (Alias2 a) -> a" +testdata aliases hoogle-4.2.23/datadir/testdata.txt0000644000000000000000000000212412222103576015226 0ustar0000000000000000-- data for tests.txt @package testdata module Testdata () :: () (,) :: a -> b -> (a,b) type FilePath = String type String = [Char] data Unit Unit :: Unit data Maybe a Just :: a -> Maybe a Nothing :: Maybe a id :: a -> a unsafeCoerce :: a -> b map :: (a -> b) -> [a] -> [b] flipmap :: [a] -> (a -> b) -> [b] fmap :: Functor m => (a -> b) -> m a -> m b unfmap :: (a -> b) -> m a -> m b eq :: Eq a => (a -> b) -> m a -> m b fst :: (a,b) -> a snd :: (a,b) -> b (==) :: Eq a => a -> a -> Bool instance Eq Bool instance Functor [] not :: Bool -> Bool string :: String chars :: [Char] int2 :: Char -> Int -> Int instance Ord Bar ordId :: Ord a => a -> a nonId :: Non a => a -> a -- check bug # 352 ( # ) :: Int everywhere :: Data a => (forall local. Data local => local -> local) -> a -> a class Eq2 a b => Ord2 a b | a -> b @entry package pkg1 @entry package pkg2 module Foo.Bar -- | Documentation for foo_bar foo_bar :: Unit fst :: (Unit,Unit) -> Unit fst2 :: (Unit,Unit) -> Unit module Bar.Foo bar_foo :: Unit fst :: (Bar,Bar) -> Bar type Alias1 a = Alias2 a aliases :: Alias1 (Alias1 a) -> a hoogle-4.2.23/datadir/rank.txt0000644000000000000000000000160712222103576014355 0ustar0000000000000000-- a list of examples -- used to generate a scoring system @package rank module Rank type String = [Char] type FilePath = String @rank Ord a => [a] -> [a] Ord a => a -> [a] -> [a] [a] -> [a] a -> [a] -> [a] @rank Ord a => [a] -> [a] [a] -> [a] Int -> [a] -> [a] String -> String Int -> [Char] -> [Char] @rank Ord a => [a] -> [a] [a] -> [a] Ord a => a -> [a] @rank [a] -> [b] (a -> b) -> [a] -> [b] [a] -> [a] Eq a => [a] -> [a] @rank Int -> Bool a -> Int -> Bool a -> Bool @rank a -> a Int -> a -> a a -> m a a -> b @rank a -> b a -> b a -> b -> a a -> a Int -> a @rank [a] -> a [a] -> Int -> a Ord a => [a] -> a [a] -> Bool @rank a -> b -> c a -> b -> c -> d Int -> b -> c a -> a -> a Ord a => a -> a -> a @rank String [Char] FilePath a -> String @rank [(a,b)] -> a -> b [(a,b)] -> a -> b a -> [(a,b)] -> b Eq a => [(a,b)] -> a -> b [(a,b)] -> a -> Maybe b Eq a => a -> [(a,b)] -> Maybe b hoogle-4.2.23/datadir/examples.txt0000644000000000000000000000267712222103576015250 0ustar0000000000000000-- these tests use all the databases -- check ~ is found, bug #280 ~ +keyword -n1 keyword ~ -- check keywords are including in default ~ -n1 keyword ~ -- check that keyword links work, bug #309 ! --link +keyword -n1 keyword ! -- http://haskell.org/haskellwiki/Keywords#.21 -- check you find forall, bug #235 forall -n10 keyword forall -- check you find MonadWriter, bug #249 MonadWriter +mtl -n1 class (Monoid w, Monad m) => MonadWriter w m module -n10 keyword module Prelude -n1 Prelude even +base -n1 even tan +base -n1 tan +base log -n1 log seq +base -n1 seq -- test that the base type String=[Char] alias is known "[Char] -> a -> a" -n1 @now trace -- test that packages are included hlint -n1 package hlint -- #146, preserve foralls everywhere +syb -n1 everywhere :: (forall a. Data a => a -> a) -> (forall a. Data a => a -> a) -- #320, make sure it finds system system -n10 System.Cmd system :: String -> IO ExitCode -- #187, LT not found LT +base -n1 LT :: Ordering -- #327, utf8 not found utf8 -n1 utf8 -- check that URL's work >>= --link -n1 http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html#v:-62--62--61- False --link -n1 http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html#v:False Ord --link -n1 http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html#t:Ord String --link -n1 http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html#t:String hoogle-4.2.23/datadir/resources/0000755000000000000000000000000012222103576014667 5ustar0000000000000000hoogle-4.2.23/datadir/resources/template_example.html0000644000000000000000000000037012222103576021103 0ustar0000000000000000 #homepage example.com #export welcome

    Welcome to Hoogle

    This copy of Hoogle overrides a few example settings, to allow you to better integrate it in any local installations.

    hoogle-4.2.23/datadir/resources/template.html0000644000000000000000000000726112222103576017376 0ustar0000000000000000 #export header css js query $&query$ $&queryHyphen$ Hoogle
    #homepage haskell.org #export footer version
    #search $&query$ #export welcome

    Welcome to Hoogle

    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.

    Example searches:
    $query=map$ $#search$
    $query=(a -> b) -> [a] -> [b]$ $#search$
    $query=Ord a => [a] -> [a]$ $#search$
    $query=Data.Map.insert$ $#search$

    Enter your own search at the top of the page.

    The Hoogle manual contains more details, including further details on search queries, how to install Hoogle as a command line application and how to integrate Hoogle with Firefox/Emacs/Vim etc.

    I am very interested in any feedback you may have. Please email me, or add an entry to my bug tracker.

    #export parseError

    $!errFormat$

    Parse error: $&errMessage$

    For information on what queries should look like, see the user manual.

    hoogle-4.2.23/datadir/resources/spinner.gif0000644000000000000000000000376512222103576017047 0ustar0000000000000000GIF89a鵵<<<򭭭۪׻&&&عˮRRRꅅJJJ Ѥ)))]]]̷YYYfffʦุzzzNNNjjjֺnnnޖaaatttTTTFFFWWW222www|||666qqqAAAlllxxx---###Ҭ! NETSCAPE2.0!,Ȁ-h _W -%Mo>j`=^:Q!6 53p6ZO/Q,);Q  G@l^ba"-$ R:σ1?T"!J `Ą%* ċl4HDa+Q4\"  RaVg @!, otp8_sZ7L2>ngwhP7'tbcAr.: *2rb"K[\,A?B= M"- aɊH!1?!,d d=befN>]Ic.lF61 Zb3gA#Mc_XdE7k_$17|yC,FwWmZ'/zR[ #VQ!,b -%#!2;/ZY!Nqjc6#Pb,O e5.=P_veVf*gJ&moo6dKq$>|`͇)" !, m#=!2;/2Y!6  O!G#H;2^^H+c3d;JqBfEfZ!_m*.G>Sg<(hSkRPp!, rB1 OD,U  GM& !R ,D(HmzP 2-FbnG}5Z`ch+3!DIe/;cZ !, dV,P33fA}EmE"-,$Cd{u?F|e=b 2(],G3K!j%y[_t e?QF+H5"0(). !, rO:!2;>W."X2Y!Ml|sN1d^X_pxk7hG% HmFnS. CCJ]PL6^j?#V5' +)!,a :8oC|u(U! 3s hP'X*h^;edj%dXXg(D)nePI~q='/$ ;hoogle-4.2.23/datadir/resources/search.xml0000644000000000000000000000211712222103576016657 0ustar0000000000000000 Hoogle Hoogle - Haskell API Search 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. haskell http://haskell.org/hoogle/datadir/resources/favicon.png http://haskell.org/hoogle/datadir/resources/favicon64.png Neil Mitchell false en-us UTF-8 UTF-8 hoogle-4.2.23/datadir/resources/more_small.png0000644000000000000000000000031212222103576017523 0ustar0000000000000000PNG  IHDR [AgAMA atEXtSoftwarewww.inkscape.org<PLTENN~׃8IDATc(/VR2/g()/w g(L/`/g0)/`/wfPQE @ P%P P[uhVIENDB`hoogle-4.2.23/datadir/resources/more_gray.png0000644000000000000000000000031312222103576017356 0ustar0000000000000000PNG  IHDR ҎtEXtCreation Time!|tIME-T] pHYs  ~PLTE޵t(IDATcH4cLKKbKcHK pI+ ? ԃ2IENDB`hoogle-4.2.23/datadir/resources/more_blue.png0000644000000000000000000000043312222103576017346 0ustar0000000000000000PNG  IHDR atEXtCreation Time -@GtIME -4 pHYs  ~").appendTo(b),e=d.css("display");d.remove();if(e==="none"||e===""){ck||(ck=c.createElement("iframe"),ck.frameBorder=ck.width=ck.height=0),b.appendChild(ck);if(!cl||!ck.createElement)cl=(ck.contentWindow||ck.contentDocument).document,cl.write((f.support.boxModel?"":"")+""),cl.close();d=cl.createElement(a),cl.body.appendChild(d),e=f.css(d,"display"),b.removeChild(ck)}cj[a]=e}return cj[a]}function ct(a,b){var c={};f.each(cp.concat.apply([],cp.slice(0,b)),function(){c[this]=a});return c}function cs(){cq=b}function cr(){setTimeout(cs,0);return cq=f.now()}function ci(){try{return new a.ActiveXObject("Microsoft.XMLHTTP")}catch(b){}}function ch(){try{return new a.XMLHttpRequest}catch(b){}}function cb(a,c){a.dataFilter&&(c=a.dataFilter(c,a.dataType));var d=a.dataTypes,e={},g,h,i=d.length,j,k=d[0],l,m,n,o,p;for(g=1;g0){if(c!=="border")for(;e=0===c})}function S(a){return!a||!a.parentNode||a.parentNode.nodeType===11}function K(){return!0}function J(){return!1}function n(a,b,c){var d=b+"defer",e=b+"queue",g=b+"mark",h=f._data(a,d);h&&(c==="queue"||!f._data(a,e))&&(c==="mark"||!f._data(a,g))&&setTimeout(function(){!f._data(a,e)&&!f._data(a,g)&&(f.removeData(a,d,!0),h.fire())},0)}function m(a){for(var b in a){if(b==="data"&&f.isEmptyObject(a[b]))continue;if(b!=="toJSON")return!1}return!0}function l(a,c,d){if(d===b&&a.nodeType===1){var e="data-"+c.replace(k,"-$1").toLowerCase();d=a.getAttribute(e);if(typeof d=="string"){try{d=d==="true"?!0:d==="false"?!1:d==="null"?null:f.isNumeric(d)?+d:j.test(d)?f.parseJSON(d):d}catch(g){}f.data(a,c,d)}else d=b}return d}function h(a){var b=g[a]={},c,d;a=a.split(/\s+/);for(c=0,d=a.length;c)[^>]*$|#([\w\-]*)$)/,j=/\S/,k=/^\s+/,l=/\s+$/,m=/^<(\w+)\s*\/?>(?:<\/\1>)?$/,n=/^[\],:{}\s]*$/,o=/\\(?:["\\\/bfnrt]|u[0-9a-fA-F]{4})/g,p=/"[^"\\\n\r]*"|true|false|null|-?\d+(?:\.\d*)?(?:[eE][+\-]?\d+)?/g,q=/(?:^|:|,)(?:\s*\[)+/g,r=/(webkit)[ \/]([\w.]+)/,s=/(opera)(?:.*version)?[ \/]([\w.]+)/,t=/(msie) ([\w.]+)/,u=/(mozilla)(?:.*? rv:([\w.]+))?/,v=/-([a-z]|[0-9])/ig,w=/^-ms-/,x=function(a,b){return(b+"").toUpperCase()},y=d.userAgent,z,A,B,C=Object.prototype.toString,D=Object.prototype.hasOwnProperty,E=Array.prototype.push,F=Array.prototype.slice,G=String.prototype.trim,H=Array.prototype.indexOf,I={};e.fn=e.prototype={constructor:e,init:function(a,d,f){var g,h,j,k;if(!a)return this;if(a.nodeType){this.context=this[0]=a,this.length=1;return this}if(a==="body"&&!d&&c.body){this.context=c,this[0]=c.body,this.selector=a,this.length=1;return this}if(typeof a=="string"){a.charAt(0)!=="<"||a.charAt(a.length-1)!==">"||a.length<3?g=i.exec(a):g=[null,a,null];if(g&&(g[1]||!d)){if(g[1]){d=d instanceof e?d[0]:d,k=d?d.ownerDocument||d:c,j=m.exec(a),j?e.isPlainObject(d)?(a=[c.createElement(j[1])],e.fn.attr.call(a,d,!0)):a=[k.createElement(j[1])]:(j=e.buildFragment([g[1]],[k]),a=(j.cacheable?e.clone(j.fragment):j.fragment).childNodes);return e.merge(this,a)}h=c.getElementById(g[2]);if(h&&h.parentNode){if(h.id!==g[2])return f.find(a);this.length=1,this[0]=h}this.context=c,this.selector=a;return this}return!d||d.jquery?(d||f).find(a):this.constructor(d).find(a)}if(e.isFunction(a))return f.ready(a);a.selector!==b&&(this.selector=a.selector,this.context=a.context);return e.makeArray(a,this)},selector:"",jquery:"1.7.2",length:0,size:function(){return this.length},toArray:function(){return F.call(this,0)},get:function(a){return a==null?this.toArray():a<0?this[this.length+a]:this[a]},pushStack:function(a,b,c){var d=this.constructor();e.isArray(a)?E.apply(d,a):e.merge(d,a),d.prevObject=this,d.context=this.context,b==="find"?d.selector=this.selector+(this.selector?" ":"")+c:b&&(d.selector=this.selector+"."+b+"("+c+")");return d},each:function(a,b){return e.each(this,a,b)},ready:function(a){e.bindReady(),A.add(a);return this},eq:function(a){a=+a;return a===-1?this.slice(a):this.slice(a,a+1)},first:function(){return this.eq(0)},last:function(){return this.eq(-1)},slice:function(){return this.pushStack(F.apply(this,arguments),"slice",F.call(arguments).join(","))},map:function(a){return this.pushStack(e.map(this,function(b,c){return a.call(b,c,b)}))},end:function(){return this.prevObject||this.constructor(null)},push:E,sort:[].sort,splice:[].splice},e.fn.init.prototype=e.fn,e.extend=e.fn.extend=function(){var a,c,d,f,g,h,i=arguments[0]||{},j=1,k=arguments.length,l=!1;typeof i=="boolean"&&(l=i,i=arguments[1]||{},j=2),typeof i!="object"&&!e.isFunction(i)&&(i={}),k===j&&(i=this,--j);for(;j0)return;A.fireWith(c,[e]),e.fn.trigger&&e(c).trigger("ready").off("ready")}},bindReady:function(){if(!A){A=e.Callbacks("once memory");if(c.readyState==="complete")return setTimeout(e.ready,1);if(c.addEventListener)c.addEventListener("DOMContentLoaded",B,!1),a.addEventListener("load",e.ready,!1);else if(c.attachEvent){c.attachEvent("onreadystatechange",B),a.attachEvent("onload",e.ready);var b=!1;try{b=a.frameElement==null}catch(d){}c.documentElement.doScroll&&b&&J()}}},isFunction:function(a){return e.type(a)==="function"},isArray:Array.isArray||function(a){return e.type(a)==="array"},isWindow:function(a){return a!=null&&a==a.window},isNumeric:function(a){return!isNaN(parseFloat(a))&&isFinite(a)},type:function(a){return a==null?String(a):I[C.call(a)]||"object"},isPlainObject:function(a){if(!a||e.type(a)!=="object"||a.nodeType||e.isWindow(a))return!1;try{if(a.constructor&&!D.call(a,"constructor")&&!D.call(a.constructor.prototype,"isPrototypeOf"))return!1}catch(c){return!1}var d;for(d in a);return d===b||D.call(a,d)},isEmptyObject:function(a){for(var b in a)return!1;return!0},error:function(a){throw new Error(a)},parseJSON:function(b){if(typeof b!="string"||!b)return null;b=e.trim(b);if(a.JSON&&a.JSON.parse)return a.JSON.parse(b);if(n.test(b.replace(o,"@").replace(p,"]").replace(q,"")))return(new Function("return "+b))();e.error("Invalid JSON: "+b)},parseXML:function(c){if(typeof c!="string"||!c)return null;var d,f;try{a.DOMParser?(f=new DOMParser,d=f.parseFromString(c,"text/xml")):(d=new ActiveXObject("Microsoft.XMLDOM"),d.async="false",d.loadXML(c))}catch(g){d=b}(!d||!d.documentElement||d.getElementsByTagName("parsererror").length)&&e.error("Invalid XML: "+c);return d},noop:function(){},globalEval:function(b){b&&j.test(b)&&(a.execScript||function(b){a.eval.call(a,b)})(b)},camelCase:function(a){return a.replace(w,"ms-").replace(v,x)},nodeName:function(a,b){return a.nodeName&&a.nodeName.toUpperCase()===b.toUpperCase()},each:function(a,c,d){var f,g=0,h=a.length,i=h===b||e.isFunction(a);if(d){if(i){for(f in a)if(c.apply(a[f],d)===!1)break}else for(;g0&&a[0]&&a[j-1]||j===0||e.isArray(a));if(k)for(;i1?i.call(arguments,0):b,j.notifyWith(k,e)}}function l(a){return function(c){b[a]=arguments.length>1?i.call(arguments,0):c,--g||j.resolveWith(j,b)}}var b=i.call(arguments,0),c=0,d=b.length,e=Array(d),g=d,h=d,j=d<=1&&a&&f.isFunction(a.promise)?a:f.Deferred(),k=j.promise();if(d>1){for(;c
    a",d=p.getElementsByTagName("*"),e=p.getElementsByTagName("a")[0];if(!d||!d.length||!e)return{};g=c.createElement("select"),h=g.appendChild(c.createElement("option")),i=p.getElementsByTagName("input")[0],b={leadingWhitespace:p.firstChild.nodeType===3,tbody:!p.getElementsByTagName("tbody").length,htmlSerialize:!!p.getElementsByTagName("link").length,style:/top/.test(e.getAttribute("style")),hrefNormalized:e.getAttribute("href")==="/a",opacity:/^0.55/.test(e.style.opacity),cssFloat:!!e.style.cssFloat,checkOn:i.value==="on",optSelected:h.selected,getSetAttribute:p.className!=="t",enctype:!!c.createElement("form").enctype,html5Clone:c.createElement("nav").cloneNode(!0).outerHTML!=="<:nav>",submitBubbles:!0,changeBubbles:!0,focusinBubbles:!1,deleteExpando:!0,noCloneEvent:!0,inlineBlockNeedsLayout:!1,shrinkWrapBlocks:!1,reliableMarginRight:!0,pixelMargin:!0},f.boxModel=b.boxModel=c.compatMode==="CSS1Compat",i.checked=!0,b.noCloneChecked=i.cloneNode(!0).checked,g.disabled=!0,b.optDisabled=!h.disabled;try{delete p.test}catch(r){b.deleteExpando=!1}!p.addEventListener&&p.attachEvent&&p.fireEvent&&(p.attachEvent("onclick",function(){b.noCloneEvent=!1}),p.cloneNode(!0).fireEvent("onclick")),i=c.createElement("input"),i.value="t",i.setAttribute("type","radio"),b.radioValue=i.value==="t",i.setAttribute("checked","checked"),i.setAttribute("name","t"),p.appendChild(i),j=c.createDocumentFragment(),j.appendChild(p.lastChild),b.checkClone=j.cloneNode(!0).cloneNode(!0).lastChild.checked,b.appendChecked=i.checked,j.removeChild(i),j.appendChild(p);if(p.attachEvent)for(n in{submit:1,change:1,focusin:1})m="on"+n,o=m in p,o||(p.setAttribute(m,"return;"),o=typeof p[m]=="function"),b[n+"Bubbles"]=o;j.removeChild(p),j=g=h=p=i=null,f(function(){var d,e,g,h,i,j,l,m,n,q,r,s,t,u=c.getElementsByTagName("body")[0];!u||(m=1,t="padding:0;margin:0;border:",r="position:absolute;top:0;left:0;width:1px;height:1px;",s=t+"0;visibility:hidden;",n="style='"+r+t+"5px solid #000;",q="
    "+""+"
    ",d=c.createElement("div"),d.style.cssText=s+"width:0;height:0;position:static;top:0;margin-top:"+m+"px",u.insertBefore(d,u.firstChild),p=c.createElement("div"),d.appendChild(p),p.innerHTML="
    t
    ",k=p.getElementsByTagName("td"),o=k[0].offsetHeight===0,k[0].style.display="",k[1].style.display="none",b.reliableHiddenOffsets=o&&k[0].offsetHeight===0,a.getComputedStyle&&(p.innerHTML="",l=c.createElement("div"),l.style.width="0",l.style.marginRight="0",p.style.width="2px",p.appendChild(l),b.reliableMarginRight=(parseInt((a.getComputedStyle(l,null)||{marginRight:0}).marginRight,10)||0)===0),typeof p.style.zoom!="undefined"&&(p.innerHTML="",p.style.width=p.style.padding="1px",p.style.border=0,p.style.overflow="hidden",p.style.display="inline",p.style.zoom=1,b.inlineBlockNeedsLayout=p.offsetWidth===3,p.style.display="block",p.style.overflow="visible",p.innerHTML="
    ",b.shrinkWrapBlocks=p.offsetWidth!==3),p.style.cssText=r+s,p.innerHTML=q,e=p.firstChild,g=e.firstChild,i=e.nextSibling.firstChild.firstChild,j={doesNotAddBorder:g.offsetTop!==5,doesAddBorderForTableAndCells:i.offsetTop===5},g.style.position="fixed",g.style.top="20px",j.fixedPosition=g.offsetTop===20||g.offsetTop===15,g.style.position=g.style.top="",e.style.overflow="hidden",e.style.position="relative",j.subtractsBorderForOverflowNotVisible=g.offsetTop===-5,j.doesNotIncludeMarginInBodyOffset=u.offsetTop!==m,a.getComputedStyle&&(p.style.marginTop="1%",b.pixelMargin=(a.getComputedStyle(p,null)||{marginTop:0}).marginTop!=="1%"),typeof d.style.zoom!="undefined"&&(d.style.zoom=1),u.removeChild(d),l=p=d=null,f.extend(b,j))});return b}();var j=/^(?:\{.*\}|\[.*\])$/,k=/([A-Z])/g;f.extend({cache:{},uuid:0,expando:"jQuery"+(f.fn.jquery+Math.random()).replace(/\D/g,""),noData:{embed:!0,object:"clsid:D27CDB6E-AE6D-11cf-96B8-444553540000",applet:!0},hasData:function(a){a=a.nodeType?f.cache[a[f.expando]]:a[f.expando];return!!a&&!m(a)},data:function(a,c,d,e){if(!!f.acceptData(a)){var g,h,i,j=f.expando,k=typeof c=="string",l=a.nodeType,m=l?f.cache:a,n=l?a[j]:a[j]&&j,o=c==="events";if((!n||!m[n]||!o&&!e&&!m[n].data)&&k&&d===b)return;n||(l?a[j]=n=++f.uuid:n=j),m[n]||(m[n]={},l||(m[n].toJSON=f.noop));if(typeof c=="object"||typeof c=="function")e?m[n]=f.extend(m[n],c):m[n].data=f.extend(m[n].data,c);g=h=m[n],e||(h.data||(h.data={}),h=h.data),d!==b&&(h[f.camelCase(c)]=d);if(o&&!h[c])return g.events;k?(i=h[c],i==null&&(i=h[f.camelCase(c)])):i=h;return i}},removeData:function(a,b,c){if(!!f.acceptData(a)){var d,e,g,h=f.expando,i=a.nodeType,j=i?f.cache:a,k=i?a[h]:h;if(!j[k])return;if(b){d=c?j[k]:j[k].data;if(d){f.isArray(b)||(b in d?b=[b]:(b=f.camelCase(b),b in d?b=[b]:b=b.split(" ")));for(e=0,g=b.length;e1,null,!1)},removeData:function(a){return this.each(function(){f.removeData(this,a)})}}),f.extend({_mark:function(a,b){a&&(b=(b||"fx")+"mark",f._data(a,b,(f._data(a,b)||0)+1))},_unmark:function(a,b,c){a!==!0&&(c=b,b=a,a=!1);if(b){c=c||"fx";var d=c+"mark",e=a?0:(f._data(b,d)||1)-1;e?f._data(b,d,e):(f.removeData(b,d,!0),n(b,c,"mark"))}},queue:function(a,b,c){var d;if(a){b=(b||"fx")+"queue",d=f._data(a,b),c&&(!d||f.isArray(c)?d=f._data(a,b,f.makeArray(c)):d.push(c));return d||[]}},dequeue:function(a,b){b=b||"fx";var c=f.queue(a,b),d=c.shift(),e={};d==="inprogress"&&(d=c.shift()),d&&(b==="fx"&&c.unshift("inprogress"),f._data(a,b+".run",e),d.call(a,function(){f.dequeue(a,b)},e)),c.length||(f.removeData(a,b+"queue "+b+".run",!0),n(a,b,"queue"))}}),f.fn.extend({queue:function(a,c){var d=2;typeof a!="string"&&(c=a,a="fx",d--);if(arguments.length1)},removeAttr:function(a){return this.each(function(){f.removeAttr(this,a)})},prop:function(a,b){return f.access(this,f.prop,a,b,arguments.length>1)},removeProp:function(a){a=f.propFix[a]||a;return this.each(function(){try{this[a]=b,delete this[a]}catch(c){}})},addClass:function(a){var b,c,d,e,g,h,i;if(f.isFunction(a))return this.each(function(b){f(this).addClass(a.call(this,b,this.className))});if(a&&typeof a=="string"){b=a.split(p);for(c=0,d=this.length;c-1)return!0;return!1},val:function(a){var c,d,e,g=this[0];{if(!!arguments.length){e=f.isFunction(a);return this.each(function(d){var g=f(this),h;if(this.nodeType===1){e?h=a.call(this,d,g.val()):h=a,h==null?h="":typeof h=="number"?h+="":f.isArray(h)&&(h=f.map(h,function(a){return a==null?"":a+""})),c=f.valHooks[this.type]||f.valHooks[this.nodeName.toLowerCase()];if(!c||!("set"in c)||c.set(this,h,"value")===b)this.value=h}})}if(g){c=f.valHooks[g.type]||f.valHooks[g.nodeName.toLowerCase()];if(c&&"get"in c&&(d=c.get(g,"value"))!==b)return d;d=g.value;return typeof d=="string"?d.replace(q,""):d==null?"":d}}}}),f.extend({valHooks:{option:{get:function(a){var b=a.attributes.value;return!b||b.specified?a.value:a.text}},select:{get:function(a){var b,c,d,e,g=a.selectedIndex,h=[],i=a.options,j=a.type==="select-one";if(g<0)return null;c=j?g:0,d=j?g+1:i.length;for(;c=0}),c.length||(a.selectedIndex=-1);return c}}},attrFn:{val:!0,css:!0,html:!0,text:!0,data:!0,width:!0,height:!0,offset:!0},attr:function(a,c,d,e){var g,h,i,j=a.nodeType;if(!!a&&j!==3&&j!==8&&j!==2){if(e&&c in f.attrFn)return f(a)[c](d);if(typeof a.getAttribute=="undefined")return f.prop(a,c,d);i=j!==1||!f.isXMLDoc(a),i&&(c=c.toLowerCase(),h=f.attrHooks[c]||(u.test(c)?x:w));if(d!==b){if(d===null){f.removeAttr(a,c);return}if(h&&"set"in h&&i&&(g=h.set(a,d,c))!==b)return g;a.setAttribute(c,""+d);return d}if(h&&"get"in h&&i&&(g=h.get(a,c))!==null)return g;g=a.getAttribute(c);return g===null?b:g}},removeAttr:function(a,b){var c,d,e,g,h,i=0;if(b&&a.nodeType===1){d=b.toLowerCase().split(p),g=d.length;for(;i=0}})});var z=/^(?:textarea|input|select)$/i,A=/^([^\.]*)?(?:\.(.+))?$/,B=/(?:^|\s)hover(\.\S+)?\b/,C=/^key/,D=/^(?:mouse|contextmenu)|click/,E=/^(?:focusinfocus|focusoutblur)$/,F=/^(\w*)(?:#([\w\-]+))?(?:\.([\w\-]+))?$/,G=function( a){var b=F.exec(a);b&&(b[1]=(b[1]||"").toLowerCase(),b[3]=b[3]&&new RegExp("(?:^|\\s)"+b[3]+"(?:\\s|$)"));return b},H=function(a,b){var c=a.attributes||{};return(!b[1]||a.nodeName.toLowerCase()===b[1])&&(!b[2]||(c.id||{}).value===b[2])&&(!b[3]||b[3].test((c["class"]||{}).value))},I=function(a){return f.event.special.hover?a:a.replace(B,"mouseenter$1 mouseleave$1")};f.event={add:function(a,c,d,e,g){var h,i,j,k,l,m,n,o,p,q,r,s;if(!(a.nodeType===3||a.nodeType===8||!c||!d||!(h=f._data(a)))){d.handler&&(p=d,d=p.handler,g=p.selector),d.guid||(d.guid=f.guid++),j=h.events,j||(h.events=j={}),i=h.handle,i||(h.handle=i=function(a){return typeof f!="undefined"&&(!a||f.event.triggered!==a.type)?f.event.dispatch.apply(i.elem,arguments):b},i.elem=a),c=f.trim(I(c)).split(" ");for(k=0;k=0&&(h=h.slice(0,-1),k=!0),h.indexOf(".")>=0&&(i=h.split("."),h=i.shift(),i.sort());if((!e||f.event.customEvent[h])&&!f.event.global[h])return;c=typeof c=="object"?c[f.expando]?c:new f.Event(h,c):new f.Event(h),c.type=h,c.isTrigger=!0,c.exclusive=k,c.namespace=i.join("."),c.namespace_re=c.namespace?new RegExp("(^|\\.)"+i.join("\\.(?:.*\\.)?")+"(\\.|$)"):null,o=h.indexOf(":")<0?"on"+h:"";if(!e){j=f.cache;for(l in j)j[l].events&&j[l].events[h]&&f.event.trigger(c,d,j[l].handle.elem,!0);return}c.result=b,c.target||(c.target=e),d=d!=null?f.makeArray(d):[],d.unshift(c),p=f.event.special[h]||{};if(p.trigger&&p.trigger.apply(e,d)===!1)return;r=[[e,p.bindType||h]];if(!g&&!p.noBubble&&!f.isWindow(e)){s=p.delegateType||h,m=E.test(s+h)?e:e.parentNode,n=null;for(;m;m=m.parentNode)r.push([m,s]),n=m;n&&n===e.ownerDocument&&r.push([n.defaultView||n.parentWindow||a,s])}for(l=0;le&&j.push({elem:this,matches:d.slice(e)});for(k=0;k0?this.on(b,null,a,c):this.trigger(b)},f.attrFn&&(f.attrFn[b]=!0),C.test(b)&&(f.event.fixHooks[b]=f.event.keyHooks),D.test(b)&&(f.event.fixHooks[b]=f.event.mouseHooks)}),function(){function x(a,b,c,e,f,g){for(var h=0,i=e.length;h0){k=j;break}}j=j[a]}e[h]=k}}}function w(a,b,c,e,f,g){for(var h=0,i=e.length;h+~,(\[\\]+)+|[>+~])(\s*,\s*)?((?:.|\r|\n)*)/g,d="sizcache"+(Math.random()+"").replace(".",""),e=0,g=Object.prototype.toString,h=!1,i=!0,j=/\\/g,k=/\r\n/g,l=/\W/;[0,0].sort(function(){i=!1;return 0});var m=function(b,d,e,f){e=e||[],d=d||c;var h=d;if(d.nodeType!==1&&d.nodeType!==9)return[];if(!b||typeof b!="string")return e;var i,j,k,l,n,q,r,t,u=!0,v=m.isXML(d),w=[],x=b;do{a.exec(""),i=a.exec(x);if(i){x=i[3],w.push(i[1]);if(i[2]){l=i[3];break}}}while(i);if(w.length>1&&p.exec(b))if(w.length===2&&o.relative[w[0]])j=y(w[0]+w[1],d,f);else{j=o.relative[w[0]]?[d]:m(w.shift(),d);while(w.length)b=w.shift(),o.relative[b]&&(b+=w.shift()),j=y(b,j,f)}else{!f&&w.length>1&&d.nodeType===9&&!v&&o.match.ID.test(w[0])&&!o.match.ID.test(w[w.length-1])&&(n=m.find(w.shift(),d,v),d=n.expr?m.filter(n.expr,n.set)[0]:n.set[0]);if(d){n=f?{expr:w.pop(),set:s(f)}:m.find(w.pop(),w.length===1&&(w[0]==="~"||w[0]==="+")&&d.parentNode?d.parentNode:d,v),j=n.expr?m.filter(n.expr,n.set):n.set,w.length>0?k=s(j):u=!1;while(w.length)q=w.pop(),r=q,o.relative[q]?r=w.pop():q="",r==null&&(r=d),o.relative[q](k,r,v)}else k=w=[]}k||(k=j),k||m.error(q||b);if(g.call(k)==="[object Array]")if(!u)e.push.apply(e,k);else if(d&&d.nodeType===1)for(t=0;k[t]!=null;t++)k[t]&&(k[t]===!0||k[t].nodeType===1&&m.contains(d,k[t]))&&e.push(j[t]);else for(t=0;k[t]!=null;t++)k[t]&&k[t].nodeType===1&&e.push(j[t]);else s(k,e);l&&(m(l,h,e,f),m.uniqueSort(e));return e};m.uniqueSort=function(a){if(u){h=i,a.sort(u);if(h)for(var b=1;b0},m.find=function(a,b,c){var d,e,f,g,h,i;if(!a)return[];for(e=0,f=o.order.length;e":function(a,b){var c,d=typeof b=="string",e=0,f=a.length;if(d&&!l.test(b)){b=b.toLowerCase();for(;e=0)?c||d.push(h):c&&(b[g]=!1));return!1},ID:function(a){return a[1].replace(j,"")},TAG:function(a,b){return a[1].replace(j,"").toLowerCase()},CHILD:function(a){if(a[1]==="nth"){a[2]||m.error(a[0]),a[2]=a[2].replace(/^\+|\s*/g,"");var b=/(-?)(\d*)(?:n([+\-]?\d*))?/.exec(a[2]==="even"&&"2n"||a[2]==="odd"&&"2n+1"||!/\D/.test(a[2])&&"0n+"+a[2]||a[2]);a[2]=b[1]+(b[2]||1)-0,a[3]=b[3]-0}else a[2]&&m.error(a[0]);a[0]=e++;return a},ATTR:function(a,b,c,d,e,f){var g=a[1]=a[1].replace(j,"");!f&&o.attrMap[g]&&(a[1]=o.attrMap[g]),a[4]=(a[4]||a[5]||"").replace(j,""),a[2]==="~="&&(a[4]=" "+a[4]+" ");return a},PSEUDO:function(b,c,d,e,f){if(b[1]==="not")if((a.exec(b[3])||"").length>1||/^\w/.test(b[3]))b[3]=m(b[3],null,null,c);else{var g=m.filter(b[3],c,d,!0^f);d||e.push.apply(e,g);return!1}else if(o.match.POS.test(b[0])||o.match.CHILD.test(b[0]))return!0;return b},POS:function(a){a.unshift(!0);return a}},filters:{enabled:function(a){return a.disabled===!1&&a.type!=="hidden"},disabled:function(a){return a.disabled===!0},checked:function(a){return a.checked===!0},selected:function(a){a.parentNode&&a.parentNode.selectedIndex;return a.selected===!0},parent:function(a){return!!a.firstChild},empty:function(a){return!a.firstChild},has:function(a,b,c){return!!m(c[3],a).length},header:function(a){return/h\d/i.test(a.nodeName)},text:function(a){var b=a.getAttribute("type"),c=a.type;return a.nodeName.toLowerCase()==="input"&&"text"===c&&(b===c||b===null)},radio:function(a){return a.nodeName.toLowerCase()==="input"&&"radio"===a.type},checkbox:function(a){return a.nodeName.toLowerCase()==="input"&&"checkbox"===a.type},file:function(a){return a.nodeName.toLowerCase()==="input"&&"file"===a.type},password:function(a){return a.nodeName.toLowerCase()==="input"&&"password"===a.type},submit:function(a){var b=a.nodeName.toLowerCase();return(b==="input"||b==="button")&&"submit"===a.type},image:function(a){return a.nodeName.toLowerCase()==="input"&&"image"===a.type},reset:function(a){var b=a.nodeName.toLowerCase();return(b==="input"||b==="button")&&"reset"===a.type},button:function(a){var b=a.nodeName.toLowerCase();return b==="input"&&"button"===a.type||b==="button"},input:function(a){return/input|select|textarea|button/i.test(a.nodeName)},focus:function(a){return a===a.ownerDocument.activeElement}},setFilters:{first:function(a,b){return b===0},last:function(a,b,c,d){return b===d.length-1},even:function(a,b){return b%2===0},odd:function(a,b){return b%2===1},lt:function(a,b,c){return bc[3]-0},nth:function(a,b,c){return c[3]-0===b},eq:function(a,b,c){return c[3]-0===b}},filter:{PSEUDO:function(a,b,c,d){var e=b[1],f=o.filters[e];if(f)return f(a,c,b,d);if(e==="contains")return(a.textContent||a.innerText||n([a])||"").indexOf(b[3])>=0;if(e==="not"){var g=b[3];for(var h=0,i=g.length;h=0}},ID:function(a,b){return a.nodeType===1&&a.getAttribute("id")===b},TAG:function(a,b){return b==="*"&&a.nodeType===1||!!a.nodeName&&a.nodeName.toLowerCase()===b},CLASS:function(a,b){return(" "+(a.className||a.getAttribute("class"))+" ").indexOf(b)>-1},ATTR:function(a,b){var c=b[1],d=m.attr?m.attr(a,c):o.attrHandle[c]?o.attrHandle[c](a):a[c]!=null?a[c]:a.getAttribute(c),e=d+"",f=b[2],g=b[4];return d==null?f==="!=":!f&&m.attr?d!=null:f==="="?e===g:f==="*="?e.indexOf(g)>=0:f==="~="?(" "+e+" ").indexOf(g)>=0:g?f==="!="?e!==g:f==="^="?e.indexOf(g)===0:f==="$="?e.substr(e.length-g.length)===g:f==="|="?e===g||e.substr(0,g.length+1)===g+"-":!1:e&&d!==!1},POS:function(a,b,c,d){var e=b[2],f=o.setFilters[e];if(f)return f(a,c,b,d)}}},p=o.match.POS,q=function(a,b){return"\\"+(b-0+1)};for(var r in o.match)o.match[r]=new RegExp(o.match[r].source+/(?![^\[]*\])(?![^\(]*\))/.source),o.leftMatch[r]=new RegExp(/(^(?:.|\r|\n)*?)/.source+o.match[r].source.replace(/\\(\d+)/g,q));o.match.globalPOS=p;var s=function(a,b){a=Array.prototype.slice.call(a,0);if(b){b.push.apply(b,a);return b}return a};try{Array.prototype.slice.call(c.documentElement.childNodes,0)[0].nodeType}catch(t){s=function(a,b){var c=0,d=b||[];if(g.call(a)==="[object Array]")Array.prototype.push.apply(d,a);else if(typeof a.length=="number")for(var e=a.length;c",e.insertBefore(a,e.firstChild),c.getElementById(d)&&(o.find.ID=function(a,c,d){if(typeof c.getElementById!="undefined"&&!d){var e=c.getElementById(a[1]);return e?e.id===a[1]||typeof e.getAttributeNode!="undefined"&&e.getAttributeNode("id").nodeValue===a[1]?[e]:b:[]}},o.filter.ID=function(a,b){var c=typeof a.getAttributeNode!="undefined"&&a.getAttributeNode("id");return a.nodeType===1&&c&&c.nodeValue===b}),e.removeChild(a),e=a=null}(),function(){var a=c.createElement("div");a.appendChild(c.createComment("")),a.getElementsByTagName("*").length>0&&(o.find.TAG=function(a,b){var c=b.getElementsByTagName(a[1]);if(a[1]==="*"){var d=[];for(var e=0;c[e];e++)c[e].nodeType===1&&d.push(c[e]);c=d}return c}),a.innerHTML="",a.firstChild&&typeof a.firstChild.getAttribute!="undefined"&&a.firstChild.getAttribute("href")!=="#"&&(o.attrHandle.href=function(a){return a.getAttribute("href",2)}),a=null}(),c.querySelectorAll&&function(){var a=m,b=c.createElement("div"),d="__sizzle__";b.innerHTML="

    ";if(!b.querySelectorAll||b.querySelectorAll(".TEST").length!==0){m=function(b,e,f,g){e=e||c;if(!g&&!m.isXML(e)){var h=/^(\w+$)|^\.([\w\-]+$)|^#([\w\-]+$)/.exec(b);if(h&&(e.nodeType===1||e.nodeType===9)){if(h[1])return s(e.getElementsByTagName(b),f);if(h[2]&&o.find.CLASS&&e.getElementsByClassName)return s(e.getElementsByClassName(h[2]),f)}if(e.nodeType===9){if(b==="body"&&e.body)return s([e.body],f);if(h&&h[3]){var i=e.getElementById(h[3]);if(!i||!i.parentNode)return s([],f);if(i.id===h[3])return s([i],f)}try{return s(e.querySelectorAll(b),f)}catch(j){}}else if(e.nodeType===1&&e.nodeName.toLowerCase()!=="object"){var k=e,l=e.getAttribute("id"),n=l||d,p=e.parentNode,q=/^\s*[+~]/.test(b);l?n=n.replace(/'/g,"\\$&"):e.setAttribute("id",n),q&&p&&(e=e.parentNode);try{if(!q||p)return s(e.querySelectorAll("[id='"+n+"'] "+b),f)}catch(r){}finally{l||k.removeAttribute("id")}}}return a(b,e,f,g)};for(var e in a)m[e]=a[e];b=null}}(),function(){var a=c.documentElement,b=a.matchesSelector||a.mozMatchesSelector||a.webkitMatchesSelector||a.msMatchesSelector;if(b){var d=!b.call(c.createElement("div"),"div"),e=!1;try{b.call(c.documentElement,"[test!='']:sizzle")}catch(f){e=!0}m.matchesSelector=function(a,c){c=c.replace(/\=\s*([^'"\]]*)\s*\]/g,"='$1']");if(!m.isXML(a))try{if(e||!o.match.PSEUDO.test(c)&&!/!=/.test(c)){var f=b.call(a,c);if(f||!d||a.document&&a.document.nodeType!==11)return f}}catch(g){}return m(c,null,null,[a]).length>0}}}(),function(){var a=c.createElement("div");a.innerHTML="
    ";if(!!a.getElementsByClassName&&a.getElementsByClassName("e").length!==0){a.lastChild.className="e";if(a.getElementsByClassName("e").length===1)return;o.order.splice(1,0,"CLASS"),o.find.CLASS=function(a,b,c){if(typeof b.getElementsByClassName!="undefined"&&!c)return b.getElementsByClassName(a[1])},a=null}}(),c.documentElement.contains?m.contains=function(a,b){return a!==b&&(a.contains?a.contains(b):!0)}:c.documentElement.compareDocumentPosition?m.contains=function(a,b){return!!(a.compareDocumentPosition(b)&16)}:m.contains=function(){return!1},m.isXML=function(a){var b=(a?a.ownerDocument||a:0).documentElement;return b?b.nodeName!=="HTML":!1};var y=function(a,b,c){var d,e=[],f="",g=b.nodeType?[b]:b;while(d=o.match.PSEUDO.exec(a))f+=d[0],a=a.replace(o.match.PSEUDO,"");a=o.relative[a]?a+"*":a;for(var h=0,i=g.length;h0)for(h=g;h=0:f.filter(a,this).length>0:this.filter(a).length>0)},closest:function(a,b){var c=[],d,e,g=this[0];if(f.isArray(a)){var h=1;while(g&&g.ownerDocument&&g!==b){for(d=0;d-1:f.find.matchesSelector(g,a)){c.push(g);break}g=g.parentNode;if(!g||!g.ownerDocument||g===b||g.nodeType===11)break}}c=c.length>1?f.unique(c):c;return this.pushStack(c,"closest",a)},index:function(a){if(!a)return this[0]&&this[0].parentNode?this.prevAll().length:-1;if(typeof a=="string")return f.inArray(this[0],f(a));return f.inArray(a.jquery?a[0]:a,this)},add:function(a,b){var c=typeof a=="string"?f(a,b):f.makeArray(a&&a.nodeType?[a]:a),d=f.merge(this.get(),c);return this.pushStack(S(c[0])||S(d[0])?d:f.unique(d))},andSelf:function(){return this.add(this.prevObject)}}),f.each({parent:function(a){var b=a.parentNode;return b&&b.nodeType!==11?b:null},parents:function(a){return f.dir(a,"parentNode")},parentsUntil:function(a,b,c){return f.dir(a,"parentNode",c)},next:function(a){return f.nth(a,2,"nextSibling")},prev:function(a){return f.nth(a,2,"previousSibling")},nextAll:function(a){return f.dir(a,"nextSibling")},prevAll:function(a){return f.dir(a,"previousSibling")},nextUntil:function(a,b,c){return f.dir(a,"nextSibling",c)},prevUntil:function(a,b,c){return f.dir(a,"previousSibling",c)},siblings:function(a){return f.sibling((a.parentNode||{}).firstChild,a)},children:function(a){return f.sibling(a.firstChild)},contents:function(a){return f.nodeName(a,"iframe")?a.contentDocument||a.contentWindow.document:f.makeArray(a.childNodes)}},function(a,b){f.fn[a]=function(c,d){var e=f.map(this,b,c);L.test(a)||(d=c),d&&typeof d=="string"&&(e=f.filter(d,e)),e=this.length>1&&!R[a]?f.unique(e):e,(this.length>1||N.test(d))&&M.test(a)&&(e=e.reverse());return this.pushStack(e,a,P.call(arguments).join(","))}}),f.extend({filter:function(a,b,c){c&&(a=":not("+a+")");return b.length===1?f.find.matchesSelector(b[0],a)?[b[0]]:[]:f.find.matches(a,b)},dir:function(a,c,d){var e=[],g=a[c];while(g&&g.nodeType!==9&&(d===b||g.nodeType!==1||!f(g).is(d)))g.nodeType===1&&e.push(g),g=g[c];return e},nth:function(a,b,c,d){b=b||1;var e=0;for(;a;a=a[c])if(a.nodeType===1&&++e===b)break;return a},sibling:function(a,b){var c=[];for(;a;a=a.nextSibling)a.nodeType===1&&a!==b&&c.push(a);return c}});var V="abbr|article|aside|audio|bdi|canvas|data|datalist|details|figcaption|figure|footer|header|hgroup|mark|meter|nav|output|progress|section|summary|time|video",W=/ jQuery\d+="(?:\d+|null)"/g,X=/^\s+/,Y=/<(?!area|br|col|embed|hr|img|input|link|meta|param)(([\w:]+)[^>]*)\/>/ig,Z=/<([\w:]+)/,$=/]","i"),bd=/checked\s*(?:[^=]|=\s*.checked.)/i,be=/\/(java|ecma)script/i,bf=/^\s*",""],legend:[1,"
    ","
    "],thead:[1,"","
    "],tr:[2,"","
    "],td:[3,"","
    "],col:[2,"","
    "],area:[1,"",""],_default:[0,"",""]},bh=U(c);bg.optgroup=bg.option,bg.tbody=bg.tfoot=bg.colgroup=bg.caption=bg.thead,bg.th=bg.td,f.support.htmlSerialize||(bg._default=[1,"div
    ","
    "]),f.fn.extend({text:function(a){return f.access(this,function(a){return a===b?f.text(this):this.empty().append((this[0]&&this[0].ownerDocument||c).createTextNode(a))},null,a,arguments.length)},wrapAll:function(a){if(f.isFunction(a))return this.each(function(b){f(this).wrapAll(a.call(this,b))});if(this[0]){var b=f(a,this[0].ownerDocument).eq(0).clone(!0);this[0].parentNode&&b.insertBefore(this[0]),b.map(function(){var a=this;while(a.firstChild&&a.firstChild.nodeType===1)a=a.firstChild;return a}).append(this)}return this},wrapInner:function(a){if(f.isFunction(a))return this.each(function(b){f(this).wrapInner(a.call(this,b))});return this.each(function(){var b=f(this),c=b.contents();c.length?c.wrapAll(a):b.append(a)})},wrap:function(a){var b=f.isFunction(a);return this.each(function(c){f(this).wrapAll(b?a.call(this,c):a)})},unwrap:function(){return this.parent().each(function(){f.nodeName(this,"body")||f(this).replaceWith(this.childNodes)}).end()},append:function(){return this.domManip(arguments,!0,function(a){this.nodeType===1&&this.appendChild(a)})},prepend:function(){return this.domManip(arguments,!0,function(a){this.nodeType===1&&this.insertBefore(a,this.firstChild)})},before:function(){if(this[0]&&this[0].parentNode)return this.domManip(arguments,!1,function(a){this.parentNode.insertBefore(a,this)});if(arguments.length){var a=f .clean(arguments);a.push.apply(a,this.toArray());return this.pushStack(a,"before",arguments)}},after:function(){if(this[0]&&this[0].parentNode)return this.domManip(arguments,!1,function(a){this.parentNode.insertBefore(a,this.nextSibling)});if(arguments.length){var a=this.pushStack(this,"after",arguments);a.push.apply(a,f.clean(arguments));return a}},remove:function(a,b){for(var c=0,d;(d=this[c])!=null;c++)if(!a||f.filter(a,[d]).length)!b&&d.nodeType===1&&(f.cleanData(d.getElementsByTagName("*")),f.cleanData([d])),d.parentNode&&d.parentNode.removeChild(d);return this},empty:function(){for(var a=0,b;(b=this[a])!=null;a++){b.nodeType===1&&f.cleanData(b.getElementsByTagName("*"));while(b.firstChild)b.removeChild(b.firstChild)}return this},clone:function(a,b){a=a==null?!1:a,b=b==null?a:b;return this.map(function(){return f.clone(this,a,b)})},html:function(a){return f.access(this,function(a){var c=this[0]||{},d=0,e=this.length;if(a===b)return c.nodeType===1?c.innerHTML.replace(W,""):null;if(typeof a=="string"&&!ba.test(a)&&(f.support.leadingWhitespace||!X.test(a))&&!bg[(Z.exec(a)||["",""])[1].toLowerCase()]){a=a.replace(Y,"<$1>");try{for(;d1&&l0?this.clone(!0):this).get();f(e[h])[b](j),d=d.concat(j)}return this.pushStack(d,a,e.selector)}}),f.extend({clone:function(a,b,c){var d,e,g,h=f.support.html5Clone||f.isXMLDoc(a)||!bc.test("<"+a.nodeName+">")?a.cloneNode(!0):bo(a);if((!f.support.noCloneEvent||!f.support.noCloneChecked)&&(a.nodeType===1||a.nodeType===11)&&!f.isXMLDoc(a)){bk(a,h),d=bl(a),e=bl(h);for(g=0;d[g];++g)e[g]&&bk(d[g],e[g])}if(b){bj(a,h);if(c){d=bl(a),e=bl(h);for(g=0;d[g];++g)bj(d[g],e[g])}}d=e=null;return h},clean:function(a,b,d,e){var g,h,i,j=[];b=b||c,typeof b.createElement=="undefined"&&(b=b.ownerDocument||b[0]&&b[0].ownerDocument||c);for(var k=0,l;(l=a[k])!=null;k++){typeof l=="number"&&(l+="");if(!l)continue;if(typeof l=="string")if(!_.test(l))l=b.createTextNode(l);else{l=l.replace(Y,"<$1>");var m=(Z.exec(l)||["",""])[1].toLowerCase(),n=bg[m]||bg._default,o=n[0],p=b.createElement("div"),q=bh.childNodes,r;b===c?bh.appendChild(p):U(b).appendChild(p),p.innerHTML=n[1]+l+n[2];while(o--)p=p.lastChild;if(!f.support.tbody){var s=$.test(l),t=m==="table"&&!s?p.firstChild&&p.firstChild.childNodes:n[1]===""&&!s?p.childNodes:[];for(i=t.length-1;i>=0;--i)f.nodeName(t[i],"tbody")&&!t[i].childNodes.length&&t[i].parentNode.removeChild(t[i])}!f.support.leadingWhitespace&&X.test(l)&&p.insertBefore(b.createTextNode(X.exec(l)[0]),p.firstChild),l=p.childNodes,p&&(p.parentNode.removeChild(p),q.length>0&&(r=q[q.length-1],r&&r.parentNode&&r.parentNode.removeChild(r)))}var u;if(!f.support.appendChecked)if(l[0]&&typeof (u=l.length)=="number")for(i=0;i1)},f.extend({cssHooks:{opacity:{get:function(a,b){if(b){var c=by(a,"opacity");return c===""?"1":c}return a.style.opacity}}},cssNumber:{fillOpacity:!0,fontWeight:!0,lineHeight:!0,opacity:!0,orphans:!0,widows:!0,zIndex:!0,zoom:!0},cssProps:{"float":f.support.cssFloat?"cssFloat":"styleFloat"},style:function(a,c,d,e){if(!!a&&a.nodeType!==3&&a.nodeType!==8&&!!a.style){var g,h,i=f.camelCase(c),j=a.style,k=f.cssHooks[i];c=f.cssProps[i]||i;if(d===b){if(k&&"get"in k&&(g=k.get(a,!1,e))!==b)return g;return j[c]}h=typeof d,h==="string"&&(g=bu.exec(d))&&(d=+(g[1]+1)*+g[2]+parseFloat(f.css(a,c)),h="number");if(d==null||h==="number"&&isNaN(d))return;h==="number"&&!f.cssNumber[i]&&(d+="px");if(!k||!("set"in k)||(d=k.set(a,d))!==b)try{j[c]=d}catch(l){}}},css:function(a,c,d){var e,g;c=f.camelCase(c),g=f.cssHooks[c],c=f.cssProps[c]||c,c==="cssFloat"&&(c="float");if(g&&"get"in g&&(e=g.get(a,!0,d))!==b)return e;if(by)return by(a,c)},swap:function(a,b,c){var d={},e,f;for(f in b)d[f]=a.style[f],a.style[f]=b[f];e=c.call(a);for(f in b)a.style[f]=d[f];return e}}),f.curCSS=f.css,c.defaultView&&c.defaultView.getComputedStyle&&(bz=function(a,b){var c,d,e,g,h=a.style;b=b.replace(br,"-$1").toLowerCase(),(d=a.ownerDocument.defaultView)&&(e=d.getComputedStyle(a,null))&&(c=e.getPropertyValue(b),c===""&&!f.contains(a.ownerDocument.documentElement,a)&&(c=f.style(a,b))),!f.support.pixelMargin&&e&&bv.test(b)&&bt.test(c)&&(g=h.width,h.width=c,c=e.width,h.width=g);return c}),c.documentElement.currentStyle&&(bA=function(a,b){var c,d,e,f=a.currentStyle&&a.currentStyle[b],g=a.style;f==null&&g&&(e=g[b])&&(f=e),bt.test(f)&&(c=g.left,d=a.runtimeStyle&&a.runtimeStyle.left,d&&(a.runtimeStyle.left=a.currentStyle.left),g.left=b==="fontSize"?"1em":f,f=g.pixelLeft+"px",g.left=c,d&&(a.runtimeStyle.left=d));return f===""?"auto":f}),by=bz||bA,f.each(["height","width"],function(a,b){f.cssHooks[b]={get:function(a,c,d){if(c)return a.offsetWidth!==0?bB(a,b,d):f.swap(a,bw,function(){return bB(a,b,d)})},set:function(a,b){return bs.test(b)?b+"px":b}}}),f.support.opacity||(f.cssHooks.opacity={get:function(a,b){return bq.test((b&&a.currentStyle?a.currentStyle.filter:a.style.filter)||"")?parseFloat(RegExp.$1)/100+"":b?"1":""},set:function(a,b){var c=a.style,d=a.currentStyle,e=f.isNumeric(b)?"alpha(opacity="+b*100+")":"",g=d&&d.filter||c.filter||"";c.zoom=1;if(b>=1&&f.trim(g.replace(bp,""))===""){c.removeAttribute("filter");if(d&&!d.filter)return}c.filter=bp.test(g)?g.replace(bp,e):g+" "+e}}),f(function(){f.support.reliableMarginRight||(f.cssHooks.marginRight={get:function(a,b){return f.swap(a,{display:"inline-block"},function(){return b?by(a,"margin-right"):a.style.marginRight})}})}),f.expr&&f.expr.filters&&(f.expr.filters.hidden=function(a){var b=a.offsetWidth,c=a.offsetHeight;return b===0&&c===0||!f.support.reliableHiddenOffsets&&(a.style&&a.style.display||f.css(a,"display"))==="none"},f.expr.filters.visible=function(a){return!f.expr.filters.hidden(a)}),f.each({margin:"",padding:"",border:"Width"},function(a,b){f.cssHooks[a+b]={expand:function(c){var d,e=typeof c=="string"?c.split(" "):[c],f={};for(d=0;d<4;d++)f[a+bx[d]+b]=e[d]||e[d-2]||e[0];return f}}});var bC=/%20/g,bD=/\[\]$/,bE=/\r?\n/g,bF=/#.*$/,bG=/^(.*?):[ \t]*([^\r\n]*)\r?$/mg,bH=/^(?:color|date|datetime|datetime-local|email|hidden|month|number|password|range|search|tel|text|time|url|week)$/i,bI=/^(?:about|app|app\-storage|.+\-extension|file|res|widget):$/,bJ=/^(?:GET|HEAD)$/,bK=/^\/\//,bL=/\?/,bM=/)<[^<]*)*<\/script>/gi,bN=/^(?:select|textarea)/i,bO=/\s+/,bP=/([?&])_=[^&]*/,bQ=/^([\w\+\.\-]+:)(?:\/\/([^\/?#:]*)(?::(\d+))?)?/,bR=f.fn.load,bS={},bT={},bU,bV,bW=["*/"]+["*"];try{bU=e.href}catch(bX){bU=c.createElement("a"),bU.href="",bU=bU.href}bV=bQ.exec(bU.toLowerCase())||[],f.fn.extend({load:function(a,c,d){if(typeof a!="string"&&bR)return bR.apply(this,arguments);if(!this.length)return this;var e=a.indexOf(" ");if(e>=0){var g=a.slice(e,a.length);a=a.slice(0,e)}var h="GET";c&&(f.isFunction(c)?(d=c,c=b):typeof c=="object"&&(c=f.param(c,f.ajaxSettings.traditional),h="POST"));var i=this;f.ajax({url:a,type:h,dataType:"html",data:c,complete:function(a,b,c){c=a.responseText,a.isResolved()&&(a.done(function(a){c=a}),i.html(g?f("
    ").append(c.replace(bM,"")).find(g):c)),d&&i.each(d,[c,b,a])}});return this},serialize:function(){return f.param(this.serializeArray())},serializeArray:function(){return this.map(function(){return this.elements?f.makeArray(this.elements):this}).filter(function(){return this.name&&!this.disabled&&(this.checked||bN.test(this.nodeName)||bH.test(this.type))}).map(function(a,b){var c=f(this).val();return c==null?null:f.isArray(c)?f.map(c,function(a,c){return{name:b.name,value:a.replace(bE,"\r\n")}}):{name:b.name,value:c.replace(bE,"\r\n")}}).get()}}),f.each("ajaxStart ajaxStop ajaxComplete ajaxError ajaxSuccess ajaxSend".split(" "),function(a,b){f.fn[b]=function(a){return this.on(b,a)}}),f.each(["get","post"],function(a,c){f[c]=function(a,d,e,g){f.isFunction(d)&&(g=g||e,e=d,d=b);return f.ajax({type:c,url:a,data:d,success:e,dataType:g})}}),f.extend({getScript:function(a,c){return f.get(a,b,c,"script")},getJSON:function(a,b,c){return f.get(a,b,c,"json")},ajaxSetup:function(a,b){b?b$(a,f.ajaxSettings):(b=a,a=f.ajaxSettings),b$(a,b);return a},ajaxSettings:{url:bU,isLocal:bI.test(bV[1]),global:!0,type:"GET",contentType:"application/x-www-form-urlencoded; charset=UTF-8",processData:!0,async:!0,accepts:{xml:"application/xml, text/xml",html:"text/html",text:"text/plain",json:"application/json, text/javascript","*":bW},contents:{xml:/xml/,html:/html/,json:/json/},responseFields:{xml:"responseXML",text:"responseText"},converters:{"* text":a.String,"text html":!0,"text json":f.parseJSON,"text xml":f.parseXML},flatOptions:{context:!0,url:!0}},ajaxPrefilter:bY(bS),ajaxTransport:bY(bT),ajax:function(a,c){function w(a,c,l,m){if(s!==2){s=2,q&&clearTimeout(q),p=b,n=m||"",v.readyState=a>0?4:0;var o,r,u,w=c,x=l?ca(d,v,l):b,y,z;if(a>=200&&a<300||a===304){if(d.ifModified){if(y=v.getResponseHeader("Last-Modified"))f.lastModified[k]=y;if(z=v.getResponseHeader("Etag"))f.etag[k]=z}if(a===304)w="notmodified",o=!0;else try{r=cb(d,x),w="success",o=!0}catch(A){w="parsererror",u=A}}else{u=w;if(!w||a)w="error",a<0&&(a=0)}v.status=a,v.statusText=""+(c||w),o?h.resolveWith(e,[r,w,v]):h.rejectWith(e,[v,w,u]),v.statusCode(j),j=b,t&&g.trigger("ajax"+(o?"Success":"Error"),[v,d,o?r:u]),i.fireWith(e,[v,w]),t&&(g.trigger("ajaxComplete",[v,d]),--f.active||f.event.trigger("ajaxStop"))}}typeof a=="object"&&(c=a,a=b),c=c||{};var d=f.ajaxSetup({},c),e=d.context||d,g=e!==d&&(e.nodeType||e instanceof f)?f(e):f.event,h=f.Deferred(),i=f.Callbacks("once memory"),j=d.statusCode||{},k,l={},m={},n,o,p,q,r,s=0,t,u,v={readyState:0,setRequestHeader:function(a,b){if(!s){var c=a.toLowerCase();a=m[c]=m[c]||a,l[a]=b}return this},getAllResponseHeaders:function(){return s===2?n:null},getResponseHeader:function(a){var c;if(s===2){if(!o){o={};while(c=bG.exec(n))o[c[1].toLowerCase()]=c[2]}c=o[a.toLowerCase()]}return c===b?null:c},overrideMimeType:function(a){s||(d.mimeType=a);return this},abort:function(a){a=a||"abort",p&&p.abort(a),w(0,a);return this}};h.promise(v),v.success=v.done,v.error=v.fail,v.complete=i.add,v.statusCode=function(a){if(a){var b;if(s<2)for(b in a)j[b]=[j[b],a[b]];else b=a[v.status],v.then(b,b)}return this},d.url=((a||d.url)+"").replace(bF,"").replace(bK,bV[1]+"//"),d.dataTypes=f.trim(d.dataType||"*").toLowerCase().split(bO),d.crossDomain==null&&(r=bQ.exec(d.url.toLowerCase()),d.crossDomain=!(!r||r[1]==bV[1]&&r[2]==bV[2]&&(r[3]||(r[1]==="http:"?80:443))==(bV[3]||(bV[1]==="http:"?80:443)))),d.data&&d.processData&&typeof d.data!="string"&&(d.data=f.param(d.data,d.traditional)),bZ(bS,d,c,v);if(s===2)return!1;t=d.global,d.type=d.type.toUpperCase(),d.hasContent=!bJ.test(d.type),t&&f.active++===0&&f.event.trigger("ajaxStart");if(!d.hasContent){d.data&&(d.url+=(bL.test(d.url)?"&":"?")+d.data,delete d.data),k=d.url;if(d.cache===!1){var x=f.now(),y=d.url.replace(bP,"$1_="+x);d.url=y+(y===d.url?(bL.test(d.url)?"&":"?")+"_="+x:"")}}(d.data&&d.hasContent&&d.contentType!==!1||c.contentType)&&v.setRequestHeader("Content-Type",d.contentType),d.ifModified&&(k=k||d.url,f.lastModified[k]&&v.setRequestHeader("If-Modified-Since",f.lastModified[k]),f.etag[k]&&v.setRequestHeader("If-None-Match",f.etag[k])),v.setRequestHeader("Accept",d.dataTypes[0]&&d.accepts[d.dataTypes[0]]?d.accepts[d.dataTypes[0]]+(d.dataTypes[0]!=="*"?", "+bW+"; q=0.01":""):d.accepts["*"]);for(u in d.headers)v.setRequestHeader(u,d.headers[u]);if(d.beforeSend&&(d.beforeSend.call(e,v,d)===!1||s===2)){v.abort();return!1}for(u in{success:1,error:1,complete:1})v[u](d[u]);p=bZ(bT,d,c,v);if(!p)w(-1,"No Transport");else{v.readyState=1,t&&g.trigger("ajaxSend",[v,d]),d.async&&d.timeout>0&&(q=setTimeout(function(){v.abort("timeout")},d.timeout));try{s=1,p.send(l,w)}catch(z){if(s<2)w(-1,z);else throw z}}return v},param:function(a,c){var d=[],e=function(a,b){b=f.isFunction(b)?b():b,d[d.length]=encodeURIComponent(a)+"="+encodeURIComponent(b)};c===b&&(c=f.ajaxSettings.traditional);if(f.isArray(a)||a.jquery&&!f.isPlainObject(a))f.each(a,function(){e(this.name,this.value)});else for(var g in a)b_(g,a[g],c,e);return d.join("&").replace(bC,"+")}}),f.extend({active:0,lastModified:{},etag:{}});var cc=f.now(),cd=/(\=)\?(&|$)|\?\?/i;f.ajaxSetup({jsonp:"callback",jsonpCallback:function(){return f.expando+"_"+cc++}}),f.ajaxPrefilter("json jsonp",function(b,c,d){var e=typeof b.data=="string"&&/^application\/x\-www\-form\-urlencoded/.test(b.contentType);if(b.dataTypes[0]==="jsonp"||b.jsonp!==!1&&(cd.test(b.url)||e&&cd.test(b.data))){var g,h=b.jsonpCallback=f.isFunction(b.jsonpCallback)?b.jsonpCallback():b.jsonpCallback,i=a[h],j=b.url,k=b.data,l="$1"+h+"$2";b.jsonp!==!1&&(j=j.replace(cd,l),b.url===j&&(e&&(k=k.replace(cd,l)),b.data===k&&(j+=(/\?/.test(j)?"&":"?")+b.jsonp+"="+h))),b.url=j,b.data=k,a[h]=function(a){g=[a]},d.always(function(){a[h]=i,g&&f.isFunction(i)&&a[h](g[0])}),b.converters["script json"]=function(){g||f.error(h+" was not called");return g[0]},b.dataTypes[0]="json";return"script"}}),f.ajaxSetup({accepts:{script:"text/javascript, application/javascript, application/ecmascript, application/x-ecmascript"},contents:{script:/javascript|ecmascript/},converters:{"text script":function(a){f.globalEval(a);return a}}}),f.ajaxPrefilter("script",function(a){a.cache===b&&(a.cache=!1),a.crossDomain&&(a.type="GET",a.global=!1)}),f.ajaxTransport("script",function(a){if(a.crossDomain){var d,e=c.head||c.getElementsByTagName("head")[0]||c.documentElement;return{send:function(f,g){d=c.createElement("script"),d.async="async",a.scriptCharset&&(d.charset=a.scriptCharset),d.src=a.url,d.onload=d.onreadystatechange=function(a,c){if(c||!d.readyState||/loaded|complete/.test(d.readyState))d.onload=d.onreadystatechange=null,e&&d.parentNode&&e.removeChild(d),d=b,c||g(200,"success")},e.insertBefore(d,e.firstChild)},abort:function(){d&&d.onload(0,1)}}}});var ce=a.ActiveXObject?function(){for(var a in cg)cg[a](0,1)}:!1,cf=0,cg;f.ajaxSettings.xhr=a.ActiveXObject?function(){return!this.isLocal&&ch()||ci()}:ch,function(a){f.extend(f.support,{ajax:!!a,cors:!!a&&"withCredentials"in a})}(f.ajaxSettings.xhr()),f.support.ajax&&f.ajaxTransport(function(c){if(!c.crossDomain||f.support.cors){var d;return{send:function(e,g){var h=c.xhr(),i,j;c.username?h.open(c.type,c.url,c.async,c.username,c.password):h.open(c.type,c.url,c.async);if(c.xhrFields)for(j in c.xhrFields)h[j]=c.xhrFields[j];c.mimeType&&h.overrideMimeType&&h.overrideMimeType(c.mimeType),!c.crossDomain&&!e["X-Requested-With"]&&(e["X-Requested-With"]="XMLHttpRequest");try{for(j in e)h.setRequestHeader(j,e[j])}catch(k){}h.send(c.hasContent&&c.data||null),d=function(a,e){var j,k,l,m,n;try{if(d&&(e||h.readyState===4)){d=b,i&&(h.onreadystatechange=f.noop,ce&&delete cg[i]);if(e)h.readyState!==4&&h.abort();else{j=h.status,l=h.getAllResponseHeaders(),m={},n=h.responseXML,n&&n.documentElement&&(m.xml=n);try{m.text=h.responseText}catch(a){}try{k=h.statusText}catch(o){k=""}!j&&c.isLocal&&!c.crossDomain?j=m.text?200:404:j===1223&&(j=204)}}}catch(p){e||g(-1,p)}m&&g(j,k,m,l)},!c.async||h.readyState===4?d():(i=++cf,ce&&(cg||(cg={},f(a).unload(ce)),cg[i]=d),h.onreadystatechange=d)},abort:function(){d&&d(0,1)}}}});var cj={},ck,cl,cm=/^(?:toggle|show|hide)$/,cn=/^([+\-]=)?([\d+.\-]+)([a-z%]*)$/i,co,cp=[["height","marginTop","marginBottom","paddingTop","paddingBottom"],["width","marginLeft","marginRight","paddingLeft","paddingRight"],["opacity"]],cq;f.fn.extend({show:function(a,b,c){var d,e;if(a||a===0)return this.animate(ct("show",3),a,b,c);for(var g=0,h=this.length;g=i.duration+this.startTime){this.now=this.end,this.pos=this.state=1,this.update(),i.animatedProperties[this.prop]=!0;for(b in i.animatedProperties)i.animatedProperties[b]!==!0&&(g=!1);if(g){i.overflow!=null&&!f.support.shrinkWrapBlocks&&f.each(["","X","Y"],function(a,b){h.style["overflow"+b]=i.overflow[a]}),i.hide&&f(h).hide();if(i.hide||i.show)for(b in i.animatedProperties)f.style(h,b,i.orig[b]),f.removeData(h,"fxshow"+b,!0),f.removeData(h,"toggle"+b,!0);d=i.complete,d&&(i.complete=!1,d.call(h))}return!1}i.duration==Infinity?this.now=e:(c=e-this.startTime,this.state=c/i.duration,this.pos=f.easing[i.animatedProperties[this.prop]](this.state,c,0,1,i.duration),this.now=this.start+(this.end-this.start)*this.pos),this.update();return!0}},f.extend(f.fx,{tick:function(){var a,b=f.timers,c=0;for(;c-1,k={},l={},m,n;j?(l=e.position(),m=l.top,n=l.left):(m=parseFloat(h)||0,n=parseFloat(i)||0),f.isFunction(b)&&(b=b.call(a,c,g)),b.top!=null&&(k.top=b.top-g.top+m),b.left!=null&&(k.left=b.left-g.left+n),"using"in b?b.using.call(a,k):e.css(k)}},f.fn.extend({position:function(){if(!this[0])return null;var a=this[0],b=this.offsetParent(),c=this.offset(),d=cx.test(b[0].nodeName)?{top:0,left:0}:b.offset();c.top-=parseFloat(f.css(a,"marginTop"))||0,c.left-=parseFloat(f.css(a,"marginLeft"))||0,d.top+=parseFloat(f.css(b[0],"borderTopWidth"))||0,d.left+=parseFloat(f.css(b[0],"borderLeftWidth"))||0;return{top:c.top-d.top,left:c.left-d.left}},offsetParent:function(){return this.map(function(){var a=this.offsetParent||c.body;while(a&&!cx.test(a.nodeName)&&f.css(a,"position")==="static")a=a.offsetParent;return a})}}),f.each({scrollLeft:"pageXOffset",scrollTop:"pageYOffset"},function(a,c){var d=/Y/.test(c);f.fn[a]=function(e){return f.access(this,function(a,e,g){var h=cy(a);if(g===b)return h?c in h?h[c]:f.support.boxModel&&h.document.documentElement[e]||h.document.body[e]:a[e];h?h.scrollTo(d?f(h).scrollLeft():g,d?g:f(h).scrollTop()):a[e]=g},a,e,arguments.length,null)}}),f.each({Height:"height",Width:"width"},function(a,c){var d="client"+a,e="scroll"+a,g="offset"+a;f.fn["inner"+a]=function(){var a=this[0];return a?a.style?parseFloat(f.css(a,c,"padding")):this[c]():null},f.fn["outer"+a]=function(a){var b=this[0];return b?b.style?parseFloat(f.css(b,c,a?"margin":"border")):this[c]():null},f.fn[c]=function(a){return f.access(this,function(a,c,h){var i,j,k,l;if(f.isWindow(a)){i=a.document,j=i.documentElement[d];return f.support.boxModel&&j||i.body&&i.body[d]||j}if(a.nodeType===9){i=a.documentElement;if(i[d]>=i[e])return i[d];return Math.max(a.body[e],i[e],a.body[g],i[g])}if(h===b){k=f.css(a,c),l=parseFloat(k);return f.isNumeric(l)?l:k}f(a).css(c,h)},c,a,arguments.length,null)}}),a.jQuery=a.$=f,typeof define=="function"&&define.amd&&define.amd.jQuery&&define("jquery",[],function(){return f})})(window);hoogle-4.2.23/datadir/resources/jquery-cookie.js0000644000000000000000000001022612222103576020014 0ustar0000000000000000/** * Cookie plugin * * Copyright (c) 2006 Klaus Hartl (stilbuero.de) * Dual licensed under the MIT and GPL licenses: * http://www.opensource.org/licenses/mit-license.php * http://www.gnu.org/licenses/gpl.html * */ /** * Create a cookie with the given name and value and other optional parameters. * * @example $.cookie('the_cookie', 'the_value'); * @desc Set the value of a cookie. * @example $.cookie('the_cookie', 'the_value', { expires: 7, path: '/', domain: 'jquery.com', secure: true }); * @desc Create a cookie with all available options. * @example $.cookie('the_cookie', 'the_value'); * @desc Create a session cookie. * @example $.cookie('the_cookie', null); * @desc Delete a cookie by passing null as value. Keep in mind that you have to use the same path and domain * used when the cookie was set. * * @param String name The name of the cookie. * @param String value The value of the cookie. * @param Object options An object literal containing key/value pairs to provide optional cookie attributes. * @option Number|Date expires Either an integer specifying the expiration date from now on in days or a Date object. * If a negative value is specified (e.g. a date in the past), the cookie will be deleted. * If set to null or omitted, the cookie will be a session cookie and will not be retained * when the the browser exits. * @option String path The value of the path atribute of the cookie (default: path of page that created the cookie). * @option String domain The value of the domain attribute of the cookie (default: domain of page that created the cookie). * @option Boolean secure If true, the secure attribute of the cookie will be set and the cookie transmission will * require a secure protocol (like HTTPS). * @type undefined * * @name $.cookie * @cat Plugins/Cookie * @author Klaus Hartl/klaus.hartl@stilbuero.de */ /** * Get the value of a cookie with the given name. * * @example $.cookie('the_cookie'); * @desc Get the value of a cookie. * * @param String name The name of the cookie. * @return The value of the cookie. * @type String * * @name $.cookie * @cat Plugins/Cookie * @author Klaus Hartl/klaus.hartl@stilbuero.de */ jQuery.cookie = function(name, value, options) { if (typeof value != 'undefined') { // name and value given, set cookie options = options || {}; if (value === null) { value = ''; options.expires = -1; } var expires = ''; if (options.expires && (typeof options.expires == 'number' || options.expires.toUTCString)) { var date; if (typeof options.expires == 'number') { date = new Date(); date.setTime(date.getTime() + (options.expires * 24 * 60 * 60 * 1000)); } else { date = options.expires; } expires = '; expires=' + date.toUTCString(); // use expires attribute, max-age is not supported by IE } // CAUTION: Needed to parenthesize options.path and options.domain // in the following expressions, otherwise they evaluate to undefined // in the packed version for some reason... var path = options.path ? '; path=' + (options.path) : ''; var domain = options.domain ? '; domain=' + (options.domain) : ''; var secure = options.secure ? '; secure' : ''; document.cookie = [name, '=', encodeURIComponent(value), expires, path, domain, secure].join(''); } else { // only name given, get cookie var cookieValue = null; if (document.cookie && document.cookie != '') { var cookies = document.cookie.split(';'); for (var i = 0; i < cookies.length; i++) { var cookie = jQuery.trim(cookies[i]); // Does this cookie string begin with the name we want? if (cookie.substring(0, name.length + 1) == (name + '=')) { cookieValue = decodeURIComponent(cookie.substring(name.length + 1)); break; } } } return cookieValue; } };hoogle-4.2.23/datadir/resources/hoogle.png0000644000000000000000000000600712222103576016655 0ustar0000000000000000PNG  IHDR:P_gAMA a IDATx P^WC]j]>.c\RѺתVUkժuq YJBBV,B d!;$ l$$AB<;o#|{ Cw޻s9d̀n#K 6ni 6niZ{hׯ]q]c1c3qnX0uSizfkv|hNߟYo5-3as>8Ϲ76g 301'3X~`[\ӹWb]<~sHّ) _^: ƿxV_y܋ƵWG~f0R{:{\?r>t1j ǝ=`DYe+2rcO/FGC]ueyw|!';B %TUK|G57QIH= 7eje,:wwTV1jg* et׮\Dg|=C ;خcbTWF2 lEarTM1=>pn jY.LurI1Q:[:O;ٺy'ahu$ML{Lݙms̥?{@[g T}}iHPg?-LuSUĨfd60X {a..ػc$/s*W^3IgkoD1ԨA& @^x5=ΰdڶm9OxgH/9R>o,`h/D-L$s?2WpO@ԎnsݣvZ ܂O/bb\72K;FݽJUjZd/w\Y&DGlV\M0ﭐov1*ǹ[=hsVrë66U ꥫ~Jjv:ljU2 !o ݊'W8QQz55l4\&uK,E{=~R\B ϕ VVOEGx7N3Mz+箈e\QwM!`W-|Eβ)qf^D=R_TG QQO/phj5|4m\|87 ?d .0d JQ"?@DOS1(oY$JBp g,:}j Ln5 Fdzԏ~i:߬tnnZ]"; Z b+@[;g Ct= 2'FEV }wO㐑A"o]0+',X>j.}G.(GR%9-xS& s` NCpPݽ@޲居*.'ZK1[k`»@idRLIPUb! 2dN2yl?wў*$e%r F8a!D{H1(Ƶ;i飯Uk[.S򁵿~U/'a+" Ϭ'HQ@Pmiz5Cc3XCՇ̩LnR퐛#}KPw̴Ɛ@ s39nzԲ!6c:V_Ӄ-{v/D^ABK Hy;Q8 5vhF6m [ }{OrvȀ,֎e8.M{Ȱw P*+tCjtj{ BHËr^%SR! gΙf51*&Aݱ{b8^ 27c`lwpHA8voX˻IY<1I@$Q°1KPh^@\(''x0MW_X:Ȋy0a>N!ЛH9#@[gc688W$HfjתlAhPӴp/T UgoHX8yr lMf<[NV>sPo li8(j|[Nm&Q* osSٶo[MzuhGJS Մ65K ߴo3V?>0 1rwbX8mDրr`2)Bع⡂!wyCKvli_ <8];&uMX7m`ݴua3bIENDB`hoogle-4.2.23/datadir/resources/hoogle.js0000644000000000000000000002737012222103576016513 0ustar0000000000000000 var embed = false; // are we running as an embedded search box var instant = false; // should we search on key presses var query = parseQuery(); // what is the current query string var $hoogle; // $("#hoogle") after load ///////////////////////////////////////////////////////////////////// // SEARCHING $(function(){ $hoogle = $("#hoogle"); embed = !$hoogle.hasClass("HOOGLE_REAL"); var self = embed ? newEmbed() : newReal(); var $form = $hoogle.parents("form:first"); var ajaxUrl = !embed ? "?" : $form.attr("action") + "?"; var ajaxMode = embed ? 'embed' : 'ajax'; var ajaxPrefix = $form.find("input[name=prefix]").attr("value"); var ajaxSuffix = $form.find("input[name=suffix]").attr("value"); var active = $hoogle.val(); // What is currently being searched for (may not yet be displayed) var past = cache(100); // Cache of previous searches var watch = watchdog(500, function(){self.showWaiting();}); // Timeout of the "Waiting..." callback $hoogle.keyup(function(){ if (!instant) return; var now = $hoogle.val(); if (now == active) return; active = now; var title = now + (now == "" ? "" : " - ") + "Hoogle"; query["hoogle"] = now; if (!embed){ if (window.history) window.history.replaceState(null, title, renderQuery(query)); $("title").text(title); } var old = past.ask(now); if (old != undefined){self.showResult(old); return;} watch.stop(); if (embed && now == ""){self.hide(); return;} watch.start(); var data = {hoogle:now, mode:ajaxMode, prefix:ajaxPrefix, suffix:ajaxSuffix}; function complete(e) { watch.stop(); if (e.status == 200) { past.add(now,e.responseText); if ($hoogle.val() == now) self.showResult(e.responseText); } else self.showError(e.status, e.responseText); } var args = {url:ajaxUrl, data:data, complete:complete, dataType:"html"} try { $.ajax(args); } catch (err) { try { if (!embed) throw err; $.ajaxCrossDomain(args); } catch (err) { // Probably a permissions error from cross domain scripting... watch.stop(); } } }); }) function newReal() { $hoogle.focus(); $hoogle.select(); var $body = $("#body"); return { showWaiting: function(){$("h1").text("Still working...");}, showError: function(status,text){$body.html("

    Error: status " + status + "

    " + text + "

    ")}, showResult: function(text){$body.html(text); newDocs();} } } function newEmbed() { $hoogle.attr("autocomplete","off"); // IE note: unless the div in the iframe contain any border it doesn't calculate the correct outerHeight() // therefore we put 3 borders on the iframe, and leave one for the bottom div var $iframe = $("