From: sabadev Date: Fri, 7 May 2021 00:42:15 +0000 (-0400) Subject: Added last modified date to the blog links. X-Git-Url: http://sabadev.xyz:4321/?a=commitdiff_plain;h=1ba6a69b9cfb0f8721fdb37b075ea3722cad0fe4;p=website.git Added last modified date to the blog links. --- diff --git a/package.yaml b/package.yaml index f7da016..37a0fa0 100644 --- a/package.yaml +++ b/package.yaml @@ -27,6 +27,7 @@ dependencies: - cmark == 0.6 - containers == 0.6.2.1 - directory == 1.3.6.0 +- filepath == 1.4.2.1 - http-api-data == 0.4.1.1 - http-media == 0.8.0.0 - lucid == 2.9.12.1 @@ -37,6 +38,7 @@ dependencies: - servant-server == 0.18.2 - tagsoup == 0.14.8 - text == 1.2.4.1 +- time == 1.9.3 - warp == 3.3.14 - with-utf8 == 1.0.2.2 diff --git a/src/Html.hs b/src/Html.hs index a592b93..30a809e 100644 --- a/src/Html.hs +++ b/src/Html.hs @@ -5,13 +5,17 @@ import Control.Exception.Safe (SomeException) import Control.Monad (void) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.IO.Class (MonadIO(..), liftIO) +import Data.Bifunctor (first) import Data.ByteString.Lazy (ByteString(..)) -import Data.List (sort) +import Data.List (sortOn) import Data.Maybe (fromMaybe) +import Data.Time.Clock (UTCTime(..)) +import Data.Time.Format (formatTime, defaultTimeLocale, iso8601DateFormat) import Lucid import Sanitize import Servant -import System.Directory (getDirectoryContents) +import System.Directory (getDirectoryContents, getModificationTime) +import System.FilePath.Posix (()) import qualified Data.Text as T import qualified Data.Text.IO as T @@ -67,11 +71,17 @@ navigation theme = do blogListItems blogList :: (MonadIO m) => Maybe Theme -> m (Html ()) -blogList theme = liftIO $ getDirectoryContents staticPath >>= pure . foldMap (blogListItem theme) . sort . filter (T.isSuffixOf markdownExtension) . fmap T.pack +blogList theme = liftIO $ getDirectoryContents staticPath >>= mapM blogModificationTime . fmap T.unpack . filter (T.isSuffixOf markdownExtension) . fmap T.pack >>= pure . foldMap (blogListItem theme) . sortOn snd . fmap (first T.pack) -blogListItem :: Maybe Theme -> T.Text -> Html () -blogListItem theme (blogLink -> Nothing) = pure $ mempty -blogListItem theme (blogLink -> (Just file)) = li_ [class_ "blog-link"] $ a_ [href_ $ safeBlogLink theme $ T.unpack file] $ toHtml file +blogModificationTime :: (MonadIO m) => FilePath -> m (FilePath, UTCTime) +blogModificationTime filePath = liftIO $ getModificationTime (staticPath filePath) >>= pure . (,) filePath + +blogListItem :: Maybe Theme -> (T.Text, UTCTime) -> Html () +blogListItem theme (first blogLink -> (Nothing, _)) = pure $ mempty +blogListItem theme (first blogLink -> (Just file, time)) = li_ [class_ "blog-link"] $ a_ [href_ $ safeBlogLink theme $ T.unpack file] $ toHtml $ blogNameWithDate file time + +blogNameWithDate :: T.Text -> UTCTime -> T.Text +blogNameWithDate file time = file <> " (last modified: " <> T.pack (formatTime defaultTimeLocale (iso8601DateFormat Nothing) $ utctDay time) <> ")" blogLink :: T.Text -> Maybe T.Text blogLink = T.stripSuffix markdownExtension @@ -94,10 +104,10 @@ siteTitle :: T.Text siteTitle = "Saba's Site" staticPath :: FilePath -staticPath = "static/" +staticPath = "static" imagePath :: FilePath -imagePath = staticPath <> "img/" +imagePath = staticPath "img" markdownExtension :: T.Text markdownExtension = ".md" diff --git a/src/Server.hs b/src/Server.hs index 12404bd..271f3a1 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -9,6 +9,7 @@ import Lucid import RenderBlog (renderBlog) import Servant import StyleSheet +import System.FilePath.Posix (()) import qualified Clay as C import qualified Data.ByteString.Lazy as B import qualified Data.Text as T @@ -30,13 +31,13 @@ blogPost :: Maybe Theme -> BlogId -> Handler (Html ()) blogPost theme blogId = handleAny (blogNotFound theme blogId) $ findBlogPost blogId >>= htmlContainer theme (Just blogId) . renderBlog findBlogPost :: BlogId -> Handler T.Text -findBlogPost = liftIO . T.readFile . (<>) staticPath . flip (<>) (T.unpack markdownExtension) +findBlogPost = liftIO . T.readFile . () staticPath . flip (<>) (T.unpack markdownExtension) changeTheme :: Theme -> BlogId -> Handler (Html ()) changeTheme theme = blogPost (Just theme) imageLink :: ImageId -> Handler B.ByteString -imageLink imageId = handleAny imageNotFound $ liftIO $ B.readFile $ imagePath <> imageId +imageLink imageId = handleAny imageNotFound $ liftIO $ B.readFile $ imagePath imageId styling :: Maybe Theme -> Handler C.Css styling (fromMaybe defaultTheme -> theme) = pure $ getStyleFromTheme (themeType theme) $ C.rgba (themeRed theme) (themeGreen theme) (themeBlue theme) 1