Often we need a pair of conversion functions: one to encode a value as a string, and another corresponding function to decode a string back into the original type. Here we show a concise way to define these functions for datatypes whose constructors enumerate a small fixed set of possibilities (sometimes described as “enums”).
We will make use of a few language extensions (GHC generics and the anyclass
strategy) to let the compiler automatically generate a list of all the values of an datatype.
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
We use the deriving strategies extension to be explicit about which deriving mechanism is in use for each typeclass.
{-# LANGUAGE DerivingStrategies #-}
This code uses \case
expressions.
{-# LANGUAGE LambdaCase #-}
In addition to GHC’s Generic
class, we’ll also need to import the GEnum
class from the generic-deriving
library. When a type has an instance of the GEnum
class, we can use genum
to obtain a list of all values of that type.
import GHC.Generics (Generic)
import Generics.Deriving.Enum (GEnum (genum))
We’ll be using the Map
data structure from the containers
library.
import qualified Data.Map.Strict as Map
First we’ll define two enum datatypes to use for examples. Let’s imagine we’re writing code related to billing for a subscription service. The product comes in three varieties – basic, standard, and pro – and our users can choose to pay either monthly or annually.
For each type, we derive instances of the Generic
and GEnum
classes. We will not be directly using the Generic
class, but it is a requirement for deriving the GEnum
class which we will be using.
data Product = Basic | Standard | Pro
deriving stock (Generic, Show)
deriving anyclass GEnum
data Frequency = Monthly | Annual
deriving stock (Generic, Show)
deriving anyclass GEnum
We’ll also define a Bill
datatype, consisting of a product and a billing frequency. These two fields represent a summary of a subscriber’s invoice.
data Bill = Bill Product Frequency
deriving stock (Generic, Show)
deriving anyclass GEnum
Here are some example encoding functions.
For our first example, we define a way to represent values of the Product
type as String
s.
encodeProduct :: Product -> String
= \case
encodeProduct Basic -> "p1"
Standard -> "p2"
Pro -> "p3"
Next we define a way to encode the Bill
type as an Integer
. Since a bill consists of a Product
(of which there are three) and a Frequency
(of which there are two), then there are 3 × 2 = 6 values of Bill
to encode.
Decoding is converting back in the other direction – for example, Integer -> Maybe Bill
. The return type includes Maybe
because not every integer represents a bill, so decoding can fail.
It could be rather tedious and redundant to also write to corresponding decoding functions. Fortunately, we can take a shortcut.
encodeBill :: Bill -> Integer
= \case
encodeBill Bill Basic Monthly -> 10
Bill Basic Annual -> 11
Bill Standard Monthly -> 20
Bill Standard Annual -> 21
Bill Pro Monthly -> 30
Bill Pro Annual -> 31
If the type a
we’re encoding has an instance of GEnum
and we have an encoding function f :: a -> b
such as encodeProduct
or encodeBill
, then this invert
function will infer the corresponding decoding function.
invert :: (GEnum a, Ord b) => (a -> b) -> b -> Maybe a
The first step is to construct reverseMap
, a Map
that contains, for every value of type a
, a mapping from the encoded form back to the original value. This is where we use genum
to list all values of type a
.
The b -> Maybe a
decoding function, then, consists of a lookup from that map.
=
invert f let
= foldMap (\a -> Map.singleton (f a) a) genum
reverseMap in
-> Map.lookup b reverseMap \b
Now we can use the invert
function to generate the decoding functions for Product
and Bill
with minimal effort.
decodeProduct :: String -> Maybe Product
= invert encodeProduct
decodeProduct
decodeBill :: Integer -> Maybe Bill
= invert encodeBill decodeBill
=
main do
We demonstrate by printing the results of some encodings and decodings.
putStrLn (encodeProduct Basic)
putStrLn (encodeProduct Standard)
putStrLn (show (decodeProduct "p1"))
putStrLn (show (decodeProduct "xyz"))
putStrLn (show (encodeBill (Bill Basic Annual)))
putStrLn (show (encodeBill (Bill Pro Monthly)))
putStrLn (show (decodeBill 31))
putStrLn (show (decodeBill 50))
encodeProduct
maps Basic
to "p1"
and Standard
to "p2"
.
decodeProduct
maps "p1"
back to Just Basic
. But it maps "xyz"
to Nothing
, because "xyz"
is not the encoding of any product.
$ runhaskell invert.hs
p1
p2
Just Basic
Nothing
11
30
Just (Bill Pro Annual) Nothing
Next: Dynamic typing