About

Template Haskell codegen removing noise and boilerplate from domain models.

Problem

Imagine a real-life project, where you have to define the types for your problem domain: your domain model. How many types do you think there’ll be? A poll among Haskellers shows that highly likely more than 30. That is 30 places for you to derive or define instances, work around the records problem and the problem of conflicting constructor names. That is a lot of boilerplate and noise, distracting you from your actual goal of modeling the data structures or learning an existing model during maintenance. Also don’t forget about the boilerplate required to generate optics for your model to actually make it accessible.

Mission

In its approach to those problems this project sets the following goals:

• Let the domain model definition be focused on data and nothing else.
• Let it be readable and comfortably editable, avoiding syntactic noise.
• Separate its declaration from the problems of declaration of instances, accessor functions, optics and etc.
• Have the records problem solved.
• Have the problem of conflicting constructor names solved.
• Avoid boilerplate in all the above.
• Avoid complications of the build process.

Solution

This project introduces a clear boundary between the data model declaration and the rest of the code base. It introduces a YAML format designed specifically for the problem of defining types and relations between them and that only. We call it Domain Schema.

Schemas can be loaded at compile time and transformed into Haskell declarations using Template Haskell. Since it’s just Template Haskell, no extra build software is needed to use this library. It is a normal Haskell package.

Schema gets analysed allowing to generate all kinds of instances automatically using a set of prepackaged derivers. An API is provided for creation of custom derivers for extending the library or handling special cases.

Tutorial and Case in Point

We’ll show you how this whole thing works on an example of a model of a service address.

Schema

First we need to define a schema. For that we create the following YAML document:

# Service can be either located on the network or
# by a socket file.
#
# Choice between two or more types can be encoded using
# "sum" type composition, which you may also know as
# "union" or "variant". That's what we use here.
ServiceAddress:
  sum:
    network: NetworkAddress
    local: FilePath

# Network address is a combination of transport protocol,
# host and port. All those three things at once.
#
# "product" type composition lets us encode that.
# You may also know it as "record" or "tuple".
NetworkAddress:
  product:
    protocol: TransportProtocol
    host: Host
    port: Word16

# Transport protocol is either TCP or UDP.
# We encode that using enumeration.
TransportProtocol:
  enum:
    - tcp
    - udp

# Host can be adressed by either an IP or its name,
# so "sum" again.
Host:
  sum:
    ip: Ip
    name: Text

# IP can be either of version 4 or version 6.
# We encode it as a sum over words of the accordingly required
# amount of bits.
Ip:
  sum:
    v4: Word32
    v6: Word128

# Since the standard lib lacks a definition
# of a 128-bit word, we define a custom one
# as a product of two 64-bit words.
Word128:
  product:
    part1: Word64
    part2: Word64

As you can see in the specification above we’re not concerned with typeclass instances or problems of name disambiguation. We’re only concerned with data and relations that it has. This is what we mean by focus. It makes the experience of designing and maintaining a model distraction free.

Those three methods of defining types (product, sum, enum) are all that you need to define a model of any complexity. If you understand them, there’s nothing new to learn.

Codegen

Now, having that schema defined in a file at path schemas/model.yaml, we can load it in a Haskell module as follows:

{-# LANGUAGE
  TemplateHaskell,
  StandaloneDeriving, DeriveGeneric, DeriveDataTypeable, DeriveLift,
  FlexibleInstances, MultiParamTypeClasses,
  DataKinds, TypeFamilies
  #-}
module Model where

import Data.Text (Text)
import Data.Word (Word16, Word32, Word64)
import Domain

declare (Just (False, True)) mempty
  =<< loadSchema "schemas/model.yaml"

And that will cause the compiler to generate the following declarations:

data ServiceAddress =
  NetworkServiceAddress !NetworkAddress |
  LocalServiceAddress !FilePath

data NetworkAddress =
  NetworkAddress {
    networkAddressProtocol :: !TransportProtocol,
    networkAddressHost :: !Host,
    networkAddressPort :: !Word16
  }

data TransportProtocol =
  TcpTransportProtocol |
  UdpTransportProtocol

data Host =
  IpHost !Ip |
  NameHost !Text

data Ip =
  V4Ip !Word32 |
  V6Ip !Word128

data Word128 =
  Word128 {
    word128Part1 :: !Word64,
    word128Part2 :: !Word64
  }

As you can see in the generated code the field names from the schema get translated to record fields or constructors depending on the type composition method.

In this example the record fields are prefixed with type names for disambiguation, but by modifying the options passed to the declare function it is possible to remove the type name prefix or prepend with underscore, you can also avoid generating record fields altogether (to keep the value-level namespace clean).

The constructor names are also disambiguated by appending the type name to the label from schema. Thus we are introducing a consistent naming convention, while avoiding the boilerplate in the declaration of the model.

Instances

If we introduce the following change to our code:

-declare (Just (False, True)) mempty
+declare (Just (False, True)) stdDeriver

We’ll get a ton of instances generated including the obvious Show, Eq and even Hashable for all the declared types. We’ll also get some useful ones, which you wouldn’t derive otherwise.

deriving instance Show ServiceAddress
deriving instance Eq ServiceAddress
deriving instance Ord ServiceAddress
deriving instance GHC.Generics.Generic ServiceAddress
deriving instance Data.Data.Data ServiceAddress
deriving instance base-4.14.1.0:Data.Typeable.Internal.Typeable ServiceAddress
instance hashable-1.3.0.0:Data.Hashable.Class.Hashable ServiceAddress
deriving instance template-haskell-2.16.0.0:Language.Haskell.TH.Syntax.Lift ServiceAddress
instance GHC.Records.HasField "network" ServiceAddress (Maybe NetworkAddress) where
  GHC.Records.getField (NetworkServiceAddress a) = Just a
  GHC.Records.getField _ = Nothing
instance GHC.Records.HasField "local" ServiceAddress (Maybe FilePath) where
  GHC.Records.getField (LocalServiceAddress a) = Just a
  GHC.Records.getField _ = Nothing
instance (a ~ NetworkAddress) =>
         GHC.OverloadedLabels.IsLabel "network" (a -> ServiceAddress) where
  GHC.OverloadedLabels.fromLabel = NetworkServiceAddress
instance (a ~ FilePath) =>
         GHC.OverloadedLabels.IsLabel "local" (a -> ServiceAddress) where
  GHC.OverloadedLabels.fromLabel = LocalServiceAddress
instance (mapper ~ (NetworkAddress -> NetworkAddress)) =>
         GHC.OverloadedLabels.IsLabel "network" (mapper
                                                 -> ServiceAddress -> ServiceAddress) where
  GHC.OverloadedLabels.fromLabel
    = \ fn
        -> \ a
             -> case a of
                  NetworkServiceAddress a -> NetworkServiceAddress (fn a)
                  a -> a
instance (mapper ~ (FilePath -> FilePath)) =>
         GHC.OverloadedLabels.IsLabel "local" (mapper
                                               -> ServiceAddress -> ServiceAddress) where
  GHC.OverloadedLabels.fromLabel
    = \ fn
        -> \ a
             -> case a of
                  LocalServiceAddress a -> LocalServiceAddress (fn a)
                  a -> a
instance (a ~ Maybe NetworkAddress) =>
         GHC.OverloadedLabels.IsLabel "network" (ServiceAddress -> a) where
  GHC.OverloadedLabels.fromLabel
    = \ a
        -> case a of
             NetworkServiceAddress a -> Just a
             _ -> Nothing
instance (a ~ Maybe FilePath) =>
         GHC.OverloadedLabels.IsLabel "local" (ServiceAddress -> a) where
  GHC.OverloadedLabels.fromLabel
    = \ a
        -> case a of
             LocalServiceAddress a -> Just a
             _ -> Nothing
deriving instance Show NetworkAddress
deriving instance Eq NetworkAddress
deriving instance Ord NetworkAddress
deriving instance GHC.Generics.Generic NetworkAddress
deriving instance Data.Data.Data NetworkAddress
deriving instance base-4.14.1.0:Data.Typeable.Internal.Typeable NetworkAddress
instance hashable-1.3.0.0:Data.Hashable.Class.Hashable NetworkAddress
deriving instance template-haskell-2.16.0.0:Language.Haskell.TH.Syntax.Lift NetworkAddress
instance GHC.Records.HasField "protocol" NetworkAddress TransportProtocol where
  GHC.Records.getField (NetworkAddress a _ _) = a
instance GHC.Records.HasField "host" NetworkAddress Host where
  GHC.Records.getField (NetworkAddress _ a _) = a
instance GHC.Records.HasField "port" NetworkAddress Word16 where
  GHC.Records.getField (NetworkAddress _ _ a) = a
instance (mapper ~ (TransportProtocol -> TransportProtocol)) =>
         GHC.OverloadedLabels.IsLabel "protocol" (mapper
                                                  -> NetworkAddress -> NetworkAddress) where
  GHC.OverloadedLabels.fromLabel
    = \ fn (NetworkAddress a b c) -> ((NetworkAddress (fn a)) b) c
instance (mapper ~ (Host -> Host)) =>
         GHC.OverloadedLabels.IsLabel "host" (mapper
                                              -> NetworkAddress -> NetworkAddress) where
  GHC.OverloadedLabels.fromLabel
    = \ fn (NetworkAddress a b c) -> ((NetworkAddress a) (fn b)) c
instance (mapper ~ (Word16 -> Word16)) =>
         GHC.OverloadedLabels.IsLabel "port" (mapper
                                              -> NetworkAddress -> NetworkAddress) where
  GHC.OverloadedLabels.fromLabel
    = \ fn (NetworkAddress a b c) -> ((NetworkAddress a) b) (fn c)
instance (a ~ TransportProtocol) =>
         GHC.OverloadedLabels.IsLabel "protocol" (NetworkAddress -> a) where
  GHC.OverloadedLabels.fromLabel = \ (NetworkAddress a _ _) -> a
instance (a ~ Host) =>
         GHC.OverloadedLabels.IsLabel "host" (NetworkAddress -> a) where
  GHC.OverloadedLabels.fromLabel = \ (NetworkAddress _ b _) -> b
instance (a ~ Word16) =>
         GHC.OverloadedLabels.IsLabel "port" (NetworkAddress -> a) where
  GHC.OverloadedLabels.fromLabel = \ (NetworkAddress _ _ c) -> c
deriving instance Enum TransportProtocol
deriving instance Bounded TransportProtocol
deriving instance Show TransportProtocol
deriving instance Eq TransportProtocol
deriving instance Ord TransportProtocol
deriving instance GHC.Generics.Generic TransportProtocol
deriving instance Data.Data.Data TransportProtocol
deriving instance base-4.14.1.0:Data.Typeable.Internal.Typeable TransportProtocol
instance hashable-1.3.0.0:Data.Hashable.Class.Hashable TransportProtocol
deriving instance template-haskell-2.16.0.0:Language.Haskell.TH.Syntax.Lift TransportProtocol
instance GHC.Records.HasField "tcp" TransportProtocol Bool where
  GHC.Records.getField TcpTransportProtocol = True
  GHC.Records.getField _ = False
instance GHC.Records.HasField "udp" TransportProtocol Bool where
  GHC.Records.getField UdpTransportProtocol = True
  GHC.Records.getField _ = False
instance GHC.OverloadedLabels.IsLabel "tcp" TransportProtocol where
  GHC.OverloadedLabels.fromLabel = TcpTransportProtocol
instance GHC.OverloadedLabels.IsLabel "udp" TransportProtocol where
  GHC.OverloadedLabels.fromLabel = UdpTransportProtocol
instance (a ~ Bool) =>
         GHC.OverloadedLabels.IsLabel "tcp" (TransportProtocol -> a) where
  GHC.OverloadedLabels.fromLabel
    = \ a
        -> case a of
             TcpTransportProtocol -> True
             _ -> False
instance (a ~ Bool) =>
         GHC.OverloadedLabels.IsLabel "udp" (TransportProtocol -> a) where
  GHC.OverloadedLabels.fromLabel
    = \ a
        -> case a of
             UdpTransportProtocol -> True
             _ -> False
deriving instance Show Host
deriving instance Eq Host
deriving instance Ord Host
deriving instance GHC.Generics.Generic Host
deriving instance Data.Data.Data Host
deriving instance base-4.14.1.0:Data.Typeable.Internal.Typeable Host
instance hashable-1.3.0.0:Data.Hashable.Class.Hashable Host
deriving instance template-haskell-2.16.0.0:Language.Haskell.TH.Syntax.Lift Host
instance GHC.Records.HasField "ip" Host (Maybe Ip) where
  GHC.Records.getField (IpHost a) = Just a
  GHC.Records.getField _ = Nothing
instance GHC.Records.HasField "name" Host (Maybe Text) where
  GHC.Records.getField (NameHost a) = Just a
  GHC.Records.getField _ = Nothing
instance (a ~ Ip) =>
         GHC.OverloadedLabels.IsLabel "ip" (a -> Host) where
  GHC.OverloadedLabels.fromLabel = IpHost
instance (a ~ Text) =>
         GHC.OverloadedLabels.IsLabel "name" (a -> Host) where
  GHC.OverloadedLabels.fromLabel = NameHost
instance (mapper ~ (Ip -> Ip)) =>
         GHC.OverloadedLabels.IsLabel "ip" (mapper -> Host -> Host) where
  GHC.OverloadedLabels.fromLabel
    = \ fn
        -> \ a
             -> case a of
                  IpHost a -> IpHost (fn a)
                  a -> a
instance (mapper ~ (Text -> Text)) =>
         GHC.OverloadedLabels.IsLabel "name" (mapper -> Host -> Host) where
  GHC.OverloadedLabels.fromLabel
    = \ fn
        -> \ a
             -> case a of
                  NameHost a -> NameHost (fn a)
                  a -> a
instance (a ~ Maybe Ip) =>
         GHC.OverloadedLabels.IsLabel "ip" (Host -> a) where
  GHC.OverloadedLabels.fromLabel
    = \ a
        -> case a of
             IpHost a -> Just a
             _ -> Nothing
instance (a ~ Maybe Text) =>
         GHC.OverloadedLabels.IsLabel "name" (Host -> a) where
  GHC.OverloadedLabels.fromLabel
    = \ a
        -> case a of
             NameHost a -> Just a
             _ -> Nothing
deriving instance Show Ip
deriving instance Eq Ip
deriving instance Ord Ip
deriving instance GHC.Generics.Generic Ip
deriving instance Data.Data.Data Ip
deriving instance base-4.14.1.0:Data.Typeable.Internal.Typeable Ip
instance hashable-1.3.0.0:Data.Hashable.Class.Hashable Ip
deriving instance template-haskell-2.16.0.0:Language.Haskell.TH.Syntax.Lift Ip
instance GHC.Records.HasField "v4" Ip (Maybe Word32) where
  GHC.Records.getField (V4Ip a) = Just a
  GHC.Records.getField _ = Nothing
instance GHC.Records.HasField "v6" Ip (Maybe Word128) where
  GHC.Records.getField (V6Ip a) = Just a
  GHC.Records.getField _ = Nothing
instance (a ~ Word32) =>
         GHC.OverloadedLabels.IsLabel "v4" (a -> Ip) where
  GHC.OverloadedLabels.fromLabel = V4Ip
instance (a ~ Word128) =>
         GHC.OverloadedLabels.IsLabel "v6" (a -> Ip) where
  GHC.OverloadedLabels.fromLabel = V6Ip
instance (mapper ~ (Word32 -> Word32)) =>
         GHC.OverloadedLabels.IsLabel "v4" (mapper -> Ip -> Ip) where
  GHC.OverloadedLabels.fromLabel
    = \ fn
        -> \ a
             -> case a of
                  V4Ip a -> V4Ip (fn a)
                  a -> a
instance (mapper ~ (Word128 -> Word128)) =>
         GHC.OverloadedLabels.IsLabel "v6" (mapper -> Ip -> Ip) where
  GHC.OverloadedLabels.fromLabel
    = \ fn
        -> \ a
             -> case a of
                  V6Ip a -> V6Ip (fn a)
                  a -> a
instance (a ~ Maybe Word32) =>
         GHC.OverloadedLabels.IsLabel "v4" (Ip -> a) where
  GHC.OverloadedLabels.fromLabel
    = \ a
        -> case a of
             V4Ip a -> Just a
             _ -> Nothing
instance (a ~ Maybe Word128) =>
         GHC.OverloadedLabels.IsLabel "v6" (Ip -> a) where
  GHC.OverloadedLabels.fromLabel
    = \ a
        -> case a of
             V6Ip a -> Just a
             _ -> Nothing
deriving instance Show Word128
deriving instance Eq Word128
deriving instance Ord Word128
deriving instance GHC.Generics.Generic Word128
deriving instance Data.Data.Data Word128
deriving instance base-4.14.1.0:Data.Typeable.Internal.Typeable Word128
instance hashable-1.3.0.0:Data.Hashable.Class.Hashable Word128
deriving instance template-haskell-2.16.0.0:Language.Haskell.TH.Syntax.Lift Word128
instance GHC.Records.HasField "part1" Word128 Word64 where
  GHC.Records.getField (Word128 a _) = a
instance GHC.Records.HasField "part2" Word128 Word64 where
  GHC.Records.getField (Word128 _ a) = a
instance (mapper ~ (Word64 -> Word64)) =>
         GHC.OverloadedLabels.IsLabel "part1" (mapper
                                               -> Word128 -> Word128) where
  GHC.OverloadedLabels.fromLabel
    = \ fn (Word128 a b) -> (Word128 (fn a)) b
instance (mapper ~ (Word64 -> Word64)) =>
         GHC.OverloadedLabels.IsLabel "part2" (mapper
                                               -> Word128 -> Word128) where
  GHC.OverloadedLabels.fromLabel
    = \ fn (Word128 a b) -> (Word128 a) (fn b)
instance (a ~ Word64) =>
         GHC.OverloadedLabels.IsLabel "part1" (Word128 -> a) where
  GHC.OverloadedLabels.fromLabel = \ (Word128 a _) -> a
instance (a ~ Word64) =>
         GHC.OverloadedLabels.IsLabel "part2" (Word128 -> a) where
  GHC.OverloadedLabels.fromLabel = \ (Word128 _ b) -> b

Labels

Among the generated instances you’ll find instances for the IsLabel class. It is a class powering Haskell’s OverloadedLabels extension. The instances we define for it let us reduce the boilerplate in the way we address our model. Here’s how.

We can access the members of records:

getNetworkAddressPort :: NetworkAddress -> Word16
getNetworkAddressPort = #port

Yep. Finally. Address your fields without crazy prefixes or dealing with disambiguation otherwise.

Labels will be unprefixed regardless of what you choose to do about record fields. You can also name them whatever you like. Literally, even type and data make up valid labels, and unless you choose to generate unprefixed record fields, you can freely use them.

We get accessors to the members of sums as well:

getHostIp :: Host -> Maybe Ip
getHostIp = #ip

Yep. Sum types can have accessors if you look at them from a certain perspective.

Accessors to enums - why not?

isTransportProtocolTcp :: TransportProtocol -> Bool
isTransportProtocolTcp = #tcp

We get shortcuts to enums:

tcpTransportProtocol :: TransportProtocol
tcpTransportProtocol = #tcp

We can instantiate sums:

ipHost :: Ip -> Host
ipHost = #ip

We can map over both record fields and sum variants:

mapNetworkAddressHost :: (Host -> Host) -> NetworkAddress -> NetworkAddress
mapNetworkAddressHost = #host

mapHostIp :: (Ip -> Ip) -> Host -> Host
mapHostIp = #ip

There’s a few things worth noticing here. Unfortunately the type inferencer will be unable to automatically detect the type of the mapping lambda parameter, so it needs to have an unambiguous type. This means that often times you’ll have to provide an explicit type for it. But there’s a solution.

There is a “domain-optics” library which provides an integration with the “optics” library. By including the derivers from it in the parameters to the declare macro, you’ll be able to map as follows without type inference issues:

mapNetworkAddressHost :: (Host -> Host) -> NetworkAddress -> NetworkAddress
mapNetworkAddressHost = over #host

You can read more about the “optics” library integration in the Optics section.

If we can map, then we can also set:

setNetworkAddressHost :: Host -> NetworkAddress -> NetworkAddress
setNetworkAddressHost host = #host (const host)

Optics

Extensional “domain-optics” library provides integration with “optics”. By using the derivers from it we can get optics using labels as well.

Coming back to our example here’s all we’ll have to do to enable our model with optics:

{-# LANGUAGE
  TemplateHaskell,
  StandaloneDeriving, DeriveGeneric, DeriveDataTypeable, DeriveLift,
  FlexibleInstances, MultiParamTypeClasses,
  DataKinds, TypeFamilies,
  UndecidableInstances
  #-}
module Model where

import Data.Text (Text)
import Data.Word (Word16, Word32, Word64)
import Domain
import DomainOptics

declare (Just (False, True)) (stdDeriver <> labelOpticDeriver)
  =<< loadSchema "schemas/model.yaml"

Here are some of the optics that will become available to us:

networkAddressHostOptic :: Lens' NetworkAddress Host
networkAddressHostOptic = #host

hostIpOptic :: Prism' Host Ip
hostIpOptic = #ip

tcpTransportProtocolOptic :: Prism' TransportProtocol ()
tcpTransportProtocolOptic = #tcp

As you may have noticed, we avoid the “underscore-uppercase” naming convention for prisms. With labels there’s no longer any need for it.

We recommend using “optics” instead of direct IsLabel instances, because functions like view, over, set, review make your intent clearer to the reader in many cases and in some cases provide better type inference.