Skip to content

Commit b67bdd0

Browse files
functorafunctora
committed
wip
1 parent 45e52c1 commit b67bdd0

File tree

3 files changed

+89
-65
lines changed
  • ghcjs
    • lightning-verifier/src/App/Widgets
    • miso-widgets/src/Functora/Miso/Widgets
  • pub/functora/src/prelude/Functora

3 files changed

+89
-65
lines changed

‎ghcjs/lightning-verifier/src/App/Widgets/Bolt11.hs‎

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -63,6 +63,7 @@ invoiceWidget st ln =
6363
Header.headerViewer "Invoice Details"
6464
<> pairs
6565
st
66+
#stDocLnInvoiceViewer
6667
( [ pair "Network"
6768
$ case B11.bolt11HrpNet $ B11.bolt11Hrp ln of
6869
B11.BitcoinMainnet -> "Bitcoin Mainnet"
@@ -137,6 +138,7 @@ preimageWidget st rawR r =
137138
Header.headerViewer "Preimage Details"
138139
<> pairs
139140
st
141+
#stDocLnPreimageViewer
140142
[ pair "Preimage" rawR,
141143
pair "Preimage Hash" . inspect @ByteString $ sha256Hash r
142144
]
@@ -166,9 +168,10 @@ pairs ::
166168
Foldable1 f
167169
) =>
168170
model ->
171+
ATraversal' (StDoc Unique) (Map Int StViewer) ->
169172
[FieldPair DynamicField f] ->
170173
[View Action]
171-
pairs st raw =
174+
pairs st optic raw =
172175
case typeOf st `eqTypeRep` typeRep @Model of
173176
Just HRefl ->
174177
FieldPairs.fieldPairsViewer
@@ -183,7 +186,7 @@ pairs st raw =
183186
Just
184187
$ #modelState
185188
. #stDoc
186-
. #stDocLnInvoiceViewer
189+
. cloneTraversal optic
187190
. at idx
188191
. non
189192
StViewer
@@ -195,7 +198,7 @@ pairs st raw =
195198
Just
196199
$ #modelState
197200
. #stDoc
198-
. #stDocLnInvoiceViewer
201+
. cloneTraversal optic
199202
. at idx
200203
. non
201204
StViewer
@@ -229,12 +232,12 @@ pairs st raw =
229232
success :: MisoString -> [View Action]
230233
success msg =
231234
css "app-success"
232-
$ pairs () [newFieldPairId mempty $ DynamicFieldText msg]
235+
$ pairs () voidTraversal [newFieldPairId mempty $ DynamicFieldText msg]
233236

234237
failure :: MisoString -> [View Action]
235238
failure msg =
236239
css "app-failure"
237-
$ pairs () [newFieldPairId mempty $ DynamicFieldText msg]
240+
$ pairs () voidTraversal [newFieldPairId mempty $ DynamicFieldText msg]
238241

239242
css :: MisoString -> [View action] -> [View action]
240243
css x = fmap $ \case

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

Lines changed: 77 additions & 60 deletions
Original file line numberDiff line numberDiff line change
@@ -813,63 +813,46 @@ genericFieldViewer args opts widget =
813813
if input == mempty
814814
then mempty
815815
else
816-
[ span_
817-
[ Typography.typography,
818-
Css.fullWidth,
819-
class_ "mdc-text-field",
820-
class_ "mdc-text-field--filled",
821-
style_
822-
[ ("align-items", "center"),
823-
("align-content", "center"),
824-
("word-break", "normal"),
825-
("overflow-wrap", "anywhere"),
826-
("min-height", "56px"),
827-
("height", "auto"),
828-
("padding-top", "8px"),
829-
("padding-bottom", "8px"),
830-
("border-radius", "4px"),
831-
("line-height", "150%")
816+
( case stateQr of
817+
Opened -> Qr.qr input
818+
Closed -> mempty
819+
)
820+
<> [ span_
821+
[ Typography.typography,
822+
Css.fullWidth,
823+
class_ "mdc-text-field",
824+
class_ "mdc-text-field--filled",
825+
style_
826+
[ ("align-items", "center"),
827+
("align-content", "center"),
828+
("word-break", "normal"),
829+
("overflow-wrap", "anywhere"),
830+
("min-height", "56px"),
831+
("height", "auto"),
832+
("padding-top", "8px"),
833+
("padding-bottom", "8px"),
834+
("border-radius", "4px"),
835+
("line-height", "150%")
836+
]
832837
]
833-
]
834-
[ div_ mempty
835-
$ [ widget
836-
$ truncateFieldInput allowTrunc stateTrunc opts input
837-
]
838-
<> ( if not allowTrunc
839-
then mempty
840-
else do
841-
let icon = case stateTrunc of
842-
Closed -> "open_in_full"
843-
Opened -> "close_fullscreen"
844-
trav <- maybeToList opticTrunc
845-
pure
846-
. fieldViewerIcon icon
847-
. action
848-
$ pure
849-
. ( &
850-
cloneTraversal trav
851-
%~ ( \case
852-
Closed -> Opened
853-
Opened -> Closed
854-
)
855-
)
856-
)
857-
<> ( if not allowCopy
858-
then mempty
859-
else
860-
[ fieldViewerIcon "content_copy"
861-
. action
862-
$ Jsm.shareText input
863-
]
864-
)
865-
]
866-
]
838+
[ div_ mempty
839+
$ [ widget $ truncateFieldInput allowTrunc stateTrunc opts input
840+
]
841+
<> ( if null extraWidgets then mempty else [br_ mempty]
842+
)
843+
<> extraWidgets
844+
]
845+
]
867846
where
868847
st = args ^. #viewerArgsModel
869848
value = st ^. viewerArgsOptic args
870849
input = fold1 $ value ^. #fieldInput
871850
action = args ^. #viewerArgsAction
872-
allowCopy = value ^. #fieldAllowCopy
851+
stateQr = fromMaybe Closed $ do
852+
trav <- opts ^. #viewerOptsQrOptic
853+
st ^? cloneTraversal trav
854+
allowCopy =
855+
value ^. #fieldAllowCopy
873856
allowTrunc =
874857
maybe False (length input >)
875858
$ opts
@@ -879,21 +862,55 @@ genericFieldViewer args opts widget =
879862
stateTrunc = fromMaybe Closed $ do
880863
trav <- opticTrunc
881864
st ^? cloneTraversal trav
865+
extraWidgets =
866+
( if not allowTrunc
867+
then mempty
868+
else do
869+
let icon = case stateTrunc of
870+
Closed -> "open_in_full"
871+
Opened -> "close_fullscreen"
872+
trav <- maybeToList opticTrunc
873+
pure
874+
. fieldViewerIcon icon
875+
. action
876+
$ pure
877+
. ( &
878+
cloneTraversal trav
879+
%~ ( \case
880+
Closed -> Opened
881+
Opened -> Closed
882+
)
883+
)
884+
)
885+
<> ( do
886+
trav <- maybeToList $ opts ^. #viewerOptsQrOptic
887+
pure
888+
. fieldViewerIcon "qr_code_2"
889+
. action
890+
$ pure
891+
. ( &
892+
cloneTraversal trav
893+
%~ ( \case
894+
Closed -> Opened
895+
Opened -> Closed
896+
)
897+
)
898+
)
899+
<> ( if not allowCopy
900+
then mempty
901+
else
902+
[ fieldViewerIcon "content_copy"
903+
. action
904+
$ Jsm.shareText input
905+
]
906+
)
882907

883908
fieldViewerIcon :: MisoString -> action -> View action
884909
fieldViewerIcon icon action =
885910
IconButton.iconButton
886911
( IconButton.config
887912
& IconButton.setOnClick action
888-
& IconButton.setAttributes
889-
[ Theme.primary,
890-
style_
891-
[ ("height", "auto"),
892-
("padding-top", "inherit"),
893-
("padding-bottom", "inherit"),
894-
("vertical-align", "middle")
895-
]
896-
]
913+
& IconButton.setAttributes [Theme.primary]
897914
)
898915
icon
899916

‎pub/functora/src/prelude/Functora/Prelude.hs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@ module Functora.Prelude
2828
(^.),
2929
Getter',
3030
mkGetters,
31+
voidTraversal,
3132
constTraversal,
3233

3334
-- * DerivingVia
@@ -521,6 +522,9 @@ mkGetters :: TH.Name -> TH.DecsQ
521522
mkGetters =
522523
TH.makeLensesWith $ TH.lensRules & TH.generateUpdateableOptics .~ False
523524

525+
voidTraversal :: ATraversal' s a
526+
voidTraversal = const pure
527+
524528
constTraversal :: a -> ATraversal' s a
525529
constTraversal a = \f s -> const s <$> f a
526530

0 commit comments

Comments
 (0)