added a slug list route
This commit is contained in:
parent
fa66dd0464
commit
08985373c5
2 changed files with 13 additions and 0 deletions
|
@ -35,6 +35,7 @@ import Servant.HTML.Blaze
|
||||||
|
|
||||||
type CommentAPI =
|
type CommentAPI =
|
||||||
"comments" :> Capture "slug" Text :> Get '[HTML] CommentPage
|
"comments" :> Capture "slug" Text :> Get '[HTML] CommentPage
|
||||||
|
:<|> "slugs" :> Get '[JSON] [Slug]
|
||||||
:<|> "comments" :> ReqBody '[JSON, FormUrlEncoded] NewComment :> Post '[JSON] Comment
|
:<|> "comments" :> ReqBody '[JSON, FormUrlEncoded] NewComment :> Post '[JSON] Comment
|
||||||
|
|
||||||
data Conf = Conf { port :: Int }
|
data Conf = Conf { port :: Int }
|
||||||
|
@ -45,11 +46,15 @@ showComments db s = do
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
return CommentPage { url = s, viewTime = now, comments = cs }
|
return CommentPage { url = s, viewTime = now, comments = cs }
|
||||||
|
|
||||||
|
listSlugs :: DB Comments -> Handler [Slug]
|
||||||
|
listSlugs = liftIO . slugs
|
||||||
|
|
||||||
api :: Proxy CommentAPI
|
api :: Proxy CommentAPI
|
||||||
api = Proxy
|
api = Proxy
|
||||||
|
|
||||||
server :: DB Comments -> Server CommentAPI
|
server :: DB Comments -> Server CommentAPI
|
||||||
server db = showComments db
|
server db = showComments db
|
||||||
|
:<|> listSlugs db
|
||||||
:<|> liftIO . createNewComment db
|
:<|> liftIO . createNewComment db
|
||||||
|
|
||||||
app :: DB Comments -> Application
|
app :: DB Comments -> Application
|
||||||
|
|
|
@ -40,6 +40,7 @@ module Aggreact.Comments
|
||||||
-- * Operations
|
-- * Operations
|
||||||
, initDB
|
, initDB
|
||||||
, createNewComment
|
, createNewComment
|
||||||
|
, slugs
|
||||||
, getCommentsBySlug
|
, getCommentsBySlug
|
||||||
, getCommentsByParentId
|
, getCommentsByParentId
|
||||||
) where
|
) where
|
||||||
|
@ -199,6 +200,9 @@ createComment = modify . IxSet.insert
|
||||||
updateComment :: Comment -> Update Comments ()
|
updateComment :: Comment -> Update Comments ()
|
||||||
updateComment comment = modify (IxSet.updateIx (id comment) comment)
|
updateComment comment = modify (IxSet.updateIx (id comment) comment)
|
||||||
|
|
||||||
|
getSlugs :: Query Comments [Slug]
|
||||||
|
getSlugs = (fmap fst . IxSet.groupBy) <$> ask
|
||||||
|
|
||||||
commentById :: Id -> Query Comments (Maybe Comment)
|
commentById :: Id -> Query Comments (Maybe Comment)
|
||||||
commentById cid = do
|
commentById cid = do
|
||||||
comments <- ask
|
comments <- ask
|
||||||
|
@ -219,6 +223,7 @@ $(makeAcidic ''Comments [ 'createComment
|
||||||
, 'commentById
|
, 'commentById
|
||||||
, 'commentsByParentId
|
, 'commentsByParentId
|
||||||
, 'commentsBySlug
|
, 'commentsBySlug
|
||||||
|
, 'getSlugs
|
||||||
])
|
])
|
||||||
|
|
||||||
-- * Operations
|
-- * Operations
|
||||||
|
@ -233,6 +238,9 @@ createNewComment db (NewComment pid s txt uid) = do
|
||||||
Acid.update db (UpdateComment newComment)
|
Acid.update db (UpdateComment newComment)
|
||||||
return newComment
|
return newComment
|
||||||
|
|
||||||
|
slugs :: DB Comments -> IO [Slug]
|
||||||
|
slugs db = Acid.query db GetSlugs
|
||||||
|
|
||||||
getCommentsBySlug :: DB Comments -> Slug -> IO Comments
|
getCommentsBySlug :: DB Comments -> Slug -> IO Comments
|
||||||
getCommentsBySlug db s = Acid.query db (CommentsBySlug s)
|
getCommentsBySlug db s = Acid.query db (CommentsBySlug s)
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue