Switched footer to a navigation bar, and added proper links.

diff --git a/src/Server.hs b/src/Server.hs
index 770b8e7..219be67 100644 (file)
--- a/src/Server.hs
+++ b/src/Server.hs
@@ -1,6 +1,6 @@
 module Server where
 
-import Control.Monad ((<=<))
+import Control.Monad ((<=<), void)
 import Control.Monad.IO.Class (liftIO)
 import CssContentType
 import Lucid
@@ -37,7 +37,7 @@ blogPost :: BlogId -> Handler (Html ())
 blogPost = htmlContainer . renderBlog <=< findBlogPost
 
 findBlogPost :: BlogId -> Handler T.Text
-findBlogPost = liftIO . T.readFile . (<>) staticPath . flip (<>) ".md"
+findBlogPost = liftIO . T.readFile . (<>) staticPath . flip (<>) (T.unpack markdownExtension)
 
 themes :: Server Themes
 themes = darkTheme :<|> lightTheme
@@ -52,25 +52,31 @@ lightTheme = pure mempty
 
 htmlContainer :: Html a -> Handler (Html ())
 htmlContainer contents = do
-  footer <- htmlFooter
-  pure $ with doctypehtml_ [lang_ "en"] $ do
+  nav <- navigation
+  pure $ void $ with doctypehtml_ [lang_ "en"] $ do
     head_ $ do
       title_ $ toHtml siteTitle
       meta_ [charset_ "utf8"]
       meta_ [name_ "description", content_ "width=device-width"]
       link_ [rel_ "stylesheet", href_ "/dark"]
     body_ $ div_ [role_ "main"] $ do
+      nav
       contents
-      footer
 
-htmlFooter :: Handler (Html ())
-htmlFooter = liftIO blogLinks >>= pure . div_ [role_ "footer"] . ul_ [class_ "blog-links"]
+navigation :: Handler (Html ())
+navigation = liftIO blogList >>= pure . div_ [role_ "navigation"] . ul_ [class_ "blog-links"]
 
-blogLinks :: IO (Html ())
-blogLinks = getDirectoryContents staticPath >>= pure . foldMap blogLink
+blogList :: IO (Html ())
+blogList = getDirectoryContents staticPath >>= pure . foldMap blogListItem . filter (T.isSuffixOf markdownExtension) . fmap T.pack
 
-blogLink :: FilePath -> Html ()
-blogLink = li_ [class_ "blog-link"] . toHtml
+blogListItem :: T.Text -> Html ()
+blogListItem path = do
+  case blogLink path of
+    Nothing -> pure $ mempty
+    Just file -> li_ [class_ "blog-link"] $ a_ [href_ file] $ toHtml file
+
+blogLink :: T.Text -> Maybe T.Text
+blogLink = pure . (<>) "/blog/" <=< T.stripSuffix markdownExtension
 
 siteTitle :: T.Text
 siteTitle = "My Site"
@@ -80,3 +86,6 @@ testPage = liftIO getCurrentDirectory >>= pure . T.pack
 
 staticPath :: FilePath
 staticPath = "static/"
+
+markdownExtension :: T.Text
+markdownExtension = ".md"