Software extensibility

Loose coupling is useful, among other things, for practical system/software extensibility; or, in other words, tight coupling complicates it. It's the recent investigation of XMPP client implementations (with some of the issues arising because of restrictive APIs) that made me to consider it this time, though the problem is pervasive. XMPP looks like a nice problem example, since there is a small core, and a set of extensions – all specified and sane, with new ones appearing occasionally, but some of them altering some aspects of the core behaviour (e.g., cancelling resource binding on stream resumption). In its implementation, it would be nice to define the core once, and only extend it with separate modules implementing extensions then; likewise with multi-protocol clients that may use it.

Separating a system into smaller reusable tools with defined responsibilities and APIs (applications, libraries, microservices, actors, generic abstractions available in a given language, etc) helps to some extent on its own, but it's far from a complete solution; as plugin and scripting mechanisms, those still depend on (and are restricted by) resulting APIs, and unforeseen uses are complicated without adjusting the core.

Emacs and Prosody are good examples of highly extensible programs. They provide various ways to customise their behaviour, including common functions and configuration by setting variables, but what distinguishes them is that they allow new modules/packages/modes to alter existing control flows (albeit implicitly) by making use of hooks/advices/events, employing event-driven architecture. libpurple does something similar with signals, but to a lesser extent, and still relying on restrictive APIs and conventions.

In the XMPP example, the core flow (as in RFC 6120) is defined in steps, and it would be sufficient for alteration if those steps (or merely RFC sections) were defined as nodes in an alterable control flow graph.

As for implementation, there's a bunch of technologies that may be useful, or have similarities and may be used for inspiration: DRAKON, π-calculus (and other process calculi), perhaps dynamically typed languages, RDF graphs. There is plenty of ways to implement it, but here's a Haskell example (while in would be easier with deptyped languages, and almost trivial in lisp):

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}

import Control.Concurrent.Async
import Data.Proxy
import GHC.TypeLits
import Data.Type.Equality

-- * Core

-- | Labeled events carrying arbitrary data.
type family Event (t :: Symbol)

-- | Labeled handlers accepting certain 'Event's, and optionally
-- producing new ones.
data Handler f t = Handler { handlerLabel :: String
                           , handlerFunction :: Event f -> IO (Maybe (Event t))

instance Show (Handler f t) where
  show h = handlerLabel h

-- | Mapping between two 'Event's, via some 'Handler'.
data Mapping where
  Mapping :: (KnownSymbol f, KnownSymbol t)
          => Proxy f
          -> Proxy t
          -> Handler f t
          -> Mapping

instance Show Mapping where
  show (Mapping f t h) = concat [ symbolVal f, " → "
                                , handlerLabel h, " → ", symbolVal t]

-- | 'Handler' of a fixed 'Event'.
data HandlerOf s where
  HandlerOf :: KnownSymbol t => Proxy t -> Handler s t -> HandlerOf s

-- | A result containing some 'Event'.
data Result where
  Result :: KnownSymbol s => Proxy s -> Maybe (Event s) -> Result

handlers :: KnownSymbol s => Proxy s -> [Mapping] -> [HandlerOf s]
handlers from' [] = []
handlers from' (Mapping from to handler : rest) = case sameSymbol from' from of
  Nothing -> handlers from' rest
  Just Refl -> HandlerOf to handler : handlers from' rest

runHandler :: Event s -> HandlerOf s -> IO (Async Result)
runHandler ev (HandlerOf t h) = async $ do
  r <- handlerFunction h ev
  pure $ Result t r

iter :: [Mapping] -> [Async Result] -> IO [Async Result]
iter m l = do
  (a, ret) <- waitAny l
  new <- case ret of
    Result p (Nothing) -> pure []
    Result p (Just ev) -> mapM (runHandler ev) (handlers p m)
  let old = filter (/= a) l
  pure $ old ++ new

run :: [Mapping] -> [Async Result] -> IO ()
run m [] = pure ()
run m as = do
  as' <- iter m as
  run m as'

-- * Program example

type instance Event "started" = ()
type instance Event "printed value" = ()
type instance Event "printed string" = ()
type instance Event "got string" = String
type instance Event "got string length" = Int

printString :: String -> IO (Maybe ())
printString s = putStrLn s >> pure Nothing

initialMappings :: [Mapping]
initialMappings = [ Mapping
                    (Proxy :: Proxy "started")
                    (Proxy :: Proxy "got string")
                    (Handler "get string" (const $ pure <$> getLine))
                  , Mapping
                    (Proxy :: Proxy "got string")
                    (Proxy :: Proxy "got string length")
                    (Handler "get string length" (pure . pure . length))
                  , Mapping
                    (Proxy :: Proxy "got string length")
                    (Proxy :: Proxy "printed value")
                    (Handler "print value" (\v -> print v >> pure Nothing))
                  , Mapping
                    (Proxy :: Proxy "got string")
                    (Proxy :: Proxy "printed string")
                    (Handler "print string" printString)

type instance Event "reversed" = String

addReverse :: [Mapping] -> [Mapping]
addReverse [] = [Mapping
                 (Proxy :: Proxy "got string")
                 (Proxy :: Proxy "reversed")
                 (Handler "reverse string" (pure . pure . reverse))]
addReverse (x@(Mapping from to h) : xs) =
  case (sameSymbol from (Proxy :: Proxy "got string")) of
    Just Refl ->
      Mapping (Proxy :: Proxy "reversed") to
      (Handler (handlerLabel h) (handlerFunction h))
      : addReverse xs
    _ -> x : addReverse xs

main :: IO ()
main = do
  start <- async $ pure $ Result (Proxy :: Proxy "started") (pure ())
  run (addReverse initialMappings) [start]

-- λ> mapM_ print initialMappings
-- started → get string → got string
-- got string → get string length → got string length
-- got string length → print value → printed value
-- got string → print string → printed string
-- λ> mapM_ print (addReverse initialMappings)
-- started → get string → got string
-- reversed → get string length → got string length
-- got string length → print value → printed value
-- reversed → print string → printed string
-- got string → reverse string → reversed