diff --git a/posts/guides/demobot.md b/posts/guides/demobot.md new file mode 100644 index 0000000..31b4893 --- /dev/null +++ b/posts/guides/demobot.md @@ -0,0 +1,148 @@ +--- +title: Functional architecture Pt. 1 +date: 2018-12-25 +--- + + +I'm lucky enough to work with Haskell professionally which gives me some view +to good and maintainable real world architecture. In my opinion, one of the +biggest contributing factors to how your general architecture is defined, is +determined by the base application monad stack you are using. + +Our actual product is mostly in the regular `LoggingT (ReaderT app IO)` base +monad with whatever style you would imagine with that base monad in place. It's +not entirely consistent, but close enough. + +With all the talk about just having `IO`, `ReaderT app IO`, free monads or +tagless final monads, I thought of trying different styles. For this post I'm +focusing on the tagless final since it's most interesting for me right now. + +`IO` + +: The most basic style. This is pretty much only suitable for the most basic +of needs. + +`ReaderT app IO` + +: How we mostly define the base monad. This is a really good way of doing +things, it gives you a lot of leeway on how you can define the rest of your +application. + +`Free monads` + +: Free monads are a way of having a small constrained DSL or monad stack for +defining your application. By constraining the user, you are also reducing the +area for bugs. There is also some possibility for introspection, but usually +this isn't a usable feature. Also since free monad applications need the full +AST, they're quite a bit slower than the other solutions. + +`Tagless final` + +: This is something I'm the least familiar with. If I have understood +correctly, free monads and tagless final are more or less equivalent solutions +in their power, but in tagless final you aren't creating the AST anywhere, +which also means that you aren't paying for it either. + +That out of the way, I had a small project idea for a bot that's easy to +contribute to, difficult to make errors and easy to reason about. The project +is at most a proof-of-concept and most definitely not production quality. +Still, I hope it's complex enough to showcase the architecture. + +The full source code is available [at my git repository](https://git.rauhala.info/MasseR/demobot). + +For the architecture to make sense, let me introduce two different actors: a +*core contributor* that's familiar with Haskell and a *external contributor* +that's familiar with programming, not necessarily with Haskell. + +The repository is split into two parts, the library and the application. + +The library + +: Provides the restricted monad classes (tagless final), extension points and +the core bot main loop. + +The application + +: Provides the implementation for the tagless final type classes, meaning +that the application defines how the networking stack is handled, how database +connectivity is done and so on. It also collects all the extensions for that +specific application. + +The *core contributor* is responsible for maintaining the library as well as +the type class instances for the application type. The *external contributor* +is responsible for maintaining one or multiple extensions that are restricted +in their capability and complexity. + +I'm restricting the capabilities of the monad in the library and extensions, +meaning that I'm not allowing any IO. For example the networking is handled by +a single `MonadNetwork` type class. This is the most complex type class in the +library right now, using type families for defining a specific extension point +for the messages. This could be something like 'event type' for Flowdock +messages or 'source channel' for IRC messages. + +~~~haskell +data Request meta = Request { content :: Text + , meta :: meta } +data Response meta = Response { content :: Text + , meta :: meta } + +class Monad m => MonadNetwork m where + type Meta m :: * + recvMsg :: m (Request (Meta m)) + putMsg :: Response (Meta m) -> m () +~~~ + +Then we have the extension point which is more or less just a `Request -> m (Maybe Response)`. I'm using rank n types here for qualifying the `Meta` +extension point and forcing the allowed type classes to be a subset of the +application monad stack, I don't want extension writers to be able to write +messages to the bot network by themselves. + +~~~haskell +data Extension meta = + Extension { act :: forall m. (meta ~ Meta m, MonadExtension m) => Request meta -> m (Maybe (Response meta)) + , name :: String } +~~~ + +Last part of the library is the main loop, which is basically a free monad +(tagless final) waiting for an interpreter. At least in this POC I find this +style to be really good, it's really simplified, easy to read and hides a lot +of the complexity, while bringing forth the core algorithm. + +~~~haskell +mainLoop :: forall m. (MonadCatch m, MonadBot m) => [Extension (Meta m)] -> m () +mainLoop extensions = forever $ catch go handleFail + where + handleFail :: SomeException -> m () + handleFail e = logError $ tshow e + go :: m () + go = do + msg <- recvMsg + responses <- catMaybes <$> mapM (`act` msg) extensions + mapM_ putMsg responses +~~~ + +Then comes the actual application where we write the effectful interpreters. In +this POC the interpreter is just a `LoggingT IO a` with the semantics of +stdin/stdout. This is the only file where we're actually interacting with the +outside world, everything else is just pure code. + +~~~haskell +instance MonadNetwork AppM where + type Meta AppM = () + recvMsg = Request <$> liftIO T.getLine <*> pure () + putMsg Response{..} = liftIO . T.putStrLn $ content +~~~ + +Writing the extensions was the responsibility of *external contributors* and we +already saw how the actual extension point was defined above. Using these +extension points is really simple and here we see how the implementation is +just a simple `Request -> m (Maybe Response)`. + +~~~haskell +extension :: Extension () +extension = Extension{..} + where + name = "hello world" + act Request{..} | "hello" `T.isPrefixOf` content = return $ Just $ Response "Hello to you" () + | otherwise = return Nothing +~~~