Commit 9c0883ff authored by Andrew Gibiansky's avatar Andrew Gibiansky

Removing setuptools. Hoogle is much prettier now.

parent a097310e
......@@ -5,6 +5,8 @@ Custom IHaskell CSS.
/* Styles used for the Hoogle display in the pager */
.hoogle-doc {
display: block;
padding-bottom: 1.3em;
padding-left: 0.4em;
}
.hoogle-code {
display: block;
......@@ -18,13 +20,20 @@ Custom IHaskell CSS.
color: green;
font-weight: bold;
}
.hoogle-package {
.hoogle-head {
font-weight: bold;
}
.hoogle-package-name {
.hoogle-sub {
display: block;
margin-left: 0.4em;
}
.hoogle-package {
font-weight: bold;
font-style: italic;
}
.hoogle-module {
font-weight: bold;
}
/* Styles used for basic displays */
.get-type {
......
......@@ -52,7 +52,7 @@ $([IPython.events]).on('app_initialized.NotebookApp', function(){
// Prevent the pager from surrounding everything with a <pre>
IPython.Pager.prototype.append_text = function (text) {
this.pager_element.find(".container").append($('<div/>').html(text));
this.pager_element.find(".container").append($('<div/>').html(IPython.utils.autoLinkUrls(text)));
};
});
......
......@@ -610,21 +610,11 @@ evalCommand _ (Directive GetInfo str) state = safely state $ do
evalCommand _ (Directive SearchHoogle query) state = safely state $ do
results <- liftIO $ Hoogle.search query
let output = unlines $ map (Hoogle.render Hoogle.HTML) results
return EvalOut {
evalStatus = Success,
evalResult = [],
evalState = state,
evalPager = output
}
return $ hoogleResults state results
evalCommand _ (Directive GetDoc query) state = safely state $
return EvalOut {
evalStatus = Success,
evalResult = [],
evalState = state,
evalPager = "Hoogle documentation queries not implemented yet."
}
evalCommand _ (Directive GetDoc query) state = safely state $ do
results <- liftIO $ Hoogle.document query
return $ hoogleResults state results
evalCommand output (Statement stmt) state = wrapExecution state $ do
write $ "Statement:\n" ++ stmt
......@@ -813,6 +803,21 @@ evalCommand _ (ParseError loc err) state = do
evalPager = ""
}
hoogleResults :: KernelState -> [Hoogle.HoogleResult] -> EvalOut
hoogleResults state results = EvalOut {
evalStatus = Success,
evalResult = [],
evalState = state,
evalPager = output
}
where
fmt =
case getFrontend state of
IPythonNotebook -> Hoogle.HTML
IPythonConsole -> Hoogle.Plain
output = unlines $ map (Hoogle.render fmt) results
-- Read from a file handle until we hit a delimiter or until we've read
-- as many characters as requested
readChars :: Handle -> String -> Int -> IO String
......
......@@ -3,14 +3,17 @@ module IHaskell.Eval.Hoogle (
search,
document,
render,
OutputFormat(..)
OutputFormat(..),
HoogleResult
) where
import ClassyPrelude
import ClassyPrelude hiding (span, div)
import Text.Printf
import Network.HTTP
import Data.Aeson
import Data.String.Utils
import Data.List (elemIndex, (!!), last)
import Control.Monad (guard)
import qualified Data.ByteString.Lazy.Char8 as Char
......@@ -32,6 +35,7 @@ data HoogleResult
= SearchResult HoogleResponse
| DocResult HoogleResponse
| NoResult String
deriving Show
instance FromJSON [HoogleResponse] where
parseJSON (Object obj) = do
......@@ -73,7 +77,10 @@ search string = do
Right json ->
case eitherDecode $ Char.pack json of
Left err -> [NoResult err]
Right results -> map SearchResult results
Right results ->
case map SearchResult results of
[] -> [NoResult "no matching identifiers found."]
res -> res
-- | Look up an identifier on Hoogle.
-- Return documentation for that identifier. If there are many
......@@ -81,9 +88,17 @@ search string = do
document :: String -> IO [HoogleResult]
document string = do
matchingResults <- filter matches <$> search string
return $ map toDocResult matchingResults
let results = map toDocResult matchingResults
return $ case results of
[] -> [NoResult "no matching identifiers found."]
res -> res
where
matches (SearchResult resp) = startswith "string" $ self resp
matches (SearchResult resp) =
case split " " $ self resp of
name:_ -> strip string == strip name
_ -> False
matches _ = False
toDocResult (SearchResult resp) = DocResult resp
-- | Render a Hoogle search result into an output format.
......@@ -115,38 +130,97 @@ renderHtml (NoResult resp) =
printf "<span class='err-msg'>No result: %s</span>" resp
renderHtml (DocResult resp) =
printf "%s<br/><a href='%s'>...more...</a><br/><div class='hoogle-doc'>%s</div>"
(renderSelf $ self resp)
(location resp)
(renderDocs $ docs resp)
renderSelf (self resp) (location resp)
++
renderDocs (docs resp)
renderHtml (SearchResult resp) =
printf "%s<br/><a href='%s'>...more...</a><br/><div class='hoogle-doc'>%s</div>"
(renderSelf $ self resp)
(location resp)
(renderDocs $ docs resp)
renderHtml (SearchResult resp) =
renderSelf (self resp) (location resp)
++
renderDocs (docs resp)
renderSelf :: String -> String
renderSelf string
renderSelf :: String -> String -> String
renderSelf string loc
| startswith "package" string
= printf "%s <span class='hoogle-package-name'>%s</span>" pkg $ replace "package" "" string
= pkg ++ " " ++ span "hoogle-package" (link loc $ extractPackage string)
| startswith "module" string
= let package = extractPackageName loc in
mod ++ " " ++
span "hoogle-module" (link loc $ extractModule string) ++
packageSub package
| otherwise
= printf "<span class='hoogle-name'>%s</span>" $ strip string
= let [name, args] = split "::" string
package = extractPackageName loc
modname = extractModuleName loc in
span "hoogle-name" (unicodeReplace $
link loc (strip name) ++
" :: " ++
strip args)
++ packageAndModuleSub package modname
where
pkg = "<span class='hoogle-package'>package</span>" :: String
extractPackage = strip . replace "package" ""
extractModule = strip . replace "module" ""
pkg = span "hoogle-head" "package"
mod = span "hoogle-head" "module"
unicodeReplace :: String -> String
unicodeReplace =
replace "forall" "&#x2200;" .
replace "=>" "&#x21D2;" .
replace "->" "&#x2192;" .
replace "::" "&#x2237;"
packageSub Nothing = ""
packageSub (Just package) =
span "hoogle-sub" $
"(" ++ pkg ++ " " ++ span "hoogle-package" package ++ ")"
packageAndModuleSub Nothing _ = ""
packageAndModuleSub (Just package) Nothing = packageSub (Just package)
packageAndModuleSub (Just package) (Just modname) =
span "hoogle-sub" $
"(" ++ pkg ++ " " ++ span "hoogle-package" package ++
", " ++ mod ++ " " ++ span "hoogle-module" modname ++ ")"
renderDocs :: String -> String
renderDocs doc =
let groups = groupBy bothAreCode $ lines doc
nonull = filter (not . null . strip)
bothAreCode s1 s2 =
startswith ">" (strip s1) &&
startswith ">" (strip s2)
isCode (s:_) = startswith ">" $ strip s
makeBlock lines =
if isCode lines
then printf "<div class='hoogle-code'>%s<div>" $ unlines lines
else printf "<div class='hoogle-text'>%s<div>" $ unlines lines
then div "hoogle-code" $ unlines $ nonull lines
else div "hoogle-text" $ unlines $ nonull lines
in
unlines $ map makeBlock groups
div "hoogle-doc" $ unlines $ map makeBlock groups
extractPackageName :: String -> Maybe String
extractPackageName link = do
let pieces = split "/" link
archiveLoc <- elemIndex "archive" pieces
latestLoc <- elemIndex "latest" pieces
guard $ latestLoc - archiveLoc == 2
return $ pieces !! (latestLoc - 1)
extractModuleName :: String -> Maybe String
extractModuleName link = do
let pieces = split "/" link
guard $ not $ null pieces
let html = last pieces
mod = replace "-" "." $ takeWhile (/= '.') html
return mod
div :: String -> String -> String
div = printf "<div class='%s'>%s</div>"
span :: String -> String -> String
span = printf "<span class='%s'>%s</span>"
link :: String -> String -> String
link = printf "<a target='_blank' href='%s'>%s</a>"
......@@ -205,10 +205,13 @@ installPipDependencies = withTmpDir $ \tmpDir ->
mapM_ (installDependency tmpDir)
[
("pyzmq", "14.0.1")
, ("setuptools", "2.0.2") -- This cannot go first in the dependenc list, because its setup.py is broken.
, ("MarkupSafe", "0.18") -- Neither can this
, ("tornado","3.1.1")
, ("jinja2","2.7.1")
-- The following cannot go first in the dependency list, because
-- their setup.py are broken and require the directory to exist
-- already.
, ("MarkupSafe", "0.18")
--, ("setuptools", "2.0.2")
]
where
installDependency :: FilePath -> (Text, Text) -> Sh ()
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment