Monday, October 18, 2010

Domain Modeling in Haskell - Combinators for Composition

In my last post I had started sharing my explorations of the Haskell land in a simple domain modeling exercise. I find this a very fruitful way of learning a new language. Try something meaningful and don't feel shy to share with the community. I got some good feedback from Steven and immediately jumped on to improve the quality of the code.

In this post I will enhance and improve upon the earlier model. The focus will once again be on understanding the compositional capabilities that Haskell offers. Eric Evans in his book on domain driven design talks about supple design of the domain model. He mentions the qualities that make a design supple when "the client developer can flexibly use a minimal set of loosely coupled concepts to express a range of scenarios in the domain". I think the meat of this statement is composability. When we have a minimal set of well designed abstractions, we can make them compose in various ways to implement the functionalities that our domain needs to implement.

Combinators for business rules

Combinators are a great way to compose abstractions. If your language supports higher order functions you can compose pure functions to build up larger abstractions out of smaller ones. Concatenative languages offer the best of combinator based designs. With an applicative language Haskell is as good as it gets. I will try to enrich our earlier domain model with combinators that make domain logic explicit abstracting most of the accidental complexities off into the implementation layers.

Consider the function forTrade in my last post. It returns the list of tax/fee ids that need to be charged for the current trade. We had a stub implementation last time where it was returning the same set of tax/fee ids for every trade. Let's improve upon this and make the function return a different set of tax/fees depending upon the market of operation. Say we have a Market data type as ..

data Market = HongKong | Singapore | NewYork | Tokyo | Any deriving (Show, Eq)


where Any is a placeholder for a generic market. We will use it as a wild card in business rules to hold all rules applicable for any market. As for example taxFeeForMarket is an association list that keeps track of the tax/fee ids for every market. The one with Any in the market field specifies the generic tax/fees applicable for every market. For Singapore market we have a specialization of the rule and hence we have a separate entry for it. Let's see how we can implement a forTrade that gives us the appropriate set of tax/fee ids depending on the market where the trade is executed.

taxFeeForMarket = [(Any, [TradeTax, Commission]), (Singapore, [TradeTax, Commission, VAT])]

-- tax and fees applicable for a trade
forTrade :: Trade -> (Trade, Maybe [TaxFeeId])
forTrade trade =
  let list = lookup (market trade) taxFeeForMarket `mplus` lookup Any taxFeeForMarket
  in (trade, list)

We use a combinator mplus which is provided by the typeclass MonadPlus in Control.Monad ..

class Monad m => MonadPlus m where
  mzero :: m a
  mplus :: m a -> m a -> ma


mzero gives a zero definition for MonadPlus while mplus gives an additive semantics of the abstraction. It's also true that mzero and mplus of MonadPlus form a Monoid and there are some significant overlaps between the two definitions. But that's another story for another day. In our modeling exercise, we use the instance of MonadPlus for Maybe, which is defined as:

instance MonadPlus Maybe where
  mzero = Nothing
  
  Nothing `mplus` ys = ys
  xs `mplus` _  = xs


As you will see shortly how using mplus for Maybe nicely abstracts the business rule for tax/fee determination that we are modeling.

In the context of our tax/fee id determination logic, the combinator mplus fetches the set of tax/fees by a lookup from the specific to the generic pairs. It first looks up the entry, if any, for the specific market. If it finds one, it stops the search then and there and returns the list. Or else it goes into the second lookup and fetches the generic list. All the detailed logic of this path in which the lookup is made is encapsulated within the combinator mplus. Look how succinct the expression is, yet it reveals all the intentions that the business rule demands.

Implementing the Bounded Context

When we design a system we need to have the context map clearly defined. The primary model is the one which we are implementing. This model will collaborate with many other models or external systems. As a well-behaved modeler we need to have the interfaces well defined with all inter-module communications published beforehand.

The domain model will interact with external world from where it's going to get many of the data that it will process. Remember we defined the Trade data type in the last post. It was defined as a Haskell data type and was used all over our implementation. It is an implementation artifact which we need to localize within our impelmentation context only.

Trade data is going to come from external systems, may be over the Web as a list of key/value pairs. Hence we need to have an adaptor data structure, generic enough to supply our domain model the various fields of a security trade.

We use an association list - a list of key/value pairs for this. But how do we prepare a Trade data type from this list, without making the code base filled with boilerplatey stuff ?

Remember that a valid trade has to contain all of these fields. The moment we fail to get any of them, we need to mark the trade construction invalid and return a null trade. Null ? We know that the invention of nulls have been declared a billion dollar mistake by none other than the inventor himself.

Here we will use a monad in Haskell - the Maybe. Our constructor function will take an association list and return a Maybe Trade. Every lookup in the association list will return a Maybe String. We need to lift the String from it into the Trade data constructor. This is a monadic lift and we use two combinators liftM and ap for doing this. The moment one lookup fails, the function makeTrade returns a Nothing without proceeding with further lookups. All these details are encapsulated within these combinators, which make the following code expressive and without much of an accidental complexity.

makeTrade :: [(String, Maybe String)] -> Maybe Trade
makeTrade alist =
    Trade `liftM` lookup1 "account"                      alist
             `ap` lookup1 "instrument"                   alist
             `ap` (read `liftM` (lookup1 "market"        alist))
             `ap` lookup1 "ref_no"                       alist
             `ap` (read `liftM` (lookup1 "unit_price"    alist))
             `ap` (read `liftM` (lookup1 "quantity"      alist))

lookup1 key alist = case lookup key alist of
                      Just (Just s@(_:_)) -> Just s
                      _ -> Nothing


Now we have defined an external interface of how trades will be constructed with data coming from other modules. The domain model is thus protected through this insulation layer preventing our internal implementation from leaking out. As I mentioned earlier, the outer levels liftM and ap combinators lift data from the Maybe String that lookup1 returns into the Maybe Trade which the function makeTrade returns. Also note how we convert the String values for unit_price and quantity into the respective Double data types through the magic of typeclasses using read. Nowhere we mention that the values need to be converted to Double - it's done through type inference and the magic of automatically using the appropriate instance of the Read typeclass by the compiler.

Here are the other functions, some of them refactored from the version that we developed in the earlier post.

-- trade enrichment
enrichWith :: (Trade, [(TaxFeeId, Double)]) -> RichTrade
enrichWith (trade, taxfees) = 
    RichTrade trade $ M.fromList taxfees

-- tax fee valuation for the trade
taxFees :: (Trade, Maybe [TaxFeeId]) -> (Trade, [(TaxFeeId, Double)])
taxFees (trade, Just taxfeeids) =
    (trade, zip taxfeeids (map (valueAs trade) taxfeeids))
taxFees (trade, Nothing) =
    (trade, [])

-- calculation of each tax and fee
rates = [(TradeTax, 0.2), (Commission, 0.15), (VAT, 0.1)]
valueAs :: Trade -> TaxFeeId -> Double
valueAs trade taxFeeId = 
    (principal trade) * (fromMaybe 0 (lookup taxFeeId rates))

-- compute net amount
netAmount :: RichTrade -> NetAmount
netAmount rtrade = 
    let t = trade rtrade
        p = principal t
        m = taxFeeMap rtrade
    in M.fold (+) p m

= enrichWith . taxFees . forTrade


Our domain model is fleshing out gradually. We have even added some stuff to pull data into our model from external contexts. In future posts I will explore more how Haskell combinators can make your domain model expressive yet succinct. This exercise is turning out to be a great learning exercise for me. Feel free to suggest improvements that will make the model better and more idiomatic.

Monday, October 04, 2010

Domain Modeling in Haskell - Follow the Types

In my last post I had talked about how implementing the same problem in different programming languages make you think differently. Of course these languages also have to be sufficiently opinionated to make you think in terms of their idioms and best practices. In that post I had discussed Scala and Clojure, two of the most competing languages trying to get the programmer mindshare on the JVM today.

As a weekend exercise I tried the same modeling problem in another functional language, that's touted to be the purest around. In my earlier exercise, Scala was statically typed, offered both functional and OO paradigms to model your domain. So it was somewhat a matter of choice to remain functional or fall down to objects for implementing your model. Clojure is functional, but still has matured in 1.2 to offer some features that you can use to build your model around OOish abstractions. Whether that's idiomatic Clojure or not, I will leave to the purists, but my friend Sergio has implemented a domain model using dynamic mixins in Clojure. A nice idea with deftypes and defprotocols.

With Haskell you don't have any escape route - you've to be functional and model your domain artifacts as functions that compose. With Haskell way of thinking you think in types, keep your pure functional code separate from impure side-effecting logic and use the myriads of ways to compose your computations. Without further ado ..

Here's the Trade abstraction as a Haskell data type .. once again much simpler compared to a real world one ..

-- some helpful synonyms
type Instrument = String
type Account = String
type NetAmount = Double

-- various types of tax and fees
data TaxFeeId = TradeTax | Commission | VAT deriving (Show, Eq, Ord)

data Trade = Trade {
      account     :: Account
     ,instrument  :: Instrument
     ,ref_no      :: String
     ,unit_price  :: Double
     ,quantity    :: Double
} deriving (Show)


We can define a helper function that gets me the principal of a trade ..

principal :: Trade -> Double
principal trade = (unit_price trade) * (quantity trade)


As in our previous exercise, we will try to decorate a trade with an appropriate set of tax and fee components. Remember we used mixins for Scala and function composition in Clojure that composes the decorators along with the subject.

The name Decorator nicely abstracts the intent of the computation. In some languages the implementation is a bit ceremonious, in others it's just a natural idiom of the language. With Haskell implementation we will also rely on composition, but we will try to get a nice pointfree computation that also makes a good DSL.

Let's find the set of tax and fees applicable for a trade. It depends on a few of the attributes of the trade and is usually computed through a somewhat detailed business logic. For our purposes, we will keep it simple and return a fixed set of tax/fee ids for our trade.

-- tax and fees applicable for a trade
forTrade :: Trade -> (Trade, [TaxFeeId])
forTrade trade =
    (trade, [TradeTax, Commission, VAT])


forTrade gives us a list of tax/fee ids applicable for the trade. However, we need to compute the value of each of them before we could use them to enrich our trade. We have the combinator taxFees that does exactly this and returns an association list containing pairs of tax/fee ids and their computed values for the trade.

taxFees use a function valueAs that implements Haskell's pattern matching. Note how the implementation is self explanatory through using algebraic data types of Haskell.

Note taxFees consume input the same way as forTrade outputs .. we are preparing to set up the composition ..

taxFees :: (Trade, [TaxFeeId]) -> (Trade, [(TaxFeeId, Double)])
taxFees (trade, taxfeeids) =
    (trade, zip taxfeeids (map (valueAs trade) taxfeeids))

-- valuation of tax and fee
valueAs :: Trade -> TaxFeeId -> Double
valueAs trade TradeTax = 0.2 * (principal trade)
valueAs trade Commission = 0.15 * (principal trade)
valueAs trade VAT = 0.1 * (principal trade)


Now we are ready for our final function that will enrich the trade. But before that let's define another type for our rich trade, that will contain a trade along with a Map of tax and fees.

import qualified Data.Map as M

type TaxFeeMap = M.Map TaxFeeId Double

data RichTrade = RichTrade {
      trade        :: Trade 
     ,taxFeeMap    :: TaxFeeMap 
} deriving (Show)


Our enrichWith function simply creates a Map out of the association list and tags it along with the Trade to form a RichTrade. Note how we use combinators like foldl to abstract the iteration and populate the Map.

-- trade enrichment
enrichWith :: (Trade, [(TaxFeeId, Double)]) -> RichTrade
enrichWith (trade, taxfees) = 
    RichTrade trade (foldl(\map (k, v) -> M.insert k v map) M.empty taxfees)


When we talk about enriching a trade in the problem domain, we talk about 3 steps - get the list of tax fees, compute the values for each of them for the particular trade and form the rich trade. Our Haskell implementation is just as verbose for the user. The enrichment recipe using the above functions boils down to the following pointfree composition ..

enrichWith . taxFees . forTrade

bah! Now how do we compute the net amount of a trade using the above model. Easy. Just define another combinator that can plug in with the above expression ..

netAmount :: RichTrade -> NetAmount
netAmount rtrade = 
    let t = trade rtrade
        p = principal t
        m = taxFeeMap rtrade
    in M.fold (\v a -> a + v) p m


and now you can compute the net amount as ..

netAmount . enrichWith . taxFees . forTrade


And we get an EDSL for free without any additional effort and just by sticking to idiomatic Haskell. The type system guides you in every respect - Haskellers call it "Follow the types". And once you have a compiled version of your code, it's type safe. If you have designed your abstractions based on the problem domain model, you have already implemented a lot of the domain rules out there.

As far as Haskell type system is concerned we have just scratched the surface here in this simple example. The idea was to compare with the implementations that Scala and Clojure had in my earlier post. In an upcoming post, I will take this example and enhance it with some more domain logic that will allow us to unearth some more of Haskell power, like type classes, a few monads etc. Incidentally there's a Reader monad begging to be modeled in the above example - can you spot it ?