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
66afc486
Commit
66afc486
authored
Mar 04, 2019
by
Gregory W. Schwartz
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Rebasing.
parent
5a707725
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
34 additions
and
5 deletions
+34
-5
ihaskell.cabal
ihaskell.cabal
+1
-0
Publish.hs
src/IHaskell/Publish.hs
+33
-5
No files found.
ihaskell.cabal
View file @
66afc486
...
@@ -82,6 +82,7 @@ library
...
@@ -82,6 +82,7 @@ library
strict >=0.3,
strict >=0.3,
system-argv0 -any,
system-argv0 -any,
text >=0.11,
text >=0.11,
time >= 1.8,
transformers -any,
transformers -any,
unix >= 2.6,
unix >= 2.6,
unordered-containers -any,
unordered-containers -any,
...
...
src/IHaskell/Publish.hs
View file @
66afc486
...
@@ -6,7 +6,11 @@ module IHaskell.Publish
...
@@ -6,7 +6,11 @@ module IHaskell.Publish
import
IHaskellPrelude
import
IHaskellPrelude
import
qualified
Data.Text
as
T
import
qualified
Data.Text
as
T
<<<<<<<
HEAD
import
qualified
Data.Text.Encoding
as
E
import
qualified
Data.Text.Encoding
as
E
=======
import
qualified
Data.Time.Clock.System
as
Time
>>>>>>>
Make
unique
labels
using
a
timestamp
for
svg
elements
.
import
IHaskell.Display
import
IHaskell.Display
import
IHaskell.Types
import
IHaskell.Types
...
@@ -34,15 +38,18 @@ publishResult send replyHeader displayed updateNeeded poutput upager result = do
...
@@ -34,15 +38,18 @@ publishResult send replyHeader displayed updateNeeded poutput upager result = do
FinalResult
{}
->
True
FinalResult
{}
->
True
outs
=
evaluationOutputs
result
outs
=
evaluationOutputs
result
-- Get time to send to output for unique labels.
uniqueLabel
<-
getUniqueLabel
-- If necessary, clear all previous output and redraw.
-- If necessary, clear all previous output and redraw.
clear
<-
readMVar
updateNeeded
clear
<-
readMVar
updateNeeded
when
clear
$
do
when
clear
$
do
clearOutput
clearOutput
disps
<-
readMVar
displayed
disps
<-
readMVar
displayed
mapM_
sendOutput
$
reverse
disps
mapM_
(
sendOutput
uniqueLabel
)
$
reverse
disps
-- Draw this message.
-- Draw this message.
sendOutput
outs
sendOutput
uniqueLabel
outs
-- If this is the final message, add it to the list of completed messages. If it isn't, make sure we
-- If this is the final message, add it to the list of completed messages. If it isn't, make sure we
-- clear it later by marking update needed as true.
-- clear it later by marking update needed as true.
...
@@ -57,16 +64,18 @@ publishResult send replyHeader displayed updateNeeded poutput upager result = do
...
@@ -57,16 +64,18 @@ publishResult send replyHeader displayed updateNeeded poutput upager result = do
unless
(
null
pager
)
$
unless
(
null
pager
)
$
if
upager
if
upager
then
modifyMVar_
poutput
(
return
.
(
++
pager
))
then
modifyMVar_
poutput
(
return
.
(
++
pager
))
else
sendOutput
$
Display
pager
else
sendOutput
uniqueLabel
$
Display
pager
where
where
clearOutput
=
do
clearOutput
=
do
hdr
<-
dupHeader
replyHeader
ClearOutputMessage
hdr
<-
dupHeader
replyHeader
ClearOutputMessage
send
$
ClearOutput
hdr
True
send
$
ClearOutput
hdr
True
sendOutput
(
ManyDisplay
manyOuts
)
=
mapM_
sendOutput
manyOuts
sendOutput
uniqueLabel
(
ManyDisplay
manyOuts
)
=
sendOutput
(
Display
outs
)
=
do
mapM_
(
sendOutput
uniqueLabel
)
manyOuts
sendOutput
uniqueLabel
(
Display
outs
)
=
do
hdr
<-
dupHeader
replyHeader
DisplayDataMessage
hdr
<-
dupHeader
replyHeader
DisplayDataMessage
<<<<<<<
HEAD
send
$
PublishDisplayData
hdr
(
map
(
convertSvgToHtml
.
prependCss
)
outs
)
Nothing
send
$
PublishDisplayData
hdr
(
map
(
convertSvgToHtml
.
prependCss
)
outs
)
Nothing
convertSvgToHtml
(
DisplayData
MimeSvg
s
)
=
html
$
makeSvgImg
$
base64
$
E
.
encodeUtf8
s
convertSvgToHtml
(
DisplayData
MimeSvg
s
)
=
html
$
makeSvgImg
$
base64
$
E
.
encodeUtf8
s
...
@@ -76,7 +85,26 @@ publishResult send replyHeader displayed updateNeeded poutput upager result = do
...
@@ -76,7 +85,26 @@ publishResult send replyHeader displayed updateNeeded poutput upager result = do
makeSvgImg
base64data
=
T
.
unpack
$
"<img src=
\"
data:image/svg+xml;base64,"
<>
makeSvgImg
base64data
=
T
.
unpack
$
"<img src=
\"
data:image/svg+xml;base64,"
<>
base64data
<>
base64data
<>
"
\"
/>"
"
\"
/>"
=======
send
$
PublishDisplayData
hdr
(
map
(
makeUnique
uniqueLabel
.
prependCss
)
outs
)
Nothing
>>>>>>>
Make
unique
labels
using
a
timestamp
for
svg
elements
.
prependCss
(
DisplayData
MimeHtml
h
)
=
prependCss
(
DisplayData
MimeHtml
h
)
=
DisplayData
MimeHtml
$
mconcat
[
"<style>"
,
T
.
pack
ihaskellCSS
,
"</style>"
,
h
]
DisplayData
MimeHtml
$
mconcat
[
"<style>"
,
T
.
pack
ihaskellCSS
,
"</style>"
,
h
]
prependCss
x
=
x
prependCss
x
=
x
makeUnique
l
(
DisplayData
MimeSvg
s
)
=
DisplayData
MimeSvg
.
T
.
replace
"glyph"
(
"glyph-"
<>
l
)
.
T
.
replace
"
\"
clip"
(
"
\"
clip-"
<>
l
)
.
T
.
replace
"#clip"
(
"#clip-"
<>
l
)
.
T
.
replace
"
\"
image"
(
"
\"
image-"
<>
l
)
.
T
.
replace
"#image"
(
"#image-"
<>
l
)
.
T
.
replace
"linearGradient id=
\"
linear"
(
"linearGradient id=
\"
linear-"
<>
l
)
.
T
.
replace
"#linear"
(
"#linear-"
<>
l
)
$
s
makeUnique
_
x
=
x
getUniqueLabel
=
fmap
(
\
(
Time
.
MkSystemTime
s
p
)
->
T
.
pack
(
show
s
)
<>
T
.
pack
(
show
p
))
Time
.
getSystemTime
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