feat: add tab move support and keep track of tabs position

package-lock.json

@@ -1945,6 +1945,62 @@
         "typedarray": "^0.0.6"
       }
     },
+    "concurrently": {
+      "version": "5.2.0",
+      "resolved": "https://registry.npmjs.org/concurrently/-/concurrently-5.2.0.tgz",
+      "integrity": "sha512-XxcDbQ4/43d6CxR7+iV8IZXhur4KbmEJk1CetVMUqCy34z9l0DkszbY+/9wvmSnToTej0SYomc2WSRH+L0zVJw==",
+      "dev": true,
+      "requires": {
+        "chalk": "^2.4.2",
+        "date-fns": "^2.0.1",
+        "lodash": "^4.17.15",
+        "read-pkg": "^4.0.1",
+        "rxjs": "^6.5.2",
+        "spawn-command": "^0.0.2-1",
+        "supports-color": "^6.1.0",
+        "tree-kill": "^1.2.2",
+        "yargs": "^13.3.0"
+      },
+      "dependencies": {
+        "supports-color": {
+          "version": "6.1.0",
+          "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-6.1.0.tgz",
+          "integrity": "sha512-qe1jfm1Mg7Nq/NSh6XE24gPXROEVsWHxC1LIx//XNlD9iw7YZQGjZNjYN7xGaEG6iKdA8EtNFW6R0gjnVXp+wQ==",
+          "dev": true,
+          "requires": {
+            "has-flag": "^3.0.0"
+          }
+        },
+        "yargs": {
+          "version": "13.3.2",
+          "resolved": "https://registry.npmjs.org/yargs/-/yargs-13.3.2.tgz",
+          "integrity": "sha512-AX3Zw5iPruN5ie6xGRIDgqkT+ZhnRlZMLMHAs8tg7nRruy2Nb+i5o9bwghAogtM08q1dpr2LVoS8KSTMYpWXUw==",
+          "dev": true,
+          "requires": {
+            "cliui": "^5.0.0",
+            "find-up": "^3.0.0",
+            "get-caller-file": "^2.0.1",
+            "require-directory": "^2.1.1",
+            "require-main-filename": "^2.0.0",
+            "set-blocking": "^2.0.0",
+            "string-width": "^3.0.0",
+            "which-module": "^2.0.0",
+            "y18n": "^4.0.0",
+            "yargs-parser": "^13.1.2"
+          }
+        },
+        "yargs-parser": {
+          "version": "13.1.2",
+          "resolved": "https://registry.npmjs.org/yargs-parser/-/yargs-parser-13.1.2.tgz",
+          "integrity": "sha512-3lbsNRf/j+A4QuSZfDRA7HRSfWrzO0YjqTJd5kjAq37Zep1CEgaYmrH9Q3GwPiB9cHyd1Y1UwggGhJGoxipbzg==",
+          "dev": true,
+          "requires": {
+            "camelcase": "^5.0.0",
+            "decamelize": "^1.2.0"
+          }
+        }
+      }
+    },
     "console-browserify": {
       "version": "1.2.0",
       "resolved": "https://registry.npmjs.org/console-browserify/-/console-browserify-1.2.0.tgz",
@@ -2379,6 +2435,12 @@
         "whatwg-url": "^7.0.0"
       }
     },
+    "date-fns": {
+      "version": "2.13.0",
+      "resolved": "https://registry.npmjs.org/date-fns/-/date-fns-2.13.0.tgz",
+      "integrity": "sha512-xm0c61mevGF7f0XpCGtDTGpzEFC/1fpLXHbmFpxZZQJuvByIK2ozm6cSYuU+nxFYOPh2EuCfzUwlTEFwKG+h5w==",
+      "dev": true
+    },
     "deasync": {
       "version": "0.1.19",
       "resolved": "https://registry.npmjs.org/deasync/-/deasync-0.1.19.tgz",
@@ -3865,6 +3927,12 @@
         "minimalistic-crypto-utils": "^1.0.1"
       }
     },
+    "hosted-git-info": {
+      "version": "2.8.8",
+      "resolved": "https://registry.npmjs.org/hosted-git-info/-/hosted-git-info-2.8.8.tgz",
+      "integrity": "sha512-f/wzC2QaWBs7t9IYqB4T3sR1xviIViXJRJTWBlx2Gf3g0Xi5vI7Yy4koXQ1c9OYDGHN9sBy1DQ2AB8fqZBWhUg==",
+      "dev": true
+    },
     "hsl-regex": {
       "version": "1.0.0",
       "resolved": "https://registry.npmjs.org/hsl-regex/-/hsl-regex-1.0.0.tgz",
@@ -4846,6 +4914,18 @@
       "integrity": "sha512-9ui7CGtOOlehQu0t/OhhlmDyc71mKVlv+4vF+me4iZLPrNtRL2xoquEdfZxasC/bdQi/Hr3iTrpyRKIG+ocabA==",
       "dev": true
     },
+    "normalize-package-data": {
+      "version": "2.5.0",
+      "resolved": "https://registry.npmjs.org/normalize-package-data/-/normalize-package-data-2.5.0.tgz",
+      "integrity": "sha512-/5CMN3T0R4XTj4DcGaexo+roZSdSFW/0AOOTROrjxzCG1wrWXEsGbRKevjlIL+ZDE4sZlJr5ED4YW0yqmkK+eA==",
+      "dev": true,
+      "requires": {
+        "hosted-git-info": "^2.1.4",
+        "resolve": "^1.10.0",
+        "semver": "2 || 3 || 4 || 5",
+        "validate-npm-package-license": "^3.0.1"
+      }
+    },
     "normalize-path": {
       "version": "3.0.0",
       "resolved": "https://registry.npmjs.org/normalize-path/-/normalize-path-3.0.0.tgz",
@@ -5250,6 +5330,12 @@
       "integrity": "sha1-GN4vl+S/epVRrXURlCtUlverpmA=",
       "dev": true
     },
+    "pify": {
+      "version": "3.0.0",
+      "resolved": "https://registry.npmjs.org/pify/-/pify-3.0.0.tgz",
+      "integrity": "sha1-5aSs0sEB/fPZpNB/DbxNtJ3SgXY=",
+      "dev": true
+    },
     "pkg-up": {
       "version": "3.1.0",
       "resolved": "https://registry.npmjs.org/pkg-up/-/pkg-up-3.1.0.tgz",
@@ -5883,6 +5969,17 @@
       "integrity": "sha512-Hrgsx+orqoygnmhFbKaHE6c296J+HTAQXoxEF6gNupROmmGJRoyzfG3ccAveqCBrwr/2yxQ5BVd/GTl5agOwSg==",
       "dev": true
     },
+    "read-pkg": {
+      "version": "4.0.1",
+      "resolved": "https://registry.npmjs.org/read-pkg/-/read-pkg-4.0.1.tgz",
+      "integrity": "sha1-ljYlN48+HE1IyFhytabsfV0JMjc=",
+      "dev": true,
+      "requires": {
+        "normalize-package-data": "^2.3.2",
+        "parse-json": "^4.0.0",
+        "pify": "^3.0.0"
+      }
+    },
     "readable-stream": {
       "version": "2.3.7",
       "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-2.3.7.tgz",
@@ -6133,6 +6230,15 @@
         "inherits": "^2.0.1"
       }
     },
+    "rxjs": {
+      "version": "6.5.5",
+      "resolved": "https://registry.npmjs.org/rxjs/-/rxjs-6.5.5.tgz",
+      "integrity": "sha512-WfQI+1gohdf0Dai/Bbmk5L5ItH5tYqm3ki2c5GdWhKjalzjg93N3avFjVStyZZz+A2Em+ZxKH5bNghw9UeylGQ==",
+      "dev": true,
+      "requires": {
+        "tslib": "^1.9.0"
+      }
+    },
     "safe-buffer": {
       "version": "5.1.2",
       "resolved": "https://registry.npmjs.org/safe-buffer/-/safe-buffer-5.1.2.tgz",
@@ -6497,6 +6603,44 @@
       "integrity": "sha1-PpNdfd1zYxuXZZlW1VEo6HtQhKM=",
       "dev": true
     },
+    "spawn-command": {
+      "version": "0.0.2-1",
+      "resolved": "https://registry.npmjs.org/spawn-command/-/spawn-command-0.0.2-1.tgz",
+      "integrity": "sha1-YvXpRmmBwbeW3Fkpk34RycaSG9A=",
+      "dev": true
+    },
+    "spdx-correct": {
+      "version": "3.1.0",
+      "resolved": "https://registry.npmjs.org/spdx-correct/-/spdx-correct-3.1.0.tgz",
+      "integrity": "sha512-lr2EZCctC2BNR7j7WzJ2FpDznxky1sjfxvvYEyzxNyb6lZXHODmEoJeFu4JupYlkfha1KZpJyoqiJ7pgA1qq8Q==",
+      "dev": true,
+      "requires": {
+        "spdx-expression-parse": "^3.0.0",
+        "spdx-license-ids": "^3.0.0"
+      }
+    },
+    "spdx-exceptions": {
+      "version": "2.3.0",
+      "resolved": "https://registry.npmjs.org/spdx-exceptions/-/spdx-exceptions-2.3.0.tgz",
+      "integrity": "sha512-/tTrYOC7PPI1nUAgx34hUpqXuyJG+DTHJTnIULG4rDygi4xu/tfgmq1e1cIRwRzwZgo4NLySi+ricLkZkw4i5A==",
+      "dev": true
+    },
+    "spdx-expression-parse": {
+      "version": "3.0.1",
+      "resolved": "https://registry.npmjs.org/spdx-expression-parse/-/spdx-expression-parse-3.0.1.tgz",
+      "integrity": "sha512-cbqHunsQWnJNE6KhVSMsMeH5H/L9EpymbzqTQ3uLwNCLZ1Q481oWaofqH7nO6V07xlXwY6PhQdQ2IedWx/ZK4Q==",
+      "dev": true,
+      "requires": {
+        "spdx-exceptions": "^2.1.0",
+        "spdx-license-ids": "^3.0.0"
+      }
+    },
+    "spdx-license-ids": {
+      "version": "3.0.5",
+      "resolved": "https://registry.npmjs.org/spdx-license-ids/-/spdx-license-ids-3.0.5.tgz",
+      "integrity": "sha512-J+FWzZoynJEXGphVIS+XEh3kFSjZX/1i9gFBaWQcB+/tmpe2qUsSBABpcxqxnAxFdiUFEgAX1bjYGQvIZmoz9Q==",
+      "dev": true
+    },
     "split-string": {
       "version": "3.1.0",
       "resolved": "https://registry.npmjs.org/split-string/-/split-string-3.1.0.tgz",
@@ -6890,6 +7034,18 @@
         "punycode": "^2.1.0"
       }
     },
+    "tree-kill": {
+      "version": "1.2.2",
+      "resolved": "https://registry.npmjs.org/tree-kill/-/tree-kill-1.2.2.tgz",
+      "integrity": "sha512-L0Orpi8qGpRG//Nd+H90vFB+3iHnue1zSSGmNOOCh1GLJ7rUKVwV2HvijphGQS2UmhUZewS9VgvxYIdgr+fG1A==",
+      "dev": true
+    },
+    "tslib": {
+      "version": "1.12.0",
+      "resolved": "https://registry.npmjs.org/tslib/-/tslib-1.12.0.tgz",
+      "integrity": "sha512-5rxCQkP0kytf4H1T4xz1imjxaUUPMvc5aWp0rJ/VMIN7ClRiH1FwFvBt8wOeMasp/epeUnmSW6CixSIePtiLqA==",
+      "dev": true
+    },
     "tty-browserify": {
       "version": "0.0.0",
       "resolved": "https://registry.npmjs.org/tty-browserify/-/tty-browserify-0.0.0.tgz",
@@ -7151,6 +7307,16 @@
       "integrity": "sha512-usZBT3PW+LOjM25wbqIlZwPeJV+3OSz3M1k1Ws8snlW39dZyYL9lOGC5FgPVHfk0jKmjiDV8Z0mIbVQPiwFs7g==",
       "dev": true
     },
+    "validate-npm-package-license": {
+      "version": "3.0.4",
+      "resolved": "https://registry.npmjs.org/validate-npm-package-license/-/validate-npm-package-license-3.0.4.tgz",
+      "integrity": "sha512-DpKm2Ui/xN7/HQKCtpZxoRWBhZ9Z0kqtygG8XCgNQ8ZlDnxuQmWhj566j8fN4Cu3/JmbhsDo7fcAJq4s9h27Ew==",
+      "dev": true,
+      "requires": {
+        "spdx-correct": "^3.0.0",
+        "spdx-expression-parse": "^3.0.0"
+      }
+    },
     "vendors": {
       "version": "1.0.4",
       "resolved": "https://registry.npmjs.org/vendors/-/vendors-1.0.4.tgz",

package.json

@@ -7,13 +7,14 @@
   },
   "scripts": {
     "parcel": "parcel",
-    "dev": "spago build --watch & parcel watch src/background.js -d extension/",
-    "build": "spago build && parcel build src/background.js -d extension/",
+    "dev": "concurrently --kill-others \"spago build --watch\" \"parcel watch src/background.js src/sidebar.js -d extension/\"",
+    "build": "spago build && parcel build src/background.js src/sidebar.js -d extension/",
     "test": "echo \"Error: no test specified\" && exit 1"
   },
   "author": "",
   "license": "ISC",
   "devDependencies": {
+    "concurrently": "^5.2.0",
     "parcel": "^1.12.4"
   }
 }

src/Background.purs

@@ -2,25 +2,25 @@ module PureTabs.Background where
 
 import Browser.Runtime as Runtime
 import Browser.Tabs (Tab, TabId, WindowId, query, removeOne, activateTab)
-import Browser.Tabs.OnActivated as TabsOnActivated
-import Browser.Tabs.OnCreated as TabsOnCreated
-import Browser.Tabs.OnRemoved as TabsOnRemoved
-import Browser.Tabs.OnUpdated (ChangeInfo(..))
-import Browser.Tabs.OnUpdated as TabsOnUpdated
+import Browser.Tabs.OnActivated as OnActivated
+import Browser.Tabs.OnCreated as OnCreated
+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 Control.Alt ((<$>))
-import Control.Alternative (pure, (*>))
+import Control.Alt ((<#>))
+import Control.Alternative (empty, pure, (*>))
 import Control.Bind ((>>=))
 import Control.Category (identity, (>>>))
-import Data.Array (fromFoldable)
+import Data.Array (catMaybes, deleteAt, foldl, fromFoldable, insertAt, mapWithIndex, (!!))
 import Data.Foldable (for_)
-import Data.Function (flip)
-import Data.Lens (_Just, over, preview, set)
+import Data.Function (flip, (#))
+import Data.Lens (_Just, over, preview, set, view)
 import Data.Lens.At (at)
 import Data.Lens.Iso.Newtype (_Newtype)
-import Data.List (List, foldr, foldMap)
-import Data.Map (empty, lookup, values)
-import Data.Maybe (Maybe(..), maybe)
+import Data.List (List, foldMap, foldr)
+import Data.Map as M
+import Data.Maybe (Maybe(..), maybe, maybe')
 import Data.Monoid ((<>))
 import Data.Newtype (unwrap)
 import Data.Show (show)
@@ -30,9 +30,10 @@ import Effect (Effect)
 import Effect.Aff (Aff, launchAff_)
 import Effect.Class (liftEffect)
 import Effect.Console (log)
+import Effect.Exception.Unsafe (unsafeThrow)
 import Effect.Ref as Ref
 import Prelude (Unit, bind, ($), discard, (<<<))
-import PureTabs.Model (BackgroundEvent(..), GlobalState, SidebarEvent(..), _active, _port, _portFromWindow, _portFromWindowId, _tabFromTabIdAndWindow, _tabFromWindow, _windows, tabsToGlobalState)
+import PureTabs.Model (BackgroundEvent(..), GlobalState, SidebarEvent(..), _active, _index, _port, _portFromWindow, _portFromWindowId, _positions, _tabFromTabIdAndWindow, _tabFromWindow, _tabs, _windowIdToWindow, _windows, tabsToGlobalState)
 
 type Ports
   = Ref.Ref (List Runtime.Port)
@@ -45,18 +46,22 @@ main = do
   runMain :: Aff Unit
   runMain = do
     allTabs <- query
+    traceM allTabs
     liftEffect
       $ do
           state <- Ref.new $ tabsToGlobalState allTabs
+          readState <- Ref.read state
+          traceM readState
           initializeBackground state
           log "all listener initialized"
 
 initializeBackground :: Ref.Ref GlobalState -> Effect Unit
 initializeBackground ref = do
-  TabsOnCreated.addListener $ onTabCreated ref
-  (mkListenerTwo $ onTabDeleted ref) >>= TabsOnRemoved.addListener 
-  TabsOnActivated.addListener $ onTabActived ref
-  TabsOnUpdated.addListener $ onTabUpdated ref
+  OnCreated.addListener $ onTabCreated ref
+  (mkListenerTwo $ onTabDeleted ref) >>= OnRemoved.addListener
+  OnActivated.addListener $ onTabActived ref
+  OnUpdated.addListener $ onTabUpdated ref
+  (mkListenerTwo $ onTabMoved ref) >>= OnMoved.addListener
   (mkListenerOne $ onConnect ref) >>= Runtime.onConnectAddListener
 
 onTabCreated :: (Ref.Ref GlobalState) -> Tab -> Effect Unit
@@ -71,16 +76,56 @@ onTabCreated stateRef tab' = do
   where
   tab = unwrap tab'
 
-onTabUpdated :: (Ref.Ref GlobalState) -> TabId -> ChangeInfo -> Tab -> Effect Unit
+onTabUpdated :: (Ref.Ref GlobalState) -> TabId -> OnUpdated.ChangeInfo -> Tab -> Effect Unit
 onTabUpdated stateRef tid cinfo tab' = do
   state <- Ref.modify (set (_tabFromWindow tab') (Just tab')) stateRef
   case (preview (_portFromWindow tab') state) of
     Nothing -> pure unit
     Just port -> Runtime.postMessageJson port $ BgTabUpdated tid cinfo tab'
 
-onTabActived :: (Ref.Ref GlobalState) -> TabsOnActivated.ActiveInfo -> Effect Unit
-onTabActived stateRef (TabsOnActivated.ActiveInfo aInfo) = do
-  traceM aInfo
+onTabMoved :: (Ref.Ref GlobalState) -> TabId -> OnMoved.MoveInfo -> Effect Unit
+onTabMoved ref tid minfo = do
+  s <- Ref.modify (updateState minfo) ref
+  case (preview (_portFromWindowId minfo.windowId) s) of
+    Nothing -> pure unit
+    Just port -> Runtime.postMessageJson port $ BgTabMoved tid minfo.fromIndex minfo.toIndex
+  where
+  updateState :: OnMoved.MoveInfo -> GlobalState -> GlobalState
+  updateState minfo' state =
+    let
+      newState = updatePositions minfo' state
+
+      newPositions :: Array TabId
+      newPositions = view ((_windowIdToWindow minfo'.windowId) <<< _positions) newState
+    in
+      over ((_windowIdToWindow minfo'.windowId) <<< _tabs) (updateTabsIndex newPositions) newState
+
+  updatePositions :: OnMoved.MoveInfo -> GlobalState -> GlobalState
+  updatePositions minfo' = over ((_windowIdToWindow minfo'.windowId) <<< _positions) $ unsafeUpdatePositions minfo'
+
+  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 = mapWithIndex (\idx tid' -> set (at tid' <<< _Just <<< _Newtype <<< _index) idx) positions
+    in
+      foldl (#) tabs modifyFuncs
+
+  unsafeUpdatePositions :: OnMoved.MoveInfo -> Array TabId -> Array TabId
+  unsafeUpdatePositions minfo' =
+    (moveElement minfo'.fromIndex minfo'.toIndex)
+      -- the indexes should exist, we need to revisit the code if it doesn't
+      
+      >>> (maybe' (\_ -> unsafeThrow "invalid indexes") identity)
+
+  moveElement :: forall a. Int -> Int -> Array a -> Maybe (Array a)
+  moveElement from to arr = do
+    tab <- arr !! from
+    deleteAt from arr >>= insertAt to tab
+
+onTabActived :: (Ref.Ref GlobalState) -> OnActivated.ActiveInfo -> Effect Unit
+onTabActived stateRef (OnActivated.ActiveInfo aInfo) = do
+  log $ "activated " <> show aInfo.tabId
   state <- Ref.modify (updateGlobalState aInfo.previousTabId aInfo.tabId) stateRef
   case (preview (_portFromWindowId aInfo.windowId) state) of
     Nothing -> pure unit
@@ -105,7 +150,7 @@ onTabActived stateRef (TabsOnActivated.ActiveInfo aInfo) = do
     in
       (prevTabF >>> newTabF) state
 
-onTabDeleted :: (Ref.Ref GlobalState) -> TabId -> TabsOnRemoved.RemoveInfo -> Effect Unit
+onTabDeleted :: (Ref.Ref GlobalState) -> TabId -> OnRemoved.RemoveInfo -> Effect Unit
 onTabDeleted stateRef tabId info = do
   state <- Ref.read stateRef
   let
@@ -135,15 +180,12 @@ onConnect stateRef' port = do
     SbHasWindowId winId -> log ("bg: created winId " <> show winId) *> callback winId
     _ -> pure unit
 
+-- | Initialize the data and the listeners of a new window, and send the current window state.
 onNewWindowId ::
   forall a.
   Runtime.Port ->
   (Ref.Ref GlobalState) ->
-  ( Ref.Ref
-      ( Maybe
-          (Listener a)
-      )
-  ) ->
+  (Ref.Ref (Maybe (Listener a))) ->
   WindowId -> Effect Unit
 onNewWindowId port stateRef listenerRef winId = do
   -- initial state of the current window
@@ -154,19 +196,27 @@ onNewWindowId port stateRef listenerRef winId = do
   Ref.write Nothing listenerRef
   -- send initial tabs
   maybe (pure unit)
-    (\w -> Runtime.postMessageJson port $ BgInitialTabList $ fromFoldable $ values w.tabs)
-    (lookup winId r.windows)
+    ( \w ->
+        Runtime.postMessageJson port
+          $ BgInitialTabList
+          $ fromFoldable
+          $ w.positions
+          <#> (flip M.lookup w.tabs)
+          # catMaybes
+    )
+    (M.lookup winId r.windows)
   --  add the new onMessage listener
   sidebarListener <- Runtime.onMessageJsonAddListener port $ manageSidebar stateRef port
   onDisconnectListener <- mkListenerUnit $ onDisconnect stateRef winId sidebarListener
   Runtime.portOnDisconnect port onDisconnectListener
 
+-- | Set the port of a new window connecting. If the window doesn't exist, initialize a new data
 initWindowState :: Runtime.Port -> (Ref.Ref GlobalState) -> WindowId -> Effect GlobalState
 initWindowState port ref winId =
   (flip Ref.modify) ref
     $ over (_windows <<< (at winId))
         ( case _ of
-            Nothing -> Just $ { tabs: empty, port: Just port }
+            Nothing -> Just $ { tabs: M.empty, port: Just port, positions: empty }
             Just win -> Just $ set _port (Just port) win
         )
 

src/Browser/Tabs.purs

@@ -77,7 +77,7 @@ newtype Tab
   -- should be optional
   , id :: TabId
   , incognito :: Boolean
-  , index :: Number
+  , index :: Int
   , isArticle :: Maybe Boolean
   , isInReaderMode :: Boolean
   , lastAccessed :: Number

src/Browser/Tabs/OnMoved.js

@@ -1,3 +1,15 @@
 "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,19 +1,16 @@
-module Browser.Tabs.OnMoved (addListener, removeListener) where
+module Browser.Tabs.OnMoved (addListener, removeListener, MoveInfo) where
 
-import Browser.Tabs (TabId(..), WindowId)
-import Browser.Utils (Listener2, UnregisteredListener2)
-import Control.Alternative (pure)
-import Data.Unit (Unit, unit)
+import Browser.Tabs (TabId, WindowId)
+import Browser.Utils (Listener2)
+import Data.Unit (Unit)
 import Effect (Effect)
-import Undefined (undefined)
 
-type MoveInfo = { windowId :: WindowId
-  , fromIndex :: Number
-  , toIndex :: Number
-} 
+type MoveInfo
+  = { windowId :: WindowId
+    , fromIndex :: Int
+    , toIndex :: Int
+    }
 
-addListener :: (UnregisteredListener2 TabId MoveInfo) -> Effect Unit
-addListener lst = undefined
+foreign import addListener :: (Listener2 TabId MoveInfo) -> Effect Unit
 
-removeListener :: (Listener2 TabId MoveInfo) -> Effect Unit
-removeListener lst = undefined
+foreign import removeListener :: (Listener2 TabId MoveInfo) -> Effect Unit

src/JQuery/Ext.js

@@ -0,0 +1,10 @@
+"use strict";
+
+exports.after = function(ob) {
+    return function(ob1) {
+        return function() {
+            ob1.after(ob);
+        };
+    };
+};
+

src/JQuery/Ext.purs

@@ -0,0 +1,7 @@
+module JQuery.Ext (after) where
+
+import Prelude (Unit)
+import Effect (Effect)
+import JQuery (JQuery)
+
+foreign import after :: JQuery -> JQuery -> Effect Unit

src/Model.purs

@@ -1,17 +1,20 @@
 module PureTabs.Model
   ( Window
   , GlobalState
-  , _id
   , _active
-  , _tabs
+  , _id
+  , _index
   , _port
-  , _windows
   , _portFromWindow
   , _portFromWindowId
+  , _positions
+  , _tabFromTabIdAndWindow
   , _tabFromWindow
-  , _tabWindowId
   , _tabId
-  , _tabFromTabIdAndWindow
+  , _tabs
+  , _tabWindowId
+  , _windowIdToWindow
+  , _windows
   , initialGlobalState
   , tabsToGlobalState
   , BackgroundEvent(..)
@@ -19,115 +22,132 @@ module PureTabs.Model
   ) where
 
 import Browser.Runtime (Port)
-import Browser.Tabs (TabId, WindowId, Tab)
+import Browser.Tabs (TabId, WindowId, Tab(..))
 import Browser.Tabs.OnUpdated (ChangeInfo(..))
-import Control.Alt (map)
+import Control.Alternative (empty)
 import Control.Bind (join)
-import Data.Function (($))
+import Control.Category ((>>>), (<<<))
+import Data.Array (sortBy)
+import Data.Function (on, ($))
+import Data.Functor (map)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
 import Data.Lens (Lens', Traversal', _Just, view)
 import Data.Lens.At (at)
 import Data.Lens.Iso.Newtype (_Newtype)
 import Data.Lens.Record (prop)
-import Data.List (List, catMaybes, head)
-import Data.Map (Map, empty, fromFoldableWith, lookup, singleton, union, values)
+import Data.List (List(..), catMaybes, concat, head, singleton)
+import Data.Map as M
 import Data.Maybe (Maybe(..))
-import Data.Newtype (unwrap)
+import Data.Ord (compare)
 import Data.Show (class Show)
 import Data.Symbol (SProxy(..))
-import Data.Tuple (Tuple(..))
-import Prelude ((<<<))
+import Data.Tuple (Tuple(..), fst, snd, uncurry)
+import Data.Tuple.Nested ((/\))
+
+type GlobalState
+  = { windows :: M.Map WindowId Window
+    }
 
 type Window
-  = { tabs :: Map TabId Tab
+  = { positions :: Array TabId
+    , tabs :: M.Map TabId Tab
     , port :: Maybe Port
     }
 
 _tabs :: forall a r. Lens' { tabs :: a | r } a
-_tabs = prop (SProxy ::_ "tabs")
+_tabs = prop (SProxy :: _ "tabs")
 
 _port :: forall a r. Lens' { port :: a | r } a
-_port = prop (SProxy ::_ "port")
-
-type GlobalState
-  = { windows :: Map WindowId Window
-    }
+_port = prop (SProxy :: _ "port")
 
 _windows :: forall a r. Lens' { windows :: a | r } a
-_windows = prop (SProxy ::_ "windows")
+_windows = prop (SProxy :: _ "windows")
 
 _title :: forall a r. Lens' { title :: a | r } a
-_title = prop (SProxy ::_ "title")
+_title = prop (SProxy :: _ "title")
+
+_index :: forall a r. Lens' { index :: a | r } a
+_index = prop (SProxy :: _ "index")
 
 _tabTitle :: Lens' Tab String
 _tabTitle = _Newtype <<< _title
 
 _id :: forall a r. Lens' { id :: a | r } a
-_id = prop (SProxy ::_ "id")
+_id = prop (SProxy :: _ "id")
 
 _active :: forall a r. Lens' { active :: a | r } a
-_active = prop (SProxy ::_ "active")
+_active = prop (SProxy :: _ "active")
 
 _tabId :: Lens' Tab TabId
 _tabId = _Newtype <<< _id
 
 _windowId :: forall a r. Lens' { windowId :: a | r } a
-_windowId = prop (SProxy ::_ "windowId")
+_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' = _portFromWindowId tab.windowId
-  where
-  tab = unwrap tab'
+_portFromWindow (Tab tab) = _portFromWindowId tab.windowId
 
 _portFromWindowId :: WindowId -> Traversal' GlobalState Port
-_portFromWindowId wid = _windows <<< (at wid) <<< _Just <<< _port <<< _Just
+_portFromWindowId wid = _windowIdToWindow wid <<< _port <<< _Just
+
+_windowIdToWindow :: WindowId -> Traversal' GlobalState Window
+_windowIdToWindow wid = _windows <<< (at wid) <<< _Just
 
 _tabFromWindow :: Tab -> Traversal' GlobalState (Maybe Tab)
-_tabFromWindow tab' = _windows <<< (at tab.windowId) <<< _Just <<< _tabs <<< (at tab.id)
-  where
-  tab = unwrap tab'
+_tabFromWindow (Tab tab) = _windowIdToWindow tab.windowId <<< _tabs <<< (at tab.id)
 
 _tabFromTabIdAndWindow :: GlobalState -> TabId -> Maybe Tab
 _tabFromTabIdAndWindow s tabId =
   let
-    allWindows = values s.windows
+    allWindows = M.values s.windows
 
     allTabs = map (view _tabs) allWindows
 
-    matchingTabId = map (lookup tabId) allTabs
+    matchingTabId = map (M.lookup tabId) allTabs
   in
     join $ head matchingTabId
 
 initialGlobalState :: GlobalState
 initialGlobalState =
-  { windows: empty
+  { windows: M.empty
   }
 
 tabsToGlobalState :: List Tab -> GlobalState
 tabsToGlobalState tabs = { windows: tabsToWindows tabs }
   where
-  tabsToWindows :: List Tab -> Map WindowId Window
-  tabsToWindows tabs' =
-    fromFoldableWith
-      (\v1 v2 -> { tabs: union v1.tabs v2.tabs, port: Nothing })
-      $ map
-          ( \t ->
-              Tuple
-                (view _tabWindowId t)
-                { tabs: singleton (view _tabId t) t, port: Nothing }
-          )
-          tabs'
+  tabsToWindows :: List Tab -> M.Map WindowId Window
+  tabsToWindows tabs' = M.fromFoldableWith merge $ map mapTab tabs'
+
+  merge :: Window -> Window -> Window
+  merge w1 w2 =
+    let
+      mergedMap = M.union w1.tabs w2.tabs
+    in
+      { tabs: mergedMap
+      , port: Nothing
+      -- TODO do that after building the state, to avoid going creating a new list each time
+      , positions: (mapPositions >>> (sortBy (compare `on` snd)) >>> (map fst)) mergedMap
+      }
+
+  mapTab :: Tab -> Tuple WindowId Window
+  mapTab (Tab t) = Tuple t.windowId { tabs: M.singleton t.id (Tab t), port: Nothing, positions: empty }
+
+  mapPositions :: M.Map TabId Tab -> Array (Tuple TabId Int)
+  mapPositions = M.toUnfoldableUnordered >>> (map \(Tuple tid (Tab t)) -> tid /\ t.index)
 
 data BackgroundEvent
   = BgInitialTabList (Array Tab)
   | BgTabCreated Tab
   | BgTabDeleted TabId
   | BgTabUpdated TabId ChangeInfo Tab
-  | BgTabMoved
+  | BgTabMoved TabId Int Int
   | BgTabActived (Maybe TabId) TabId
   | BgTabAttached Tab
   | BgTabDetached TabId

src/Sidebar.purs

@@ -6,12 +6,12 @@ import Browser.Tabs.OnUpdated (ChangeInfo(..))
 import Browser.Windows (getCurrent)
 import Control.Alternative (pure)
 import Control.Bind ((>=>), (>>=))
+import Data.CommutativeRing ((+))
+import Data.Eq ((==))
 import Data.Foldable (traverse_)
 import Data.Function (flip)
-import Data.Lens (view)
 import Data.Maybe (Maybe(..), maybe)
 import Data.Monoid ((<>))
-import Data.Newtype (unwrap)
 import Data.Show (show)
 import Data.Unit (unit)
 import Debug.Trace (traceM)
@@ -20,8 +20,9 @@ import Effect.Aff (Aff, launchAff_)
 import Effect.Class (liftEffect)
 import Effect.Console (log)
 import JQuery as J
+import JQuery.Ext (after) as J
 import Prelude (Unit, bind, ($), discard)
-import PureTabs.Model (BackgroundEvent(..), SidebarEvent(..), _tabId)
+import PureTabs.Model (BackgroundEvent(..), SidebarEvent(..))
 
 main :: Effect Unit
 main = do
@@ -52,12 +53,11 @@ initSidebar port winId = do
     BgInitialTabList tabs -> traverse_ (createTabElement port >=> (flip J.append) contentDiv) tabs
     BgTabUpdated tid cinfo tab -> updateTabInfo tid cinfo tab
     BgTabActived prev new -> activateTab prev new
+    BgTabMoved tid prevPos newPos -> moveTab tid prevPos newPos
     _ -> log "received unsupported message type"
 
 createTabElement :: Runtime.Port -> Tab -> Effect J.JQuery
-createTabElement port tab' = do
-  let
-    tab = unwrap tab'
+createTabElement port (Tab tab) = do
   tabDiv <- J.create "<div>"
   J.setAttr "class" "tab" tabDiv
   J.setAttr "id" tab.id tabDiv
@@ -80,10 +80,10 @@ createTabElement port tab' = do
   pure tabDiv
   where
   onCloseClick :: J.JQueryEvent -> J.JQuery -> Effect Unit
-  onCloseClick event j = Runtime.postMessageJson port $ SbTabDeleted $ view _tabId tab'
+  onCloseClick event j = Runtime.postMessageJson port $ SbTabDeleted tab.id
 
   onTabClick :: J.JQueryEvent -> J.JQuery -> Effect Unit
-  onTabClick event j = Runtime.postMessageJson port $ SbTabActived $ view _tabId tab'
+  onTabClick event j = Runtime.postMessageJson port $ SbTabActived tab.id
 
 createCloseButton :: Effect J.JQuery
 createCloseButton = do
@@ -125,3 +125,15 @@ activateTab prev new = do
   maybe (pure unit) (\p -> (J.select ("#" <> (show p))) >>= J.setClass "active" false) prev
   newTab <- J.select ("#" <> (show new))
   J.setClass "active" true newTab
+
+moveTab :: TabId -> Int -> Int -> Effect Unit
+moveTab tabId prev new =
+  do
+    tabDiv <- J.select $ "#" <> show tabId
+    J.remove tabDiv
+    if new == 0 then do
+      firstChild <- J.select $ "#tabs > .tab:nth-child(" <> (show $ new + 1) <> ")"
+      J.before tabDiv firstChild
+    else do
+      child <- J.select $ "#tabs > .tab:nth-child(" <> (show $ new) <> ")"
+      J.after tabDiv child