Skip to content

Commit

Permalink
display posts
Browse files Browse the repository at this point in the history
  • Loading branch information
soupi committed Apr 24, 2022
1 parent d8f9f86 commit e5d3ddf
Showing 1 changed file with 89 additions and 10 deletions.
99 changes: 89 additions & 10 deletions src/Bulletin.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,9 @@ module Bulletin where

import qualified Web.Twain as Twain
import Network.Wai.Handler.Warp (run, Port)
import qualified Data.Text as T
import qualified Data.Time.Clock as C
import qualified Data.Map as M

-- | Entry point. Starts a bulletin-board server at port 3000.
main :: IO ()
Expand All @@ -13,30 +16,35 @@ main = runServer 3000
-- | Run a bulletin-board server at at specific port.
runServer :: Port -> IO ()
runServer port = do
app <- mkApp
putStrLn $ unwords
[ "Running bulletin board app at"
, "http://localhost:" <> show port
, "(ctrl-c to quit)"
]
run port mkApp
run port app

-- ** Application and routing

-- | Bulletin board application description.
mkApp :: Twain.Application
mkApp =
foldr ($)
mkApp :: IO Twain.Application
mkApp = do
dummyPosts <- makeDummyPosts
pure $ foldr ($)
(Twain.notFound $ Twain.send $ Twain.text "Error: not found.")
routes
(routes dummyPosts)

-- | Bulletin board routing.
routes :: [Twain.Middleware]
routes =
routes :: Posts -> [Twain.Middleware]
routes posts =
-- Our main page, which will display all of the bulletins
[ Twain.get "/" $
Twain.send $ Twain.text "not yet implemented"
Twain.send (displayAllPosts posts)

-- A page for a specific post
, Twain.get "/post/:id" $
Twain.send $ Twain.text "not yet implemented"
, Twain.get "/post/:id" $ do
pid <- Twain.param "id"
Twain.send (displayPost pid posts)

-- A page for creating a new post
, Twain.get "/new" $
Expand All @@ -50,3 +58,74 @@ routes =
, Twain.post "/post/:id/delete" $
Twain.send $ Twain.text "not yet implemented"
]

-- ** Business logic

-- | Respond with a list of all posts
displayAllPosts :: Posts -> Twain.Response
displayAllPosts =
Twain.text . T.unlines . map ppPost . M.elems

-- | Respond with a specific post or return 404
displayPost :: Integer -> Posts -> Twain.Response
displayPost pid posts =
case M.lookup pid posts of
Just post ->
Twain.text (ppPost post)

Nothing ->
Twain.raw
Twain.status404
[("Content-Type", "text/plain; charset=utf-8")]
"404 Not found."

-- ** Posts

-- | A mapping from a post id to a post.
type Posts = M.Map Integer Post

-- | A description of a bulletin board post.
data Post
= Post
{ pTime :: C.UTCTime
, pAuthor :: T.Text
, pTitle :: T.Text
, pContent :: T.Text
}

-- | Create an initial posts Map with a dummy post.
makeDummyPosts :: IO Posts
makeDummyPosts = do
time <- C.getCurrentTime
pure $
M.singleton
0
( Post
{ pTime = time
, pTitle = "Dummy title"
, pAuthor = "Dummy author"
, pContent = "bla bla bla..."
}
)

-- | Prettyprint a post to text.
ppPost :: Post -> T.Text
ppPost post =
let
header =
T.unwords
[ "[" <> T.pack (show (pTime post)) <> "]"
, pTitle post
, "by"
, pAuthor post
]
seperator =
T.replicate (T.length header) "-"
in
T.unlines
[ seperator
, header
, seperator
, pContent post
, seperator
]

0 comments on commit e5d3ddf

Please sign in to comment.