1
1
module Conduit.AppM where
2
2
3
3
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 )
18
13
import Effect.Aff (Aff )
19
14
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
+ }
24
27
25
28
newtype AppM a
26
- = AppM (ReaderT Env Aff a )
29
+ = AppM (ReaderT ( AppInst AppM ) Aff a )
27
30
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
30
33
31
34
derive newtype instance functorAppM :: Functor AppM
32
35
@@ -42,116 +45,84 @@ derive newtype instance monadEffectAppM :: MonadEffect AppM
42
45
43
46
derive newtype instance monadAffAppM :: MonadAff AppM
44
47
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
47
59
48
60
-- | 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
58
70
59
71
-- | 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
74
76
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
87
79
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
100
83
101
84
-- | Article
102
- instance articleApiAppM :: ArticleApi AppM where
85
+ instance monadArticleAppM :: MonadArticle AppM where
103
86
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
106
89
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
109
92
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
112
95
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
117
98
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
127
104
128
105
-- | Comment
129
- instance commentApiAppM :: CommentApi AppM where
106
+ instance monadCommentAppM :: MonadComment AppM where
130
107
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
133
110
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
136
113
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
139
116
140
117
-- | Profile
141
- instance profileApiAppM :: ProfileApi AppM where
118
+ instance monadProfileAppM :: MonadProfile AppM where
142
119
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
152
125
153
126
-- | 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