How would I abstract Command/Response in an extensible way?

Viewed 99

While trying to do some domain driven design in Haskell, I found myself with this problem:

data FetchAccessories = FetchAccessories
data AccessoriesResponse = AccessoriesResponse

data FetchProducts = FetchProducts
data ProductsResponse = ProductsResponse

type AccessoryHandler = FetchAccessories -> AccessoriesResponse
type ProductHandler = FetchProducts -> ProductsResponse

handle :: Handler -- Not sure how to do this abstraction
handle FetchAccessories = AccessoriesResponse
handle FetchProducts = ProductsResponse

someFn :: AccessoriesResponse  -- Ideally
someFn = handle FetchAccessories

What I'd like to do is tie together a single Fetch* with a single Response*, and give enough information so that the compiler knows if I call handle FetchAccessories, it can only return AccessoriesResponse.

Edit:

Even more ideally, this would work without annotation, products & accessories having their appropriate type inferred:

biggerFn =
  let products = handle FetchProducts
      accessories = handle FetchAccessories
  in
    undefined -- do business things 
2 Answers

As stated, this is exactly the job for type classes. Type class is a construct that lets you tie together a few types, as well as define some functions on those types.

In your case we can define the a class Handler like this:

class Handler request response where
    handle :: request -> response

Here, request and response are type variables, representing two types, which get "tied together" by our class, and a function handle that takes one and returns the other.

Next, we can define instances of this class for your two cases:

instance Handler FetchAccessories AccessoriesResponse where
    handle FetchAccessories = AccessoriesResponse

instance Handler FetchProducts ProductsResponse where
    handle FetchProducts = ProductsResponse

And then we can use the function:

someFn :: AccessoriesResponse
someFn = handle FetchAccessories

(note that you'll need to enable MultiParamTypeClasses for this to work)


In response to your comment: I wonder if there is some way to avoid the annotation on someFn (since ghc seems so very close to knowing)

The problem is, GHC is not actually close to knowing. You know that AccessoriesResponse only goes with FetchAccessories, but as far as GHC is concerned, that's not necessarily true. After all, you could very well go ahead and add another class instance like this:

instance Handler FetchAccessories String where
    handler FetchAccessories = "foo"

And now it turns out that handle FetchAccessories might mean either AccessoriesResponse or "foo". GHC cannot decide for you.

But you can tell it, explicitly, that for every request type there can be only one response type. This is called "functional dependency" (you need to enable FunctionalDependencies for this), and the syntax is the following:

class Handler request response | request -> response where
    handler :: request -> response

This will tell GHC that response is uniquely determined by request and will have two practical consequences: (1) GHC will reject the second instance Handler FetchAccessories String from my example above, complaining that it violates the functional dependency, and (2) GHC will be able to figure out what response is just by knowing request.

In particular, this means that you can omit the type signature on someFn.

On a related note, you may or may not also want to do the opposite thing: for every response there can be only one request. To do that, you can specify two functional dependencies:

class Handler request response | request -> response, response -> request where

(the below is no longer relevant in light of your comment, but I'll leave it here for the record)

However, I suspect that what you actually meant was a different kind of model. What I suspect you meant is a model that says "a request can be either for products or for accessories, and a response can be either that of products or of accessories, and the handle function would turn any given request into a corresponding response"

If that is what you indeed meant, the suitable model would be sum types:

data Fetch = FetchAccessories | FetchProducts
data Response = AccessoriesResponse | ProductsResponse

handle :: Fetch -> Response
handle FetchAccessories = AccessoriesResponse
handle FetchProducts = ProductsResponse

If you have a closed set of fetches, this may also be a natural use case for a GADT, indexed by a tag that indicates the type of request or response.

{-# LANGUAGE DataKinds, GADTs, KindSignatures, StandaloneDeriving #-}

data Tag = Accessories | Products

data Fetch (t :: Tag) where
  FetchAccessories :: Fetch 'Accessories
  FetchProducts :: Fetch 'Products

deriving instance Show (Fetch t)

data Response (t :: Tag) where
  AccessoriesResponse :: Response 'Accessories
  ProductsResponse :: Response 'Products

deriving instance Show (Response t)

type Handler t = Fetch t -> Response t

-- Handles any type of request.
handle :: Handler t
handle FetchAccessories = AccessoriesResponse
handle FetchProducts = ProductsResponse

-- Handles only accessory requests.
-- The compiler knows this matching is exhaustive.
handleAccessories :: Handler 'Accessories
handleAccessories FetchAccessories = AccessoriesResponse

someFn :: Response 'Accessories
someFn = handle FetchAccessories

You may of course add more fields to the Fetch and Response types.

data Fetch (t :: Tag) where
  FetchAccessories :: AccessoryName -> Fetch 'Accessories
  FetchProducts :: ProductId -> Fetch 'Products
Related