Skip to content

Commit 716530a

Browse files
committed
field viewer refactoring wip
1 parent a40c7e9 commit 716530a

File tree

8 files changed

+68
-139
lines changed

8 files changed

+68
-139
lines changed

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

Lines changed: 3 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,6 @@ import qualified Data.ByteString.Lazy as BL
1111
import qualified Data.Text.Encoding as T
1212
import qualified Functora.Bolt11 as B11
1313
import Functora.Miso.Prelude
14-
import qualified Functora.Miso.Widgets.Field as Field
1514
import qualified Functora.Miso.Widgets.FieldPairs as FieldPairs
1615
import qualified Functora.Miso.Widgets.Header as Header
1716
import qualified Functora.Prelude as Prelude
@@ -63,7 +62,6 @@ invoiceWidget st ln =
6362
Header.headerViewer "Invoice Details"
6463
<> pairs
6564
st
66-
#stDocLnInvoiceViewer
6765
( [ pair "Network"
6866
$ case B11.bolt11HrpNet $ B11.bolt11Hrp ln of
6967
B11.BitcoinMainnet -> "Bitcoin Mainnet"
@@ -138,7 +136,6 @@ preimageWidget st rawR r =
138136
Header.headerViewer "Preimage Details"
139137
<> pairs
140138
st
141-
#stDocLnPreimageViewer
142139
[ pair "Preimage" rawR,
143140
pair "Preimage Hash" . inspect @ByteString $ sha256Hash r
144141
]
@@ -168,10 +165,9 @@ pairs ::
168165
Foldable1 f
169166
) =>
170167
model ->
171-
ATraversal' (StDoc Unique) (Map Int StViewer) ->
172168
[FieldPair DynamicField f] ->
173169
[View Action]
174-
pairs st optic raw =
170+
pairs st raw =
175171
case typeOf st `eqTypeRep` typeRep @Model of
176172
Just HRefl ->
177173
FieldPairs.fieldPairsViewer
@@ -180,34 +176,6 @@ pairs st optic raw =
180176
FieldPairs.argsOptic = constTraversal xs,
181177
FieldPairs.argsAction = PushUpdate . Instant
182178
}
183-
( \idx ->
184-
Field.defViewerOpts
185-
{ Field.viewerOptsQrOptic =
186-
Just
187-
$ #modelState
188-
. #stDoc
189-
. cloneTraversal optic
190-
. at idx
191-
. non
192-
StViewer
193-
{ stViewerQr = Closed,
194-
stViewerTruncate = Closed
195-
}
196-
. #stViewerQr,
197-
Field.viewerOptsTruncateOptic =
198-
Just
199-
$ #modelState
200-
. #stDoc
201-
. cloneTraversal optic
202-
. at idx
203-
. non
204-
StViewer
205-
{ stViewerQr = Closed,
206-
stViewerTruncate = Closed
207-
}
208-
. #stViewerTruncate
209-
}
210-
)
211179
Nothing ->
212180
FieldPairs.fieldPairsViewer
213181
FieldPairs.Args
@@ -218,8 +186,6 @@ pairs st optic raw =
218186
void $ fun st
219187
pure next
220188
}
221-
( const Field.defViewerOpts
222-
)
223189
where
224190
xs =
225191
filter
@@ -232,12 +198,12 @@ pairs st optic raw =
232198
success :: MisoString -> [View Action]
233199
success msg =
234200
css "app-success"
235-
$ pairs () voidTraversal [newFieldPairId mempty $ DynamicFieldText msg]
201+
$ pairs () [newFieldPairId mempty $ DynamicFieldText msg]
236202

237203
failure :: MisoString -> [View Action]
238204
failure msg =
239205
css "app-failure"
240-
$ pairs () voidTraversal [newFieldPairId mempty $ DynamicFieldText msg]
206+
$ pairs () [newFieldPairId mempty $ DynamicFieldText msg]
241207

242208
css :: MisoString -> [View action] -> [View action]
243209
css x = fmap $ \case

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

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -23,8 +23,7 @@ decrypt st =
2323
{ Field.argsModel = st,
2424
Field.argsOptic = #modelState . #stPre,
2525
Field.argsAction = PushUpdate . Instant
26-
}
27-
Field.defViewerOpts,
26+
},
2827
Grid.mediumCell
2928
[ Field.passwordField
3029
Field.Args

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

Lines changed: 0 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -75,7 +75,6 @@ screenWidget st@Model {modelState = St {stCpt = Just {}}} =
7575
Field.argsOptic = #modelState . #stPre,
7676
Field.argsAction = PushUpdate . Instant
7777
}
78-
Field.defViewerOpts
7978
)
8079
<> Qr.qr out
8180
<> [ Grid.bigCell
@@ -88,7 +87,6 @@ screenWidget st@Model {modelState = St {stCpt = Just {}}} =
8887
$ DynamicFieldText out,
8988
Field.argsAction = PushUpdate . Instant
9089
}
91-
Field.defViewerOpts
9290
]
9391
<> [ Grid.bigCell
9492
[ Button.raised
@@ -114,7 +112,6 @@ screenWidget st@Model {modelState = St {stScreen = QrCode sc}} =
114112
Field.argsOptic = #modelState . #stPre,
115113
Field.argsAction = PushUpdate . Instant
116114
}
117-
Field.defViewerOpts
118115
)
119116
<> Qr.qr out
120117
<> [ Grid.bigCell
@@ -127,7 +124,6 @@ screenWidget st@Model {modelState = St {stScreen = QrCode sc}} =
127124
$ DynamicFieldText out,
128125
Field.argsAction = PushUpdate . Instant
129126
}
130-
Field.defViewerOpts
131127
]
132128
<> [ Grid.bigCell
133129
[ Button.raised
@@ -146,26 +142,6 @@ screenWidget st@Model {modelState = St {stScreen = Converter}} =
146142
FieldPairs.argsOptic = #modelState . #stDoc . #stDocFieldPairs,
147143
FieldPairs.argsAction = PushUpdate . Instant
148144
}
149-
( \idx ->
150-
Field.defViewerOpts
151-
{ Field.viewerOptsQrOptic =
152-
Just
153-
$ #modelState
154-
. #stDoc
155-
. #stDocFieldPairsViewer
156-
. at idx
157-
. _Just
158-
. #stViewerQr,
159-
Field.viewerOptsTruncateOptic =
160-
Just
161-
$ #modelState
162-
. #stDoc
163-
. #stDocFieldPairsViewer
164-
. at idx
165-
. _Just
166-
. #stViewerTruncate
167-
}
168-
)
169145
<> [ Field.textField @Model @Action
170146
Field.Args
171147
{ Field.argsModel = st,

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

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@ module Functora.Miso.Types
99
Field (..),
1010
FieldOpts (..),
1111
defFieldOpts,
12+
defTruncateLimit,
1213
newField,
1314
newFieldId,
1415
newRatioField,
@@ -152,11 +153,14 @@ defFieldOpts :: FieldOpts
152153
defFieldOpts =
153154
FieldOpts
154155
{ fieldOptsAllowCopy = True,
155-
fieldOptsTruncateLimit = Just 67,
156+
fieldOptsTruncateLimit = Just defTruncateLimit,
156157
fieldOptsTruncateState = Just Closed,
157158
fieldOptsQrState = Just Closed
158159
}
159160

161+
defTruncateLimit :: Int
162+
defTruncateLimit = 67
163+
160164
newField ::
161165
(MonadIO m) => FieldType -> a -> (a -> MisoString) -> m (Field a Unique)
162166
newField typ output newInput = do

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

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -57,8 +57,6 @@ assetViewer
5757
. #assetFieldPairs,
5858
FieldPairs.argsAction = action
5959
}
60-
( const Field.defViewerOpts
61-
)
6260
<> Money.moneyViewer
6361
Money.Args
6462
{ Money.argsModel = st,

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

Lines changed: 45 additions & 54 deletions
Original file line numberDiff line numberDiff line change
@@ -5,8 +5,6 @@ module Functora.Miso.Widgets.Field
55
defOpts,
66
OptsWidget (..),
77
ModalWidget' (..),
8-
ViewerOpts (..),
9-
defViewerOpts,
108
field,
119
ratioField,
1210
textField,
@@ -114,24 +112,6 @@ data ModalWidget' model where
114112
ATraversal' model (Field a Unique) ->
115113
ModalWidget' model
116114

117-
data ViewerOpts model = ViewerOpts
118-
{ viewerOptsQrOptic :: Maybe (ATraversal' model OpenedOrClosed),
119-
viewerOptsTruncateOptic :: Maybe (ATraversal' model OpenedOrClosed),
120-
viewerOptsTruncateLimit :: Maybe Int
121-
}
122-
deriving stock (Generic)
123-
124-
defViewerOpts :: ViewerOpts model
125-
defViewerOpts =
126-
ViewerOpts
127-
{ viewerOptsQrOptic = Nothing,
128-
viewerOptsTruncateOptic = Nothing,
129-
viewerOptsTruncateLimit = Just defTruncateLimit
130-
}
131-
132-
defTruncateLimit :: Int
133-
defTruncateLimit = 67
134-
135115
field ::
136116
Full model action t Unique ->
137117
Opts model action ->
@@ -765,25 +745,31 @@ fieldViewer ::
765745
( Foldable1 f
766746
) =>
767747
Args model action t f ->
768-
ViewerOpts model ->
769748
[View action]
770-
fieldViewer args opts =
749+
fieldViewer args =
771750
case typ of
772-
FieldTypeNumber -> genericFieldViewer args opts text
773-
FieldTypePercent -> genericFieldViewer args opts $ text . (<> "%")
774-
FieldTypeText -> genericFieldViewer args opts text
751+
FieldTypeNumber -> genericFieldViewer args text
752+
FieldTypePercent -> genericFieldViewer args $ text . (<> "%")
753+
FieldTypeText -> genericFieldViewer args text
775754
FieldTypeTitle -> header val
776755
FieldTypeHtml ->
777-
genericFieldViewer args opts {viewerOptsTruncateLimit = Nothing} rawHtml
778-
FieldTypePassword -> genericFieldViewer args opts $ const "*****"
779-
FieldTypeQrCode -> Qr.qr val <> genericFieldViewer args opts text
756+
genericFieldViewer
757+
( args
758+
& cloneTraversal optic
759+
. #fieldOpts
760+
. #fieldOptsTruncateLimit
761+
.~ Nothing
762+
)
763+
rawHtml
764+
FieldTypePassword -> genericFieldViewer args $ const "*****"
765+
FieldTypeQrCode -> Qr.qr val <> genericFieldViewer args text
780766
where
781-
opt =
767+
optic =
782768
#argsModel . argsOptic args
783769
typ =
784-
fromMaybe FieldTypeText $ args ^? cloneTraversal opt . #fieldType
770+
fromMaybe FieldTypeText $ args ^? cloneTraversal optic . #fieldType
785771
val =
786-
maybe mempty fold1 $ args ^? cloneTraversal opt . #fieldInput
772+
maybe mempty fold1 $ args ^? cloneTraversal optic . #fieldInput
787773

788774
header :: MisoString -> [View action]
789775
header txt =
@@ -803,10 +789,9 @@ genericFieldViewer ::
803789
( Foldable1 f
804790
) =>
805791
Args model action t f ->
806-
ViewerOpts model ->
807792
(MisoString -> View action) ->
808793
[View action]
809-
genericFieldViewer args opts widget =
794+
genericFieldViewer args widget =
810795
if input == mempty
811796
then mempty
812797
else
@@ -835,7 +820,12 @@ genericFieldViewer args opts widget =
835820
[ div_
836821
[ Css.fullWidth
837822
]
838-
$ [ widget $ truncateFieldInput allowTrunc stateTrunc opts input
823+
$ [ widget
824+
$ truncateFieldInput
825+
allowTrunc
826+
stateTrunc
827+
(opts ^. #fieldOptsTruncateLimit)
828+
input
839829
]
840830
<> ( if null extraWidgets
841831
then mempty
@@ -850,38 +840,37 @@ genericFieldViewer args opts widget =
850840
]
851841
]
852842
where
853-
opt =
854-
#argsModel . argsOptic args
843+
st = argsModel args
844+
optic = argsOptic args
845+
action = argsAction args
855846
input =
856-
maybe mempty fold1 $ args ^? cloneTraversal opt . #fieldInput
857-
action =
858-
args ^. #argsAction
859-
fopts =
860-
fromMaybe defFieldOpts $ args ^? cloneTraversal opt . #fieldOpts
847+
maybe mempty fold1 $ st ^? cloneTraversal optic . #fieldInput
848+
opts =
849+
fromMaybe defFieldOpts $ st ^? cloneTraversal optic . #fieldOpts
861850
stateQr =
862-
fromMaybe Closed $ fopts ^. #fieldOptsQrState
851+
fromMaybe Closed $ opts ^. #fieldOptsQrState
863852
allowCopy =
864-
fopts ^. #fieldOptsAllowCopy
853+
opts ^. #fieldOptsAllowCopy
865854
allowTrunc =
866-
maybe False (MS.length input >) $ fopts ^. #fieldOptsTruncateLimit
867-
opticTrunc =
868-
opts ^. #viewerOptsTruncateOptic
855+
maybe False (MS.length input >) $ opts ^. #fieldOptsTruncateLimit
869856
stateTrunc =
870-
fromMaybe Closed $ fopts ^. #fieldOptsTruncateState
857+
fromMaybe Closed $ opts ^. #fieldOptsTruncateState
871858
extraWidgets =
872859
( if not allowTrunc
873860
then mempty
874861
else do
875862
let icon = case stateTrunc of
876863
Closed -> "open_in_full"
877864
Opened -> "close_fullscreen"
878-
trav <- maybeToList opticTrunc
879865
pure
880866
. fieldViewerIcon icon
881867
. action
882868
$ pure
883869
. ( &
884-
cloneTraversal trav
870+
cloneTraversal optic
871+
. #fieldOpts
872+
. #fieldOptsTruncateState
873+
. _Just
885874
%~ ( \case
886875
Closed -> Opened
887876
Opened -> Closed
@@ -892,13 +881,15 @@ genericFieldViewer args opts widget =
892881
let icon = case stateQr of
893882
Closed -> "qr_code_2"
894883
Opened -> "grid_off"
895-
trav <- maybeToList $ opts ^. #viewerOptsQrOptic
896884
pure
897885
. fieldViewerIcon icon
898886
. action
899887
$ pure
900888
. ( &
901-
cloneTraversal trav
889+
cloneTraversal optic
890+
. #fieldOpts
891+
. #fieldOptsQrState
892+
. _Just
902893
%~ ( \case
903894
Closed -> Opened
904895
Opened -> Closed
@@ -925,12 +916,12 @@ fieldViewerIcon icon action =
925916
truncateFieldInput ::
926917
Bool ->
927918
OpenedOrClosed ->
928-
ViewerOpts model ->
919+
Maybe Int ->
929920
MisoString ->
930921
MisoString
931-
truncateFieldInput True Closed opts raw =
922+
truncateFieldInput True Closed limit raw =
932923
let full = fromMisoString raw
933-
half = fromMaybe defTruncateLimit (viewerOptsTruncateLimit opts) `div` 2
924+
half = fromMaybe defTruncateLimit limit `div` 2
934925
in toMisoString
935926
$ T.take half full
936927
<> "..."

0 commit comments

Comments
 (0)