Create library

.gitignore

@@ -0,0 +1,10 @@
+/bower_components/
+/node_modules/
+/.pulp-cache/
+/output/
+/generated-docs/
+/.psc-package/
+/.psc*
+/.purs*
+/.psa*
+/.spago

LICENCE

@@ -0,0 +1,7 @@
+Copyright 2022 Mark Eibes
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

packages.dhall

@@ -0,0 +1,105 @@
+{-
+Welcome to your new Dhall package-set!
+
+Below are instructions for how to edit this file for most use
+cases, so that you don't need to know Dhall to use it.
+
+## Use Cases
+
+Most will want to do one or both of these options:
+1. Override/Patch a package's dependency
+2. Add a package not already in the default package set
+
+This file will continue to work whether you use one or both options.
+Instructions for each option are explained below.
+
+### Overriding/Patching a package
+
+Purpose:
+- Change a package's dependency to a newer/older release than the
+    default package set's release
+- Use your own modified version of some dependency that may
+    include new API, changed API, removed API by
+    using your custom git repo of the library rather than
+    the package set's repo
+
+Syntax:
+where `entityName` is one of the following:
+- dependencies
+- repo
+- version
+-------------------------------
+let upstream = --
+in  upstream
+  with packageName.entityName = "new value"
+-------------------------------
+
+Example:
+-------------------------------
+let upstream = --
+in  upstream
+  with halogen.version = "master"
+  with halogen.repo = "https://example.com/path/to/git/repo.git"
+
+  with halogen-vdom.version = "v4.0.0"
+  with halogen-vdom.dependencies = [ "extra-dependency" ] # halogen-vdom.dependencies
+-------------------------------
+
+### Additions
+
+Purpose:
+- Add packages that aren't already included in the default package set
+
+Syntax:
+where `<version>` is:
+- a tag (i.e. "v4.0.0")
+- a branch (i.e. "master")
+- commit hash (i.e. "701f3e44aafb1a6459281714858fadf2c4c2a977")
+-------------------------------
+let upstream = --
+in  upstream
+  with new-package-name =
+    { dependencies =
+       [ "dependency1"
+       , "dependency2"
+       ]
+    , repo =
+       "https://example.com/path/to/git/repo.git"
+    , version =
+        "<version>"
+    }
+-------------------------------
+
+Example:
+-------------------------------
+let upstream = --
+in  upstream
+  with benchotron =
+      { dependencies =
+          [ "arrays"
+          , "exists"
+          , "profunctor"
+          , "strings"
+          , "quickcheck"
+          , "lcg"
+          , "transformers"
+          , "foldable-traversable"
+          , "exceptions"
+          , "node-fs"
+          , "node-buffer"
+          , "node-readline"
+          , "datetime"
+          , "now"
+          ]
+      , repo =
+          "https://github.com/hdgarrood/purescript-benchotron.git"
+      , version =
+          "v7.0.0"
+      }
+-------------------------------
+-}
+let upstream =
+      https://github.com/purescript/package-sets/releases/download/psc-0.15.7-20230219/packages.dhall
+        sha256:2ba900b6b1cdeb3ad8f1554d1ceaafede6a9451dc009f96ef45754476d00c900
+
+in  upstream

spago.dhall

@@ -0,0 +1,34 @@
+{-
+Welcome to a Spago project!
+You can edit this file as you like.
+
+Need help? See the following resources:
+- Spago documentation: https://github.com/purescript/spago
+- Dhall language tour: https://docs.dhall-lang.org/tutorials/Language-Tour.html
+
+When creating a new Spago project, you can use
+`spago init --no-comments` or `spago init -C`
+to generate this file without the comments in this block.
+-}
+{ name = "webextension-polyfill"
+, repository = "https://github.com/rowtype-yoga/purescript-webextension-polyfill.git"
+, license = "MIT"
+, dependencies =
+  [ "aff"
+  , "aff-promise"
+  , "console"
+  , "effect"
+  , "either"
+  , "foldable-traversable"
+  , "foreign"
+  , "foreign-generic"
+  , "foreign-object"
+  , "maybe"
+  , "newtype"
+  , "prelude"
+  , "psci-support"
+  , "yoga-json"
+  ]
+, packages = ../../packages.dhall
+, sources = [ "src/**/*.purs", "test/**/*.purs" ]
+}

src/WebExtension/Polyfill.js

@@ -0,0 +1,22 @@
+import browser, { storage, history as _history, runtime, windows } from 'webextension-polyfill'
+
+export const browserImpl = browser
+export function loadFromLocalStorageImpl(key) { return () => storage.local.get(key)}
+export function saveInLocalStorageImpl(obj) { return () => storage.local.set(obj)}
+export function removeFromLocalStorageImpl(key) { return () => storage.local.remove(key)}
+
+export function history() { return _history}
+
+export function addOnVisitedListenerImpl(listener) { return history => () => history.onVisited.addListener(listener)}
+
+export function sendMessageViaPortImpl(message, port) { return port.postMessage(message)}
+export function addOnPortMessageListenerImpl(listener, port) { return port.onMessage.addListener(listener)}
+
+export function onContentScriptConnectedImpl(listener) { return () =>
+  runtime.onConnect.addListener(port => listener(port)())}
+
+export const connectToBackgroundScriptImpl = runtime.connect
+
+export function openNewWindowImpl(options) { return () => windows.create(options)}
+
+export const reload = runtime.reload

src/WebExtension/Polyfill.purs

@@ -0,0 +1,113 @@
+module WebExtension.Polyfill where
+
+import Prelude
+import Control.Promise (Promise, toAffE)
+import Data.Either (Either(..))
+import Data.Maybe (Maybe(..))
+import Data.Semigroup.Foldable (intercalateMap)
+import Effect (Effect)
+import Effect.Aff (Aff)
+import Effect.Class.Console as Console
+import Effect.Uncurried (EffectFn1, EffectFn2, mkEffectFn1, runEffectFn1, runEffectFn2)
+import Foreign (Foreign, renderForeignError)
+import Foreign.Internal.Stringify (unsafeStringify)
+import Foreign.Object (Object)
+import Foreign.Object as Object
+import Prim.Row (class Union)
+import Yoga.JSON (class ReadForeign, class WriteForeign, read)
+import Yoga.JSON as JSON
+import WebExtension.Polyfill.Types (StorageKey(..))
+
+foreign import browserImpl ∷ Type
+
+-- Unusal API. The keys could also be an array in which case there'd be an object
+-- with keys for the array of strings passed in originally values. Maybe this is
+-- for efficiency reasons when using the "sync" API which is apparently kind of
+-- throttled. Until then, we store keys and values.
+foreign import data LocalStorage ∷ Type
+
+foreign import loadFromLocalStorageImpl ∷ String -> Effect (Promise (Object Foreign))
+
+foreign import saveInLocalStorageImpl ∷ Object Foreign -> Effect (Promise Unit)
+
+foreign import removeFromLocalStorageImpl ∷ String -> Effect (Promise Unit)
+
+loadFromLocalStorage ∷ ∀ a. ReadForeign a => StorageKey -> Aff (Maybe a)
+loadFromLocalStorage (StorageKey key) = do
+  Console.info $ "Loading from Local Storage " <> key
+  result <- toAffE $ loadFromLocalStorageImpl key
+  pure case Object.lookup key result of
+    Nothing -> Nothing
+    Just raw -> JSON.read_ raw
+
+saveInLocalStorage ∷ ∀ a. WriteForeign a => StorageKey -> a -> Aff Unit
+saveInLocalStorage (StorageKey key) value = do
+  Console.info $ "Saving in Local Storage " <> key <> " : " <> JSON.writeJSON value
+  saveInLocalStorageImpl (Object.singleton key $ JSON.write value) # toAffE
+
+removeFromLocalStorage ∷ StorageKey -> Aff Unit
+removeFromLocalStorage (StorageKey key) = do
+  Console.info $ "Removing from Local Storage " <> key
+  removeFromLocalStorageImpl key # toAffE
+
+foreign import data Port ∷ Type
+
+foreign import sendMessageViaPortImpl ∷ EffectFn2 Foreign Port Unit
+
+sendMessageViaPort ∷ ∀ msg. WriteForeign msg => msg -> Port -> Effect Unit
+sendMessageViaPort m = runEffectFn2 sendMessageViaPortImpl (JSON.write m)
+
+foreign import addOnPortMessageListenerImpl ∷ EffectFn2 (EffectFn1 Foreign Unit) Port Unit
+
+addOnPortMessageListener ∷ (Foreign -> Effect Unit) -> Port -> Effect Unit
+addOnPortMessageListener listener = runEffectFn2 addOnPortMessageListenerImpl (mkEffectFn1 listener)
+
+foreign import onContentScriptConnectedImpl ∷ (Port -> Effect Unit) -> Effect Unit
+
+onContentScriptConnected ∷ (Port -> Effect Unit) -> Effect Unit
+onContentScriptConnected = onContentScriptConnectedImpl
+
+type ConnectOptions =
+  ( name ∷ String )
+
+foreign import connectToBackgroundScriptImpl ∷ ∀ opts. EffectFn1 (Record opts) Port
+
+connectToBackgroundScript ∷ ∀ opts missing. Union opts missing ConnectOptions => Record opts -> Effect Port
+connectToBackgroundScript = runEffectFn1 connectToBackgroundScriptImpl
+
+foreign import openNewWindowImpl ∷ ∀ opts. Record opts -> Effect Unit
+
+openNewWindow ∷ ∀ opts. Record opts -> Effect Unit
+openNewWindow = openNewWindowImpl
+
+foreign import reload ∷ Effect Unit
+
+foreign import data BrowserHistory ∷ Type
+
+foreign import history ∷ Effect BrowserHistory
+
+foreign import addOnVisitedListenerImpl ∷ (EffectFn1 Foreign Unit) -> BrowserHistory -> Effect Unit
+
+addOnVisitedListener ∷
+  (HistoryItem -> Effect Unit) ->
+  BrowserHistory -> Effect Unit
+addOnVisitedListener callback = addOnVisitedListenerImpl (mkEffectFn1 rawCallback)
+  where
+  rawCallback f = do
+    let parsed = read f
+    case parsed of
+      Left err ->
+        Console.error
+          $ "Could not parse history item "
+          <> unsafeStringify f
+          <> " "
+          <> intercalateMap "\n" renderForeignError err
+      Right ok -> callback ok
+
+type HistoryItem =
+  { id ∷ String
+  , url ∷ Maybe String
+  , title ∷ Maybe String
+  , lastVisitTime ∷ Maybe Number -- really an instant
+  , visitCount ∷ Maybe Int
+  }

src/WebExtension/Polyfill/Types.purs

@@ -0,0 +1,10 @@
+module WebExtension.Polyfill.Types where
+
+import Prelude
+import Data.Newtype (class Newtype)
+
+newtype StorageKey = StorageKey String
+
+derive instance newtypeStorageKey ∷ Newtype StorageKey _
+derive newtype instance eqStorageKey ∷ Eq StorageKey
+derive newtype instance ordStorageKey ∷ Ord StorageKey