Reinit project

package.json

@@ -20,7 +20,8 @@
   "devDependencies": {
     "concurrently": "^5.2.0",
     "parcel": "^1.12.4",
-    "spago": "^0.19.2"
+    "spago": "^0.19.2",
+    "web-ext": "^7.10.0"
   },
   "resolutions": {
     "@babel/preset-env": "7.13.8"

packages.dhall

@@ -117,7 +117,8 @@ let additions =
 -------------------------------
 -}
 let upstream =
-      https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20210226/packages.dhall sha256:7e973070e323137f27e12af93bc2c2f600d53ce4ae73bb51f34eb7d7ce0a43ea
+      https://github.com/purescript/package-sets/releases/download/psc-0.15.13-20231228/packages.dhall
+        sha256:f61b8e3181e85976f495fd7c023506551914bc733f0b26cb209bc67e3c4f4024
 
 let overrides = {=}
 

spago.dhall

@@ -4,32 +4,10 @@ You can edit this file as you like.
 -}
 { name = "pure-tabs"
 , dependencies =
-  [ "aff"
-  , "aff-coroutines"
-  , "aff-promise"
-  , "avar"
+  [ "prelude"
   , "console"
-  , "css"
-  , "datetime"
-  , "debug"
+  , "control"  
   , "effect"
-  , "foreign"
-  , "foreign-generic"
-  , "generics-rep"
-  , "halogen"
-  , "halogen-css"
-  , "halogen-hooks"
-  , "lists"
-  , "numbers"
-  , "ordered-collections"
-  , "profunctor"
-  , "profunctor-lenses"
-  , "psci-support"
-  , "refs"
-  , "st"
-  , "unordered-collections"
-  , "web-dom"
-  , "web-html"
   ]
 , packages = ./packages.dhall
 , sources = [ "src/**/*.purs", "test/**/*.purs" ]

src/Background.purs

@@ -1,288 +1,11 @@
 module PureTabs.Background where
 
-import Browser.Runtime as Runtime
-import Browser.Tabs (Tab(..), TabId, WindowId)
-import Browser.Tabs as BT
-import Browser.Tabs.OnActivated as OnActivated
-import Browser.Tabs.OnAttached as OnAttached
-import Browser.Tabs.OnCreated as OnCreated
-import Browser.Tabs.OnDetached as OnDetached
-import Browser.Tabs.OnMoved as OnMoved
-import Browser.Tabs.OnRemoved as OnRemoved
-import Browser.Tabs.OnUpdated as OnUpdated
-import Browser.Utils (Listener, mkListenerOne, mkListenerTwo, mkListenerUnit)
-import Browser.Windows (Window)
-import Browser.Windows.OnCreated as WinOnCreated
-import Browser.Windows.OnRemoved as WinOnRemoved
-import Control.Alt ((<#>))
-import Control.Alternative ((*>))
-import Control.Bind ((=<<), (>>=))
-import Control.Category ((>>>))
-import Data.Array as A
-import Data.CommutativeRing ((+))
-import Data.Foldable (for_)
-import Data.Function (flip, (#))
-import Data.Lens (_Just, set, view)
-import Data.Lens.At (at)
-import Data.List (List, foldMap)
-import Data.Map as M
-import Data.Maybe (Maybe(..), maybe)
-import Data.Monoid ((<>))
-import Data.Newtype (unwrap)
-import Data.Set as Set
-import Data.Show (show)
-import Data.Traversable (traverse)
-import Data.Unit (unit)
-import Effect (Effect)
-import Effect.Aff (Aff, launchAff_)
-import Effect.Class (liftEffect)
-import Effect.Console (log)
-import Effect.Ref as Ref
-import Prelude (Unit, bind, discard, pure, ($), (<$>), (<<<))
-import PureTabs.Browser.Sessions (getTabValue, removeTabValue, setTabValue)
-import PureTabs.Model.BackgroundEvent (BackgroundEvent(..))
-import PureTabs.Model.GlobalState as GS
-import PureTabs.Model.Group (GroupId(..))
-import PureTabs.Model.GroupMapping (GroupData, createGroup, deleteGroup, moveGroup, renameGroup, retrieveGroups, updateGroupsMapping)
-import PureTabs.Model.SidebarEvent (SidebarEvent(..))
-import PureTabs.Model.TabWithGroup (TabWithGroup(..))
-
-type Ports
-  = Ref.Ref (List Runtime.Port)
-
-type StateRef = Ref.Ref GS.GlobalState
+import Prelude
 
+import Effect.Console (log)
+import Effect (Effect)
 
 main :: Effect Unit
 main = do
   log "[bg] starting"
-  launchAff_ do
-     allTabs <- BT.browserQuery {}
-     liftEffect $ initializeBackground =<< (Ref.new $ GS.initialTabsToGlobalState allTabs)
-
-initializeBackground :: Ref.Ref GS.GlobalState -> Effect Unit
-initializeBackground ref = do
-  (mkListenerOne $ onConnect ref) >>= Runtime.onConnectAddListener
-  (mkListenerOne $ onWindowCreated ref) >>= WinOnCreated.addListener
-  (mkListenerOne $ onWindowRemoved ref) >>= WinOnRemoved.addListener
-  onTabCreated ref # OnCreated.addListener
-  (mkListenerTwo $ onTabDeleted ref) >>= OnRemoved.addListener
-  onTabActived ref # OnActivated.addListener
-  onTabUpdated ref # OnUpdated.addListener
-  (mkListenerTwo $ onTabDetached ref) >>= OnDetached.addListener
-  (mkListenerTwo $ onTabAttached ref) >>= OnAttached.addListener
-  (mkListenerTwo $ onTabMoved ref) >>= OnMoved.addListener
-
-onWindowCreated :: StateRef -> Window -> Effect Unit
-onWindowCreated ref { id: winId } = do
-  log $ "[bg] created window " <> (show winId)
-  ref # Ref.modify_ (GS.addEmptyWindow winId)
-
-onWindowRemoved :: StateRef -> WindowId -> Effect Unit
-onWindowRemoved ref winId = do
-  log $ "[bg] deleted window " <> (show winId)
-  ref # Ref.modify_ (GS.deleteWindow winId)
-
-onTabCreated :: StateRef -> Tab -> Effect Unit
-onTabCreated stateRef tab = do
-  log $ "[bg] created tab " <> (BT.showTabId tab) 
-  state <- Ref.modify (GS.createTab tab) stateRef
-  liftEffect $ GS.sendToTabPort tab state $ BgTabCreated tab
-
-  let Tab({id: tid, windowId: wid}) = tab
-
-  -- Attempt to detect session restore.
-  -- If the tab we're opening already has a `groupId` value, it is either a
-  -- restored tab from the current session, or a restored tab from a full
-  -- session restore. If we found groups associated with the tab's window, we
-  -- ask the sidebar to initiliaze them.
-  -- 
-  -- This solution ignores one use case (for which it will probably be buggy):
-  -- opening a session on top of an already existing session. If the user
-  -- starts creating groups, opening tab, and then restore a session, then it
-  -- will probably break.
-  launchAff_ do
-    groups' <- retrieveGroups wid
-    -- First initialize the groups, then assign the tab. Otherwise the
-    -- tab could be assigned to a non existing group.
-    case groups' of 
-        [] -> pure unit
-        groups -> liftEffect do
-           log $ "[bg] groups found for window " <> (show wid)
-           GS.sendToTabPort tab state $ BgInitializeGroups groups
-
-    gid <-(getTabValue tid "groupId" :: Aff (Maybe GroupId))
-    liftEffect $ log $ "[bg] gid maybe found for tab " <> (show tid) <> ": " <> (show gid)
-    liftEffect $ GS.sendToTabPort tab state $ BgAssignTabToGroup tid gid
-
-onTabUpdated :: StateRef -> TabId -> OnUpdated.ChangeInfo -> Tab -> Effect Unit
-onTabUpdated stateRef tid cinfo tab = do
-  log $ "[bg] updated tab " <> show tid
-  state <- Ref.modify (GS.updateTab tab) stateRef
-  GS.sendToTabPort tab state $ BgTabUpdated tid cinfo tab
-
-onTabMoved :: StateRef -> TabId -> OnMoved.MoveInfo -> Effect Unit
-onTabMoved ref tid minfo = do
-  log $ "[bg] moved tab " <> show tid
-  state <- Ref.modify (GS.moveTab minfo.fromIndex minfo.toIndex minfo.windowId) ref
-  GS.sendToWindowPort minfo.windowId state $ BgTabMoved tid minfo.fromIndex minfo.toIndex
-
-onTabActived :: StateRef -> OnActivated.ActiveInfo -> Effect Unit
-onTabActived stateRef (OnActivated.ActiveInfo aInfo) = do
-  log $ "[bg] activated tab " <> show aInfo.tabId
-  state <- Ref.modify (GS.activateTab aInfo.windowId aInfo.previousTabId aInfo.tabId) stateRef
-  GS.sendToWindowPort aInfo.windowId state $ BgTabActivated aInfo.previousTabId aInfo.tabId
-
-onTabDeleted :: StateRef -> TabId -> OnRemoved.RemoveInfo -> Effect Unit
-onTabDeleted stateRef tabId info = do 
-  log $ "[bg] deleted tab " <> show tabId
-  state <- Ref.modify (GS.deleteTab info.windowId tabId) stateRef
-  GS.sendToWindowPort info.windowId state $ BgTabDeleted tabId
-
-onTabDetached :: StateRef -> TabId -> OnDetached.DetachInfo -> Effect Unit
-onTabDetached stateRef tabId info = do
-  log $ "[bg] detached tab " <> show tabId
-  state <- Ref.modify (GS.detachTab info.oldWindowId tabId) stateRef
-  GS.sendToWindowPort info.oldWindowId state $ BgTabDetached tabId
-
-onTabAttached :: StateRef -> TabId -> OnAttached.AttachInfo -> Effect Unit
-onTabAttached stateRef tid info = do
-  log $ "[bg] attached tab " <> show tid
-  state <- Ref.modify (GS.attachTab info.newWindowId tid info.newPosition) stateRef
-  case GS.tabFromWinIdAndTabId info.newWindowId tid state of
-     Just newTab -> GS.sendToWindowPort info.newWindowId state $ BgTabAttached newTab
-     Nothing -> pure unit
-
-onConnect :: StateRef -> Runtime.Port -> Effect Unit
-onConnect stateRef port = do
-  log "[bg] connection received"
-  -- Create a temporary listener ref that will only be held until the sidebar has sent its current window
-  listenerRef <- Ref.new Nothing
-  initialListener <-
-    Runtime.onMessageJsonAddListener port $ windowListener
-      $ onNewWindowId port stateRef listenerRef
-  -- XXX: Is it possible a message arrives *before* this is executed ? 
-  -- Theoretically yes, and this means this way of doing is unsafe, but it's
-  -- difficult for a handler to remove itself otherwise.
-  Ref.write (Just initialListener) listenerRef
-
-  where
-
-  windowListener :: (WindowId -> Effect Unit) -> SidebarEvent -> Effect Unit
-  windowListener callback msg = case msg of
-    SbHasWindowId winId -> log ("[bg] created winId " <> show winId) *> callback winId
-    _ -> pure unit
-
-onNewWindowId 
-  :: forall a. 
-   Runtime.Port 
-  -> StateRef 
-  -> (Ref.Ref (Maybe (Listener a)))
-  -> WindowId 
-  -> Effect Unit
-onNewWindowId port stateRef listenerRef winId = do
-  -- Initial state of the current window
-  Ref.modify_ (GS.initializeWindowState winId port) stateRef
-
-  -- Remove the previous onMessage listener
-  ogListener <- Ref.read listenerRef
-  foldMap (\l -> Runtime.onMessageRemoveListener port l) ogListener
-  Ref.write Nothing listenerRef
-
-  -- Send initial tabs
-  latestState <- Ref.read stateRef
-  M.lookup winId latestState.windows # foldMap \w ->
-    let 
-        tabs = A.fromFoldable
-          $ w.positions
-          <#> (flip M.lookup w.tabs)
-          # A.catMaybes
-
-    in
-      launchAff_ do
-         liftEffect $ log $ "[bg] initializing tabs"
-         groups <- initialWindowGroups
-         tabsWithGroup <- initialTabsGroups tabs groups
-         liftEffect $ Runtime.postMessageJson port $ BgInitialTabList groups tabsWithGroup
-    
-  --  Add the new onMessage listener
-  sidebarListener <- Runtime.onMessageJsonAddListener port $ manageSidebar stateRef winId port
-  onDisconnectListener <- mkListenerUnit $ onDisconnect stateRef winId sidebarListener
-  Runtime.portOnDisconnect port onDisconnectListener
-
-  where
-        -- | Set a default group if none exist.
-        initialWindowGroups :: Aff (Array GroupData)
-        initialWindowGroups = 
-           retrieveGroups winId >>= 
-             case _ of 
-                  [] -> updateGroupsMapping winId (createGroup (GroupId 0) "main") 
-                      *> retrieveGroups winId >>= \groups' -> pure groups'
-                  groups' -> pure groups'
-
-        -- | For each tab, set a default tab if it doesn't exist
-        initialTabsGroups :: Array Tab -> Array GroupData -> Aff (Array TabWithGroup)
-        initialTabsGroups tabs groups = 
-          let 
-              defaultGroup = groups # (A.head >>> maybe (GroupId 0) (unwrap >>> _.groupId))
-          in
-              tabs # traverse \tab@(Tab t) -> (getTabValue t.id "groupId" :: Aff (Maybe GroupId)) >>= 
-                case _ of 
-                     Nothing -> pure (TabWithGroup tab defaultGroup)
-                     Just gid -> pure $ TabWithGroup tab gid
-
-
-
-manageSidebar :: StateRef -> WindowId -> Runtime.Port -> SidebarEvent -> Effect Unit
-manageSidebar ref winId port = case _ of
-
-  SbDeleteTab tabId -> launchAff_ $ BT.browserRemoveOne tabId
-
-  SbActivateTab tabId -> launchAff_ $ BT.browserActivateTab tabId
-
-  SbMoveTab tabId newIndex -> BT.browserMoveTab tabId { index: newIndex }
-
-  SbCreateTab tid' -> case tid' of
-    Nothing -> BT.browserCreateTab { windowId: winId }
-    Just tid ->
-      Ref.read ref <#> view (GS._positions >>> GS._windowIdToWindow winId)
-        >>= \positions -> case A.elemIndex tid positions of
-            Nothing -> BT.browserCreateTab { windowId: winId }
-            Just idx -> BT.browserCreateTab { windowId: winId, index: idx + 1 }
-
-  SbSelectedGroup tabIds -> do
-     state <- Ref.read ref
-     let 
-         allTabIds = M.keys $ view ((GS._windowIdToWindow winId) <<< GS._tabs) state
-         tabIdsToHide = A.fromFoldable $ Set.difference allTabIds (Set.fromFoldable tabIds)
-
-     BT.browserHideTabs tabIdsToHide
-     BT.browserShowTabs tabIds
-
-  SbDeletedGroup gid tabIds -> launchAff_ do
-     BT.browserRemove tabIds
-     activeTab <- BT.browserQuery { windowId: unwrap winId, active: true }
-     let activeTabId = activeTab # A.head >>> (<$>) (unwrap >>> _.id)
-     liftEffect $ Runtime.postMessageJson port $ BgGroupDeleted gid activeTabId
-     updateGroupsMapping winId $ deleteGroup gid
-
-  SbChangeTabGroup tid Nothing -> launchAff_ $ removeTabValue tid "groupId"
-  SbChangeTabGroup tid (Just gid) -> launchAff_ do
-    liftEffect $ log $ "[bg] moving tab " <> (show tid) <> " to group " <> (show gid) 
-    setTabValue tid "groupId" gid
-
-  SbCreatedGroup gid name -> launchAff_ do
-     liftEffect $ log $ "[bg] creating group " <> name <> " [" <> (show gid) <> "]"
-     updateGroupsMapping winId $ createGroup gid name
-  SbRenamedGroup gid name -> launchAff_ do
-     liftEffect $ log $ "[bg] renaming group to " <> name <> " [" <> (show gid) <> "]"
-     updateGroupsMapping winId $ renameGroup gid name
-  SbMovedGroup gid pos -> launchAff_ $ updateGroupsMapping winId $ moveGroup gid pos
-
-  SbDetacheTab -> pure unit
-  SbHasWindowId winId' -> pure unit
-
-
-onDisconnect :: forall a. StateRef -> WindowId -> Listener a -> Effect Unit
-onDisconnect stateRef winId listener = Ref.modify_ (set (GS._windows <<< (at winId) <<< _Just <<< GS._port) Nothing) stateRef
+  

src/Browser/Dom/Element.js

@@ -1,11 +0,0 @@
-"use strict";
-
-
-exports["scrollIntoView"] = function(elem) {
-  return function() {
-    elem.scrollIntoView({
-      behavior: "smooth",
-      block: "nearest"
-    });
-  };
-};

src/Browser/Dom/Element.purs

@@ -1,11 +0,0 @@
-module PureTabs.Browser.Dom.Element (scrollIntoView) where
-
-import Prelude
-
-import Effect (Effect)
-import Web.DOM.Element (Element)
-
-
-
-foreign import scrollIntoView :: Element -> Effect Unit
-

src/Browser/Runtime.js

@@ -1,57 +0,0 @@
-"use strict";
-
-
-exports.connect = function () {
-    return browser.runtime.connect();
-}
-
-exports.postMessage = function (port) {
-  return function (message) {
-    return function () {
-      port.postMessage(message);
-    }
-  }
-}
-
-exports.onConnectAddListener = function (fn) {
-  return function () {
-    return browser.runtime.onConnect.addListener(fn)
-  }
-}
-
-exports.portOnDisconnect = function(port) {
-  return function (fn) {
-    return function () {
-      return port.onDisconnect.addListener(fn)
-    }
-  }
-}
-
-exports.onMessageAddListener = function (port) {
-  return function (fn) {
-    return function () {
-      return port.onMessage.addListener(fn);
-    }
-  }
-}
-
-exports.onMessageRemoveListener = function (port) {
-  return function (fn) {
-    return function () {
-      return port.onMessage.removeListener(fn);
-    }
-  }
-}
-
-exports.portEquality = function (p1) {
-  return function (p2) {
-    return p1 === p2
-  }
-}
-
-
-exports.portHasError = function(port) {
-  return function () {
-    return port.error != null;
-  };
-};

src/Browser/Runtime.purs

@@ -1,63 +0,0 @@
-module Browser.Runtime (
-  Port,
-  connect,
-  onConnectAddListener,
-  portOnDisconnect,
-  postMessage,
-  postMessageJson,
-  onMessageAddListener,
-  onMessageJsonAddListener,
-  onMessageRemoveListener,
-  portHasError
-) where
-
-import Browser.Utils (mkListenerOne, Listener, UnregisteredListener)
-import Control.Alt (map)
-import Control.Monad.Except (runExcept)
-import Data.Array (intercalate)
-import Data.Either (Either(..))
-import Data.Eq (class Eq)
-import Data.Generic.Rep (class Generic)
-import Data.Monoid ((<>))
-import Effect (Effect)
-import Effect.Console (error)
-import Foreign (renderForeignError)
-import Foreign.Generic (class GenericEncode, class GenericDecode, defaultOptions, genericEncodeJSON, genericDecodeJSON)
-import Prelude (Unit, ($), bind, discard, pure)
-  
-foreign import data Port :: Type
-
-foreign import portEquality :: Port -> Port -> Boolean
-
-instance eqPort :: Eq Port where
-  eq = portEquality
-
-foreign import connect :: Effect Port
-
-foreign import onConnectAddListener :: Listener Port -> Effect Unit
-
-foreign import postMessage :: forall a. Port -> a -> Effect Unit
-
-postMessageJson :: forall a rep. Generic a rep => GenericEncode rep => Port -> a -> Effect Unit
-postMessageJson port d = postMessage port $ genericEncodeJSON (defaultOptions { unwrapSingleConstructors = true}) d
-
-foreign import portOnDisconnect :: Port -> Listener Unit -> Effect Unit
-
-foreign import onMessageAddListener :: forall a. Port -> Listener a -> Effect Unit
-
-foreign import portHasError :: Port -> Effect Boolean
-
-onMessageJsonAddListener :: forall a rep. Generic a rep => GenericDecode rep => Port -> UnregisteredListener a -> Effect (Listener String)
-onMessageJsonAddListener port f = do 
-  jsonLst <- mkListenerOne listener
-  onMessageAddListener port jsonLst
-  pure jsonLst
-
-  where
-        listener msg = case runExcept (genericDecodeJSON (defaultOptions { unwrapSingleConstructors = true}) msg :: _ a) of 
-                 Left err -> do 
-                    error $ "error while trying to parse message: " <> intercalate ", " (map renderForeignError err)
-                    error $ "message was " <> msg
-                 Right d -> f d
-
-foreign import onMessageRemoveListener :: forall a. Port -> Listener a -> Effect Unit

src/Browser/Sessions.js

@@ -1,30 +0,0 @@
-"use strict";
-
-
-exports["setTabValueImpl"] = function(tabId, key, value) {
-  return browser.sessions.setTabValue(tabId, key, value);
-};
-
-exports["removeTabValueImpl"] = function(tabId, key) {
-  return browser.sessions.removeTabValue(tabId, key);
-};
-
-exports["getTabValueImpl"] = function(Just, Nothing, tabId, key) {
-    return browser.sessions.getTabValue(tabId, key).then(val => {
-      if (val === undefined) return Nothing;
-      else return Just(val);
-    });
-};
-
-
-exports["setWindowValueImpl"] = function(windowId, key, value) {
-  return browser.sessions.setWindowValue(windowId, key, value);
-};
-
-exports["removeWindowValueImpl"] = function(windowId, key) {
-  return browser.sessions.removeWindowValue(windowId, key);
-};
-
-exports["getWindowValueImpl"] = function(windowId, key) {
-  return browser.sessions.getWindowValue(windowId, key);
-};

src/Browser/Sessions.purs

@@ -1,104 +0,0 @@
-module PureTabs.Browser.Sessions where
-
-import Prelude
-
-import Browser.Tabs (TabId(..), WindowId(..))
-import Control.Monad.Error.Class (throwError, try)
-import Control.Monad.Except (runExcept)
-import Control.Promise (Promise, toAffE)
-import Data.Either (Either(..), hush)
-import Data.Foldable (intercalate)
-import Data.Generic.Rep (class Generic)
-import Data.Maybe (Maybe(..))
-import Effect.Aff (Aff)
-import Effect.Class.Console as Log
-import Effect.Exception (error)
-import Effect.Uncurried (EffectFn2, EffectFn3, EffectFn4, runEffectFn2, runEffectFn3, runEffectFn4)
-import Foreign (renderForeignError)
-import Foreign.Generic (class GenericDecode, defaultOptions, genericDecode)
-
-foreign import setTabValueImpl 
-  :: forall r. EffectFn3 Number String r (Promise Unit)
-
-setTabValue 
-  :: forall r
-   . TabId
-  -> String
-  -> r
-  -> Aff Unit
-setTabValue (TabId tid) key value = toAffE $ runEffectFn3 setTabValueImpl tid key value
-
-foreign import removeTabValueImpl
-  :: EffectFn2 Number String (Promise Unit)
-
-removeTabValue
-  :: TabId
-  -> String
-  -> Aff Unit
-removeTabValue (TabId tid) key = toAffE $ runEffectFn2 removeTabValueImpl tid key
-
-foreign import getTabValueImpl
-  :: forall r. EffectFn4 (r -> Maybe r) (Maybe r) Number String (Promise (Maybe r))
-
-getTabValue
-  :: forall r
-   . TabId
-  -> String
-  -> Aff (Maybe r)
-getTabValue (TabId tid) key = toAffE $ runEffectFn4 getTabValueImpl Just Nothing tid key
-
-
-foreign import setWindowValueImpl 
-  :: forall r. EffectFn3 Number String r (Promise Unit)
-
---
-setWindowValue 
-  :: forall r
-   . WindowId
-  -> String
-  -> r
-  -> Aff Unit
-setWindowValue (WindowId winId) key value = toAffE $ runEffectFn3 setWindowValueImpl winId key value
-
-foreign import removeWindowValueImpl
-  :: EffectFn2 Number String (Promise Unit)
-
-removeWindowValue
-  :: WindowId
-  -> String
-  -> Aff Unit
-removeWindowValue (WindowId winId) key = toAffE $ runEffectFn2 removeWindowValueImpl winId key
-
-foreign import getWindowValueImpl :: forall r. EffectFn2 Number String (Promise r)
-
-getWindowValue'
-  :: forall r rep
-   . Generic r rep
-  => GenericDecode rep
-  => WindowId
-  -> String
-  -> Aff r
-getWindowValue' (WindowId winId) key = do 
-  content <- toAffE $ runEffectFn2 getWindowValueImpl winId key
-  case runExcept (genericDecode (defaultOptions { unwrapSingleConstructors = true}) content :: _ r) of
-       Left err -> do 
-          Log.error $ "error while trying to getWindowValue of " <> key <> ": " <> intercalate ", " (map renderForeignError err)
-          throwError $ error "couldn't decode msg"
-       Right resp -> pure resp
-
-getWindowValue
-  :: forall r rep
-   . Generic r rep
-  => GenericDecode rep
-  => WindowId
-  -> String
-  -> Aff (Maybe r)
-getWindowValue winId key = hush <$> (try $ getWindowValue' winId key)

src/Browser/Storage.js

@@ -1,11 +0,0 @@
-"use strict";
-
-exports["storageLocalGetImpl"] = function(key) {
-  return browser.storage.local.get(key).then(obj => {
-    return obj[key];
-  });
-}
-
-exports["storageLocalSetImpl"] = function(key, value) {
-  return browser.storage.local.set({[key]: value});
-}

src/Browser/Storage.purs

@@ -1,42 +0,0 @@
-module PureTabs.Browser.Storage (storageLocalGet, storageLocalSet) where
-
-import Prelude
-
-import Browser.Utils (unsafeLog)
-import Control.Monad.Error.Class (try)
-import Control.Monad.Except (runExcept)
-import Control.Promise (Promise, toAffE)
-import Data.Either (Either(..), hush)
-import Data.Foldable (intercalate)
-import Data.Generic.Rep (class Generic)
-import Data.Maybe (Maybe)
-import Effect.Aff (Aff, throwError)
-import Effect.Aff.Compat (EffectFn1, runEffectFn1)
-import Effect.Class (liftEffect)
-import Effect.Class.Console (error) as Log
-import Effect.Class.Console (log)
-import Effect.Exception (error)
-import Effect.Uncurried (EffectFn2, runEffectFn2)
-import Foreign (Foreign, renderForeignError)
-import Foreign.Generic (class GenericDecode, defaultOptions, genericDecode)
-
-foreign import storageLocalGetImpl :: EffectFn1 String  (Promise Foreign)
-
-storageLocalGet' :: forall r rep. Generic r rep => GenericDecode rep => String -> Aff r
-storageLocalGet' keys = do 
-  msg <- toAffE $ runEffectFn1 storageLocalGetImpl keys
-  case runExcept (genericDecode (defaultOptions { unwrapSingleConstructors = true}) msg :: _ r) of
-       Left err -> do 
-          Log.error $ "error while trying to parse message: " <> intercalate ", " (map renderForeignError err)
-          throwError $ error "couldn't decode msg"
-       Right resp -> pure resp
-
-storageLocalGet :: forall r rep. Generic r rep => GenericDecode rep => String -> Aff (Maybe r)
-storageLocalGet key = hush <$> (try $ storageLocalGet' key)
-
-foreign import storageLocalSetImpl
-  :: forall r. EffectFn2 String r (Promise Unit)
-
-storageLocalSet :: forall r. String -> r -> Aff Unit
-storageLocalSet key value = toAffE $ runEffectFn2 storageLocalSetImpl key value

src/Browser/Tabs.js

@@ -1,51 +0,0 @@
-"use strict";
-
-exports.queryImpl = function (query) {
-  return function () {
-    return browser.tabs.query(query);
-  };
-};
-
-exports["browserRemove'"] = function (tabs) {
-  return function () {
-    return browser.tabs.remove(tabs);
-  };
-};
-
-exports["browserUpdate'"] = function () {
-  return function (updateProperties) {
-    return function (tabId) {
-      return function () {
-        return browser.tabs.update(tabId, updateProperties);
-      };
-    };
-  };
-};
-
-exports["browserMoveTab"] = function (tabIds) {
-  return function (moveProperties) {
-    return function () {
-      return browser.tabs.move(tabIds, moveProperties);
-    };
-  };
-};
-
-exports["browserCreateTab"] = function (union) {
-  return function (createProperties) {
-    return function () {
-      return browser.tabs.create(createProperties);
-    };
-  };
-};
-
-exports["browserHideTabs"] = function (tabIds) {
-  return function () {
-    return browser.tabs.hide(tabIds);
-  }
-}
-
-exports["browserShowTabs"] = function (tabIds) {
-  return function () {
-    return browser.tabs.show(tabIds);
-  }
-}

src/Browser/Tabs.purs

@@ -1,220 +0,0 @@
-module Browser.Tabs (
-  WindowId(..)
-  , TabId(..)
-  , Tab(..)
-  , MoveProperties
-  , CreateProperties
-  , browserQuery
-  , browserRemove
-  , browserRemoveOne
-  , browserUpdate
-  , browserActivateTab
-  , browserMoveTab
-  , browserCreateTab
-  , browserHideTabs
-  , browserShowTabs
-  , showTabId
-  ) where
-
-import Browser.Utils (unwrapForeign)
-import Control.Alt (map)
-import Control.Promise (Promise, toAffE)
-import Data.Eq (class Eq)
-import Data.Function (($))
-import Data.Generic.Rep (class Generic)
-import Data.Generic.Rep.Show (genericShow)
-import Data.Maybe (Maybe)
-import Data.Newtype (class Newtype)
-import Data.Number.Format (toString)
-import Data.Ord (class Ord)
-import Data.Show (class Show, show)
-import Data.Traversable (traverse)
-import Data.Unit (Unit)
-import Effect (Effect)
-import Effect.Aff (Aff)
-import Effect.Class (liftEffect)
-import Foreign (Foreign)
-import Foreign.Class (class Decode, class Encode)
-import Foreign.Generic (defaultOptions, genericDecode, genericEncode)
-import Prelude (bind, pure)
-import Prim.Row (class Union)
-
-newtype WindowId
-  = WindowId Number
-
-derive instance newtypeWindowId :: Newtype WindowId _
-
-derive instance eqWindowId :: Eq WindowId
-
-derive instance ordWindowId :: Ord WindowId
-
-instance showWindowId :: Show WindowId where
-  show (WindowId wid) = toString wid
-
-derive instance genWindowId :: Generic WindowId _
-
-instance encodeWindowId :: Encode WindowId where
-  encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x
-
-instance decodeWindowId :: Decode WindowId where
-  decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
-
-newtype TabId
-  = TabId Number
-
-derive instance eqTabId :: Eq TabId
-
-derive instance ordTabId :: Ord TabId
-
-instance showTabIdInstance :: Show TabId where
-  show (TabId wid) = toString wid
-
-derive instance genTabId :: Generic TabId _
-
-instance encodeTabId :: Encode TabId where
-  encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x
-
-instance decodeTabId :: Decode TabId where
-  decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
-
-newtype Tab
-  = Tab
-  { active :: Boolean
-  , attention :: Maybe Boolean
-  , audible :: Maybe Boolean
-  , autoDiscardable :: Maybe Boolean
-  , cookieStoreId :: Maybe String
-  , discarded :: Maybe Boolean
-  , favIconUrl :: Maybe String
-  , height :: Maybe Number
-  , hidden :: Boolean
-  , highlighted :: Boolean
-  -- should be optional
-  , id :: TabId
-  , incognito :: Boolean
-  , index :: Int
-  , isArticle :: Maybe Boolean
-  , isInReaderMode :: Boolean
-  , lastAccessed :: Number
-  , openerTabId :: Maybe TabId
-  , pinned :: Boolean
-  , sessionId :: Maybe String
-  , status :: Maybe String
-  -- create an enum for that successorTabId :: Maybe Number
-  , title :: String
-  , url :: Maybe String
-  , width :: Maybe Number
-  , windowId :: WindowId
-  }
-
-derive instance newtypeTab :: Newtype Tab _
-
-derive instance genTab :: Generic Tab _
-
-instance showTab :: Show Tab where
-  show = genericShow
-
-showTabId :: Tab -> String
-showTabId (Tab t) = show t.id
-
-instance encodeTab :: Encode Tab where
-  encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x
-
-instance decodeTab :: Decode Tab where
-  decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
-
-
-type QueryRecord = 
-  ( active :: Boolean
-  , audible :: Boolean
-  , autoDiscardable :: Boolean
-  , cookieStoreId :: String
-  , currentWindow :: Boolean
-  , discarded :: Boolean
-  , hidden :: Boolean
-  , highlighted :: Boolean
-  , index :: Int
-  , muted :: Boolean
-  , lastFocusedWindow :: Boolean
-  , pinned :: Boolean
-  , title :: String
-  , url :: String
-  , windowId :: Number
-  )
-
-foreign import queryImpl 
-  :: forall r
-   . { | r }
-  -> Effect (Promise (Array Foreign))
-
-browserQuery 
-  :: forall r r2
-   . Union r r2 QueryRecord
-  => Record r
-  -> Aff (Array Tab)
-browserQuery query = do
-  tabsArray <- toAffE $ queryImpl query
-  parsed <- liftEffect $ traverse unwrapForeign tabsArray
-  pure parsed
-
-foreign import browserRemove' :: (Array Number) -> Effect (Promise Unit)
-
-browserRemove :: (Array TabId) -> Aff Unit
-browserRemove tabs =
-  let
-    tabIdsArray = map unwrap tabs
-  in
-    toAffE $ browserRemove' tabIdsArray
-  where
-  unwrap (TabId n) = n
-
-browserRemoveOne :: TabId -> Aff Unit
-browserRemoveOne tabId = browserRemove [tabId]
-
-type RowUpdateProperties
-  = ( active :: Boolean
-    , autoDiscardable :: Boolean
-    , highlighted :: Boolean
-    , loadReplace :: Boolean
-    , muted :: Boolean
-    , openerTabId :: TabId
-    , pinned :: Boolean
-    , successorTabId :: TabId
-    , url :: String
-    )
-
-foreign import browserUpdate' :: forall given trash. Union given trash RowUpdateProperties => { | given } -> TabId -> Effect (Promise Tab)
-
-browserUpdate :: forall prop b. Union prop b RowUpdateProperties => { | prop } -> TabId -> Aff Tab
-browserUpdate props tabId = toAffE $ browserUpdate' props tabId
-
-
-browserActivateTab :: TabId -> Aff Tab
-browserActivateTab tabId = browserUpdate { active: true } tabId
-
-type MoveProperties = {
-  -- windowId :: Maybe WindowId
-  index :: Int
-}
-
-foreign import browserMoveTab :: TabId -> MoveProperties -> Effect Unit
-
-
-type CreateProperties = (
-  active :: Boolean,
-  cookieStoreId :: String,
-  discarded :: Boolean,
-  index :: Int,
-  openerTabId :: TabId,
-  openInReaderMode :: Boolean,
-  pinned :: Boolean,
-  title :: String,
-  url :: String,
-  windowId :: WindowId
-)
-
-foreign import browserCreateTab :: forall props trash. Union props trash CreateProperties => { | props } -> Effect Unit
-
-foreign import browserHideTabs :: Array TabId -> Effect Unit
-
-foreign import browserShowTabs :: Array TabId -> Effect Unit

src/Browser/Tabs/OnActivated.js

@@ -1,13 +0,0 @@
-"use strict";
-
-exports["addListener'"] = function (listener) {
-  return function() {
-    return browser.tabs.onActivated.addListener(listener);
-  };
-};
-
-exports["removeListener"] = function (listener) {
-  return function() {
-    return browser.tabs.onActivated.removeListener(listener);
-  };
-};

src/Browser/Tabs/OnActivated.purs

@@ -1,46 +0,0 @@
-module Browser.Tabs.OnActivated (addListener, removeListener, ActiveInfo(..)) where
-
-import Browser.Tabs (TabId, WindowId)
-import Browser.Utils (Listener, UnregisteredListener, unwrapForeign, mkListenerOne)
-import Control.Bind ((>=>))
-import Data.Function (($))
-import Data.Generic.Rep (class Generic)
-import Data.Generic.Rep.Show (genericShow)
-import Data.Maybe (Maybe)
-import Data.Newtype (class Newtype)
-import Data.Show (class Show)
-import Data.Unit (Unit)
-import Effect (Effect)
-import Foreign (Foreign)
-import Foreign.Class (class Decode, class Encode)
-import Foreign.Generic (defaultOptions, genericDecode, genericEncode)
-import Prelude (bind)
-
-newtype ActiveInfo
-  = ActiveInfo
-  { previousTabId :: Maybe TabId
-  , tabId :: TabId
-  , windowId :: WindowId
-  }
-
-derive instance newtypeActiveInfo :: Newtype ActiveInfo _
-
-derive instance genActiveInfo :: Generic ActiveInfo _
-
-instance showActiveInfo :: Show ActiveInfo where
-  show = genericShow
-
-instance encodeActiveInfo :: Encode ActiveInfo where
-  encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x
-
-instance decodeActiveInfo :: Decode ActiveInfo where
-  decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
-
-foreign import addListener' :: (Listener Foreign) -> Effect Unit
-
-addListener :: (UnregisteredListener ActiveInfo) -> Effect Unit
-addListener listener = do
-  lst <- mkListenerOne $ unwrapForeign >=> listener
-  addListener' lst
-
-foreign import removeListener :: (Listener ActiveInfo) -> Effect Unit

src/Browser/Tabs/OnAttached.js

@@ -1,13 +0,0 @@
-"use strict";
-
-exports["addListener"] = function (lst) {
-  return function () {
-    return browser.tabs.onAttached.addListener(lst);
-  };
-};
-
-exports["removeListener"] = function (lst) {
-  return function () {
-    return browser.tabs.onAttached.removeListener(lst);
-  };
-};

src/Browser/Tabs/OnAttached.purs

@@ -1,14 +0,0 @@
-module Browser.Tabs.OnAttached where
-
-import Browser.Tabs (TabId, WindowId)
-import Browser.Utils (Listener2)
-import Data.Unit (Unit)
-import Effect (Effect)
-
-type AttachInfo = {
-  newWindowId :: WindowId,
-  newPosition :: Int
-}
-
-foreign import addListener :: (Listener2 TabId AttachInfo) -> Effect Unit
-foreign import removeListener :: (Listener2 TabId AttachInfo) -> Effect Unit

src/Browser/Tabs/OnCreated.js

@@ -1,13 +0,0 @@
-"use stricts";
-
-exports.addListenerImpl = function (listener) {
-  return function () {
-    browser.tabs.onCreated.addListener(listener);
-  }
-}
-
-exports.removeListener = function (listener) {
-  return function () {
-    return browser.tabs.onCreated.removeListener(listener);
-  }
-}

src/Browser/Tabs/OnCreated.purs

@@ -1,17 +0,0 @@
-module Browser.Tabs.OnCreated (addListener, removeListener) where
-
-import Browser.Tabs (Tab)
-import Browser.Utils (Listener, UnregisteredListener, mkListenerOne, unwrapForeign)
-import Control.Bind ((>=>))
-import Effect (Effect)
-import Foreign (Foreign)
-import Prelude (Unit, bind, ($))
-
-foreign import addListenerImpl :: (Listener Foreign) -> Effect Unit
-
-addListener :: (UnregisteredListener Tab) -> Effect Unit
-addListener listener = do
-  lst <- mkListenerOne $ unwrapForeign >=> listener
-  addListenerImpl lst
-
-foreign import removeListener :: (Listener Tab) -> Effect Unit

src/Browser/Tabs/OnDetached.js

@@ -1,13 +0,0 @@
-"use strict";
-
-exports["addListener"] = function (lst) {
-  return function () {
-    return browser.tabs.onDetached.addListener(lst);
-  };
-};
-
-exports["removeListener"] = function (lst) {
-  return function () {
-    return browser.tabs.onDetached.removeListener(lst);
-  };
-};

src/Browser/Tabs/OnDetached.purs

@@ -1,14 +0,0 @@
-module Browser.Tabs.OnDetached where
-
-import Browser.Tabs (TabId, WindowId)
-import Browser.Utils (Listener2)
-import Data.Unit (Unit)
-import Effect (Effect)
-
-type DetachInfo = {
-  oldWindowId :: WindowId,
-  oldPosition :: Int
-}
-
-foreign import addListener :: (Listener2 TabId DetachInfo) -> Effect Unit
-foreign import removeListener :: (Listener2 TabId DetachInfo) -> Effect Unit

src/Browser/Tabs/OnMoved.js

@@ -1,15 +0,0 @@
-"use strict";
-
-exports["addListener"] = function (listener) {
-  return function () {
-    return browser.tabs.onMoved.addListener(listener);
-  };
-};
-
-exports["removeListener"] = function (listener) {
-  return function() {
-    return browser.tabs.onMoved.removeListener(listener);
-  };
-};
-
-

src/Browser/Tabs/OnMoved.purs

@@ -1,16 +0,0 @@
-module Browser.Tabs.OnMoved (addListener, removeListener, MoveInfo) where
-
-import Browser.Tabs (TabId, WindowId)
-import Browser.Utils (Listener2)
-import Data.Unit (Unit)
-import Effect (Effect)
-
-type MoveInfo
-  = { windowId :: WindowId
-    , fromIndex :: Int
-    , toIndex :: Int
-    }
-
-foreign import addListener :: (Listener2 TabId MoveInfo) -> Effect Unit
-
-foreign import removeListener :: (Listener2 TabId MoveInfo) -> Effect Unit

src/Browser/Tabs/OnRemoved.js

@@ -1,13 +0,0 @@
-"use stricts";
-
-exports.addListener = function (listener) {
-  return function () {
-    browser.tabs.onRemoved.addListener(listener);
-  }
-}
-
-exports.removeListener = function (listener) {
-  return function () {
-    return browser.tabs.onRemoved.removeListener(listener);
-  }
-}

src/Browser/Tabs/OnRemoved.purs

@@ -1,15 +0,0 @@
-module Browser.Tabs.OnRemoved (RemoveInfo, addListener, removeListener) where
-
-import Prelude (Unit)
-import Effect (Effect)
-import Browser.Tabs (WindowId, TabId)
-import Browser.Utils (Listener2)
-
-type RemoveInfo = {
-  windowId :: WindowId,
-  isWindowClosing :: Boolean
-}
-
-foreign import addListener :: (Listener2 TabId RemoveInfo) -> Effect Unit
-
-foreign import removeListener :: (Listener2 TabId RemoveInfo) -> Effect Unit

src/Browser/Tabs/OnUpdated.js

@@ -1,13 +0,0 @@
-"use strict";
-
-exports["addListener'"] = function (listener) {
-  return function() {
-    return browser.tabs.onUpdated.addListener(listener, {});
-  };
-};
-
-exports["removeListener'"] = function (listener) {
-  return function() {
-    return browser.tabs.onUpdated.removeListener(listener);
-  };
-};

src/Browser/Tabs/OnUpdated.purs

@@ -1,62 +0,0 @@
-module Browser.Tabs.OnUpdated where
-
-import Browser.Tabs (Tab, TabId)
-import Browser.Utils (Listener3, UnregisteredListener3, mkListenerThree, unwrapForeign)
-import Control.Alternative (pure)
-import Control.Bind ((>>=))
-import Data.Generic.Rep (class Generic)
-import Data.Generic.Rep.Show (genericShow)
-import Data.Maybe (Maybe)
-import Data.Newtype (class Newtype)
-import Data.Show (class Show)
-import Data.Tuple.Nested (Tuple3, tuple3, uncurry3)
-import Effect (Effect)
-import Foreign (Foreign)
-import Foreign.Class (class Decode, class Encode)
-import Foreign.Generic (defaultOptions, genericDecode, genericEncode)
-import Prelude (Unit, bind, ($))
-
-type ChangeInfoRec
-  = { attention :: Maybe Boolean
-    , audible :: Maybe Boolean
-    , discarded :: Maybe Boolean
-    , favIconUrl :: Maybe String
-    , hidden :: Maybe Boolean
-    , isArticle :: Maybe Boolean
-    -- mutedInfo :: Maybe MutedInfo,
-    , pinned :: Maybe Boolean
-    , status :: Maybe String
-    , title :: Maybe String
-    , url :: Maybe String
-    }
-
-newtype ChangeInfo
-  = ChangeInfo ChangeInfoRec
-
-derive instance newtypeChangeInfo :: Newtype ChangeInfo _
-
-derive instance genChangeInfo :: Generic ChangeInfo _
-
-instance showChangeInfo :: Show ChangeInfo where
-  show = genericShow
-
-instance encodeChangeInfo :: Encode ChangeInfo where
-  encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x
-
-instance decodeChangeInfo :: Decode ChangeInfo where
-  decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
-
-foreign import addListener' :: (Listener3 TabId Foreign Foreign) -> Effect Unit
-
-foreign import removeListener' :: (Listener3 TabId Foreign Foreign) -> Effect Unit
-
-addListener :: (UnregisteredListener3 TabId ChangeInfo Tab) -> Effect Unit
-addListener listener = do
-  lst' <- mkListenerThree \tid cinfo tab -> (lst tid cinfo tab) >>= uncurry3 listener
-  addListener' lst'
-
-lst :: TabId -> Foreign -> Foreign -> Effect (Tuple3 TabId ChangeInfo Tab)
-lst tid changeInfo tab = do
-  cinfo <- unwrapForeign changeInfo
-  t <- unwrapForeign tab
-  pure $ tuple3 tid cinfo t

src/Browser/Utils.js

@@ -1,46 +0,0 @@
-"use stricts";
-
-
-exports.mkListenerUnit = function (fn) {
-  return function () {
-    return function () {
-      return fn();
-    }
-  }
-};
-
-exports.mkListenerOne = function (fn) {
-  return function () {
-    return function (one) {
-      return fn(one)();
-    }
-  }
-};
-
-exports.mkListenerTwo = function (fn) {
-  return function () {
-    return function (one, two) {
-        return fn(one)(two)();
-    }
-  }
-};
-
-exports.mkListenerThree = function (fn) {
-  return function () {
-    return function (one, two, three) {
-        return fn(one)(two)(three)();
-    }
-  }
-};
-
-exports["unsafeLog'"] = function (data) {
-  console.log(">> this is unsafe:");
-  console.log(data);
-  return data;
-};
-
-exports["unsafeLog"] = function (data) {
-  return function() {
-    exports["unsafeLog'"](data);
-  };
-};

src/Browser/Utils.purs

@@ -1,82 +0,0 @@
-module Browser.Utils
-  ( UnregisteredListener
-  , UnregisteredListener2
-  , UnregisteredListener3
-  , Listener
-  , Listener2
-  , Listener3
-  , mkListenerUnit
-  , mkListenerOne
-  , mkListenerTwo
-  , mkListenerThree
-  , unwrapForeign
-  , unsafeLog
-  , unsafeLog'
-  , eqBy
-  , sortByKeyIndex
-  ) where
-
-import Control.Alt (map)
-import Control.Alternative (pure)
-import Control.Monad.Except (runExcept)
-import Data.Array as A
-import Data.Either (Either(..))
-import Data.Eq (class Eq, (==))
-import Data.Foldable (fold)
-import Data.Function (($))
-import Data.Generic.Rep (class Generic)
-import Data.Ord (class Ord)
-import Data.Tuple as T
-import Effect (Effect)
-import Effect.Exception (throw)
-import Foreign (Foreign, renderForeignError)
-import Foreign.Generic (class GenericDecode, defaultOptions, genericDecode)
-import Prelude (Unit, comparing, (>>>))
-
-type UnregisteredListener a
-  = (a -> Effect Unit)
-
-type UnregisteredListener2 a b
-  = (a -> b -> Effect Unit)
-
-type UnregisteredListener3 a b c
-  = (a -> b -> c -> Effect Unit)
-
-newtype Listener a
-  = Listener (UnregisteredListener a)
-
-newtype Listener2 a b
-  = Listener2 (UnregisteredListener2 a b)
-
-newtype Listener3 a b c
-  = Listener3 (UnregisteredListener3 a b c)
-
-foreign import mkListenerUnit :: (Effect Unit) -> Effect (Listener Unit)
-
-foreign import mkListenerOne :: forall a. (UnregisteredListener a) -> Effect (Listener a)
-
-foreign import mkListenerTwo :: forall a b. (UnregisteredListener2 a b) -> Effect (Listener2 a b)
-
-foreign import mkListenerThree :: forall a b c. (UnregisteredListener3 a b c) -> Effect (Listener3 a b c)
-
-unwrapForeign :: forall a rep. Generic a rep => GenericDecode rep => Foreign -> Effect a
-unwrapForeign d = case runExcept
-    $ genericDecode (defaultOptions { unwrapSingleConstructors = true }) d of
-  Left err -> throw $ A.intercalate ", " (map renderForeignError err)
-  Right val -> pure val
-
-foreign import unsafeLog' :: forall a. a
-foreign import unsafeLog :: forall a. a -> Effect Unit
-
-eqBy :: forall a b. Eq b => (a -> b) -> (a -> a -> Boolean)
-eqBy f = \a b -> f a == f b
-
-sortByKeyIndex :: forall a b. Ord b => (a -> b) -> Array a -> Array a
-sortByKeyIndex cmp = A.mapWithIndex T.Tuple >>> A.sortBy compareKey >>> map T.snd
-  where compareGiven = comparing (T.snd >>> cmp)
-        compareIdx = comparing T.fst
-        compareKey = fold [compareGiven, compareIdx]

src/Browser/Windows.js

@@ -1,5 +0,0 @@
-"use strict";
-
-exports.getCurrentImpl = function () {
-  return browser.windows.getCurrent()
-};

src/Browser/Windows.purs

@@ -1,38 +0,0 @@
-module Browser.Windows (Window, getCurrent) where 
-
-import Browser.Tabs (Tab, WindowId)
-import Control.Promise (toAffE, Promise)
-import Effect (Effect)
-import Effect.Aff (Aff)
-
-
-type Window = {
-  alwaysOnTop :: Boolean,
-  focused :: Boolean,
-  -- optional
-  height :: Number,
-  -- optional
-  id :: WindowId,
-  incognito :: Boolean,
-  -- optional
-  left :: Number,
-  -- optional
-  sessionId :: String,
-  -- optional
-  {-- state :: Null --}
-  -- optional
-  tabs :: Array Tab,
-  -- optional
-  title :: String,
-  -- optional
-  top :: Number,
-  -- optional
-  {-- type ::  --}
-  -- optional
-  width :: Number
-}
-
-foreign import getCurrentImpl :: Effect (Promise Window)
-
-getCurrent :: Aff Window
-getCurrent = toAffE getCurrentImpl

src/Browser/Windows/OnCreated.js

@@ -1,15 +0,0 @@
-"use stricts";
-
-exports.addListener = function (listener) {
-  return function () {
-    browser.windows.onCreated.addListener(listener);
-  }
-}
-
-exports.removeListener = function (listener) {
-  return function () {
-    return browser.windows.onCreated.removeListener(listener);
-  }
-}
-
-

src/Browser/Windows/OnCreated.purs

@@ -1,11 +0,0 @@
-module Browser.Windows.OnCreated (addListener, removeListener) where
-
-import Browser.Utils (Listener)
-import Browser.Windows (Window)
-import Data.Unit (Unit)
-import Effect (Effect)
-
-foreign import addListener :: (Listener Window) -> Effect Unit
-
-foreign import removeListener :: (Listener Window) -> Effect Unit
-

src/Browser/Windows/OnRemoved.js

@@ -1,14 +0,0 @@
-"use stricts";
-
-exports.addListener = function (listener) {
-  return function () {
-    browser.windows.onRemoved.addListener(listener);
-  }
-}
-
-exports.removeListener = function (listener) {
-  return function () {
-    return browser.windows.onRemoved.removeListener(listener);
-  }
-}
-

src/Browser/Windows/OnRemoved.purs

@@ -1,10 +0,0 @@
-module Browser.Windows.OnRemoved (addListener, removeListener) where
-
-import Browser.Tabs (WindowId)
-import Browser.Utils (Listener)
-import Data.Unit (Unit)
-import Effect (Effect)
-
-foreign import addListener :: (Listener WindowId) -> Effect Unit
-
-foreign import removeListener :: (Listener WindowId) -> Effect Unit

src/Model/BackgroundEvent.purs

@@ -1,47 +0,0 @@
-module PureTabs.Model.BackgroundEvent where 
-
-import Browser.Tabs (Tab, TabId)
-import Browser.Tabs.OnUpdated (ChangeInfo)
-import Data.Generic.Rep (class Generic)
-import Data.Generic.Rep.Show (genericShow)
-import Data.Maybe (Maybe)
-import Data.Show (class Show)
-import PureTabs.Model.Group (GroupId)
-import PureTabs.Model.GroupMapping (GroupData)
-import PureTabs.Model.TabWithGroup (TabWithGroup)
-
-
-data BackgroundEvent
-  = BgInitialTabList (Array GroupData) (Array TabWithGroup)
-  | BgInitializeGroups (Array GroupData)
-  | BgTabCreated Tab
-
-  -- Initially we were assigning the group from the Sidebar each time a tab is created. The issue is
-  -- that to avoid creating the tab in Aff (see onTabCreated method) we're splitting the action of
-  -- creating a tab and assigning it a group in two different messages. Now the problem comes with
-  -- the asynchronicity of each action:
-  -- - We're first creating a tab with no group assigned.
-  -- - We're then sending a message to update the group of each tab.
-  -- The missing piece in between is that when the Sidebar received the tab creation event, it
-  -- didn't have the tab's group assignation and was assigning a default one. It would then receive
-  -- a message to switch the group, but a message to the background was already sent to update the
-  -- group of the tab to the initial one. So while the state of the current session was correct, at
-  -- the next session the restored tabs would lose their group.
-  --
-  -- Hence this solution: 
-  -- | GroupId of Nothing means we ask the Sidebar to assign the group (by using SbChangeTabGroup).
-  -- | Just GroupId means we tell the Sidebar the group of the tab (i.e. we're restoring a tab).
-  | BgAssignTabToGroup TabId (Maybe GroupId)
-  | BgTabDeleted TabId
-  | BgTabUpdated TabId ChangeInfo Tab
-  | BgTabMoved TabId Int Int
-  | BgTabActivated (Maybe TabId) TabId
-  | BgTabAttached Tab
-  | BgTabDetached TabId
-  | BgGroupDeleted GroupId (Maybe TabId)
-
-derive instance genBackgroundEvent :: Generic BackgroundEvent _
-
-instance showBackgroundEvent :: Show BackgroundEvent where
-  show = genericShow
-

src/Model/GlobalState.purs

@@ -1,324 +0,0 @@
-module PureTabs.Model.GlobalState (
- ExtWindow
-  , GlobalState
-  , _active
-  , _id
-  , _index
-  , _port
-  , _portFromWindow
-  , _portFromWindowId
-  , _positions
-  , _tabFromTabIdAndWindow
-  , _tabFromWindow
-  , _tabId
-  , _tabIndex
-  , _tabs
-  , _tabWindowId
-  , _windowIdToWindow
-  , _windowIdToTabIdToTab
-  , _windows
-  , emptyWindow
-  , initialGlobalState
-  , initialTabsToGlobalState
-  , addEmptyWindow
-  , deleteWindow
-  , createTab
-  , updateTab
-  , activateTab
-  , moveTab
-  , deleteTab
-  , detachTab
-  , attachTab
-  , sendToTabPort
-  , sendToWindowPort
-  , tabFromWinIdAndTabId 
-  , initializeWindowState
-  ) where
-
-import Browser.Runtime (Port, postMessageJson)
-import Browser.Tabs (Tab(..), TabId, WindowId, showTabId)
-import Control.Alt ((<|>))
-import Control.Bind (join, bind, (>>=))
-import Control.Category (identity, (<<<), (>>>))
-import Control.Plus (empty) as A
-import Data.Array (deleteAt, filter, foldl, fromFoldable, insertAt, mapWithIndex, sortBy, groupBy, (!!)) as A
-import Data.Eq ((==), (/=))
-import Data.Function (const, on, ($))
-import Data.Functor (map, (<#>), (<$>))
-import Data.Lens (Lens', Traversal', _Just, over, preview, set, view)
-import Data.Lens.At (at)
-import Data.Lens.Iso.Newtype (_Newtype)
-import Data.Lens.Record (prop)
-import Data.List (head) as L
-import Data.Array.NonEmpty (NonEmptyArray, head) as NEA
-import Data.Map as M
-import Data.Maybe (Maybe(..), fromMaybe, maybe, maybe')
-import Data.Monoid ((<>))
-import Data.Ord (compare)
-import Data.Show (show)
-import Data.Symbol (SProxy(..))
-import Data.Tuple (Tuple(..))
-import Data.Unit (Unit)
-import Effect (Effect)
-import Effect.Console (error)
-import Effect.Exception.Unsafe (unsafeThrow)
-import Prelude ((#))
-import PureTabs.Model.BackgroundEvent (BackgroundEvent)
-
-type GlobalState
-  = { windows :: M.Map WindowId ExtWindow
-    , detached :: Maybe Tab
-    }
-
-initialGlobalState :: GlobalState
-initialGlobalState =
-  { windows: M.empty
-  , detached: Nothing
-  }
-
-type ExtWindow
-  = { positions :: Array TabId
-    , tabs :: M.Map TabId Tab
-    , port :: Maybe Port
-    }
-
-emptyWindow :: ExtWindow
-emptyWindow =
-  { positions: A.empty
-  , tabs: M.empty
-  , port: Nothing
-  }
-
-_tabs :: forall a r. Lens' { tabs :: a | r } a
-_tabs = prop (SProxy :: _ "tabs")
-
-_port :: forall a r. Lens' { port :: a | r } a
-_port = prop (SProxy :: _ "port")
-
-_windows :: forall a r. Lens' { windows :: a | r } a
-_windows = prop (SProxy :: _ "windows")
-
-_title :: forall a r. Lens' { title :: a | r } a
-_title = prop (SProxy :: _ "title")
-
-_tabTitle :: Lens' Tab String
-_tabTitle = _Newtype <<< _title
-
-_index :: forall a r. Lens' { index :: a | r } a
-_index = prop (SProxy :: _ "index")
-
-_tabIndex :: Lens' Tab Int
-_tabIndex = _Newtype <<< _index
-
-_id :: forall a r. Lens' { id :: a | r } a
-_id = prop (SProxy :: _ "id")
-
-_tabId :: Lens' Tab TabId
-_tabId = _Newtype <<< _id
-
-_active :: forall a r. Lens' { active :: a | r } a
-_active = prop (SProxy :: _ "active")
-
-_windowId :: forall a r. Lens' { windowId :: a | r } a
-_windowId = prop (SProxy :: _ "windowId")
-
-_positions :: forall a r. Lens' { positions :: a | r } a
-_positions = prop (SProxy :: _ "positions")
-
-_tabWindowId :: Lens' Tab WindowId
-_tabWindowId = _Newtype <<< _windowId
-
-_portFromWindow :: Tab -> Traversal' GlobalState Port
-_portFromWindow (Tab tab) = _portFromWindowId tab.windowId
-
-_portFromWindowId :: WindowId -> Traversal' GlobalState Port
-_portFromWindowId wid = _windowIdToWindow wid <<< _port <<< _Just
-
-_windowIdToWindow :: WindowId -> Traversal' GlobalState ExtWindow
-_windowIdToWindow wid = _windows <<< (at wid) <<< _Just
-
-_tabFromWindow :: Tab -> Traversal' GlobalState (Maybe Tab)
-_tabFromWindow (Tab tab) = _windowIdToWindow tab.windowId <<< _tabs <<< (at tab.id)
-
-_windowIdToTabIdToTab :: WindowId -> TabId -> Traversal' GlobalState (Maybe Tab)
-_windowIdToTabIdToTab wid tid = _windowIdToWindow wid <<< _tabs <<< (at tid)
-
-tabFromWinIdAndTabId :: WindowId -> TabId -> GlobalState -> Maybe Tab
-tabFromWinIdAndTabId winId tabId = join <<< preview (_windowIdToTabIdToTab winId tabId)
-
-_tabFromTabIdAndWindow :: GlobalState -> TabId -> Maybe Tab
-_tabFromTabIdAndWindow s tabId =
-  let
-    allWindows = M.values s.windows
-
-    allTabs = map (view _tabs) allWindows
-
-    matchingTabId = map (M.lookup tabId) allTabs
-  in
-    join $ L.head matchingTabId
-
-
-sendToTabPort :: Tab -> GlobalState -> BackgroundEvent -> Effect Unit
-sendToTabPort tab state msg =
-  case (preview (_portFromWindow tab) state) of 
-       Just port -> postMessageJson port msg
-       Nothing -> error $ "[bg] no port found for tab id " <> (showTabId tab)
-
-sendToWindowPort :: WindowId -> GlobalState -> BackgroundEvent -> Effect Unit
-sendToWindowPort wid state event =
-  case (preview (_portFromWindowId wid) state) of
-    Just port -> postMessageJson port event
-    Nothing -> error $ "[bg] no port found for window id " <> (show wid)
-
-initialTabsToGlobalState :: Array Tab -> GlobalState
-initialTabsToGlobalState tabs = { windows: windows, detached: Nothing }
-  where
-  groupedTabs = A.groupBy (\(Tab t1) (Tab t2) -> t1.windowId == t2.windowId) tabs
-
-  tabsToWindow :: NEA.NonEmptyArray Tab -> Tuple WindowId ExtWindow
-  tabsToWindow tabs' =
-    let
-      windowId = (\(Tab t) -> t.windowId) $ NEA.head tabs'
-
-      window =
-        { tabs: M.fromFoldable $ tabs' <#> \(Tab t) -> Tuple t.id (Tab t)
-        , port: Nothing
-        , positions: (\(Tab t) -> t.id) <$> A.sortBy (compare `on` \(Tab t) -> t.index) (A.fromFoldable tabs')
-        }
-    in
-      Tuple windowId window
-
-  windows = M.fromFoldable $ (tabsToWindow <$> groupedTabs)
-
-
-addEmptyWindow :: WindowId -> GlobalState -> GlobalState
-addEmptyWindow winId = (over (_windows <<< at winId)) (_ <|> (Just emptyWindow))
-
-deleteWindow :: WindowId -> GlobalState -> GlobalState
-deleteWindow winId state = state { windows = M.delete winId state.windows }
-
-
-createTab :: Tab -> GlobalState -> GlobalState
-createTab (Tab t) s = s { windows = M.update updateWindow t.windowId windows }
-
-  where
-
-  windows = case M.lookup t.windowId s.windows of
-                 Nothing -> M.insert t.windowId emptyWindow s.windows
-                 Just _ -> s.windows
-
-  updateWindow :: ExtWindow -> Maybe ExtWindow
-  updateWindow win =
-    -- this will delete the window if there is an issue with the position..
-    -- not the best solution but we can't really recover from it anyway.
-    (A.insertAt t.index t.id win.positions)
-      <#> \newPos ->
-        win
-        { positions = newPos
-        , tabs = M.insert t.id (Tab t) win.tabs
-        }
-
-
-updateTab :: Tab -> GlobalState -> GlobalState
-updateTab tab = 
-  -- update by replacing the tab only if it already exists
-  (over (_tabFromWindow tab) (map $ const tab))
-  -- or update the currently detached tab
-    >>> ( \s -> case s.detached of
-          Just (Tab tab')
-            | (view _tabId tab) == tab'.id -> s { detached = Just (Tab tab') }
-          _ -> s
-      )
-
-
-moveTab :: Int -> Int -> WindowId -> GlobalState -> GlobalState
-moveTab fromIndex toIndex windowId state = 
-  let 
-      -- Update the state by moving the tab at `fromIndex` to `toIndex`.
-      newState = state # over ((_windowIdToWindow windowId) <<< _positions) unsafeUpdatePositions
-
-      -- Get the new positions for each tab based on the move just done.
-      newPositions = newState # view ((_windowIdToWindow windowId) <<< _positions)
-   in
-     -- Update the new positions for each tab
-     newState # over ((_windowIdToWindow windowId) <<< _tabs) (updateTabsIndex newPositions) 
-
-  where
-    -- | Move an element from `from` to `to` in array `arr`.
-    moveElement :: forall a. Int -> Int -> Array a -> Maybe (Array a)
-    moveElement from to arr = do
-      tab <- arr A.!! from
-      A.deleteAt from arr >>= A.insertAt to tab
-
-    -- | Update the positions tabs
-    unsafeUpdatePositions :: Array TabId -> Array TabId
-    unsafeUpdatePositions =
-      (moveElement fromIndex toIndex)
-      -- The indexes should exist, we need to revisit the code if it doesn't
-      >>> (maybe' (\_ -> unsafeThrow "[bg] invalid indexes during moveTab") identity)
-
-    -- | Update the index of the tab given the positions.
-    -- | This is done by folding over a map of index update function applied to all tabs.
-    updateTabsIndex :: Array TabId -> M.Map TabId Tab -> M.Map TabId Tab
-    updateTabsIndex positions tabs =
-      let
-        modifyFuncs :: Array (M.Map TabId Tab -> M.Map TabId Tab)
-        modifyFuncs = A.mapWithIndex (\idx tid' -> set (at tid' <<< _Just <<< _Newtype <<< _index) idx) positions
-      in
-        A.foldl (#) tabs modifyFuncs
-
-activateTab :: WindowId -> (Maybe TabId) -> TabId -> GlobalState -> GlobalState
-activateTab winId previousTabId newTabId state =
-    let
-      prevTab :: Maybe Tab
-      prevTab = previousTabId >>= \ptid -> join $ preview (_windowIdToTabIdToTab winId ptid) state
-
-      prevTabF :: GlobalState -> GlobalState
-      prevTabF = maybe identity (\t -> set (_activeTab t) false) prevTab
-
-      newTab = join $ preview (_windowIdToTabIdToTab winId newTabId) state
-
-      newTabF :: GlobalState -> GlobalState
-      newTabF = maybe identity (\t -> set (_activeTab t) true) newTab
-
-      _activeTab t = (_tabFromWindow t) <<< _Just <<< _Newtype <<< _active
-    in
-      (prevTabF >>> newTabF) state
-
-
-deleteTab :: WindowId -> TabId -> GlobalState -> GlobalState
-deleteTab winId tabId = 
-  (set (_windowIdToTabIdToTab winId tabId) Nothing)
-    >>> over (_windowIdToWindow winId <<< _positions) (A.filter ((/=) tabId))
-
-
-detachTab :: WindowId -> TabId -> GlobalState -> GlobalState
-detachTab winId tabId state =
-  case preview (_windowIdToTabIdToTab winId tabId) state of
-    Just (Just tab) -> do
-      state # (deleteTab winId tabId) >>> \s -> s { detached = Just tab } 
-    -- XXX: We're losing the information that we couldn't fetch the tab.
-    -- This shouldn't happen, but I don't see how to go around it. We don't
-    -- have a (typed) proof that a given tab exists for a window id and a tab
-    -- id, so let's just assume everything is well behaved.
-    -- The other solution is to first do a read, then a write, and return an
-    -- effect where we can throw.
-    _ -> state
-
-
-attachTab :: WindowId -> TabId -> Int -> GlobalState -> GlobalState
-attachTab winId tabId newPosition state =
-  case state.detached of 
-       Just (Tab tab) -> 
-         let 
-             newTab = Tab (tab { windowId = winId, index = newPosition })
-         in 
-         state # (createTab newTab) >>> (_ { detached = Nothing})
-       _ -> state
-
-
-initializeWindowState :: WindowId -> Port -> GlobalState -> GlobalState
-initializeWindowState winId port = 
-  over (_windows <<< (at winId)) (\win -> Just $ set _port (Just port) (fromMaybe emptyWindow win))

src/Model/Group.purs

@@ -1,24 +0,0 @@
-module PureTabs.Model.Group (GroupId(..)) where
-
-
-import Prelude (class Eq, class Ord, class Show, (<>), show)
-import Data.Generic.Rep (class Generic)
-import Foreign.Class (class Decode, class Encode)
-import Foreign.Generic (defaultOptions, genericDecode, genericEncode)
-
-newtype GroupId
-  = GroupId Int
-
-derive instance eqGroupId :: Eq GroupId
-derive instance ordGroupId :: Ord GroupId
-
-instance showGroupId :: Show GroupId where 
-  show (GroupId gid) = "GroupId(" <> (show gid) <> ")"
-
-derive instance genGroupId :: Generic GroupId _
-
-instance encodeGroupId :: Encode GroupId where
-  encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x
-
-instance decodeGroupId :: Decode GroupId where
-  decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x

src/Model/GroupMapping.purs

@@ -1,80 +0,0 @@
-module PureTabs.Model.GroupMapping where 
-
-
-import Browser.Tabs (WindowId)
-import Data.Array as A
-import Data.Generic.Rep (class Generic)
-import Data.Generic.Rep.Show (genericShow)
-import Data.Maybe (fromMaybe, Maybe(..))
-import Data.Newtype (class Newtype, unwrap)
-import Data.Show (class Show, show)
-import Effect.Aff (Aff)
-import Effect.Class.Console (error)
-import Foreign.Class (class Decode, class Encode)
-import Foreign.Generic (defaultOptions, genericDecode, genericEncode)
-import Prelude (Unit, bind, flip, map, pure, ($), (/=), (<*), (<>), (==), (>>=), (>>>))
-import PureTabs.Browser.Sessions (getWindowValue, setWindowValue)
-import PureTabs.Model.Group (GroupId)
-
-
-newtype GroupData 
-  = GroupData { groupId :: GroupId
-              , name :: String
-              }
-
-derive instance genGroupData :: Generic GroupData _
-derive instance newtypeGroupData :: Newtype GroupData _
-
-instance showGroupData :: Show GroupData where 
-  show = genericShow
-
-instance encodeGroupData :: Encode GroupData where
-  encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x
-
-instance decodeGroupData :: Decode GroupData where
-  decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x
-
-groupData :: GroupId -> String -> GroupData
-groupData gid name = GroupData { groupId: gid, name: name }
-
-newtype SavedGroups = SavedGroups (Array GroupData)
-
-derive instance genSavedGroups :: Generic SavedGroups _
-derive instance newtypeSavedGroups :: Newtype SavedGroups _
-
-retrieveGroups :: WindowId -> Aff (Array GroupData)
-retrieveGroups winId = do 
-  (groups :: (Maybe SavedGroups)) <- getWindowValue winId "groups"
-  case groups of
-       Just (SavedGroups groups') -> pure groups'
-       Nothing -> pure [] <* error ("couldn't get key `groups` for window " <> (show winId))
-
-type GroupsUpdate = (Array GroupData) -> (Array GroupData)
-
-updateGroupsMapping :: WindowId -> GroupsUpdate -> Aff Unit
-updateGroupsMapping winId updateGroups = do
-  groups <- retrieveGroups winId
-  let updatedGroups = updateGroups groups
-  setWindowValue winId "groups" updatedGroups
-
-
-createGroup :: GroupId -> String -> GroupsUpdate
-createGroup gid name = 
-  A.filter (unwrap >>> _.groupId >>> (/=) gid)
-  >>> (flip A.snoc) (groupData gid name)
-
-renameGroup :: GroupId -> String -> GroupsUpdate
-renameGroup gid newName = 
-    map $ case _ of 
-               GroupData { groupId: gid' } | gid == gid' -> groupData gid newName
-               other -> other
-
-moveGroup :: GroupId -> Int -> GroupsUpdate
-moveGroup gid to arr =
-    fromMaybe arr $ do
-      from <- A.findIndex (unwrap >>> _.groupId >>> (==) gid) arr
-      group <- arr A.!! from
-      A.deleteAt from arr >>= A.insertAt to group
-
-deleteGroup :: GroupId -> GroupsUpdate
-deleteGroup gid = A.filter (unwrap >>>_.groupId >>> (/=) gid)

src/Model/SidebarEvent.purs

@@ -1,29 +0,0 @@
-module PureTabs.Model.SidebarEvent where 
-
-import Browser.Tabs (TabId, WindowId)
-import Data.Generic.Rep (class Generic)
-import Data.Generic.Rep.Show (genericShow)
-import Data.Maybe (Maybe)
-import Data.Show (class Show)
-import PureTabs.Model.Group (GroupId)
-
-
-
-data SidebarEvent
-  = SbDeleteTab TabId
-  | SbActivateTab TabId
-  | SbCreateTab (Maybe TabId)
-  | SbMoveTab TabId Int
-  | SbDetacheTab
-  | SbHasWindowId WindowId
-  | SbSelectedGroup (Array TabId)
-  | SbDeletedGroup GroupId (Array TabId)
-  | SbChangeTabGroup TabId (Maybe GroupId)
-  | SbCreatedGroup GroupId String
-  | SbRenamedGroup GroupId String
-  | SbMovedGroup GroupId Int
-
-derive instance genSidebarEvent :: Generic SidebarEvent _
-
-instance showSidebarEvent :: Show SidebarEvent where
-  show = genericShow

src/Model/TabWithGroup.purs

@@ -1,23 +0,0 @@
-module PureTabs.Model.TabWithGroup where
-
-import Browser.Tabs (Tab)
-import Data.Generic.Rep (class Generic)
-import Data.Generic.Rep.Show (genericShow)
-import Data.Show (class Show)
-import PureTabs.Model.Group (GroupId)
-import Foreign.Class (class Decode, class Encode)
-import Foreign.Generic (defaultOptions, genericDecode, genericEncode)
-
-data TabWithGroup
-  = TabWithGroup Tab GroupId
-
-derive instance genTabWithGroup :: Generic TabWithGroup _
-
-instance showTabWithGroup :: Show TabWithGroup where 
-  show = genericShow
-
-instance encodeTabWithGroup :: Encode TabWithGroup where
-  encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x
-
-instance decodeTabWithGroup :: Decode TabWithGroup where
-  decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x

src/Sidebar/Components/Bar.purs

@@ -1,549 +0,0 @@
-module PureTabs.Sidebar.Bar where
-
-import Browser.Tabs (Tab(..), TabId)
-import Browser.Utils (eqBy, sortByKeyIndex, unsafeLog)
-import Control.Bind (bind, discard, map, void, (<#>), (=<<), (>>=))
-import Data.Array ((:))
-import Data.Array as A
-import Data.Array.NonEmpty (NonEmptyArray)
-import Data.Array.NonEmpty as NonEmptyArray
-import Data.Eq ((/=))
-import Data.Foldable (for_)
-import Data.Function (($))
-import Data.Map as M
-import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', maybe)
-import Data.MediaType.Common (textPlain)
-import Data.Number (fromString)
-import Data.Set (Set, toUnfoldable) as S
-import Data.Set.NonEmpty (cons, max) as NES
-import Data.Symbol (SProxy(..))
-import Data.Traversable (sequence, traverse)
-import Data.Tuple (Tuple(..))
-import Data.Tuple as T
-import Data.Unit (Unit, unit)
-import Effect.Aff.Class (class MonadAff)
-import Effect.Class (class MonadEffect, liftEffect)
-import Effect.Console (log)
-import Halogen as H
-import Halogen.HTML as HH
-import Halogen.HTML.Events as HE
-import Halogen.HTML.Properties as HP
-import Prelude (flip, join, pure, show, (#), (&&), (+), (-), (<$>), (<<<), (<>), (==), (>), (>>>))
-import PureTabs.Model.Group (GroupId(..))
-import PureTabs.Model.GroupMapping (GroupData(..))
-import PureTabs.Model.SidebarEvent (SidebarEvent(..))
-import PureTabs.Model.TabWithGroup (TabWithGroup(..))
-import PureTabs.Sidebar.Component.GroupName as GroupName
-import PureTabs.Sidebar.Component.TopMenu as TopMenu
-import PureTabs.Sidebar.Tabs (Output(..))
-import PureTabs.Sidebar.Tabs as Tabs
-import PureTabs.Utils (ifU)
-import Sidebar.Utils (moveElem, whenC)
-import Web.HTML.Event.DataTransfer as DT
-import Web.HTML.Event.DragEvent as DE
-
-
-type Group
-  = { name :: String
-    , pos :: Int
-    }
-
-type State
-  = { groups :: M.Map GroupId Group
-    , tabsToGroup :: M.Map TabId GroupId
-    , groupTabsPositions :: Array (Tuple TabId GroupId)
-    , currentGroup :: GroupId
-    , draggedCurrentGroup :: Maybe GroupId
-    }
-
-data Action
-  = UserSelectedGroup GroupId
-  | UserRenameGroup GroupId String
-  | UserCreatedGroup
-  | UserChangedDeletion Boolean
-  | UserDeletedGroup GroupId
-  | HandleTabsOutput GroupId Tabs.Output
-  | GroupNameDragOver DE.DragEvent GroupId
-  | DragEnd DE.DragEvent
-
-
-data Query a
-  = TabsQuery (Tabs.Query a)
-  | InitialTabsWithGroup (Array GroupData) (Array TabWithGroup) a
-  | InitializeGroups (Array GroupData) a
-  | AssignTabToGroup TabId (Maybe GroupId) a
-  | GroupDeleted GroupId (Maybe TabId) a
-
-initialGroup :: M.Map GroupId Group
-initialGroup = M.fromFoldable [ Tuple (GroupId 0) { name: "main", pos: 0 } ]
-
-initialState :: forall i. i -> State
-initialState _ =
-  { groups: initialGroup
-    , tabsToGroup: M.empty
-    , groupTabsPositions : []
-    , currentGroup: GroupId 0
-    , draggedCurrentGroup: Nothing
-    }
-
-type Slots
-  = ( tabs :: Tabs.Slot GroupId
-    , groupName :: GroupName.Slot GroupId
-    , topMenu :: TopMenu.Slot Unit)
-
-_tabs :: SProxy "tabs"
-_tabs = (SProxy :: _ "tabs")
-
-_groupName :: SProxy "groupName"
-_groupName = (SProxy :: _ "groupName")
-
-_topMenu :: SProxy "topMenu"
-_topMenu = (SProxy :: _ "topMenu")
-
-component :: forall i m. MonadEffect m => MonadAff m => H.Component HH.HTML Query i SidebarEvent m
-component =
-  H.mkComponent
-    { initialState
-    , render: render
-    , eval:
-        H.mkEval
-          $ H.defaultEval
-              { handleQuery = handleQuery
-              , handleAction = handleAction
-              }
-    }
-  where
-
-  render :: State -> H.ComponentHTML Action Slots m
-  render state = 
-    let 
-        currentGroupShown = fromMaybe state.currentGroup state.draggedCurrentGroup
-
-        topMenu = HH.slot _topMenu unit TopMenu.component unit (
-          Just <<< case _ of 
-               TopMenu.CreateGroup -> UserCreatedGroup
-               TopMenu.ChangedDeletion value -> UserChangedDeletion value
-        )
-
-        -- TODO: order groups by `pos`
-        barListGroup = HH.div [ HP.id_ "bar-list" ] [HH.ul [ HP.id_ "bar-list-group"] $ 
-          (M.toUnfoldable state.groups) <#> \(Tuple gid g) -> renderGroup gid (gid == currentGroupShown) g
-        ]
-
-        tabsDivs = (S.toUnfoldable $ (M.keys state.groups)) <#> 
-          (\gid -> HH.div [
-            HP.classes [(H.ClassName "bar-tabs"), whenC (gid == currentGroupShown) (H.ClassName "bar-tabs-active")] 
-          ] [renderGroupTabs gid])
-    
-     in
-        HH.div [ HP.id_ "bar", HE.onDragEnd \evt -> Just $ DragEnd evt ] $ topMenu : barListGroup : tabsDivs 
-
-  renderGroupTabs :: GroupId -> H.ComponentHTML Action Slots m
-  renderGroupTabs groupId = HH.slot _tabs groupId Tabs.component unit (Just <<< (HandleTabsOutput groupId))
-
-  renderGroup :: GroupId -> Boolean -> Group -> H.ComponentHTML Action Slots m
-  renderGroup groupId isActive group =  
-    HH.li [ 
-      HP.classes [(H.ClassName "group-name"), whenC isActive (H.ClassName "active-group")]
-      , HE.onClick (\_ -> Just (UserSelectedGroup groupId))
-      , HE.onDragOver \evt -> Just $ GroupNameDragOver evt groupId
-    ] [ HH.slot _groupName groupId GroupName.component group.name 
-          case _ of 
-               GroupName.NewName newName -> Just (UserRenameGroup groupId newName)
-               GroupName.DeleteGroup -> Just (UserDeletedGroup groupId)
-    ] 
-
-handleAction :: forall m. MonadEffect m => Action -> H.HalogenM State Action Slots SidebarEvent m Unit
-handleAction = 
-  case _ of
-
-       UserSelectedGroup gid -> do
-          H.modify_ _ { currentGroup = gid }
-
-       UserRenameGroup gid newName -> do
-          H.modify_ \s -> s { groups = M.update (\g -> Just $ g { name = newName }) gid s.groups }
-          H.raise $ SbRenamedGroup gid newName
-
-       UserCreatedGroup -> do
-          s <- H.get
-          let Tuple gid newGroup = createGroup Nothing s
-          H.modify_ $ insertGroup gid newGroup
-          H.raise $ SbCreatedGroup gid newGroup.name
-
-       UserChangedDeletion value -> void $ H.queryAll _groupName $ H.tell $ GroupName.DeletionEnabled value
-
-       UserDeletedGroup gid -> do 
-          s <- H.get
-          if M.size s.groups > 1 then
-            H.raise $ SbDeletedGroup gid $ getTabIdsOfGroup gid s.tabsToGroup
-          else 
-            void $ H.query _groupName gid $ H.tell $ GroupName.TriedToDeleteLastGroup
-
-       GroupNameDragOver dragEvent gid -> do
-         let 
-             dataTransfer = DE.dataTransfer dragEvent
-         dragData <- H.liftEffect $ DT.getData textPlain dataTransfer
-         case fromString dragData of
-              Nothing -> H.liftEffect $ log $ "[sb] group drag over, got something else than a number: " <> dragData
-              Just tid -> do 
-                 H.modify_ _ { draggedCurrentGroup = Just gid }
-                 H.liftEffect $ log $ "[sb] dragging " <> (show tid) <> " over " <> (show gid)
-
-       DragEnd evt -> do 
-          H.modify_ _ { draggedCurrentGroup = Nothing }
-          H.liftEffect $ log $ "[sb] drag end from bar component"
-
-       HandleTabsOutput gid output -> 
-         case output of 
-            OutputTabDragEnd tid' -> do 
-                 s <- H.get
-                 case Tuple tid' s.draggedCurrentGroup of 
-                      -- Only perform a move when we're dragging a tab onto a different group
-                      Tuple (Just tid) (Just draggedGroup) | s.currentGroup /= draggedGroup -> 
-                               moveTabToGroup tid gid draggedGroup s
-                      _ -> pure unit
-
-                 H.modify_ _ { draggedCurrentGroup = Nothing }
-
-
-            TabsSidebarAction (SbMoveTab tid groupIndex) -> sidebarMoveTab tid gid groupIndex
-            TabsSidebarAction sbEvent -> H.raise sbEvent
-
-  where
-        moveTabToGroup 
-          :: MonadEffect m => TabId 
-          -> GroupId 
-          -> GroupId 
-          -> State 
-          -> H.HalogenM State Action Slots SidebarEvent m Unit
-        moveTabToGroup _ fromGroup toGroup _ | fromGroup == toGroup = pure unit
-        moveTabToGroup tid fromGroup toGroup state = do
-          let 
-              -- XXX: The goal is to put it at the end, but if you:
-              --  - create a new group
-              --  - drag a tab from the first one to it
-              --  - drag it back to the first group
-              --  Then it will be at the beginning of the group, not the end.
-
-              -- Right now we only put it at the end of the list. 
-              -- We don't support dragging at a specific place.
-              newTabIndex = 
-                fromMaybe (A.length state.groupTabsPositions) 
-                $ lastWinTabIndexInGroup toGroup state.groupTabsPositions
-
-              -- The new index of tab in the group will be at the end.
-              newIndexInGroup = state.groupTabsPositions #
-                                    A.length <<<
-                                    A.filter (T.snd >>> (==) toGroup)
-
-          s <- H.modify \s -> 
-            s { tabsToGroup = M.update (\_ -> Just toGroup) tid s.tabsToGroup
-            , groupTabsPositions = 
-              s.groupTabsPositions
-              <#> \(Tuple tid' gid') -> if tid' == tid then Tuple tid' toGroup else Tuple tid' gid' 
-            -- Reassign the current group directly here to avoid flickering
-            , currentGroup = toGroup
-            }
-
-          deletedTab' <- H.query _tabs fromGroup $ H.request $ Tabs.TabDeleted tid
-          case deletedTab' of 
-               Just (Just (Tab tab)) -> 
-                 void $ H.query _tabs toGroup $ H.tell 
-                  $ Tabs.TabCreated $ Tab (tab { index = newIndexInGroup })
-               _ -> pure unit
-
-          H.raise $ SbMoveTab tid newTabIndex
-          H.raise $ SbActivateTab tid
-          H.raise $ SbChangeTabGroup tid (Just toGroup)
-          void $ handleTabsQuery $ Tabs.TabActivated (Just tid) tid Nothing
-
-        -- | Raise a SbMoveTab event with the tab index corrected from the point of view of the
-        -- | group to that of the Firefox window.
-        sidebarMoveTab 
-          :: TabId 
-          -> GroupId 
-          -> Int 
-          -> H.HalogenM State Action Slots SidebarEvent m Unit
-        sidebarMoveTab tid gid groupIndex = do
-           s <- H.get
-           let 
-               oldPosition = getPositionTab tid gid s.groupTabsPositions
-               newIndex = do 
-                  prevIdx <- oldPosition
-                  s.groupTabsPositions #
-                    A.mapWithIndex (Tuple) 
-                          >>> A.filter (\(Tuple _ (Tuple _ gid')) -> gid' == gid)
-                          >>> (flip A.index) groupIndex
-                          >>> map T.fst
-
-           -- Important: we ask Firefox to do the move, but we don't
-           -- perform it ourselves.  This means we don't update the state.
-           -- We will get back a TabMoved event that will then be
-           -- processed accordingly.
-           newIndex # maybe (pure unit) \idx -> H.raise $ SbMoveTab tid idx 
-
- 
-handleQuery :: forall a m. MonadEffect m => Query a -> H.HalogenM State Action Slots SidebarEvent m (Maybe a)
-handleQuery = case _ of 
-   TabsQuery q -> handleTabsQuery q
-
-   InitializeGroups groups a -> do
-      liftEffect $ log $ "[sb] initializing groups"
-      let newGroups = M.fromFoldable $ 
-            A.mapWithIndex (\idx (GroupData g) -> Tuple g.groupId { name: g.name, pos: idx}) groups
-
-      -- TODO: re-assign existing tabs to the new groups.
-      H.modify_ \s ->
-        if newGroups == s.groups then
-          s
-        else
-          s { groups = newGroups }
-
-      pure (Just a)
-
-   -- Given Nothing, we assign the group ourselves (i.e. the tab had no group to start with)
-   AssignTabToGroup tid Nothing a -> do 
-      { tabsToGroup } <- H.get
-      let groupId = M.lookup tid tabsToGroup
-      for_ groupId \gid -> H.raise $ SbChangeTabGroup tid (Just gid)
-      pure (Just a)
-
-   -- Given an existing group for the tab, we modify our state to reflect it. No need to update the
-   -- background since the information already comes for there.
-   AssignTabToGroup tid (Just gid) a -> do 
-      oldS <- H.get
-
-      for_ (M.lookup tid oldS.tabsToGroup) \prevGid -> do
-        liftEffect $ log $ "[sb] assigning " <> (show tid) <> " to " <> (show gid) <> " from " <> (show prevGid)
-        s <- H.modify \s ->
-          let newGroupTabsPositions = 
-                s.groupTabsPositions <#> \tup@(Tuple tid' gid') -> if tid == tid' then Tuple tid gid else tup
-          in
-             s { tabsToGroup = M.insert tid gid s.tabsToGroup, groupTabsPositions = newGroupTabsPositions }
-
-        tab <- join <$> (H.query _tabs prevGid $ H.request $ Tabs.TabDeleted tid)
-
-        let newTabIndex = getGroupPositionOfTab tid gid s.groupTabsPositions
-
-        case Tuple tab newTabIndex of
-             Tuple (Just (Tab tab')) (Just newTabIndex') -> 
-               void $ H.query _tabs gid $ H.tell $ Tabs.TabCreated (Tab $ tab' { index = newTabIndex'})
-             _ -> liftEffect $ log $ "[sb] couldn't find the tab or the position of the tab"
-
-      pure (Just a)
-
-   InitialTabsWithGroup groups tabs a -> do
-       -- Assign the tabs to their group and save the tabs positions
-       s <- H.modify \s ->
-         let 
-             newGroups = 
-               case groups of
-                    [] -> initialGroup
-                    newGroups' -> 
-                      M.fromFoldable $ 
-                        A.mapWithIndex 
-                        (\idx (GroupData g) -> Tuple g.groupId { name: g.name, pos: idx})
-                        newGroups'
-
-             existingGroups = M.keys newGroups
-
-             tabIdGroup = tabs <#> \(TabWithGroup (Tab t) gid) -> Tuple t.id gid
-          in
-             s { groups = newGroups, tabsToGroup = M.fromFoldable tabIdGroup, groupTabsPositions = tabIdGroup }
-
-       -- Initialize each child tabs component with its tabs
-       let 
-            tabsGroups = tabs <#> \(TabWithGroup tab@(Tab t) _) -> Tuple tab $ fromMaybe s.currentGroup (M.lookup t.id s.tabsToGroup)
-            groupedTabs = A.groupBy (eqBy T.snd) (sortByKeyIndex T.snd tabsGroups)
-       void $ traverse initializeGroup groupedTabs
-
-       -- Activate the right tab and its group
-       let activatedTab = tabsGroups # A.head <<< A.filter (\(Tuple (Tab t) _) -> t.active)
-       activatedTab # maybe (pure unit) \(Tuple (Tab t) gid) -> do
-         void $ tellChild gid $ Tabs.TabActivated Nothing t.id
-         handleAction $ UserSelectedGroup gid
-
-       pure (Just a)
-
-      where 
-            initializeGroup :: forall act. NonEmptyArray (Tuple Tab GroupId) -> H.HalogenM State act Slots SidebarEvent m Unit
-            initializeGroup groupedTabs = 
-              let 
-                  gid = T.snd $ NonEmptyArray.head groupedTabs
-              in 
-                  void $ tellChild gid $ Tabs.InitialTabList $ A.fromFoldable $ T.fst <$> groupedTabs
-
-   GroupDeleted gid currentTid a -> do 
-      H.modify_ \s -> 
-        let 
-            currentGroup = fromMaybe s.currentGroup $ currentTid >>= (flip M.lookup s.tabsToGroup)
-         in
-            s { groups = M.delete gid s.groups, currentGroup = currentGroup }
-      pure $ Just a
-
-
-handleTabsQuery :: forall act a m. MonadEffect m => Tabs.Query a -> H.HalogenM State act Slots SidebarEvent m (Maybe a)
-handleTabsQuery = case _ of
-
-    Tabs.InitialTabList tabs a -> pure $ Just a
-
-    Tabs.TabCreated (Tab tab) a -> do 
-       s <- H.get
-
-       let tabGroupId = fromMaybe s.currentGroup $ tab.openerTabId >>= (flip M.lookup) s.tabsToGroup
-
-           newGroupTabsPositions = 
-             fromMaybe s.groupTabsPositions 
-             $ A.insertAt tab.index (Tuple tab.id tabGroupId) s.groupTabsPositions
-
-           inGroupPosition = getPositionTabInGroup tab.index tabGroupId newGroupTabsPositions 
-
-           newTab = Tab $ tab { index = inGroupPosition }
-
-       newS <- H.modify \state -> 
-         state 
-         { tabsToGroup = M.insert tab.id tabGroupId s.tabsToGroup 
-         , groupTabsPositions = newGroupTabsPositions
-         , currentGroup = tabGroupId
-         }
-
-       void $ tellChild tabGroupId $ Tabs.TabCreated newTab
-       pure $ Just a
-
-    Tabs.TabDeleted tid reply -> do 
-       doOnTabGroup tid \gid -> do 
-         H.modify_ (\s -> s 
-                       { tabsToGroup = M.delete tid s.tabsToGroup 
-                       , groupTabsPositions = A.deleteBy 
-                          -- This is ugly. There is no function to delete the
-                          -- first element of an array that matches a condition.
-                          (\(Tuple tid1 _) (Tuple tid2 _) -> tid1 == tid2)
-                          (Tuple tid s.currentGroup)
-                          s.groupTabsPositions
-                       })
-         void $ H.query _tabs gid $ H.request $ Tabs.TabDeleted tid
-       pure (Just (reply Nothing))
-
-    Tabs.TabActivated prevTid' tid a -> do 
-       for_ prevTid' \prevTid ->
-         doOnTabGroup prevTid \gid -> 
-           void $ tellChild gid $ Tabs.TabActivated prevTid' tid
-
-       doOnTabGroup tid \gid -> do 
-         { tabsToGroup } <- H.modify (_ { currentGroup = gid})
-         H.raise $ SbSelectedGroup $ getTabIdsOfGroup gid tabsToGroup
-         void $ tellChild gid $ Tabs.TabActivated prevTid' tid
-       pure (Just a)
-
-    Tabs.TabMoved tid next a -> do 
-       doOnTabGroup tid \gid -> do 
-         { groupTabsPositions } <- H.get 
-         let 
-             newGroupTabsPositions = fromMaybe groupTabsPositions $ do 
-               prevPosition <- getPositionTab tid gid groupTabsPositions
-               moveElem prevPosition next groupTabsPositions
-
-             nextGroupPosition = getPositionTabInGroup next gid newGroupTabsPositions
-
-         H.modify_ (_ { groupTabsPositions = newGroupTabsPositions })
-         void $ tellChild gid $ Tabs.TabMoved tid nextGroupPosition
-       pure (Just a)
-
-    Tabs.TabInfoChanged tid cinfo a -> do 
-       doOnTabGroup tid \gid -> do
-         void $ tellChild gid $ Tabs.TabInfoChanged tid cinfo
-       pure (Just a)
-
-    Tabs.TabDetached tid a -> do 
-       handleTabsQuery $ Tabs.TabDeleted tid \_ -> a
-
-    Tabs.TabAttached tab a -> do 
-       handleTabsQuery $ Tabs.TabCreated tab a
-
-doOnTabGroup 
-  :: forall m act
-   . TabId 
-  -> (GroupId -> H.HalogenM State act Slots SidebarEvent m Unit) 
-  -> H.HalogenM State act Slots SidebarEvent m Unit
-doOnTabGroup tabId f = do
-  { tabsToGroup } <- H.get
-  case M.lookup tabId tabsToGroup of 
-       Just groupId -> f groupId
-       Nothing -> pure unit
-
-
-
-tellChild :: forall act m. GroupId -> (H.Tell Tabs.Query) -> H.HalogenM State act Slots SidebarEvent m (Maybe Unit)
-tellChild gid q = H.query _tabs gid $ H.tell q
-
-getPositionTabInGroup
-  :: Int
-  -> GroupId
-  -> Array (Tuple TabId GroupId)
-  -> Int
-getPositionTabInGroup index gid = 
-  (A.take $ index + 1)
-     >>> (A.filter \(Tuple _ gid') -> gid' == gid)  
-     >>> A.length
-     >>> (flip (-) $ 1)
-
-getPositionTab 
-  :: TabId
-  -> GroupId
-  -> Array (Tuple TabId GroupId)
-  -> Maybe Int
-getPositionTab tid gid arr = A.findIndex (\(Tuple tid' gid') -> tid' == tid && gid' == gid) arr
-
-getTabIdsOfGroup 
-  :: GroupId
-  -> M.Map TabId GroupId
-  -> Array TabId
-getTabIdsOfGroup gid =
-  M.toUnfoldable 
-  >>> A.filter (\(Tuple tid gid') -> gid' == gid)
-  >>> map T.fst
-
-getGroupPositionOfTab
-  :: TabId
-  -> GroupId
-  -> Array (Tuple TabId GroupId)
-  -> Maybe Int
-getGroupPositionOfTab tid gid = 
-  A.filter (T.snd >>> (==) gid) 
-  >>> A.findIndex (T.fst >>> (==) tid)
-
-
-lastWinTabIndexInGroup 
-  :: GroupId
-  -> Array (Tuple TabId GroupId)
-  -> Maybe Int
-lastWinTabIndexInGroup gid = 
-  A.mapWithIndex (Tuple)
-    >>> A.filter (T.snd >>> T.snd >>> (==) gid)
-    >>> map T.fst
-    >>> A.last
-    >>> map ((+) 1)
-
-findNextGroupId :: S.Set GroupId -> GroupId
-findNextGroupId values = 
-  let GroupId(maxValue) = NES.max (NES.cons (GroupId 0) values)
-   in GroupId(maxValue + 1)
-
-createGroup :: (Maybe GroupId) -> State -> Tuple GroupId Group
-createGroup mGid s =
-  let 
-      gid = fromMaybe' (\_ -> findNextGroupId $ M.keys s.groups) mGid
-  in
-    Tuple gid { name: "new group", pos: M.size s.groups }
-
-insertGroup :: GroupId -> Group -> State -> State
-insertGroup gid group s = s { groups = M.insert gid group s.groups }
-

src/Sidebar/Components/GroupName.js

@@ -1,5 +0,0 @@
-"use strict";
-
-exports.targetValue = function(t) {
-  return t.value;
-}

src/Sidebar/Components/GroupName.purs

@@ -1,107 +0,0 @@
-module PureTabs.Sidebar.Component.GroupName (component, Output(..), Query(..), Slot) where
-
-
-import Control.Category ((<<<))
-import Data.Maybe (Maybe(..), maybe)
-import Data.String.CodeUnits (length)
-import Data.Tuple.Nested ((/\))
-import Effect.Aff (Milliseconds(..))
-import Effect.Aff as Aff
-import Effect.Aff.Class (class MonadAff, liftAff)
-import Halogen (liftEffect)
-import Halogen as H
-import Halogen.HTML as HH
-import Halogen.HTML.Events as HE
-import Halogen.HTML.Properties as HP
-import Halogen.Hooks as Hooks
-import Halogen.Query.Input as HQI
-import Prelude (bind, discard, otherwise, pure, unit, ($), (==))
-import Sidebar.Utils (whenC)
-import Web.Event.Event as E
-import Web.Event.EventTarget as ET
-import Web.HTML.HTMLElement (focus) as Web
-import Web.UIEvent.KeyboardEvent as KE
-
-type Slot a = H.Slot Query Output a
-
-data Output 
-  = NewName String
-  | DeleteGroup
-
-data Query a
-  = DeletionEnabled Boolean a
-  | TriedToDeleteLastGroup a
-
-foreign import targetValue :: ET.EventTarget -> String
-
-component
-  :: forall m
-   . MonadAff m
-  => H.Component HH.HTML Query String Output m
-component = Hooks.component \rec name -> Hooks.do 
-  isRenaming /\ isRenamingIdx <- Hooks.useState false 
-  initialName /\ initialNameIdx <- Hooks.useState name 
-  chars /\ charsIdx <- Hooks.useState name
-
-  deletionEnabled /\ deletionEnabledIdx <- Hooks.useState false
-  triedToDelete /\ triedToDeleteIdx <- Hooks.useState false
-
-  Hooks.useQuery rec.queryToken case _ of 
-
-    DeletionEnabled value a -> do 
-       Hooks.put deletionEnabledIdx value
-       pure Nothing
-
-    TriedToDeleteLastGroup a -> do
-       Hooks.put triedToDeleteIdx true
-       -- TODO: Add a debounce for setting triedToDelete to false. This will
-       -- avoid the animation getting cancelled if we click multiple times too
-       -- fast on the button.
-       liftAff $ Aff.delay $ Milliseconds 800.0
-       Hooks.put triedToDeleteIdx false
-       pure Nothing
-
-  let 
-      onKeyEvent keyEvent 
-        | KE.key keyEvent == "Enter" = 
-            Just $ case (length chars) of 
-              0 -> do 
-                 Hooks.put isRenamingIdx false
-                 Hooks.put charsIdx initialName
-              _ -> do
-                 Hooks.put isRenamingIdx false 
-                 Hooks.put initialNameIdx chars
-                 Hooks.raise rec.outputToken $ NewName chars
-        | KE.key keyEvent == "Escape" = 
-          Just do 
-             Hooks.put charsIdx initialName
-             Hooks.put isRenamingIdx false
-        | otherwise = Nothing
-
-      onInput input = do 
-         target <- E.target input
-         let value = targetValue target
-         Just $ Hooks.put charsIdx value
-
-      groupName = HH.text chars
-      node = 
-        if deletionEnabled then 
-          [HH.span [
-            HP.class_ $ H.ClassName "group-deletion-button"
-            , HE.onClick \_ -> Just $ Hooks.raise rec.outputToken DeleteGroup
-          ] [HH.text "✖"], groupName]
-        else
-          [groupName]
-
-
-  Hooks.pure $
-      if isRenaming then 
-        HH.input [ HP.type_ HP.InputText, HP.value chars, HE.onKeyUp onKeyEvent, HE.onInput onInput, HP.ref (HQI.RefLabel "input") ] 
-      else 
-        HH.span [ 
-          HP.class_ $ whenC triedToDelete (H.ClassName "shake-animation")
-          , HE.onDoubleClick \_ -> if deletionEnabled then Nothing else Just $ do 
-             Hooks.put isRenamingIdx true 
-             elem <- Hooks.getHTMLElementRef (HQI.RefLabel "input")
-             maybe (pure unit) (liftEffect <<< Web.focus) elem
-        ] node

src/Sidebar/Components/Groups.purs

@@ -1 +0,0 @@
-module PureTabs.Sidebar.Groups where

src/Sidebar/Components/Tab.purs

@@ -1 +0,0 @@
-module PureTabs.Sidebar.Tab  where

src/Sidebar/Components/Tabs.purs

@@ -1,468 +0,0 @@
-module PureTabs.Sidebar.Tabs (component, Query(..), Output(..), Slot) where
-
-import Browser.Tabs (Tab(..), TabId, showTabId)
-import Browser.Tabs.OnUpdated (ChangeInfo(..), ChangeInfoRec)
-import CSS.Background as CssBackground
-import Control.Alt ((<$>))
-import Control.Alternative (empty, pure)
-import Control.Bind (bind, discard, (>=>), (>>=))
-import Control.Category (identity, (<<<), (>>>))
-import Data.Array (catMaybes, deleteAt, filter, findIndex, head, insertAt, length, mapWithIndex, modifyAt) as A
-import Data.Eq ((/=), (==))
-import Data.Foldable (for_)
-import Data.Function (flip, ($))
-import Data.Maybe (Maybe(..), fromMaybe, isNothing, maybe)
-import Data.MediaType.Common (textPlain)
-import Data.Monoid ((<>))
-import Data.Show (show)
-import Data.String.CodeUnits (length)
-import Data.Symbol (SProxy(..))
-import Data.Time.Duration (Milliseconds(..))
-import Data.Unit (Unit, unit)
-import Effect.AVar (AVar)
-import Effect.Aff (Aff, Fiber, forkAff, delay, killFiber)
-import Effect.Aff.AVar (put, empty, take) as AVar
-import Effect.Aff.Class (class MonadAff)
-import Effect.Class (class MonadEffect)
-import Effect.Class.Console (log)
-import Effect.Exception (error)
-import Halogen as H
-import Halogen.HTML as HH
-import Halogen.HTML.CSS as CSS
-import Halogen.HTML.Events as HE
-import Halogen.HTML.Properties as HP
-import Prelude (negate, sub)
-import PureTabs.Browser.Dom.Element (scrollIntoView)
-import PureTabs.Model.SidebarEvent (SidebarEvent(..))
-import Sidebar.Utils (moveElem, whenC)
-import Web.Event.Event (Event)
-import Web.Event.Event as Event
-import Web.HTML.Event.DataTransfer as DT
-import Web.HTML.Event.DragEvent as DE
-import Web.HTML.HTMLElement (toElement) as DOM
-import Web.UIEvent.MouseEvent as ME
-
-type Slot a = H.Slot Query Output a
-
-data Query a
-  = InitialTabList (Array Tab) a
-  | TabCreated Tab a
-  | TabDeleted TabId (Maybe Tab -> a)
-  | TabActivated (Maybe TabId) TabId a
-  | TabMoved TabId Int a
-  | TabInfoChanged TabId ChangeInfo a
-  | TabDetached TabId a
-  | TabAttached Tab a
-
-data Output 
-  = TabsSidebarAction SidebarEvent
-  -- Nothing if we already did the move
-  -- Just TabId in case the dragged ended somewhere else
-  | OutputTabDragEnd (Maybe TabId)
-
-data Action
-  = UserClosedTab TabId Event
-  | UserActivatedTab TabId Event
-  | UserOpenedTab (Maybe TabId) Event
-  -- drags
-  | TabDragStart DE.DragEvent Tab Int
-  | TabDragOver DE.DragEvent Int
-  | TabDragEnd DE.DragEvent
-  | TabDragLeave DE.DragEvent
-  | TabDragLeaveRun DE.DragEvent
-  -- special
-  -- stop the propagation of the event
-  | PreventPropagation Event
-
-type DraggedTab
-  = { tab :: Tab
-    , originalIndex :: Int
-    , overIndex :: Maybe Int
-    }
-
-type Debouncer
-  = { var :: AVar Unit
-    , timer :: Fiber Unit
-    }
-
-
-type State
-  = { tabs :: Array Tab
-    , selectedElem :: Maybe DraggedTab
-    , leaveDebounce :: Maybe Debouncer
-    }
-
-type TabProperties
-  = { isActive :: Boolean
-    , isDiscarded :: Boolean
-    , isBeingDragged :: Boolean
-    }
-
-getTabProperties 
-  :: forall r.
-  Tab 
-  -> Int
-  -> { selectedElem :: Maybe DraggedTab | r }
-  -> TabProperties
-getTabProperties (Tab t) index props = 
-  let 
-      isBeingDragged = fromMaybe false $ do 
-        dt <- props.selectedElem
-        overIndex <- dt.overIndex
-        Just $ overIndex == index
-   in
-    { isActive: t.active
-    , isDiscarded: fromMaybe false t.discarded
-    , isBeingDragged: isBeingDragged
-    }
-
-component :: forall i m. MonadEffect m => MonadAff m => H.Component HH.HTML Query i Output m
-component =
-  H.mkComponent
-    { initialState
-    , render: render
-    , eval:
-        H.mkEval
-          $ H.defaultEval
-              { handleQuery = handleQuery
-              , handleAction = handleAction
-              }
-    }
-
-initialState :: forall i. i -> State
-initialState _ = 
-  { tabs: empty
-  , selectedElem: Nothing
-  , leaveDebounce: Nothing 
-  }
-
-debounceTimeout :: Milliseconds -> AVar Unit -> Aff (Fiber Unit)
-debounceTimeout ms var =
-  forkAff do
-    delay ms
-    AVar.put unit var
-
-_tab :: SProxy "tab"
-_tab = SProxy
-
-tabContainerRef :: H.RefLabel 
-tabContainerRef = H.RefLabel "tab-container"
-
-getTabRef :: TabId -> H.RefLabel
-getTabRef tid = H.RefLabel $ "tab-" <> show tid
-
-render :: forall m. State -> H.ComponentHTML Action () m
-render state =
-  let
-    tabsWithIndex = state.tabs
-
-    tabs =
-      fromMaybe tabsWithIndex
-        $ state.selectedElem
-        >>= ( \{ originalIndex, overIndex } -> case overIndex of
-              Just overIndex' -> moveElem originalIndex overIndex' tabsWithIndex
-              Nothing -> A.deleteAt originalIndex tabsWithIndex
-          )
-
-    currentOverIndex = fromMaybe (-1) $ state.selectedElem >>= _.overIndex
-  in
-    HH.div
-      [ HP.classes [H.ClassName "tabs", whenC (isNothing state.selectedElem) $ H.ClassName "is-not-dragging"]
-      , HE.onDoubleClick (\ev -> Just (UserOpenedTab Nothing (ME.toEvent ev)))
-      , HE.onDragOver \evt -> Just $ TabDragOver evt (sub (A.length tabs) 1)
-      , HE.onDragLeave \evt -> Just $ TabDragLeave evt
-      ]
-      [ HH.div
-          [ HP.class_ $ H.ClassName "inner-tabs"
-          , HP.ref tabContainerRef
-          -- We prevent both propagation to avoid tabs blinking during drag and
-          -- drop. In the case of dragOver, the handler from #tabs triggers
-          -- when we drag over between two tabs (because of the margin), and
-          -- the tab jumps brefiely to the end. 
-          -- The same happens for dragLeave, but with the tab disappearing
-          -- brefiely.
-          , HE.onDragOver \evt -> Just $ PreventPropagation $ DE.toEvent evt
-          , HE.onDragLeave \evt -> Just $ TabDragLeave evt
-          ]
-          (A.mapWithIndex (\idx tab -> 
-            renderTab idx (getTabProperties tab idx state) tab
-          ) tabs)
-      ]
-
-  where
-
-  threeDotBounces = HH.div [ HP.class_ (H.ClassName "three-dot-bounce") ] [
-    HH.div [HP.class_ (H.ClassName "three-dot-bounce-1")] [],  
-    HH.div [HP.class_ (H.ClassName "three-dot-bounce-2")] [],
-    HH.div [HP.class_ (H.ClassName "three-dot-bounce-3")] []
-    ]
-
-  renderTab :: Int -> TabProperties -> Tab -> H.ComponentHTML Action () m
-  renderTab index props (Tab t) =
-    HH.div
-      [ HP.id_ $ show t.id
-      , HP.ref $ getTabRef t.id
-      , HP.draggable true
-
-      -- drag events
-      , HE.onDragStart \evt -> Just $ TabDragStart evt (Tab t) index
-      , HE.onDragEnd \evt -> Just $ TabDragEnd evt
-      , HE.onDragOver \evt -> Just $ TabDragOver evt index
-
-      -- click event
-      , HE.onClick (\ev -> Just (UserActivatedTab t.id (ME.toEvent ev)))
-      , HE.onDoubleClick (\ev -> Just (UserOpenedTab (Just t.id) (ME.toEvent ev)))
-
-      -- classes
-      , HP.classes $ H.ClassName
-          <$> A.catMaybes
-              [ Just "tab"
-              , if props.isActive then Just "active" else Nothing
-              , if props.isDiscarded then Just "discarded" else Nothing
-              , if props.isBeingDragged then Just "being-dragged" else Nothing
-              ]
-      , HP.title t.title
-      ] [
-      case t.status of 
-           Just "loading" -> threeDotBounces
-           _ -> HH.div [ HP.class_ $ H.ClassName "tab-favicon", faviconStyle t.favIconUrl ] [] 
-
-      , HH.div [ HP.class_ $ H.ClassName "tab-title" ] [ HH.text (if length t.title /= 0 then t.title else maybe "" identity t.url) ]
-
-      , HH.div
-          [ HP.class_ $ H.ClassName "close-button-parent"
-          , HE.onClick (\ev -> Just (UserClosedTab t.id (ME.toEvent ev)))
-          ]
-          [ HH.div [ HP.class_ $ H.ClassName "close-button-outer" ]
-              [ HH.div [ HP.class_ $ H.ClassName "close-button-inner" ] []
-              ]
-          ]
-      ]
-
-  faviconStyle favicon' =
-    CSS.style
-      $ do
-          case favicon' of
-            Nothing -> pure unit
-            Just favicon -> CssBackground.backgroundImage $ CssBackground.url favicon
-
-cancelLeaveDebounce :: forall m. MonadAff m => State -> H.HalogenM State Action () Output m Unit
-cancelLeaveDebounce state = case state.leaveDebounce of
-  Just { var, timer } -> do
-    H.liftAff $ killFiber (error "could not cancel timer") timer
-    H.modify_ _ { leaveDebounce = Nothing }
-  Nothing -> pure unit
-
-runDebounce :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
-runDebounce actionToRun = do
-  state <- H.get
-  let
-    debounceTime = Milliseconds 50.0
-  case state.leaveDebounce of
-    Nothing -> do
-      var <- H.liftAff AVar.empty
-      timer <- H.liftAff (debounceTimeout debounceTime var)
-      _ <-
-        H.fork do
-          H.liftAff (AVar.take var)
-          H.modify_ _ { leaveDebounce = Nothing }
-          handleAction actionToRun
-      let
-        debouncer = { var, timer }
-      H.modify_ _ { leaveDebounce = Just debouncer }
-
-    Just { var, timer } -> do
-      H.liftAff $ killFiber (error "could not cancel timer") timer
-      nextTimer <- H.liftAff (debounceTimeout debounceTime var)
-      let
-        debouncer = { var, timer: nextTimer }
-      H.modify_ _ { leaveDebounce = Just debouncer }
-
-handleAction :: forall m. MonadEffect m => MonadAff m => Action -> H.HalogenM State Action () Output m Unit
-handleAction = case _ of
-
-  UserClosedTab tid ev -> do
-    H.liftEffect
-      $ do
-          Event.preventDefault ev
-          Event.stopPropagation ev
-          log "[sb] closed a tab"
-    H.raise $ TabsSidebarAction $ SbDeleteTab tid
-
-  UserActivatedTab tid ev -> do
-    H.liftEffect
-      $ do
-          Event.preventDefault ev
-          Event.stopPropagation ev
-          log "[sb] activated a tab"
-    H.raise $ TabsSidebarAction $ SbActivateTab tid
-
-  UserOpenedTab tid ev -> do
-    H.liftEffect
-      $ do
-          Event.preventDefault ev
-          Event.stopPropagation ev
-          log "[sb] created a tab"
-    H.raise $ TabsSidebarAction $ SbCreateTab tid
-
-  -- Drag actions
-  TabDragStart dragEvent tab index -> do
-    let
-      dataTransfer = DE.dataTransfer dragEvent
-    H.liftEffect
-      $ do
-          DT.setData textPlain (showTabId tab) dataTransfer
-          DT.setDropEffect DT.Move dataTransfer
-    H.modify_ _ { selectedElem = Just { tab: tab, originalIndex: index, overIndex: Just index } }
-    H.liftEffect $ log $ "[sb] drag start from " <> (show index)
-
-  TabDragOver event index -> do
-    -- prevent the ghost from flying back to its (wrong) place
-    -- see https://stackoverflow.com/questions/42725321/prevent-html5-drag-ghost-image-flying-back
-    let
-      evt = (DE.toEvent event)
-    H.liftEffect $ Event.preventDefault evt
-    -- because we're also triggering this event on over of the empty part of the
-    -- tab list, we need to prevent it from triggering twice.
-    H.liftEffect $ Event.stopPropagation evt
-    state <- H.get
-    cancelLeaveDebounce state
-    case state.selectedElem of
-      Just selectedRec@{ originalIndex, overIndex } -> case overIndex of
-        -- we only do nothing if we're still over the same element
-        Just overIndex'
-          | overIndex' == index -> pure unit
-        _ -> H.modify_ (_ { selectedElem = Just $ selectedRec { overIndex = Just index } })
-      Nothing -> pure unit
-
-  PreventPropagation event -> do
-    H.liftEffect $ Event.stopImmediatePropagation event
-    pure unit
-
-  TabDragEnd event -> do
-    state <- H.get
-    cancelLeaveDebounce state
-    case state.selectedElem of
-      Nothing -> pure unit
-
-      -- On success, we don't remove the dragged element here. It is instead done in the
-      -- query handler for TabMoved. See comment there for the explanation.
-      Just { tab: (Tab t), originalIndex, overIndex: (Just overIndex) } -> do
-        H.raise $ TabsSidebarAction (SbMoveTab t.id overIndex)
-        H.raise $ OutputTabDragEnd Nothing
-        H.liftEffect $ log "[sb] drag end (asking to do a move)"
-
-      Just { tab: (Tab t), overIndex: Nothing } -> do
-        H.modify_ _ { selectedElem = Nothing }
-        H.raise $ OutputTabDragEnd $ Just t.id
-        H.liftEffect $ log "[sb] drag end (doing nothing)"
-
-  TabDragLeave event -> runDebounce $ TabDragLeaveRun event
-
-  TabDragLeaveRun event -> do
-    state <- H.get
-    case state.selectedElem of
-      Just selectedRec@{ overIndex: (Just overIndex) } -> H.modify_ _ { selectedElem = Just $ selectedRec { overIndex = Nothing } }
-      _ -> pure unit
-
-handleQuery :: forall act o m a. MonadEffect m => Query a -> H.HalogenM State act () o m (Maybe a)
-handleQuery = case _ of
-
-  InitialTabList tabs a -> do 
-     H.modify_ _ { tabs = tabs } 
-     pure (Just a)
-
-  TabCreated (Tab t) a -> do
-    H.modify_ \s ->
-      s { tabs = fromMaybe s.tabs $ A.insertAt t.index (Tab t) s.tabs}
-    pure (Just a)
-
-  TabDeleted tid reply -> do
-    { tabs } <- H.get
-    let deletedTab = findTabByTabId tid tabs
-    H.modify_ \s -> s { tabs = applyAtTabId tid A.deleteAt s.tabs}
-    pure (Just (reply deletedTab))
-
-  TabActivated prevTid tid a -> do
-    let 
-      updateTabs = maybe identity (\old -> applyAtTabId old $ setTabActiveAtIndex false) prevTid
-          >>> applyAtTabId tid (setTabActiveAtIndex true)
-    H.modify_ \s -> s { tabs = updateTabs s.tabs }
-    scrollToTab tid
-    pure (Just a)
-
-  TabMoved tid next a -> do
-    H.modify_ \s -> 
-       let 
-           newTabs = do 
-              tabPosition <- A.findIndex (\(Tab t) -> t.id == tid) s.tabs
-              moveElem tabPosition next s.tabs
-        in 
-          -- Regarding `selectedElem = Nothing`:
-          -- Wait for a move to disable the drag data, otherwise the tab will come
-          -- back briefly to its original place before switching again.
-          -- This also means that if the move fail, this will be in an inconsistant
-          -- state.
-          s { tabs = fromMaybe s.tabs newTabs, selectedElem = Nothing}
-    pure (Just a)
-
-  TabInfoChanged tid cinfo a -> do
-    H.modify_ \s ->
-      s { tabs = 
-        fromMaybe s.tabs $
-          (findIndexTabId tid >=> \index -> A.modifyAt index (updateTabFromInfo cinfo) s.tabs) s.tabs
-        }
-    pure (Just a)
-
-  TabDetached tid reply -> 
-    handleQuery $ TabDeleted tid \_ -> reply
-
-  TabAttached tab a -> do
-    H.liftEffect (log $ "[sb] tab attached " <> (showTabId tab))
-    handleQuery $ TabCreated tab a
-
-
-
-setTabActive :: Boolean -> Tab -> Tab
-setTabActive act (Tab t) = Tab (t { active = act })
-
-setTabActiveAtIndex :: Boolean -> Int -> Array Tab -> Maybe (Array Tab)
-setTabActiveAtIndex act i = A.modifyAt i (setTabActive act)
-
-findTabByTabId :: TabId -> Array Tab -> Maybe Tab
-findTabByTabId tid = A.head <<< A.filter \(Tab t) -> t.id == tid
-
-findIndexTabId :: TabId -> Array Tab -> Maybe Int
-findIndexTabId tid = A.findIndex \(Tab t) -> t.id == tid
-
-applyAtTabId :: TabId -> (Int -> Array Tab -> Maybe (Array Tab)) -> Array Tab -> Array Tab
-applyAtTabId tid f a = fromMaybe a $ findIndexTabId tid a >>= (flip f) a
-
-updateTabFromInfo :: ChangeInfo -> Tab -> Tab
-updateTabFromInfo (ChangeInfo cinfo) (Tab t) =
-  let
-    updateField :: forall r a. { acc :: ChangeInfoRec -> Maybe a, update :: a -> r -> r } -> r -> r
-    updateField { acc, update } tab = case acc cinfo of
-      Nothing -> tab
-      Just field -> update field tab
-
-    applyChange =
-      updateField { acc: _.title, update: (\val -> _ { title = val }) }
-        >>> updateField { acc: _.status, update: (\val -> _ { status = Just val }) }
-        >>> updateField { acc: _.discarded, update: (\val -> _ { discarded = Just val }) }
-        >>> updateField { acc: _.url, update: (\val -> _ { url = Just val }) }
-        >>> updateField { acc: _.pinned, update: (\val -> _ { pinned = val }) }
-        >>> updateField { acc: _.hidden, update: (\val -> _ { hidden = val }) }
-        >>> updateField { acc: _.favIconUrl, update: (\val -> _ { favIconUrl = Just val }) }
-  in
-    Tab (applyChange t)
-
-scrollToTab 
-  :: forall state action input output monad
-   .  MonadEffect monad
-   => TabId 
-   -> H.HalogenM state action input output monad Unit
-scrollToTab tid = do 
-  ref <- H.getHTMLElementRef $ getTabRef tid
-  for_ ref \el -> H.liftEffect $ scrollIntoView $ DOM.toElement el

src/Sidebar/Components/TopMenu.purs

@@ -1,41 +0,0 @@
-module PureTabs.Sidebar.Component.TopMenu (component, TopMenuAction(..), Slot) where 
-
-import Prelude (($), bind, not)
-
-import Data.Tuple.Nested ((/\))
-import Data.Maybe (Maybe(..))
-import Halogen as H
-import Halogen.HTML as HH
-import Halogen.HTML.Events as HE
-import Halogen.HTML.Properties as HP
-import Halogen.Hooks as Hooks
-
-
-type Slot a = forall q. H.Slot q TopMenuAction a
-
-
-data TopMenuAction
-  = CreateGroup
-  | ChangedDeletion Boolean
-
-
-component 
-  :: forall unusedQuery unusedInput anyMonad
-   . H.Component HH.HTML unusedQuery unusedInput TopMenuAction anyMonad
-component = Hooks.component \rec _ -> Hooks.do
-  isDeleting /\ isDeletingIdx <- Hooks.useState false
-
-  let menuElem attrs text = HH.li attrs [ HH.text text ]
-
-  Hooks.pure $ 
-    HH.div [ HP.id_ "top-menu" ] [
-      HH.ul [] [
-        menuElem [HE.onClick \_ -> Just $ Hooks.raise rec.outputToken CreateGroup] "+", 
-        menuElem [
-          HE.onClick \_ -> Just $ do
-             isNowDeleting <- Hooks.modify isDeletingIdx (not)
-             Hooks.raise rec.outputToken $ ChangedDeletion isNowDeleting
-       ] if isDeleting then "✓" else "-"
-      ]
-    ]
-

src/Sidebar/Sidebar.purs

@@ -1,170 +0,0 @@
-module PureTabs.Sidebar where
-
-import Browser.Runtime as Runtime
-import Browser.Tabs (Tab(..), WindowId)
-import Browser.Tabs.OnUpdated (ChangeInfo(..))
-import Browser.Windows (getCurrent)
-import Control.Alt (void)
-import Control.Alternative (pure)
-import Control.Coroutine as CR
-import Control.Coroutine.Aff (emit)
-import Control.Coroutine.Aff as CRA
-import Control.Monad.Error.Class (throwError, try)
-import Data.Either (Either(..))
-import Data.Function (($))
-import Data.Maybe (Maybe(..))
-import Data.Show (show)
-import Data.Time.Duration (Milliseconds(..))
-import Data.Unit (Unit, unit)
-import Effect (Effect)
-import Effect.Aff (Aff, delay, error)
-import Effect.Class (liftEffect)
-import Effect.Console (log)
-import Effect.Console as Log
-import Effect.Exception (message)
-import Halogen as H
-import Halogen.Aff as HA
-import Halogen.VDom.Driver (runUI)
-import Prelude (bind, discard, (*), (-), (<>))
-import PureTabs.Model.BackgroundEvent (BackgroundEvent(..))
-import PureTabs.Model.SidebarEvent (SidebarEvent(..))
-import PureTabs.Sidebar.Bar as Bar
-import PureTabs.Sidebar.Tabs as Tabs
-import Web.DOM.ParentNode (QuerySelector(..))
-
-
-trySendWindowId :: WindowId -> Aff Runtime.Port
-trySendWindowId windowId = loopConnect 5 (Milliseconds 50.0)
-  where 
-        tryConnect = do 
-            port <- Runtime.connect 
-            Runtime.postMessageJson port (SbHasWindowId windowId) 
-            log "[sb] windowId sent"
-            pure port
-
-        loopConnect :: Int -> Milliseconds -> Aff Runtime.Port
-        loopConnect 0 _ = 
-          throwError $ error "[sb] couldn't connect to the background extesion :("
-        loopConnect attemptLeft timeout = do
-          liftEffect $ 
-            log $ "[sb] attempt to connect to background extension (left: " <> (show attemptLeft) <> ")"
-          success <- try $ liftEffect tryConnect
-          case success of 
-               Left err -> do
-                 liftEffect $ Log.error $ message err
-                 delay timeout 
-                 loopConnect (attemptLeft - 1) (multiplyMs 2.0 timeout)
-               Right port -> pure port
-
-        multiplyMs by (Milliseconds t) = Milliseconds (t * by)
-
-
-
-main :: Effect Unit
-main = do
-  log "[sb] starting"
-  HA.runHalogenAff do
-    currentWindow <- getCurrent
-    port <- trySendWindowId currentWindow.id
-    content' <- HA.selectElement (QuerySelector "#content")
-    io <- case content' of
-      Nothing -> throwError (error "Could not find #content")
-      Just content -> runUI Bar.component unit content
-    io.subscribe $ onSidebarMsg port
-    CR.runProcess ((onBackgroundMsgProducer port) CR.$$ onBackgroundMsgConsumer io.query)
-
-onBackgroundMsgProducer :: Runtime.Port -> CR.Producer BackgroundEvent Aff Unit
-onBackgroundMsgProducer port =
-  CRA.produce \emitter ->
-    liftEffect $ void $ Runtime.onMessageJsonAddListener port (emit emitter)
-
-
-onBackgroundMsgConsumer :: (forall a. Bar.Query a -> Aff (Maybe a)) -> CR.Consumer BackgroundEvent Aff Unit
-onBackgroundMsgConsumer query =
-  CR.consumer
-    $ case _ of
-
-        BgInitialTabList groups tabs -> do
-          void $ query $ H.tell $ \q -> Bar.InitialTabsWithGroup groups tabs q 
-          pure Nothing
-
-        BgInitializeGroups groups -> do
-          void $ query $ H.tell $ \q -> Bar.InitializeGroups groups q 
-          pure Nothing
-
-        BgAssignTabToGroup tid gid -> do
-          void $ query $ H.tell $ \q -> Bar.AssignTabToGroup tid gid q 
-          pure Nothing
-
-        BgTabCreated tab -> do
-          void $ query $ H.tell $ \q -> Bar.TabsQuery (Tabs.TabCreated tab q)
-          pure Nothing
-
-        BgTabDeleted tabId -> do
-          void $ query $ H.request $ \q -> Bar.TabsQuery (Tabs.TabDeleted tabId q)
-          pure Nothing
-
-        BgTabActivated prev next -> do
-          void $ query $ H.tell $ \q -> Bar.TabsQuery (Tabs.TabActivated prev next q)
-          pure Nothing
-
-        BgTabMoved tabId prev next -> do
-          void $ query $ H.tell $ \q -> Bar.TabsQuery (Tabs.TabMoved tabId next q)
-          pure Nothing
-
-        BgTabUpdated tabId cinfo tab -> do
-          void $ query $ H.tell $ \q -> Bar.TabsQuery (Tabs.TabInfoChanged tabId (fillChangeInfoIfEmpty tab cinfo) q)
-          pure Nothing
-
-        BgTabDetached tabId -> do 
-          void $ query $ H.tell $ \q -> Bar.TabsQuery (Tabs.TabDetached tabId q)
-          pure Nothing
-
-        BgTabAttached tab -> do 
-          void $ query $ H.tell $ \q -> Bar.TabsQuery (Tabs.TabAttached tab q)
-          pure Nothing
-
-        BgGroupDeleted gid currentTid -> do
-           void $ query $ H.tell $ Bar.GroupDeleted gid currentTid
-           pure Nothing
-
-fillChangeInfoIfEmpty :: Tab -> ChangeInfo -> ChangeInfo
-fillChangeInfoIfEmpty (Tab tab) = 
-  case _ of 
-      ChangeInfo { attention: Nothing
-                 , audible: Nothing
-                 , discarded: Nothing
-                 , favIconUrl: Nothing
-                 , hidden: Nothing
-                 , isArticle: Nothing
-                 , pinned: Nothing
-                 , status: Just "complete"
-                 , title: Nothing
-                 , url: Nothing 
-                 } ->
-            ChangeInfo { attention: tab.attention
-            , audible: tab.audible
-            , discarded: tab.discarded
-            , favIconUrl: tab.favIconUrl
-            , hidden: Just tab.hidden
-            , isArticle: tab.isArticle
-            , pinned: Just tab.pinned
-            , status: Just "complete"
-            , title: Just tab.title
-            , url: tab.url
-            }
-      cinfo -> cinfo
-
-onSidebarMsg :: Runtime.Port -> CR.Consumer SidebarEvent Aff Unit
-onSidebarMsg port =
-  CR.consumer \(msg) -> do
-    liftEffect $ Runtime.postMessageJson port msg
-    pure Nothing

src/Sidebar/Utils.purs

@@ -1,15 +0,0 @@
-module Sidebar.Utils (whenC, moveElem) where 
-
-import Data.Array ((!!), insertAt, deleteAt) as A
-import Data.Maybe (Maybe)
-import Halogen (ClassName(..))
-import Prelude (bind, (>=>))
-
-
-whenC :: Boolean -> ClassName -> ClassName
-whenC b c = if b then c else ClassName ""
-
-moveElem :: forall a. Int -> Int -> Array a -> Maybe (Array a)
-moveElem from to arr = do
-  elem <- arr A.!! from
-  (A.deleteAt from >=> A.insertAt to elem) arr

src/sidebar.js

@@ -1,7 +1 @@
-var Sidebar = require("../output/PureTabs.Sidebar");
-
-function main() {
-  Sidebar.main();
-}
-
-main();
+console.log("[sidebar] hello");