TabbedLayout

unisonweb · Aug 23, 2023 · cf7b7ed · cf7b7ed
1 parent 488aa82
commit cf7b7ed
Show file tree

Hide file tree

Showing 2 changed files with 67 additions and 1 deletion.
diff --git a/src/UI/PageLayout.elm b/src/UI/PageLayout.elm
@@ -7,6 +7,7 @@ import UI.Click as Click
 import UI.CopyrightYear as CopyrightYear
 import UI.PageContent as PageContent exposing (PageContent)
 import UI.Sidebar as Sidebar exposing (Sidebar)
+import UI.TabList as TabList exposing (TabList)
 
 
 type PageHero msg
@@ -51,6 +52,13 @@ type PageLayout msg
     | CenteredLayout (Layout {} msg)
     | CenteredNarrowLayout (Layout {} msg)
     | PresentationLayout (PageContent msg)
+    | TabbedLayout
+        (Layout
+            { header : List (Html msg)
+            , tabList : TabList msg
+            }
+            msg
+        )
 
 
 heroLayout : PageHero msg -> PageContent msg -> PageFooter msg -> PageLayout msg
@@ -75,7 +83,12 @@ sidebarEdgeToEdgeLayout os sidebar content footer =
         }
 
 
-sidebarLeftContentLayout : OperatingSystem -> Sidebar msg -> PageContent msg -> PageFooter msg -> PageLayout msg
+sidebarLeftContentLayout :
+    OperatingSystem
+    -> Sidebar msg
+    -> PageContent msg
+    -> PageFooter msg
+    -> PageLayout msg
 sidebarLeftContentLayout os sidebar content footer =
     SidebarLeftContentLayout
         { sidebar = sidebar
@@ -110,6 +123,22 @@ presentationLayout content =
     PresentationLayout content
 
 
+tabbedLayout :
+    List (Html msg)
+    -> TabList msg
+    -> PageContent msg
+    -> PageFooter msg
+    -> PageLayout msg
+tabbedLayout header tabList content footer =
+    TabbedLayout
+        { header = header
+        , tabList = tabList
+        , content = content
+        , footer = footer
+        , backgroundColor = SubduedBackground
+        }
+
+
 
 -- TRANSFORM
 
@@ -139,6 +168,9 @@ withContent content pl =
         PresentationLayout _ ->
             PresentationLayout content
 
+        TabbedLayout l ->
+            TabbedLayout (withContent_ l)
+
 
 withBackgroundColor : BackgroundColor -> PageLayout msg -> PageLayout msg
 withBackgroundColor bg pl =
@@ -161,6 +193,9 @@ withBackgroundColor bg pl =
         PresentationLayout _ ->
             pl
 
+        TabbedLayout _ ->
+            pl
+
 
 withSubduedBackground : PageLayout msg -> PageLayout msg
 withSubduedBackground pl =
@@ -232,6 +267,15 @@ map toMsg pageLayout =
         PresentationLayout content ->
             PresentationLayout (PageContent.map toMsg content)
 
+        TabbedLayout layout ->
+            TabbedLayout
+                { header = List.map (Html.map toMsg) layout.header
+                , tabList = TabList.map toMsg layout.tabList
+                , content = PageContent.map toMsg layout.content
+                , footer = mapPageFooter toMsg layout.footer
+                , backgroundColor = layout.backgroundColor
+                }
+
 
 mapPageFooter : (a -> msg) -> PageFooter a -> PageFooter msg
 mapPageFooter toMsg (PageFooter items) =
@@ -332,3 +376,10 @@ view page =
             div [ class "page presentation-layout" ]
                 [ PageContent.view_ (viewPageFooter (PageFooter [])) content
                 ]
+
+        TabbedLayout layout_ ->
+            div [ class "page tabbed-layout" ]
+                [ header [] layout_.header
+                , TabList.view layout_.tabList
+                , div [] [ PageContent.view_ (viewPageFooter (PageFooter [])) layout_.content ]
+                ]
diff --git a/src/UI/TabList.elm b/src/UI/TabList.elm
@@ -12,6 +12,7 @@
 module UI.TabList exposing
     ( Tab
     , TabList
+    , map
     , tab
     , tabList
     , view
@@ -48,6 +49,20 @@ tabList before selected_ after =
 
 
 
+-- MAP
+
+
+mapTab : (a -> b) -> Tab a -> Tab b
+mapTab f (Tab a) =
+    Tab { label = a.label, click = Click.map f a.click }
+
+
+map : (a -> b) -> TabList a -> TabList b
+map f (TabList a) =
+    TabList (Zipper.map (mapTab f) a)
+
+
+
 -- VIEW