Skip to content

Commit ce8cb77

Browse files
epostepost
committed
console: Routing WIP. #376 
1 parent baac157 commit ce8cb77

File tree

4 files changed

+148
-20
lines changed

4 files changed

+148
-20
lines changed

‎console/package.json‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -25,9 +25,9 @@
2525
"devDependencies": {
2626
"concurrently": "^5.0.2",
2727
"parcel-bundler": "^1.12.4",
28-
"purescript": "^0.13.6",
28+
"purescript": "^0.13.8",
2929
"purescript-psa": "^0.7.3",
30-
"spago": "^0.14"
30+
"spago": "^0.15.2"
3131
},
3232
"dependencies": {
3333
"@statebox/stbx-js": "0.0.31",

‎console/spago.dhall‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,9 @@
99
, "effect"
1010
, "halogen"
1111
, "psci-support"
12+
, "routing"
13+
, "routing-duplex"
14+
, "studio"
1215
]
1316
, packages =
1417
../packages.dhall

‎console/src/Statebox/Console.purs‎

Lines changed: 105 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -2,41 +2,68 @@ module Statebox.Console where
22

33
import Prelude
44
import Data.Either (either)
5+
import Data.Generic.Rep
56
import Data.Lens
67
import Data.Lens.Record (prop)
78
import Data.Symbol (SProxy(..))
89
import Data.Foldable (fold, foldMap)
10+
import Data.Map as Map
11+
import Data.Map (Map)
912
import Data.Maybe (Maybe(..), maybe, fromMaybe)
13+
import Data.Tuple.Nested ((/\))
1014
import Effect.Aff.Class (class MonadAff)
1115
import Effect.Console (log)
1216
import Halogen as H
1317
import Halogen (ComponentHTML)
14-
import Halogen.HTML (HTML, p, text, br, span, div, ul, li, h2, h3, table, tr, th, td)
18+
import Halogen.HTML (HTML, p, text, br, span, div, ul, li, h2, h3, table, tr, th, td, button)
19+
import Halogen.HTML.Events (onClick, onValueInput)
1520
import Halogen.Query.HalogenM (HalogenM)
1621

1722
import Statebox.Console.DAO as DAO
23+
import View.Model (Project(..), ProjectId)
1824

1925
import Stripe as Stripe
2026

2127
import Debug.Trace (spy)
2228

29+
-- TODO
30+
fakeCustomerId = "TODO"
31+
2332
--------------------------------------------------------------------------------
2433

2534
type State =
26-
{ customer :: Maybe Stripe.Customer
35+
{ route :: Route
36+
, customer :: Maybe Stripe.Customer
2737
, paymentMethods :: Array Stripe.PaymentMethod
2838
, subscriptions :: Array Stripe.Subscription
2939
, plans :: Array Stripe.PlanWithExpandedProduct
3040
, accounts :: Array { invoices :: Array Stripe.Invoice
3141
}
3242
, status :: AppStatus
43+
, projects :: Map ProjectId Project
3344
}
3445

3546
_accounts = prop (SProxy :: SProxy "accounts")
3647
_invoices = prop (SProxy :: SProxy "invoices")
3748

3849
--------------------------------------------------------------------------------
3950

51+
data Route
52+
= Home
53+
| Projects
54+
| ProjectR ProjectId
55+
| APIKeys
56+
| Invoices Stripe.CustomerId
57+
| Account
58+
| Subscription
59+
| Plan
60+
61+
derive instance eqRoute :: Eq Route
62+
derive instance ordRoute :: Ord Route
63+
derive instance genericRoute :: Generic Route _
64+
65+
--------------------------------------------------------------------------------
66+
4067
data AppStatus = Ok | ErrorStatus String
4168

4269
derive instance eqAppStatus :: Eq AppStatus
@@ -48,9 +75,12 @@ instance showAppStatus :: Show AppStatus where
4875

4976
type Input = State
5077

51-
data Action = FetchStuff
78+
data Action
79+
= SelectRoute Route
80+
| FetchStuff
5281

53-
data Query a = DoAction Action a
82+
data Query a
83+
= DoAction Action a
5484

5585
type ChildSlots = ()
5686

@@ -66,12 +96,16 @@ mkInitialState :: Input -> State
6696
mkInitialState input = input
6797

6898
handleQuery = case _ of
69-
(DoAction x next) -> do
99+
DoAction x next -> do
70100
handleAction x
71101
pure (Just next)
72102

73103
handleAction :: ∀ m. MonadAff m => Action -> HalogenM State Action ChildSlots Void m Unit
74104
handleAction = case _ of
105+
106+
SelectRoute newRoute -> do
107+
H.modify_ \state -> state { route = newRoute }
108+
75109
FetchStuff -> do
76110
H.liftEffect $ log "handling action FetchStuff..."
77111

@@ -117,19 +151,74 @@ handleAction = case _ of
117151
render :: ∀ m. MonadAff m => State -> ComponentHTML Action ChildSlots m
118152
render state =
119153
div []
120-
[ p [] [ text $ if state.status == Ok then "" else "status: " <> show state.status ]
121-
, h2 [] [ text "Customer" ]
122-
, div [] (maybe [] (pure <<< customerHtml) state.customer)
123-
, h3 [] [ text "Customer's payment methods" ]
124-
, div [] (state.paymentMethods <#> paymentMethodHtml)
125-
, h2 [] [ text "Subscriptions" ]
126-
, div [] (state.subscriptions <#> subscriptionHtml)
127-
, h2 [] [ text "Plans" ]
128-
, div [] (state.plans <#> planWithExpandedProductHtml)
129-
, h2 [] [ text "Invoices" ]
130-
, div [] (state.accounts <#> \account -> invoiceSummaries account.invoices)
154+
[ navMenuHtml state
155+
, contentHtml state
156+
, p [] [ text $ if state.status == Ok then "" else "status: " <> show state.status ]
131157
]
132158

159+
navMenuHtml :: ∀ m. MonadAff m => State -> ComponentHTML Action ChildSlots m
160+
navMenuHtml state =
161+
div []
162+
[ button [ onClick \e -> Just $ SelectRoute $ Home ] [ text "Home" ]
163+
, button [ onClick \e -> Just $ SelectRoute $ Projects ] [ text "Projects" ]
164+
, button [ onClick \e -> Just $ SelectRoute $ Account ] [ text "Billing Accounts" ]
165+
, button [ onClick \e -> Just $ SelectRoute $ APIKeys ] [ text "API Keys" ]
166+
, button [ onClick \e -> Just $ SelectRoute $ Invoices fakeCustomerId ] [ text "Invoices" ]
167+
, button [ onClick \e -> Just $ SelectRoute $ Subscription ] [ text "Subscriptions" ]
168+
, button [ onClick \e -> Just $ SelectRoute $ Plan ] [ text "Plans" ]
169+
]
170+
171+
contentHtml :: ∀ m. MonadAff m => State -> ComponentHTML Action ChildSlots m
172+
contentHtml state = case state.route of
173+
Home ->
174+
div []
175+
[ h2 [] [ text "Statebox Cloud Admin Console" ]
176+
, text "Welcome!"
177+
]
178+
Projects ->
179+
div [] $
180+
[ h2 [] [ text "Projects" ]
181+
, div [] $ Map.toUnfoldable state.projects <#>
182+
(\(projectId /\ project) -> button [ onClick \e -> Just $ SelectRoute $ ProjectR projectId ] [ text project.name ])
183+
]
184+
APIKeys ->
185+
div [] $
186+
[ h2 [] [ text "API keys" ]
187+
, p [] [ text "* Create" ]
188+
, p [] [ text "* Deprecate" ]
189+
, p [] [ text "* Assign to a root" ]
190+
]
191+
ProjectR projectId ->
192+
div []
193+
[ h2 [] [ text $ "Project " <> show projectId ]
194+
, h3 [] [ text $ "API keys" ]
195+
, h3 [] [ text $ "Roots" ]
196+
]
197+
Account ->
198+
div []
199+
[ h2 [] [ text "Customer" ]
200+
, div [] (maybe [] (pure <<< customerHtml) state.customer)
201+
, h3 [] [ text "Customer's payment methods" ]
202+
, div [] (state.paymentMethods <#> paymentMethodHtml)
203+
]
204+
Subscription ->
205+
div []
206+
[ h2 [] [ text "Subscriptions" ]
207+
, div [] (state.subscriptions <#> subscriptionHtml)
208+
]
209+
Invoices x ->
210+
div []
211+
[ h2 [] [ text "Invoices" ]
212+
, div [] (state.accounts <#> \account -> invoiceSummaries account.invoices)
213+
]
214+
Plan ->
215+
div []
216+
[ h2 [] [ text "Plans" ]
217+
, div [] (state.plans <#> planWithExpandedProductHtml)
218+
]
219+
220+
--------------------------------------------------------------------------------
221+
133222
invoiceSummaries :: ∀ m. MonadAff m => Array Stripe.Invoice -> ComponentHTML Action ChildSlots m
134223
invoiceSummaries invoices =
135224
table [] (invoices <#> invoiceSummaryLineHtml)

‎console/src/Statebox/Console/Main.purs‎

Lines changed: 38 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,26 +1,62 @@
11
module Statebox.Console.Main where
22

3-
import Prelude
3+
import Prelude hiding ((/))
4+
import Data.Map as Map
5+
import Data.Map (Map)
46
import Data.Maybe
7+
import Data.Tuple.Nested ((/\))
58
import Effect (Effect)
9+
import Effect.Class (liftEffect)
610
import Halogen as H
711
import Halogen.Aff (awaitBody, runHalogenAff)
812
import Halogen.VDom.Driver (runUI)
13+
import Routing.Duplex (RouteDuplex', path, root, segment, int, optional, param)
14+
import Routing.Duplex.Generic (sum, noArgs)
15+
import Routing.Duplex.Generic.Syntax
16+
import Routing.PushState as Routing.PushState
917

1018
import Statebox.Console as Console
19+
import Statebox.Console (Route(..))
20+
21+
import ExampleData as ExampleData
22+
import View.Model (ProjectId, Project) -- TODO rm, used to define example data
1123

1224
main :: Effect Unit
1325
main = runHalogenAff do
1426
body <- awaitBody
27+
pushStateInterface <- liftEffect Routing.PushState.makeInterface
1528
io <- runUI Console.ui initialState body
1629
_ <- io.query $ H.tell $ Console.DoAction Console.FetchStuff
1730
pure io
1831
where
1932
initialState :: Console.State
20-
initialState = { customer: Nothing
33+
initialState = { route: Home
34+
, customer: Nothing
2135
, paymentMethods: mempty
2236
, subscriptions: mempty
2337
, plans: mempty
2438
, accounts: [ { invoices: mempty } ]
39+
, projects: exampleProjects
40+
-- , projects: [ ExampleData.project1 ]
2541
, status: Console.Ok
2642
}
43+
44+
45+
routesCodex :: RouteDuplex' Route
46+
routesCodex = root $ sum
47+
{ "Home": noArgs
48+
, "ProjectR": "project" / segment
49+
, "Projects": "project" / noArgs
50+
, "APIKeys": "key" / noArgs
51+
, "Account": "account" / noArgs
52+
, "Invoices": "invoices" / segment
53+
, "Subscription": "subscriptions" / noArgs
54+
, "Plan": "plans" / noArgs
55+
}
56+
57+
--------------------------------------------------------------------------------
58+
59+
exampleProjects :: Map ProjectId Project
60+
exampleProjects = Map.fromFoldable
61+
[ "project1" /\ ExampleData.project1
62+
]

0 commit comments

Comments
 (0)