mirror of
https://github.com/IHaskell/IHaskell.git
synced 2025-04-16 03:16:20 +00:00
Rebasing.
This commit is contained in:
parent
5a7077254b
commit
66afc48636
@ -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,
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user