feat: rename group by double clicking on it

spago.dhall

@@ -18,6 +18,7 @@ You can edit this file as you like.
   , "generics-rep"
   , "halogen"
   , "halogen-css"
+  , "halogen-hooks"
   , "lists"
   , "numbers"
   , "ordered-collections"

src/Sidebar/Components/Bar.purs

@@ -13,7 +13,9 @@ import Data.Tuple (Tuple(..))
 import Data.Unit (Unit, unit)
 import Effect.Aff.Class (class MonadAff)
 import Effect.Class (class MonadEffect)
+import Halogen (ComponentHTML)
 import Halogen as H
+import Halogen.HTML (slot)
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
@@ -21,7 +23,9 @@ import Prelude (class Eq, class Ord, (<<<), (==))
 import PureTabs.Model (SidebarEvent)
 import PureTabs.Sidebar.Tabs (Output(..))
 import PureTabs.Sidebar.Tabs as Tabs
+import Sidebar.Component.GroupName as GroupName
 import Sidebar.Utils (whenC)
+import Web.HTML.Event.EventTypes (offline)
 
 newtype GroupId
   = GroupId Int
@@ -43,6 +47,7 @@ type State
 
 data Action
   = UserSelectedGroup GroupId
+  | UserRenameGroup GroupId String
   | HandleTabsOutput GroupId Tabs.Output
 
 initialState :: forall i. i -> State
@@ -53,20 +58,19 @@ initialState _ =
     thirdGroupId = GroupId 2
   in
     { 
-      groups: M.fromFoldable [
-        Tuple firstGroupId { name: "main", pos: 0 }
-        -- , Tuple secondGroupId { name: "second", pos: 1}
-        -- , Tuple thirdGroupId { name: "third", pos: 2}
-      ], 
-      tabsToGroup: M.empty, 
-      currentGroup: firstGroupId 
+      groups: M.fromFoldable [ Tuple firstGroupId { name: "main", pos: 0 } ]
+      , tabsToGroup: M.empty
+      , currentGroup: firstGroupId 
     }
 
 type Slots
-  = ( tabs :: H.Slot Tabs.Query Tabs.Output GroupId )
+  = ( tab :: H.Slot Tabs.Query Tabs.Output GroupId, groupName :: forall unusedQuery. H.Slot unusedQuery GroupName.NewName GroupId)
 
-_childLabel :: SProxy "tabs"
-_childLabel = (SProxy :: _ "tabs")
+_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 =
@@ -86,7 +90,8 @@ component =
   render state = 
     let 
         barListGroup = HH.div [ HP.id_ "bar-list" ] [HH.ul [ HP.id_ "bar-list-group"] $ 
-          (\(Tuple gid g) -> renderGroup gid (gid == state.currentGroup) g) <$> (M.toUnfoldable state.groups)]
+          (M.toUnfoldable state.groups) <#> \(Tuple gid g) -> renderGroup gid (gid == state.currentGroup) g
+        ]
 
         tabsDivs = (toUnfoldable $ (M.keys state.groups)) <#> 
           (\gid -> HH.div [
@@ -97,19 +102,21 @@ component =
         HH.div [ HP.id_ "bar" ] $ A.cons barListGroup tabsDivs 
 
   renderGroupTabs :: GroupId -> H.ComponentHTML Action Slots m
-  renderGroupTabs groupId = HH.slot _childLabel groupId Tabs.component unit (Just <<< (HandleTabsOutput groupId))
+  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 (\ev -> Just (UserSelectedGroup groupId))
-    ] [ HH.text group.name ] 
+      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 }
          HandleTabsOutput gid event -> case event of
                                             TabsSidebarAction sbEvent -> H.raise sbEvent
 
@@ -145,4 +152,4 @@ component =
 
     where
         tellChild :: GroupId -> (H.Tell Tabs.Query) -> H.HalogenM State act Slots o m (Maybe Unit)
-        tellChild gid q = H.query _childLabel gid $ H.tell q
+        tellChild gid q = H.query _tab gid $ H.tell q

src/Sidebar/Components/GroupName.js

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

src/Sidebar/Components/GroupName.purs

@@ -0,0 +1,80 @@
+module Sidebar.Component.GroupName (component, NewName) where
+
+
+import Control.Monad.Free (liftF)
+import Data.Foldable (elem)
+import Data.Maybe (Maybe(..))
+import Data.Tuple.Nested ((/\))
+import Effect.Aff.Class (class MonadAff)
+import Effect.Class (liftEffect)
+import Halogen (liftEffect)
+import Halogen as H
+import Halogen.HTML (span, text)
+import Halogen.HTML as HH
+import Halogen.HTML.Core (ref)
+import Halogen.HTML.Events (onChange, onDoubleClick, onInput, onKeyUp)
+import Halogen.HTML.Events as HE
+import Halogen.HTML.Properties (autofocus, ref)
+import Halogen.HTML.Properties as HP
+import Halogen.Hooks (HookF(..), OutputToken, getHTMLElementRef, put, query, raise, subscribe', useTickEffect)
+import Halogen.Hooks as Hooks
+import Halogen.Query (getHTMLElementRef)
+import Halogen.Query as HQ
+import Halogen.Query.Input as HQI
+import Prelude (bind, const, discard, flap, liftM1, map, otherwise, pure, unit, ($), (<$>), (=<<), (==), (>=>), (>>>))
+import Web.Event.Event (target)
+import Web.Event.Event as E
+import Web.Event.EventTarget (EventTarget)
+import Web.Event.EventTarget as ET
+import Web.HTML (window) as Web
+import Web.HTML.HTMLDocument as HTMLDocument
+import Web.HTML.Window (document) as Web
+import Web.HTML.HTMLElement (focus) as Web
+import Web.UIEvent.InputEvent (InputEvent, fromEvent)
+import Web.UIEvent.InputEvent as IE
+import Web.UIEvent.KeyboardEvent as KE
+import Web.UIEvent.KeyboardEvent.EventTypes as KET
+
+type NewName = String
+
+foreign import targetValue :: ET.EventTarget -> String
+
+component
+  :: forall unusedQuery anyMonad
+   . MonadAff anyMonad
+  => H.Component HH.HTML unusedQuery String NewName anyMonad
+component = Hooks.component \rec name -> Hooks.do 
+  isRenaming /\ isRenamingIdx <- Hooks.useState false 
+  initialName /\ initialNameIdx <- Hooks.useState name 
+  chars /\ charsIdx <- Hooks.useState name
+
+  let 
+      onKeyEvent keyEvent 
+        | KE.key keyEvent == "Enter" = 
+            Just do 
+               Hooks.put isRenamingIdx false 
+               Hooks.put initialNameIdx chars
+               Hooks.raise rec.outputToken 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
+
+  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 [ 
+          HE.onDoubleClick \_ -> Just $ do 
+             Hooks.put isRenamingIdx true 
+             elem <- Hooks.getHTMLElementRef (HQI.RefLabel "input")
+             case elem of 
+                  Just elem -> liftEffect $ Web.focus elem
+                  _ -> pure unit
+        ] [HH.text chars]

src/Sidebar/Components/Groups.purs

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