In the last 5 weeks or so, we’ve built a web application exposing a small API. The application is quite narrow, encompassing only a small amount of functionality. But it is still deep, covering several different libraries and techniques.
In these next couple weeks, we’ll look at some architectural considerations. We’ll observe some of the weaknesses of this system, and how we can improve on them. This week will focus on an approach with type classes and monad transformers. In a couple weeks, we’ll consider free monads, and how we can use them.
You can follow along with this code on the effects-1 branch of the Github repo.
Weaknesses
In our current system, there are a lot of different functions like these:
fetchUserPG :: PGInfo -> Int64 -> IO (Maybe User)createUserPG :: PGInfo -> User -> IO Int64cacheUser :: RedisInfo -> Int64 -> User -> IO ()
Now, the parameters do inform us what each function should be accessing. But the functions are still regular IO functions. This means a novice programmer could come in and get the idea that it’s fine to use arbitrary effects. For instance, why not fetch our Postgres information from the Redis function? After all, fetchPGInfo is an IO function as well:
fetchPostgresConnection :: IO PGInfo...
cacheUser :: RedisInfo -> Int64 -> User -> IO ()cacheUser = do pgInfo <- fetchPostgresConnection -- Connect to Postgres instead of Redis :(
Our API also has some uncomfortable lifting in our handler functions. We have to call liftIO because all our database functions are IO functions.
fetchUsersHandler :: PGInfo -> RedisInfo -> Int64 -> Handler UserfetchUsersHandler pgInfo redisInfo uid = do -- liftIO #1 maybeCachedUser <- liftIO $ fetchUserRedis redisInfo uid case maybeCachedUser of Just user -> return user Nothing -> do -- liftIO #2 maybeUser <- liftIO $ fetchUserPG pgInfo uid case maybeUser of -- liftIO #3 Just user -> liftIO (cacheUser redisInfo uid user) >> return user Nothing -> Handler $ (throwE $ err401 { errBody = "Could not find user with that ID" })
At the very least, our connection parameters are explicit here. If we hid them in a Reader, this would introduce even more lifts.
This article will focus on using type classes to restrict how we use effects. With any luck, we’ll also clean up our code a bit and make it easier to test things. But we’ll focus more on testing more next week.
Now, depending on the project size and scope, these weaknesses might not be issues. But it’s definitely a useful exercise to see alternative ways to organize our code.
Defining our Type Classes
Our first step for limiting our effects will be to create two type classes. We’ll have one for our main database, and one for our cache. We’ll try to make these functions agnostic to the underlying database representation. Hence, we’ll change our API to remove the notion of Entity. We’ll replace it with the idea of KeyVal, a wrapper around a tuple.
newtype KeyVal a = KeyVal (Int64, a)
With that, here are the 8 functions we have for accessing our database:
class (Monad m) => MonadDatabase m where fetchUserDB :: Int64 -> m (Maybe User) createUserDB :: User -> m Int64 deleteUserDB :: Int64 -> m () fetchArticleDB :: Int64 -> m (Maybe Article) createArticleDB :: Article -> m Int64 deleteArticleDB :: Int64 -> m () fetchArticlesByAuthor :: Int64 -> m [KeyVal Article] fetchRecentArticles :: m [(KeyVal User, KeyVal Article)]
And then we have three functions for how we interact with our cache:
class (Monad m) => MonadCache m where cacheUser :: Int64 -> User -> m () fetchCachedUser :: Int64 -> m (Maybe User) deleteCachedUser :: Int64 -> m ()
We can now create instances of these type classes for any different monad we want to use. Let’s start by describing implementations for our existing libraries.
Writing Instances
We’ll start with SqlPersistT. We want to make an instance of MonadDatabase for it. We'll gather all the different functionality from the last few articles.
instance (MonadIO m, MonadLogger m) => MonadDatabase (SqlPersistT m) where fetchUserDB uid = get (toSqlKey uid)
createUserDB user = fromSqlKey <$> insert user
deleteUserDB uid = delete (toSqlKey uid :: Key User)
fetchArticleDB aid = ((fmap entityVal) . listToMaybe) <$> (select . from $ \articles -> do where_ (articles ^. ArticleId ==. val (toSqlKey aid)) return articles)
createArticleDB article = fromSqlKey <$> insert article
deleteArticleDB aid = delete (toSqlKey aid :: Key Article)
fetchArticlesByAuthor uid = do entities <- select . from $ \articles -> do where_ (articles ^. ArticleAuthorId ==. val (toSqlKey uid)) return articles return $ unEntity <$> entities
fetchRecentArticles = do tuples <- select . from $ \(users `InnerJoin` articles) -> do on (users ^. UserId ==. articles ^. ArticleAuthorId) orderBy [desc (articles ^. ArticlePublishedTime)] limit 10 return (users, articles) return $ (\(userEntity, articleEntity) -> (unEntity userEntity, unEntity articleEntity)) <$> tuples
Since we’re removing Entity from our API, we use this unEntity function. It will give us back the key and value as a KeyVal:
unEntity :: (ToBackendKey SqlBackend a) => Entity a -> KeyVal aunEntity (Entity id_ val_) = KeyVal (fromSqlKey id_, val_)
Now we’ll do the same with our cache functions. We’ll make an instance of MonadCache for the Redis monad:
instance MonadCache Redis where cacheUser uid user = void $ setex (pack . show $ uid) 3600 (pack . show $ user) fetchCachedUser uid = do result <- get (pack . show $ uid) case result of Right (Just userString) -> return $ Just (read . unpack $ userString) _ -> return Nothing deleteCachedUser uid = void $ del [pack . show $ uid]
And that’s all there is here! Let’s see how we can combine these for easy use within our API.
Making our App Monad
We’d like to describe an “App Monad” that will allow us to access both these functionalities with ease. We’ll make a wrapper around a monad transformer incorporating a Reader for the Redis information and the SqlPersistT monad. We derive Monad for this type using GeneralizedNewtypeDeriving:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
newtype AppMonad a = AppMonad (ReaderT RedisInfo (SqlPersistT (LoggingT IO)) a) deriving (Functor, Applicative, Monad)
Now we’ll want to make instances of MonadDatabase and MonadCache. The instances are easy though; we'll use the instances for the underlying monads. First, let's define a transformation from an SqlPersistT action to our AppMonad. We need to build out the ReaderT RedisInfo for this. We'll use the ReaderT constructor and ignore the info with const.
liftSqlPersistT :: SqlPersistT (LoggingT IO) a -> AppMonad aliftSqlPersistT action = AppMonad $ ReaderT (const action)
We can also define a transformation on Redis actions:
liftRedis :: Redis a -> AppMonad aliftRedis action = do info <- AppMonad ask connection <- liftIO $ connect info liftIO $ runRedis connection action
We’ll apply our underlying instances like so:
instance MonadDatabase AppMonad where fetchUserDB = liftSqlPersistT . fetchUserDB createUserDB = liftSqlPersistT . createUserDB deleteUserDB = liftSqlPersistT . deleteUserDB fetchArticleDB = liftSqlPersistT . fetchArticleDB createArticleDB = liftSqlPersistT . createArticleDB deleteArticleDB = liftSqlPersistT . deleteArticleDB fetchArticlesByAuthor = liftSqlPersistT . fetchArticlesByAuthor fetchRecentArticles = liftSqlPersistT fetchRecentArticles
instance MonadCache AppMonad where cacheUser uid user = liftRedis (cacheUser uid user) fetchCachedUser = liftRedis . fetchCachedUser deleteCachedUser = liftRedis . deleteCachedUser
And that’s it! We have our instances. Now we want to move on and figure out how we’ll actually incorporate this new monad into our API.
Writing a Natural Transformation
We would like to make it so that our handler functions can use AppMonad instead of the Handler monad. But Servant is sort’ve hard-coded to use Handler, so what do we do? The answer is we define a “Natural Transformation”.
I found this term to be a bit like “category”. It seems innocuous but actually refers to something deeply mathematical. But we don’t need to know too much to use it. The type operator (:~>) defines a natural transformation. All we need to make it is a function that takes an action in our monad and converts it into an action in the Handler monad. We'll need to pass our connection information to make this work.
transformAppToHandler :: PGInfo -> RedisInfo -> AppMonad :~> Handler
We’ll start by defining a “handler” that will catch any errors we throw and recast them as Servant errors. In general, you want to list the specific types of exceptions you’ll catch. It’s not a great idea to catch every exception like this. But for this example, we’ll keep it simple:
handler :: SomeException -> IO (Either ServantErr a)handler e = return $ Left $ err500 { errBody = pack (show e)}
Notice this returns an Either which is always a Left. Let's now define how we convert an action from our “AppMonad” into an Either as well. We’ll get the result and pass it on as a Right value.
runAppAction :: Exception e => AppMonad a -> IO (Either e a)runAppAction (AppMonad action) = do result <- runPGAction pgInfo $ runReaderT action redisInfo return $ Right result
And putting it together, here’s our transformation. We catch errors, and then wrap the result up in Handler.
transformAppToHandler :: PGInfo -> RedisInfo -> AppMonad :~> HandlertransformAppToHandler pgInfo redisInfo = NT $ \action -> do result <- liftIO (handleAny handler (runAppAction action)) Handler $ either throwError return result ...
Incorporating the App Monad
All we have to do now is incorporate our new monad into our handlers. First off, let’s change our API to remove Entities:
type FullAPI = "users" :> Capture "userid" Int64 :> Get '[JSON] User :<|> "users" :> ReqBody '[JSON] User :> Post '[JSON] Int64 :<|> "articles" :> Capture "articleid" Int64 :> Get '[JSON] Article :<|> "articles" :> ReqBody '[JSON] Article :> Post '[JSON] Int64 :<|> "articles" :> "author" :> Capture "authorid" Int64 :> Get '[JSON] [KeyVal Article] :<|> "articles" :> "recent" :> Get '[JSON] [(KeyVal User, KeyVal Article)]
We want to update the type of each function. The AppMonad incorporates all the configuration information. So we don’t need to pass connection information explicitly. Instead, we can use constraints on our monad type classes to expose those effects. Here’s what our type signatures look like:
fetchUsersHandler :: (MonadDatabase m, MonadCache m) => Int64 -> m UsercreateUserHandler :: (MonadDatabase m) => User -> m Int64fetchArticleHandler :: (MonadDatabase m) => Int64 -> m ArticlecreateArticleHandler :: (MonadDatabase m)=> Article -> m Int64fetchArticlesByAuthorHandler :: (MonadDatabase m) => Int64 -> m [KeyVal Article]fetchRecentArticlesHandler :: (MonadDatabase m) => m [(KeyVal User, KeyVal Article)]
And now a lot of our functions are simple monadic calls. We don’t even need to use “lift”!
createUserHandler :: (MonadDatabase m) => User -> m Int64createUserHandler = createUserDB
createArticleHandler :: (MonadDatabase m)=> Article -> m Int64createArticleHandler = createArticleDB
fetchArticlesByAuthorHandler :: (MonadDatabase m) => Int64 -> m [KeyVal Article]fetchArticlesByAuthorHandler = fetchArticlesByAuthor
fetchRecentArticlesHandler :: (MonadDatabase m) => m [(KeyVal User, KeyVal Article)]fetchRecentArticlesHandler = fetchRecentArticles
The “fetch” functions are a bit more complicated since we’ll want to do stuff like check the cache first. But again, all our functions are simple monadic calls without using any lifting. Here’s how our fetch handlers look:
fetchUsersHandler :: (MonadDatabase m, MonadCache m) => Int64 -> m UserfetchUsersHandler uid = do maybeCachedUser <- fetchCachedUser uid case maybeCachedUser of Just user -> return user Nothing -> do maybeUser <- fetchUserDB uid case maybeUser of Just user -> cacheUser uid user >> return user Nothing -> error "Could not find user with that ID"
fetchArticleHandler :: (MonadDatabase m) => Int64 -> m ArticlefetchArticleHandler aid = do maybeArticle <- fetchArticleDB aid case maybeArticle of Just article -> return article Nothing -> error "Could not find article with that ID"
And now we’ll change our Server function. We’ll update it so that it takes our natural transformation as an argument. Then we’ll use the enter function combined with that transformation. This is how Servant knows what monad we want for our handlers:
fullAPIServer :: (AppMoand :~> Handler) -> Server FullAPIfullAPIServer naturalTransformation = enter naturalTransformation $ fetchUsersHandler :<|> createUserHandler :<|> fetchArticleHandler :<|> createArticleHandler :<|> fetchArticlesByAuthorHandler :<|> fetchRecentArticlesHandler
runServer :: IO ()runServer = do pgInfo <- fetchPostgresConnection redisInfo <- fetchRedisConnection -- Pass the natural transformation as an argument! run 8000 (serve usersAPI (fullAPIServer (transformAppToHandler pgInfo redisInfo)))
And now we’re done!
Weaknesses with this Approach
Of course, this system is not without it’s weaknesses. In particular, there’s quite a bit of boilerplate. This is especially true if we don’t want to fix the ordering of our monad stack. For instance what if another part of our application puts SqlPersistT on top of Redis? What if we want to mix other monad transformers in? We’ll need new instances of MonadDatabase and MonadCache for that. We'll end up writing a lot more simple definitions. We’ll examine solutions to this weakness in a couple weeks when we look at free monads.
We’ll also need to add new functions to our type classes every time we want to update their functionality. And then we’ll have to update EVERY instance of that typeclass, which can be quite a pain. The more instances we have, the more painful it will be to add new functionality.
Conclusion
So with a few useful tricks, we can come up with code that is a lot cleaner. We employed type classes to great effect to limit how effects appear in our application. By writing instances of these classes for different monads, we can change the behavior of our application. Next week, we’ll see how we can use this behavior to write simpler tests!
When managing an application with this many dependencies you need the right tools. I used Stack for all my Haskell project organization. Check out our free Stack mini-course to learn more!
But if you’ve never tried Haskell at all, give it a try! Take a look at our Getting Started Checklist.