Rebasing.

This commit is contained in:
Gregory W. Schwartz 2019-03-04 12:37:33 -05:00
parent 5a7077254b
commit 66afc48636
2 changed files with 34 additions and 5 deletions

View File

@ -82,6 +82,7 @@ library
strict >=0.3,
system-argv0 -any,
text >=0.11,
time >= 1.8,
transformers -any,
unix >= 2.6,
unordered-containers -any,

View File

@ -6,7 +6,11 @@ module IHaskell.Publish
import IHaskellPrelude
import qualified Data.Text as T
<<<<<<< HEAD
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.Types
@ -34,15 +38,18 @@ publishResult send replyHeader displayed updateNeeded poutput upager result = do
FinalResult{} -> True
outs = evaluationOutputs result
-- Get time to send to output for unique labels.
uniqueLabel <- getUniqueLabel
-- If necessary, clear all previous output and redraw.
clear <- readMVar updateNeeded
when clear $ do
clearOutput
disps <- readMVar displayed
mapM_ sendOutput $ reverse disps
mapM_ (sendOutput uniqueLabel) $ reverse disps
-- 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
-- clear it later by marking update needed as true.
@ -57,16 +64,18 @@ publishResult send replyHeader displayed updateNeeded poutput upager result = do
unless (null pager) $
if upager
then modifyMVar_ poutput (return . (++ pager))
else sendOutput $ Display pager
else sendOutput uniqueLabel $ Display pager
where
clearOutput = do
hdr <- dupHeader replyHeader ClearOutputMessage
send $ ClearOutput hdr True
sendOutput (ManyDisplay manyOuts) = mapM_ sendOutput manyOuts
sendOutput (Display outs) = do
sendOutput uniqueLabel (ManyDisplay manyOuts) =
mapM_ (sendOutput uniqueLabel) manyOuts
sendOutput uniqueLabel (Display outs) = do
hdr <- dupHeader replyHeader DisplayDataMessage
<<<<<<< HEAD
send $ PublishDisplayData hdr (map (convertSvgToHtml . prependCss) outs) Nothing
convertSvgToHtml (DisplayData MimeSvg s) = html $ makeSvgImg $ base64 $ E.encodeUtf8 s
@ -76,7 +85,26 @@ publishResult send replyHeader displayed updateNeeded poutput upager result = do
makeSvgImg base64data = T.unpack $ "<img src=\"data:image/svg+xml;base64," <>
base64data <>
"\"/>"
=======
send $ PublishDisplayData hdr (map (makeUnique uniqueLabel . prependCss) outs) Nothing
>>>>>>> Make unique labels using a timestamp for svg elements.
prependCss (DisplayData MimeHtml h) =
DisplayData MimeHtml $ mconcat ["<style>", T.pack ihaskellCSS, "</style>", h]
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