mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-02-04 15:20:25 +01:00
Post title on homepage
This commit is contained in:
parent
98df84df28
commit
14c4924281
@ -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
|
||||||
|
|||||||
@ -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")
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user