-- | Single-line text fields: editable inputs, debounced search fields, and
-- selectable read-only labels, plus the key handling they share.
module NanoUI.Widgets.TextInput
  ( TextInputState (..)
  , loadTextInputState
  , saveTextInputState
  , textInputLayout
  , searchFieldLayout
  , textInputEditor
  , editorTextState
  , saveTextEditor
  , editTextInput
  , textInputMode
  , applyTextInputCommand
    -- * Text fields
  , TextInputConfig (..)
  , defaultTextInputConfig
  , textInput
  , textInput'
  , textInputConfigured
  , textInputConfigured'
  , SearchFieldConfig (..)
  , defaultSearchFieldConfig
  , searchField
  , searchField'
  , searchFieldConfigured
  , searchFieldConfigured'
  , buildTextInput
  , editTextField
    -- * Selectable text
  , selectableText
  , selectableText'
  , selectableTextWith
  , selectableTextWith'
  )
where

import Control.Monad (foldM, void, when)
import Data.Bits ((.|.))
import Data.IntMap.Strict qualified as IM
import Data.Dynamic (fromDynamic, toDyn)
import Data.Maybe (fromMaybe, isNothing)
import Data.Text (Text)
import Data.Text qualified as T
import Effectful (Eff, type (:>))
import GHC.Clock (getMonotonicTime)
import NanoUI.Context
  ( Context (..)
  , adoptStoreText
  , getStore
  , intKey
  , markDirty
  , recordStoreText
  , registerFocusable
  , setStore
  , modifyStore
  )
import NanoUI.Id (WidgetId)
import NanoUI.Input
  ( Input (..)
  , Key (..)
  , inputKeys
  )
import NanoUI.Layout.Arena (NodeType (..))
import NanoUI.Monad (Ui, askContext, askDefaultLayout, askInput, nextId, uiIO)
import NanoUI.Store (WidgetStore (..), Slot (..), slotKey)
import NanoUI.Style (Layout (..), Sizing (..), defaultLayout)
import NanoUI.WidgetText (packTextNodeStyleFull, textInputFlagPassword, textInputFlagSearch, textInputFlagSelectable, textInputPasswordMode, textInputSelectableMode)
import NanoUI.Widgets.Behavior (keyboardFocused)
import NanoUI.Widgets.Node (Response (..), addWidgetStyled, setChanged, setSubmitted)
import NanoUI.Widgets.TextBuffer qualified as TB
import NanoUI.Widgets.TextEditor
  ( Editor (..)
  , EditorMode (..)
  , TextCommand (..)
  , inputTextCommands
  , editorModeCode
  , emptyHistory
  , runCommandIO
  , sealHistory
  , singleLineMode
  )

textInputLayout :: Layout
textInputLayout :: Layout
textInputLayout =
  Layout
defaultLayout
    { layoutWidth = Grow 1
    , layoutMinW = 160
    }

-- | Layout for a caption-less search field. Grows to fill, keeps a little more
-- room for the embedded magnifier / clear chrome than a plain text input.
searchFieldLayout :: Layout
searchFieldLayout :: Layout
searchFieldLayout =
  Layout
defaultLayout
    { layoutWidth = Grow 1
    , layoutMinW = 180
    }

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

-- | A field's cursor and anchor for @text@; the cursor defaults to the end
-- and the anchor to the cursor. Both are clamped to the text, which can have
-- been replaced from outside the field with a shorter one.
loadTextInputState :: WidgetStore -> Int -> Text -> TextInputState
loadTextInputState :: WidgetStore -> Int -> Text -> TextInputState
loadTextInputState WidgetStore
store Int
key Text
text =
  let len :: Int
len = Text -> Int
T.length Text
text
      cursor :: Int
cursor = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
len (Int -> Int -> IntMap Int -> Int
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Int
len (Slot -> Int -> Int
slotKey Slot
SlotCursor Int
key) (WidgetStore -> IntMap Int
storeInt WidgetStore
store))
      anchor :: Int
anchor = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
len (Int -> Int -> IntMap Int -> Int
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Int
cursor (Slot -> Int -> Int
slotKey Slot
SlotAnchor Int
key) (WidgetStore -> IntMap Int
storeInt WidgetStore
store))
   in Text -> Int -> Int -> TextInputState
TextInputState Text
text Int
cursor Int
anchor

saveTextInputState :: Int -> TextInputState -> WidgetStore -> WidgetStore
saveTextInputState :: Int -> TextInputState -> WidgetStore -> WidgetStore
saveTextInputState Int
key TextInputState
s WidgetStore
store =
  WidgetStore
store
    { storeText = IM.insert key (tisText s) (storeText store)
    , storeInt =
        IM.insert (slotKey SlotCursor key) (tisCursor s) $
          IM.insert (slotKey SlotAnchor key) (tisAnchor s) (storeInt store)
    }

-- | The editor for a field's state, with the undo history stored for it. A
-- history recorded against other text (the caller replaced the value) is
-- dropped.
textInputEditor :: WidgetStore -> Int -> TextInputState -> Editor
textInputEditor :: WidgetStore -> Int -> TextInputState -> Editor
textInputEditor WidgetStore
store Int
key TextInputState
s =
  let buf :: TextBuffer
buf = Cursor -> TextBuffer -> TextBuffer
TB.withCursor (Int -> Int -> Cursor
TB.Cursor Int
0 (TextInputState -> Int
tisCursor TextInputState
s)) (Text -> TextBuffer
TB.fromText (TextInputState -> Text
tisText TextInputState
s))
      history :: EditHistory
history = case Int -> IntMap Dynamic -> Maybe Dynamic
forall a. Int -> IntMap a -> Maybe a
IM.lookup (Slot -> Int -> Int
slotKey Slot
SlotTextHistory Int
key) (WidgetStore -> IntMap Dynamic
storeDyn WidgetStore
store) Maybe Dynamic
-> (Dynamic -> Maybe (Text, EditHistory))
-> Maybe (Text, EditHistory)
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 (Text, EditHistory)
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic of
        Just (Text
text, EditHistory
h) | Text
text Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== TextInputState -> Text
tisText TextInputState
s -> EditHistory
h
        Maybe (Text, EditHistory)
_ -> EditHistory
emptyHistory
   in TextBuffer -> Cursor -> EditHistory -> Editor
Editor TextBuffer
buf (TextBuffer -> Cursor -> Cursor
TB.clampCursor TextBuffer
buf (Int -> Int -> Cursor
TB.Cursor Int
0 (TextInputState -> Int
tisAnchor TextInputState
s))) EditHistory
history

editorTextState :: Editor -> TextInputState
editorTextState :: Editor -> TextInputState
editorTextState Editor
ed =
  let buf :: TextBuffer
buf = Editor -> TextBuffer
editorBuffer Editor
ed
   in Text -> Int -> Int -> TextInputState
TextInputState (TextBuffer -> Text
TB.toText TextBuffer
buf) (Cursor -> Int
TB.cursorCol (TextBuffer -> Cursor
TB.getCursor TextBuffer
buf)) (Cursor -> Int
TB.cursorCol (Editor -> Cursor
editorAnchor Editor
ed))

-- | Store an editor's text, selection and history.
saveTextEditor :: Int -> Editor -> WidgetStore -> WidgetStore
saveTextEditor :: Int -> Editor -> WidgetStore -> WidgetStore
saveTextEditor Int
key Editor
ed WidgetStore
store =
  let s :: TextInputState
s = Editor -> TextInputState
editorTextState Editor
ed
      saved :: WidgetStore
saved = Int -> TextInputState -> WidgetStore -> WidgetStore
saveTextInputState Int
key TextInputState
s WidgetStore
store
   in WidgetStore
saved {storeDyn = IM.insert (slotKey SlotTextHistory key) (toDyn (tisText s, editorHistory ed)) (storeDyn saved)}

-- | Run this frame's commands on a field, or 'Nothing' when it had none.
editTextInput :: Context -> EditorMode -> Input -> WidgetStore -> Int -> TextInputState -> IO (Maybe Editor)
editTextInput :: Context
-> EditorMode
-> Input
-> WidgetStore
-> Int
-> TextInputState
-> IO (Maybe Editor)
editTextInput Context
ctx EditorMode
mode Input
inp WidgetStore
store Int
key TextInputState
s0 =
  case EditorMode -> Input -> [TextCommand]
inputTextCommands EditorMode
mode Input
inp of
    [] -> Maybe Editor -> IO (Maybe Editor)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Editor
forall a. Maybe a
Nothing
    [TextCommand]
cmds -> Editor -> Maybe Editor
forall a. a -> Maybe a
Just (Editor -> Maybe Editor) -> IO Editor -> IO (Maybe Editor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Editor -> TextCommand -> IO Editor)
-> Editor -> [TextCommand] -> IO Editor
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ((TextCommand -> Editor -> IO Editor)
-> Editor -> TextCommand -> IO Editor
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Context -> EditorMode -> TextCommand -> Editor -> IO Editor
runCommandIO Context
ctx EditorMode
mode)) (WidgetStore -> Int -> TextInputState -> Editor
textInputEditor WidgetStore
store Int
key TextInputState
s0) [TextCommand]
cmds

-- | The editor mode of a single-line field with these style flags.
textInputMode :: Int -> EditorMode
textInputMode :: Int -> EditorMode
textInputMode Int
si =
  EditorMode
singleLineMode
    { modeEditable = not (textInputSelectableMode si)
    , modeCopyable = not (textInputPasswordMode si)
    }

-- | Run a command on a single-line field outside its frame (a context menu
-- row, an app's Edit menu). A change to the text pulses 'respChanged' on the
-- field's next frame.
applyTextInputCommand :: Context -> WidgetId -> EditorMode -> TextCommand -> IO ()
applyTextInputCommand :: Context -> WidgetId -> EditorMode -> TextCommand -> IO ()
applyTextInputCommand Context
ctx WidgetId
wid EditorMode
mode TextCommand
cmd = do
  store <- Context -> IO WidgetStore
getStore Context
ctx
  let
    key = WidgetId -> Int
intKey WidgetId
wid
    s0 = WidgetStore -> Int -> Text -> TextInputState
loadTextInputState WidgetStore
store Int
key (Text -> Int -> IntMap Text -> Text
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Text
"" Int
key (WidgetStore -> IntMap Text
storeText WidgetStore
store))
  let ed0 = WidgetStore -> Int -> TextInputState -> Editor
textInputEditor WidgetStore
store Int
key TextInputState
s0
  ed <- runCommandIO ctx mode cmd ed0 {editorHistory = sealHistory (editorHistory ed0)}
  let s1 = Editor -> TextInputState
editorTextState Editor
ed
      saved = Int -> Editor -> WidgetStore -> WidgetStore
saveTextEditor Int
key Editor
ed WidgetStore
store
  setStore ctx $
    if tisText s1 /= tisText s0
      then saved {storeInt = IM.insert (slotKey SlotTextAreaChanged key) 1 (storeInt saved)}
      else saved
  markDirty ctx

-- -----------------------------------------------------------------------------
-- Text fields
-- -----------------------------------------------------------------------------

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

defaultTextInputConfig :: TextInputConfig
defaultTextInputConfig :: TextInputConfig
defaultTextInputConfig =
  TextInputConfig
    { ticPlaceholder :: Text
ticPlaceholder = Text
""
    , ticPassword :: Bool
ticPassword = Bool
False
    , ticLayout :: Layout
ticLayout = Layout
textInputLayout
    }

-- | Single-line text field. Pass the current text; the result is the text
-- after this frame's typing, pastes, and menu edits.
{-# INLINE textInput #-}
textInput :: Ui :> es => Text -> Eff es Text
textInput :: forall (es :: [Effect]). (Ui :> es) => Text -> Eff es Text
textInput Text
value = (Response, Text) -> Text
forall a b. (a, b) -> b
snd ((Response, Text) -> Text)
-> Eff es (Response, Text) -> Eff es Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextInputConfig -> Text -> Eff es (Response, Text)
forall (es :: [Effect]).
(Ui :> es) =>
TextInputConfig -> Text -> Eff es (Response, Text)
textInputConfigured' TextInputConfig
defaultTextInputConfig Text
value

{-# INLINE textInput' #-}
textInput' :: Ui :> es => Text -> Eff es (Response, Text)
textInput' :: forall (es :: [Effect]).
(Ui :> es) =>
Text -> Eff es (Response, Text)
textInput' = TextInputConfig -> Text -> Eff es (Response, Text)
forall (es :: [Effect]).
(Ui :> es) =>
TextInputConfig -> Text -> Eff es (Response, Text)
textInputConfigured' TextInputConfig
defaultTextInputConfig

-- | 'textInput' with a placeholder, password masking, or its own layout.
--
-- @
-- secret' <- textInputConfigured defaultTextInputConfig {ticPassword = True} secret
-- @
{-# INLINE textInputConfigured #-}
textInputConfigured :: Ui :> es => TextInputConfig -> Text -> Eff es Text
textInputConfigured :: forall (es :: [Effect]).
(Ui :> es) =>
TextInputConfig -> Text -> Eff es Text
textInputConfigured TextInputConfig
cfg Text
value = (Response, Text) -> Text
forall a b. (a, b) -> b
snd ((Response, Text) -> Text)
-> Eff es (Response, Text) -> Eff es Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextInputConfig -> Text -> Eff es (Response, Text)
forall (es :: [Effect]).
(Ui :> es) =>
TextInputConfig -> Text -> Eff es (Response, Text)
textInputConfigured' TextInputConfig
cfg Text
value

textInputConfigured' :: Ui :> es => TextInputConfig -> Text -> Eff es (Response, Text)
textInputConfigured' :: forall (es :: [Effect]).
(Ui :> es) =>
TextInputConfig -> Text -> Eff es (Response, Text)
textInputConfigured' TextInputConfig
cfg Text
value =
  Int
-> Layout -> Text -> Text -> Maybe Float -> Eff es (Response, Text)
forall (es :: [Effect]).
(Ui :> es) =>
Int
-> Layout -> Text -> Text -> Maybe Float -> Eff es (Response, Text)
buildTextInput
    (if TextInputConfig -> Bool
ticPassword TextInputConfig
cfg then Int
textInputFlagPassword else Int
0)
    (TextInputConfig -> Layout
ticLayout TextInputConfig
cfg)
    (TextInputConfig -> Text
ticPlaceholder TextInputConfig
cfg)
    Text
value
    Maybe Float
forall a. Maybe a
Nothing

-- | One frame of a single-line field's text state: load the text (seeding
-- @initial@ on first use) with its cursor and anchor, run the editor while
-- focused, and save any change. While unfocused, @unfocusedText@ (when given)
-- replaces the stored text, so a field that mirrors another value follows it.
-- Returns the text before and after this frame, whether it is focused, and
-- whether a command run from outside the frame changed it.
editTextField :: Ui :> es => WidgetId -> EditorMode -> Text -> Maybe Text -> Eff es (Text, Text, Bool, Bool)
editTextField :: forall (es :: [Effect]).
(Ui :> es) =>
WidgetId
-> EditorMode
-> Text
-> Maybe Text
-> Eff es (Text, Text, Bool, Bool)
editTextField WidgetId
wid EditorMode
mode Text
initial Maybe Text
unfocusedText = do
  ctx <- Eff es Context
forall (es :: [Effect]). (Ui :> es) => Eff es Context
askContext
  uiIO $ registerFocusable ctx wid
  inp <- askInput
  store <- uiIO (getStore ctx)
  let
    key = WidgetId -> Int
intKey WidgetId
wid
    modeKey = Slot -> Int -> Int
slotKey Slot
SlotTextMode Int
key
    pulseKey = Slot -> Int -> Int
slotKey Slot
SlotTextAreaChanged Int
key
    stored = Int -> IntMap Text -> Maybe Text
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
key (WidgetStore -> IntMap Text
storeText WidgetStore
store)
    s0 = WidgetStore -> Int -> Text -> TextInputState
loadTextInputState WidgetStore
store Int
key (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
initial Maybe Text
stored)
    pulse = Int -> IntMap Int -> Bool
forall a. Int -> IntMap a -> Bool
IM.member Int
pulseKey (WidgetStore -> IntMap Int
storeInt WidgetStore
store)
  when (isNothing stored || IM.lookup modeKey (storeInt store) /= Just (editorModeCode mode) || pulse) $
    uiIO $ modifyStore ctx $ \WidgetStore
st -> WidgetStore
st
      { storeText = if isNothing stored then IM.insert key initial (storeText st) else storeText st
      , storeInt = IM.delete pulseKey (IM.insert modeKey (editorModeCode mode) (storeInt st))
      }
  isFocus <- keyboardFocused wid
  mEdited <- if isFocus then uiIO (editTextInput ctx mode inp store key s0) else pure Nothing
  let s1 = case Maybe Editor
mEdited of
        Just Editor
ed -> Editor -> TextInputState
editorTextState Editor
ed
        Maybe Editor
Nothing -> TextInputState
-> (Text -> TextInputState) -> Maybe Text -> TextInputState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TextInputState
s0 (\Text
t -> TextInputState
s0 {tisText = t}) Maybe Text
unfocusedText
  when (s1 /= s0) $
    uiIO $ modifyStore ctx (maybe (saveTextInputState key s1) (saveTextEditor key) mEdited)
  pure (tisText s0, tisText s1, isFocus, pulse)

-- | Shared single-line field builder. The caller's @value@ is adopted as by
-- 'NanoUI.Context.adoptStoreText'. @styleIdx@ may carry the search or password
-- flag on a @NodeTextInput@; when @mDebounceMs@ is present the returned change
-- pulse is delayed until the text has been idle for that long (immediate for
-- clear clicks).
buildTextInput ::
  Ui :> es =>
  Int ->
  Layout ->
  Text ->
  Text ->
  Maybe Float ->
  Eff es (Response, Text)
buildTextInput :: forall (es :: [Effect]).
(Ui :> es) =>
Int
-> Layout -> Text -> Text -> Maybe Float -> Eff es (Response, Text)
buildTextInput Int
styleIdx Layout
layout Text
placeholder Text
value Maybe Float
mDebounceMs = do
  wid <- Eff es WidgetId
forall (es :: [Effect]). (Ui :> es) => Eff es WidgetId
nextId
  ctx <- askContext
  let key = WidgetId -> Int
intKey WidgetId
wid
  _ <- uiIO $ adoptStoreText ctx wid key value
  -- Both modes are constants, so an idle field allocates no mode record.
  let mode = if Int -> Bool
textInputPasswordMode Int
styleIdx then EditorMode
singleLineMode {modeCopyable = False} else EditorMode
singleLineMode
  (oldText, newText, isFocus, pulse) <- editTextField wid mode value Nothing
  uiIO $ recordStoreText ctx key newText
  inp <- askInput
  let submitted = Bool
isFocus Bool -> Bool -> Bool
&& Key
KeyEnter Key -> SmallArray Key -> Bool
forall a. Eq a => a -> SmallArray a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Input -> SmallArray Key
inputKeys Input
inp
      edited = Bool
pulse Bool -> Bool -> Bool
|| Text
newText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
oldText
  changed <- case mDebounceMs of
    Maybe Float
Nothing -> Bool -> Eff es Bool
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
edited
    Just Float
ms -> IO Bool -> Eff es Bool
forall (es :: [Effect]) a. (Ui :> es) => IO a -> Eff es a
uiIO (Context -> Int -> Bool -> Bool -> Float -> IO Bool
debounceSearchChanged Context
ctx Int
key Bool
isFocus Bool
edited Float
ms)
  resp <- addWidgetStyled wid NodeTextInput placeholder 0 layout styleIdx
  pure (setSubmitted submitted (setChanged changed resp), newText)

-- | Debounced change pulse for a search field. Fires when the text differs from
-- the last committed query and either the field is empty, lost focus, or has
-- been idle for @ms@ (trailing edge). Field text lives under @key@; the last
-- committed query under 'SlotSearchCommitted'.
debounceSearchChanged :: Context -> Int -> Bool -> Bool -> Float -> IO Bool
debounceSearchChanged :: Context -> Int -> Bool -> Bool -> Float -> IO Bool
debounceSearchChanged Context
ctx Int
key Bool
focused Bool
rawChanged Float
ms = do
  store <- Context -> IO WidgetStore
getStore Context
ctx
  let
    committedKey = Slot -> Int -> Int
slotKey Slot
SlotSearchCommitted Int
key
    ageKey = Slot -> Int -> Int
slotKey Slot
SlotSearchAge Int
key
    fieldText = Text -> Int -> IntMap Text -> Text
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Text
"" Int
key (WidgetStore -> IntMap Text
storeText WidgetStore
store)
    committedMissing = Bool -> Bool
not (Int -> IntMap Text -> Bool
forall a. Int -> IntMap a -> Bool
IM.member Int
committedKey (WidgetStore -> IntMap Text
storeText WidgetStore
store))
    committed = Text -> Int -> IntMap Text -> Text
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Text
fieldText Int
committedKey (WidgetStore -> IntMap Text
storeText WidgetStore
store)
    dirty = Text
fieldText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
committed
    needClock = Bool
rawChanged Bool -> Bool -> Bool
|| Bool
dirty
  now <- if needClock then getMonotonicTime else pure 0
  let
    -- Debounce timing stays in Double: wall-clock seconds as Float lose
    -- resolution at long uptimes (~125 ms at 12 days), which would shift
    -- (or skip) the trailing-edge window.
    lastEdit = Double -> Int -> IntMap Double -> Double
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Double
now Int
ageKey (WidgetStore -> IntMap Double
storeDouble WidgetStore
store)
    deadline = Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
ms :: Double
    idleMs = (Double
now Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lastEdit) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000
    commit =
      Bool -> Bool
not Bool
rawChanged
        Bool -> Bool -> Bool
&& Bool
dirty
        Bool -> Bool -> Bool
&& (Text -> Bool
T.null Text
fieldText Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
focused Bool -> Bool -> Bool
|| Double
idleMs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
deadline)
  when (rawChanged || commit || committedMissing) $
    modifyStore ctx $ \WidgetStore
st ->
      WidgetStore
st
        { storeText =
            if commit || committedMissing
              then IM.insert committedKey fieldText (storeText st)
              else storeText st
        , storeDouble =
            if rawChanged || commit
              then IM.insert ageKey now (storeDouble st)
              else storeDouble st
        }
  pure commit

-- | Search field: a caption-less 'NodeTextInput' with an embedded magnifier and
-- clear button. The label acts as the placeholder. Change pulses are debounced
-- (trailing edge); clearing with the embedded button fires immediately.
data SearchFieldConfig = SearchFieldConfig
  { SearchFieldConfig -> Text
sfcPlaceholder :: !Text
  , SearchFieldConfig -> Float
sfcDebounceMs :: !Float
  , SearchFieldConfig -> Layout
sfcLayout :: !Layout
  }
  deriving (SearchFieldConfig -> SearchFieldConfig -> Bool
(SearchFieldConfig -> SearchFieldConfig -> Bool)
-> (SearchFieldConfig -> SearchFieldConfig -> Bool)
-> Eq SearchFieldConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SearchFieldConfig -> SearchFieldConfig -> Bool
== :: SearchFieldConfig -> SearchFieldConfig -> Bool
$c/= :: SearchFieldConfig -> SearchFieldConfig -> Bool
/= :: SearchFieldConfig -> SearchFieldConfig -> Bool
Eq, Int -> SearchFieldConfig -> ShowS
[SearchFieldConfig] -> ShowS
SearchFieldConfig -> String
(Int -> SearchFieldConfig -> ShowS)
-> (SearchFieldConfig -> String)
-> ([SearchFieldConfig] -> ShowS)
-> Show SearchFieldConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchFieldConfig -> ShowS
showsPrec :: Int -> SearchFieldConfig -> ShowS
$cshow :: SearchFieldConfig -> String
show :: SearchFieldConfig -> String
$cshowList :: [SearchFieldConfig] -> ShowS
showList :: [SearchFieldConfig] -> ShowS
Show)

defaultSearchFieldConfig :: SearchFieldConfig
defaultSearchFieldConfig :: SearchFieldConfig
defaultSearchFieldConfig =
  SearchFieldConfig
    { sfcPlaceholder :: Text
sfcPlaceholder = Text
"Search…"
    , sfcDebounceMs :: Float
sfcDebounceMs = Float
300
    , sfcLayout :: Layout
sfcLayout = Layout
searchFieldLayout
    }

-- | Search box with a magnifier and a clear button; the first argument is the
-- placeholder. Pass the current text; the result is the text after this
-- frame. 'respChanged' on 'searchField'' is debounced: it fires once typing
-- pauses, or at once when the field is cleared.
{-# INLINE searchField #-}
searchField :: Ui :> es => Text -> Text -> Eff es Text
searchField :: forall (es :: [Effect]). (Ui :> es) => Text -> Text -> Eff es Text
searchField Text
placeholder Text
value = (Response, Text) -> Text
forall a b. (a, b) -> b
snd ((Response, Text) -> Text)
-> Eff es (Response, Text) -> Eff es Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Eff es (Response, Text)
forall (es :: [Effect]).
(Ui :> es) =>
Text -> Text -> Eff es (Response, Text)
searchField' Text
placeholder Text
value

{-# INLINE searchField' #-}
searchField' :: Ui :> es => Text -> Text -> Eff es (Response, Text)
searchField' :: forall (es :: [Effect]).
(Ui :> es) =>
Text -> Text -> Eff es (Response, Text)
searchField' Text
placeholder =
  SearchFieldConfig -> Text -> Eff es (Response, Text)
forall (es :: [Effect]).
(Ui :> es) =>
SearchFieldConfig -> Text -> Eff es (Response, Text)
searchFieldConfigured' (SearchFieldConfig
defaultSearchFieldConfig {sfcPlaceholder = placeholder})

{-# INLINE searchFieldConfigured #-}
searchFieldConfigured :: Ui :> es => SearchFieldConfig -> Text -> Eff es Text
searchFieldConfigured :: forall (es :: [Effect]).
(Ui :> es) =>
SearchFieldConfig -> Text -> Eff es Text
searchFieldConfigured SearchFieldConfig
cfg Text
value = (Response, Text) -> Text
forall a b. (a, b) -> b
snd ((Response, Text) -> Text)
-> Eff es (Response, Text) -> Eff es Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SearchFieldConfig -> Text -> Eff es (Response, Text)
forall (es :: [Effect]).
(Ui :> es) =>
SearchFieldConfig -> Text -> Eff es (Response, Text)
searchFieldConfigured' SearchFieldConfig
cfg Text
value

searchFieldConfigured' ::
  Ui :> es => SearchFieldConfig -> Text -> Eff es (Response, Text)
searchFieldConfigured' :: forall (es :: [Effect]).
(Ui :> es) =>
SearchFieldConfig -> Text -> Eff es (Response, Text)
searchFieldConfigured' SearchFieldConfig
cfg Text
value =
  Int
-> Layout -> Text -> Text -> Maybe Float -> Eff es (Response, Text)
forall (es :: [Effect]).
(Ui :> es) =>
Int
-> Layout -> Text -> Text -> Maybe Float -> Eff es (Response, Text)
buildTextInput
    Int
textInputFlagSearch
    (SearchFieldConfig -> Layout
sfcLayout SearchFieldConfig
cfg)
    (SearchFieldConfig -> Text
sfcPlaceholder SearchFieldConfig
cfg)
    Text
value
    (Float -> Maybe Float
forall a. a -> Maybe a
Just (SearchFieldConfig -> Float
sfcDebounceMs SearchFieldConfig
cfg))

-- -----------------------------------------------------------------------------
-- Selectable text
-- -----------------------------------------------------------------------------

-- | Read-only text that can be selected with the mouse and copied with Ctrl+C.
{-# INLINE selectableText #-}
selectableText :: Ui :> es => Text -> Eff es ()
selectableText :: forall (es :: [Effect]). (Ui :> es) => Text -> Eff es ()
selectableText = (Layout -> Layout) -> Text -> Eff es ()
forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Text -> Eff es ()
selectableTextWith Layout -> Layout
forall a. a -> a
id

{-# INLINE selectableText' #-}
selectableText' :: Ui :> es => Text -> Eff es Response
selectableText' :: forall (es :: [Effect]). (Ui :> es) => Text -> Eff es Response
selectableText' = (Layout -> Layout) -> Text -> Eff es Response
forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Text -> Eff es Response
selectableTextWith' Layout -> Layout
forall a. a -> a
id

{-# INLINE selectableTextWith #-}
selectableTextWith :: Ui :> es => (Layout -> Layout) -> Text -> Eff es ()
selectableTextWith :: forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Text -> Eff es ()
selectableTextWith Layout -> Layout
f Text
txt = Eff es Response -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Layout -> Layout) -> Text -> Eff es Response
forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Text -> Eff es Response
selectableTextWith' Layout -> Layout
f Text
txt)

selectableTextWith' :: Ui :> es => (Layout -> Layout) -> Text -> Eff es Response
selectableTextWith' :: forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Text -> Eff es Response
selectableTextWith' Layout -> Layout
f Text
txt = do
  layout <- Layout -> Layout
f (Layout -> Layout) -> Eff es Layout -> Eff es Layout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es Layout
forall (es :: [Effect]). (Ui :> es) => Eff es Layout
askDefaultLayout
  wid <- nextId
  ctx <- askContext
  -- The caller owns the text; the editor only moves the selection.
  _ <- uiIO $ adoptStoreText ctx wid (intKey wid) txt
  _ <- editTextField wid singleLineMode {modeEditable = False} txt Nothing
  let styleIdx =
        Int
textInputFlagSelectable
          Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. FontVariant
-> FontWeight -> FontStyle -> TextDecoration -> Int -> Int
packTextNodeStyleFull
                (Layout -> FontVariant
layoutFontVariant Layout
layout)
                (Layout -> FontWeight
layoutFontWeight Layout
layout)
                (Layout -> FontStyle
layoutFontStyle Layout
layout)
                (Layout -> TextDecoration
layoutTextDecoration Layout
layout)
                Int
0
  addWidgetStyled wid NodeTextInput txt 0 layout styleIdx