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?

+3


source to share


3 answers


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/

+2


source


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

      

+3


source


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

.

+1


source







All Articles