{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}

module NanoUI.Widgets.Tree (TreeItem (..), tree, tree') where

import Control.Applicative ((<|>))
import Control.Monad (when)
import Data.IORef (writeIORef)
import Data.Foldable (fold, toList)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Primitive.SmallArray (SmallArray, indexSmallArray, mapSmallArray', sizeofSmallArray, smallArrayFromList)
import Effectful (Eff, type (:>))
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
import NanoUI.Context (Context (..), adoptStoreInt, getFocusId, getStore, intKey, recordStoreInt, registerFocusable, setStore, writeStoreInt, modifyStore)
import NanoUI.Font (treeChevronRect)
import NanoUI.Frame.Hit (scrollHitRect)
import NanoUI.Id (WidgetId (..), hashWidgetId)
import NanoUI.Input (inputMousePos)
import NanoUI.Layout.Arena (NodeType (..))
import NanoUI.Store (WidgetStore (..))
import NanoUI.Monad (Ui, askContext, askInput, nextId, uiIO, withKey)
import NanoUI.Style (defaultLayout, fillW, gap, tight)
import NanoUI.Types (Rect (..), clamp, rectContains)
import NanoUI.WidgetText (treeEncodeStyle)
import NanoUI.Widgets.Behavior (KeyNav (..), useKeyNav)
import NanoUI.Widgets.Combinators (selectableItem)
import NanoUI.Widgets.Layout (columnWith)
import NanoUI.Widgets.Node (Response (..), setChanged, tagContainer)

data TreeItem = TreeItem {TreeItem -> Text
treeItemLabel :: !Text, TreeItem -> [TreeItem]
treeItemChildren :: ![TreeItem]}
  deriving (TreeItem -> TreeItem -> Bool
(TreeItem -> TreeItem -> Bool)
-> (TreeItem -> TreeItem -> Bool) -> Eq TreeItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TreeItem -> TreeItem -> Bool
== :: TreeItem -> TreeItem -> Bool
$c/= :: TreeItem -> TreeItem -> Bool
/= :: TreeItem -> TreeItem -> Bool
Eq, Int -> TreeItem -> ShowS
[TreeItem] -> ShowS
TreeItem -> String
(Int -> TreeItem -> ShowS)
-> (TreeItem -> String) -> ([TreeItem] -> ShowS) -> Show TreeItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TreeItem -> ShowS
showsPrec :: Int -> TreeItem -> ShowS
$cshow :: TreeItem -> String
show :: TreeItem -> String
$cshowList :: [TreeItem] -> ShowS
showList :: [TreeItem] -> ShowS
Show)

-- | A visible row: pre-order node index, depth, whether it has children, label.
type TreeRow = (Int, Int, Bool, Text)

-- | Nodes in a subtree, its root included.
subtreeSize :: TreeItem -> Int
subtreeSize :: TreeItem -> Int
subtreeSize TreeItem
item = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [TreeItem] -> Int
forestSize (TreeItem -> [TreeItem]
treeItemChildren TreeItem
item)

forestSize :: [TreeItem] -> Int
forestSize :: [TreeItem] -> Int
forestSize = (Int -> TreeItem -> Int) -> Int -> [TreeItem] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
acc TreeItem
x -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ TreeItem -> Int
subtreeSize TreeItem
x) Int
0

-- | Visible rows in pre-order, skipping the children of collapsed nodes. One
-- pass: rows come out in order, and a subtree hands the next pre-order index
-- to the continuation that lists its later siblings.
visibleRows :: IS.IntSet -> [TreeItem] -> SmallArray TreeRow
visibleRows :: IntSet -> [TreeItem] -> SmallArray TreeRow
visibleRows IntSet
expanded [TreeItem]
items = [TreeRow] -> SmallArray TreeRow
forall a. [a] -> SmallArray a
smallArrayFromList (Int -> Int -> [TreeItem] -> (Int -> [TreeRow]) -> [TreeRow]
go Int
0 Int
0 [TreeItem]
items ([TreeRow] -> Int -> [TreeRow]
forall a b. a -> b -> a
const []))
  where
    go :: Int -> Int -> [TreeItem] -> (Int -> [TreeRow]) -> [TreeRow]
go !Int
idx !Int
_ [] Int -> [TreeRow]
k = Int -> [TreeRow]
k Int
idx
    go !Int
idx !Int
depth (item :: TreeItem
item@(TreeItem Text
lbl [TreeItem]
kids) : [TreeItem]
rest) Int -> [TreeRow]
k =
      let hasKids :: Bool
hasKids = Bool -> Bool
not ([TreeItem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TreeItem]
kids)
       in (Int
idx, Int
depth, Bool
hasKids, Text
lbl)
            TreeRow -> [TreeRow] -> [TreeRow]
forall a. a -> [a] -> [a]
: if Bool
hasKids Bool -> Bool -> Bool
&& Int -> IntSet -> Bool
IS.member Int
idx IntSet
expanded
              then Int -> Int -> [TreeItem] -> (Int -> [TreeRow]) -> [TreeRow]
go (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [TreeItem]
kids (\Int
next -> Int -> Int -> [TreeItem] -> (Int -> [TreeRow]) -> [TreeRow]
go Int
next Int
depth [TreeItem]
rest Int -> [TreeRow]
k)
              else Int -> Int -> [TreeItem] -> (Int -> [TreeRow]) -> [TreeRow]
go (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ TreeItem -> Int
subtreeSize TreeItem
item) Int
depth [TreeItem]
rest Int -> [TreeRow]
k

-- | Pre-order indices of every node that has children (the default expansion).
parentIndices :: [TreeItem] -> IS.IntSet
parentIndices :: [TreeItem] -> IntSet
parentIndices [TreeItem]
items = (Int, IntSet) -> IntSet
forall a b. (a, b) -> b
snd (Int -> [TreeItem] -> IntSet -> (Int, IntSet)
go Int
0 [TreeItem]
items IntSet
IS.empty)
  where
    go :: Int -> [TreeItem] -> IntSet -> (Int, IntSet)
go !Int
idx [] IntSet
acc = (Int
idx, IntSet
acc)
    go !Int
idx (TreeItem Text
_ [TreeItem]
kids : [TreeItem]
rest) IntSet
acc
      | [TreeItem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TreeItem]
kids = Int -> [TreeItem] -> IntSet -> (Int, IntSet)
go (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [TreeItem]
rest IntSet
acc
      | Bool
otherwise = case Int -> [TreeItem] -> IntSet -> (Int, IntSet)
go (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [TreeItem]
kids (Int -> IntSet -> IntSet
IS.insert Int
idx IntSet
acc) of
          (Int
next, IntSet
acc') -> Int -> [TreeItem] -> IntSet -> (Int, IntSet)
go Int
next [TreeItem]
rest IntSet
acc'

treeKeyNav ::
  KeyNav ->
  SmallArray TreeRow ->
  SmallArray Response ->
  WidgetId ->
  Int ->
  IS.IntSet ->
  (Int, IS.IntSet, Maybe WidgetId)
treeKeyNav :: KeyNav
-> SmallArray TreeRow
-> SmallArray Response
-> WidgetId
-> Int
-> IntSet
-> (Int, IntSet, Maybe WidgetId)
treeKeyNav KeyNav
nav SmallArray TreeRow
rows SmallArray Response
resps WidgetId
focus Int
selected IntSet
expanded
  | WidgetId -> Word64
hashWidgetId WidgetId
focus Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
moving = (Int
selected, IntSet
expanded, Maybe WidgetId
forall a. Maybe a
Nothing)
  | Bool
otherwise = case [Int
pos | Int
pos <- [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1], Int -> WidgetId
widAt Int
pos WidgetId -> WidgetId -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetId
focus] of
      Int
pos : [Int]
_ -> Int -> TreeRow -> (Int, IntSet, Maybe WidgetId)
step Int
pos (SmallArray TreeRow -> Int -> TreeRow
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray TreeRow
rows Int
pos)
      [] -> (Int
selected, IntSet
expanded, Maybe WidgetId
forall a. Maybe a
Nothing)
 where
  moving :: Bool
moving = KeyNav -> Bool
knUp KeyNav
nav Bool -> Bool -> Bool
|| KeyNav -> Bool
knDown KeyNav
nav Bool -> Bool -> Bool
|| KeyNav -> Bool
knLeft KeyNav
nav Bool -> Bool -> Bool
|| KeyNav -> Bool
knRight KeyNav
nav Bool -> Bool -> Bool
|| KeyNav -> Bool
knEnter KeyNav
nav Bool -> Bool -> Bool
|| KeyNav -> Bool
knSpace KeyNav
nav
  n :: Int
n = SmallArray TreeRow -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray TreeRow
rows
  widAt :: Int -> WidgetId
widAt Int
i = Response -> WidgetId
rawRespId (SmallArray Response -> Int -> Response
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Response
resps Int
i)
  idxAt :: Int -> Int
idxAt Int
i = let (Int
idx, Int
_, Bool
_, Text
_) = SmallArray TreeRow -> Int -> TreeRow
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray TreeRow
rows Int
i in Int
idx
  wantToggle :: Bool
wantToggle = KeyNav -> Bool
knEnter KeyNav
nav Bool -> Bool -> Bool
|| KeyNav -> Bool
knSpace KeyNav
nav
  parentPosition :: Int -> Int -> Maybe Int
parentPosition Int
pos Int
depth = Int -> Maybe Int
go (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    where
      go :: Int -> Maybe Int
go Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe Int
forall a. Maybe a
Nothing
        | Bool
otherwise =
            let (Int
_, Int
d, Bool
_, Text
_) = SmallArray TreeRow -> Int -> TreeRow
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray TreeRow
rows Int
i
             in if Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
depth then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i else Int -> Maybe Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  step :: Int -> TreeRow -> (Int, IntSet, Maybe WidgetId)
step Int
pos (Int
nodeIdx, Int
depth, Bool
hasKids, Text
_)
    | KeyNav -> Bool
knDown KeyNav
nav, Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = let p :: Int
p = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 in (Int -> Int
idxAt Int
p, IntSet
expanded, WidgetId -> Maybe WidgetId
forall a. a -> Maybe a
Just (Int -> WidgetId
widAt Int
p))
    | KeyNav -> Bool
knUp KeyNav
nav, Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = let p :: Int
p = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 in (Int -> Int
idxAt Int
p, IntSet
expanded, WidgetId -> Maybe WidgetId
forall a. a -> Maybe a
Just (Int -> WidgetId
widAt Int
p))
    | Bool
wantToggle, Bool
hasKids = (Int
selected, Int -> IntSet -> IntSet
toggle Int
nodeIdx IntSet
expanded, Maybe WidgetId
forall a. Maybe a
Nothing)
    | KeyNav -> Bool
knRight KeyNav
nav, Bool
hasKids, Bool -> Bool
not (Int -> IntSet -> Bool
IS.member Int
nodeIdx IntSet
expanded) = (Int
selected, Int -> IntSet -> IntSet
IS.insert Int
nodeIdx IntSet
expanded, Maybe WidgetId
forall a. Maybe a
Nothing)
    | KeyNav -> Bool
knLeft KeyNav
nav, Bool
hasKids, Int -> IntSet -> Bool
IS.member Int
nodeIdx IntSet
expanded = (Int
selected, Int -> IntSet -> IntSet
IS.delete Int
nodeIdx IntSet
expanded, Maybe WidgetId
forall a. Maybe a
Nothing)
    | KeyNav -> Bool
knLeft KeyNav
nav, Int
depth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
        case Int -> Int -> Maybe Int
parentPosition Int
pos Int
depth of
          Just Int
p -> (Int -> Int
idxAt Int
p, IntSet
expanded, WidgetId -> Maybe WidgetId
forall a. a -> Maybe a
Just (Int -> WidgetId
widAt Int
p))
          Maybe Int
Nothing -> (Int
nodeIdx, IntSet
expanded, Maybe WidgetId
forall a. Maybe a
Nothing)
    | Bool
otherwise = (Int
selected, IntSet
expanded, Maybe WidgetId
forall a. Maybe a
Nothing)

toggle :: Int -> IS.IntSet -> IS.IntSet
toggle :: Int -> IntSet -> IntSet
toggle Int
idx IntSet
s = if Int -> IntSet -> Bool
IS.member Int
idx IntSet
s then Int -> IntSet -> IntSet
IS.delete Int
idx IntSet
s else Int -> IntSet -> IntSet
IS.insert Int
idx IntSet
s

treeRow :: (Ui :> es) => Int -> TreeRow -> Int -> IS.IntSet -> Eff es (Response, Maybe Int, Maybe IS.IntSet)
treeRow :: forall (es :: [Effect]).
(Ui :> es) =>
Int
-> TreeRow
-> Int
-> IntSet
-> Eff es (Response, Maybe Int, Maybe IntSet)
treeRow Int
rowIdx (Int
nodeIdx, Int
depth, Bool
hasKids, Text
lbl) Int
selectedIdx IntSet
expandedSet = do
  ctx <- Eff es Context
forall (es :: [Effect]). (Ui :> es) => Eff es Context
askContext
  inp <- askInput
  let expanded = Int -> IntSet -> Bool
IS.member Int
nodeIdx IntSet
expandedSet
      selected = Int
selectedIdx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nodeIdx
      isOdd = Int -> Bool
forall a. Integral a => a -> Bool
odd Int
rowIdx
  resp <- selectableItem NodeTree lbl selected (tight . fillW $ defaultLayout) (treeEncodeStyle nodeIdx depth hasKids expanded isOdd)
  uiIO $ registerFocusable ctx (rawRespId resp)
  if not (rawRespClicked resp)
    then pure (resp, Nothing, Nothing)
    else uiIO $ do
      mrect <- scrollHitRect ctx (rawRespId resp)
      let mouse = Input -> V2
inputMousePos Input
inp
          onChevron = case Maybe Rect
mrect of
            Just rect :: Rect
rect@(Rect Float
x Float
y Float
w Float
h) ->
              Rect -> V2 -> Bool
rectContains (FontMetrics -> Float -> Float -> Float -> Float -> Int -> Rect
treeChevronRect (Context -> FontMetrics
ctxFontMetrics Context
ctx) Float
x Float
y Float
w Float
h Int
depth) V2
mouse
                Bool -> Bool -> Bool
&& Rect -> V2 -> Bool
rectContains Rect
rect V2
mouse
            Maybe Rect
_ -> Bool
False
      if hasKids && onChevron
        then pure (setChanged False resp, Nothing, Just (toggle nodeIdx expandedSet))
        else pure (setChanged (not selected) resp, Just nodeIdx, Nothing)

-- | Collapsible tree. Rows are numbered in pre-order; pass the selected row
-- and the result is the selection after this frame's click or arrow keys.
-- Expansion is kept by the widget. @key@ distinguishes trees in one scope.
{-# INLINE tree #-}
tree :: (Foldable f, Ui :> es) => Text -> f TreeItem -> Int -> Eff es Int
tree :: forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
Text -> f TreeItem -> Int -> Eff es Int
tree Text
key f TreeItem
items 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
<$> Text -> f TreeItem -> Int -> Eff es (Response, Int)
forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
Text -> f TreeItem -> Int -> Eff es (Response, Int)
tree' Text
key f TreeItem
items Int
index

tree' :: (Foldable f, Ui :> es) => Text -> f TreeItem -> Int -> Eff es (Response, Int)
tree' :: forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
Text -> f TreeItem -> Int -> Eff es (Response, Int)
tree' Text
key f TreeItem
inputItems Int
index =
  Text -> 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 (Text
"tree:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key) (Eff es (Response, Int) -> Eff es (Response, Int))
-> Eff es (Response, Int) -> Eff es (Response, Int)
forall a b. (a -> b) -> a -> b
$ do
    groupId <- Eff es WidgetId
forall (es :: [Effect]). (Ui :> es) => Eff es WidgetId
nextId
    ctx <- askContext
    let items = f TreeItem -> [TreeItem]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f TreeItem
inputItems
        groupKey = WidgetId -> Int
intKey WidgetId
groupId
        total = [TreeItem] -> Int
forestSize [TreeItem]
items
        clamped = if Int
total Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then Int
0 else Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
index
    selected <- uiIO $ adoptStoreInt ctx groupId groupKey clamped
    st <- uiIO (getStore ctx)
    expandedSet <- case IM.lookup groupKey (storeIntSet st) of
      Just IntSet
expanded -> IntSet -> Eff es IntSet
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IntSet
expanded
      Maybe IntSet
Nothing -> do
        let initial :: IntSet
initial = [TreeItem] -> IntSet
parentIndices [TreeItem]
items
        IO () -> Eff es ()
forall (es :: [Effect]) a. (Ui :> es) => IO a -> Eff es a
uiIO (IO () -> Eff es ()) -> IO () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ Context -> WidgetStore -> IO ()
setStore Context
ctx (WidgetStore
st {storeIntSet = IM.insert groupKey initial (storeIntSet st)})
        IntSet -> Eff es IntSet
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IntSet
initial
    let rows = IntSet -> [TreeItem] -> SmallArray TreeRow
visibleRows IntSet
expandedSet [TreeItem]
items
    columnWith (tight . gap 0 . fillW) $ do
      tagContainer groupId
      results <-
        smallArrayFromList
          <$> sequence [withKey i (treeRow rowIdx row selected expandedSet) | rowIdx <- [0 .. sizeofSmallArray rows - 1], let row@(i, _, _, _) = indexSmallArray rows rowIdx]
      let resps = ((Response, Maybe Int, Maybe IntSet) -> Response)
-> SmallArray (Response, Maybe Int, Maybe IntSet)
-> SmallArray Response
forall a b. (a -> b) -> SmallArray a -> SmallArray b
mapSmallArray' (\(Response
r, Maybe Int
_, Maybe IntSet
_) -> Response
r) SmallArray (Response, Maybe Int, Maybe IntSet)
results
          afterClickSel = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
selected (((Response, Maybe Int, Maybe IntSet) -> Maybe Int -> Maybe Int)
-> Maybe Int
-> SmallArray (Response, Maybe Int, Maybe IntSet)
-> Maybe Int
forall a b. (a -> b -> b) -> b -> SmallArray a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Response
_, Maybe Int
idx, Maybe IntSet
_) Maybe Int
rest -> Maybe Int
idx Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
rest) Maybe Int
forall a. Maybe a
Nothing SmallArray (Response, Maybe Int, Maybe IntSet)
results)
          afterClickExp = IntSet -> Maybe IntSet -> IntSet
forall a. a -> Maybe a -> a
fromMaybe IntSet
expandedSet (((Response, Maybe Int, Maybe IntSet)
 -> Maybe IntSet -> Maybe IntSet)
-> Maybe IntSet
-> SmallArray (Response, Maybe Int, Maybe IntSet)
-> Maybe IntSet
forall a b. (a -> b -> b) -> b -> SmallArray a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Response
_, Maybe Int
_, Maybe IntSet
s) Maybe IntSet
rest -> Maybe IntSet
s Maybe IntSet -> Maybe IntSet -> Maybe IntSet
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe IntSet
rest) Maybe IntSet
forall a. Maybe a
Nothing SmallArray (Response, Maybe Int, Maybe IntSet)
results)
      focus <- uiIO (getFocusId ctx)
      nav <- useKeyNav focus
      let (keySel, keyExp, mFocus) = treeKeyNav nav rows resps focus afterClickSel afterClickExp
      uiIO $ do
        writeStoreInt ctx groupId groupKey keySel
        recordStoreInt ctx groupKey keySel
      when (keyExp /= expandedSet) $ uiIO $
        modifyStore ctx (\WidgetStore
st' -> WidgetStore
st' {storeIntSet = IM.insert groupKey keyExp (storeIntSet st')})
      maybe (pure ()) (\WidgetId
wid -> IO () -> Eff es ()
forall (es :: [Effect]) a. (Ui :> es) => IO a -> Eff es a
uiIO (IO () -> Eff es ()) -> IO () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ IORef WidgetId -> WidgetId -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Context -> IORef WidgetId
ctxFocusId Context
ctx) WidgetId
wid) mFocus
      pure (setChanged (keySel /= selected) (fold resps), keySel)