Просмотр исходного кода

feat: add group to the global state, rewrite global state init function

Jocelyn Boullier 5 лет назад
Родитель
Сommit
25ed344a87
2 измененных файлов с 73 добавлено и 36 удалено
  1. 26 12
      src/Background.purs
  2. 47 24
      src/Model.purs

+ 26 - 12
src/Background.purs

@@ -13,23 +13,21 @@ import Browser.Utils (Listener, mkListenerOne, mkListenerTwo, mkListenerUnit)
 import Browser.Windows (Window)
 import Browser.Windows (Window)
 import Browser.Windows.OnCreated as WinOnCreated
 import Browser.Windows.OnCreated as WinOnCreated
 import Browser.Windows.OnRemoved as WinOnRemoved
 import Browser.Windows.OnRemoved as WinOnRemoved
-import Control.Alt (map, (<#>), (<$>), (<|>))
-import Control.Alternative (empty, pure, (*>))
+import Control.Alt (map, (<#>), (<|>))
+import Control.Alternative (pure, (*>))
 import Control.Bind ((=<<), (>>=))
 import Control.Bind ((=<<), (>>=))
 import Control.Category (identity, (>>>))
 import Control.Category (identity, (>>>))
 import Data.Array as A
 import Data.Array as A
 import Data.CommutativeRing ((+))
 import Data.CommutativeRing ((+))
 import Data.Eq ((/=), (==))
 import Data.Eq ((/=), (==))
-import Data.Foldable (for_)
 import Data.Function (const, flip, (#))
 import Data.Function (const, flip, (#))
 import Data.Lens (_Just, over, preview, set, view)
 import Data.Lens (_Just, over, preview, set, view)
 import Data.Lens.At (at)
 import Data.Lens.At (at)
 import Data.Lens.Iso.Newtype (_Newtype)
 import Data.Lens.Iso.Newtype (_Newtype)
-import Data.List (List, foldMap, foldr)
+import Data.List (List, foldMap)
 import Data.Map as M
 import Data.Map as M
-import Data.Maybe (Maybe(..), maybe, maybe')
+import Data.Maybe (Maybe(..), fromMaybe, maybe, maybe')
 import Data.Monoid ((<>))
 import Data.Monoid ((<>))
-import Data.Newtype (unwrap)
 import Data.Show (show)
 import Data.Show (show)
 import Data.Unit (unit)
 import Data.Unit (unit)
 import Debug.Trace (traceM)
 import Debug.Trace (traceM)
@@ -41,7 +39,26 @@ import Effect.Exception (throw)
 import Effect.Exception.Unsafe (unsafeThrow)
 import Effect.Exception.Unsafe (unsafeThrow)
 import Effect.Ref as Ref
 import Effect.Ref as Ref
 import Prelude (Unit, bind, ($), discard, (<<<))
 import Prelude (Unit, bind, ($), discard, (<<<))
-import PureTabs.Model (BackgroundEvent(..), ExtWindow, GlobalState, SidebarEvent(..), _active, _index, _port, _portFromWindow, _portFromWindowId, _positions, _tabFromTabIdAndWindow, _tabFromWindow, _tabs, _windowIdToWindow, _windows, _windowIdToTabIdToTab, emptyWindow, tabsToGlobalState)
+import PureTabs.Model
+  ( BackgroundEvent(..)
+  , ExtWindow
+  , GlobalState
+  , SidebarEvent(..)
+  , _active
+  , _index
+  , _port
+  , _portFromWindow
+  , _portFromWindowId
+  , _positions
+  , _tabFromTabIdAndWindow
+  , _tabFromWindow
+  , _tabs
+  , _windowIdToWindow
+  , _windows
+  , _windowIdToTabIdToTab
+  , emptyWindow
+  , initialTabListToGlobalState
+  )
 
 
 type Ports
 type Ports
   = Ref.Ref (List Runtime.Port)
   = Ref.Ref (List Runtime.Port)
@@ -54,7 +71,7 @@ main = do
   runMain :: Aff Unit
   runMain :: Aff Unit
   runMain = do
   runMain = do
     allTabs <- query
     allTabs <- query
-    liftEffect $ initializeBackground =<< (Ref.new $ tabsToGlobalState allTabs)
+    liftEffect $ initializeBackground =<< (Ref.new $ initialTabListToGlobalState allTabs)
 
 
 initializeBackground :: Ref.Ref GlobalState -> Effect Unit
 initializeBackground :: Ref.Ref GlobalState -> Effect Unit
 initializeBackground ref = do
 initializeBackground ref = do
@@ -292,10 +309,7 @@ initWindowState :: Runtime.Port -> (Ref.Ref GlobalState) -> WindowId -> Effect U
 initWindowState port ref winId =
 initWindowState port ref winId =
   (flip Ref.modify_) ref
   (flip Ref.modify_) ref
     $ over (_windows <<< (at winId))
     $ over (_windows <<< (at winId))
-        ( case _ of
-            Nothing -> Just $ { tabs: M.empty, port: Just port, positions: empty }
-            Just win -> Just $ set _port (Just port) win
-        )
+        (\win -> Just $ set _port (Just port) (fromMaybe emptyWindow win))
 
 
 -- TODO don't pass the full ref, but only a set of function to manipulate/access 
 -- TODO don't pass the full ref, but only a set of function to manipulate/access 
 -- the data required
 -- the data required

+ 47 - 24
src/Model.purs

@@ -1,6 +1,8 @@
 module PureTabs.Model
 module PureTabs.Model
   ( ExtWindow
   ( ExtWindow
   , GlobalState
   , GlobalState
+  , Group
+  , GroupId
   , _active
   , _active
   , _id
   , _id
   , _index
   , _index
@@ -18,7 +20,7 @@ module PureTabs.Model
   , _windows
   , _windows
   , emptyWindow
   , emptyWindow
   , initialGlobalState
   , initialGlobalState
-  , tabsToGlobalState
+  , initialTabListToGlobalState
   , BackgroundEvent(..)
   , BackgroundEvent(..)
   , SidebarEvent(..)
   , SidebarEvent(..)
   ) where
   ) where
@@ -30,18 +32,20 @@ import Control.Alternative (empty)
 import Control.Bind (join)
 import Control.Bind (join)
 import Control.Category ((>>>), (<<<))
 import Control.Category ((>>>), (<<<))
 import Control.Plus (empty) as A
 import Control.Plus (empty) as A
-import Data.Array (sortBy, singleton) as A
+import Data.Array (sortBy, singleton, fromFoldable) as A
+import Data.Eq ((==))
 import Data.Function (on, ($))
 import Data.Function (on, ($))
-import Data.Functor (map)
+import Data.Functor (map, (<#>), (<$>))
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
 import Data.Generic.Rep.Show (genericShow)
 import Data.Lens (Lens', Traversal', _Just, view)
 import Data.Lens (Lens', Traversal', _Just, view)
 import Data.Lens.At (at)
 import Data.Lens.At (at)
 import Data.Lens.Iso.Newtype (_Newtype)
 import Data.Lens.Iso.Newtype (_Newtype)
 import Data.Lens.Record (prop)
 import Data.Lens.Record (prop)
-import Data.List (List(..), catMaybes, concat, head, singleton)
+import Data.List (List(..), head, groupBy) as L
+import Data.List.NonEmpty (head, NonEmptyList, toList) as NEL
 import Data.Map as M
 import Data.Map as M
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Ord (compare)
 import Data.Ord (compare)
 import Data.Show (class Show)
 import Data.Show (class Show)
 import Data.Symbol (SProxy(..))
 import Data.Symbol (SProxy(..))
@@ -59,14 +63,33 @@ initialGlobalState =
   , detached: Nothing
   , detached: Nothing
   }
   }
 
 
+newtype GroupId
+  = GroupId Int
+
+type Group
+  = { id :: GroupId, name :: String }
+
+newGroup :: Int -> (Maybe String) -> Group
+newGroup gid name = { id: GroupId gid, name: fromMaybe "Unnamed" name }
+
 type ExtWindow
 type ExtWindow
   = { positions :: Array TabId
   = { positions :: Array TabId
     , tabs :: M.Map TabId Tab
     , tabs :: M.Map TabId Tab
     , port :: Maybe Port
     , port :: Maybe Port
+    , groups :: Array Group
+    , tabToGroup :: M.Map TabId GroupId
+    , currentGroup :: GroupId
     }
     }
 
 
 emptyWindow :: ExtWindow
 emptyWindow :: ExtWindow
-emptyWindow = { positions: A.empty, tabs: M.empty, port: Nothing }
+emptyWindow =
+  { positions: A.empty
+  , tabs: M.empty
+  , port: Nothing
+  , groups: A.singleton (newGroup 1 Nothing)
+  , tabToGroup: M.empty
+  , currentGroup: GroupId 1
+  }
 
 
 _tabs :: forall a r. Lens' { tabs :: a | r } a
 _tabs :: forall a r. Lens' { tabs :: a | r } a
 _tabs = prop (SProxy :: _ "tabs")
 _tabs = prop (SProxy :: _ "tabs")
@@ -128,30 +151,30 @@ _tabFromTabIdAndWindow s tabId =
 
 
     matchingTabId = map (M.lookup tabId) allTabs
     matchingTabId = map (M.lookup tabId) allTabs
   in
   in
-    join $ head matchingTabId
+    join $ L.head matchingTabId
 
 
-tabsToGlobalState :: List Tab -> GlobalState
-tabsToGlobalState tabs = { windows: tabsToWindows tabs, detached: Nothing }
+initialTabListToGlobalState :: L.List Tab -> GlobalState
+initialTabListToGlobalState tabs = { windows: windows, detached: Nothing }
   where
   where
-  tabsToWindows :: List Tab -> M.Map WindowId ExtWindow
-  tabsToWindows tabs' = M.fromFoldableWith merge $ map mapTab tabs'
+  groupedTabs = L.groupBy (\(Tab t1) (Tab t2) -> t1.windowId == t2.windowId) tabs
 
 
-  merge :: ExtWindow -> ExtWindow -> ExtWindow
-  merge w1 w2 =
+  tabsToWindow :: NEL.NonEmptyList Tab -> Tuple WindowId ExtWindow
+  tabsToWindow tabs' =
     let
     let
-      mergedMap = M.union w1.tabs w2.tabs
+      windowId = (\(Tab t) -> t.windowId) $ NEL.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')
+        , groups: A.singleton (newGroup 1 Nothing)
+        , tabToGroup: M.fromFoldable $ tabs' <#> \(Tab t) -> Tuple t.id (GroupId 1)
+        , currentGroup: GroupId 1
+        }
     in
     in
-      { tabs: mergedMap
-      , port: Nothing
-      -- TODO do that after building the state, to avoid going creating a new list each time
-      , positions: (mapPositions >>> (A.sortBy (compare `on` snd)) >>> (map fst)) mergedMap
-      }
-
-  mapTab :: Tab -> Tuple WindowId ExtWindow
-  mapTab (Tab t) = Tuple t.windowId { tabs: M.singleton t.id (Tab t), port: Nothing, positions: A.singleton t.id }
+      Tuple windowId window
 
 
-  mapPositions :: M.Map TabId Tab -> Array (Tuple TabId Int)
-  mapPositions = M.toUnfoldableUnordered >>> (map \(Tuple tid (Tab t)) -> tid /\ t.index)
+  windows = M.fromFoldable $ (tabsToWindow <$> groupedTabs)
 
 
 data BackgroundEvent
 data BackgroundEvent
   = BgInitialTabList (Array Tab)
   = BgInitialTabList (Array Tab)