

The Has
type class patterns are simple but surprisingly useful. Iโll walk through some examples.
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
.
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 maybe
s and mconcat
stuff).
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
imagesScene {..}
backgroundImage
= singleton
<> imagescharacters
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:
collectRockImage
inconsistency from the first example).The downsides are:
2. The instance declaration is noisier than the function declaration and required greater indention.
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.
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.
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
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
Basing the Has
class on Prism
s 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.
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.
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!
Create your free account to unlock your custom reading experience.