{-# LANGUAGE OverloadedStrings #-}

module NanoUI.Widgets.Tabs
  ( Tab (..), TabStyle (..), TabOrientation (..), TabResponse (..)
  , TabsConfig (..), defaultTabsConfig
  , tab, closableTab
  , tabs, tabs', tabsConfigured, tabsConfigured'
  , tabBar, tabBar', tabBarConfigured, tabBarConfigured'
  )
where

import Control.Monad (forM_, when)
import Data.Bits ((.|.))
import Data.List (find)
import qualified Data.IntMap.Strict as IM
import Data.Maybe (isJust, listToMaybe)
import Data.Text (Text)
import Effectful (Eff, type (:>))
import NanoUI.Context
  ( Context (..)
  , getPrevRect
  , getScrollOffset
  , getStore
  , intKey
  , markDirty
  , resolveScrollStep
  , setScrollOffset
  , setStore
  , currentTheme
  )
import NanoUI.Frame.Hit (findNodeByWidgetId)
import NanoUI.Frame.Scroll.Geometry (scrollAxisRange, scrollBare, scrollHorizontalHidden)
import NanoUI.Id (WidgetId)
import NanoUI.Input (inputMousePos, inputScroll)
import NanoUI.Layout.Arena (setNodeValue)
import NanoUI.Monad (Ui, askContext, askInput, nextId, uiIO, withKey)
import NanoUI.Store (WidgetStore (storeFloat), slotKey, Slot (..))
import NanoUI.Style
  ( AlignX (..)
  , AlignY (..)
  , Direction (..)
  , Layout (..)
  , Padding (..)
  , Sizing (..)
  , defaultLayout
  , fillW
  , grow
  , themeMuted
  , tight
  )
import NanoUI.Types (Rect (..), clamp, rectContains, rectW, v2Y)
import NanoUI.WidgetText (buttonFlagClose, buttonFlagTab)
import NanoUI.Widgets.Combinators (buttonStyledEx)
import NanoUI.Widgets.Layout (column', columnWith, row', rowWith, scrollAreaIdConfigured)
import NanoUI.Widgets.Node
  ( HasResponse (..)
  , Response (..)
  , respClicked
  , respId
  , respRect
  , setChanged
  , setClicked
  , tagContainer
  )

data TabStyle = TabUnderline | TabPill | TabSegmented | TabContained
  deriving (TabStyle -> TabStyle -> Bool
(TabStyle -> TabStyle -> Bool)
-> (TabStyle -> TabStyle -> Bool) -> Eq TabStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TabStyle -> TabStyle -> Bool
== :: TabStyle -> TabStyle -> Bool
$c/= :: TabStyle -> TabStyle -> Bool
/= :: TabStyle -> TabStyle -> Bool
Eq, Int -> TabStyle -> ShowS
[TabStyle] -> ShowS
TabStyle -> String
(Int -> TabStyle -> ShowS)
-> (TabStyle -> String) -> ([TabStyle] -> ShowS) -> Show TabStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TabStyle -> ShowS
showsPrec :: Int -> TabStyle -> ShowS
$cshow :: TabStyle -> String
show :: TabStyle -> String
$cshowList :: [TabStyle] -> ShowS
showList :: [TabStyle] -> ShowS
Show, Int -> TabStyle
TabStyle -> Int
TabStyle -> [TabStyle]
TabStyle -> TabStyle
TabStyle -> TabStyle -> [TabStyle]
TabStyle -> TabStyle -> TabStyle -> [TabStyle]
(TabStyle -> TabStyle)
-> (TabStyle -> TabStyle)
-> (Int -> TabStyle)
-> (TabStyle -> Int)
-> (TabStyle -> [TabStyle])
-> (TabStyle -> TabStyle -> [TabStyle])
-> (TabStyle -> TabStyle -> [TabStyle])
-> (TabStyle -> TabStyle -> TabStyle -> [TabStyle])
-> Enum TabStyle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TabStyle -> TabStyle
succ :: TabStyle -> TabStyle
$cpred :: TabStyle -> TabStyle
pred :: TabStyle -> TabStyle
$ctoEnum :: Int -> TabStyle
toEnum :: Int -> TabStyle
$cfromEnum :: TabStyle -> Int
fromEnum :: TabStyle -> Int
$cenumFrom :: TabStyle -> [TabStyle]
enumFrom :: TabStyle -> [TabStyle]
$cenumFromThen :: TabStyle -> TabStyle -> [TabStyle]
enumFromThen :: TabStyle -> TabStyle -> [TabStyle]
$cenumFromTo :: TabStyle -> TabStyle -> [TabStyle]
enumFromTo :: TabStyle -> TabStyle -> [TabStyle]
$cenumFromThenTo :: TabStyle -> TabStyle -> TabStyle -> [TabStyle]
enumFromThenTo :: TabStyle -> TabStyle -> TabStyle -> [TabStyle]
Enum, TabStyle
TabStyle -> TabStyle -> Bounded TabStyle
forall a. a -> a -> Bounded a
$cminBound :: TabStyle
minBound :: TabStyle
$cmaxBound :: TabStyle
maxBound :: TabStyle
Bounded)

data TabOrientation = TabTop | TabBottom | TabLeft | TabRight
  deriving (TabOrientation -> TabOrientation -> Bool
(TabOrientation -> TabOrientation -> Bool)
-> (TabOrientation -> TabOrientation -> Bool) -> Eq TabOrientation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TabOrientation -> TabOrientation -> Bool
== :: TabOrientation -> TabOrientation -> Bool
$c/= :: TabOrientation -> TabOrientation -> Bool
/= :: TabOrientation -> TabOrientation -> Bool
Eq, Int -> TabOrientation -> ShowS
[TabOrientation] -> ShowS
TabOrientation -> String
(Int -> TabOrientation -> ShowS)
-> (TabOrientation -> String)
-> ([TabOrientation] -> ShowS)
-> Show TabOrientation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TabOrientation -> ShowS
showsPrec :: Int -> TabOrientation -> ShowS
$cshow :: TabOrientation -> String
show :: TabOrientation -> String
$cshowList :: [TabOrientation] -> ShowS
showList :: [TabOrientation] -> ShowS
Show, Int -> TabOrientation
TabOrientation -> Int
TabOrientation -> [TabOrientation]
TabOrientation -> TabOrientation
TabOrientation -> TabOrientation -> [TabOrientation]
TabOrientation
-> TabOrientation -> TabOrientation -> [TabOrientation]
(TabOrientation -> TabOrientation)
-> (TabOrientation -> TabOrientation)
-> (Int -> TabOrientation)
-> (TabOrientation -> Int)
-> (TabOrientation -> [TabOrientation])
-> (TabOrientation -> TabOrientation -> [TabOrientation])
-> (TabOrientation -> TabOrientation -> [TabOrientation])
-> (TabOrientation
    -> TabOrientation -> TabOrientation -> [TabOrientation])
-> Enum TabOrientation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TabOrientation -> TabOrientation
succ :: TabOrientation -> TabOrientation
$cpred :: TabOrientation -> TabOrientation
pred :: TabOrientation -> TabOrientation
$ctoEnum :: Int -> TabOrientation
toEnum :: Int -> TabOrientation
$cfromEnum :: TabOrientation -> Int
fromEnum :: TabOrientation -> Int
$cenumFrom :: TabOrientation -> [TabOrientation]
enumFrom :: TabOrientation -> [TabOrientation]
$cenumFromThen :: TabOrientation -> TabOrientation -> [TabOrientation]
enumFromThen :: TabOrientation -> TabOrientation -> [TabOrientation]
$cenumFromTo :: TabOrientation -> TabOrientation -> [TabOrientation]
enumFromTo :: TabOrientation -> TabOrientation -> [TabOrientation]
$cenumFromThenTo :: TabOrientation
-> TabOrientation -> TabOrientation -> [TabOrientation]
enumFromThenTo :: TabOrientation
-> TabOrientation -> TabOrientation -> [TabOrientation]
Enum, TabOrientation
TabOrientation -> TabOrientation -> Bounded TabOrientation
forall a. a -> a -> Bounded a
$cminBound :: TabOrientation
minBound :: TabOrientation
$cmaxBound :: TabOrientation
maxBound :: TabOrientation
Bounded)

-- | Header look and placement for 'tabsConfigured' and 'tabBarConfigured'.
data TabsConfig = TabsConfig
  { TabsConfig -> TabStyle
tabsStyle :: !TabStyle
  , TabsConfig -> TabOrientation
tabsOrientation :: !TabOrientation
  }
  deriving (TabsConfig -> TabsConfig -> Bool
(TabsConfig -> TabsConfig -> Bool)
-> (TabsConfig -> TabsConfig -> Bool) -> Eq TabsConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TabsConfig -> TabsConfig -> Bool
== :: TabsConfig -> TabsConfig -> Bool
$c/= :: TabsConfig -> TabsConfig -> Bool
/= :: TabsConfig -> TabsConfig -> Bool
Eq, Int -> TabsConfig -> ShowS
[TabsConfig] -> ShowS
TabsConfig -> String
(Int -> TabsConfig -> ShowS)
-> (TabsConfig -> String)
-> ([TabsConfig] -> ShowS)
-> Show TabsConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TabsConfig -> ShowS
showsPrec :: Int -> TabsConfig -> ShowS
$cshow :: TabsConfig -> String
show :: TabsConfig -> String
$cshowList :: [TabsConfig] -> ShowS
showList :: [TabsConfig] -> ShowS
Show)

-- | Underlined headers along the top.
defaultTabsConfig :: TabsConfig
defaultTabsConfig :: TabsConfig
defaultTabsConfig = TabStyle -> TabOrientation -> TabsConfig
TabsConfig TabStyle
TabUnderline TabOrientation
TabTop

data Tab a body = Tab
  { forall a body. Tab a body -> a
tabKey :: !a
  , forall a body. Tab a body -> Text
tabTitle :: !Text
  , forall a body. Tab a body -> Bool
tabClosable :: !Bool
  , forall a body. Tab a body -> Bool
tabDisabled :: !Bool
  , forall a body. Tab a body -> Maybe Text
tabBadge :: !(Maybe Text)
  , forall a body. Tab a body -> body
tabBody :: !body
  }

data TabResponse a = TabResponse
  { forall a. TabResponse a -> Response
tabResponse :: !Response
  , forall a. TabResponse a -> Maybe a
tabClosed :: !(Maybe a)
  , forall a. TabResponse a -> a
tabActive :: !a
  }
  deriving (TabResponse a -> TabResponse a -> Bool
(TabResponse a -> TabResponse a -> Bool)
-> (TabResponse a -> TabResponse a -> Bool) -> Eq (TabResponse a)
forall a. Eq a => TabResponse a -> TabResponse a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => TabResponse a -> TabResponse a -> Bool
== :: TabResponse a -> TabResponse a -> Bool
$c/= :: forall a. Eq a => TabResponse a -> TabResponse a -> Bool
/= :: TabResponse a -> TabResponse a -> Bool
Eq, Int -> TabResponse a -> ShowS
[TabResponse a] -> ShowS
TabResponse a -> String
(Int -> TabResponse a -> ShowS)
-> (TabResponse a -> String)
-> ([TabResponse a] -> ShowS)
-> Show (TabResponse a)
forall a. Show a => Int -> TabResponse a -> ShowS
forall a. Show a => [TabResponse a] -> ShowS
forall a. Show a => TabResponse a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> TabResponse a -> ShowS
showsPrec :: Int -> TabResponse a -> ShowS
$cshow :: forall a. Show a => TabResponse a -> String
show :: TabResponse a -> String
$cshowList :: forall a. Show a => [TabResponse a] -> ShowS
showList :: [TabResponse a] -> ShowS
Show)

instance HasResponse (TabResponse a) where
  {-# INLINE toResponse #-}
  toResponse :: TabResponse a -> Response
toResponse = TabResponse a -> Response
forall a. TabResponse a -> Response
tabResponse

tab :: a -> Text -> body -> Tab a body
tab :: forall a body. a -> Text -> body -> Tab a body
tab a
key Text
title body
body = a -> Text -> Bool -> Bool -> Maybe Text -> body -> Tab a body
forall a body.
a -> Text -> Bool -> Bool -> Maybe Text -> body -> Tab a body
Tab a
key Text
title Bool
False Bool
False Maybe Text
forall a. Maybe a
Nothing body
body

closableTab :: a -> Text -> body -> Tab a body
closableTab :: forall a body. a -> Text -> body -> Tab a body
closableTab a
key Text
title body
body = a -> Text -> Bool -> Bool -> Maybe Text -> body -> Tab a body
forall a body.
a -> Text -> Bool -> Bool -> Maybe Text -> body -> Tab a body
Tab a
key Text
title Bool
True Bool
False Maybe Text
forall a. Maybe a
Nothing body
body

-- | Header chrome height: one source for the strip bar, the scroller, and
-- the paging arrows so they cannot drift apart.
tabHeaderH :: Float
tabHeaderH :: Float
tabHeaderH = Float
28

-- | One rendered header, shared by selection, close handling, and scrolling.
data Header a = Header
  { forall a. Header a -> a
headerKey :: !a
  , forall a. Header a -> Response
headerResponse :: !Response
  , forall a. Header a -> Bool
headerClosed :: !Bool
  }

tabStrip ::
  (Eq a, Ui :> es) =>
  TabsConfig ->
  a ->
  [Tab a body] ->
  Maybe (a -> Eff es ()) ->
  Eff es (TabResponse a, a)
tabStrip :: forall a (es :: [Effect]) body.
(Eq a, Ui :> es) =>
TabsConfig
-> a
-> [Tab a body]
-> Maybe (a -> Eff es ())
-> Eff es (TabResponse a, a)
tabStrip (TabsConfig TabStyle
style TabOrientation
orient) a
cur [Tab a body]
tabList Maybe (a -> Eff es ())
mRenderBody = do
  ctx <- Eff es Context
forall (es :: [Effect]). (Ui :> es) => Eff es Context
askContext
  groupId <- nextId
  let vertical = TabOrientation
orient TabOrientation -> TabOrientation -> Bool
forall a. Eq a => a -> a -> Bool
== TabOrientation
TabLeft Bool -> Bool -> Bool
|| TabOrientation
orient TabOrientation -> TabOrientation -> Bool
forall a. Eq a => a -> a -> Bool
== TabOrientation
TabRight
      h = Float
tabHeaderH
      styleVal = TabStyle -> Int
forall a. Enum a => a -> Int
fromEnum TabStyle
style
      hdrLay =
        Layout
defaultLayout
          { layoutHeight = Fixed h
          , layoutPadding = Padding 8 8 4 4
          , layoutAlignX = AlignCenter
          , layoutAlignY = AlignMiddle
          , layoutGap = 4
          }
      barLay =
        if Bool
vertical
          then Layout
defaultLayout {layoutDirection = Column, layoutWidth = Fit, layoutHeight = Grow 1, layoutGap = 2, layoutPadding = Padding 2 2 2 2}
          else
            Layout
defaultLayout
              { layoutDirection = Row
              , layoutWidth = Grow 1
              , layoutHeight = Fixed (h + 4)
              , layoutGap = if style == TabSegmented then 0 else 4
              , layoutPadding = if style == TabContained then Padding 0 0 2 0 else Padding 0 0 0 0
              }
  let headerBar =
        if Bool
vertical
          then Layout -> Eff es (TabResponse a, a) -> Eff es (TabResponse a, a)
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
column' Layout
barLay (Eff es (TabResponse a, a) -> Eff es (TabResponse a, a))
-> Eff es (TabResponse a, a) -> Eff es (TabResponse a, a)
forall a b. (a -> b) -> a -> b
$ do
            WidgetId -> Eff es ()
forall (es :: [Effect]). (Ui :> es) => WidgetId -> Eff es ()
tagContainer WidgetId
groupId
            (tabResp, nextTab, _) <- Context
-> Layout
-> Int
-> a
-> [(Int, Tab a body)]
-> Eff es (TabResponse a, a, [Header a])
forall a (es :: [Effect]) body.
(Eq a, Ui :> es) =>
Context
-> Layout
-> Int
-> a
-> [(Int, Tab a body)]
-> Eff es (TabResponse a, a, [Header a])
renderHeaders Context
ctx Layout
hdrLay Int
styleVal a
cur ([Int] -> [Tab a body] -> [(Int, Tab a body)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [Tab a body]
tabList)
            pure (tabResp, nextTab)
          else Layout -> Eff es (TabResponse a, a) -> Eff es (TabResponse a, a)
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
row' Layout
barLay (Eff es (TabResponse a, a) -> Eff es (TabResponse a, a))
-> Eff es (TabResponse a, a) -> Eff es (TabResponse a, a)
forall a b. (a -> b) -> a -> b
$ do
            WidgetId -> Eff es ()
forall (es :: [Effect]). (Ui :> es) => WidgetId -> Eff es ()
tagContainer WidgetId
groupId
            Context
-> TabStyle
-> Layout
-> Layout
-> WidgetId
-> a
-> [Tab a body]
-> Eff es (TabResponse a, a)
forall a (es :: [Effect]) body.
(Eq a, Ui :> es) =>
Context
-> TabStyle
-> Layout
-> Layout
-> WidgetId
-> a
-> [Tab a body]
-> Eff es (TabResponse a, a)
renderScrollableHeaders Context
ctx TabStyle
style Layout
hdrLay Layout
barLay WidgetId
groupId a
cur [Tab a body]
tabList
  case mRenderBody of
    Maybe (a -> Eff es ())
Nothing -> Eff es (TabResponse a, a)
headerBar
    Just a -> Eff es ()
bodyRender ->
      let shell :: (Eff es (TabResponse a, a) -> Eff es (TabResponse a, a))
-> Eff es (TabResponse a, a)
shell Eff es (TabResponse a, a) -> Eff es (TabResponse a, a)
layout = Eff es (TabResponse a, a) -> Eff es (TabResponse a, a)
layout (Eff es (TabResponse a, a) -> Eff es (TabResponse a, a))
-> Eff es (TabResponse a, a) -> Eff es (TabResponse a, a)
forall a b. (a -> b) -> a -> b
$ do
            (tabResp, nextTab) <- Eff es (TabResponse a, a)
headerBar
            bodyRender nextTab
            pure (tabResp, nextTab)
       in if Bool
vertical
            then (Eff es (TabResponse a, a) -> Eff es (TabResponse a, a))
-> Eff es (TabResponse a, a)
shell ((Layout -> Layout)
-> Eff es (TabResponse a, a) -> Eff es (TabResponse a, a)
forall (es :: [Effect]) a.
(Ui :> es) =>
(Layout -> Layout) -> Eff es a -> Eff es a
rowWith (Layout -> Layout
tight (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fillW (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
grow))
            else (Eff es (TabResponse a, a) -> Eff es (TabResponse a, a))
-> Eff es (TabResponse a, a)
shell ((Layout -> Layout)
-> Eff es (TabResponse a, a) -> Eff es (TabResponse a, a)
forall (es :: [Effect]) a.
(Ui :> es) =>
(Layout -> Layout) -> Eff es a -> Eff es a
columnWith (Layout -> Layout
tight (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fillW))

-- | Horizontal headers that page with chevron buttons when they overflow.
-- While the labels fit, the strip renders exactly as before (no scroll
-- container, no well). Once they overflow, the headers move into a 1D
-- hidden, bare 'scrollHorizontalHidden' container so the framework owns the
-- clip, the offset store, the damage, and the wheel: a bare scroller paints
-- no well, so the headers look exactly as they did before they could
-- scroll, and the hidden policy keeps the scrollbar away while the wheel
-- (both the left+right axis, applied by the framework, and up/down notches,
-- mapped here because a tab bar is horizontal) still pages the same offset.
-- The strip only adds the two buttons. The scroller grows between the
-- buttons, so the right arrow sits on the bar's far edge instead of
-- trailing the last tab.
renderScrollableHeaders ::
  (Eq a, Ui :> es) =>
  Context ->
  TabStyle ->
  Layout ->
  Layout ->
  WidgetId ->
  a ->
  [Tab a body] ->
  Eff es (TabResponse a, a)
renderScrollableHeaders :: forall a (es :: [Effect]) body.
(Eq a, Ui :> es) =>
Context
-> TabStyle
-> Layout
-> Layout
-> WidgetId
-> a
-> [Tab a body]
-> Eff es (TabResponse a, a)
renderScrollableHeaders Context
ctx TabStyle
style Layout
hdrLay Layout
barLay WidgetId
groupId a
cur [Tab a body]
tabList = do
  scrollWid <- Text -> Eff es WidgetId -> Eff es WidgetId
forall k (es :: [Effect]) a.
(Hashable k, Ui :> es) =>
k -> Eff es a -> Eff es a
withKey (Text
"tab-scroller" :: Text) Eff es WidgetId
forall (es :: [Effect]). (Ui :> es) => Eff es WidgetId
nextId
  let h = Float
tabHeaderH
      styleVal = TabStyle -> Int
forall a. Enum a => a -> Int
fromEnum TabStyle
style
      barPad = Layout -> Padding
layoutPadding Layout
barLay
      arrowW = Float
26
      leftGlyph = Text
"\8249"
      rightGlyph = Text
"\8250"
      innerLay =
        Layout
defaultLayout
          { layoutDirection = Row
          , layoutWidth = Fit
          , layoutHeight = Fixed h
          , layoutGap = layoutGap barLay
          , layoutPadding = Padding 0 0 0 0
          }
      scrollerLay =
        Layout
defaultLayout
          { layoutDirection = Row
          , layoutWidth = Grow 1
          , layoutHeight = Fixed h
          , layoutPadding = Padding 0 0 0 0
          }
      -- Hidden + bare: the scroller owns the clip, offset, wheel, and damage
      -- but paints nothing (no well, no scrollbar), so the headers look
      -- exactly as they did before the strip could scroll.
      scrollerCfg = ScrollConfig
scrollHorizontalHidden {scrollBare = True}
      rangeKey = Slot -> Int -> Int
slotKey Slot
SlotScrollContent (WidgetId -> Int
intKey WidgetId
scrollWid)
      renderInner =
        Text
-> Eff es (TabResponse a, a, [Header a])
-> Eff es (TabResponse a, a, [Header a])
forall k (es :: [Effect]) a.
(Hashable k, Ui :> es) =>
k -> Eff es a -> Eff es a
withKey (Text
"tab-strip" :: Text) (Eff es (TabResponse a, a, [Header a])
 -> Eff es (TabResponse a, a, [Header a]))
-> Eff es (TabResponse a, a, [Header a])
-> Eff es (TabResponse a, a, [Header a])
forall a b. (a -> b) -> a -> b
$
          Layout
-> Eff es (TabResponse a, a, [Header a])
-> Eff es (TabResponse a, a, [Header a])
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
row' Layout
innerLay (Context
-> Layout
-> Int
-> a
-> [(Int, Tab a body)]
-> Eff es (TabResponse a, a, [Header a])
forall a (es :: [Effect]) body.
(Eq a, Ui :> es) =>
Context
-> Layout
-> Int
-> a
-> [(Int, Tab a body)]
-> Eff es (TabResponse a, a, [Header a])
renderHeaders Context
ctx Layout
hdrLay Int
styleVal a
cur ([Int] -> [Tab a body] -> [(Int, Tab a body)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [Tab a body]
tabList))
  -- The reachable range cached last frame decides whether the strip needs the
  -- scroller at all. Cached as a float so a pure scroll frame keeps its clip
  -- damage (see `onlyScrollFloatsChanged` in NanoUI.Damage).
  store <- uiIO (getStore ctx)
  let maxOffPrev = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float -> Int -> IntMap Float -> Float
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Float
0 Int
rangeKey (WidgetStore -> IntMap Float
storeFloat WidgetStore
store))
      overflow = Float
maxOffPrev Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0.5
  off <- uiIO (getScrollOffset ctx scrollWid)
  wheelStep <- uiIO (resolveScrollStep ctx scrollWid)
  mBar <- uiIO (getPrevRect ctx groupId)
  mScr <- uiIO (getPrevRect ctx scrollWid)
  inp <- askInput
  let overBar = Bool -> (Rect -> Bool) -> Maybe Rect -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Rect
r -> Rect -> V2 -> Bool
rectContains Rect
r (Input -> V2
inputMousePos Input
inp)) Maybe Rect
mBar
      notches = if Bool
overBar then Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (V2 -> Float
v2Y (Input -> V2
inputScroll Input
inp)) else Int
0 :: Int
      canLeft = Bool
overflow Bool -> Bool -> Bool
&& Float
off Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0.5
  leftResp <-
    if overflow
      then Just <$> withKey ("tab-arrow-left" :: Text) (arrowButton ctx hdrLay arrowW h (not canLeft) leftGlyph)
      else pure Nothing
  (tabResp, nextTab, resps) <-
    if overflow
      then scrollAreaIdConfigured scrollWid scrollerLay scrollerCfg renderInner
      else renderInner
  let
    (viewX, viewW) =
      if overflow
        then maybe (0, 0) (\Rect
r -> (Rect -> Float
rectX Rect
r, Rect -> Float
rectW Rect
r)) mScr
        else
          case mBar of
            Just Rect
r ->
              ( Rect -> Float
rectX Rect
r Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Padding -> Float
padL Padding
barPad
              , Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Rect -> Float
rectW Rect
r Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padL Padding
barPad Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padR Padding
barPad)
              )
            Maybe Rect
Nothing -> (Float
0, Float
0)
    maxRight = [Float] -> Float
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Float
0 Float -> [Float] -> [Float]
forall a. a -> [a] -> [a]
: [Rect -> Float
rectX Rect
r Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Rect -> Float
rectW Rect
r | Header a
header <- [Header a]
resps, let r :: Rect
r = Response -> Rect
forall r. HasResponse r => r -> Rect
respRect (Header a -> Response
forall a. Header a -> Response
headerResponse Header a
header)])
    contentW = Float
maxRight Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
viewX Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (if Bool
overflow then Float
off else Float
0)
    -- The first overflow frame has no scroller rect yet (mScr is Nothing);
    -- keep the last cached range instead of measuring against a phantom
    -- viewport, so nothing pages or clamps wildly and the cache never
    -- flip-flops the scroller away.
    maxOff = case (Bool
overflow, Maybe Rect
mScr) of
      (Bool
True, Maybe Rect
Nothing) -> Float
maxOffPrev
      (Bool, Maybe Rect)
_ -> Float -> Float -> Float -> Float
scrollAxisRange Float
contentW Float
viewW Float
0
    page = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
1 (Float
viewW Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.9)
    canRight = Bool
overflow Bool -> Bool -> Bool
&& Float
off Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
maxOff Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
0.5
  rightResp <-
    if overflow
      then Just <$> withKey ("tab-arrow-right" :: Text) (arrowButton ctx hdrLay arrowW h (not canRight) rightGlyph)
      else pure Nothing
  uiIO (cacheScrollRange ctx rangeKey maxOff)
  -- One final offset per frame. The paged result folds the arrow pages, the
  -- wheel notches, and the end clamp (a stale offset that outlived a wider
  -- bar); the active-follow wins over it so a programmatically changed tab
  -- always lands in view.
  let pagedOff
        | Bool -> (Response -> Bool) -> Maybe Response -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Response -> Bool
forall r. HasResponse r => r -> Bool
respClicked Maybe Response
leftResp, Bool
canLeft = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
off Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
page)
        | Bool -> (Response -> Bool) -> Maybe Response -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Response -> Bool
forall r. HasResponse r => r -> Bool
respClicked Maybe Response
rightResp, Bool
canRight = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
maxOff (Float
off Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
page)
        | Bool
overflow, Int
notches Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0, Float
maxOff Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 =
            Float -> Float -> Float -> Float
forall a. Ord a => a -> a -> a -> a
clamp Float
0 Float
maxOff (Float
off Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
notches Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
wheelStep)
        | Bool
overflow, Float
off Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
maxOff Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.5 = Float
maxOff
        | Bool
otherwise = Float
off
      finalOff
        | Bool
overflow
        , a
nextTab a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
cur
        , Just Header a
header <- (Header a -> Bool) -> [Header a] -> Maybe (Header a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
nextTab) (a -> Bool) -> (Header a -> a) -> Header a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header a -> a
forall a. Header a -> a
headerKey) [Header a]
resps
        , let hr :: Rect
hr = Response -> Rect
forall r. HasResponse r => r -> Rect
respRect (Header a -> Response
forall a. Header a -> Response
headerResponse Header a
header) =
            if Rect -> Float
rectX Rect
hr Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
viewX
              then Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
off Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Float
viewX Float -> Float -> Float
forall a. Num a => a -> a -> a
- Rect -> Float
rectX Rect
hr))
              else
                if Rect -> Float
rectX Rect
hr Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Rect -> Float
rectW Rect
hr Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
viewX Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
viewW
                  then Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
maxOff (Float
off Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Rect -> Float
rectX Rect
hr Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Rect -> Float
rectW Rect
hr Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
viewX Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
viewW))
                  else Float
pagedOff
        | Bool
otherwise = Float
pagedOff
  when (finalOff /= off) $
    uiIO (setScrollOffset ctx scrollWid finalOff)
  pure (tabResp, nextTab)

-- | Remember the scroller's reachable range for the next frame's arrow
-- visibility. Sub-pixel churn is ignored so a parked strip never dirties.
cacheScrollRange :: Context -> Int -> Float -> IO ()
cacheScrollRange :: Context -> Int -> Float -> IO ()
cacheScrollRange Context
ctx Int
key Float
v = do
  st <- Context -> IO WidgetStore
getStore Context
ctx
  let prev = Float -> Int -> IntMap Float -> Float
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Float
0 Int
key (WidgetStore -> IntMap Float
storeFloat WidgetStore
st)
  when (abs (prev - v) > 0.5) $
    setStore ctx (st {storeFloat = IM.insert key v (storeFloat st)})

-- | A prettier thin chevron button for the strip. Disabled ends paint the
-- glyph in the muted fg instead of dropping the button, so the row width does
-- not jump as you page to either end.
arrowButton :: (Ui :> es) => Context -> Layout -> Float -> Float -> Bool -> Text -> Eff es Response
arrowButton :: forall (es :: [Effect]).
(Ui :> es) =>
Context
-> Layout -> Float -> Float -> Bool -> Text -> Eff es Response
arrowButton Context
ctx Layout
hdrLay Float
arrowW Float
barH Bool
muted Text
glyph = do
  theme <- IO Theme -> Eff es Theme
forall (es :: [Effect]) a. (Ui :> es) => IO a -> Eff es a
uiIO (Context -> IO Theme
currentTheme Context
ctx)
  let lay =
        Layout
hdrLay
          { layoutWidth = Fixed arrowW
          , layoutHeight = Fixed barH
          , layoutFontColor = if muted then Just (themeMuted theme) else Nothing
          }
  buttonStyledEx (not muted) glyph 0 lay 0

renderHeaders ::
  (Eq a, Ui :> es) =>
  Context ->
  Layout ->
  Int ->
  a ->
  [(Int, Tab a body)] ->
  Eff es (TabResponse a, a, [Header a])
renderHeaders :: forall a (es :: [Effect]) body.
(Eq a, Ui :> es) =>
Context
-> Layout
-> Int
-> a
-> [(Int, Tab a body)]
-> Eff es (TabResponse a, a, [Header a])
renderHeaders Context
ctx Layout
hdrLay Int
styleVal a
cur [(Int, Tab a body)]
indexed = do
  resps <- ((Int, Tab a body) -> Eff es (Header a))
-> [(Int, Tab a body)] -> Eff es [Header a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Int
i, Tab a body
t) -> Int -> Eff es (Header a) -> Eff es (Header a)
forall k (es :: [Effect]) a.
(Hashable k, Ui :> es) =>
k -> Eff es a -> Eff es a
withKey Int
i (Layout -> Int -> a -> Tab a body -> Eff es (Header a)
forall a (es :: [Effect]) body.
(Eq a, Ui :> es) =>
Layout -> Int -> a -> Tab a body -> Eff es (Header a)
renderSingleHeader Layout
hdrLay (Int
styleVal Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) a
cur Tab a body
t)) [(Int, Tab a body)]
indexed
  let clickedKeys = [Header a -> a
forall a. Header a -> a
headerKey Header a
h | Header a
h <- [Header a]
resps, Response -> Bool
forall r. HasResponse r => r -> Bool
respClicked (Header a -> Response
forall a. Header a -> Response
headerResponse Header a
h), Bool -> Bool
not (Header a -> Bool
forall a. Header a -> Bool
headerClosed Header a
h)]
      closedKey = Header a -> a
forall a. Header a -> a
headerKey (Header a -> a) -> Maybe (Header a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Header a -> Bool) -> [Header a] -> Maybe (Header a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Header a -> Bool
forall a. Header a -> Bool
headerClosed [Header a]
resps
      nextTab = case [a]
clickedKeys of
        (a
k : [a]
_) -> a
k
        [] -> a
cur
      hasChanged = a
nextTab a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
cur
      hasClicked = Bool -> Bool
not ([a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
clickedKeys)
      overallResp =
        TabResponse
          { tabResponse :: Response
tabResponse = Bool -> Response -> Response
setChanged Bool
hasChanged (Bool -> Response -> Response
setClicked Bool
hasClicked ((Header a -> Response) -> [Header a] -> Response
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Header a -> Response
forall a. Header a -> Response
headerResponse [Header a]
resps))
          , tabClosed :: Maybe a
tabClosed = Maybe a
closedKey
          , tabActive :: a
tabActive = a
nextTab
          }
  when (hasChanged || isJust closedKey) $ uiIO (markDirty ctx)
  when hasChanged $ uiIO (syncTabHeaderActive ctx nextTab resps)
  pure (overallResp, nextTab, resps)

renderSingleHeader ::
  (Eq a, Ui :> es) =>
  Layout ->
  Int ->
  a ->
  Tab a body ->
  Eff es (Header a)
renderSingleHeader :: forall a (es :: [Effect]) body.
(Eq a, Ui :> es) =>
Layout -> Int -> a -> Tab a body -> Eff es (Header a)
renderSingleHeader Layout
hdrLay Int
packedStyle a
cur Tab a body
t = do
  let isActive :: Bool
isActive = Tab a body -> a
forall a body. Tab a body -> a
tabKey Tab a body
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
cur
      headerText :: Text
headerText = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Tab a body -> Text
forall a body. Tab a body -> Text
tabTitle Tab a body
t) (\Text
b -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Tab a body -> Text
forall a body. Tab a body -> Text
tabTitle Tab a body
t, Text
" (", Text
b, Text
")"]) (Tab a body -> Maybe Text
forall a body. Tab a body -> Maybe Text
tabBadge Tab a body
t)
      tabStyle :: Int
tabStyle = Int
packedStyle Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
buttonFlagTab
      headerButton :: Text -> Float -> Layout -> Int -> Eff es Response
headerButton = Bool -> Text -> Float -> Layout -> Int -> Eff es Response
forall (es :: [Effect]).
(Ui :> es) =>
Bool -> Text -> Float -> Layout -> Int -> Eff es Response
buttonStyledEx (Bool -> Bool
not (Tab a body -> Bool
forall a body. Tab a body -> Bool
tabDisabled Tab a body
t))
  if Tab a body -> Bool
forall a body. Tab a body -> Bool
tabClosable Tab a body
t
    then do
      (tabResp, closed) <- (Layout -> Layout)
-> Eff es (Response, Bool) -> Eff es (Response, Bool)
forall (es :: [Effect]) a.
(Ui :> es) =>
(Layout -> Layout) -> Eff es a -> Eff es a
rowWith Layout -> Layout
tight (Eff es (Response, Bool) -> Eff es (Response, Bool))
-> Eff es (Response, Bool) -> Eff es (Response, Bool)
forall a b. (a -> b) -> a -> b
$ do
        resp <- Text -> Float -> Layout -> Int -> Eff es Response
headerButton Text
headerText (if Bool
isActive then Float
1 else Float
0) Layout
hdrLay Int
tabStyle
        closeResp <- headerButton "\215" 0 (hdrLay {layoutPadding = Padding 2 4 4 4}) buttonFlagClose
        pure (resp, respClicked closeResp)
      pure (Header (tabKey t) tabResp closed)
    else do
      resp <- Text -> Float -> Layout -> Int -> Eff es Response
headerButton Text
headerText (if Bool
isActive then Float
1 else Float
0) Layout
hdrLay Int
tabStyle
      pure (Header (tabKey t) resp False)

syncTabHeaderActive :: Eq a => Context -> a -> [Header a] -> IO ()
syncTabHeaderActive :: forall a. Eq a => Context -> a -> [Header a] -> IO ()
syncTabHeaderActive Context
ctx a
active [Header a]
resps =
  [Header a] -> (Header a -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Header a]
resps ((Header a -> IO ()) -> IO ()) -> (Header a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Header a
k Response
r Bool
_) -> do
    mIdx <- Context -> WidgetId -> IO (Maybe Int)
findNodeByWidgetId Context
ctx (Response -> WidgetId
forall r. HasResponse r => r -> WidgetId
respId Response
r)
    case mIdx of
      Just Int
i -> NodeArena -> Int -> Float -> IO ()
setNodeValue (Context -> NodeArena
ctxNodeArena Context
ctx) Int
i (if a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
active then Float
1 else Float
0)
      Maybe Int
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Tab headers and the active tab's body. Pass the active key; the result is
-- the active key after this frame's clicks or arrow keys. Only the active
-- tab's body runs.
{-# INLINE tabs #-}
tabs :: (Foldable f, Eq a, Ui :> es) => a -> f (Tab a (Eff es ())) -> Eff es a
tabs :: forall (f :: * -> *) a (es :: [Effect]).
(Foldable f, Eq a, Ui :> es) =>
a -> f (Tab a (Eff es ())) -> Eff es a
tabs = TabsConfig -> a -> f (Tab a (Eff es ())) -> Eff es a
forall (f :: * -> *) a (es :: [Effect]).
(Foldable f, Eq a, Ui :> es) =>
TabsConfig -> a -> f (Tab a (Eff es ())) -> Eff es a
tabsConfigured TabsConfig
defaultTabsConfig

-- | 'tabs' returning the 'TabResponse', which also reports a closed tab.
{-# INLINE tabs' #-}
tabs' :: (Foldable f, Eq a, Ui :> es) => a -> f (Tab a (Eff es ())) -> Eff es (TabResponse a)
tabs' :: forall (f :: * -> *) a (es :: [Effect]).
(Foldable f, Eq a, Ui :> es) =>
a -> f (Tab a (Eff es ())) -> Eff es (TabResponse a)
tabs' = TabsConfig -> a -> f (Tab a (Eff es ())) -> Eff es (TabResponse a)
forall (f :: * -> *) a (es :: [Effect]).
(Foldable f, Eq a, Ui :> es) =>
TabsConfig -> a -> f (Tab a (Eff es ())) -> Eff es (TabResponse a)
tabsConfigured' TabsConfig
defaultTabsConfig

-- | 'tabs' with a header style and placement.
tabsConfigured :: (Foldable f, Eq a, Ui :> es) => TabsConfig -> a -> f (Tab a (Eff es ())) -> Eff es a
tabsConfigured :: forall (f :: * -> *) a (es :: [Effect]).
(Foldable f, Eq a, Ui :> es) =>
TabsConfig -> a -> f (Tab a (Eff es ())) -> Eff es a
tabsConfigured TabsConfig
cfg a
active f (Tab a (Eff es ()))
inputTabs =
  let ts :: [Tab a (Eff es ())]
ts = (Tab a (Eff es ()) -> [Tab a (Eff es ())] -> [Tab a (Eff es ())])
-> [Tab a (Eff es ())]
-> f (Tab a (Eff es ()))
-> [Tab a (Eff es ())]
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] f (Tab a (Eff es ()))
inputTabs
   in (TabResponse a, a) -> a
forall a b. (a, b) -> b
snd ((TabResponse a, a) -> a) -> Eff es (TabResponse a, a) -> Eff es a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TabsConfig
-> a
-> [Tab a (Eff es ())]
-> Maybe (a -> Eff es ())
-> Eff es (TabResponse a, a)
forall a (es :: [Effect]) body.
(Eq a, Ui :> es) =>
TabsConfig
-> a
-> [Tab a body]
-> Maybe (a -> Eff es ())
-> Eff es (TabResponse a, a)
tabStrip TabsConfig
cfg a
active [Tab a (Eff es ())]
ts ((a -> Eff es ()) -> Maybe (a -> Eff es ())
forall a. a -> Maybe a
Just ([Tab a (Eff es ())] -> a -> Eff es ()
forall a (es :: [Effect]).
(Eq a, Ui :> es) =>
[Tab a (Eff es ())] -> a -> Eff es ()
renderBody [Tab a (Eff es ())]
ts))

tabsConfigured' :: (Foldable f, Eq a, Ui :> es) => TabsConfig -> a -> f (Tab a (Eff es ())) -> Eff es (TabResponse a)
tabsConfigured' :: forall (f :: * -> *) a (es :: [Effect]).
(Foldable f, Eq a, Ui :> es) =>
TabsConfig -> a -> f (Tab a (Eff es ())) -> Eff es (TabResponse a)
tabsConfigured' TabsConfig
cfg a
active f (Tab a (Eff es ()))
inputTabs =
  let ts :: [Tab a (Eff es ())]
ts = (Tab a (Eff es ()) -> [Tab a (Eff es ())] -> [Tab a (Eff es ())])
-> [Tab a (Eff es ())]
-> f (Tab a (Eff es ()))
-> [Tab a (Eff es ())]
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] f (Tab a (Eff es ()))
inputTabs
   in (TabResponse a, a) -> TabResponse a
forall a b. (a, b) -> a
fst ((TabResponse a, a) -> TabResponse a)
-> Eff es (TabResponse a, a) -> Eff es (TabResponse a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TabsConfig
-> a
-> [Tab a (Eff es ())]
-> Maybe (a -> Eff es ())
-> Eff es (TabResponse a, a)
forall a (es :: [Effect]) body.
(Eq a, Ui :> es) =>
TabsConfig
-> a
-> [Tab a body]
-> Maybe (a -> Eff es ())
-> Eff es (TabResponse a, a)
tabStrip TabsConfig
cfg a
active [Tab a (Eff es ())]
ts ((a -> Eff es ()) -> Maybe (a -> Eff es ())
forall a. a -> Maybe a
Just ([Tab a (Eff es ())] -> a -> Eff es ()
forall a (es :: [Effect]).
(Eq a, Ui :> es) =>
[Tab a (Eff es ())] -> a -> Eff es ()
renderBody [Tab a (Eff es ())]
ts))

-- | Tab headers only; the caller renders the body.
{-# INLINE tabBar #-}
tabBar :: (Foldable f, Eq a, Ui :> es) => a -> f (Tab a body) -> Eff es a
tabBar :: forall (f :: * -> *) a (es :: [Effect]) body.
(Foldable f, Eq a, Ui :> es) =>
a -> f (Tab a body) -> Eff es a
tabBar = TabsConfig -> a -> f (Tab a body) -> Eff es a
forall (f :: * -> *) a (es :: [Effect]) body.
(Foldable f, Eq a, Ui :> es) =>
TabsConfig -> a -> f (Tab a body) -> Eff es a
tabBarConfigured TabsConfig
defaultTabsConfig

{-# INLINE tabBar' #-}
tabBar' :: (Foldable f, Eq a, Ui :> es) => a -> f (Tab a body) -> Eff es (TabResponse a)
tabBar' :: forall (f :: * -> *) a (es :: [Effect]) body.
(Foldable f, Eq a, Ui :> es) =>
a -> f (Tab a body) -> Eff es (TabResponse a)
tabBar' = TabsConfig -> a -> f (Tab a body) -> Eff es (TabResponse a)
forall (f :: * -> *) a (es :: [Effect]) body.
(Foldable f, Eq a, Ui :> es) =>
TabsConfig -> a -> f (Tab a body) -> Eff es (TabResponse a)
tabBarConfigured' TabsConfig
defaultTabsConfig

tabBarConfigured :: (Foldable f, Eq a, Ui :> es) => TabsConfig -> a -> f (Tab a body) -> Eff es a
tabBarConfigured :: forall (f :: * -> *) a (es :: [Effect]) body.
(Foldable f, Eq a, Ui :> es) =>
TabsConfig -> a -> f (Tab a body) -> Eff es a
tabBarConfigured TabsConfig
cfg a
active f (Tab a body)
ts = (TabResponse a, a) -> a
forall a b. (a, b) -> b
snd ((TabResponse a, a) -> a) -> Eff es (TabResponse a, a) -> Eff es a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TabsConfig
-> a
-> [Tab a body]
-> Maybe (a -> Eff es ())
-> Eff es (TabResponse a, a)
forall a (es :: [Effect]) body.
(Eq a, Ui :> es) =>
TabsConfig
-> a
-> [Tab a body]
-> Maybe (a -> Eff es ())
-> Eff es (TabResponse a, a)
tabStrip TabsConfig
cfg a
active ((Tab a body -> [Tab a body] -> [Tab a body])
-> [Tab a body] -> f (Tab a body) -> [Tab a body]
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] f (Tab a body)
ts) Maybe (a -> Eff es ())
forall a. Maybe a
Nothing

tabBarConfigured' :: (Foldable f, Eq a, Ui :> es) => TabsConfig -> a -> f (Tab a body) -> Eff es (TabResponse a)
tabBarConfigured' :: forall (f :: * -> *) a (es :: [Effect]) body.
(Foldable f, Eq a, Ui :> es) =>
TabsConfig -> a -> f (Tab a body) -> Eff es (TabResponse a)
tabBarConfigured' TabsConfig
cfg a
active f (Tab a body)
ts = (TabResponse a, a) -> TabResponse a
forall a b. (a, b) -> a
fst ((TabResponse a, a) -> TabResponse a)
-> Eff es (TabResponse a, a) -> Eff es (TabResponse a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TabsConfig
-> a
-> [Tab a body]
-> Maybe (a -> Eff es ())
-> Eff es (TabResponse a, a)
forall a (es :: [Effect]) body.
(Eq a, Ui :> es) =>
TabsConfig
-> a
-> [Tab a body]
-> Maybe (a -> Eff es ())
-> Eff es (TabResponse a, a)
tabStrip TabsConfig
cfg a
active ((Tab a body -> [Tab a body] -> [Tab a body])
-> [Tab a body] -> f (Tab a body) -> [Tab a body]
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] f (Tab a body)
ts) Maybe (a -> Eff es ())
forall a. Maybe a
Nothing

renderBody :: (Eq a, Ui :> es) => [Tab a (Eff es ())] -> a -> Eff es ()
renderBody :: forall a (es :: [Effect]).
(Eq a, Ui :> es) =>
[Tab a (Eff es ())] -> a -> Eff es ()
renderBody [Tab a (Eff es ())]
ts a
activeKey =
  (Layout -> Layout) -> Eff es () -> Eff es ()
forall (es :: [Effect]) a.
(Ui :> es) =>
(Layout -> Layout) -> Eff es a -> Eff es a
columnWith (Layout -> Layout
tight (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fillW) (Eff es () -> Eff es ()) -> Eff es () -> Eff es ()
forall a b. (a -> b) -> a -> b
$
    case (Tab a (Eff es ()) -> Bool)
-> [Tab a (Eff es ())] -> Maybe (Tab a (Eff es ()))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
activeKey) (a -> Bool)
-> (Tab a (Eff es ()) -> a) -> Tab a (Eff es ()) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tab a (Eff es ()) -> a
forall a body. Tab a body -> a
tabKey) [Tab a (Eff es ())]
ts of
      Just Tab a (Eff es ())
selected -> Tab a (Eff es ()) -> Eff es ()
forall a body. Tab a body -> body
tabBody Tab a (Eff es ())
selected
      Maybe (Tab a (Eff es ()))
Nothing -> Eff es ()
-> (Tab a (Eff es ()) -> Eff es ())
-> Maybe (Tab a (Eff es ()))
-> Eff es ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Eff es ()
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Tab a (Eff es ()) -> Eff es ()
forall a body. Tab a body -> body
tabBody ([Tab a (Eff es ())] -> Maybe (Tab a (Eff es ()))
forall a. [a] -> Maybe a
listToMaybe [Tab a (Eff es ())]
ts)