purescript_linked_in/src/Model.purs

module PureTabs.Model
  ( Window
  , GlobalState
  , _active
  , _id
  , _index
  , _port
  , _portFromWindow
  , _portFromWindowId
  , _positions
  , _tabFromTabIdAndWindow
  , _tabFromWindow
  , _tabId
  , _tabs
  , _tabWindowId
  , _windowIdToWindow
  , _windows
  , initialGlobalState
  , tabsToGlobalState
  , BackgroundEvent(..)
  , SidebarEvent(..)
  ) where

import Browser.Runtime (Port)
import Browser.Tabs (TabId(..), WindowId, Tab(..))
import Browser.Tabs.OnUpdated (ChangeInfo(..))
import Control.Alternative (empty)
import Control.Bind (join)
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, concat, head, singleton)
import Data.Map as M
import Data.Maybe (Maybe(..))
import Data.Ord (compare)
import Data.Show (class Show)
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst, snd, uncurry)
import Data.Tuple.Nested ((/\))

type GlobalState
  = { windows :: M.Map WindowId Window
    }

type Window
  = { positions :: Array TabId
    , tabs :: M.Map TabId Tab
    , port :: Maybe Port
    }

_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")

_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")

_active :: forall a r. Lens' { active :: a | r } a
_active = prop (SProxy :: _ "active")

_tabId :: Lens' Tab TabId
_tabId = _Newtype <<< _id

_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 Window
_windowIdToWindow wid = _windows <<< (at wid) <<< _Just

_tabFromWindow :: Tab -> Traversal' GlobalState (Maybe Tab)
_tabFromWindow (Tab tab) = _windowIdToWindow tab.windowId <<< _tabs <<< (at tab.id)

_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 $ head matchingTabId

initialGlobalState :: GlobalState
initialGlobalState =
  { windows: M.empty
  }

tabsToGlobalState :: List Tab -> GlobalState
tabsToGlobalState tabs = { windows: tabsToWindows tabs }
  where
  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 TabId Int Int
  | BgTabActived (Maybe TabId) TabId
  | BgTabAttached Tab
  | BgTabDetached TabId
  | BgTabHighlighted
  | BgTabReplaced
  | BgTabZoomChanged

derive instance genBackgroundEvent :: Generic BackgroundEvent _

instance showBackgroundEvent :: Show BackgroundEvent where
  show = genericShow

data SidebarEvent
  = SbTabDeleted TabId
  | SbTabActived TabId
  | SbTabCreated
  | SbTabMoved TabId Int
  | SbTabDetached
  | SbGroupCreated
  | SbGroupDeleted
  | SbGroupRenamed
  | SbHasWindowId WindowId

derive instance genSidebarEvent :: Generic SidebarEvent _

instance showSidebarEvent :: Show SidebarEvent where
  show = genericShow