From: Luke Lau Date: Wed, 10 Oct 2018 22:54:09 +0000 (+0100) Subject: Use semantic HTML X-Git-Url: https://git.lukelau.me/?p=blog.git;a=commitdiff_plain;h=b085109c9741c88408b45f0acfd7ba7659d7abab Use semantic HTML --- diff --git a/Main.hs b/Main.hs index 57edc52..e6f0aae 100644 --- a/Main.hs +++ b/Main.hs @@ -72,11 +72,7 @@ main = do get "/create" $ do authed <- loggedIn if authed - then html $ renderText $ html_ $ do - head_ $ do - title_ "Create" - style - body_ $ do + then template "Create" $ do h1_ "Create a new post" with form_ [action_ "create", method_ "post"] $ do input_ [name_ "title", type_ "text", placeholder_ "Title"] @@ -106,26 +102,11 @@ main = do post "/logout" $ deleteCookie "session" >> redirect "/" get "/" $ do - authed <- loggedIn posts <- liftIO $ do files <- listDirectory "posts" posts <- catMaybes <$> mapM load files return $ take 5 $ sortOn (Down . date) posts - html $ renderText $ html_ $ do - head_ $ style >> title_ "Cool Blog" - body_ $ do - p_ $ a_ [href_ "/"] "Cool Blog" - if authed - then do - a_ [href_ "/create"] "Create a Post" - br_ [] - with form_ [action_ "/logout", method_ "post"] $ - input_ [type_ "submit", value_ "Log Out"] - else with form_ [action_ "/login", method_ "post"] $ do - input_ [name_ "username", placeholder_ "Username", type_ "text"] - input_ [name_ "password", placeholder_ "Password", type_ "password"] - input_ [type_ "submit"] - sequence (mapMaybe render posts) + template "Cool blog" $ sequence (mapMaybe render posts) get "/posts/:post" $ do name <- param "post" @@ -135,14 +116,27 @@ main = do Just post -> case render post of Nothing -> status internalServerError500 - Just content -> + Just content -> template (title post) content + +template :: T.Text -> Html a -> ActionM () +template title content = do + authed <- loggedIn html $ renderText $ html_ $ do - head_ $ style >> title_ "Post" + head_ $ style >> title_ (toHtml title) body_ $ do - p_ $ a_ [href_ "/"] "Home" + term "nav" $ do + a_ [href_ "/"] "🏠 Cool Blog" + if authed + then do + a_ [href_ "/create"] "Create a Post" + with form_ [action_ "/logout", method_ "post", class_ "login-form"] $ + input_ [type_ "submit", value_ "Log Out"] + else with form_ [action_ "/login", method_ "post", class_ "login-form"] $ do + input_ [name_ "username", placeholder_ "Username", type_ "text"] + input_ [name_ "password", placeholder_ "Password", type_ "password"] + input_ [type_ "submit"] content - -style = link_ [Attribute "rel" "stylesheet", Attribute "href" "/style.css"] + where style = link_ [Attribute "rel" "stylesheet", Attribute "href" "/style.css"] data Post = Post { markdown :: T.Text @@ -162,11 +156,12 @@ render p@(Post markdown title date author) = case M.parse (pathToPost p) (T.toStrict markdown) of Left e -> Nothing Right doc -> Just $ - with div_ [id_ (T.toStrict title)] $ do + with article_ [id_ (T.toStrict title)] $ do + header_ $ do with a_ [href_ (T.toStrict $ linkToPost p)] $ h1_ $ toHtml title - i_ $ toHtml $ "By " <> author <> ", " <> dateStr - br_ [] + address_ $ "By " >> toHtml author + with time_ [datetime_ (T.toStrict $ T.pack (show date))] $ toHtml dateStr M.render (M.useExtensions extensions doc) where extensions = [M.ghcSyntaxHighlighter, M.skylighting, M.footnotes] dateStr = T.pack $ formatTime defaultTimeLocale "%a %e %B %Y" date diff --git a/style.css b/style.css index 7813b24..47c4110 100644 --- a/style.css +++ b/style.css @@ -1,5 +1,13 @@ body { font-family: sans-serif; + max-width: 1000px; + margin: 0 auto; + padding: 1em; +} + +.login-form { + display: inline; + float: right; } blockquote {