@@ -11,7 +11,7 @@ import Effect.Aff.Class (class MonadAff)
1111import Effect.Console (log )
1212import Halogen as H
1313import Halogen (ComponentHTML )
14- import Halogen.HTML (HTML , p , text , br , div , ul , li , h2 , h3 , table , tr , th , td )
14+ import Halogen.HTML (HTML , p , text , br , span , div , ul , li , h2 , h3 , table , tr , th , td )
1515import Halogen.Query.HalogenM (HalogenM )
1616
1717import Statebox.Console.DAO as DAO
@@ -25,6 +25,8 @@ import Debug.Trace (spy)
2525type State =
2626 { customer :: Maybe Stripe.Customer
2727 , paymentMethods :: Array Stripe.PaymentMethod
28+ , subscriptions :: Array Stripe.Subscription
29+ , plans :: Array Stripe.PlanWithExpandedProduct
2830 , accounts :: Array { invoices :: Array Stripe.Invoice
2931 }
3032 , status :: AppStatus
@@ -87,6 +89,20 @@ handleAction = case _ of
8789 (\x -> H .modify_ $ _ { accounts = [ { invoices: x.data } ] }))
8890 spyM " invoicesEE" $ invoicesEE
8991
92+ -- fetch subscriptions for this customer
93+ subscriptionsEE <- H .liftAff $ DAO .listSubscriptions
94+ subscriptionsEE # either (\e -> H .modify_ $ _ { status = ErrorStatus " Failed to fetch subscriptions." })
95+ (either (\e -> H .modify_ $ _ { status = ErrorStatus " Decoding subscriptions failed." })
96+ (\x -> H .modify_ $ _ { subscriptions = x.data }))
97+ spyM " subscriptionsEE" $ subscriptionsEE
98+
99+ -- fetch plans for this customer
100+ plansEE <- H .liftAff $ DAO .listPlans
101+ plansEE # either (\e -> H .modify_ $ _ { status = ErrorStatus " Failed to fetch plans." })
102+ (either (\e -> H .modify_ $ _ { status = ErrorStatus " Decoding plans failed." })
103+ (\x -> H .modify_ $ _ { plans = x.data }))
104+ spyM " plansEE" $ plansEE
105+
90106 -- fetch the payment methods for this customer
91107 paymentMethodsEE <- H .liftAff $ DAO .listPaymentMethods
92108 paymentMethodsEE # either (\e -> H .modify_ $ _ { status = ErrorStatus " Failed to fetch payment methods." })
@@ -106,6 +122,10 @@ render state =
106122 , div [] (maybe [] (pure <<< customerHtml) state.customer)
107123 , h3 [] [ text " Customer's payment methods" ]
108124 , div [] (state.paymentMethods <#> paymentMethodHtml)
125+ , h2 [] [ text " Subscriptions" ]
126+ , div [] (state.subscriptions <#> subscriptionHtml)
127+ , h2 [] [ text " Plans" ]
128+ , div [] (state.plans <#> planWithExpandedProductHtml)
109129 , h2 [] [ text " Invoices" ]
110130 , div [] (state.accounts <#> \account -> invoiceSummaries account.invoices)
111131 ]
@@ -118,8 +138,7 @@ invoiceSummaries invoices =
118138 invoiceSummaryLineHtml i =
119139 tr [] [ td [] [ text $ i.customer_email ]
120140 , td [] [ text $ i.account_name ]
121- , td [] [ text $ i.currency ]
122- , td [] [ text $ show i.amount_due ]
141+ , td [] [ text $ formatCurrency i.currency i.amount_due ]
123142 ]
124143
125144customerHtml :: ∀ m . MonadAff m => Stripe.Customer -> ComponentHTML Action ChildSlots m
@@ -140,7 +159,7 @@ customerHtml c =
140159 ] <>
141160 foldMap addressRowsHtml c.address <>
142161 [ tr [] [ th [] [ text " balance" ]
143- , td [] [ text $ c.currency <> " " <> show c.balance <> " cents " ]
162+ , td [] [ text $ formatCurrency c.currency c.balance ]
144163 ]
145164 , tr [] [ th [] [ text " tax ids" ]
146165 , td [] [ taxIdsHtml c.tax_ids ]
@@ -171,7 +190,7 @@ paymentMethodHtml pm =
171190billingDetailsHtml :: ∀ m . MonadAff m => Stripe.BillingDetails -> ComponentHTML Action ChildSlots m
172191billingDetailsHtml bd = nameAddressPhoneHtml bd
173192
174- nameAddressPhoneHtml :: ∀ r m . MonadAff m => { | Stripe.NameAddressPhoneRow () } -> ComponentHTML Action ChildSlots m
193+ nameAddressPhoneHtml :: ∀ m . MonadAff m => { | Stripe.NameAddressPhoneRow () } -> ComponentHTML Action ChildSlots m
175194nameAddressPhoneHtml x =
176195 table [] $
177196 [ tr [] [ th [] [ text " name" ]
@@ -222,6 +241,125 @@ cardHtml c =
222241 formatExpiryDate :: Stripe.Card -> String
223242 formatExpiryDate card = show c.exp_month <> " /" <> show c.exp_year
224243
244+ formatCurrency :: Stripe.Currency -> Stripe.Amount -> String
245+ formatCurrency currency amount =
246+ show amount <> " " <> currency <> " cents"
247+
248+ timestampHtml :: ∀ m . MonadAff m => Stripe.Timestamp -> ComponentHTML Action ChildSlots m
249+ timestampHtml ts = text $ show ts
250+
251+ timestampRangeHtml :: ∀ m . MonadAff m => Stripe.Timestamp -> Stripe.Timestamp -> ComponentHTML Action ChildSlots m
252+ timestampRangeHtml start end =
253+ span [] [ timestampHtml start, text " thru " , timestampHtml end ]
254+
255+ subscriptionHtml :: ∀ m . MonadAff m => Stripe.Subscription -> ComponentHTML Action ChildSlots m
256+ subscriptionHtml s =
257+ table []
258+ [ tr [] [ td [] [ text " id" ]
259+ , td [] [ text s.id ]
260+ ]
261+ , tr [] [ td [] [ text " status" ]
262+ , td [] [ text s.status ]
263+ ]
264+ , tr [] [ td [] [ text " quantity" ]
265+ , td [] [ text $ show s.quantity ]
266+ ]
267+ , tr [] [ td [] [ text " start date" ]
268+ , td [] [ timestampHtml s.start_date ]
269+ ]
270+ , tr [] [ td [] [ text " current period" ]
271+ , td [] [ timestampRangeHtml s.current_period_start s.current_period_end ]
272+ ]
273+ , tr [] [ td [] [ text " trial period" ]
274+ , td [] [ timestampRangeHtml s.trial_start s.trial_end ]
275+ ]
276+ , tr [] [ td [] [ text " collection method" ]
277+ , td [] [ text s.collection_method ]
278+ ]
279+ , tr [] [ td [] [ text " live mode" ]
280+ , td [] [ text $ show s.livemode ]
281+ ]
282+ , tr [] [ td [] [ text " items" ]
283+ , td [] (s.items.data <#> subscriptionItemHtml)
284+ ]
285+ ]
286+
287+ subscriptionItemHtml :: ∀ m . MonadAff m => Stripe.SubscriptionItem -> ComponentHTML Action ChildSlots m
288+ subscriptionItemHtml item =
289+ table []
290+ [ tr [] [ td [] [ text " plan" ]
291+ , td [] [ planHtml item.plan ]
292+ ]
293+ , tr [] [ td [] [ text " created" ]
294+ , td [] [ text $ show item.created ]
295+ ]
296+ ]
297+
298+ planHtml :: ∀ m . MonadAff m => Stripe.Plan -> ComponentHTML Action ChildSlots m
299+ planHtml plan =
300+ table []
301+ [ tr [] [ td [] [ text " nickname" ]
302+ , td [] [ text $ fromMaybe " -" plan.nickname ]
303+ ]
304+ , tr [] [ td [] [ text " product id" ]
305+ , td [] [ text plan.product ]
306+ ]
307+ , tr [] [ td [] [ text " created on" ]
308+ , td [] [ timestampHtml plan.created ]
309+ ]
310+ , tr [] [ td [] [ text " amount" ]
311+ , td [] [ text $ formatCurrency plan.currency plan.amount ]
312+ ]
313+ , tr [] [ td [] [ text " billing scheme" ]
314+ , td [] [ text plan.billing_scheme ]
315+ ]
316+ , tr [] [ td [] [ text " interval" ]
317+ , td [] [ text $ plan.interval <> " (" <> show plan.interval_count <> " x)" ]
318+ ]
319+ ]
320+
321+ -- ------------------------------------------------------------------------------
322+
323+ planWithExpandedProductHtml :: ∀ m . MonadAff m => Stripe.PlanWithExpandedProduct -> ComponentHTML Action ChildSlots m
324+ planWithExpandedProductHtml plan =
325+ table []
326+ [ tr [] [ td [] [ text " nickname" ]
327+ , td [] [ text $ fromMaybe " -" plan.nickname ]
328+ ]
329+ , tr [] [ td [] [ text " product" ]
330+ , td [] [ productHtml plan.product ]
331+ ]
332+ , tr [] [ td [] [ text " created on" ]
333+ , td [] [ timestampHtml plan.created ]
334+ ]
335+ , tr [] [ td [] [ text " amount" ]
336+ , td [] [ text $ formatCurrency plan.currency plan.amount ]
337+ ]
338+ , tr [] [ td [] [ text " billing scheme" ]
339+ , td [] [ text plan.billing_scheme ]
340+ ]
341+ , tr [] [ td [] [ text " interval" ]
342+ , td [] [ text $ plan.interval <> " (" <> show plan.interval_count <> " x)" ]
343+ ]
344+ ]
345+
346+ productHtml :: ∀ m . MonadAff m => Stripe.Product -> ComponentHTML Action ChildSlots m
347+ productHtml product =
348+ table []
349+ [ tr [] [ td [] [ text " product id" ]
350+ , td [] [ text product.id ]
351+ ]
352+ , tr [] [ td [] [ text " name" ]
353+ , td [] [ text product.name ]
354+ ]
355+ , tr [] [ td [] [ text " description" ]
356+ , td [] [ text $ fromMaybe " -" product.description ]
357+ ]
358+ , tr [] [ td [] [ text " unit" ]
359+ , td [] [ text $ fromMaybe " -" product.unit_label ]
360+ ]
361+ ]
362+
225363-- ------------------------------------------------------------------------------
226364
227365spyM :: ∀ m a . Applicative m => String -> a -> m Unit
0 commit comments