Как преобразовать значение ByteString в JSVal

Question

В модуле GHCJS.DOM.JSFFI.Generated.CanvasRenderingContext2D есть функция putImageData со следующим типом:

putImageData ::
  Control.Monad.IO.Class.MonadIO m =>
  CanvasRenderingContext2D
  -> Maybe GHCJS.DOM.Types.ImageData -> Float -> Float -> m ()

Второй параметр имеет тип Maybe GHCJS.DOM.Types.ImageData, Этот тип определен в модуле GHCJS.DOM.Types как оболочка нового типа вокруг значения JSVal:

newtype ImageData = ImageData {unImageData :: GHCJS.Prim.JSVal}

У меня есть значение типа ByteString это всегда 4 байта со значениями RGBA каждого пикселя. Как преобразовать мое значение ByteString в GHCJS.Prim.JSVal?

Answer 1

Как отметил К. А. Бур, после преобразования ByteString к Uint8ClampedArray, вы можете передать зажатый массив в newImageData чтобы получить желаемое ImageData объект.

Вы можете использовать встроенную функцию Javascript для генерации Uint8ClampedArray, Пройти ByteString через Javascript FFI, используйте Data.ByteString.useAsCStringLen,

Код ниже показывает, как это сделать.

{-# 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

Вот ссылка на репозиторий с примером кода: https://github.com/dc25/stackOverflow__how-to-convert-a-bytestring-value-to-a-jsval

Вот ссылка на живую демонстрацию: https://dc25.github.io/stackOverflow__how-to-convert-a-bytestring-value-to-a-jsval/

Answer 2

Редактировать: Похоже, мой первоначальный ответ был слишком ориентирован на GHC. Добавлено непроверенное исправление, которое может работать для GHCJS.

Редактировать № 2: добавил мой stack.yaml файл для примера.

Ты можешь использовать GHCJS.DOM.ImageData.newImageData построить ImageData объект. Это требует, чтобы данные были GHCJS.DOM.Types.Uint8ClampedArray (который является байтовым массивом в формате RGBA).

Есть функции преобразования в GHCJS.Buffer от ByteStringс Bufferс (через fromByteString) и оттуда в типизированные массивы (например, getUint8Array). Они выполняют преобразование непосредственно в GHCJS, и даже в обычном GHC они используют преобразование base64 в качестве посредника, который должен быть довольно быстрым. К сожалению, функция преобразования getUint8ClampedArray не входит (и для простого GHC, похоже, fromByteString в любом случае может быть сломан - в jsaddle 0.8.3.0 он вызывает неправильную вспомогательную функцию JavaScript).

Для простого GHC, кажется, работает следующее (первая строка копируется из fromByteString с помощником, переименованным из явно неверного 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])

Вот непроверенная версия GHCJS, которая может работать. Если они исправят вышеупомянутую ошибку jsaddle, она должна работать и под обычным GHC:

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])

У меня нет работающей установки GHCJS, но вот полный рабочий пример, который я протестировал, используя JSaddle+Warp под обычным GHC, который, кажется, работает нормально (то есть, если вы указываете браузер на localhost:6868, он отображает изображение 3x4 на элемент canvas):

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))

Чтобы построить это, я использовал следующее 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

Answer 3

Вы можете использовать Google, чтобы найти функцию по типу подписи ByteString -> GHCJS.Prim.JSVal, https://www.stackage.org/lts-8.11/hoogle?q=ByteString+-%3E+GHCJS.Prim.JSVal

Который имеет это в результатах: https://www.stackage.org/haddock/lts-8.11/ghcjs-base-stub-0.1.0.2/GHCJS-Prim.html

toJSString :: String -> JSVal

Так что теперь вам просто нужна функция, чтобы сделать ByteString -> String,