Skip to content

Commit 6adafd6

Browse files
committed
fix jsaddle blob performance
1 parent aaf61a9 commit 6adafd6

File tree

10 files changed

+176
-99
lines changed

10 files changed

+176
-99
lines changed

ghcjs/delivery-calculator/src/App/Jsm.hs

Lines changed: 13 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1,38 +1,28 @@
1+
{-# OPTIONS_GHC -Wno-deprecations #-}
2+
13
module App.Jsm (fetchBlobUris) where
24

35
import App.Types
6+
import qualified Data.ByteString.Lazy as BL
47
import qualified Data.Generics as Syb
5-
import qualified Data.Map as Map
68
import qualified Functora.Miso.Jsm as Jsm
79
import Functora.Miso.Prelude
810

9-
fetchBlobUris :: (Data a) => a -> JSM a
11+
fetchBlobUris :: (Data a) => a -> JSM (Map Unicode Rfc2397)
1012
fetchBlobUris st = do
1113
vars <-
1214
forM blobUris $ \uri -> do
1315
var <- newEmptyMVar
14-
Jsm.fetchUrlAsRfc2397 uri $ liftIO . putMVar var . fmap (uri,)
16+
Jsm.fetchUrlAsRfc2397 uri
17+
$ liftIO
18+
. putMVar var
19+
. fmap (uri,)
20+
. (>>= decodeRfc2397 . BL.fromStrict)
1521
pure var
16-
vals <-
17-
fmap (fromList . catMaybes)
18-
. forM vars
19-
$ liftIO
20-
. takeMVar
21-
pure
22-
$ Syb.everywhere
23-
( Syb.mkT $ \(x :: Field DynamicField Unique) ->
24-
case Map.lookup (x ^. #fieldInput . #uniqueValue) vals of
25-
Just val
26-
| fieldType x == FieldTypeImage ->
27-
x
28-
& #fieldInput
29-
. #uniqueValue
30-
.~ val
31-
& #fieldOutput
32-
.~ DynamicFieldText val
33-
_ -> x
34-
)
35-
st
22+
fmap (fromList . catMaybes)
23+
. forM vars
24+
$ liftIO
25+
. takeMVar
3626
where
3727
blobUris =
3828
nubOrd

ghcjs/delivery-calculator/src/App/Widgets/Menu.hs

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@ import qualified App.Jsm as Jsm
99
import App.Types
1010
import qualified App.Widgets.Fav as Fav
1111
import qualified App.Xlsx as Xlsx
12+
import qualified Data.ByteString.Lazy as BL
1213
import qualified Functora.Miso.Jsm as Jsm
1314
import Functora.Miso.Prelude
1415
import qualified Functora.Miso.Widgets.BrowserLink as BrowserLink
@@ -92,8 +93,10 @@ menu st =
9293
[ ("min-width", "0")
9394
],
9495
onClick . PushUpdate . Instant . EffectUpdate $ do
95-
res <- Jsm.fetchBlobUris $ st ^. #modelState
96-
Jsm.saveFile Xlsx.xlsxFile Xlsx.xlsxMime $ Xlsx.newXlsx res
96+
imgs <- Jsm.fetchBlobUris $ st ^. #modelState
97+
Jsm.saveFile Xlsx.xlsxFile Xlsx.xlsxMime
98+
. from @BL.ByteString @ByteString
99+
$ Xlsx.newXlsx imgs
97100
]
98101
[ icon Icon.IconDownload
99102
],

ghcjs/delivery-calculator/src/App/Xlsx.hs

Lines changed: 10 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -8,36 +8,25 @@ module App.Xlsx
88
)
99
where
1010

11-
import App.Types
1211
import Codec.Xlsx
13-
-- import qualified Data.ByteString.Base64.Lazy as B64
1412
import qualified Data.ByteString.Lazy as BL
13+
import qualified Data.Map as Map
1514
import Functora.Miso.Prelude
1615
import Lens.Micro hiding (each, to)
1716
import qualified Prelude
1817

19-
newXlsx :: St Unique -> BL.ByteString
20-
newXlsx st =
21-
fromXlsx 0
22-
$ def
23-
& atSheet "List1" ?~ sheet
18+
newXlsx :: Map Unicode Rfc2397 -> BL.ByteString
19+
newXlsx imgs = xlsx
2420
where
25-
imgs =
26-
catMaybes
27-
$ st
28-
^.. #stAssets
29-
. each
30-
. #assetFieldPairs
31-
. each
32-
. #fieldPairValue
33-
. #fieldInput
34-
. #uniqueValue
35-
. to (trace "2397-start" . decodeRfc2397)
21+
xlsx =
22+
fromXlsx 0
23+
$ def
24+
& atSheet "List1" ?~ sheet
3625
sheet =
3726
def
3827
& cellValueAt (1, 2) ?~ CellDouble 42.0
3928
& cellValueAt (3, 2) ?~ CellText "foo"
40-
& #wsDrawing ?~ drawing (Prelude.head imgs)
29+
& #wsDrawing ?~ drawing (Prelude.head $ Map.elems imgs)
4130

4231
drawing :: Rfc2397 -> Drawing
4332
drawing rfc2397 = Drawing [anchor1]
@@ -58,17 +47,10 @@ drawing rfc2397 = Drawing [anchor1]
5847
(DrawingElementId 0)
5948
FileInfo
6049
{ fiFilename = "img",
61-
fiContentType = from @Unicode @Text $ rfc2397Mime rfc2397,
62-
fiContents =
63-
trace "HELLO"
64-
$ rfc2397Bytes rfc2397
50+
fiContentType = decodeUtf8 $ rfc2397Mime rfc2397,
51+
fiContents = rfc2397Bytes rfc2397
6552
}
6653

67-
-- img :: BL.ByteString
68-
-- img =
69-
-- B64.decodeLenient
70-
-- "/9j/4AAQSkZJRgABAQEASABIAAD/2wBDAP//////////////////////////////////////////////////////////////////////////////////////2wBDAf//////////////////////////////////////////////////////////////////////////////////////wAARCADqATkDASIAAhEBAxEB/8QAFwABAQEBAAAAAAAAAAAAAAAAAAECA//EACQQAQEBAAIBBAMBAQEBAAAAAAABESExQQISUXFhgZGxocHw/8QAFQEBAQAAAAAAAAAAAAAAAAAAAAH/xAAWEQEBAQAAAAAAAAAAAAAAAAAAEQH/2gAMAwEAAhEDEQA/AMriLyCKgg1gQwCgs4FTMOdutepjQak+FzMSVqgxZdRdPPIIvH5WzzGdBriphtTeAXg2ZjKA1pqKDUGZca3foBek8gFv8Ie3fKdA1qb8s7hoL6eLVt51FsAnql3Ut1M7AWbflLMDkEMX/F6/YjK/pADFQAUNA6alYagKk72m/j9p4Bq2fDDSYKLNXPNLoHE/NT6RYC31cJxZ3yWVM+aBYi/S2ZgiAsnYJx5D21vPmqrm3PTfpQQwyAC8JZvSKDni41ZrMuUVVl+Uz9w9v/1QWrZsZ5nFPHYH+JZyureQSF5M+fJ0CAfwRAVRBQA1DAWVUayoJUWoDpsxntPsueBV4+VxhdyAtv8AjOLGpIDMLbeGvbF4iozJfr/WukAVABAXAQXEAAASzVAZdO2WNordm+emFl7XcQSNZiFtv0C9w90nhJf4mA1u+GcJFwIyAqL/AOovwgGNfSRqdIrNa29M0gKCAojU9PAMjWXpckEJFNFEAAXEUBABYz6rZ0ureQc9vyt9XxDF2QAXtABcQAs0AZywkvluJbyipifas52DcyxjlZweAO0xri/hc+wZOEKIu6nSyeToVZyWXwvCg53gW81QQ7aTNAn5dGZJPs1UXURQAUEMCXQLZE93PRZ5hPTgNMrbIzKCm52LZwCs+2M8w2g3sjPuZAXb4IsMAUACzVUGM4/K+md6vEXUUyM5PDR0IxYe6ramih0VNBrS4xoqN8Q1BFQk3yqyAsioioAAKgDSJL4/jQIn5igLrPqtOuf6oOaxbMoAltUAhhIoJiiggrPu+AaOIxtAX3JbaAIaLwi4t9X4T3fg2AFtqcrUUarP20zUDAmqoE0WRBZPNVUVEAAAAVAC8kvih2DSKxOdBqs7Z0l0gI0mKAC4AuHE7ZtBriM+744QAAAAABAFsveIttBICyaikvy1+r/Cen5rWQHIBQa4rIDRqSl5qDWqziqgAAAATA7BpGdqXb2C2+J/UgAtRQBSQtkBWb6vhLbQAAAAAEBRAAAAAUbm+GZNdPxAP+ql2Tjwx7/wIgZ8iKvBk+CJoCXii9gaqZ/qqihAAAEVABGkBFUwBftNkZ3QW34QAAABFAQAVAAAAAARVkl8gs/43sk1jL45LvHArepk+E9XTG35oLqsmIKmLAEygKg0y1AFQBUXwgAAAoBC34S3UAAABAVAAAAAABAUQAVABdRQa1PcYyit2z58M8C4ouM2NXpOEGeWtNZUatiAIoAKIoCoAoG4C9MW6dgIoAIAAAAAAACKWAgL0CAAAALiANCKioNLgM1CrLihmTafkt1EF3SZ5ZVUW4mnIKvAi5fhEURVDWVQBRAAAAAAAAQFRVyAyulgAqCKlF8IqLsEgC9mGoC+IusqCrv5ZEUVOk1RuJfwSLOOkGFi4XPCoYYrNiKauosBGi9ICstM1UAAAAAAFQ0VcTBAXUGgIqGoKhKAzRRUQUAwxoSrGRpkQA/qiosOL9oJptMRRVZa0VUqSiChE6BqMgCwqKqIogAIAqKCKgKoogg0lBFuIKgAAAKNRlf2gqsftsEtZWoAAqAACKoMqAAeSoqp39kL2AqLOlE8rEBFQARYALhigrNC9gGmooLp4TweEQFFBFAECgIoAu0ifIAqAAA//9k="
71-
7254
xlsxFile :: Unicode
7355
xlsxFile = "delivery-calculator.xlsx"
7456

ghcjs/delivery-calculator/static/wasm.js

Lines changed: 9 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,31 +1,28 @@
11
import "./app.js";
22

3-
import {
4-
ConsoleStdout,
5-
File,
6-
OpenFile,
7-
WASI,
8-
} from "@bjorn3/browser_wasi_shim";
3+
import { ConsoleStdout, File, OpenFile, WASI } from "@bjorn3/browser_wasi_shim";
94

105
import ghc_wasm_jsffi from "../dist/wasm/ghc_wasm_jsffi.js";
116

127
async function main() {
13-
148
const args = [];
159
const env = [];
1610
const fds = [
1711
new OpenFile(new File([])), // stdin
1812
ConsoleStdout.lineBuffered((msg) => console.log(`[WASI stdout] ${msg}`)),
1913
ConsoleStdout.lineBuffered((msg) => console.warn(`[WASI stderr] ${msg}`)),
2014
];
21-
const options = {debug : false};
15+
const options = { debug: false };
2216
const wasi = new WASI(args, env, fds, options);
2317

2418
const instance_exports = {};
25-
const {instance} = await WebAssembly.instantiateStreaming(fetch("bin.wasm"), {
26-
wasi_snapshot_preview1 : wasi.wasiImport,
27-
ghc_wasm_jsffi : ghc_wasm_jsffi(instance_exports),
28-
});
19+
const { instance } = await WebAssembly.instantiateStreaming(
20+
fetch("bin.wasm"),
21+
{
22+
wasi_snapshot_preview1: wasi.wasiImport,
23+
ghc_wasm_jsffi: ghc_wasm_jsffi(instance_exports),
24+
},
25+
);
2926
Object.assign(instance_exports, instance.exports);
3027

3128
wasi.initialize(instance);
Lines changed: 75 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,75 @@
1+
export function h$wrapBuffer(buf, unalignedOk, offset, length) {
2+
if (!unalignedOk && offset && offset % 8 !== 0) {
3+
throw "h$wrapBuffer: offset not aligned:" + offset;
4+
}
5+
if (!buf || !(buf instanceof ArrayBuffer))
6+
throw "h$wrapBuffer: not an ArrayBuffer";
7+
if (!offset) {
8+
offset = 0;
9+
}
10+
if (!length || length < 0) {
11+
length = buf.byteLength - offset;
12+
}
13+
return {
14+
buf: buf,
15+
len: length,
16+
i3: offset % 4 ? null : new Int32Array(buf, offset, length >> 2),
17+
u8: new Uint8Array(buf, offset, length),
18+
u1: offset % 2 ? null : new Uint16Array(buf, offset, length >> 1),
19+
f3: offset % 4 ? null : new Float32Array(buf, offset, length >> 2),
20+
f6: offset % 8 ? null : new Float64Array(buf, offset, length >> 3),
21+
dv: new DataView(buf, offset, length),
22+
};
23+
}
24+
25+
export function h$byteArrayToBase64String(off, len, ba) {
26+
var bin = "";
27+
var u8 = ba.u8;
28+
var end = off + len;
29+
for (var i = off; i < end; i++) {
30+
bin += String.fromCharCode(u8[i]);
31+
}
32+
return window.btoa(bin);
33+
}
34+
35+
export function h$newByteArrayFromBase64String(base64) {
36+
var bin = window.atob(base64);
37+
var ba = h$newByteArray(bin.length);
38+
var u8 = ba.u8;
39+
for (var i = 0; i < bin.length; i++) {
40+
u8[i] = bin.charCodeAt(i);
41+
}
42+
return ba;
43+
}
44+
45+
export function h$newByteArray(len) {
46+
var len0 = Math.max(h$roundUpToMultipleOf(len, 8), 8);
47+
var buf = new ArrayBuffer(len0);
48+
return {
49+
buf: buf,
50+
len: len,
51+
i3: new Int32Array(buf),
52+
u8: new Uint8Array(buf),
53+
u1: new Uint16Array(buf),
54+
f3: new Float32Array(buf),
55+
f6: new Float64Array(buf),
56+
dv: new DataView(buf),
57+
};
58+
}
59+
60+
export function h$roundUpToMultipleOf(n, m) {
61+
var rem = n % m;
62+
return rem === 0 ? n : n - rem + m;
63+
}
64+
65+
[
66+
h$wrapBuffer,
67+
h$byteArrayToBase64String,
68+
h$newByteArrayFromBase64String,
69+
h$newByteArray,
70+
h$roundUpToMultipleOf,
71+
].forEach(function (f) {
72+
if (!globalThis[f.name]) {
73+
globalThis[f.name] = f;
74+
}
75+
});

ghcjs/miso-functora/js/main.js

Lines changed: 10 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
import "./jsaddle-compat";
12
import { defineCustomElements } from "@ionic/pwa-elements/loader";
23
import { Filesystem, Directory } from "@capacitor/filesystem";
34
import { WebviewPrint } from "capacitor-webview-print";
@@ -73,8 +74,8 @@ export async function selectBarcode() {
7374
return ScanResult;
7475
}
7576

76-
export async function saveFile(name, mime, bs) {
77-
const u8a = Uint8Array.from(bs);
77+
export async function saveFile(name, mime, ab) {
78+
const u8a = new Uint8Array(ab);
7879
if (Capacitor.isNativePlatform()) {
7980
const b64 = btoa(String.fromCharCode.apply(null, u8a));
8081
const { uri } = await Filesystem.writeFile({
@@ -104,16 +105,19 @@ export function isNativePlatform() {
104105
}
105106

106107
export async function fetchUrlAsRfc2397(url) {
107-
const resp = await fetch(url);
108-
const blob = await resp.blob();
109-
return new Promise((resolve, reject) => {
108+
const imgResp = await fetch(url);
109+
const imgBlob = await imgResp.blob();
110+
const rfc2397 = await new Promise((resolve, reject) => {
110111
var fr = new FileReader();
111112
fr.onload = () => {
112113
resolve(fr.result);
113114
};
114115
fr.onerror = reject;
115-
fr.readAsDataURL(blob);
116+
fr.readAsDataURL(imgBlob);
116117
});
118+
const utf8Encode = new TextEncoder();
119+
const ab = utf8Encode.encode(rfc2397).buffer;
120+
return ab;
117121
}
118122

119123
defineCustomElements(window);

ghcjs/miso-functora/js/main.min.js

Lines changed: 1 addition & 1 deletion
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

ghcjs/miso-functora/src/Functora/Miso/Jsm/Generic.hs

Lines changed: 30 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,9 @@ where
2020
import qualified Data.ByteString.Lazy as BL
2121
import Functora.Miso.Prelude
2222
import Functora.Miso.Types
23+
import qualified GHCJS.Buffer as Buf
2324
import qualified GHCJS.Types as JS
25+
import qualified JavaScript.TypedArray.ArrayBuffer as AB
2426
import qualified Language.Javascript.JSaddle as JS
2527
import qualified Text.URI as URI
2628
import qualified Prelude ((!!))
@@ -200,20 +202,41 @@ printCurrentPage name = do
200202
pkg <- getPkg
201203
void $ pkg ^. JS.js1 ("printCurrentPage" :: Unicode) name
202204

203-
saveFile :: forall a. (From a [Word8]) => Unicode -> Unicode -> a -> JSM ()
205+
saveFile :: Unicode -> Unicode -> ByteString -> JSM ()
204206
saveFile name mime bs = do
207+
(buf, off, len) <- ghcjsPure $ Buf.fromByteString bs
208+
ab0 <- ghcjsPure . JS.jsval_ =<< ghcjsPure (Buf.getArrayBuffer buf)
209+
ab1 <- ab0 ^. JS.jsf ("slice" :: Unicode) ([off, off + len] :: [Int])
205210
argv <-
206211
sequence
207212
[ JS.toJSVal name,
208213
JS.toJSVal mime,
209-
JS.toJSVal $ from @a @[Word8] bs
214+
JS.toJSVal ab1
210215
]
211216
genericPromise @[JS.JSVal] @Unicode "saveFile" argv $ \case
212217
Nothing -> pure ()
213218
Just str -> popupText str
214219

215-
fetchUrlAsRfc2397 :: Unicode -> (Maybe Unicode -> JSM ()) -> JSM ()
216-
fetchUrlAsRfc2397 url after =
217-
genericPromise @[Unicode] @Unicode "fetchUrlAsRfc2397" [url]
218-
$ after
219-
. fmap strip
220+
fetchUrlAsRfc2397 :: Unicode -> (Maybe ByteString -> JSM ()) -> JSM ()
221+
fetchUrlAsRfc2397 url after = do
222+
success <- JS.function $ \_ _ ->
223+
handleAny (\e -> consoleLog e >> after Nothing) . \case
224+
[val] -> do
225+
valExist <- ghcjsPure $ JS.isTruthy val
226+
if not valExist
227+
then after Nothing
228+
else do
229+
ab <- AB.freeze $ JS.pFromJSVal val
230+
buf <- ghcjsPure $ Buf.createFromArrayBuffer ab
231+
res <- ghcjsPure $ Buf.toByteString 0 Nothing buf
232+
after $ Just res
233+
_ ->
234+
throwString @String "Failure, bad argv!"
235+
failure <-
236+
JS.function $ \_ _ e -> do
237+
msg <- handleAny (\_ -> pure "Unknown") $ JS.valToText e
238+
consoleLog @Unicode $ "Failure, " <> inspect msg <> "!"
239+
after Nothing
240+
pkg <- getPkg
241+
prom <- pkg ^. JS.jsf ("fetchUrlAsRfc2397" :: Unicode) ([url] :: [Unicode])
242+
void $ prom ^. JS.js2 @Unicode "then" success failure

pub/functora/src/test/Functora/WebSpec.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,12 @@
11
module Functora.WebSpec (spec) where
22

3+
import qualified Data.ByteString.Lazy as BL
34
import Functora.Prelude
45
import qualified Functora.Rfc2397 as Rfc2397
56
import Test.Hspec
67
import Test.QuickCheck.Instances ()
78

8-
smaples :: [Unicode]
9+
smaples :: [BL.ByteString]
910
smaples =
1011
[ "data:text/vnd-example+xyz;foo=bar;base64,R0lGODdh",
1112
"data:text/plain;charset=UTF-8;page=21,the%20data:1234,5678",

0 commit comments

Comments
 (0)