wip

Author: functora

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

@@ -35,6 +35,7 @@ where
 import qualified Data.ByteString.Base64.URL as B64URL
 import qualified Data.ByteString.Lazy as BL
 import Data.Functor.Barbie
+import qualified Data.Generics as Syb
 import qualified Data.Version as Version
 import Functora.Cfg
 import Functora.Miso.Prelude
@@ -45,6 +46,7 @@ import Functora.Miso.Types as X hiding
     newFieldPairId,
   )
 import qualified Functora.Miso.Types as FM
+import qualified Functora.Miso.Widgets.Field as Field
 import Functora.Money hiding (Currency, Money, Text)
 import qualified Functora.Prelude as Prelude
 import qualified Functora.Rates as Rates
@@ -214,7 +216,12 @@ unQrCode = \case
 stUri :: (MonadThrow m) => Model -> m URI
 stUri st = do
   uri <- mkURI $ from @Unicode @Prelude.Text baseUri
-  qxs <- stQuery . uniqueToIdentity $ st ^. #modelState
+  qxs <-
+    stQuery
+      . Syb.everywhere (Syb.mkT $ Field.truncateDynamicField Nothing)
+      . uniqueToIdentity
+      $ st
+      ^. #modelState
   pure
     $ uri
       { URI.uriQuery = qxs
@@ -271,8 +278,11 @@ unShareUri uri = do
     Just tSt -> do
       bSt <- either throwString pure . B64URL.decode $ encodeUtf8 tSt
       iSt <- either (throwString . thd3) pure $ decodeBinary bSt
-      uSt <- identityToUnique iSt
-      pure $ Just uSt
+      uSt <-
+        identityToUnique
+          $ Syb.everywhere (Syb.mkT Field.expandDynamicField) iSt
+      pure
+        $ Just uSt
 
 baseUri :: Unicode
 #ifdef GHCID

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

@@ -21,6 +21,7 @@ module Functora.Miso.Types
     newDynamicTitleField,
     DynamicField (..),
     parseDynamicField,
+    parseDynamicFieldId,
     inspectDynamicField,
     FieldType (..),
     htmlFieldType,
@@ -248,6 +249,15 @@ parseDynamicField value =
   where
     str = value ^. #fieldInput . #uniqueValue
 
+parseDynamicFieldId :: Field DynamicField Identity -> Maybe DynamicField
+parseDynamicFieldId value =
+  case value ^. #fieldType of
+    FieldTypeNumber -> DynamicFieldNumber <$> parseRatio str
+    FieldTypePercent -> DynamicFieldNumber <$> parseRatio str
+    _ -> Just $ DynamicFieldText str
+  where
+    str = value ^. #fieldInput . #runIdentity
+
 inspectDynamicField :: DynamicField -> Unicode
 inspectDynamicField = \case
   DynamicFieldText x -> x

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

@@ -6,6 +6,9 @@ module Functora.Miso.Widgets.Field
     OptsWidget (..),
     OptsWidgetPair (..),
     ModalWidget' (..),
+    truncateUnicode,
+    truncateDynamicField,
+    expandDynamicField,
     field,
     ratioField,
     textField,
@@ -198,7 +201,7 @@ field full@Full {fullArgs = args, fullParser = parser, fullViewer = viewer} opts
         . #uniqueUid
     getInput st' =
       st' ^? cloneTraversal optic . #fieldInput . #uniqueValue
-    getOutput st' = do
+    getOutput st' =
       (st' ^? cloneTraversal optic >>= parser)
         <|> (st' ^? cloneTraversal optic . #fieldOutput)
     getInputReplacement st' = do
@@ -872,7 +875,7 @@ genericFieldViewer args widget =
                   [ Css.fullWidth
                   ]
                   $ [ widget
-                        $ truncateFieldInput
+                        $ truncateFieldViewer
                           allowTrunc
                           stateTrunc
                           (opts ^. #fieldOptsTruncateLimit)
@@ -966,20 +969,51 @@ fieldViewerIcon icon action =
     )
     icon
 
-truncateFieldInput ::
+truncateFieldViewer ::
   Bool ->
   OpenedOrClosed ->
   Maybe Int ->
   Unicode ->
   Unicode
-truncateFieldInput True Closed limit full =
-  let half = fromMaybe defTruncateLimit limit `div` 2
-   in take half full
-        <> "..."
-        <> MS.takeEnd half full
-truncateFieldInput _ _ _ full =
+truncateFieldViewer True Closed limit full =
+  truncateUnicode limit full
+truncateFieldViewer _ _ _ full =
   full
 
+truncateDynamicField ::
+  Maybe Int ->
+  Field DynamicField Identity ->
+  Field DynamicField Identity
+truncateDynamicField limit =
+  (#fieldInput . #runIdentity %~ truncateUnicode limit)
+    . ( #fieldOutput %~ \case
+          DynamicFieldNumber {} -> DynamicFieldNumber 0
+          DynamicFieldText {} -> DynamicFieldText mempty
+      )
+
+truncateUnicode :: Maybe Int -> Unicode -> Unicode
+truncateUnicode limit input =
+  if length input <= full
+    then input
+    else
+      take half input
+        <> "..."
+        <> MS.takeEnd half input
+  where
+    full = fromMaybe defTruncateLimit limit
+    half = full `div` 2
+
+expandDynamicField ::
+  Field DynamicField Identity ->
+  Field DynamicField Identity
+expandDynamicField x =
+  if null inp
+    then x & #fieldInput . #runIdentity .~ inspectDynamicField out
+    else x & #fieldOutput .~ fromMaybe out (parseDynamicFieldId x)
+  where
+    inp = x ^. #fieldInput . #runIdentity
+    out = x ^. #fieldOutput
+
 insertAction ::
   Full model action t Unique ->
   ((Maybe Unicode -> JSM ()) -> JSM ()) ->