-- | Commands run on a text field from outside its frame: an app's Edit menu,
-- a toolbar button, the field's own context menu.
module NanoUI.Widgets.TextField
  ( runTextCommand
  , textCanUndo
  , textCanRedo
  , applyTextFieldCommand
  , textFieldMode
  , textFieldHistory
  ) where

import Data.Dynamic (fromDynamic)
import Data.IORef (writeIORef)
import Data.IntMap.Strict qualified as IM
import Data.Text (Text)
import Effectful (Eff, type (:>))
import NanoUI.Context (Context (..), WidgetStore (..), getStore, intKey, setTextInputMenu)
import NanoUI.Frame.Hit (findNodeByWidgetId)
import NanoUI.Id (WidgetId)
import NanoUI.Layout.Arena (NodeType (..), getNodeType, getStyleIdx)
import NanoUI.Monad (Ui, askContext, uiIO)
import NanoUI.Store (slotKey, Slot (..))
import NanoUI.Widgets.TextArea (applyTextAreaCommand)
import NanoUI.Widgets.TextEditor
  ( EditHistory
  , EditorMode (..)
  , TextCommand
  , canRedo
  , canUndo
  , editorModeFromCode
  , emptyHistory
  , multiLineMode
  )
import NanoUI.Widgets.TextInput (applyTextInputCommand, textInputMode)

-- | Run a command on the text field (text input, search field, text area)
-- with this id, as if its keys were pressed: @runTextCommand (respId resp)
-- Undo@. The field takes keyboard focus, and its next frame returns the
-- changed text and a 'NanoUI.respChanged' pulse. An id that is not a text
-- field is ignored.
runTextCommand :: Ui :> es => WidgetId -> TextCommand -> Eff es ()
runTextCommand :: forall (es :: [Effect]).
(Ui :> es) =>
WidgetId -> TextCommand -> Eff es ()
runTextCommand WidgetId
wid TextCommand
cmd = do
  ctx <- Eff es Context
forall (es :: [Effect]). (Ui :> es) => Eff es Context
askContext
  uiIO (applyTextFieldCommand ctx wid cmd)

-- | Whether 'NanoUI.Widgets.TextCommand.Undo' would change the field, for
-- enabling a menu item.
textCanUndo :: Ui :> es => WidgetId -> Eff es Bool
textCanUndo :: forall (es :: [Effect]). (Ui :> es) => WidgetId -> Eff es Bool
textCanUndo WidgetId
wid = do
  ctx <- Eff es Context
forall (es :: [Effect]). (Ui :> es) => Eff es Context
askContext
  uiIO (canUndo <$> textFieldHistory ctx wid)

-- | Whether 'NanoUI.Widgets.TextCommand.Redo' would change the field, for
-- enabling a menu item.
textCanRedo :: Ui :> es => WidgetId -> Eff es Bool
textCanRedo :: forall (es :: [Effect]). (Ui :> es) => WidgetId -> Eff es Bool
textCanRedo WidgetId
wid = do
  ctx <- Eff es Context
forall (es :: [Effect]). (Ui :> es) => Eff es Context
askContext
  uiIO (canRedo <$> textFieldHistory ctx wid)

-- | Run a command on the field with this id and focus it: the command comes
-- from a menu or button that may not be over the field, and the caret,
-- selection highlight and next keystroke belong to the field it edited.
applyTextFieldCommand :: Context -> WidgetId -> TextCommand -> IO ()
applyTextFieldCommand :: Context -> WidgetId -> TextCommand -> IO ()
applyTextFieldCommand Context
ctx WidgetId
wid TextCommand
cmd =
  Context -> WidgetId -> IO (Maybe EditorMode)
textFieldMode Context
ctx WidgetId
wid IO (Maybe EditorMode) -> (Maybe EditorMode -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just EditorMode
mode -> do
      if EditorMode -> Bool
modeMultiLine EditorMode
mode
        then Context -> WidgetId -> TextCommand -> IO ()
applyTextAreaCommand Context
ctx WidgetId
wid TextCommand
cmd
        else Context -> WidgetId -> EditorMode -> TextCommand -> IO ()
applyTextInputCommand Context
ctx WidgetId
wid EditorMode
mode TextCommand
cmd
      IORef WidgetId -> WidgetId -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Context -> IORef WidgetId
ctxFocusId Context
ctx) WidgetId
wid
      Context -> Maybe TextInputMenu -> IO ()
setTextInputMenu Context
ctx Maybe TextInputMenu
forall a. Maybe a
Nothing
    Maybe EditorMode
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | How the field with this id edits: from its node when it has one this
-- frame, or from what it recorded the last time it was declared.
textFieldMode :: Context -> WidgetId -> IO (Maybe EditorMode)
textFieldMode :: Context -> WidgetId -> IO (Maybe EditorMode)
textFieldMode Context
ctx WidgetId
wid =
  Context -> WidgetId -> IO (Maybe NodeIdx)
findNodeByWidgetId Context
ctx WidgetId
wid IO (Maybe NodeIdx)
-> (Maybe NodeIdx -> IO (Maybe EditorMode))
-> IO (Maybe EditorMode)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just NodeIdx
idx ->
      NodeArena -> NodeIdx -> IO NodeType
getNodeType (Context -> NodeArena
ctxNodeArena Context
ctx) NodeIdx
idx IO NodeType
-> (NodeType -> IO (Maybe EditorMode)) -> IO (Maybe EditorMode)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        NodeType
NodeTextInput -> EditorMode -> Maybe EditorMode
forall a. a -> Maybe a
Just (EditorMode -> Maybe EditorMode)
-> (NodeIdx -> EditorMode) -> NodeIdx -> Maybe EditorMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeIdx -> EditorMode
textInputMode (NodeIdx -> Maybe EditorMode)
-> IO NodeIdx -> IO (Maybe EditorMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeArena -> NodeIdx -> IO NodeIdx
getStyleIdx (Context -> NodeArena
ctxNodeArena Context
ctx) NodeIdx
idx
        NodeType
NodeTextArea -> Maybe EditorMode -> IO (Maybe EditorMode)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EditorMode -> Maybe EditorMode
forall a. a -> Maybe a
Just EditorMode
multiLineMode)
        NodeType
_ -> Maybe EditorMode -> IO (Maybe EditorMode)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe EditorMode
forall a. Maybe a
Nothing
    Maybe NodeIdx
Nothing -> do
      store <- Context -> IO WidgetStore
getStore Context
ctx
      pure (IM.lookup (slotKey SlotTextMode (intKey wid)) (storeInt store) >>= editorModeFromCode)

-- | The undo history of the field with this id, empty when it has none.
textFieldHistory :: Context -> WidgetId -> IO EditHistory
textFieldHistory :: Context -> WidgetId -> IO EditHistory
textFieldHistory Context
ctx WidgetId
wid = do
  store <- Context -> IO WidgetStore
getStore Context
ctx
  let key = WidgetId -> NodeIdx
intKey WidgetId
wid
      stored = NodeIdx -> IntMap Dynamic -> Maybe Dynamic
forall a. NodeIdx -> IntMap a -> Maybe a
IM.lookup (Slot -> NodeIdx -> NodeIdx
slotKey Slot
SlotTextHistory NodeIdx
key) (WidgetStore -> IntMap Dynamic
storeDyn WidgetStore
store)
      text = Text -> NodeIdx -> IntMap Text -> Text
forall a. a -> NodeIdx -> IntMap a -> a
IM.findWithDefault Text
"" NodeIdx
key (WidgetStore -> IntMap Text
storeText WidgetStore
store)
  pure $ case stored >>= fromDynamic of
    Just (Text
recorded, EditHistory
h) | Text
recorded Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
text :: Text) -> EditHistory
h
    Maybe (Text, EditHistory)
_ -> EditHistory
emptyHistory