Commit 66afc486 authored by Gregory W. Schwartz's avatar Gregory W. Schwartz

Rebasing.

parent 5a707725
...@@ -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,
......
...@@ -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
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