The Has Type Class Pattern

Originally published by Jonathan Fischoff on June 27th 2017 2,909 reads

@jonathangfischoffJonathan Fischoff

The Has type class patterns are simple but surprisingly useful. I’ll walk through some examples.

Use Case 1: Collecting all Images

Imagine you are working on a game and during an asset validation step, you want to make sure that the scene’s images exist.

We need to traverse the scene description and collect all the image file paths. Let’s make a Scene type:

data Scene = Scene 
  { backgroundImage   :: Text
  , characters        :: [Character]   
  , bewilderedTourist :: Maybe Character
  , objects           :: [Either Rock WoodenCrate]  
  }

data Character = Character
 { hat   :: Maybe DamageArray
 , head  :: DamageArray
 , torso :: DamageArray
 , legs  :: DamageArray
 , shoes :: Maybe DamageArray
 }

data DamageArray = DamageArray
  { noDamage        :: Text
  , someDamage      :: Text
  , excessiveDamage :: Text
  }

data Rock = Rock 
  { weight    :: Double
  , rockImage :: Text
  }

data WoodenCrate = WoodenCrate
  { strength         :: Double
  , woodenCrateImage :: DamageArray  
  }

You get the idea. There are a lot of types, with a fair amount of nesting. A real scene could have hundreds of types and double digit levels of nesting, but this is a good enough example for our purposes.

So now we want to write a function, collectImages :: Scene -> Set Text.

You haz no Has

The most straightforward approach is to just write the functions:

collectImages :: Scene -> Set Text
collectImages Scene {..} 
  =  singleton backgroundImage 
  <> mconcat (map collectCharacterImages characters)
  <> maybe mempty collectCharacterImages bewilderedTourist
  <> mconcat (map (either (singleton . collectRockImage) 
                          collectWoodenCrateImages)     
                  objects)

collectCharacterImages :: Character -> Set Text
collectCharacterImages Character {..}  
  =  maybe mempty collectDamageArrayImages hat
  <> collectDamageArrayImages head
  <> collectDamageArrayImages torso
  <> collectDamageArrayImages legs
  <> maybe mempty collectDamageArrayImages shoes

collectDamageArrayImages :: DamageArray -> Set Text
collectDamageArrayImages DamageArray {..} = fromList
  [ noDamage
  , someDamage
  , excessiveDamage
  ]

collectRockImage :: Rock -> Text
collectRockImage Rock {..} = rockImage

collectWoodenCrateImages :: WoodenCrate -> Set Text
collectWoodenCrateImages WoodenCrate {..} = 
  collectDamageArrayImages woodenCrateImage

The code is verbose and a little tedious, but not terribly difficult to write or follow. I was disciplined and named everything in a consistent way, which made it easy remember. The trickiest part is just remembering what helper functions to call when operating on my polymorphic containers (all the maybes and mconcat stuff).

All the Has in the World

Here is the same code written with a variation of the Has type class pattern:

class HasImages a where
  images :: a -> Set Text

instance HasImages a => HasImages [a] where
  images xs = foldr (\x accum -> images x <> accum) mempty xs

instance HasImages a => HasImages (Maybe a) where
  images x = maybe [] images x

instance (HasImages a, HasImages b) => HasImages (Either a b) where
  images x = either images images x

instance HasImages Scene where
  images Scene {..} 
    =  singleton backgroundImage 
    <> images characters
    <> images bewilderedTourist
    <> images objects

instance HasImages Character where
  images Character {..} 
    =  images hat
    <> images head
    <> images torso
    <> images legs
    <> images shoes

instance HasImages DamageArray where
  images DamageArray {..} = fromList
    [ noDamage
    , someDamage
    , excessiveDamage
    ]

instance HasImages Rock where
  images Rock {..} = singleton rockImage

instance HasImages WoodenCrate where
  images WoodenCrate {..} = images woodenCrateImage

Alright, so this the simplest variation of the Has type class pattern. We have a HasImages type class which requires a function, a -> Set Text, to be implemented by each instance.

The first difference between the Has example and the prior example is that I have implemented generic functions for my polymorphic containers [], Maybe, and Either. The value in this approach is that I don’t have to think about what functions to call to collect the images: it’s always images. In the prior example, I had to think about the how to collect the images each time, and it took brain power better spent elsewhere.

The benefits of the Has pattern are:

1. I can write a single instance for each polymorphic container that will work for all specializations I need.
2. I do not have to make as many decisions, freeing up brain power to focus on other things
3. It provides structure for other engineers to extend without having to make decisions about names of functions and what the type the functions should be (see the collectRockImage inconsistency from the first example).

The downsides are:

1. It uses a type class, which is a more complicated concept than a function.

2. The instance declaration is noisier than the function declaration and required greater indention.

Use Case 2: Composable Reader

The Has pattern can also be used to create a composable Reader monad.

Say you have library A with the following:

foo :: Reader Int Bool

and library B with:

bar :: Reader String Int

and you would like to be able to write

foobar = do 
  flag <- foo
  
  if flag then 
    bar
  else
    return 0

but it won’t type check, because foo needs an Int environment and bar needs a String environment.

The trick is to define the helper Has type classes:

class HasFooEnv a where
  getFooEnv :: a -> Int

class HasBarEnv a where
  getBarEnv :: a -> String

Then we modify the type signatures to use MonadReader:

foo :: (MonadReader e m, HasFooEnv e) => m Bool

We will have to modify calls to ask to use asks getFooEnv. We make a similar modification for bar:

bar :: (MonadReader e m, HasBarEnv e) => m Int

and instances:

instance HasFooEnv (Int, String) where
  getFooEnv = fst

instance HasBarEnv (Int, String) where
  getBarEnv = snd

We get the combined version to type check:

foobar :: Reader (Int, String) 
foobar = do 
  flag <- foo
  
  if flag then 
    bar
  else
    return 0

Michael Snoyman also discusses the Has pattern in a post on ReaderT here.

Use Case 3: Convenient Argument Passing

It is quite common in database applications to have the following types:

newtype Key a = Key UUID
data Entity a = Entity 
  { entityKey   :: Key a
  , entityValue :: a
  }

Additionally, one will write queries that look like:

getFriends :: Key User -> [Entity User]

which will get called often by extracting a Key User from an Entity User.

getFriends (entityKey user)

and you can make the API just ever so slightly easier to use with:

class HasKey a k | a -> k where
  key :: a -> Key k

instance HasKey (Key a) a where
  key = id

instance HasKey (Entity a) a where
  key = entityKey

getFriends :: HasKey a User => a -> [Entity User]

and one can now pass in either a Entity User or Key User.

getFriends user

It’s a small thing, but one of my past coworkers liked it and I do myself so I’m including it. More difficult error messages is a downside.

Use Case 4: Traversals

So far we are discussing a simple version of Has that can only get things. This is only the beginning. Going back to our first example, let’s say that instead of merely collecting the images, we also want to traverse the scene and update the image file paths with the hash of the image as a suffix.

We are going to take advantage of the lens package and our new HasImages class will look like:

class HasImages a where
  images :: Traversal' a Text

Our instances look like:

instance HasImages a => HasImages [a] where
  images = traversed . images

instance HasImages a => HasImages (Maybe a) where
  images = traversed . images

instance (HasImages a, HasImages b) => HasImages (Either a b) where
  images f e = case e of
    Left  x -> Left  <$> traverseOf images f x
    Right x -> Right <$> traverseOf images f x

instance HasImages Scene where
  images f Scene {..} 
    =  Scene 
   <$> f backgroundImage
   <*> traverseOf images f characters
   <*> traverseOf images f bewilderedTourist
   <*> traverseOf images f objects

instance HasImages Character where
  images f Character {..} 
     =  Character
    <$> traverseOf images f hat
    <*> traverseOf images f head
    <*> traverseOf images f torso
    <*> traverseOf images f legs
    <*> traverseOf images f shoes

instance HasImages DamageArray where
  images f DamageArray {..} 
    =  DamageArray
   <$> f noDamage
   <*> f someDamage
   <*> f excessiveDamage

instance HasImages Rock where
  images f Rock {..} 
    =  Rock weight 
   <$> f rockImage

instance HasImages WoodenCrate where
  images f WoodenCrate {..} 
    = WoodenCrate strength 
   <$> traverseOf images f woodenCrateImage

We can apply our hash updater like:

hashFilePath :: Text -> IO Text
hashFilePath filePath = do 
  let pathStr = T.unpack filePath
  fileHash <- hashBytes <$> BSL.readFile pathStr
  return $ T.pack $ dropExtension pathStr 
         ++ "-" ++ fileHash <.> takeExtension pathStr

hashSceneImages :: Scene -> IO Scene
hashSceneImages x = traverseOf images hashFilePath x

Not only that, but we get our collectImages for “free” (although the performance is going to be different, which probably doesn’t matter).

collectImages :: Scene -> [Text]
collectImages x = fromList $ toListOf images x

Use Case 5: Composable State

We can get a composable State monad like we got a composable Reader monad by using a Lens instance of simple function:

class HasFooState a where
  fooState :: Lens' a Int

class HasBarState a where
  barState :: Lens' a String

then we modify the type signatures to use MonadStates:

foo :: (MonadState s m, HasFooState s) => m Bool

We will have to swap calls to get with use fooState, calls to modify with modifying fooState and put becomes assign fooState. We modify bar in a similar way:

bar :: (MonadReader s m, HasBarState s) => m Int

and instances:

instance HasFooState (Int, String) where
  fooState = _1

instance HasBarState (Int, String) where
  barState = _2

We get the combined version to type check.

foobar :: State (Int, String) 
foobar = do 
  flag <- foo
  
  if flag then 
    bar
  else
    return 0

Use Case 6: Extendible Exceptions

Basing the Has class on Prisms allows us to have extendible exceptions with MonadError.

Our class will look like:

class HasIdNotFound a where
  _IdNotFound :: Prism a UUID

We then write our functions like:

foo :: (HasIdNotFound e, MonadError e m) => m a

and can throw our exceptions by calling:

throwError $ review _IdNotFound theId

For a more complicated variant that requires fewer instances, take a look at this post.

A Magical Alternative

If you’re like me, you’re probably wondering if there was some magical way to write collectImages and hashSceneImages without doing any work. There is! We can use uniplate (or another similar library).

We need to enable DeriveDataType and add a deriving (Data) to each type. Then our collectImages becomes:

import Data.Generics.Uniplate.Data

collectImages :: Scene -> Set Text
collectImages x = fromList (universeBi x)

and our hashSceneImages is now:

hashSceneImages :: Scene -> IO Scene
hashSceneImages x = transformBiM hashFilePath x

The downside to this approach is it indiscriminately collects all Text values. This is not necessarily what we want (we could make a newtype ImageFile = ImageFile Text to make it safer). Another downside is it is slower than a custom traversal class.

Conclusion

Has type classes are simple, but they can keep your code well-structured and help you tackle common tasks. Additionally, you might be able to YOLO it with uniplate.

The repo with more complete examples here.

Hacker Noon is how hackers start their afternoons. We’re a part of the @AMIfamily. We are now accepting submissions and happy to discuss advertising & sponsorship opportunities.

To learn more, read our about page, like/message us on Facebook, or simply, tweet/DM @HackerNoon.

If you enjoyed this story, we recommend reading our latest tech stories and trending tech stories. Until next time, don’t take the realities of the world for granted!

Related

Bybit - Win $500 Bonus!

Visit Bybit http://bit.ly/39k3Y05

promoted

DevSecOps and DevOps: A Deep Dive

pre-emoji story

#devops

@adamkoyAdam Koy

01/16/21

SAST Analysis: No Angst Edition

pre-emoji story

#programming

@sonarsourceSonarSource

01/16/21