diff --git a/datadir/resources/hoogle.css b/datadir/resources/hoogle.css --- a/datadir/resources/hoogle.css +++ b/datadir/resources/hoogle.css @@ -2,11 +2,17 @@ * GENERAL ELEMENTS */ +html { + height: 100%; +} + body { margin: 0px; padding: 0px; font-family: sans-serif; font-size: 13px; + position: relative; + min-height: 100%; } a img { @@ -19,16 +25,56 @@ background-color: #ffb; } +a { + color: #C4451D; + text-decoration: none; +} + +.push { + height: 4em; +} + /******************************************************************** * TOP - LINKS AND SEARCH */ #links { - float: right; - margin-right: 10px; - margin-top: 5px; + position: relative; + background: none repeat scroll 0 0 #293845; + border-top: 5px solid #4E6272; + color: #DDDDDD; + text-align: right; + padding: 0.2em; } +#top-menu { + display: inline-table; + list-style: none outside none; + margin: 0 0 0 1em; + text-align: left; +} + +#top-menu li { + border-left: 1px solid #D5D5D5; + display: inline; + padding: 0; + white-space: nowrap; +} + +#top-menu li a, +#top-menu li a:link, +#top-menu li a:visited { + font-size: 85%; + color: white; + text-decoration: none; + padding: 0.2em 0.5em; +} + +#top-menu li a:hover { + background-color: #4e6272; + text-decoration: underline; +} + form { margin-bottom: 0px; } @@ -64,7 +110,6 @@ width: 140px; margin: 0px; padding: 0px; - margin-top: 7px; margin-left: 10px; } @@ -76,7 +121,7 @@ } #left a { - color: #0E7700; + color: #C4451D; text-decoration: none; background-repeat: no-repeat; } @@ -85,6 +130,7 @@ padding-right: 16px; background-image: url(more_small.png); background-position: center right; + color: #0E774A; } #left .pad { @@ -104,6 +150,13 @@ */ #footer { + background: none repeat scroll 0 0 #DDDDDD; + border-top: 1px solid #AAAAAA; + color: #666666; + width: 100%; + padding: 1.3em 0; + position: absolute; + bottom: 0; text-align: center; } @@ -116,10 +169,6 @@ padding: 5px; margin-top: 0px; font-weight: normal; - /* background for the heading must be gray, - to make type searching visisble */ - background-color: #e4e4e4; - border-top: 1px solid #999; padding-left: 170px; font-size: 16px; } @@ -148,7 +197,8 @@ padding: 3px; width: 400px; border: 2px solid #cc0; - background-color: #ffc; + background-color: #F5F5F5; + border: 1px solid #E5E5E5; text-align: left; } @@ -166,8 +216,11 @@ margin-right: 20px; } +.from, .doc { + margin-top: 0.4em; +} + a.dull, a.dull:hover { - background-color: white; text-decoration: none; } @@ -179,12 +232,22 @@ } .ans { + background: none repeat scroll 0 0 #F0F0F0; + border-top: 1px solid #CCCCCC; font-size: 16px; - margin-top: 15px; + padding: 0.2em 0.5em; } +.from + .ans { + margin-top: 1.5em; +} + +.doc + .ans { + margin-top: 1.5em; +} + .ans .a { - color: #2200C1; + color: #C4451D; } .ans a.dull { diff --git a/datadir/resources/template.html b/datadir/resources/template.html --- a/datadir/resources/template.html +++ b/datadir/resources/template.html @@ -15,11 +15,14 @@ \n
\n" _footer version = "" - ++ "
\n

© Neil Mitchell 2004-2012, version " + ++ "

\n \n
© Neil Mitchell 2004-2013, version " ++ escapeHTML version - ++ "

\n \n\n" + ++ "
\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" diff --git a/src/Web/Response.hs b/src/Web/Response.hs --- a/src/Web/Response.hs +++ b/src/Web/Response.hs @@ -10,6 +10,8 @@ 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 @@ -47,7 +49,7 @@ 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 $ response "application/json" [] $ "{\"version\":" ++ show version ++ "," ++ runJson 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 @@ -88,19 +90,28 @@ f x = x -runJson :: Database -> CmdLine -> String -runJson dbs Search{queryParsed = Left err} = "\"parseError\": " ++ show err -runJson dbs cq@Search{queryParsed = Right q} - | q == mempty = "\"results\": []" - | otherwise = "\"results\": [" ++ intercalate "," now ++ "]" - where - 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 +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 - f Result{..} = "{\"location\":" ++ show (head $ map fst locations ++ [""]) ++ - ",\"self\":" ++ show (showTagText self) ++ - ",\"docs\":" ++ show (showTagText docs) ++ "}" + 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 diff --git a/src/Web/Template.hs b/src/Web/Template.hs --- a/src/Web/Template.hs +++ b/src/Web/Template.hs @@ -83,7 +83,8 @@ generate :: String -> [Template] -> String generate name xs = unlines $ - ["module " ++ name ++ "(Templates(..), defaultTemplates, loadTemplates) where" + ["-- AUTO GENERATED - do not modify" + ,"module " ++ name ++ "(Templates(..), defaultTemplates, loadTemplates) where" ,"import Web.Template" ,"" ,"data Templates = Templates"] ++ diff --git a/test/HoogleSpec.hs b/test/HoogleSpec.hs new file mode 100644 --- /dev/null +++ b/test/HoogleSpec.hs @@ -0,0 +1,63 @@ +{-# 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