{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, FlexibleInstances #-}

-- | If you are interested in the IHaskell library for the purpose of augmenting the IHaskell
-- notebook or writing your own display mechanisms and widgets, this module contains all functions
-- you need.
--
-- In order to create a display mechanism for a particular data type, write a module named (for
-- example) @IHaskell.Display.YourThing@ in a package named @ihaskell-yourThing@. (Note the
-- capitalization - it's important!) Then, in that module, add an instance of @IHaskellDisplay@ for
-- your data type. Similarly, to create a widget, add an instance of @IHaskellWidget@.
--
-- An example of creating a display is provided in the
-- <http://gibiansky.github.io/IHaskell/demo.html demo notebook>.
--
module IHaskell.Display (
    -- * Rich display and interactive display typeclasses and types
    IHaskellDisplay(..),
    Display(..),
    DisplayData(..),
    IHaskellWidget(..),

    -- ** Interactive use functions
    printDisplay,

    -- * Constructors for displays
    plain,
    html,
    html',
    bmp,
    png,
    jpg,
    gif,
    svg,
    latex,
    markdown,
    javascript,
    json,
    vega,
    vegalite,
    vdom,
    widgetdisplay,
    custom,
    many,

    -- ** Image and data encoding functions
    Width,
    Height,
    Base64,
    encode64,
    base64,

    -- * Internal only use
    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

-- | Encode many displays into a single one. All will be output.
many :: [Display] -> Display
many :: [Display] -> Display
many = [Display] -> Display
ManyDisplay

-- | Generate a plain text display.
plain :: String -> DisplayData
plain :: String -> DisplayData
plain = MimeType -> Text -> DisplayData
DisplayData MimeType
PlainText (Text -> DisplayData) -> (String -> Text) -> String -> DisplayData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
rstrip

-- | Generate an HTML display.
html :: String -> DisplayData
html :: String -> DisplayData
html = Maybe Text -> String -> DisplayData
html' Maybe Text
forall a. Maybe a
Nothing

-- | Generate an HTML display with optional styles.
html' :: Maybe Text -> String -> DisplayData
html' :: Maybe Text -> String -> DisplayData
html' Maybe Text
maybeStyles String
s = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeHtml (Text -> DisplayData) -> Text -> DisplayData
forall a b. (a -> b) -> a -> b
$ case Maybe Text
maybeStyles of
  Just Text
css -> [Text] -> Text
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

-- | Generate an SVG display.
svg :: T.Text -> DisplayData
svg :: Text -> DisplayData
svg = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeSvg

-- | Generate a LaTeX display.
latex :: String -> DisplayData
latex :: String -> DisplayData
latex = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeLatex (Text -> DisplayData) -> (String -> Text) -> String -> DisplayData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Generate a Javascript display.
javascript :: String -> DisplayData
javascript :: String -> DisplayData
javascript = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeJavascript (Text -> DisplayData) -> (String -> Text) -> String -> DisplayData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Generate a Json display.
json :: String -> DisplayData
json :: String -> DisplayData
json = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeJson (Text -> DisplayData) -> (String -> Text) -> String -> DisplayData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Generate a Vega display.
vega :: String -> DisplayData
vega :: String -> DisplayData
vega = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeVega (Text -> DisplayData) -> (String -> Text) -> String -> DisplayData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Generate a Vegalite display.
vegalite :: String -> DisplayData
vegalite :: String -> DisplayData
vegalite = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeVegalite (Text -> DisplayData) -> (String -> Text) -> String -> DisplayData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Generate a Vdom display.
vdom :: String -> DisplayData
vdom :: String -> DisplayData
vdom = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeVdom (Text -> DisplayData) -> (String -> Text) -> String -> DisplayData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Generate a custom display. The first argument is the mimetype and the second argument is the
-- payload.
custom :: T.Text -> String -> DisplayData
custom :: Text -> String -> DisplayData
custom Text
mimetype = MimeType -> Text -> DisplayData
DisplayData (Text -> MimeType
MimeCustom Text
mimetype) (Text -> DisplayData) -> (String -> Text) -> String -> DisplayData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Generate a Markdown display.
markdown :: String -> DisplayData
markdown :: String -> DisplayData
markdown = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeMarkdown (Text -> DisplayData) -> (String -> Text) -> String -> DisplayData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Generate a GIF display of the given width and height. Data must be provided in a Base64 encoded
-- manner, suitable for embedding into HTML. The @base64@ function may be used to encode data into
-- this format.
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)

-- | Generate a BMP display of the given width and height. Data must be provided in a Base64 encoded
-- manner, suitable for embedding into HTML. The @base64@ function may be used to encode data into
-- this format.
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)

-- | Generate a PNG display of the given width and height. Data must be provided in a Base64 encoded
-- manner, suitable for embedding into HTML. The @base64@ function may be used to encode data into
-- this format.
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)

-- | Generate a JPG display of the given width and height. Data must be provided in a Base64 encoded
-- manner, suitable for embedding into HTML. The @base64@ function may be used to encode data into
-- this format.
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)

-- | Generate a Widget display given the uuid and the view version
widgetdisplay :: String -> DisplayData
widgetdisplay :: String -> DisplayData
widgetdisplay = MimeType -> Text -> DisplayData
DisplayData MimeType
MimeWidget (Text -> DisplayData) -> (String -> Text) -> String -> DisplayData
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> Text
T.pack

-- | Convert from a string into base 64 encoded data.
encode64 :: String -> Base64
encode64 :: String -> Text
encode64 String
str = ByteString -> Text
base64 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ String -> ByteString
CBS.pack String
str

-- | Convert from a ByteString into base 64 encoded data.
base64 :: ByteString -> Base64
base64 :: ByteString -> Text
base64 = ByteString -> Text
E.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode

-- | For internal use within IHaskell. Serialize displays to a ByteString.
serializeDisplay :: Display -> LBS.ByteString
serializeDisplay :: Display -> ByteString
serializeDisplay = Display -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode

-- | Items written to this chan will be included in the output sent to the frontend (ultimately the
-- browser), the next time IHaskell has an item to display.
{-# NOINLINE displayChan #-}
displayChan :: TChan Display
displayChan :: TChan Display
displayChan = IO (TChan Display) -> TChan Display
forall a. IO a -> a
unsafePerformIO IO (TChan Display)
forall a. IO (TChan a)
newTChanIO

-- | Take everything that was put into the 'displayChan' at that point out, and make a 'Display' out
-- of it.
displayFromChanEncoded :: IO LBS.ByteString
displayFromChanEncoded :: IO ByteString
displayFromChanEncoded =
  Maybe Display -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode (Maybe Display -> ByteString)
-> ([Display] -> Maybe Display) -> [Display] -> ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> Maybe Display
forall a. a -> Maybe a
Just (Display -> Maybe Display)
-> ([Display] -> Display) -> [Display] -> Maybe Display
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Display] -> Display
many ([Display] -> ByteString) -> IO [Display] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe Display) -> IO [Display]
forall a. IO (Maybe a) -> IO [a]
unfoldM (STM (Maybe Display) -> IO (Maybe Display)
forall a. STM a -> IO a
atomically (STM (Maybe Display) -> IO (Maybe Display))
-> STM (Maybe Display) -> IO (Maybe Display)
forall a b. (a -> b) -> a -> b
$ TChan Display -> STM (Maybe Display)
forall a. TChan a -> STM (Maybe a)
tryReadTChan TChan Display
displayChan)

-- | Write to the display channel. The contents will be displayed in the notebook once the current
-- execution call ends.
printDisplay :: IHaskellDisplay a => a -> IO ()
printDisplay :: forall a. IHaskellDisplay a => a -> IO ()
printDisplay a
disp = a -> IO Display
forall a. IHaskellDisplay a => a -> IO Display
display a
disp IO Display -> (Display -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> (Display -> STM ()) -> Display -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TChan Display -> Display -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan Display
displayChan