-----------------------------------------------------------------------------
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE LambdaCase                 #-}
-----------------------------------------------------------------------------
module Miso.UI.Tabs
  ( -- ** Views
    tabs_
  , tabList_
  , tabButton_
  , tab_
  ) where
-----------------------------------------------------------------------------
import           Miso
import qualified Miso.Html as H
import qualified Miso.Html.Property as P
-- import qualified Miso.Svg as S
-- import qualified Miso.Svg.Property as SP
-----------------------------------------------------------------------------
-- | Must provide `_id`
tabs_
  :: [Attribute action]
  -> [View model action]
  -> View model action
tabs_ :: forall action model.
[Attribute action] -> [View model action] -> View model action
tabs_ [Attribute action]
attrs [View model action]
kids =
  ([Attribute action] -> [View model action] -> View model action)
-> [Attribute action]
-> Bool
-> [Attribute action]
-> [View model action]
-> View model action
forall action model.
([Attribute action] -> [View model action] -> View model action)
-> [Attribute action]
-> Bool
-> [Attribute action]
-> [View model action]
-> View model action
optionalAttrs
  [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
H.div_
    [Attribute action]
attrs
    Bool
True
    [ MisoString -> Attribute action
forall action. MisoString -> Attribute action
P.class_ MisoString
"tabs w-full"
    ]
    [View model action]
kids
-----------------------------------------------------------------------------
tabList_
  :: [Attribute action]
  -> [View model action]
  -> View model action
tabList_ :: forall action model.
[Attribute action] -> [View model action] -> View model action
tabList_ [Attribute action]
attrs [View model action]
kids =
  ([Attribute action] -> [View model action] -> View model action)
-> [Attribute action]
-> Bool
-> [Attribute action]
-> [View model action]
-> View model action
forall action model.
([Attribute action] -> [View model action] -> View model action)
-> [Attribute action]
-> Bool
-> [Attribute action]
-> [View model action]
-> View model action
optionalAttrs
  [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
H.nav_
    [Attribute action]
attrs
    Bool
True
    [ MisoString -> Attribute action
forall action. MisoString -> Attribute action
P.class_ MisoString
"w-full"
    , MisoString -> Attribute action
forall action. MisoString -> Attribute action
P.role_ MisoString
"tablist"
    , MisoString -> MisoString -> Attribute action
forall action. MisoString -> MisoString -> Attribute action
P.aria_ MisoString
"orientation" MisoString
"horizontal"
    ]
    [View model action]
kids
-----------------------------------------------------------------------------
-- | The tab button
--
-- * `_id` is the TAB_ID (must match `aria_ "labelledby"` in `tab_`)
-- * `aria_ "control"` PANEL_ID. (must match `id_` of `tab_`)
-- * `tabIndex_` is used for keyboard navigation
-- * `aria_ "selected"` ("true" | "false")
--
tabButton_
  :: [Attribute action]
  -> [View model action]
  -> View model action
tabButton_ :: forall action model.
[Attribute action] -> [View model action] -> View model action
tabButton_ [Attribute action]
attrs [View model action]
kids =
  ([Attribute action] -> [View model action] -> View model action)
-> [Attribute action]
-> Bool
-> [Attribute action]
-> [View model action]
-> View model action
forall action model.
([Attribute action] -> [View model action] -> View model action)
-> [Attribute action]
-> Bool
-> [Attribute action]
-> [View model action]
-> View model action
optionalAttrs
  [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
H.button_
    [Attribute action]
attrs
    Bool
True
    [ -- SP.tabindex_ "0"
    -- , aria_ "selected" "true"
    -- , aria_ "controls" "demo-tabs-with-panels-panel-1"
    -- , id_ "demo-tabs-with-panels-tab-1"
      MisoString -> Attribute action
forall action. MisoString -> Attribute action
P.role_ MisoString
"tab"
    , MisoString -> Attribute action
forall action. MisoString -> Attribute action
P.type_ MisoString
"button"
    ]
    [View model action]
kids
-----------------------------------------------------------------------------
-- | Needs aria selected true
tab_
  :: [Attribute action]
  -> [View model action]
  -> View model action
tab_ :: forall action model.
[Attribute action] -> [View model action] -> View model action
tab_ [Attribute action]
attrs [View model action]
kids =
  ([Attribute action] -> [View model action] -> View model action)
-> [Attribute action]
-> Bool
-> [Attribute action]
-> [View model action]
-> View model action
forall action model.
([Attribute action] -> [View model action] -> View model action)
-> [Attribute action]
-> Bool
-> [Attribute action]
-> [View model action]
-> View model action
optionalAttrs
  [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
H.div_
    [Attribute action]
attrs
    Bool
True
    [ -- P.aria_ "selected" "true"
      -- SP.tabindex_ "-1"
      MisoString -> MisoString -> Attribute action
forall action. MisoString -> MisoString -> Attribute action
P.aria_ MisoString
"labelledby" MisoString
"demo-tabs-with-panels-tab-1"
    , MisoString -> Attribute action
forall action. MisoString -> Attribute action
P.id_ MisoString
"demo-tabs-with-panels-panel-1"
      -- dmj: these must match tabButton_ "controls"
    , MisoString -> Attribute action
forall action. MisoString -> Attribute action
P.role_ MisoString
"tabpanel"
    ]
    [View model action]
kids
-----------------------------------------------------------------------------