Post title on homepage

This commit is contained in:
Michael Snoyman 2020-10-19 09:48:18 +03:00
parent 98df84df28
commit 14c4924281
No known key found for this signature in database
GPG Key ID: 907EAE2F42B52046
4 changed files with 32 additions and 23 deletions

View File

@ -10,18 +10,8 @@ module Handler.Blog
import Data.WebsiteContent import Data.WebsiteContent
import Import import Import
import Yesod.AtomFeed (atomLink) import Yesod.AtomFeed (atomLink)
import Yesod.GitRepo (grContent)
import RIO.Time (getCurrentTime) import RIO.Time (getCurrentTime)
getPosts :: Handler (Vector Post)
getPosts = do
now <- getCurrentTime
posts <- getYesod >>= fmap wcPosts . liftIO . grContent . appWebsiteContent
mpreview <- lookupGetParam "preview"
case mpreview of
Just "true" -> return posts
_ -> return $ filter (\p -> postTime p <= now) posts
getAddPreview :: Handler (Route App -> (Route App, [(Text, Text)])) getAddPreview :: Handler (Route App -> (Route App, [(Text, Text)]))
getAddPreview = do getAddPreview = do
mpreview <- lookupGetParam "preview" mpreview <- lookupGetParam "preview"
@ -29,16 +19,6 @@ getAddPreview = do
Just "true" -> return $ \route -> (route, [("preview", "true")]) Just "true" -> return $ \route -> (route, [("preview", "true")])
_ -> return $ \route -> (route, []) _ -> return $ \route -> (route, [])
postYear :: Post -> Year
postYear p =
let (y, _, _) = toGregorian $ utctDay $ postTime p
in fromInteger y
postMonth :: Post -> Month
postMonth p =
let (_, m, _) = toGregorian $ utctDay $ postTime p
in Month m
getBlogHomeR :: Handler () getBlogHomeR :: Handler ()
getBlogHomeR = do getBlogHomeR = do
cacheSeconds 3600 cacheSeconds 3600

View File

@ -39,6 +39,9 @@ getHomeR = track "Handler.Snapshots.getAllSnapshotsR" $ do
let groups = groupUp now' snapshots let groups = groupUp now' snapshots
latestLtsNameWithHoogle <- getLatestLtsNameWithHoogle latestLtsNameWithHoogle <- getLatestLtsNameWithHoogle
latestLtsByGhc <- getLatestLtsByGhc latestLtsByGhc <- getLatestLtsByGhc
mrecentBlog <- headMay <$> getPosts
defaultLayout $ do defaultLayout $ do
setTitle "Stackage Server" setTitle "Stackage Server"
$(widgetFile "home") $(widgetFile "home")

View File

@ -9,13 +9,14 @@ import Settings as Import
import Settings.StaticFiles as Import import Settings.StaticFiles as Import
import Types as Import import Types as Import
import Yesod.Auth as Import import Yesod.Auth as Import
import Data.WebsiteContent as Import (WebsiteContent (..)) import Data.WebsiteContent as Import (WebsiteContent (..), Post (..))
import Data.Text.Read (decimal) import Data.Text.Read (decimal)
import RIO.Time (diffUTCTime) import RIO.Time (diffUTCTime, getCurrentTime)
--import qualified Prometheus as P --import qualified Prometheus as P
import Stackage.Database.Types (ModuleListingInfo(..)) import Stackage.Database.Types (ModuleListingInfo(..))
import Formatting (format) import Formatting (format)
import Formatting.Time (diff) import Formatting.Time (diff)
import Yesod.GitRepo (grContent)
parseLtsPair :: Text -> Maybe (Int, Int) parseLtsPair :: Text -> Maybe (Int, Int)
parseLtsPair t1 = do parseLtsPair t1 = do
@ -72,3 +73,22 @@ dateDiff (UTCTime now' _) target
| otherwise = format (diff True) $ diffUTCTime | otherwise = format (diff True) $ diffUTCTime
(UTCTime target 0) (UTCTime target 0)
(UTCTime now' 0) (UTCTime now' 0)
getPosts :: Handler (Vector Post)
getPosts = do
now <- getCurrentTime
posts <- getYesod >>= fmap wcPosts . liftIO . grContent . appWebsiteContent
mpreview <- lookupGetParam "preview"
case mpreview of
Just "true" -> return posts
_ -> return $ filter (\p -> postTime p <= now) posts
postYear :: Post -> Year
postYear p =
let (y, _, _) = toGregorian $ utctDay $ postTime p
in fromInteger y
postMonth :: Post -> Month
postMonth p =
let (_, m, _) = toGregorian $ utctDay $ postTime p
in Month m

View File

@ -83,7 +83,13 @@
<div .span6> <div .span6>
<h3>News <h3>News
<a href="/blog">Blog $maybe post <- mrecentBlog
<p>
<a href=@{BlogPostR (postYear post) (postMonth post) (postSlug post)}>#{postTitle post}
<p>
<abbr title=#{show $ postTime post}>#{dateDiff now' (utctDay $ postTime post)}
$nothing
<a href="/blog">Blog
<h3>Snapshots <h3>Snapshots
$forall stackages <- groups $forall stackages <- groups
$forall (_, _, uploaded) <- take 1 stackages $forall (_, _, uploaded) <- take 1 stackages