{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Button and selection helpers shared by the widget modules.
module NanoUI.Widgets.Combinators
  ( buttonStyled
  , buttonStyledEx
  , selectableItem
  , withBoundedIndex
  )
where

import Control.Monad (when)
import Data.Text (Text)
import Effectful (Eff, type (:>))
import NanoUI.Context (isDisabled, registerFocusable)
import NanoUI.Layout.Arena (NodeType (..))
import NanoUI.Monad (Ui, askContext, nextId, uiIO)
import NanoUI.Style (Layout (..))
import NanoUI.Widgets.Behavior (keyActivated)
import NanoUI.Widgets.Node
  ( Response (..)
  , addWidgetStyled
  , setClicked
  )

-- | Button with styleIdx for active, sort, badge, or close chrome. Focusable
-- and activatable with Enter or Space while focused.
buttonStyled :: (Ui :> es) => Text -> Float -> Layout -> Int -> Eff es Response
buttonStyled :: forall (es :: [Effect]).
(Ui :> es) =>
Text -> Float -> Layout -> Int -> Eff es Response
buttonStyled = Bool -> Text -> Float -> Layout -> Int -> Eff es Response
forall (es :: [Effect]).
(Ui :> es) =>
Bool -> Text -> Float -> Layout -> Int -> Eff es Response
buttonStyledEx Bool
True

-- | Shared activation path for ordinary buttons, menu items, and header chrome.
-- Disabled controls keep their identity and geometry but cannot take focus or
-- activate, including through a click queued before they became disabled.
{-# INLINE buttonStyledEx #-}
buttonStyledEx :: (Ui :> es) => Bool -> Text -> Float -> Layout -> Int -> Eff es Response
buttonStyledEx :: forall (es :: [Effect]).
(Ui :> es) =>
Bool -> Text -> Float -> Layout -> Int -> Eff es Response
buttonStyledEx Bool
enabled Text
txt Float
value Layout
layout Int
styleIdx = do
  wid <- Eff es WidgetId
forall (es :: [Effect]). (Ui :> es) => Eff es WidgetId
nextId
  ctx <- askContext
  disabled <- uiIO (isDisabled ctx wid)
  let active = Bool
enabled Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
disabled
  when active $ uiIO (registerFocusable ctx wid)
  resp <- addWidgetStyled wid NodeButton txt value layout styleIdx
  if active
    then do
      keyClick <- keyActivated wid
      pure (if keyClick then setClicked True resp else resp)
    else pure resp
      { rawRespHovered = False
      , rawRespPressed = False
      , rawRespClicked = False
      , rawRespRightPressed = False
      , rawRespRightClicked = False
      }

selectableItem :: (Ui :> es) => NodeType -> Text -> Bool -> Layout -> Int -> Eff es Response
selectableItem :: forall (es :: [Effect]).
(Ui :> es) =>
NodeType -> Text -> Bool -> Layout -> Int -> Eff es Response
selectableItem NodeType
nt Text
txt Bool
selected Layout
layout Int
styleIdx = do
  wid <- Eff es WidgetId
forall (es :: [Effect]). (Ui :> es) => Eff es WidgetId
nextId
  addWidgetStyled
    wid
    nt
    txt
    (if selected then 1 else 0)
    layout
    styleIdx

-- | Run an index-based picker over every value of a bounded enum. Indices
-- are offset by @fromEnum minBound@, so enums that do not start at 0 map
-- correctly. Meant for small enums: every value becomes an option.
withBoundedIndex ::
  forall a r f.
  (Bounded a, Enum a, Functor f) =>
  (a -> Text) -> a -> ([Text] -> Int -> f (r, Int)) -> f (r, a)
withBoundedIndex :: forall a r (f :: * -> *).
(Bounded a, Enum a, Functor f) =>
(a -> Text) -> a -> ([Text] -> Int -> f (r, Int)) -> f (r, a)
withBoundedIndex a -> Text
encode a
initial [Text] -> Int -> f (r, Int)
pick =
  (Int -> a) -> (r, Int) -> (r, a)
forall a b. (a -> b) -> (r, a) -> (r, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> (Int -> Int) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lower))
    ((r, Int) -> (r, a)) -> f (r, Int) -> f (r, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Int -> f (r, Int)
pick ((a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map a -> Text
encode [a
forall a. Bounded a => a
minBound .. a
forall a. Bounded a => a
maxBound]) (a -> Int
forall a. Enum a => a -> Int
fromEnum a
initial Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lower)
  where
    lower :: Int
lower = a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
minBound :: a)