purescript_linked_in/src/Sidebar/Components/Bar.purs

module PureTabs.Sidebar.Bar where

import Browser.Tabs (Tab(..), TabId)
import Control.Alternative (pure)
import Control.Bind (bind, discard, void, (<#>))
import Data.Array ((:))
import Data.Function (($))
import Data.Map as M
import Data.Maybe (Maybe(..))
import Data.Set (toUnfoldable, Set) as S
import Data.Set.NonEmpty (cons, max) as NES
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..))
import Data.Unit (Unit, unit)
import Effect.Aff.Class (class MonadAff)
import Effect.Class (class MonadEffect)
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Prelude (class Eq, class Ord, class Show, show, (+), (<<<), (<>), (==))
import PureTabs.Model.Events (SidebarEvent)
import PureTabs.Sidebar.Tabs (Output(..))
import PureTabs.Sidebar.Tabs as Tabs
import Sidebar.Component.GroupName as GroupName
import Sidebar.Utils (whenC)

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

type Group
  = { name :: String
    , pos :: Int
    }

type State
  = { groups :: M.Map GroupId Group
    , tabsToGroup :: M.Map TabId GroupId
    , currentGroup :: GroupId
    }

data Action
  = UserSelectedGroup GroupId
  | UserRenameGroup GroupId String
  | UserCreatedGroup
  | UserDeletedGroup GroupId
  | HandleTabsOutput GroupId Tabs.Output

initialState :: forall i. i -> State
initialState _ =
  let
    firstGroupId = GroupId 0
  in
    { 
      groups: M.fromFoldable [ Tuple firstGroupId { name: "main", pos: 0 } ]
      , tabsToGroup: M.empty
      , currentGroup: firstGroupId 
    }

type Slots
  = ( tab :: H.Slot Tabs.Query Tabs.Output GroupId, groupName :: forall unusedQuery. H.Slot unusedQuery GroupName.NewName GroupId)

_tab :: SProxy "tab"
_tab = (SProxy :: _ "tab")

_groupName :: SProxy "groupName"
_groupName = (SProxy :: _ "groupName")

component :: forall i m. MonadEffect m => MonadAff m => H.Component HH.HTML Tabs.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 
        menuElem attrs text = HH.li attrs [ HH.text text]

        topMenu = HH.div [ HP.id_ "bar-menu" ] [
          HH.ul [] [menuElem [HE.onClick \_ -> Just UserCreatedGroup] "+", menuElem [] "-"]
        ]

        barListGroup = HH.div [ HP.id_ "bar-list" ] [HH.ul [ HP.id_ "bar-list-group"] $ 
          (M.toUnfoldable state.groups) <#> \(Tuple gid g) -> renderGroup gid (gid == state.currentGroup) g
        ]

        tabsDivs = (S.toUnfoldable $ (M.keys state.groups)) <#> 
          (\gid -> HH.div [
            HP.classes [(H.ClassName "bar-tabs"), whenC (gid == state.currentGroup) (H.ClassName "bar-tabs-active")] 
          ] [renderGroupTabs gid])
    
     in
        HH.div [ HP.id_ "bar" ] $ topMenu : barListGroup : tabsDivs 

  renderGroupTabs :: GroupId -> H.ComponentHTML Action Slots m
  renderGroupTabs groupId = HH.slot _tab 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))
    ] [ HH.slot _groupName groupId GroupName.component group.name (\newName -> Just (UserRenameGroup groupId newName))] 

  handleAction :: Action -> H.HalogenM State Action Slots SidebarEvent m Unit
  handleAction = 
    case _ of
         UserSelectedGroup gid -> H.modify_ _ { currentGroup = gid }
         UserRenameGroup gid newName -> 
            H.modify_ \s -> s { groups = M.update (\g -> Just $ g { name = newName }) gid s.groups }
         UserCreatedGroup -> do
           H.modify_ \s -> s { groups = M.insert (findNextGroupId $ M.keys s.groups) { name: "new group", pos: M.size s.groups } s.groups }
         UserDeletedGroup gid -> pure unit
         HandleTabsOutput gid (TabsSidebarAction sbEvent) -> H.raise sbEvent

    where
          findNextGroupId :: S.Set GroupId -> GroupId
          findNextGroupId values = 
            let GroupId(maxValue) = NES.max (NES.cons (GroupId 0) values)
             in GroupId(maxValue + 1)

  -- TODO: don't use the current group, but use the group associated with the TabId
  handleQuery :: forall act o a. Tabs.Query a -> H.HalogenM State act Slots o m (Maybe a)
  handleQuery = case _ of
    Tabs.InitialTabList tabs a -> do
       s <- H.modify (\s -> 
         s { tabsToGroup = M.fromFoldable $ tabs <#> \(Tab t) -> Tuple t.id s.currentGroup }
       )
       void $ tellChild s.currentGroup $ Tabs.InitialTabList tabs
       pure (Just a)
    Tabs.TabCreated (Tab t) a -> do 
       s <- H.modify (\s -> s { tabsToGroup = M.insert t.id s.currentGroup  s.tabsToGroup })
       void $ tellChild s.currentGroup $ Tabs.TabCreated (Tab t)
       pure (Just a)
    Tabs.TabDeleted tid a -> do 
       s <- H.modify (\s -> s { tabsToGroup = M.delete tid s.tabsToGroup })
       void $ tellChild s.currentGroup $ Tabs.TabDeleted tid
       pure (Just a)
    Tabs.TabActivated oldTid tid a -> do 
       s <- H.get
       void $ tellChild s.currentGroup $ Tabs.TabActivated oldTid tid
       pure (Just a)
    Tabs.TabMoved tid prev next a -> do 
       s <- H.get
       void $ tellChild s.currentGroup $ Tabs.TabMoved tid prev next
       pure (Just a)
    Tabs.TabInfoChanged tid cinfo a -> do 
       s <- H.get
       void $ tellChild s.currentGroup $ Tabs.TabInfoChanged tid cinfo
       pure (Just a)
    Tabs.TabDetached tid a -> do 
       s <- H.get
       void $ tellChild s.currentGroup $ Tabs.TabDetached tid
       pure (Just a)

    where
        tellChild :: GroupId -> (H.Tell Tabs.Query) -> H.HalogenM State act Slots o m (Maybe Unit)
        tellChild gid q = H.query _tab gid $ H.tell q