Skip to content

Commit

Permalink
add months endpoint
Browse files Browse the repository at this point in the history
  • Loading branch information
@zachary822
zachary822 committed Nov 24, 2023
1 parent 68724e0 commit 66f02d1
Show file tree
Hide file tree
Showing 2 changed files with 159 additions and 32 deletions.
62 changes: 59 additions & 3 deletions app/Lib/Database.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@

module Lib.Database where

import Control.Concurrent (threadDelay)
import Control.Monad
import Data.Maybe
import Data.Text (Text)
Expand All @@ -24,7 +25,8 @@ getDbInfo uri = fromJust $ do
getPipe :: ReplicaSet -> Username -> Password -> IO Pipe
getPipe rs uname passwd = do
pipe <- primary rs
_ <- access pipe master admin (auth uname passwd)
isAuthed <- access pipe master admin (auth uname passwd)
unless isAuthed (threadDelay 100000) -- wait 100ms if not authed
return pipe

-- pipelines
Expand Down Expand Up @@ -88,6 +90,59 @@ postsTagPipline tag limit offset =
]
]

postsMonthPipline :: (Val v0, Val v1, Val v2, Val v3) => v0 -> v1 -> v2 -> v3 -> [Document]
postsMonthPipline year month limit offset =
[
[ "$facet"
=: [ "data"
=: [
[ "$match"
=: [ "published" =: True
]
]
,
[ "$set"
=: [ "year" =: ["$year" =: ("$updated" :: Text)]
, "month" =: ["$month" =: ("$updated" :: Text)]
]
]
, ["$match" =: ["year" =: year, "month" =: month]]
, ["$sort" =: ["updated" =: (-1 :: Int)]]
, ["$limit" =: limit]
, ["$skip" =: offset]
,
[ "$project"
=: [ "published" =: (0 :: Int)
, "year" =: (0 :: Int)
, "month" =: (0 :: Int)
]
]
]
, "total"
=: [
[ "$match"
=: [ "published" =: True
]
]
,
[ "$set"
=: [ "year" =: ["$year" =: ("$updated" :: Text)]
, "month" =: ["$month" =: ("$updated" :: Text)]
]
]
, ["$match" =: ["year" =: year, "month" =: month]]
, ["$count" =: ("total" :: Text)]
]
]
]
,
[ "$project"
=: [ "data" =: (1 :: Int)
, "total" =: ["$first" =: ("$total.total" :: Text)]
]
]
]

summaryPipeline :: [Document]
summaryPipeline =
[
Expand All @@ -97,8 +152,8 @@ summaryPipeline =
,
[ "$group"
=: [ "_id"
=: [ "year" =: ["$year" =: ("$created" :: Text)]
, "month" =: ["$month" =: ("$created" :: Text)]
=: [ "year" =: ["$year" =: ("$updated" :: Text)]
, "month" =: ["$month" =: ("$updated" :: Text)]
]
, "count" =: ["$sum" =: (1 :: Int)]
]
Expand All @@ -111,6 +166,7 @@ summaryPipeline =
, "count" =: (1 :: Int)
]
]
, ["$sort" =: ["year" =: (-1 :: Int), "month" =: (-1 :: Int), "count" =: (-1 :: Int)]]
]
, "tags"
=: [ ["$match" =: ["published" =: True]]
Expand Down
129 changes: 100 additions & 29 deletions app/Main.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,6 @@ import Data.Time.Format
import Data.Time.Format.ISO8601
import Database.MongoDB
import Database.MongoDB qualified as M
import Debug.Trace
import GHC.Generics
import Lib.Blaze
import Lib.Database
Expand Down Expand Up @@ -56,6 +55,12 @@ isDebug =
Just "1" -> True
_ -> False

isHxRequest :: ActionM Bool
isHxRequest =
header "hx-request" <&> \case
Just "true" -> True
_ -> False

formatLink :: (Monad m) => Inline -> m Inline
formatLink (Link (id_, cls, attrs) content target) = do
return $ Link (id_, cls, ("rel", "noopener noreferrer") : ("target", "_blank") : attrs) content target
Expand Down Expand Up @@ -192,19 +197,29 @@ postHtml p = H.article
" (Updated: "
timeEl (postUpdated p)
")"
H.div H.! [classQQ| my-0 flex gap-1 |] $ do
H.div H.! [classQQ| my-0 flex gap-2 |] $ do
forM_ (postTags p) $ \t -> do
H.div H.! [classQQ| badge badge-neutral |] $ H.toHtml t
H.button
H.! [classQQ| badge badge-neutral |]
H.! hx "target" "#posts"
H.! hx "get" (fromString . T.unpack $ "/posts/tags/" <> t)
$ H.toHtml t
mdToHtml $ postBody p

divider :: Html
divider = H.div H.! A.class_ "divider" $ mempty

isHxRequest :: ActionM Bool
isHxRequest =
header "hx-request" <&> \case
Just "true" -> True
_ -> False
renderPosts :: [Document] -> Html
renderPosts =
sequence_
. intersperse divider
. map (postHtml . fromDocument)

getCurrentPage :: Page -> Integer
getCurrentPage page = pageOffset page `div` pageLimit page + 1

getMaxPage :: (Integral a, Integral b) => a -> Page -> b
getMaxPage total page = ceiling (fromIntegral total / fromIntegral (pageLimit page) :: Double)

main :: IO ()
main = do
Expand Down Expand Up @@ -243,7 +258,7 @@ main = do
head
<$> liftAndCatchIO
( withResource pool $ \p ->
access p slaveOk "blog" $
access p master "blog" $
aggregate
"posts"
( postsPipline
Expand All @@ -255,17 +270,15 @@ main = do

when (null docs) $ raiseStatus status404 "no posts"

let posts = map (postHtml . fromDocument) docs
total :: Integer = M.at "total" result
curr = pageOffset page `div` pageLimit page + 1
totalPage = ceiling (fromIntegral total / fromIntegral (pageLimit page) :: Double)
let total :: Integer = M.at "total" result
curr = getCurrentPage page
maxPage = getMaxPage total page

blazeHtml $ do
sequence_ $
intersperse divider posts
when (totalPage > 1) $
renderPosts docs
when (maxPage > 1) $
H.div H.! [classQQ| join |] $
forM_ [1 .. totalPage] $ \case
forM_ [1 .. maxPage] $ \case
x
| x == curr ->
H.button
Expand All @@ -283,7 +296,7 @@ main = do
head
<$> liftAndCatchIO
( withResource pool $ \p ->
access p slaveOk "blog" $
access p master "blog" $
aggregate
"posts"
summaryPipeline
Expand All @@ -296,10 +309,14 @@ main = do
H.ul $
forM_ (monthly summary) $ \m -> do
H.li $ do
let month@(YearMonth y my) = summaryMonth m

H.a
H.! A.href "#"
H.! hx "target" "#posts"
H.! hx "get" (fromString $ concat ["/posts/months/", show y, "/", show my])
$ do
fromString . show $ summaryMonth m
fromString . show $ month
" ("
fromString . show $ monthCount m
")"
Expand All @@ -325,7 +342,7 @@ main = do
head
<$> liftAndCatchIO
( withResource pool $ \p ->
access p slaveOk "blog" $
access p master "blog" $
aggregate
"posts"
( postsTagPipline
Expand All @@ -338,17 +355,15 @@ main = do

when (null docs) $ raiseStatus status404 "no posts"

let posts = map (postHtml . fromDocument) docs
total :: Integer = M.at "total" result
curr = pageOffset page `div` pageLimit page + 1
totalPage = ceiling (fromIntegral total / fromIntegral (pageLimit page) :: Double)
let total :: Integer = M.at "total" result
curr = getCurrentPage page
maxPage = getMaxPage total page

blazeHtml $ do
sequence_ $
intersperse divider posts
when (totalPage > 1) $
renderPosts docs
when (maxPage > 1) $
H.div H.! [classQQ| join |] $
forM_ [1 .. totalPage] $ \case
forM_ [1 .. maxPage] $ \case
x
| x == curr ->
H.button
Expand All @@ -361,11 +376,67 @@ main = do
"get"
( fromString . T.unpack $
T.concat
[ "/posts/"
[ "/posts/tags/"
, tag
, "?offset="
, T.pack $ show (pred o * pageLimit page)
]
)
H.! hx "target" "#posts"
$ fromString (show o)

get "/posts/months/:year/:month" $ do
year :: Int <- captureParam "year"
month :: Int <- captureParam "month"
page <- getPage

result <-
head
<$> liftAndCatchIO
( withResource pool $ \p ->
access p master "blog" $
aggregate
"posts"
( postsMonthPipline
year
month
(pageLimit page)
(pageOffset page)
)
)

let docs = M.at "data" result

when (null docs) $ raiseStatus status404 "no posts"

let total :: Integer = M.at "total" result
curr = getCurrentPage page
maxPage = getMaxPage total page

blazeHtml $ do
renderPosts docs
when (maxPage > 1) $
H.div H.! [classQQ| join |] $
forM_ [1 .. maxPage] $ \case
x
| x == curr ->
H.button
H.! A.class_ "join-item btn btn-active"
$ H.toHtml (show curr)
o ->
H.button
H.! A.class_ "join-item btn"
H.! hx
"get"
( fromString . T.unpack $
T.concat
[ "/posts/months/"
, T.pack $ show year
, "/"
, T.pack $ show month
, "?offset="
, T.pack $ show (pred o * pageLimit page)
]
)
H.! hx "target" "#posts"
$ fromString (show o)

0 comments on commit 66f02d1

Please sign in to comment.