Skip to content

Commit a40c7e9

Browse files
functorafunctora
committed
moving FieldViewer into FieldOpts refactoring WIP
1 parent 1c249e5 commit a40c7e9

File tree

7 files changed

+105
-78
lines changed

7 files changed

+105
-78
lines changed

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

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -19,10 +19,10 @@ decrypt :: Model -> [View Action]
1919
decrypt st =
2020
[ Grid.bigCell
2121
$ Field.fieldViewer
22-
Field.ViewerArgs
23-
{ Field.viewerArgsModel = st,
24-
Field.viewerArgsOptic = #modelState . #stPre,
25-
Field.viewerArgsAction = PushUpdate . Instant
22+
Field.Args
23+
{ Field.argsModel = st,
24+
Field.argsOptic = #modelState . #stPre,
25+
Field.argsAction = PushUpdate . Instant
2626
}
2727
Field.defViewerOpts,
2828
Grid.mediumCell

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

Lines changed: 18 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -70,24 +70,23 @@ screenWidget st@Model {modelState = St {stCpt = Just {}}} =
7070
%~ unQrCode
7171
Header.headerWrapper
7272
( Field.fieldViewer
73-
Field.ViewerArgs
74-
{ Field.viewerArgsModel = st,
75-
Field.viewerArgsOptic = #modelState . #stPre,
76-
Field.viewerArgsAction = PushUpdate . Instant
73+
Field.Args
74+
{ Field.argsModel = st,
75+
Field.argsOptic = #modelState . #stPre,
76+
Field.argsAction = PushUpdate . Instant
7777
}
7878
Field.defViewerOpts
7979
)
8080
<> Qr.qr out
8181
<> [ Grid.bigCell
8282
$ Field.fieldViewer
83-
Field.ViewerArgs
84-
{ Field.viewerArgsModel = st,
85-
Field.viewerArgsOptic =
86-
to
87-
. const
83+
Field.Args
84+
{ Field.argsModel = st,
85+
Field.argsOptic =
86+
constTraversal
8887
. newDynamicFieldId
8988
$ DynamicFieldText out,
90-
Field.viewerArgsAction = PushUpdate . Instant
89+
Field.argsAction = PushUpdate . Instant
9190
}
9291
Field.defViewerOpts
9392
]
@@ -110,24 +109,23 @@ screenWidget st@Model {modelState = St {stScreen = QrCode sc}} =
110109
let out = toMisoString $ URI.render uri
111110
Header.headerWrapper
112111
( Field.fieldViewer
113-
Field.ViewerArgs
114-
{ Field.viewerArgsModel = st,
115-
Field.viewerArgsOptic = #modelState . #stPre,
116-
Field.viewerArgsAction = PushUpdate . Instant
112+
Field.Args
113+
{ Field.argsModel = st,
114+
Field.argsOptic = #modelState . #stPre,
115+
Field.argsAction = PushUpdate . Instant
117116
}
118117
Field.defViewerOpts
119118
)
120119
<> Qr.qr out
121120
<> [ Grid.bigCell
122121
$ Field.fieldViewer
123-
Field.ViewerArgs
124-
{ Field.viewerArgsModel = st,
125-
Field.viewerArgsOptic =
126-
to
127-
. const
122+
Field.Args
123+
{ Field.argsModel = st,
124+
Field.argsOptic =
125+
constTraversal
128126
. newDynamicFieldId
129127
$ DynamicFieldText out,
130-
Field.viewerArgsAction = PushUpdate . Instant
128+
Field.argsAction = PushUpdate . Instant
131129
}
132130
Field.defViewerOpts
133131
]

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

Lines changed: 27 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,8 @@ module Functora.Miso.Types
77
newUnique,
88
newUniqueDuplicator,
99
Field (..),
10+
FieldOpts (..),
11+
defFieldOpts,
1012
newField,
1113
newFieldId,
1214
newRatioField,
@@ -114,8 +116,8 @@ data Field a f = Field
114116
{ fieldType :: FieldType,
115117
fieldInput :: f MisoString,
116118
fieldOutput :: a,
117-
fieldAllowCopy :: Bool,
118-
fieldModalState :: OpenedOrClosed
119+
fieldModalState :: OpenedOrClosed,
120+
fieldOpts :: FieldOpts
119121
}
120122
deriving stock (Generic)
121123

@@ -136,6 +138,25 @@ deriving via
136138
instance
137139
(Typ a) => Binary (Field a Identity)
138140

141+
data FieldOpts = FieldOpts
142+
{ fieldOptsAllowCopy :: Bool,
143+
fieldOptsTruncateLimit :: Maybe Int,
144+
fieldOptsTruncateState :: Maybe OpenedOrClosed,
145+
fieldOptsQrState :: Maybe OpenedOrClosed
146+
}
147+
deriving stock (Eq, Ord, Show, Data, Generic)
148+
149+
deriving via GenericType FieldOpts instance Binary FieldOpts
150+
151+
defFieldOpts :: FieldOpts
152+
defFieldOpts =
153+
FieldOpts
154+
{ fieldOptsAllowCopy = True,
155+
fieldOptsTruncateLimit = Just 67,
156+
fieldOptsTruncateState = Just Closed,
157+
fieldOptsQrState = Just Closed
158+
}
159+
139160
newField ::
140161
(MonadIO m) => FieldType -> a -> (a -> MisoString) -> m (Field a Unique)
141162
newField typ output newInput = do
@@ -145,8 +166,8 @@ newField typ output newInput = do
145166
{ fieldType = typ,
146167
fieldInput = input,
147168
fieldOutput = output,
148-
fieldAllowCopy = True,
149-
fieldModalState = Closed
169+
fieldModalState = Closed,
170+
fieldOpts = defFieldOpts
150171
}
151172

152173
newFieldId :: FieldType -> (a -> MisoString) -> a -> Field a Identity
@@ -155,8 +176,8 @@ newFieldId typ viewer output =
155176
{ fieldType = typ,
156177
fieldInput = Identity $ viewer output,
157178
fieldOutput = output,
158-
fieldAllowCopy = True,
159-
fieldModalState = Closed
179+
fieldModalState = Closed,
180+
fieldOpts = defFieldOpts
160181
}
161182

162183
newRatioField :: (MonadIO m) => Rational -> m (Field Rational Unique)

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

Lines changed: 39 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,6 @@ module Functora.Miso.Widgets.Field
55
defOpts,
66
OptsWidget (..),
77
ModalWidget' (..),
8-
ViewerArgs (..),
98
ViewerOpts (..),
109
defViewerOpts,
1110
field,
@@ -37,17 +36,17 @@ import qualified Material.Theme as Theme
3736
import qualified Material.Typography as Typography
3837
import qualified Miso.String as MS
3938

40-
data Args model action item = Args
39+
data Args model action t f = Args
4140
{ argsModel :: model,
42-
argsOptic :: ATraversal' model (Field item Unique),
41+
argsOptic :: ATraversal' model (Field t f),
4342
argsAction :: (model -> JSM model) -> action
4443
}
4544
deriving stock (Generic)
4645

47-
data Full model action item = Full
48-
{ fullArgs :: Args model action item,
49-
fullParser :: Field item Unique -> Maybe item,
50-
fullViewer :: item -> MisoString
46+
data Full model action t f = Full
47+
{ fullArgs :: Args model action t f,
48+
fullParser :: Field t f -> Maybe t,
49+
fullViewer :: t -> MisoString
5150
}
5251
deriving stock (Generic)
5352

@@ -115,13 +114,6 @@ data ModalWidget' model where
115114
ATraversal' model (Field a Unique) ->
116115
ModalWidget' model
117116

118-
data ViewerArgs model action t f = ViewerArgs
119-
{ viewerArgsModel :: model,
120-
viewerArgsOptic :: Getter' model (Field t f),
121-
viewerArgsAction :: (model -> JSM model) -> action
122-
}
123-
deriving stock (Generic)
124-
125117
data ViewerOpts model = ViewerOpts
126118
{ viewerOptsQrOptic :: Maybe (ATraversal' model OpenedOrClosed),
127119
viewerOptsTruncateOptic :: Maybe (ATraversal' model OpenedOrClosed),
@@ -141,7 +133,7 @@ defTruncateLimit :: Int
141133
defTruncateLimit = 67
142134

143135
field ::
144-
Full model action item ->
136+
Full model action t Unique ->
145137
Opts model action ->
146138
View action
147139
field Full {fullArgs = args, fullParser = parser, fullViewer = viewer} opts =
@@ -238,7 +230,7 @@ field Full {fullArgs = args, fullParser = parser, fullViewer = viewer} opts =
238230
%~ maybe id (const . id) (getOutput next)
239231

240232
ratioField ::
241-
Args model action Rational ->
233+
Args model action Rational Unique ->
242234
Opts model action ->
243235
View action
244236
ratioField args =
@@ -250,7 +242,7 @@ ratioField args =
250242
}
251243

252244
textField ::
253-
Args model action MisoString ->
245+
Args model action MisoString Unique ->
254246
Opts model action ->
255247
View action
256248
textField args =
@@ -262,7 +254,7 @@ textField args =
262254
}
263255

264256
dynamicField ::
265-
Args model action DynamicField ->
257+
Args model action DynamicField Unique ->
266258
Opts model action ->
267259
View action
268260
dynamicField args =
@@ -274,7 +266,7 @@ dynamicField args =
274266
}
275267

276268
passwordField ::
277-
Args model action MisoString ->
269+
Args model action MisoString Unique ->
278270
Opts model action ->
279271
View action
280272
passwordField args opts =
@@ -289,7 +281,7 @@ passwordField args opts =
289281

290282
fieldIcon ::
291283
LeadingOrTrailing ->
292-
Args model action item ->
284+
Args model action t Unique ->
293285
Opts model action ->
294286
OptsWidget model action ->
295287
TextField.Icon action
@@ -407,7 +399,7 @@ fieldIconSimple lot txt attrs action =
407399
)
408400
txt
409401

410-
fieldModal :: Args model action item -> ModalWidget' model -> [View action]
402+
fieldModal :: Args model action t f -> ModalWidget' model -> [View action]
411403
fieldModal args@Args {argsAction = action} (ModalItemWidget opt idx fps lbl ooc) =
412404
Dialog.dialog
413405
Dialog.Args
@@ -659,7 +651,7 @@ fieldModal args (ModalMiniWidget opt) =
659651
}
660652

661653
selectTypeWidget ::
662-
Args model action item ->
654+
Args model action t f ->
663655
ATraversal' model (Field a Unique) ->
664656
View action
665657
selectTypeWidget args@Args {argsAction = action} optic =
@@ -772,22 +764,26 @@ cell Opts {optsFullWidth = full} =
772764
fieldViewer ::
773765
( Foldable1 f
774766
) =>
775-
ViewerArgs model action t f ->
767+
Args model action t f ->
776768
ViewerOpts model ->
777769
[View action]
778770
fieldViewer args opts =
779-
case value ^. #fieldType of
771+
case typ of
780772
FieldTypeNumber -> genericFieldViewer args opts text
781773
FieldTypePercent -> genericFieldViewer args opts $ text . (<> "%")
782774
FieldTypeText -> genericFieldViewer args opts text
783-
FieldTypeTitle -> header input
775+
FieldTypeTitle -> header val
784776
FieldTypeHtml ->
785777
genericFieldViewer args opts {viewerOptsTruncateLimit = Nothing} rawHtml
786778
FieldTypePassword -> genericFieldViewer args opts $ const "*****"
787-
FieldTypeQrCode -> Qr.qr input <> genericFieldViewer args opts text
779+
FieldTypeQrCode -> Qr.qr val <> genericFieldViewer args opts text
788780
where
789-
value = args ^. #viewerArgsModel . viewerArgsOptic args
790-
input = fold1 $ value ^. #fieldInput
781+
opt =
782+
#argsModel . argsOptic args
783+
typ =
784+
fromMaybe FieldTypeText $ args ^? cloneTraversal opt . #fieldType
785+
val =
786+
maybe mempty fold1 $ args ^? cloneTraversal opt . #fieldInput
791787

792788
header :: MisoString -> [View action]
793789
header txt =
@@ -806,7 +802,7 @@ header txt =
806802
genericFieldViewer ::
807803
( Foldable1 f
808804
) =>
809-
ViewerArgs model action t f ->
805+
Args model action t f ->
810806
ViewerOpts model ->
811807
(MisoString -> View action) ->
812808
[View action]
@@ -854,24 +850,24 @@ genericFieldViewer args opts widget =
854850
]
855851
]
856852
where
857-
st = args ^. #viewerArgsModel
858-
value = st ^. viewerArgsOptic args
859-
input = fold1 $ value ^. #fieldInput
860-
action = args ^. #viewerArgsAction
861-
stateQr = fromMaybe Closed $ do
862-
trav <- opts ^. #viewerOptsQrOptic
863-
st ^? cloneTraversal trav
853+
opt =
854+
#argsModel . argsOptic args
855+
input =
856+
maybe mempty fold1 $ args ^? cloneTraversal opt . #fieldInput
857+
action =
858+
args ^. #argsAction
859+
fopts =
860+
fromMaybe defFieldOpts $ args ^? cloneTraversal opt . #fieldOpts
861+
stateQr =
862+
fromMaybe Closed $ fopts ^. #fieldOptsQrState
864863
allowCopy =
865-
value ^. #fieldAllowCopy
864+
fopts ^. #fieldOptsAllowCopy
866865
allowTrunc =
867-
maybe False (MS.length input >)
868-
$ opts
869-
^. #viewerOptsTruncateLimit
866+
maybe False (MS.length input >) $ fopts ^. #fieldOptsTruncateLimit
870867
opticTrunc =
871868
opts ^. #viewerOptsTruncateOptic
872-
stateTrunc = fromMaybe Closed $ do
873-
trav <- opticTrunc
874-
st ^? cloneTraversal trav
869+
stateTrunc =
870+
fromMaybe Closed $ fopts ^. #fieldOptsTruncateState
875871
extraWidgets =
876872
( if not allowTrunc
877873
then mempty

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

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -71,10 +71,10 @@ fieldPairViewer args opts pair =
7171
else
7272
[ cell
7373
$ Field.fieldViewer
74-
Field.ViewerArgs
75-
{ Field.viewerArgsModel = args ^. #argsModel,
76-
Field.viewerArgsOptic = to . const $ pair ^. #fieldPairValue,
77-
Field.viewerArgsAction = args ^. #argsAction
74+
Field.Args
75+
{ Field.argsModel = args ^. #argsModel,
76+
Field.argsOptic = constTraversal $ pair ^. #fieldPairValue,
77+
Field.argsAction = args ^. #argsAction
7878
}
7979
opts
8080
]

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ import qualified Material.LayoutGrid as LayoutGrid
1313
import qualified Material.Typography as Typography
1414

1515
headerEditor ::
16-
Field.Args model action DynamicField ->
16+
Field.Args model action DynamicField Unique ->
1717
Field.Opts model action ->
1818
[View action]
1919
headerEditor args opts =

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

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -108,6 +108,8 @@ module Functora.Prelude
108108
nubOrdByNE,
109109
nubOrdOnNE,
110110
enumerateNE,
111+
nextEnum,
112+
prevEnum,
111113
)
112114
where
113115

@@ -976,3 +978,13 @@ nubOrdOnNE f = fromList . nubOrdOn f . toList
976978

977979
enumerateNE :: forall a. (Ord a, Enum a, Bounded a) => NonEmpty a
978980
enumerateNE = nubOrdNE $ minBound :| enumerate @a
981+
982+
nextEnum :: (Eq a, Enum a, Bounded a) => a -> a
983+
nextEnum x
984+
| x == maxBound = minBound
985+
| otherwise = succ x
986+
987+
prevEnum :: (Eq a, Enum a, Bounded a) => a -> a
988+
prevEnum x
989+
| x == minBound = maxBound
990+
| otherwise = pred x

0 commit comments

Comments
 (0)