dynamic extra widgets on fields

Author: functora

ghcjs/delivery-calculator/delivery-calculator.cabal

@@ -1,6 +1,6 @@
 cabal-version: 2.2
 name:          delivery-calculator
-version:       0.1.0.6
+version:       0.1.0.7
 synopsis:      Delivery Calculator
 category:      Web
 build-type:    Simple

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

@@ -406,6 +406,10 @@ stUri st = do
   uri <- mkURI $ from @Unicode @Prelude.Text baseUri
   qxs <-
     stQuery
+      . Syb.everywhere
+        ( Syb.mkT
+            $ const Blurred
+        )
       . Syb.everywhere
         ( Syb.mkT $ \x ->
             if x ^. #fieldType /= FieldTypeImage

ghcjs/delivery-calculator/src/Main.hs

@@ -53,7 +53,7 @@ main =
             update = updateModel,
             Miso.view = viewModel,
             subs = mempty,
-            events = defaultEvents,
+            events = Map.insert "focus" True defaultEvents,
             initialAction = InitUpdate mSt,
             mountPoint = Nothing,
             logLevel = Off

ghcjs/delivery-calculator/trapeze.yaml

@@ -1,8 +1,8 @@
 platforms:
   android:
     appName: Delivery Calculator
-    versionCode: 6
-    versionName: 0.1.0.6
+    versionCode: 7
+    versionName: 0.1.0.7
     packageName: com.functora.delivery_calculator
     manifest:
       - file: AndroidManifest.xml

ghcjs/miso-functora/miso-functora.cabal

@@ -84,6 +84,7 @@ common pkg
     , binary
     , bytestring
     , casing
+    , containers
     , functora-ghcjs
     , fuzzy
     , jsaddle

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

@@ -6,7 +6,6 @@ module Functora.Miso.Jsm.Generic
     removeAt,
     openBrowserPage,
     enterOrEscapeBlur,
-    blur,
     insertStorage,
     selectStorage,
     selectBarcode,
@@ -111,23 +110,12 @@ openBrowserPage uri =
     pkg <- getPkg
     void $ pkg ^. JS.js1 @Unicode "openBrowserPage" (URI.render uri)
 
-enterOrEscapeBlur :: Uid -> KeyCode -> Update model
+enterOrEscapeBlur :: Unicode -> KeyCode -> Update model
 enterOrEscapeBlur uid (KeyCode code) =
   EffectUpdate $ do
     let enterOrEscape = [13, 27] :: [Int]
     when (code `elem` enterOrEscape) $ blur uid
 
-blur :: Uid -> JSM ()
-blur uid = do
-  el <-
-    getElementById
-      . either impureThrow id
-      . decodeUtf8Strict
-      . unTagged
-      $ htmlUid uid
-  is <- ghcjsPure $ JS.isTruthy el
-  when is . void $ el ^. JS.js0 @Unicode "blur"
-
 insertStorage :: (ToJSON a) => Unicode -> a -> JSM ()
 insertStorage key raw = do
   val <-

ghcjs/miso-functora/src/Functora/Miso/Prelude.hs

@@ -19,7 +19,6 @@ import Miso as X hiding
     Text,
     URI,
     at,
-    blur,
     close,
     consoleLog,
     for_,

ghcjs/miso-functora/src/Functora/Miso/Types.hs

@@ -43,22 +43,27 @@ module Functora.Miso.Types
     uniqueToIdentity,
     identityToUnique,
     keyed,
+    appendAttrs,
     prependViews,
     TopOrBottom (..),
     OnlineOrOffline (..),
     StaticOrDynamic (..),
     LeadingOrTrailing (..),
+    FocusedOrBlurred (..),
     OpenedOrClosed (..),
     Update (..),
     unUpdate,
     themeCssFile,
+    noopAll,
+    noop,
     module X,
   )
 where
 
 import Data.Foldable (foldMap)
 import Data.Functor.Barbie
 import qualified Data.Generics as Syb
+import qualified Data.Map as Map
 import Functora.Cfg
 import Functora.Miso.Prelude
 import Functora.Miso.Theme as X (Theme)
@@ -122,6 +127,7 @@ data Field a f = Field
     fieldInput :: f Unicode,
     fieldOutput :: a,
     fieldModalState :: OpenedOrClosed,
+    fieldFocusState :: FocusedOrBlurred,
     fieldRequired :: Bool,
     fieldOpts :: FieldOpts
   }
@@ -176,6 +182,7 @@ newField typ output newInput = do
         fieldInput = input,
         fieldOutput = output,
         fieldModalState = Closed,
+        fieldFocusState = Blurred,
         fieldRequired = False,
         fieldOpts = defFieldOpts
       }
@@ -187,6 +194,7 @@ newFieldId typ viewer output =
       fieldInput = Identity $ viewer output,
       fieldOutput = output,
       fieldModalState = Closed,
+      fieldFocusState = Blurred,
       fieldRequired = False,
       fieldOpts = defFieldOpts
     }
@@ -497,6 +505,11 @@ keyed key = \case
   Node x0 x1 Nothing x2 x3 -> Node x0 x1 (Just $ Miso.Key key) x2 x3
   x -> x
 
+appendAttrs :: [Attribute action] -> View action -> View action
+appendAttrs attrs = \case
+  Node x0 x1 x2 x3 x4 -> Node x0 x1 x2 (x3 <> attrs) x4
+  x -> x
+
 prependViews :: [View action] -> View action -> View action
 prependViews xs = \case
   Node a b c d e -> Node a b c d $ xs <> e
@@ -526,6 +539,12 @@ data LeadingOrTrailing
   deriving stock (Eq, Ord, Show, Read, Enum, Bounded, Data, Generic)
   deriving (Binary) via GenericType LeadingOrTrailing
 
+data FocusedOrBlurred
+  = Focused
+  | Blurred
+  deriving stock (Eq, Ord, Show, Read, Enum, Bounded, Data, Generic)
+  deriving (Binary) via GenericType FocusedOrBlurred
+
 data OpenedOrClosed
   = Opened
   | Closed
@@ -554,3 +573,22 @@ themeCssFile =
     . from @String @Unicode
     . Casing.kebab
     . inspect @String
+
+noopAll :: (Update model -> action) -> [Attribute action]
+noopAll action =
+  fmap (noop action)
+    $ Map.keys defaultEvents
+
+noop :: (Update model -> action) -> Unicode -> Attribute action
+noop action event =
+  onWithOptions
+    defaultOptions
+      { preventDefault = True,
+        stopPropagation = True
+      }
+    event
+    emptyDecoder
+    . const
+    . action
+    . EffectUpdate
+    $ pure ()

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

@@ -101,7 +101,8 @@ selectCurrency
                     & #optsPlaceholder
                     .~ ("Search" :: Unicode)
                     & #optsExtraAttributes
-                    .~ [autofocus_ True]
+                    .~ [ autofocus_ True
+                       ]
                 )
                 <> [div_ [style_ [("width", "100%")]] mempty]
                 <> currencyListWidget opts args