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