{-# LANGUAGE OverloadedStrings #-}

module NanoUI.Widgets.Radio
  ( radio
  , radio'
  , boundedRadio
  , boundedRadio'
  , enumRadio
  , enumRadio'
  )
where

import Control.Monad (foldM)
import Data.Foldable (toList)
import Data.Hashable (hash)
import Data.Text (Text)
import Data.Text qualified as T
import Effectful (Eff, type (:>))
import NanoUI.Context (adoptStoreInt, intKey, recordStoreInt, registerFocusable, writeStoreInt)
import NanoUI.Layout.Arena (NodeType (..))
import NanoUI.Monad (Ui, askContext, nextId, uiIO, withKey)
import NanoUI.Style (Layout, defaultLayout, fillW, gap, tight)
import NanoUI.Types (clamp)
import NanoUI.Widgets.Behavior (KeyNav (..), useKeyNav)
import NanoUI.Widgets.Combinators (selectableItem, withBoundedIndex)
import NanoUI.Widgets.Layout (column')
import NanoUI.Widgets.Node
  ( Response (..)
  , setChanged
  , tagContainer
  )

radioLay :: Layout
radioLay :: Layout
radioLay = Layout -> Layout
tight (Layout -> Layout
fillW Layout
defaultLayout)

radioGroupLay :: Layout
radioGroupLay :: Layout
radioGroupLay = Layout -> Layout
tight (Float -> Layout -> Layout
gap Float
4 (Layout -> Layout
fillW Layout
defaultLayout))

radioSalt :: Int
radioSalt :: Int
radioSalt = Text -> Int
forall a. Hashable a => a -> Int
hash (Text
"radio" :: Text)

-- | A column of radio buttons over @options@ in fold order. Pass the selected
-- index; the result is the index after this frame's click or arrow keys.
{-# INLINE radio #-}
radio :: (Foldable f, Ui :> es) => f Text -> Int -> Eff es Int
radio :: forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
f Text -> Int -> Eff es Int
radio f Text
options Int
index = (Response, Int) -> Int
forall a b. (a, b) -> b
snd ((Response, Int) -> Int) -> Eff es (Response, Int) -> Eff es Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Text -> Int -> Eff es (Response, Int)
forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
f Text -> Int -> Eff es (Response, Int)
radio' f Text
options Int
index

radio' ::
  (Foldable f, Ui :> es) => f Text -> Int -> Eff es (Response, Int)
radio' :: forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
f Text -> Int -> Eff es (Response, Int)
radio' f Text
options Int
index =
  Int -> Eff es (Response, Int) -> Eff es (Response, Int)
forall k (es :: [Effect]) a.
(Hashable k, Ui :> es) =>
k -> Eff es a -> Eff es a
withKey Int
radioSalt (Eff es (Response, Int) -> Eff es (Response, Int))
-> Eff es (Response, Int) -> Eff es (Response, Int)
forall a b. (a -> b) -> a -> b
$ do
    gid <- Eff es WidgetId
forall (es :: [Effect]). (Ui :> es) => Eff es WidgetId
nextId
    ctx <- askContext
    let
      opts = case f Text -> [Text]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f Text
options of
        [] -> [Text
""]
        [Text]
xs -> [Text]
xs
      !len = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
opts
      !key = WidgetId -> Int
intKey WidgetId
gid
    stored <- uiIO $ adoptStoreInt ctx gid key (clamp 0 (len - 1) index)
    let !sel = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
stored
    uiIO $ registerFocusable ctx gid
    nav <- useKeyNav gid
    let
      !navDelta =
        (if KeyNav -> Bool
knDown KeyNav
nav Bool -> Bool -> Bool
|| KeyNav -> Bool
knRight KeyNav
nav then Int
1 else Int
0 :: Int)
          Int -> Int -> Int
forall a. Num a => a -> a -> a
- (if KeyNav -> Bool
knUp KeyNav
nav Bool -> Bool -> Bool
|| KeyNav -> Bool
knLeft KeyNav
nav then Int
1 else Int
0)
      !selNav = if Int
navDelta Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
sel else Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
sel Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
navDelta)
    column' radioGroupLay $ do
      tagContainer gid
      (combinedResp, clickedIdx) <- addRadioOptions selNav opts
      let !finalSel = if Int
clickedIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then Int
clickedIdx else Int
selNav
      uiIO $ do
        writeStoreInt ctx gid key finalSel
        recordStoreInt ctx key finalSel
      -- Compare with the caller's index, as 'NanoUI.Widgets.Select' does, so a
      -- selection stored between frames still reports a change.
      pure (setChanged (finalSel /= clamp 0 (len - 1) index) combinedResp, finalSel)

-- Use the ordinary widget path for every option, including singleton groups.
-- It owns IDs, node construction, and scroll-aware interaction geometry.
addRadioOptions :: Ui :> es => Int -> [Text] -> Eff es (Response, Int)
addRadioOptions :: forall (es :: [Effect]).
(Ui :> es) =>
Int -> [Text] -> Eff es (Response, Int)
addRadioOptions Int
sel [Text]
opts = ((Response, Int) -> (Int, Text) -> Eff es (Response, Int))
-> (Response, Int) -> [(Int, Text)] -> Eff es (Response, Int)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Response, Int) -> (Int, Text) -> Eff es (Response, Int)
addOption (Response
forall a. Monoid a => a
mempty, -Int
1) ([Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [Text]
opts)
 where
  addOption :: (Response, Int) -> (Int, Text) -> Eff es (Response, Int)
addOption (!Response
acc, !Int
clickedIdx) (Int
i, Text
txt) = do
    r <- NodeType -> Text -> Bool -> Layout -> Int -> Eff es Response
forall (es :: [Effect]).
(Ui :> es) =>
NodeType -> Text -> Bool -> Layout -> Int -> Eff es Response
selectableItem NodeType
NodeRadio Text
txt (Int
sel Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i) Layout
radioLay Int
i
    let
      clickedIdx' = if Response -> Bool
rawRespClicked Response
r Bool -> Bool -> Bool
&& Int
clickedIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
i else Int
clickedIdx
    pure (acc <> r, clickedIdx')

-- | Radio buttons for every value of a bounded enum, labelled by @encode@.
{-# INLINE boundedRadio #-}
boundedRadio :: (Bounded a, Enum a, Ui :> es) => (a -> Text) -> a -> Eff es a
boundedRadio :: forall a (es :: [Effect]).
(Bounded a, Enum a, Ui :> es) =>
(a -> Text) -> a -> Eff es a
boundedRadio a -> Text
encode a
value = (Response, a) -> a
forall a b. (a, b) -> b
snd ((Response, a) -> a) -> Eff es (Response, a) -> Eff es a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Text) -> a -> Eff es (Response, a)
forall a (es :: [Effect]).
(Bounded a, Enum a, Ui :> es) =>
(a -> Text) -> a -> Eff es (Response, a)
boundedRadio' a -> Text
encode a
value

boundedRadio' :: (Bounded a, Enum a, Ui :> es) => (a -> Text) -> a -> Eff es (Response, a)
boundedRadio' :: forall a (es :: [Effect]).
(Bounded a, Enum a, Ui :> es) =>
(a -> Text) -> a -> Eff es (Response, a)
boundedRadio' a -> Text
encode a
value = (a -> Text)
-> a
-> ([Text] -> Int -> Eff es (Response, Int))
-> Eff es (Response, a)
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
value [Text] -> Int -> Eff es (Response, Int)
forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
f Text -> Int -> Eff es (Response, Int)
radio'

-- | 'boundedRadio' labelled with 'show'.
{-# INLINE enumRadio #-}
enumRadio :: (Bounded a, Enum a, Show a, Ui :> es) => a -> Eff es a
enumRadio :: forall a (es :: [Effect]).
(Bounded a, Enum a, Show a, Ui :> es) =>
a -> Eff es a
enumRadio = (a -> Text) -> a -> Eff es a
forall a (es :: [Effect]).
(Bounded a, Enum a, Ui :> es) =>
(a -> Text) -> a -> Eff es a
boundedRadio (String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show)

enumRadio' :: (Bounded a, Enum a, Show a, Ui :> es) => a -> Eff es (Response, a)
enumRadio' :: forall a (es :: [Effect]).
(Bounded a, Enum a, Show a, Ui :> es) =>
a -> Eff es (Response, a)
enumRadio' = (a -> Text) -> a -> Eff es (Response, a)
forall a (es :: [Effect]).
(Bounded a, Enum a, Ui :> es) =>
(a -> Text) -> a -> Eff es (Response, a)
boundedRadio' (String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show)