We’ve reached the last chapter of this tutorial. You have seen and used all the aspects of Haskell required to make your own application, arguably more than that. We’ve touched more subjects than the Haskell course I took at university did - a course which apparently only had a 35% pass rate - and getting this far is no easy feat. You should be proud of yourself!

There is more to Haskell of course. There’s a saying: sufficiently advanced Haskell is indistinguishable from black magic. Haskell programmers, myself included, tend to make stuff unnecessarily complicated by using every tool in their arsenal, so Haskell code can look very imposing, but you do not need to use every language feature yourself.

That said, our application isn’t done yet. So let’s put the finishing touches on it.

Adding indexes

So far, our tasks have been unindexed entries in a DB. That needs to change if we want to be able to complete them. First we adapt db/docker-entrypoint-initdb.d/init.sql:

CREATE DATABASE todolists;

\connect todolists

CREATE TABLE todolist_ch8 (
  id SERIAL PRIMARY KEY,
  task TEXT NOT NULL,
  done BOOLEAN NOT NULL
);

INSERT INTO todolist_ch8 (
  task,
  done
)
VALUES
  ( 'create todo list', TRUE ),
  ( 'put todo list in database', TRUE ),
  ( 'invent terror drones', FALSE ),
  ( 'achieve world domination', FALSE );

And don’t forget to stop, rebuild, and run the container.

Next, we need to adapt the definition of our Task type to also hold an index. Indices are stored as 32-bit integers specifically in PostgreSQL, so we will need to use 32-bit integers specifically as well. We import:

import GHC.Int (Int32)

then we change the Task type:

data Task = Task Int32 String TaskStatus

our toHTML function:

toHTML task =
  case task of
    Task taskId description status ->
     -- rest of the function remains unchanged

and the task decoder also needs to decode the new id:

taskDecoder :: Hasql.Decoders.Row Task
taskDecoder = do
  taskId <- Hasql.Decoders.column Hasql.Decoders.int4
  taskDescription <- Hasql.Decoders.column stringDecoder
  taskStatus <- Hasql.Decoders.column taskStatusDecoder
  return $ Task taskId taskDescription taskStatus

We also need to reference the new table we created, so change todolist_ch5 in SQL strings into todolist_ch8.

Receiving input from the frontend

Next we will do some basic routing. First we’ll need to explicitly import the bytestring package:

- bytestring >= 0.10.8.2 && < 0.11

Then for the routing itself:

requestHandler :: Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
requestHandler request respond =
  case Wai.pathInfo request of
    [] -> getPage request respond
    "posttask" : ps -> postTask request respond
    "completetask" : ps -> completeTask request respond
    _ -> respond $ responseLBS status404 [] $ "Could not find " <> Data.ByteString.Lazy.fromStrict ( Wai.rawPathInfo request )

This uses the pathInfo function to get path information as a list of strings, split by /. We then use patters to match on either the empty path ([]), 2 potential heads ("posttask" and "completetask") and use a catch-all pattern (_) to catch any unrecognized path. There are other ways to handle routing that might better suit your use-case of course but this one is nice and simple for our tutorial app.

We will then define placeholder functions to handle each of these paths, the entire src/ServerMain.hs file will look like this (I’ve ignored import changes):

{-# LANGUAGE OverloadedStrings #-}

module ServerMain
    ( startServer
    ) where

import HTML (HTML, toHTML, toHTMLPage)
import TaskDB (Task)
import qualified TaskDB

import qualified Network.Wai.Handler.Warp as Warp (run)
import Network.Wai (Application, Request, Response, ResponseReceived, responseLBS)
import Network.Wai as Wai
import Network.HTTP.Types.Status (status200, status404)
import qualified Data.ByteString.Lazy.UTF8 as UTF8 (fromString)
import qualified Data.ByteString.Lazy

startServer :: IO ()
startServer = do
  Warp.run 8080 requestHandler

requestHandler :: Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
requestHandler request respond =
  case Wai.pathInfo request of
    [] -> getPage request respond
    "posttask" : ps -> postTask request respond
    "completetask" : ps -> completeTask request respond
    _ -> respond $ responseLBS status404 [] $ "Could not find " <> Data.ByteString.Lazy.fromStrict ( Wai.rawPathInfo request )

getPage :: Application
getPage request respond =
  let
    htmlPage taskList = UTF8.fromString $ toHTMLPage taskList
    response tasks = responseLBS status200 [] $ htmlPage tasks
  in
    do
      taskList <- TaskDB.fetchFromDB
      respond $ response taskList

postTask :: Application
postTask request respond =
  do
    respond $ responseLBS status200 [] "Post task"

completeTask :: Application
completeTask request respond =
  do
    respond $ responseLBS status200 [] "Complete task"

We should change the HTML we produce to call these new endpoints. In the getPage function add the following to htmlPage:

  <>  "<form action=\"/posttask\" method=\"POST\">\
      \  <input type=\"text\" name=\"taskdescription\"></input>\
      \  <input type=\"submit\" value=\"Create task\"></input>\
      \</form>"

(the <> symbol is a sort of generic concatenation that works on every Semigroup, not just Strings)

Then we need to handle task creation, we already have the right function to put a task into the database, namely TaskDB.pushTaskToDB. We adapt our postTask function (and add a few imports in the process).

import qualified Data.ByteString.UTF8 as StrictUTF8 (fromString, toString)
import Network.HTTP.Types.URI (parseQuery)

-- [...]

postTask :: Application
postTask request respond =
  let
    getArgs :: IO (Maybe String)
    getArgs = do
      bodyBS <- strictRequestBody request
      case parseQuery $ Data.ByteString.Lazy.toStrict bodyBS of
        [("taskDescription", Just taskDescriptionBS)] ->
          return $ Just $ StrictUTF8.toString taskDescriptionBS
        _ -> return Nothing
  in do
    args <- getArgs
    case args of
      Just taskDescription -> do
        TaskDB.pushTaskToDB taskDescription
        getPage request respond
      Nothing -> do
        respond $ responseLBS status400 [] $ "Bad arguments, must be of the form \"taskDescription=<string>\""

Here’s what’s going on. First we call our getArgs closure, which will start by reading the entire request body in memory. Not generally a good idea, since unrestricted request sizes can lock up the system, but we will roll with it for now. We then convert that to a non-lazy ByteString in order to feed it to parseQuery. Again, not ideal with large strings but meh… we then match only on the pattern we’re interested in, and consider any other pattern an error (return Nothing). Back to the main function, if we managed to correctly parse the request body, we put the result in the DB and re-generate the page. Otherwise, we send an error response.

You should now be able to run your webserver and add tasks to the todo-list.

Completing tasks

Now I have a challenge for you. Try to also implement the completetask endpoint. You will need to edit the HTML generated for tasks, create a new function to update tasks in the database and finally update the completeTask function itself. The SQL code you’ll need is as follows:

UPDATE todolist_ch8
SET done=TRUE
WHERE id=$1;

If you get stuck, you can check the final code for this chapter. There are multiple correct ways of handling this, and I do not claim that mine is the cleanest, so it’s perfectly fine if you deviate from my example code.

Further improvements

So ends our tutorial. If you would like some more practice, there are still several improvements to be made.

• Having bits of HTML strings all over the code is ugly. Why not find some library that handles HTML better? For instance you could use a template library and read in files.
• We might want to serve static content, such as CSS as well, but out routing is rather static. Try to convert it into a path dynamically and serve files from there (beware of security issues).
• Why not keep track of who is sending commands by using cookies? See the Wai documentation about cookies. (medium-hard)
• To parse the request body as a query, we’re converting a lazy ByteString into a strict ByteString, causing a potentially expensive memcopy. Create a parseLazyQuery function that instead reads a lazy ByteString directly. You can use Parsec to help you with parsing, but don’t have to. (hard)
• The site could be a whole lot prettier.

Closing remarks

Over the course of this tutorial you’ve learned about Haskell’s syntax, algebra of types, (covariant) functors, applicatives, monads, contravariant functors, the relation between programming and logic and a bunch of things I’ve probably forgotten. That cannot have been easy. I’ve dedicated many days to writing this tutorial and I’m glad you managed to get all the way to the end. Before we part, there are a few generic tips about programming in Haskell.

• It’s easy to forget to KISS (keep it simple, stupid) in Haskell. Be a little bit wary of this.
• Make your own types. TaskStatus is more descriptive and type-safe than Bool. As is BalanceInDollarCents compared to Int.
• Make impossible state impossible. Sum types open up many possibilities.
• Try to avoid functions that can throw errors or have non-exhaustive patterns. This will allow you to catch potential run-time errors at compile time.
• Be explicit about imports. Use import qualified Foo and import Foo (bar), not import Foo. That way future you won’t have to guess where function names come from.
• Abstract data types are a great way to encapsulate responsibilities.

I intend to post some stand-alone articles about specific features I’ve found useful in the future, but I’ll be taking a break as each article has taken me over a day and I now have other things to take care of. They are also quite advanced subjects so you should get comfortable with Haskell first.