Skip to content

Commit 45e52c1

Browse files
functorafunctora
committed
field viewer truncate stateful widgets
1 parent c9294aa commit 45e52c1

File tree

9 files changed

+216
-80
lines changed

9 files changed

+216
-80
lines changed

‎ghcjs/lightning-verifier/src/App/Types.hs‎

Lines changed: 17 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ module App.Types
66
Action (..),
77
St (..),
88
StDoc (..),
9+
StViewer (..),
910
newStDoc,
1011
Screen (..),
1112
isQrCode,
@@ -85,10 +86,21 @@ instance TraversableB St
8586

8687
deriving via GenericType (St Identity) instance Binary (St Identity)
8788

89+
data StViewer = StViewer
90+
{ stViewerQr :: OpenedOrClosed,
91+
stViewerTruncate :: OpenedOrClosed
92+
}
93+
deriving stock (Eq, Ord, Show, Data, Generic)
94+
95+
deriving via GenericType StViewer instance Binary StViewer
96+
8897
data StDoc f = StDoc
8998
{ stDocFieldPairs :: [FieldPair DynamicField f],
99+
stDocFieldPairsViewer :: Map Int StViewer,
90100
stDocLnPreimage :: Field MisoString f,
91-
stDocLnInvoice :: Field MisoString f
101+
stDocLnPreimageViewer :: Map Int StViewer,
102+
stDocLnInvoice :: Field MisoString f,
103+
stDocLnInvoiceViewer :: Map Int StViewer
92104
}
93105
deriving stock (Generic)
94106

@@ -113,8 +125,11 @@ newStDoc = do
113125
pure
114126
StDoc
115127
{ stDocFieldPairs = mempty,
128+
stDocFieldPairsViewer = mempty,
116129
stDocLnPreimage = r,
117-
stDocLnInvoice = ln
130+
stDocLnPreimageViewer = mempty,
131+
stDocLnInvoice = ln,
132+
stDocLnInvoiceViewer = mempty
118133
}
119134

120135
data Screen

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

Lines changed: 71 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -11,9 +11,11 @@ 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
1415
import qualified Functora.Miso.Widgets.FieldPairs as FieldPairs
1516
import qualified Functora.Miso.Widgets.Header as Header
1617
import qualified Functora.Prelude as Prelude
18+
import Type.Reflection
1719
import qualified Prelude
1820

1921
bolt11 :: Model -> [View Action]
@@ -22,10 +24,10 @@ bolt11 st =
2224
<> (if isRight ln then parserWidget rawLn rh else mempty)
2325
<> parserWidget rawR r
2426
<> fromRight mempty (verifierWidget [rawLn, rawR] <$> rh <*> r)
25-
<> either (const mempty) invoiceWidget ln
27+
<> either (const mempty) (invoiceWidget st) ln
2628
<> either
2729
(const mempty)
28-
(\bsR -> if bsR == mempty then mempty else preimageWidget rawR bsR)
30+
(\bsR -> if bsR == mempty then mempty else preimageWidget st rawR bsR)
2931
r
3032
where
3133
rawLn :: MisoString
@@ -56,10 +58,11 @@ verifierWidget src rh r =
5658
then success "The preimage matches the invoice"
5759
else failure "The preimage does not match the invoice"
5860

59-
invoiceWidget :: B11.Bolt11 -> [View Action]
60-
invoiceWidget ln =
61+
invoiceWidget :: Model -> B11.Bolt11 -> [View Action]
62+
invoiceWidget st ln =
6163
Header.headerViewer "Invoice Details"
6264
<> pairs
65+
st
6366
( [ pair "Network"
6467
$ case B11.bolt11HrpNet $ B11.bolt11Hrp ln of
6568
B11.BitcoinMainnet -> "Bitcoin Mainnet"
@@ -75,7 +78,7 @@ invoiceWidget ln =
7578
$ B11.bolt11Timestamp ln
7679
]
7780
<> ( B11.bolt11Tags ln
78-
>>= invoiceTagWidget ln
81+
>>= invoiceTag ln
7982
)
8083
<> [ pair "Signature"
8184
. B11.inspectHex
@@ -88,8 +91,8 @@ invoiceWidget ln =
8891
where
8992
sig = B11.bolt11Signature ln
9093

91-
invoiceTagWidget :: B11.Bolt11 -> B11.Tag -> [FieldPair DynamicField Identity]
92-
invoiceTagWidget ln = \case
94+
invoiceTag :: B11.Bolt11 -> B11.Tag -> [FieldPair DynamicField Identity]
95+
invoiceTag ln = \case
9396
B11.PaymentHash x -> hex "Preimage Hash" x
9497
B11.PaymentSecret x -> hex "Payment Secret" x
9598
B11.Description x -> pure . pair "Description" $ inspect x
@@ -129,10 +132,11 @@ invoiceTagWidget ln = \case
129132
. pair x
130133
. B11.inspectHex
131134

132-
preimageWidget :: MisoString -> ByteString -> [View Action]
133-
preimageWidget rawR r =
135+
preimageWidget :: Model -> MisoString -> ByteString -> [View Action]
136+
preimageWidget st rawR r =
134137
Header.headerViewer "Preimage Details"
135138
<> pairs
139+
st
136140
[ pair "Preimage" rawR,
137141
pair "Preimage Hash" . inspect @ByteString $ sha256Hash r
138142
]
@@ -157,17 +161,62 @@ pair x =
157161
newFieldPairId x
158162
. DynamicFieldText
159163

160-
pairs :: (Foldable1 f) => [FieldPair DynamicField f] -> [View Action]
161-
pairs raw =
162-
FieldPairs.fieldPairsViewer
163-
FieldPairs.Args
164-
{ FieldPairs.argsModel = xs,
165-
FieldPairs.argsOptic = id,
166-
FieldPairs.argsAction =
167-
\fun -> PushUpdate . Instant $ \next -> do
168-
void $ fun xs
169-
pure next
170-
}
164+
pairs ::
165+
( Typeable model,
166+
Foldable1 f
167+
) =>
168+
model ->
169+
[FieldPair DynamicField f] ->
170+
[View Action]
171+
pairs st raw =
172+
case typeOf st `eqTypeRep` typeRep @Model of
173+
Just HRefl ->
174+
FieldPairs.fieldPairsViewer
175+
FieldPairs.Args
176+
{ FieldPairs.argsModel = st,
177+
FieldPairs.argsOptic = constTraversal xs,
178+
FieldPairs.argsAction = PushUpdate . Instant
179+
}
180+
( \idx ->
181+
Field.defViewerOpts
182+
{ Field.viewerOptsQrOptic =
183+
Just
184+
$ #modelState
185+
. #stDoc
186+
. #stDocLnInvoiceViewer
187+
. at idx
188+
. non
189+
StViewer
190+
{ stViewerQr = Closed,
191+
stViewerTruncate = Closed
192+
}
193+
. #stViewerQr,
194+
Field.viewerOptsTruncateOptic =
195+
Just
196+
$ #modelState
197+
. #stDoc
198+
. #stDocLnInvoiceViewer
199+
. at idx
200+
. non
201+
StViewer
202+
{ stViewerQr = Closed,
203+
stViewerTruncate = Closed
204+
}
205+
. #stViewerTruncate
206+
}
207+
)
208+
Nothing ->
209+
FieldPairs.fieldPairsViewer
210+
FieldPairs.Args
211+
{ FieldPairs.argsModel = st,
212+
FieldPairs.argsOptic = constTraversal xs,
213+
FieldPairs.argsAction =
214+
\fun -> PushUpdate . Instant $ \next -> do
215+
void $ fun st
216+
pure next
217+
}
218+
( const Field.defViewerOpts
219+
)
171220
where
172221
xs =
173222
filter
@@ -180,12 +229,12 @@ pairs raw =
180229
success :: MisoString -> [View Action]
181230
success msg =
182231
css "app-success"
183-
$ pairs [newFieldPairId mempty $ DynamicFieldText msg]
232+
$ pairs () [newFieldPairId mempty $ DynamicFieldText msg]
184233

185234
failure :: MisoString -> [View Action]
186235
failure msg =
187236
css "app-failure"
188-
$ pairs [newFieldPairId mempty $ DynamicFieldText msg]
237+
$ pairs () [newFieldPairId mempty $ DynamicFieldText msg]
189238

190239
css :: MisoString -> [View action] -> [View action]
191240
css x = fmap $ \case

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

Lines changed: 21 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@ import qualified Material.LayoutGrid as LayoutGrid
1919
import qualified Material.Theme as Theme
2020
import qualified Material.TopAppBar as TopAppBar
2121
import qualified Material.Typography as Typography
22-
import Miso hiding (view)
22+
import Miso hiding (at, view)
2323
import qualified Text.URI as URI
2424

2525
mainWidget :: Model -> View Action
@@ -148,6 +148,26 @@ screenWidget st@Model {modelState = St {stScreen = Converter}} =
148148
FieldPairs.argsOptic = #modelState . #stDoc . #stDocFieldPairs,
149149
FieldPairs.argsAction = PushUpdate . Instant
150150
}
151+
( \idx ->
152+
Field.defViewerOpts
153+
{ Field.viewerOptsQrOptic =
154+
Just
155+
$ #modelState
156+
. #stDoc
157+
. #stDocFieldPairsViewer
158+
. at idx
159+
. _Just
160+
. #stViewerQr,
161+
Field.viewerOptsTruncateOptic =
162+
Just
163+
$ #modelState
164+
. #stDoc
165+
. #stDocFieldPairsViewer
166+
. at idx
167+
. _Just
168+
. #stViewerTruncate
169+
}
170+
)
151171
<> [ Field.textField @Model @Action
152172
Field.Args
153173
{ Field.argsModel = st,

‎ghcjs/lightning-verifier/static/app.css‎

Lines changed: 10 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -33,20 +33,28 @@ textarea {
3333
height: 56px;
3434
}
3535

36-
.app-success > div > span {
36+
.app-success > span {
3737
color: white;
3838
background-color: #018786 !important;
3939
display: flex;
4040
justify-content: center;
4141
}
4242

43-
.app-failure > div > span {
43+
.app-success > span > div > .mdc-icon-button {
44+
color: white !important;
45+
}
46+
47+
.app-failure > span {
4448
color: white;
4549
background-color: #b00020 !important;
4650
display: flex;
4751
justify-content: center;
4852
}
4953

54+
.app-failure > span > div > .mdc-icon-button {
55+
color: white !important;
56+
}
57+
5058
@media print {
5159
body {
5260
color-adjust: exact !important;

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

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

0 commit comments

Comments
 (0)