ソースを参照

feat: add top menu bar to add a new group

Jocelyn Boullier 5 年 前
コミット
9a1044829d

+ 24 - 2
extension/sidebar.css

@@ -1,5 +1,7 @@
 :root {
 :root {
+  --bar-black-color: #0c0c0d;
   --group-bar-size: 25px;
   --group-bar-size: 25px;
+  --top-menu-height: 20px;
 }
 }
 
 
 html,
 html,
@@ -16,8 +18,28 @@ body,
   height: 100%;
   height: 100%;
 }
 }
 
 
+#bar-menu {
+  width: 100%;
+  height: var(--top-menu-height);
+}
+
+#bar-menu ul {
+  background-color: var(--bar-black-color);
+  color: #f9f9f2;
+  list-style-type: none;
+  margin: 0 0 5px 0;
+  padding: 0;
+}
+
+#bar-menu li {
+  display: inline-block;
+  padding: 0 7px 0;
+  border-right: solid #cfcfcf 1px;
+}
+
 #bar-list {
 #bar-list {
-  background-color: #0c0c0d;
+  margin-top: 1px;
+  background-color: var(--bar-black-color);
   width: 100vh;
   width: 100vh;
   height: var(--group-bar-size);
   height: var(--group-bar-size);
   position: fixed;
   position: fixed;
@@ -53,7 +75,7 @@ body,
 
 
 .bar-tabs {
 .bar-tabs {
   width: calc(100% - var(--group-bar-size));
   width: calc(100% - var(--group-bar-size));
-  height: 100%;
+  height: calc(100% - var(--top-menu-height));
   margin-left: var(--group-bar-size);
   margin-left: var(--group-bar-size);
 }
 }
 
 

+ 29 - 11
src/Sidebar/Components/Bar.purs

@@ -1,25 +1,29 @@
 module PureTabs.Sidebar.Bar where
 module PureTabs.Sidebar.Bar where
 
 
 import Browser.Tabs (Tab(..), TabId)
 import Browser.Tabs (Tab(..), TabId)
-import Control.Alternative (pure, (<$>))
+import Control.Alternative (class Functor, pure, (<$>))
 import Control.Bind (bind, discard, void, (<#>))
 import Control.Bind (bind, discard, void, (<#>))
+import Data.Array ((:))
 import Data.Array as A
 import Data.Array as A
 import Data.Function (($))
 import Data.Function (($))
+import Data.Map (insert, size)
 import Data.Map as M
 import Data.Map as M
 import Data.Maybe (Maybe(..))
 import Data.Maybe (Maybe(..))
-import Data.Set (toUnfoldable)
+import Data.Set (toUnfoldable, Set) as S
+import Data.Set.NonEmpty (max, NonEmptySet, cons) as NES
 import Data.Symbol (SProxy(..))
 import Data.Symbol (SProxy(..))
 import Data.Tuple (Tuple(..))
 import Data.Tuple (Tuple(..))
 import Data.Unit (Unit, unit)
 import Data.Unit (Unit, unit)
 import Effect.Aff.Class (class MonadAff)
 import Effect.Aff.Class (class MonadAff)
 import Effect.Class (class MonadEffect)
 import Effect.Class (class MonadEffect)
-import Halogen (ComponentHTML)
+import Effect.Class.Console (log)
+import Halogen (ComponentHTML, get, liftEffect)
 import Halogen as H
 import Halogen as H
 import Halogen.HTML (slot)
 import Halogen.HTML (slot)
 import Halogen.HTML as HH
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
 import Halogen.HTML.Properties as HP
-import Prelude (class Eq, class Ord, (<<<), (==))
+import Prelude (class Eq, class Ord, class Show, show, (+), (<<<), (<>), (==))
 import PureTabs.Model (SidebarEvent)
 import PureTabs.Model (SidebarEvent)
 import PureTabs.Sidebar.Tabs (Output(..))
 import PureTabs.Sidebar.Tabs (Output(..))
 import PureTabs.Sidebar.Tabs as Tabs
 import PureTabs.Sidebar.Tabs as Tabs
@@ -31,9 +35,11 @@ newtype GroupId
   = GroupId Int
   = GroupId Int
 
 
 derive instance eqGroupId :: Eq GroupId
 derive instance eqGroupId :: Eq GroupId
-
 derive instance ordGroupId :: Ord GroupId
 derive instance ordGroupId :: Ord GroupId
 
 
+instance showGroupId :: Show GroupId where 
+  show (GroupId gid) = "GroupId(" <> (show gid) <> ")"
+
 type Group
 type Group
   = { name :: String
   = { name :: String
     , pos :: Int
     , pos :: Int
@@ -48,14 +54,13 @@ type State
 data Action
 data Action
   = UserSelectedGroup GroupId
   = UserSelectedGroup GroupId
   | UserRenameGroup GroupId String
   | UserRenameGroup GroupId String
+  | UserCreatedGroup
   | HandleTabsOutput GroupId Tabs.Output
   | HandleTabsOutput GroupId Tabs.Output
 
 
 initialState :: forall i. i -> State
 initialState :: forall i. i -> State
 initialState _ =
 initialState _ =
   let
   let
     firstGroupId = GroupId 0
     firstGroupId = GroupId 0
-    secondGroupId = GroupId 1
-    thirdGroupId = GroupId 2
   in
   in
     { 
     { 
       groups: M.fromFoldable [ Tuple firstGroupId { name: "main", pos: 0 } ]
       groups: M.fromFoldable [ Tuple firstGroupId { name: "main", pos: 0 } ]
@@ -89,17 +94,23 @@ component =
   render :: State -> H.ComponentHTML Action Slots m
   render :: State -> H.ComponentHTML Action Slots m
   render state = 
   render state = 
     let 
     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"] $ 
         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
           (M.toUnfoldable state.groups) <#> \(Tuple gid g) -> renderGroup gid (gid == state.currentGroup) g
         ]
         ]
 
 
-        tabsDivs = (toUnfoldable $ (M.keys state.groups)) <#> 
+        tabsDivs = (S.toUnfoldable $ (M.keys state.groups)) <#> 
           (\gid -> HH.div [
           (\gid -> HH.div [
             HP.classes [(H.ClassName "bar-tabs"), whenC (gid == state.currentGroup) (H.ClassName "bar-tabs-active")] 
             HP.classes [(H.ClassName "bar-tabs"), whenC (gid == state.currentGroup) (H.ClassName "bar-tabs-active")] 
           ] [renderGroupTabs gid])
           ] [renderGroupTabs gid])
     
     
      in
      in
-        HH.div [ HP.id_ "bar" ] $ A.cons barListGroup tabsDivs 
+        HH.div [ HP.id_ "bar" ] $ topMenu : barListGroup : tabsDivs 
 
 
   renderGroupTabs :: GroupId -> H.ComponentHTML Action Slots m
   renderGroupTabs :: GroupId -> H.ComponentHTML Action Slots m
   renderGroupTabs groupId = HH.slot _tab groupId Tabs.component unit (Just <<< (HandleTabsOutput groupId))
   renderGroupTabs groupId = HH.slot _tab groupId Tabs.component unit (Just <<< (HandleTabsOutput groupId))
@@ -117,8 +128,15 @@ component =
          UserSelectedGroup gid -> H.modify_ _ { currentGroup = gid }
          UserSelectedGroup gid -> H.modify_ _ { currentGroup = gid }
          UserRenameGroup gid newName -> 
          UserRenameGroup gid newName -> 
             H.modify_ \s -> s { groups = M.update (\g -> Just $ g { name = newName }) gid s.groups }
             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
+         UserCreatedGroup -> do
+           H.modify_ \s -> s { groups = M.insert (findNextGroupId $ M.keys s.groups) { name: "new group", pos: M.size s.groups } s.groups }
+         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)
 
 
   handleQuery :: forall act o a. Tabs.Query a -> H.HalogenM State act Slots o m (Maybe a)
   handleQuery :: forall act o a. Tabs.Query a -> H.HalogenM State act Slots o m (Maybe a)
   handleQuery = case _ of
   handleQuery = case _ of

+ 10 - 5
src/Sidebar/Components/GroupName.purs

@@ -4,6 +4,7 @@ module Sidebar.Component.GroupName (component, NewName) where
 import Control.Monad.Free (liftF)
 import Control.Monad.Free (liftF)
 import Data.Foldable (elem)
 import Data.Foldable (elem)
 import Data.Maybe (Maybe(..))
 import Data.Maybe (Maybe(..))
+import Data.String.CodeUnits (length)
 import Data.Tuple.Nested ((/\))
 import Data.Tuple.Nested ((/\))
 import Effect.Aff.Class (class MonadAff)
 import Effect.Aff.Class (class MonadAff)
 import Effect.Class (liftEffect)
 import Effect.Class (liftEffect)
@@ -28,8 +29,8 @@ import Web.Event.EventTarget (EventTarget)
 import Web.Event.EventTarget as ET
 import Web.Event.EventTarget as ET
 import Web.HTML (window) as Web
 import Web.HTML (window) as Web
 import Web.HTML.HTMLDocument as HTMLDocument
 import Web.HTML.HTMLDocument as HTMLDocument
-import Web.HTML.Window (document) as Web
 import Web.HTML.HTMLElement (focus) as Web
 import Web.HTML.HTMLElement (focus) as Web
+import Web.HTML.Window (document) as Web
 import Web.UIEvent.InputEvent (InputEvent, fromEvent)
 import Web.UIEvent.InputEvent (InputEvent, fromEvent)
 import Web.UIEvent.InputEvent as IE
 import Web.UIEvent.InputEvent as IE
 import Web.UIEvent.KeyboardEvent as KE
 import Web.UIEvent.KeyboardEvent as KE
@@ -51,10 +52,14 @@ component = Hooks.component \rec name -> Hooks.do
   let 
   let 
       onKeyEvent keyEvent 
       onKeyEvent keyEvent 
         | KE.key keyEvent == "Enter" = 
         | KE.key keyEvent == "Enter" = 
-            Just do 
-               Hooks.put isRenamingIdx false 
-               Hooks.put initialNameIdx chars
-               Hooks.raise rec.outputToken chars
+            Just $ case (length chars) of 
+              0 -> do 
+                 Hooks.put isRenamingIdx false
+                 Hooks.put charsIdx initialName
+              _ -> do
+                 Hooks.put isRenamingIdx false 
+                 Hooks.put initialNameIdx chars
+                 Hooks.raise rec.outputToken chars
         | KE.key keyEvent == "Escape" = 
         | KE.key keyEvent == "Escape" = 
           Just do 
           Just do 
              Hooks.put charsIdx initialName
              Hooks.put charsIdx initialName

+ 1 - 0
src/Sidebar/Components/Tabs.purs

@@ -26,6 +26,7 @@ import Effect.Aff.Class (class MonadAff)
 import Effect.Class (class MonadEffect)
 import Effect.Class (class MonadEffect)
 import Effect.Class.Console (log)
 import Effect.Class.Console (log)
 import Effect.Exception (error)
 import Effect.Exception (error)
+import Halogen (liftEffect)
 import Halogen as H
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML as HH
 import Halogen.HTML.CSS as CSS
 import Halogen.HTML.CSS as CSS