field auto scroll option

Author: functora

ghcjs/delivery-calculator/src/App/Jsm.hs

@@ -1,4 +1,7 @@
-module App.Jsm (fetchBlobUris) where
+module App.Jsm
+  ( fetchBlobUris,
+  )
+where
 
 import App.Types
 import qualified Data.ByteString.Lazy as BL

ghcjs/miso-functora/src/Functora/Miso/Jsm/Generic.hs

@@ -21,6 +21,7 @@ module Functora.Miso.Jsm.Generic
     saveFileThen,
     fetchUrlAsRfc2397,
     setValue,
+    scrollTo,
   )
 where
 
@@ -302,3 +303,18 @@ setValue uid value = do
       $ htmlUid uid
   is <- ghcjsPure $ JS.isTruthy el
   when is $ el ^. JS.jss ("value" :: Unicode) value
+
+scrollTo :: Uid -> JSM ()
+scrollTo uid = do
+  el <-
+    getElementById
+      . either impureThrow id
+      . decodeUtf8Strict
+      . unTagged
+      $ htmlUid uid
+  is <- ghcjsPure $ JS.isTruthy el
+  jarg <- JS.toJSVal $ toJSON arg
+  when is . void $ el ^. JS.js1 ("scrollIntoView" :: Unicode) jarg
+  where
+    arg :: Map Unicode Unicode
+    arg = [("behavior", "smooth"), ("block", "center")]

ghcjs/miso-functora/src/Functora/Miso/Widgets/Field.hs

@@ -49,6 +49,7 @@ data Opts model action t f = Opts
     optsLabel :: Maybe Unicode,
     optsOnFocus :: Field t f -> Update model -> Update model,
     optsFullWidth :: Bool,
+    optsAutoScroll :: Bool,
     optsPlaceholder :: Unicode,
     optsOnInputAction :: Maybe (Update model -> action),
     optsTrailingWidgets ::
@@ -71,6 +72,7 @@ defOpts =
       optsLabel = Nothing,
       optsOnFocus = const id,
       optsFullWidth = False,
+      optsAutoScroll = True,
       optsPlaceholder = mempty,
       optsOnInputAction = Nothing,
       optsTrailingWidgets = defTrailingWidgets,
@@ -320,7 +322,13 @@ field full@Full {fullArgs = args, fullParser = parser, fullViewer = viewer} opts
           .~ Blurred
     onFocusAction =
       action
-        . ( maybe id (optsOnFocus opts) $ st ^? cloneTraversal optic
+        . ( maybe id (optsOnFocus opts)
+              $ st
+              ^? cloneTraversal optic
+          )
+        . ( if optsAutoScroll opts
+              then addEffect $ Jsm.scrollTo uid
+              else id
           )
         . PureUpdate
         $ cloneTraversal optic