content: Before we can begin, we need to enable a few language extensions.
  
  > {-# LANGUAGE OverloadedStrings #-}
  
  This extension allows string literals (like `"cheese"`) to represent string-like
  types such as `ByteString` and `Text`. It's not strictly required since you
  could do the same thing using `pack`, for instance. But it's so convenient that
  it's hard to live without.
  
  > {-# LANGUAGE FlexibleContexts #-}
  > {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  
  These are a little harder to explain, so instead I'll explain them when they're
  used.
  
  Now we have to let GHC know that our module is called `Hairy`, not `Main` like
  it would otherwise assume.
  
  > module Hairy where
  
  Imports make up the last bit of the preamble. These are a little overly-specific
  in order to make it easier to see where everything came from. In the real world
  you might import everything from, say, `Web.Scotty.Trans` instead of explicitly
  listing everything you needed from it.
  
  For the most part, you don't have to worry about these imports. If you're
  curious about something later on, come back up here to see where it's imported
  from. Then look it up on Hackage.
  
  > import Control.Monad.IO.Class (MonadIO, liftIO)
  > import Control.Monad.Logger (runNoLoggingT, runStdoutLoggingT)
  > import Control.Monad.Reader (MonadReader, ReaderT, asks, runReaderT)
  > import Control.Monad.Trans.Class (MonadTrans, lift)
  > import Data.Aeson (Value (Null), (.=), object)
  > import Data.Default (def)
  > import qualified Data.Text as T
  > import Data.Text.Encoding (encodeUtf8)
  > import Data.Text.Lazy (Text)
  > import qualified Database.Persist as DB
  > import qualified Database.Persist.Postgresql as DB
  > import Hairy.Models (Task, TaskId, migrateAll)
  > import Network.HTTP.Types.Status (created201, internalServerError500,
  >   notFound404)
  > import Network.Wai (Middleware)
  > import Network.Wai.Handler.Warp (Settings, defaultSettings,
  >   setFdCacheDuration, setPort)
  > import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev)
  > import System.Environment (lookupEnv)
  > import Web.Heroku (parseDatabaseUrl)
  > import Web.Scotty.Trans (ActionT, Options, ScottyT, defaultHandler, delete,
  >   get, json, jsonData, middleware, notFound, param, post, put, scottyOptsT,
  >   settings, showError, status, verbose)
  
  With all that out of the way, we can start on the actual program itself. The
  top-level entry point, `main`, only has three responsibilities: get the current
  configuration, run the database migrations, and run the application with that
  configuration.
  
  > main :: IO ()
  > main = do
  >   c <- getConfig
  >   migrateSchema c
  >   runApplication c
  
  `migrateSchema` is responsible for applying any necessary schema changes to
  the database.
  
  > migrateSchema :: Config -> IO ()
  > migrateSchema c =
  >   liftIO $ flip DB.runSqlPersistMPool (pool c) $ DB.runMigration migrateAll
  
  `migrateAll` comes from `Hairy.Models` and is generated by Persistent using
  Template Haskell.
  
  Getting the current configuration involves reading the environment from the
  system and then setting up the database connection pool. After doing both of
  those, we create a new `Config` value with the environment and pool.
  
  > getConfig :: IO Config
  > getConfig = do
  >   e <- getEnvironment
  >   p <- getPool e
  >   return Config
  >     { environment = e
  >     , pool = p
  >     }
  
  The data type for `Config` is pretty simple. It has two fields: one for the
  environment and one for the database connection pool. We'll define another data
  type for the environment, and we're using Persistent's `ConnectionPool` for the
  database connection pool.
  
  > data Config = Config
  >   { environment :: Environment
  >   , pool :: DB.ConnectionPool
  >   }
  
  We want to read the environment from the `SCOTTY_ENV` environment variable, then
  parse that string as our `Environment` data type and return it. If it doesn't
  parse, we'll just blow up.
  
      $ env SCOTTY_ENV=not-an-environment cabal run
      hairy: Prelude.read: no parse
  
  If we wanted to handle it more gracefully, we could use `Text.Read.readMaybe`.
  
  > getEnvironment :: IO Environment
  > getEnvironment = do
  >   m <- lookupEnv "SCOTTY_ENV"
  >   let e = case m of
  >         Nothing -> Development
  >         Just s -> read s
  >   return e
  
  We could've written this point-free.
  
      getEnvironment :: IO Environment
      getEnvironment = fmap (maybe Development read) (lookupEnv "SCOTTY_ENV")
  
  Now that we've seen how to get the environment, let's see what the possible
  environments are. You could add more environments, like `Staging`, to suite your
  particular needs.
  
  > data Environment
  >   = Development
  >   | Production
  >   | Test
  >   deriving (Eq, Read, Show)
  
  With all the environment stuff out of the way, let's take a look at the database
  connection pool. It will be used by the application to make database queries, so
  it's responsible for configuring the database itself. That means logging,
  connection parameters, and pool size. To start, the top-level function gets the
  connection parameters and pool size, then determines which kind of logging to
  use.
  
  > getPool :: Environment -> IO DB.ConnectionPool
  > getPool e = do
  >   s <- getConnectionString e
  >   let n = getConnectionSize e
  >   case e of
  >     Development -> runStdoutLoggingT (DB.createPostgresqlPool s n)
  >     Production -> runStdoutLoggingT (DB.createPostgresqlPool s n)
  >     Test -> runNoLoggingT (DB.createPostgresqlPool s n)
  
  This function is a little weird. I wish it could be written like this:
  
      getPool :: Environment -> IO DB.ConnectionPool
      getPool e = do
        s <- getConnectionString e
        let n = getConnectionSize e
            p = DB.createPostgresqlPool s n
            t = case e of
              Development -> runStdoutLoggingT
              Production -> runStdoutLoggingT
              Test -> runNoLoggingT
        t p
  
  Unfortunately the type system won't allow it. `runStdoutLoggingT` and
  `runNoLoggingT` work on different monad transformers. `createPostgresqlPool` is
  fine with either of them, but it can't accept both simultaneously.
  
  Just like we looked up the environment through `SCOTTY_ENV`, we're going to look
  up the database connection parameters through `DATABASE_URL`. It's expected to
  look like this: `postgres://user:pass@host:port/db`. If it doesn't look like
  that, we'll blow up.
  
      $ env DATABASE_URL=not-a-database-url cabal run
      hairy: couldn't parse absolute uri
  
  If it's not given at all, we'll fall back to using a hard-coded default based on
  the environment.
  
  > getConnectionString :: Environment -> IO DB.ConnectionString
  > getConnectionString e = do
  >   m <- lookupEnv "DATABASE_URL"
  >   let s = case m of
  >         Nothing -> getDefaultConnectionString e
  >         Just u -> createConnectionString (parseDatabaseUrl u)
  >   return s
  
  These are the default connection parameters per environment.
  
  > getDefaultConnectionString :: Environment -> DB.ConnectionString
  > getDefaultConnectionString Development =
  >   "host=localhost port=5432 user=postgres dbname=hairy_development"
  > getDefaultConnectionString Production =
  >   "host=localhost port=5432 user=postgres dbname=hairy_production"
  > getDefaultConnectionString Test =
  >   "host=localhost port=5432 user=postgres dbname=hairy_test"
  
  This function converts a list of text tuples into a database connection string,
  which is a byte string. It joins each tuple with an equals sign and then joins
  each element in the list with a space.
  
      > createConnectionString [("k1", "v1"), ("k2", "v2")]
      "k1=v1 k2=v2"
  
  This is necessary to convert what `Web.Heroku.parseDatabaseUrl` gives us into
  something that Persistent can understand.
  
  > createConnectionString :: [(T.Text, T.Text)] -> DB.ConnectionString
  > createConnectionString l =
  >   let f (k, v) = T.concat [k, "=", v]
  >   in  encodeUtf8 (T.unwords (map f l))
  
  The last piece of the database puzzle is the size of the connection pool. In the
  real world you'd need to benchmark performance using different sizes to see what
  works best. A good baseline is two times the number of cores. That could be
  expressed here using `GHC.Conc.numCapabilities`, but there's no guarantee that
  the web server and the database server are even running on the same machine.
  
  > getConnectionSize :: Environment -> Int
  > getConnectionSize Development = 1
  > getConnectionSize Production = 8
  > getConnectionSize Test = 1
  
  So we've set up our environment and our database connection. That's enough to
  let us move on to setting up the application itself. All we need to do here is
  get the options for Scotty and set up a runner for reading the configuration.
  
  > runApplication :: Config -> IO ()
  > runApplication c = do
  >   o <- getOptions (environment c)
  
  This takes Scotty's monad `m` and adds the ability to read our custom config `c`
  from it. This is called a monad transformer stack. It allows us to use any monad
  in the stack. So after layering on our config reader monad, we can both deal
  with requests using Scotty's monad and read our config using our monad.
  
  >   let r m = runReaderT (runConfigM m) c
  >       app = application c
  >   scottyOptsT o r app
  
  Next we'll actually define our reader monad. This requires
  `GeneralizedNewtypeDeriving` to easily and efficiently derive instances for our
  type alias. The type signature of `runConfigM` tells us that it adds the ability
  to read `Config` to the `IO` monad, which is the bottom of Scotty's monad
  transformer stack.
  
  > newtype ConfigM a = ConfigM
  >  { runConfigM :: ReaderT Config IO a
  >  } deriving (Applicative, Functor, Monad, MonadIO, MonadReader Config)
  
  Let's circle back and see how we get Scotty's options. The data type exposed
  only has two fields, so there's not a lot for us to do here.
  
  > getOptions :: Environment -> IO Options
  > getOptions e = do
  >   s <- getSettings e
  >   return def
  >     { settings = s
  >     , verbose = case e of
  >       Development -> 1
  >       Production -> 0
  >       Test -> 0
  >     }
  
  I explicitly listed all of the environments here to ensure that I got all of
  them. In the real world you might do something like this instead:
  
      verbose = case e of
        Development -> 1
        _ -> 0
  
  Or, if you're feeling particularly witty:
  
      verbose = fromEnum (e == Development)
  
  Most of the real options are in Wai's settings. The defaults are good for most
  of them, but we want to make two changes. First, we need to remove the file
  cache so that static file changes will be picked up. We only want to do this in
  development since static files should be static in other environments. Then we
  want to use the port in the `PORT` environment variable, if it's available.
  
  > getSettings :: Environment -> IO Settings
  > getSettings e = do
  >   let s = defaultSettings
  
  Here I'm using primes (`'`) to mark altered versions of the settings. There are
  probably better ways to do this type of modification, but this works and is
  straighforward.
  
  >       s' = case e of
  >         Development -> setFdCacheDuration 0 s
  >         Production -> s
  >         Test -> s
  >   m <- getPort
  >   let s'' = case m of
  >         Nothing -> s'
  >         Just p -> setPort p s'
  >   return s''
  
  Finally we need to handle looking up the port. Like our other functions that
  read from environment variables, this one will blow up if you give it something
  it's not expecting.
  
      $ env PORT=not-a-port cabal run
      hairy: Prelude.read: no parse
  
  > getPort :: IO (Maybe Int)
  > getPort = do
  >   m <- lookupEnv "PORT"
  >   let p = case m of
  >         Nothing -> Nothing
  >         Just s -> Just (read s)
  >   return p
  
  The last bit of configuration is to set up our error type. We're going to make
  it an alias for `Text`. You could do something fancier here by enumerating the
  possible error states for your application.
  
      data Error = NotFoundError | ForbiddenError | ...
      instance ScottyError Error where ...
  
  We're alright with the default textual errors, so we don't need anything that
  fancy yet.
  
  > type Error = Text
  
  That wraps up all of the configuration, options, and settings. Everything from
  here on out deals with the application itself.
  
  Our application has several responsibilities. It needs to set up middlewares,
  install a default exception handler, and define routes.
  
  > application :: Config -> ScottyT Error ConfigM ()
  > application c = do
  
  We can set up middlewares and exception handlers. Both of them depend on the
  environment.
  
  >   let e = environment c
  >   middleware (loggingM e)
  >   defaultHandler (defaultH e)
  
  Finally we can do the routing for our application. All we need is the HTTP
  method, the path, and the action to route it to.
  
  >   get "/tasks" getTasksA
  >   post "/tasks" postTasksA
  >   get "/tasks/:id" getTaskA
  >   put "/tasks/:id" putTaskA
  >   delete "/tasks/:id" deleteTaskA
  
  Routes are matched top down, so if nothing else matched we'll render our not
  found action.
  
  >   notFound notFoundA
  
  That's it! As your application grows you'll add more routes and middlewares, but
  the basic structure shouldn't change too much.
  
  Let's take a look at that `runDB` helper we used. It takes a SQL query `q` and
  runs it inside our monad transformer stack. It does this by asking the config
  reader for the database connection pool, then running the query with that pool
  in the IO monad.
  
  > runDB :: (MonadTrans t, MonadIO (t ConfigM)) =>
  >   DB.SqlPersistT IO a -> t ConfigM a
  > runDB q = do
  >   p <- lift (asks pool)
  >   liftIO (DB.runSqlPool q p)
  
  Up next is the logging middleware. In development we want colorful multiline
  logs flushed every request. In production we want plain log lines flushed
  sometimes. In testing we don't want logging at all.
  
  > loggingM :: Environment -> Middleware
  > loggingM Development = logStdoutDev
  > loggingM Production = logStdout
  > loggingM Test = id
  
  Before we define our default exception handler, let's create an alias for our
  Scotty actions. They're all going to have the same type, so we don't want to
  repeat ourselves over and over again.
  
  > type Action = ActionT Error ConfigM ()
  
  Since our default exception handler handles uncaught exceptions in our
  application, we want it print out the exceptions in development but swallow them
  in production (we don't really care what happens to them in testing). In the
  real world you might send the exception to another service.
  
  > defaultH :: Environment -> Error -> Action
  > defaultH e x = do
  >   status internalServerError500
  >   let o = case e of
  >         Development -> object ["error" .= showError x]
  >         Production -> Null
  >         Test -> object ["error" .= showError x]
  >   json o
  
  At long last we can get to the meat of our application: the actions. This is
  where all of your business logic lives. Since Hairy is just a basic CRUD app,
  there's not a lot going on here. This action gets all the tasks from the
  database and renders them as JSON.
  
  > getTasksA :: Action
  > getTasksA = do
  >   ts <- runDB (DB.selectList [] [])
  >   json (ts :: [DB.Entity Task])
  
  This one allows you to create new tasks by posting JSON to it. If the JSON isn't
  valid, an exception will be raised. That means in development you'll get a
  helpful error message, but in production you'll get a blank 500.
  
      $ curl -X POST localhost:3000/tasks -d 'not valid json'
      {"error":"jsonData - no parse: not valid json"}
  
  > postTasksA :: Action
  > postTasksA = do
  >   t <- jsonData
  >   runDB (DB.insert_ t)
  >   status created201
  >   json (t :: Task)
  
  This action gets a task from the database. If it was found, it renders it as
  JSON. If it wasn't, it renders the generic not found action.
  
  > getTaskA :: Action
  > getTaskA = do
  >   i <- param "id"
  >   m <- runDB (DB.get (toKey i))
  >   case m of
  >     Nothing -> notFoundA
  >     Just t -> json (t :: Task)
  
  This one will either update an existing task or create a new one with the given
  ID. Then it renders the task as JSON.
  
  > putTaskA :: Action
  > putTaskA = do
  >   i <- param "id"
  >   t <- jsonData
  >   runDB (DB.repsert (toKey i) t)
  >   json (t :: Task)
  
  This is the last action. It will delete a task with the given ID. If there is no
  such task, it returns 200 anyway. In either case, `null` is returned.
  
  > deleteTaskA :: Action
  > deleteTaskA = do
  >   i <- param "id"
  >   runDB (DB.delete (toKey i :: TaskId))
  >   json Null
  
  That wraps up the business logic. We only have a couple things to attend to. We
  used `toKey`, a helper function that converts a request parameter into a
  database key. It allows us to query for stuff from the database using request
  parameters.
  
  This helper function requires the FlexibleContexts language extension, although
  I can't really tell you why. If you don't have it, GHC complains. If you do have
  it, everything works fine.
  
  > toKey :: DB.ToBackendKey DB.SqlBackend a => Integer -> DB.Key a
  > toKey i = DB.toSqlKey (fromIntegral (i :: Integer))
  
  The last thing we need to do is define our not found action. All it does is set
  the HTTP status to 404 and render `null`.
  
  > notFoundA :: Action
  > notFoundA = do
  >   status notFound404
  >   json Null
  
  That's all there is to it! With less than 200 lines of code we've created a JSON
  REST API with some CRUD actions. It's all backed by a database and can be
  configured to run in development mode on your machine or in production on
  Heroku.
  