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 branch of the Github repo. effects-1 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 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, is an function as well: IO fetchPGInfo IO 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 because all our database functions are functions. liftIO IO 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 . We’ll replace it with the idea of , a wrapper around a tuple. Entity KeyVal 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 . We want to make an instance of for it. We'll gather all the different functionality from the last few articles. SqlPersistT MonadDatabase 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 from our API, we use this function. It will give us back the key and value as a : Entity unEntity 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 for the monad: MonadCache Redis 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 monad. We derive for this type using : SqlPersistT Monad 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 and . The instances are easy though; we'll use the instances for the underlying monads. First, let's define a transformation from an action to our . We need to build out the for this. We'll use the constructor and ignore the info with . MonadDatabase MonadCache SqlPersistT AppMonad ReaderT RedisInfo ReaderT 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 instead of the monad. But Servant is sort’ve hard-coded to use , so what do we do? The answer is we define a “Natural Transformation”. AppMonad Handler Handler 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 which is always a . Let's now define how we convert an action from our “AppMonad” into an as well. We’ll get the result and pass it on as a value. Either Left Either Right 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 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: AppMonad 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 function. We’ll update it so that it takes our natural transformation as an argument. Then we’ll use the function combined with that transformation. This is how Servant knows what monad we want for our handlers: Server enter 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 on top of ? What if we want to mix other monad transformers in? We’ll need new instances of and 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. SqlPersistT Redis MonadDatabase MonadCache 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 for all my Haskell project organization. Check out our free to learn more! Stack Stack mini-course But if you’ve never tried Haskell at all, give it a try! Take a look at our . Getting Started Checklist
