How to convert ByteString value to JSVal
The GHCJS.DOM.JSFFI.Generated.CanvasRenderingContext2D module has a function putImageData
with the following type:
putImageData :: Control.Monad.IO.Class.MonadIO m => CanvasRenderingContext2D -> Maybe GHCJS.DOM.Types.ImageData -> Float -> Float -> m ()
The second parameter is of type Maybe GHCJS.DOM.Types.ImageData
. This type is defined in the GHCJS.DOM.Types module to wrap a newtype around the JSVal value:
newtype ImageData = ImageData {unImageData :: GHCJS.Prim.JSVal}
I have a type value ByteString
that is always 4 bytes with RGBA values ββfor each pixel. How can I convert a ByteString value to GHCJS.Prim.JSVal?
source to share
As K.A. Boer pointed out that after converting ByteString
to, Uint8ClampedArray
you can pass the clamped array to newImageData
to get the object you want ImageData
.
You can use built-in Javascript function to generate Uint8ClampedArray
. To pass ByteString
through FFI Javascript use Data.ByteString.useAsCStringLen
.
The code below shows how to do this.
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE JavaScriptFFI #-}
{-# LANGUAGE CPP #-}
import Reflex.Dom
import Data.Monoid ((<>))
import Control.Monad.IO.Class (liftIO)
import GHCJS.DOM.ImageData (newImageData)
import GHCJS.DOM.HTMLCanvasElement (getContext)
import GHCJS.DOM.JSFFI.Generated.CanvasRenderingContext2D (putImageData)
import GHCJS.DOM.Types (CanvasRenderingContext2D(..), castToHTMLCanvasElement, Uint8ClampedArray(..))
import Foreign.Ptr (Ptr)
import GHCJS.Types (JSVal)
import GHCJS.Marshal.Pure (pFromJSVal, pToJSVal)
import Data.Map (Map)
import Data.Text as T (Text, pack)
import Data.ByteString as BS (ByteString, pack, useAsCStringLen)
-- Some code and techniques taken from these sites:
-- http://lpaste.net/154691
-- https://www.snip2code.com/Snippet/1032978/Simple-Canvas-Example/
-- import inline Javascript code as Haskell function : jsUint8ClampedArray
foreign import javascript unsafe
-- Arguments
-- pixels : Ptr a -- Pointer to a ByteString
-- len : JSVal -- Number of pixels
"(function(){ return new Uint8ClampedArray($1.u8.slice(0, $2)); })()"
jsUint8ClampedArray :: Ptr a -> JSVal -> IO JSVal
-- takes pointer and length arguments as passed by useAsCStringLen
newUint8ClampedArray :: (Ptr a, Int) -> IO Uint8ClampedArray
newUint8ClampedArray (pixels, len) =
pFromJSVal <$> jsUint8ClampedArray pixels (pToJSVal len)
canvasAttrs :: Int -> Int -> Map T.Text T.Text
canvasAttrs w h = ("width" =: T.pack (show w))
<> ("height" =: T.pack (show h))
main = mainWidget $ do
-- first, generate some test pixels
let boxWidth = 120
boxHeight = 30
boxDataLen = boxWidth*boxHeight*4 -- 4 bytes per pixel
reds = take boxDataLen $ concat $ repeat [0xff,0x00,0x00,0xff]
greens = take boxDataLen $ concat $ repeat [0x00,0xff,0x00,0xff]
blues = take boxDataLen $ concat $ repeat [0x00,0x00,0xff,0xff]
pixels = reds ++ greens ++ blues
image = BS.pack pixels -- create a ByteString with the pixel data.
-- create Uint8ClampedArray representation of pixels
imageArray <- liftIO $ BS.useAsCStringLen image newUint8ClampedArray
let imageWidth = boxWidth
imageHeight = (length pixels `div` 4) `div` imageWidth
-- use Uint8ClampedArray representation of pixels to create ImageData
imageData <- newImageData (Just imageArray) (fromIntegral imageWidth) (fromIntegral imageHeight)
-- demonstrate the imageData is what we expect by displaying it.
(element, _) <- elAttr' "canvas" (canvasAttrs 300 200) $ return ()
let canvasElement = castToHTMLCanvasElement(_element_raw element)
elementContext <- getContext canvasElement ("2d" :: String)
let renderingContext = CanvasRenderingContext2D elementContext
putImageData renderingContext (Just imageData) 80 20
Here's a link to a repository with example code: https://github.com/dc25/stackOverflow__how-to-convert-a-bytestring-value-to-a-jsval
Here's a link to a live demo: https://dc25.github.io/stackOverflow__how-to-convert-a-bytestring-value-to-a-jsval/
source to share
Edit: It looks like my original answer was too GHC-oriented. Added an untested fix that might work for GHCJS.
Edit # 2: Added file stack.yaml
for example.
You can use GHCJS.DOM.ImageData.newImageData
to create an object ImageData
. It requires the data to be GHCJS.DOM.Types.Uint8ClampedArray
(which is an RGBA byte array).
There are functions for converting to GHCJS.Buffer
from ByteString
to Buffer
(through fromByteString
), and from there to typed arrays (for example getUint8Array
). They do the conversion directly under GHCJS, and even under plain GHC they use base64 conversion as an intermediary which should be pretty fast. Unfortunately getUint8ClampedArray
no transform function is included (and for simple GHC it looks like it fromByteString
could be broken anyway - in jsaddle 0.8.3.0, it calls the wrong JavaScript helper function).
For simple GHC, the following works (first line copied from fromByteString
with helper renamed from obviously incorrect h$newByteArrayBase64String
):
uint8ClampedArrayFromByteString :: ByteString -> GHCJSPure (Uint8ClampedArray)
uint8ClampedArrayFromByteString bs = GHCJSPure $ do
buffer <- SomeBuffer <$> jsg1 "h$newByteArrayFromBase64String"
(decodeUtf8 $ B64.encode bs)
arrbuff <- ghcjsPure (getArrayBuffer (buffer :: MutableBuffer))
liftDOM (Uint8ClampedArray <$> new (jsg "Uint8ClampedArray") [pToJSVal arrbuff])
Here is an untested version of GHCJS that might work. If they fix the above jsaddle error, it should work under simple GHC too:
uint8ClampedArrayFromByteString :: ByteString -> GHCJSPure (Uint8ClampedArray)
uint8ClampedArrayFromByteString bs = GHCJSPure $ do
(buffer,_,_) <- ghcjsPure (fromByteString bs)
buffer' <- thaw buffer
arrbuff <- ghcjsPure (getArrayBuffer buffer')
liftDOM (Uint8ClampedArray <$> new (jsg "Uint8ClampedArray") [pToJSVal arrbuff])
I don't have GHCJS installed, but here's a complete working example that I tested with JSaddle + Warp under simple GHC, which seems to work fine (i.e. if you point your browser to localhost: 6868 it displays a 3x4 image on canvas element):
module Main where
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Text.Encoding (decodeUtf8)
import qualified Data.ByteString.Base64 as B64 (encode)
import Language.Javascript.JSaddle (js, js1, jss, jsg, jsg1,
new, pToJSVal, GHCJSPure(..), ghcjsPure, JSM,
fromJSVal, toJSVal, Object)
import Language.Javascript.JSaddle.Warp (run)
import JSDOM.Types (liftDOM, Uint8ClampedArray(..), RenderingContext(..))
import JSDOM.ImageData
import JSDOM.HTMLCanvasElement
import JSDOM.CanvasRenderingContext2D
import GHCJS.Buffer (getArrayBuffer, MutableBuffer)
import GHCJS.Buffer.Types (SomeBuffer(..))
import Control.Lens ((^.))
main :: IO ()
main = run 6868 $ do
let smallImage = BS.pack [0xff,0x00,0x00,0xff, 0xff,0x00,0x00,0xff, 0xff,0x00,0x00,0xff,
0x00,0x00,0x00,0xff, 0x00,0xff,0x00,0xff, 0x00,0x00,0x00,0xff,
0x00,0x00,0xff,0xff, 0x00,0x00,0xff,0xff, 0x00,0x00,0xff,0xff,
0x00,0x00,0xff,0xff, 0x00,0x00,0x00,0xff, 0x00,0x00,0xff,0xff]
img <- makeImageData 3 4 smallImage
doc <- jsg "document"
doc ^. js "body" ^. jss "innerHTML" "<canvas id=c width=10 height=10></canvas>"
Just canvas <- doc ^. js1 "getElementById" "c" >>= fromJSVal
Just ctx <- getContext canvas "2d" ([] :: [Object])
let ctx' = CanvasRenderingContext2D (unRenderingContext ctx)
putImageData ctx' img 3 4
return ()
uint8ClampedArrayFromByteString :: ByteString -> GHCJSPure (Uint8ClampedArray)
uint8ClampedArrayFromByteString bs = GHCJSPure $ do
buffer <- SomeBuffer <$> jsg1 "h$newByteArrayFromBase64String"
(decodeUtf8 $ B64.encode bs)
arrbuff <- ghcjsPure (getArrayBuffer (buffer :: MutableBuffer))
liftDOM (Uint8ClampedArray <$> new (jsg "Uint8ClampedArray") [pToJSVal arrbuff])
makeImageData :: Int -> Int -> ByteString -> JSM ImageData
makeImageData width height dat
= do dat' <- ghcjsPure (uint8ClampedArrayFromByteString dat)
newImageData dat' (fromIntegral width) (Just (fromIntegral height))
To build this, I used the following stack.yaml
:
resolver: lts-8.12
extra-deps:
- ghcjs-dom-0.8.0.0
- ghcjs-dom-jsaddle-0.8.0.0
- jsaddle-0.8.3.0
- jsaddle-warp-0.8.3.0
- jsaddle-dom-0.8.0.0
- ref-tf-0.4.0.1
source to share
You can use hoogle to search for a function using a type signature ByteString -> GHCJS.Prim.JSVal
. https://www.stackage.org/lts-8.11/hoogle?q=ByteString+-%3E+GHCJS.Prim.JSVal
Which has this in the results: https://www.stackage.org/haddock/lts-8.11/ghcjs-base-stub-0.1.0.2/GHCJS-Prim.html#v:toJSString
toJSString :: String -> JSVal
So now you only need a function ByteString -> String
.
source to share