wip

Author: functora

ghcjs/miso-functora/js/main.js

@@ -29,14 +29,8 @@ export async function insertStorage(key, value) {
 }
 
 export async function selectClipboard() {
-  const { type, value } = await Clipboard.read();
-  if (type.startsWith("text")) {
-    return value;
-  } else {
-    const { buffer: u8a, typeFull: mime } = dataUriToBuffer(value);
-    const blob = new Blob([u8a, { type: mime }]);
-    return URL.createObjectURL(blob);
-  }
+  const { value } = await Clipboard.read();
+  return value;
 }
 
 export async function openBrowserPage(url) {
@@ -103,4 +97,10 @@ export function isNativePlatform() {
   return Capacitor.isNativePlatform();
 }
 
+export function newBlobUrl(value) {
+  const { buffer: u8a, typeFull: mime } = dataUriToBuffer(value);
+  const blob = new Blob([u8a, { type: mime }]);
+  return URL.createObjectURL(blob);
+}
+
 defineCustomElements(window);

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

@@ -13,6 +13,7 @@ module Functora.Miso.Jsm.Generic
     genericPromise,
     printCurrentPage,
     saveFile,
+    newBlobUrl,
   )
 where
 
@@ -213,3 +214,9 @@ saveFile name mime bs = do
   genericPromise @[JS.JSVal] @Unicode "saveFile" argv $ \case
     Nothing -> pure ()
     Just str -> popupText str
+
+newBlobUrl :: Unicode -> JSM Unicode
+newBlobUrl blob = do
+  pkg <- getPkg
+  res <- pkg ^. JS.js1 ("newBlobUrl" :: Unicode) blob
+  JS.fromJSVal res >>= maybe (throwString @String "Failure, bad result!") pure

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

@@ -13,6 +13,7 @@ import Functora.Prelude as X hiding
     cons,
     field,
   )
+import Functora.Rfc2397 as X
 import Miso as X hiding
   ( Key,
     Text,

ghcjs/miso-functora/src/Functora/Miso/Prelude.hs

@@ -8,7 +8,6 @@ import qualified Optics.Setter as Ops
 import Test.Hspec
 import Test.Hspec.QuickCheck
 import Test.QuickCheck.Instances ()
-import qualified Text.URI as URI
 
 data Expr
   = Lit Int

ghcjs/miso-functora/test/Functora/Miso/TypesSpec.hs

@@ -123,6 +123,7 @@ common pkg
     , uniplate
     , universum
     , unliftio
+    , uri-encode
     , vector
     , witch-mini
     , with-utf8
@@ -184,6 +185,7 @@ library
     Functora.Qr
     Functora.QrOrphan
     Functora.Rates
+    Functora.Rfc2397
     Functora.Tags
     Functora.Unicode
     Functora.Web
@@ -232,6 +234,7 @@ test-suite functora-ghcjs-test
     Functora.Tags.TestFgpt
     Functora.Tags.TestSing
     Functora.TagsSpec
+    Functora.WebSpec
 
   other-modules:
     Functora.Aes
@@ -246,6 +249,7 @@ test-suite functora-ghcjs-test
     Functora.Qr
     Functora.QrOrphan
     Functora.Rates
+    Functora.Rfc2397
     Functora.Tags
     Functora.TagsFamily
     Functora.TagsOrphan

pub/functora/src/functora-ghcjs.cabal

@@ -16,4 +16,5 @@ smaples =
 spec :: Spec
 spec = do
   it "encode/decode" . forM_ smaples $ \sample ->
-    fmap Rfc2397.encode (Rfc2397.decode sample) `shouldBe` Just sample
+    fmap Rfc2397.encodeRfc2397 (Rfc2397.decodeRfc2397 sample)
+      `shouldBe` Just sample

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

@@ -1,8 +1,8 @@
 module Functora.Rfc2397
   ( Media (..),
     Encoding (..),
-    encode,
-    decode,
+    encodeRfc2397,
+    decodeRfc2397,
   )
 where
 
@@ -19,11 +19,15 @@ data Media = Media
   }
   deriving stock (Eq, Ord, Show, Data, Generic)
 
+instance Binary Media
+
 data Encoding = B64Encoding | UrlEncoding
   deriving stock (Eq, Ord, Show, Read, Data, Generic, Bounded, Enum)
 
-encode :: Media -> String
-encode Media {mediaMime = mime, mediaBytes = bs, mediaEncoding = enc} =
+instance Binary Encoding
+
+encodeRfc2397 :: Media -> String
+encodeRfc2397 Media {mediaMime = mime, mediaBytes = bs, mediaEncoding = enc} =
   "data:"
     <> mime
     <> ( case enc of
@@ -41,8 +45,8 @@ encode Media {mediaMime = mime, mediaBytes = bs, mediaEncoding = enc} =
               $ decodeUtf8Strict bs
        )
 
-decode :: String -> Maybe Media
-decode url =
+decodeRfc2397 :: String -> Maybe Media
+decodeRfc2397 url =
   let (scheme, rest) = break (== ':') url
    in case rest of
         ':' : contents | scheme == "data" -> decodeContents contents