{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, FlexibleInstances #-}
module IHaskell.Display (
IHaskellDisplay(..),
Display(..),
DisplayData(..),
IHaskellWidget(..),
printDisplay,
plain,
html,
html',
bmp,
png,
jpg,
gif,
svg,
latex,
markdown,
javascript,
json,
vega,
vegalite,
vdom,
widgetdisplay,
custom,
many,
Width,
Height,
Base64,
encode64,
base64,
displayFromChanEncoded,
serializeDisplay,
Widget(..),
) where
import IHaskellPrelude
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as CBS
import qualified Data.ByteString.Lazy as LBS
import Data.Binary as Binary
import qualified Data.ByteString.Base64 as Base64
import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TChan
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.Text.Encoding as E
import IHaskell.Eval.Util (unfoldM)
import IHaskell.Types
import StringUtils (rstrip)
type Base64 = Text
many :: [Display] -> Display
many :: [Display] -> Display
many = [Display] -> Display
ManyDisplay
plain :: String -> DisplayData
plain :: String -> DisplayData
plain = MimeType -> Text -> DisplayData
DisplayData MimeType
PlainText forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
rstrip
html :: String -> DisplayData
html :: String -> DisplayData
html = Maybe Text -> String -> DisplayData
html' forall a. Maybe a
Nothing
html' :: Maybe Text -> String -> DisplayData
html' :: Maybe Text -> String -> DisplayData
html' Maybe Text
maybeStyles String
s = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeHtml forall a b. (a -> b) -> a -> b
$ case Maybe Text
maybeStyles of
Just Text
css -> forall a. Monoid a => [a] -> a
mconcat [Text
"<style>", Text
css, Text
"</style>", String -> Text
T.pack String
s]
Maybe Text
Nothing -> String -> Text
T.pack String
s
svg :: T.Text -> DisplayData
svg :: Text -> DisplayData
svg = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeSvg
latex :: String -> DisplayData
latex :: String -> DisplayData
latex = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeLatex forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
javascript :: String -> DisplayData
javascript :: String -> DisplayData
javascript = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeJavascript forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
json :: String -> DisplayData
json :: String -> DisplayData
json = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeJson forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
vega :: String -> DisplayData
vega :: String -> DisplayData
vega = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeVega forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
vegalite :: String -> DisplayData
vegalite :: String -> DisplayData
vegalite = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeVegalite forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
vdom :: String -> DisplayData
vdom :: String -> DisplayData
vdom = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeVdom forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
custom :: T.Text -> String -> DisplayData
custom :: Text -> String -> DisplayData
custom Text
mimetype = MimeType -> Text -> DisplayData
DisplayData (Text -> MimeType
MimeCustom Text
mimetype) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
markdown :: String -> DisplayData
markdown :: String -> DisplayData
markdown = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeMarkdown forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
gif :: Width -> Height -> Base64 -> DisplayData
gif :: Width -> Width -> Text -> DisplayData
gif Width
width Width
height = MimeType -> Text -> DisplayData
DisplayData (Width -> Width -> MimeType
MimeGif Width
width Width
height)
bmp :: Width -> Height -> Base64 -> DisplayData
bmp :: Width -> Width -> Text -> DisplayData
bmp Width
width Width
height = MimeType -> Text -> DisplayData
DisplayData (Width -> Width -> MimeType
MimeBmp Width
width Width
height)
png :: Width -> Height -> Base64 -> DisplayData
png :: Width -> Width -> Text -> DisplayData
png Width
width Width
height = MimeType -> Text -> DisplayData
DisplayData (Width -> Width -> MimeType
MimePng Width
width Width
height)
jpg :: Width -> Height -> Base64 -> DisplayData
jpg :: Width -> Width -> Text -> DisplayData
jpg Width
width Width
height = MimeType -> Text -> DisplayData
DisplayData (Width -> Width -> MimeType
MimeJpg Width
width Width
height)
widgetdisplay :: String -> DisplayData
widgetdisplay :: String -> DisplayData
widgetdisplay = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeWidget forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> Text
T.pack
encode64 :: String -> Base64
encode64 :: String -> Text
encode64 String
str = ByteString -> Text
base64 forall a b. (a -> b) -> a -> b
$ String -> ByteString
CBS.pack String
str
base64 :: ByteString -> Base64
base64 :: ByteString -> Text
base64 = ByteString -> Text
E.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode
serializeDisplay :: Display -> LBS.ByteString
serializeDisplay :: Display -> ByteString
serializeDisplay = forall a. Binary a => a -> ByteString
Binary.encode
{-# NOINLINE displayChan #-}
displayChan :: TChan Display
displayChan :: TChan Display
displayChan = forall a. IO a -> a
unsafePerformIO forall a. IO (TChan a)
newTChanIO
displayFromChanEncoded :: IO LBS.ByteString
displayFromChanEncoded :: IO ByteString
displayFromChanEncoded =
forall a. Binary a => a -> ByteString
Binary.encode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Display] -> Display
many forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IO (Maybe a) -> IO [a]
unfoldM (forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TChan a -> STM (Maybe a)
tryReadTChan TChan Display
displayChan)
printDisplay :: IHaskellDisplay a => a -> IO ()
printDisplay :: forall a. IHaskellDisplay a => a -> IO ()
printDisplay a
disp = forall a. IHaskellDisplay a => a -> IO Display
display a
disp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TChan a -> a -> STM ()
writeTChan TChan Display
displayChan