-- | Local state hooks. The store representation varies by value type, but
-- identity, equality checks, and invalidation follow one policy.
module NanoUI.Hooks
  ( useState
  , useFlag
  , useInt
  , useFloat
  , useEnum
  , useText
  , useToggle
  )
where

import Control.Monad (when)
import Data.Dynamic (fromDynamic, toDyn)
import Data.IntMap.Strict qualified as IM
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Typeable (Typeable)
import Effectful (Eff, type (:>))
import NanoUI.Context (getStore, intKey, setStore)
import NanoUI.Monad (Ui, askContext, nextId, uiIO)
import NanoUI.Store (WidgetStore (..), boolInt, bumpMirror, intBool)

useState :: (Typeable a, Eq a, Ui :> es) => a -> Eff es (a, a -> Eff es ())
useState :: forall a (es :: [Effect]).
(Typeable a, Eq a, Ui :> es) =>
a -> Eff es (a, a -> Eff es ())
useState =
  (Int -> WidgetStore -> Maybe a)
-> (Int -> a -> WidgetStore -> WidgetStore)
-> a
-> Eff es (a, a -> Eff es ())
forall a (es :: [Effect]).
(Eq a, Ui :> es) =>
(Int -> WidgetStore -> Maybe a)
-> (Int -> a -> WidgetStore -> WidgetStore)
-> a
-> Eff es (a, a -> Eff es ())
useStored
    (\Int
key WidgetStore
store -> Int -> IntMap Dynamic -> Maybe Dynamic
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
key (WidgetStore -> IntMap Dynamic
storeDyn WidgetStore
store) Maybe Dynamic -> (Dynamic -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Dynamic -> Maybe a
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic)
    ( \Int
key a
value WidgetStore
store -> WidgetStore
store {storeDyn = IM.insert key (toDyn value) (storeDyn store)}
    )

useStored ::
  (Eq a, Ui :> es) =>
  (Int -> WidgetStore -> Maybe a)
  -> (Int -> a -> WidgetStore -> WidgetStore)
  -> a
  -> Eff es (a, a -> Eff es ())
useStored :: forall a (es :: [Effect]).
(Eq a, Ui :> es) =>
(Int -> WidgetStore -> Maybe a)
-> (Int -> a -> WidgetStore -> WidgetStore)
-> a
-> Eff es (a, a -> Eff es ())
useStored Int -> WidgetStore -> Maybe a
lookupValue Int -> a -> WidgetStore -> WidgetStore
update a
initial = do
  wid <- Eff es WidgetId
forall (es :: [Effect]). (Ui :> es) => Eff es WidgetId
nextId
  ctx <- askContext
  let
    key = WidgetId -> Int
intKey WidgetId
wid
    valueIn = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
initial (Maybe a -> a) -> (WidgetStore -> Maybe a) -> WidgetStore -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> WidgetStore -> Maybe a
lookupValue Int
key
    setValue a
value = 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
$ do
      -- A setter can run more than once in a frame. Compare with the latest
      -- store, not the value captured when the hook was evaluated.
      store <- Context -> IO WidgetStore
getStore Context
ctx
      when (valueIn store /= value) $
        setStore ctx (bumpMirror (update key value store))
  value <- valueIn <$> uiIO (getStore ctx)
  pure (value, setValue)

useFlag :: Ui :> es => Bool -> Eff es (Bool, Bool -> Eff es ())
useFlag :: forall (es :: [Effect]).
(Ui :> es) =>
Bool -> Eff es (Bool, Bool -> Eff es ())
useFlag Bool
initial = do
  (value, setValue) <- Int -> Eff es (Int, Int -> Eff es ())
forall (es :: [Effect]).
(Ui :> es) =>
Int -> Eff es (Int, Int -> Eff es ())
useInt (Bool -> Int
boolInt Bool
initial)
  pure (intBool value, setValue . boolInt)

useInt :: Ui :> es => Int -> Eff es (Int, Int -> Eff es ())
useInt :: forall (es :: [Effect]).
(Ui :> es) =>
Int -> Eff es (Int, Int -> Eff es ())
useInt =
  (Int -> WidgetStore -> Maybe Int)
-> (Int -> Int -> WidgetStore -> WidgetStore)
-> Int
-> Eff es (Int, Int -> Eff es ())
forall a (es :: [Effect]).
(Eq a, Ui :> es) =>
(Int -> WidgetStore -> Maybe a)
-> (Int -> a -> WidgetStore -> WidgetStore)
-> a
-> Eff es (a, a -> Eff es ())
useStored
    (\Int
key -> Int -> IntMap Int -> Maybe Int
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
key (IntMap Int -> Maybe Int)
-> (WidgetStore -> IntMap Int) -> WidgetStore -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetStore -> IntMap Int
storeInt)
    (\Int
key Int
value WidgetStore
store -> WidgetStore
store {storeInt = IM.insert key value (storeInt store)})

useFloat :: Ui :> es => Float -> Eff es (Float, Float -> Eff es ())
useFloat :: forall (es :: [Effect]).
(Ui :> es) =>
Float -> Eff es (Float, Float -> Eff es ())
useFloat =
  (Int -> WidgetStore -> Maybe Float)
-> (Int -> Float -> WidgetStore -> WidgetStore)
-> Float
-> Eff es (Float, Float -> Eff es ())
forall a (es :: [Effect]).
(Eq a, Ui :> es) =>
(Int -> WidgetStore -> Maybe a)
-> (Int -> a -> WidgetStore -> WidgetStore)
-> a
-> Eff es (a, a -> Eff es ())
useStored
    (\Int
key -> Int -> IntMap Float -> Maybe Float
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
key (IntMap Float -> Maybe Float)
-> (WidgetStore -> IntMap Float) -> WidgetStore -> Maybe Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetStore -> IntMap Float
storeFloat)
    (\Int
key Float
value WidgetStore
store -> WidgetStore
store {storeFloat = IM.insert key value (storeFloat store)})

useEnum :: (Enum a, Ui :> es) => a -> Eff es (a, a -> Eff es ())
useEnum :: forall a (es :: [Effect]).
(Enum a, Ui :> es) =>
a -> Eff es (a, a -> Eff es ())
useEnum a
initial = do
  (index, setIndex) <- Int -> Eff es (Int, Int -> Eff es ())
forall (es :: [Effect]).
(Ui :> es) =>
Int -> Eff es (Int, Int -> Eff es ())
useInt (a -> Int
forall a. Enum a => a -> Int
fromEnum a
initial)
  pure (toEnum index, setIndex . fromEnum)

useText :: Ui :> es => Text -> Eff es (Text, Text -> Eff es ())
useText :: forall (es :: [Effect]).
(Ui :> es) =>
Text -> Eff es (Text, Text -> Eff es ())
useText =
  (Int -> WidgetStore -> Maybe Text)
-> (Int -> Text -> WidgetStore -> WidgetStore)
-> Text
-> Eff es (Text, Text -> Eff es ())
forall a (es :: [Effect]).
(Eq a, Ui :> es) =>
(Int -> WidgetStore -> Maybe a)
-> (Int -> a -> WidgetStore -> WidgetStore)
-> a
-> Eff es (a, a -> Eff es ())
useStored
    (\Int
key -> Int -> IntMap Text -> Maybe Text
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
key (IntMap Text -> Maybe Text)
-> (WidgetStore -> IntMap Text) -> WidgetStore -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetStore -> IntMap Text
storeText)
    (\Int
key Text
value WidgetStore
store -> WidgetStore
store {storeText = IM.insert key value (storeText store)})

useToggle :: Ui :> es => Bool -> Eff es (Bool, Eff es ())
useToggle :: forall (es :: [Effect]).
(Ui :> es) =>
Bool -> Eff es (Bool, Eff es ())
useToggle Bool
initial = do
  (value, setValue) <- Bool -> Eff es (Bool, Bool -> Eff es ())
forall (es :: [Effect]).
(Ui :> es) =>
Bool -> Eff es (Bool, Bool -> Eff es ())
useFlag Bool
initial
  pure (value, setValue (not value))