Skip to content

Commit c66f778

Browse files
functorafunctora
committed
better field viewer wip
1 parent 89f8d3f commit c66f778

File tree

4 files changed

+86
-31
lines changed

4 files changed

+86
-31
lines changed

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

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -18,9 +18,13 @@ import qualified System.Random as Random
1818
decrypt :: Model -> [View Action]
1919
decrypt st =
2020
[ Grid.bigCell
21-
$ Field.dynamicFieldViewer
22-
(PushUpdate . Instant)
23-
(st ^. #modelState . #stPre),
21+
$ Field.fieldViewer
22+
Field.ViewerArgs
23+
{ Field.viewerArgsModel = st,
24+
Field.viewerArgsOptic = #modelState . #stPre,
25+
Field.viewerArgsAction = PushUpdate . Instant
26+
}
27+
Field.defViewerOpts,
2428
Grid.mediumCell
2529
[ Field.passwordField
2630
Field.Args

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

Lines changed: 36 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -69,15 +69,27 @@ screenWidget st@Model {modelState = St {stCpt = Just {}}} =
6969
. #stScreen
7070
%~ unQrCode
7171
Header.headerWrapper
72-
( Field.dynamicFieldViewer
73-
(PushUpdate . Instant)
74-
(st ^. #modelState . #stPre)
72+
( Field.fieldViewer
73+
Field.ViewerArgs
74+
{ Field.viewerArgsModel = st,
75+
Field.viewerArgsOptic = #modelState . #stPre,
76+
Field.viewerArgsAction = PushUpdate . Instant
77+
}
78+
Field.defViewerOpts
7579
)
7680
<> Qr.qr out
7781
<> [ Grid.bigCell
78-
$ Field.dynamicFieldViewer
79-
(PushUpdate . Instant)
80-
(newDynamicFieldId $ DynamicFieldText out)
82+
$ Field.fieldViewer
83+
Field.ViewerArgs
84+
{ Field.viewerArgsModel = st,
85+
Field.viewerArgsOptic =
86+
to
87+
. const
88+
. newDynamicFieldId
89+
$ DynamicFieldText out,
90+
Field.viewerArgsAction = PushUpdate . Instant
91+
}
92+
Field.defViewerOpts
8193
]
8294
<> [ Grid.bigCell
8395
[ Button.raised
@@ -97,15 +109,27 @@ screenWidget st@Model {modelState = St {stScreen = QrCode sc}} =
97109
Right uri -> do
98110
let out = toMisoString $ URI.render uri
99111
Header.headerWrapper
100-
( Field.dynamicFieldViewer
101-
(PushUpdate . Instant)
102-
(st ^. #modelState . #stPre)
112+
( Field.fieldViewer
113+
Field.ViewerArgs
114+
{ Field.viewerArgsModel = st,
115+
Field.viewerArgsOptic = #modelState . #stPre,
116+
Field.viewerArgsAction = PushUpdate . Instant
117+
}
118+
Field.defViewerOpts
103119
)
104120
<> Qr.qr out
105121
<> [ Grid.bigCell
106-
$ Field.dynamicFieldViewer
107-
(PushUpdate . Instant)
108-
(newDynamicFieldId $ DynamicFieldText out)
122+
$ Field.fieldViewer
123+
Field.ViewerArgs
124+
{ Field.viewerArgsModel = st,
125+
Field.viewerArgsOptic =
126+
to
127+
. const
128+
. newDynamicFieldId
129+
$ DynamicFieldText out,
130+
Field.viewerArgsAction = PushUpdate . Instant
131+
}
132+
Field.defViewerOpts
109133
]
110134
<> [ Grid.bigCell
111135
[ Button.raised

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

Lines changed: 36 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -5,13 +5,16 @@ module Functora.Miso.Widgets.Field
55
defOpts,
66
OptsWidget (..),
77
ModalWidget' (..),
8+
ViewerArgs (..),
9+
ViewerOpts (..),
10+
defViewerOpts,
811
field,
912
ratioField,
1013
textField,
1114
dynamicField,
1215
passwordField,
1316
constTextField,
14-
dynamicFieldViewer,
17+
fieldViewer,
1518
)
1619
where
1720

@@ -110,6 +113,28 @@ data ModalWidget' model where
110113
ATraversal' model (Field a Unique) ->
111114
ModalWidget' model
112115

116+
data ViewerArgs model action t f = ViewerArgs
117+
{ viewerArgsModel :: model,
118+
viewerArgsOptic :: Getter' model (Field t f),
119+
viewerArgsAction :: (model -> JSM model) -> action
120+
}
121+
deriving stock (Generic)
122+
123+
data ViewerOpts model = ViewerOpts
124+
{ viewerOptsQrOptic :: Maybe (ATraversal' model OpenedOrClosed),
125+
viewerOptsTruncateOptic :: Maybe (ATraversal' model OpenedOrClosed),
126+
viewerOptsTruncateLimit :: Natural
127+
}
128+
deriving stock (Generic)
129+
130+
defViewerOpts :: ViewerOpts model
131+
defViewerOpts =
132+
ViewerOpts
133+
{ viewerOptsQrOptic = Nothing,
134+
viewerOptsTruncateOptic = Nothing,
135+
viewerOptsTruncateLimit = 67
136+
}
137+
113138
field ::
114139
Full model action item ->
115140
Opts model action ->
@@ -739,27 +764,25 @@ cell Opts {optsFullWidth = full} =
739764
--
740765
-- TODO : support optional copying widgets
741766
--
742-
dynamicFieldViewer ::
743-
forall model action f.
767+
fieldViewer ::
744768
( Foldable1 f
745769
) =>
746-
((model -> JSM model) -> action) ->
747-
Field DynamicField f ->
770+
ViewerArgs model action t f ->
771+
ViewerOpts model ->
748772
[View action]
749-
dynamicFieldViewer action value =
773+
fieldViewer args _ =
750774
case value ^. #fieldType of
751775
FieldTypeNumber -> genericFieldViewer action value text
752776
FieldTypePercent -> genericFieldViewer action value $ text . (<> "%")
753777
FieldTypeText -> genericFieldViewer action value text
754-
FieldTypeTitle -> header out
778+
FieldTypeTitle -> header input
755779
FieldTypeHtml -> genericFieldViewer action value rawHtml
756780
FieldTypePassword -> genericFieldViewer action value $ const "*****"
757-
FieldTypeQrCode -> Qr.qr out <> genericFieldViewer action value text
781+
FieldTypeQrCode -> Qr.qr input <> genericFieldViewer action value text
758782
where
759-
--
760-
-- TODO : use input instead!!!
761-
--
762-
out = inspectDynamicField $ value ^. #fieldOutput
783+
value = args ^. #viewerArgsModel . viewerArgsOptic args
784+
input = fold1 $ value ^. #fieldInput
785+
action = args ^. #viewerArgsAction
763786

764787
header :: MisoString -> [View action]
765788
header txt =
@@ -779,7 +802,7 @@ genericFieldViewer ::
779802
( Foldable1 f
780803
) =>
781804
((model -> JSM model) -> action) ->
782-
Field typ f ->
805+
Field t f ->
783806
(MisoString -> View action) ->
784807
[View action]
785808
genericFieldViewer action value widget =

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

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -60,9 +60,13 @@ fieldPairViewer args pair =
6060
then mempty
6161
else
6262
[ cell
63-
$ Field.dynamicFieldViewer
64-
(args ^. #argsAction)
65-
(pair ^. #fieldPairValue)
63+
$ Field.fieldViewer
64+
Field.ViewerArgs
65+
{ Field.viewerArgsModel = args ^. #argsModel,
66+
Field.viewerArgsOptic = to . const $ pair ^. #fieldPairValue,
67+
Field.viewerArgsAction = args ^. #argsAction
68+
}
69+
Field.defViewerOpts
6670
]
6771
)
6872
where

0 commit comments

Comments
 (0)