Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
G
gargantext-ihaskell
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
gargantext-ihaskell
Commits
9c0883ff
Commit
9c0883ff
authored
Jan 08, 2014
by
Andrew Gibiansky
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Removing setuptools. Hoogle is much prettier now.
parent
a097310e
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
134 additions
and
43 deletions
+134
-43
custom.css
profile/static/custom/custom.css
+11
-2
custom.js
profile/static/custom/custom.js
+1
-1
Evaluate.hs
src/IHaskell/Eval/Evaluate.hs
+19
-14
Hoogle.hs
src/IHaskell/Eval/Hoogle.hs
+98
-24
IPython.hs
src/IHaskell/IPython.hs
+5
-2
No files found.
profile/static/custom/custom.css
View file @
9c0883ff
...
...
@@ -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
{
...
...
profile/static/custom/custom.js
View file @
9c0883ff
...
...
@@ -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
)
));
};
});
...
...
src/IHaskell/Eval/Evaluate.hs
View file @
9c0883ff
...
...
@@ -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
...
...
src/IHaskell/Eval/Hoogle.hs
View file @
9c0883ff
...
...
@@ -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"
"∀"
.
replace
"=>"
"⇒"
.
replace
"->"
"→"
.
replace
"::"
"∷"
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>"
src/IHaskell/IPython.hs
View file @
9c0883ff
...
...
@@ -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
()
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment