Skip to content

Commit c5dac56

Browse files
authored
Refactoring AppM (#11)
1 parent a65ea70 commit c5dac56

33 files changed

+975
-685
lines changed

README.md

Lines changed: 3 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -44,29 +44,21 @@ yarn serve
4444

4545
## Noteworthy PureScript Libraries
4646

47-
#### [React Basic](https://github.com/lumihq/purescript-react-basic)
48-
49-
An opinionated set of bindings to the React library, optimizing for the most basic use cases
50-
5147
#### [React Basic Hooks](https://github.com/spicydonuts/purescript-react-basic-hooks)
5248

53-
An implementation of React hooks on top of purescript-react-basic
49+
An implementation of React hooks on top of purescript-react-basic.
5450

5551
#### [React Halo](https://github.com/robertdp/purescript-react-halo)
5652

5753
A Halogen-inspired interface for React.
5854

59-
#### [Wire React](https://github.com/robertdp/purescript-wire-react)
60-
61-
Event/State library for reactive state.
62-
6355
#### [Wire React Router](https://github.com/robertdp/purescript-wire-react-router)
6456

65-
A basic pushstate router for React, with support for asynchronous routing logic. Built using react-basic-hooks and wire.
57+
A basic pushstate router for React, with support for asynchronous routing logic.
6658

6759
#### [Routing Duplex](https://github.com/natefaubion/purescript-routing-duplex)
6860

69-
Unified parsing and printing for routes in PureScript
61+
Unified parsing and printing for routes in PureScript.
7062

7163
#### [Apiary](https://github.com/robertdp/purescript-apiary)
7264

packages.dhall

Lines changed: 3 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -135,22 +135,12 @@ let additions =
135135
}
136136
, react-halo =
137137
{ dependencies =
138-
[ "aff", "free", "freeap", "react-basic-hooks", "refs", "wire" ]
138+
[ "aff", "event", "free", "freeap", "react-basic-hooks", "refs" ]
139139
, repo = "https://github.com/robertdp/purescript-react-halo"
140-
, version = "v1.0.0"
141-
}
142-
, wire =
143-
{ dependencies = [ "aff", "filterable", "refs", "unsafe-reference" ]
144-
, repo = "https://github.com/robertdp/purescript-wire"
145-
, version = "v0.4.2"
146-
}
147-
, wire-react =
148-
{ dependencies = [ "wire", "free", "freet", "react-basic-hooks" ]
149-
, repo = "https://github.com/robertdp/purescript-wire-react"
150-
, version = "v0.0.1"
140+
, version = "v1.2.0"
151141
}
152142
, wire-react-router =
153-
{ dependencies = [ "aff", "indexed-monad", "freet", "profunctor-lenses", "react-basic-hooks", "routing", "wire" ]
143+
{ dependencies = [ "aff", "freet", "indexed-monad", "profunctor-lenses", "react-basic-hooks", "routing" ]
154144
, repo = "https://github.com/robertdp/purescript-wire-react-router"
155145
, version = "v0.2.1"
156146
}

spago.dhall

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
[ "apiary"
44
, "console"
55
, "effect"
6+
, "event"
67
, "foreign-generic"
78
, "heterogeneous"
89
, "js-timers"
@@ -15,8 +16,6 @@
1516
, "routing-duplex"
1617
, "unicode"
1718
, "web-uievents"
18-
, "wire"
19-
, "wire-react"
2019
, "wire-react-router"
2120
]
2221
, packages = ./packages.dhall

src/Conduit/Api/Utils.purs

Lines changed: 6 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -2,21 +2,19 @@ module Conduit.Api.Utils (makeRequest, makeSecureRequest, makeSecureRequest') wh
22

33
import Prelude
44
import Apiary as Apiary
5-
import Conduit.Capability.Routing (class Routing, redirect)
5+
import Conduit.Capability.Auth (class MonadAuth, readAuth)
6+
import Conduit.Capability.Routing (class MonadRouting, redirect)
67
import Conduit.Config as Config
7-
import Conduit.Data.Env (Env)
88
import Conduit.Data.Error (Error(..))
99
import Conduit.Data.Route (Route(..))
10-
import Control.Monad.Reader (class MonadAsk, ask)
1110
import Data.Array as Array
1211
import Data.Bifunctor (lmap)
1312
import Data.Bitraversable (lfor)
1413
import Data.Either (Either(..))
1514
import Data.Maybe (Maybe(..))
1615
import Effect.Aff.Class (class MonadAff, liftAff)
17-
import Effect.Class (class MonadEffect, liftEffect)
16+
import Effect.Class (class MonadEffect)
1817
import Effect.Class.Console as Console
19-
import Wire.React.Atom.Class (read)
2018

2119
makeRequest ::
2220
forall m rep body query path route response.
@@ -35,8 +33,8 @@ makeRequest route path query body = do
3533

3634
makeSecureRequest ::
3735
forall m rep body query path route response.
38-
MonadAsk Env m =>
39-
Routing m =>
36+
MonadAuth m =>
37+
MonadRouting m =>
4038
MonadAff m =>
4139
Apiary.BuildRequest route path query body rep =>
4240
Apiary.DecodeResponse rep response =>
@@ -46,8 +44,7 @@ makeSecureRequest ::
4644
body ->
4745
m (Either Error response)
4846
makeSecureRequest route path query body = do
49-
env <- ask
50-
auth <- liftEffect $ read env.auth.signal
47+
auth <- readAuth
5148
case auth of
5249
Nothing -> do
5350
redirect Register

src/Conduit/AppM.purs

Lines changed: 82 additions & 111 deletions
Original file line numberDiff line numberDiff line change
@@ -1,32 +1,35 @@
11
module Conduit.AppM where
22

33
import Prelude
4-
import Apiary as Apiary
5-
import Conduit.Api.Endpoints as Endpoints
6-
import Conduit.Api.Utils (makeRequest, makeSecureRequest)
7-
import Conduit.Capability.Api (class ArticleApi, class CommentApi, class ProfileApi, class TagApi, class UserApi)
8-
import Conduit.Capability.Routing (class Routing)
9-
import Conduit.Data.Auth (toAuth)
10-
import Conduit.Data.Env (Env)
11-
import Conduit.Data.Error (Error(..))
12-
import Conduit.Data.Route (Route(..))
13-
import Control.Monad.Reader (class MonadAsk, ReaderT, ask, asks, runReaderT)
14-
import Data.Either (Either(..), either)
15-
import Data.Maybe (Maybe(..))
16-
import Data.Symbol (SProxy(..))
17-
import Data.Variant (expand, match)
4+
import Conduit.Capability.Auth (class MonadAuth, AuthInst)
5+
import Conduit.Capability.Resource.Article (class MonadArticle, ArticleInst)
6+
import Conduit.Capability.Resource.Comment (class MonadComment, CommentInst)
7+
import Conduit.Capability.Resource.Profile (class MonadProfile, ProfileInst)
8+
import Conduit.Capability.Resource.Tag (class MonadTag, TagInst)
9+
import Conduit.Capability.Resource.User (class MonadUser, UserInst)
10+
import Conduit.Capability.Routing (class MonadRouting, RoutingInst)
11+
import Control.Monad.Error.Class (class MonadError, class MonadThrow)
12+
import Control.Monad.Reader (ReaderT, asks, runReaderT)
1813
import Effect.Aff (Aff)
1914
import Effect.Aff.Class (class MonadAff)
20-
import Effect.Class (class MonadEffect, liftEffect)
21-
import Record as Record
22-
import Type.Equality (class TypeEquals, from)
23-
import Wire.React.Atom.Class (modify)
15+
import Effect.Class (class MonadEffect)
16+
import Effect.Exception as Exception
17+
18+
type AppInst m
19+
= { auth :: AuthInst m
20+
, routing :: RoutingInst m
21+
, user :: UserInst m
22+
, article :: ArticleInst m
23+
, comment :: CommentInst m
24+
, profile :: ProfileInst m
25+
, tag :: TagInst m
26+
}
2427

2528
newtype AppM a
26-
= AppM (ReaderT Env Aff a)
29+
= AppM (ReaderT (AppInst AppM) Aff a)
2730

28-
runAppM :: Env -> AppM ~> Aff
29-
runAppM env (AppM m) = runReaderT m env
31+
runAppM :: AppInst AppM -> AppM ~> Aff
32+
runAppM inst (AppM go) = runReaderT go inst
3033

3134
derive newtype instance functorAppM :: Functor AppM
3235

@@ -42,116 +45,84 @@ derive newtype instance monadEffectAppM :: MonadEffect AppM
4245

4346
derive newtype instance monadAffAppM :: MonadAff AppM
4447

45-
instance monadAskAppM :: TypeEquals e Env => MonadAsk e AppM where
46-
ask = AppM $ asks from
48+
derive newtype instance monadThrowAppM :: MonadThrow Exception.Error AppM
49+
50+
derive newtype instance monadErrorAppM :: MonadError Exception.Error AppM
51+
52+
-- | Auth
53+
instance monadAuthAppM :: MonadAuth AppM where
54+
readAuth = join $ AppM $ asks _.auth.readAuth
55+
readAuthEvent = join $ AppM $ asks _.auth.readAuthEvent
56+
modifyAuth k = do
57+
f <- AppM $ asks _.auth.modifyAuth
58+
f k
4759

4860
-- | Routing
49-
instance routingAppM :: Routing AppM where
50-
navigate route = ask >>= \{ router } -> liftEffect $ router.navigate route
51-
redirect route = ask >>= \{ router } -> liftEffect $ router.redirect route
52-
logout =
53-
ask
54-
>>= \{ auth, router } ->
55-
liftEffect do
56-
modify auth.signal $ const Nothing
57-
router.redirect Home
61+
instance monadRoutingAppM :: MonadRouting AppM where
62+
readRoute = join $ AppM $ asks _.routing.readRoute
63+
readRoutingEvent = join $ AppM $ asks _.routing.readRoutingEvent
64+
navigate route = do
65+
f <- AppM $ asks _.routing.navigate
66+
f route
67+
redirect route = do
68+
f <- AppM $ asks _.routing.redirect
69+
f route
5870

5971
-- | User
60-
instance userApiAppM :: UserApi AppM where
61-
loginUser credentials = do
62-
res <- makeRequest (Apiary.Route :: Endpoints.LoginUser) Apiary.none Apiary.none { user: credentials }
63-
res
64-
# either
65-
(pure <<< Left)
66-
( match
67-
{ ok:
68-
\{ user: currentUser } -> do
69-
ask >>= \{ auth } -> liftEffect $ modify auth.signal $ const $ toAuth currentUser.token (Just $ Record.delete (SProxy :: _ "token") currentUser)
70-
pure $ Right currentUser
71-
, unprocessableEntity: pure <<< Left <<< UnprocessableEntity <<< _.errors
72-
}
73-
)
72+
instance monadUserAppM :: MonadUser AppM where
73+
loginUser creds = do
74+
f <- AppM $ asks _.user.loginUser
75+
f creds
7476
registerUser user = do
75-
res <- makeRequest (Apiary.Route :: Endpoints.RegisterUser) Apiary.none Apiary.none { user }
76-
res
77-
# either
78-
(pure <<< Left)
79-
( match
80-
{ ok:
81-
\{ user: currentUser } -> do
82-
ask >>= \{ auth } -> liftEffect $ modify auth.signal $ const $ toAuth currentUser.token (Just $ Record.delete (SProxy :: _ "token") currentUser)
83-
pure $ Right currentUser
84-
, unprocessableEntity: pure <<< Left <<< UnprocessableEntity <<< _.errors
85-
}
86-
)
77+
f <- AppM $ asks _.user.registerUser
78+
f user
8779
updateUser user = do
88-
res <- makeSecureRequest (Apiary.Route :: Endpoints.UpdateUser) Apiary.none Apiary.none { user }
89-
res
90-
# either
91-
(pure <<< Left)
92-
( match
93-
{ ok:
94-
\{ user: currentUser } -> do
95-
ask >>= \{ auth } -> liftEffect $ modify auth.signal $ map $ _ { user = Just $ Record.delete (SProxy :: _ "token") currentUser }
96-
pure $ Right currentUser
97-
, unprocessableEntity: pure <<< Left <<< UnprocessableEntity <<< _.errors
98-
}
99-
)
80+
f <- AppM $ asks _.user.updateUser
81+
f user
82+
logoutUser = join $ AppM $ asks _.user.logoutUser
10083

10184
-- | Article
102-
instance articleApiAppM :: ArticleApi AppM where
85+
instance monadArticleAppM :: MonadArticle AppM where
10386
listArticles query = do
104-
res <- makeRequest (Apiary.Route :: Endpoints.ListArticles) Apiary.none query Apiary.none
105-
pure $ res >>= match { ok: Right }
87+
f <- AppM $ asks _.article.listArticles
88+
f query
10689
listFeed query = do
107-
res <- makeSecureRequest (Apiary.Route :: Endpoints.ListFeed) Apiary.none query Apiary.none
108-
pure $ res >>= match { ok: Right }
90+
f <- AppM $ asks _.article.listFeed
91+
f query
10992
getArticle slug = do
110-
res <- makeRequest (Apiary.Route :: Endpoints.GetArticle) { slug } Apiary.none Apiary.none
111-
pure $ res >>= (match { ok: Right <<< _.article, notFound: Left <<< NotFound })
93+
f <- AppM $ asks _.article.getArticle
94+
f slug
11295
submitArticle slug article = do
113-
res <- case slug of
114-
Nothing -> map expand <$> makeSecureRequest (Apiary.Route :: Endpoints.CreateArticle) Apiary.none Apiary.none { article }
115-
Just slug' -> map expand <$> makeSecureRequest (Apiary.Route :: Endpoints.UpdateArticle) { slug: slug' } Apiary.none { article }
116-
pure $ res >>= (match { ok: Right <<< _.article, unprocessableEntity: Left <<< UnprocessableEntity <<< _.errors })
96+
f <- AppM $ asks _.article.submitArticle
97+
f slug article
11798
deleteArticle slug = do
118-
res <- makeSecureRequest (Apiary.Route :: Endpoints.DeleteArticle) { slug } Apiary.none Apiary.none
119-
pure $ res >>= (match { ok: const $ Right unit })
120-
toggleFavorite { slug, favorited } = do
121-
res <-
122-
if favorited then
123-
makeSecureRequest (Apiary.Route :: Endpoints.UnfavoriteArticle) { slug } Apiary.none Apiary.none
124-
else
125-
makeSecureRequest (Apiary.Route :: Endpoints.FavoriteArticle) { slug } Apiary.none Apiary.none
126-
pure $ res >>= match { ok: Right <<< _.article }
99+
f <- AppM $ asks _.article.deleteArticle
100+
f slug
101+
toggleFavorite article = do
102+
f <- AppM $ asks _.article.toggleFavorite
103+
f article
127104

128105
-- | Comment
129-
instance commentApiAppM :: CommentApi AppM where
106+
instance monadCommentAppM :: MonadComment AppM where
130107
listComments slug = do
131-
res <- makeRequest (Apiary.Route :: Endpoints.ListComments) { slug } Apiary.none Apiary.none
132-
pure $ res >>= match { ok: Right <<< _.comments }
108+
f <- AppM $ asks _.comment.listComments
109+
f slug
133110
createComment slug comment = do
134-
res <- makeSecureRequest (Apiary.Route :: Endpoints.CreateComment) { slug } Apiary.none { comment }
135-
pure $ res >>= (match { ok: Right <<< _.comment })
111+
f <- AppM $ asks _.comment.createComment
112+
f slug comment
136113
deleteComment slug id = do
137-
res <- makeSecureRequest (Apiary.Route :: Endpoints.DeleteComment) { slug, id } Apiary.none Apiary.none
138-
pure $ res >>= (match { ok: const $ Right unit })
114+
f <- AppM $ asks _.comment.deleteComment
115+
f slug id
139116

140117
-- | Profile
141-
instance profileApiAppM :: ProfileApi AppM where
118+
instance monadProfileAppM :: MonadProfile AppM where
142119
getProfile username = do
143-
res <- makeRequest (Apiary.Route :: Endpoints.GetProfile) { username } Apiary.none Apiary.none
144-
pure $ res >>= (match { ok: Right <<< _.profile, notFound: Left <<< NotFound })
145-
toggleFollow { username, following } = do
146-
res <-
147-
if following then
148-
makeSecureRequest (Apiary.Route :: Endpoints.UnfollowProfile) { username } Apiary.none Apiary.none
149-
else
150-
makeSecureRequest (Apiary.Route :: Endpoints.FollowProfile) { username } Apiary.none Apiary.none
151-
pure $ res >>= match { ok: Right <<< _.profile }
120+
f <- AppM $ asks _.profile.getProfile
121+
f username
122+
toggleFollow profile = do
123+
f <- AppM $ asks _.profile.toggleFollow
124+
f profile
152125

153126
-- | Tag
154-
instance tagApiAppM :: TagApi AppM where
155-
listTags = do
156-
res <- makeRequest (Apiary.Route :: Endpoints.ListTags) Apiary.none Apiary.none Apiary.none
157-
pure $ res >>= match { ok: Right <<< _.tags }
127+
instance monadTagAppM :: MonadTag AppM where
128+
listTags = join $ AppM $ asks _.tag.listTags

0 commit comments

Comments
 (0)