Skip to content

Commit 2e2fe5d

Browse files
functorafunctora
committed
wip
1 parent 557fcb8 commit 2e2fe5d

File tree

9 files changed

+54
-107
lines changed

9 files changed

+54
-107
lines changed

‎ghcjs/currency-converter/src/App/Misc.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -35,17 +35,17 @@ getConverterAmountOptic ::
3535
TopOrBottom ->
3636
LensLike' f Model (Field Rational Unique)
3737
getConverterAmountOptic = \case
38-
Top -> #modelState . #stDoc . #stDocConv . #stConvTopMoney . #moneyAmount
39-
Bottom -> #modelState . #stDoc . #stDocConv . #stConvBottomMoney . #moneyAmount
38+
Top -> #modelState . #stDoc . #stDocTopMoney . #moneyAmount
39+
Bottom -> #modelState . #stDoc . #stDocBottomMoney . #moneyAmount
4040

4141
getConverterCurrencyOptic ::
4242
( Functor f
4343
) =>
4444
TopOrBottom ->
4545
LensLike' f Model (Currency Unique)
4646
getConverterCurrencyOptic = \case
47-
Top -> #modelState . #stDoc . #stDocConv . #stConvTopMoney . #moneyCurrency
48-
Bottom -> #modelState . #stDoc . #stDocConv . #stConvBottomMoney . #moneyCurrency
47+
Top -> #modelState . #stDoc . #stDocTopMoney . #moneyCurrency
48+
Bottom -> #modelState . #stDoc . #stDocBottomMoney . #moneyCurrency
4949

5050
pushActionQueue :: (MonadIO m) => Model -> ChanItem (Model -> Model) -> m ()
5151
pushActionQueue st =

‎ghcjs/currency-converter/src/App/Types.hs‎

Lines changed: 11 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,6 @@ module App.Types
55
( Model (..),
66
Action (..),
77
St (..),
8-
StConv (..),
98
StDoc (..),
109
StExt (..),
1110
Screen (..),
@@ -67,11 +66,11 @@ data Action
6766
| PushUpdate (JSM (ChanItem (Model -> Model)))
6867

6968
data St f = St
70-
{ stScreen :: Screen,
71-
stDoc :: StDoc f,
69+
{ stKm :: Aes.Km,
7270
stIkm :: Field MisoString f,
73-
stKm :: Aes.Km,
71+
stDoc :: StDoc f,
7472
stPre :: Field DynamicField f,
73+
stScreen :: Screen,
7574
stExt :: Maybe (StExt f)
7675
}
7776
deriving stock (Generic)
@@ -111,38 +110,16 @@ instance FunctorB StExt
111110

112111
instance TraversableB StExt
113112

114-
deriving via
115-
GenericType (StExt Identity)
116-
instance
117-
Binary (StExt Identity)
118-
119-
data StConv f = StConv
120-
{ stConvTopMoney :: Money f,
121-
stConvBottomMoney :: Money f,
122-
stConvTopOrBottom :: TopOrBottom,
123-
stConvCreatedAt :: UTCTime
124-
}
125-
deriving stock (Generic)
126-
127-
deriving stock instance (Hkt f) => Eq (StConv f)
128-
129-
deriving stock instance (Hkt f) => Ord (StConv f)
130-
131-
deriving stock instance (Hkt f) => Show (StConv f)
132-
133-
deriving stock instance (Hkt f) => Data (StConv f)
134-
135-
instance FunctorB StConv
136-
137-
instance TraversableB StConv
138-
139-
deriving via GenericType (StConv Identity) instance Binary (StConv Identity)
113+
deriving via GenericType (StExt Identity) instance Binary (StExt Identity)
140114

141115
data StDoc f = StDoc
142-
{ stDocConv :: StConv f,
116+
{ stDocTopMoney :: Money f,
117+
stDocBottomMoney :: Money f,
118+
stDocTopOrBottom :: TopOrBottom,
143119
stDocPreFavName :: Field MisoString f,
144120
stDocFieldPairs :: [FieldPair DynamicField f],
145-
stDocOnlineOrOffline :: OnlineOrOffline
121+
stDocOnlineOrOffline :: OnlineOrOffline,
122+
stDocCreatedAt :: UTCTime
146123
}
147124
deriving stock (Generic)
148125

@@ -341,12 +318,11 @@ setExtScreenAction :: Screen -> Action
341318
setExtScreenAction sc =
342319
pureUpdate 0 (& #modelState . #stExt . _Just . #stExtScreen .~ sc)
343320

344-
shareLink :: forall a. (From Prelude.Text a) => Screen -> Model -> a
345-
shareLink sc =
321+
shareLink :: forall a. (From Prelude.Text a) => Model -> a
322+
shareLink =
346323
from @Prelude.Text @a
347324
. either impureThrow URI.render
348325
. stUri
349-
. setScreenPure sc
350326

351327
vsn :: MisoString
352328
vsn =

‎ghcjs/currency-converter/src/App/Widgets/Currency.hs‎

Lines changed: 5 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -274,35 +274,30 @@ swapCurrencies =
274274
st
275275
^. #modelState
276276
. #stDoc
277-
. #stDocConv
278-
. #stConvTopMoney
277+
. #stDocTopMoney
279278
. #moneyCurrency
280279
. #currencyOutput
281280
quoteCurrency =
282281
st
283282
^. #modelState
284283
. #stDoc
285-
. #stDocConv
286-
. #stConvBottomMoney
284+
. #stDocBottomMoney
287285
. #moneyCurrency
288286
. #currencyOutput
289287
in st
290288
& #modelState
291289
. #stDoc
292-
. #stDocConv
293-
. #stConvTopMoney
290+
. #stDocTopMoney
294291
. #moneyCurrency
295292
. #currencyOutput
296293
.~ quoteCurrency
297294
& #modelState
298295
. #stDoc
299-
. #stDocConv
300-
. #stConvBottomMoney
296+
. #stDocBottomMoney
301297
. #moneyCurrency
302298
. #currencyOutput
303299
.~ baseCurrency
304300
& #modelState
305301
. #stDoc
306-
. #stDocConv
307-
. #stConvTopOrBottom
302+
. #stDocTopOrBottom
308303
.~ Top

‎ghcjs/currency-converter/src/App/Widgets/Fav.hs‎

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -84,7 +84,7 @@ fav st =
8484
let uri =
8585
either impureThrow id
8686
. URI.mkURI
87-
$ shareLink (nextSt ^. #modelState . #stScreen) nextSt
87+
$ shareLink nextSt
8888
nextFav = do
8989
Fav
9090
{ favUri = uri,
@@ -122,9 +122,9 @@ makeFavName st =
122122
then mempty
123123
else " "
124124
)
125-
<> getCode #stConvTopMoney
125+
<> getCode #stDocTopMoney
126126
<> "/"
127-
<> getCode #stConvBottomMoney
127+
<> getCode #stDocBottomMoney
128128
where
129129
preFavName =
130130
st
@@ -136,7 +136,6 @@ makeFavName st =
136136
st
137137
^. #modelState
138138
. #stDoc
139-
. #stDocConv
140139
. cloneLens optic
141140
. #moneyCurrency
142141
. #currencyOutput

‎ghcjs/currency-converter/src/App/Widgets/Main.hs‎

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -124,8 +124,7 @@ screenWidget st@Model {modelState = St {stScreen = Converter}} =
124124
.~ ( &
125125
#modelState
126126
. #stDoc
127-
. #stDocConv
128-
. #stConvTopOrBottom
127+
. #stDocTopOrBottom
129128
.~ loc
130129
)
131130
& #optsPlaceholder
@@ -170,8 +169,7 @@ screenWidget st@Model {modelState = St {stScreen = Converter}} =
170169
<> ( st
171170
^. #modelState
172171
. #stDoc
173-
. #stDocConv
174-
. #stConvCreatedAt
172+
. #stDocCreatedAt
175173
. to utctDay
176174
. to inspect
177175
)

‎ghcjs/currency-converter/src/App/Widgets/Menu.hs‎

Lines changed: 1 addition & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -100,10 +100,7 @@ menu st =
100100
( IconButton.config
101101
& IconButton.setOnClick
102102
( Misc.copyIntoClipboardAction st
103-
$ shareLink
104-
@MisoString
105-
(st ^. #modelState . #stScreen)
106-
st
103+
$ shareLink @MisoString st
107104
)
108105
& IconButton.setAttributes
109106
[ TopAppBar.actionItem,

‎ghcjs/currency-converter/src/App/Widgets/SwapAmounts.hs‎

Lines changed: 9 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -35,69 +35,60 @@ swapAmounts =
3535
st
3636
^. #modelState
3737
. #stDoc
38-
. #stDocConv
39-
. #stConvTopMoney
38+
. #stDocTopMoney
4039
. #moneyAmount
4140
. #fieldInput
4241
. #uniqueValue
4342
baseOutput =
4443
st
4544
^. #modelState
4645
. #stDoc
47-
. #stDocConv
48-
. #stConvTopMoney
46+
. #stDocTopMoney
4947
. #moneyAmount
5048
. #fieldOutput
5149
quoteInput =
5250
st
5351
^. #modelState
5452
. #stDoc
55-
. #stDocConv
56-
. #stConvBottomMoney
53+
. #stDocBottomMoney
5754
. #moneyAmount
5855
. #fieldInput
5956
. #uniqueValue
6057
quoteOutput =
6158
st
6259
^. #modelState
6360
. #stDoc
64-
. #stDocConv
65-
. #stConvBottomMoney
61+
. #stDocBottomMoney
6662
. #moneyAmount
6763
. #fieldOutput
6864
in st
6965
& #modelState
7066
. #stDoc
71-
. #stDocConv
72-
. #stConvTopMoney
67+
. #stDocTopMoney
7368
. #moneyAmount
7469
. #fieldInput
7570
. #uniqueValue
7671
.~ quoteInput
7772
& #modelState
7873
. #stDoc
79-
. #stDocConv
80-
. #stConvTopMoney
74+
. #stDocTopMoney
8175
. #moneyAmount
8276
. #fieldOutput
8377
.~ quoteOutput
8478
& #modelState
8579
. #stDoc
86-
. #stDocConv
87-
. #stConvBottomMoney
80+
. #stDocBottomMoney
8881
. #moneyAmount
8982
. #fieldInput
9083
. #uniqueValue
9184
.~ baseInput
9285
& #modelState
9386
. #stDoc
94-
. #stDocConv
95-
. #stConvBottomMoney
87+
. #stDocBottomMoney
9688
. #moneyAmount
9789
. #fieldOutput
9890
.~ baseOutput
9991
& #modelState
10092
. #stDoc
101-
. #stDocConv
102-
. #stConvTopOrBottom
93+
. #stDocTopOrBottom
10394
.~ Top

‎ghcjs/currency-converter/src/App/Widgets/Templates.hs‎

Lines changed: 12 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -15,27 +15,19 @@ import qualified Material.Snackbar as Snackbar
1515

1616
newStDoc :: IO (StDoc Unique)
1717
newStDoc = do
18-
conv <- newStConv
19-
pfav <- newTextField mempty
20-
pure
21-
StDoc
22-
{ stDocConv = conv,
23-
stDocPreFavName = pfav,
24-
stDocFieldPairs = mempty,
25-
stDocOnlineOrOffline = Online
26-
}
27-
28-
newStConv :: (MonadThrow m, MonadUnliftIO m) => m (StConv Unique)
29-
newStConv = do
3018
ct <- getCurrentTime
3119
topMoney <- newMoney 1 btc
3220
bottomMoney <- newMoney 0 usd
21+
preFavName <- newTextField mempty
3322
pure
34-
StConv
35-
{ stConvTopMoney = topMoney,
36-
stConvBottomMoney = bottomMoney,
37-
stConvTopOrBottom = Top,
38-
stConvCreatedAt = ct
23+
StDoc
24+
{ stDocTopMoney = topMoney,
25+
stDocBottomMoney = bottomMoney,
26+
stDocTopOrBottom = Top,
27+
stDocPreFavName = preFavName,
28+
stDocFieldPairs = mempty,
29+
stDocOnlineOrOffline = Online,
30+
stDocCreatedAt = ct
3931
}
4032

4133
newModel ::
@@ -126,11 +118,11 @@ newModel webOpts mSt uri = do
126118
modelLoading = True,
127119
modelState =
128120
St
129-
{ stScreen = sc,
130-
stDoc = doc,
121+
{ stKm = km,
131122
stIkm = ikm,
132-
stKm = km,
123+
stDoc = doc,
133124
stPre = pre,
125+
stScreen = sc,
134126
stExt = ext
135127
},
136128
modelMarket = market,

‎ghcjs/currency-converter/src/Main.hs‎

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -179,7 +179,7 @@ updateModel (ChanUpdate prevSt) _ = do
179179
pure $ prevSt & #modelLoading .~ False
180180
)
181181
$ foldlM (\acc updater -> evalModel $ updater acc) prevSt actions
182-
uri <- URI.mkURI $ shareLink (nextSt ^. #modelState . #stScreen) nextSt
182+
uri <- URI.mkURI $ shareLink nextSt
183183
Storage.insertStorage ("current-" <> vsn) uri
184184
if nextSt ^. #modelLoading
185185
then do
@@ -282,7 +282,7 @@ evalModel raw = do
282282
. fmap (^. #currenciesList)
283283
$ getCurrencies (raw ^. #modelWebOpts)
284284
let st = raw & #modelState .~ new & #modelCurrencies .~ curs
285-
let loc = st ^. #modelState . #stDoc . #stDocConv . #stConvTopOrBottom
285+
let loc = st ^. #modelState . #stDoc . #stDocTopOrBottom
286286
let baseLens = getBaseConverterMoneyLens loc
287287
let quoteLens = getQuoteConverterMoneyLens loc
288288
let baseAmtInput =
@@ -344,21 +344,20 @@ evalModel raw = do
344344
.~ unTagged quoteAmt
345345
& #modelState
346346
. #stDoc
347-
. #stDocConv
348-
. #stConvCreatedAt
347+
. #stDocCreatedAt
349348
.~ quoteCreatedAt quote
350349
& #modelOnlineAt
351350
.~ ct
352351

353352
getBaseConverterMoneyLens :: TopOrBottom -> ALens' Model (Money Unique)
354353
getBaseConverterMoneyLens = \case
355-
Top -> #modelState . #stDoc . #stDocConv . #stConvTopMoney
356-
Bottom -> #modelState . #stDoc . #stDocConv . #stConvBottomMoney
354+
Top -> #modelState . #stDoc . #stDocTopMoney
355+
Bottom -> #modelState . #stDoc . #stDocBottomMoney
357356

358357
getQuoteConverterMoneyLens :: TopOrBottom -> ALens' Model (Money Unique)
359358
getQuoteConverterMoneyLens = \case
360-
Top -> #modelState . #stDoc . #stDocConv . #stConvBottomMoney
361-
Bottom -> #modelState . #stDoc . #stDocConv . #stConvTopMoney
359+
Top -> #modelState . #stDoc . #stDocBottomMoney
360+
Bottom -> #modelState . #stDoc . #stDocTopMoney
362361

363362
upToDate :: UTCTime -> UTCTime -> Bool
364363
upToDate lhs rhs =

0 commit comments

Comments
 (0)