post "/logout" $ deleteCookie "session" >> redirect "/"
get "/" $ do
- posts <- liftIO $ do
- fps <- listDirectory "posts"
- posts <- catMaybes <$> mapM load fps
- return $ take 5 $ sortOn (Down . postDate) posts
+ posts <- take 5 <$> liftIO loadAll
template "Cool blog" $ sequence (mapMaybe render posts)
get "/posts/:post" $ do
Nothing -> status internalServerError500
Just content -> template (postTitle p) content
+ get "/author/:author" $ do
+ author <- param "author"
+ posts <- filter ((== author) . postAuthor) <$> liftIO loadAll
+ let title = "Posts by " <> author
+ template title $ do
+ h1_ (toHtml title)
+ sequence (mapMaybe render posts)
+
template :: T.Text -> Html a -> ActionM ()
template title content = do
authed <- loggedIn
, postAuthor :: T.Text
} deriving (Read, Show)
+loadAll :: IO [Post]
+loadAll = do
+ fps <- listDirectory "posts"
+ posts <- catMaybes <$> mapM load fps
+ return $ sortOn (Down . postDate) posts
+
load :: String -> IO (Maybe Post)
load name = do
let fp = "posts" </> name
header_ $ do
a_ [href_ (T.toStrict $ linkToPost p)] $
h1_ $ toHtml title
- address_ $ "By " >> toHtml author
+ a_ [href_ (T.toStrict $ "/author/" <> postAuthor p)] $
+ address_ ("By " >> toHtml author)
time_ [datetime_ (T.toStrict $ T.pack (show date))] $ toHtml dateStr
M.render (M.useExtensions extensions doc)
where extensions = [M.ghcSyntaxHighlighter, M.skylighting, M.footnotes]