Haskell: is there a way of 'mapping' over an algebraic data type? - haskell

Question

Suppose that I have some simple algebraic data (essentially enums) and another type which has these enums as fields.
data Color = Red | Green | Blue deriving (Eq, Show, Enum, Ord)
data Width = Thin | Normal | Fat deriving (Eq, Show, Enum, Ord)
data Height = Short | Medium | Tall deriving (Eq, Show, Enum, Ord)
data Object = Object { color :: Colour
, width :: Width
, height :: Height } deriving (Show)
Given a list of objects, I want to test that the attributes are all distinct. For this I have following functions (using sort from Data.List)
allDifferent = comparePairwise . sort
where comparePairwise xs = and $ zipWith (/=) xs (drop 1 xs)
uniqueAttributes :: [Object] -> Bool
uniqueAttributes objects = all [ allDifferent $ map color objects
, allDifferent $ map width objects
, allDifferent $ map height objects ]
This works, but is rather dissatisfying because I had to type each field (color, width, height) manually. In my actual code, there are more fields! Is there a way of 'mapping' the function
\field -> allDifferent $ map field objects
over the fields of an algebraic datatype like Object? I want to treat Object as a list of its fields (something that would be easy in e.g. javascript), but these fields have different types...

Answer 1

Here is a solution using generics-sop:
pointwiseAllDifferent
:: (Generic a, Code a ~ '[ xs ], All Ord xs) => [a] -> Bool
pointwiseAllDifferent =
and
. hcollapse
. hcmap (Proxy :: Proxy Ord) (K . allDifferent)
. hunzip
. map (unZ . unSOP . from)
hunzip :: SListI xs => [NP I xs] -> NP [] xs
hunzip = foldr (hzipWith ((:) . unI)) (hpure [])
This assumes that the type Object you want to compare is a record type and requires that you make this type an instance of the class Generic, which can be done using Template Haskell:
deriveGeneric ''Object
Let's try to see what's going on here by looking at a concrete example:
objects = [Object Red Thin Short, Object Green Fat Short]
The line map (unZ . unSOP . from) converts each Object into a heterogeneous list (called an n-ary product in the library):
GHCi> map (unZ . unSOP . from) objects
[I Red :* (I Thin :* (I Short :* Nil)),I Green :* (I Fat :* (I Short :* Nil))]
The hunzip then turns this list of products into a product where each element is a list:
GHCi> hunzip it
[Red,Green] :* ([Thin,Fat] :* ([Short,Short] :* Nil))
Now, we apply allDifferent to each list in the product:
GHCi> hcmap (Proxy :: Proxy Ord) (K . allDifferent) it
K True :* (K True :* (K False :* Nil))
The product is now in fact homogeneous, as every position contains a Bool, so hcollapse turns it into a normal homogeneous list again:
GHCi> hcollapse it
[True,True,False]
The last step just applies and to it:
GHCi> and it
False

Answer 2

For this very specific situation (checking a set of attributes that are simple sum types with 0-arity constructors), you can use the following construction using Data.Data generics:
{-# LANGUAGE DeriveDataTypeable #-}
module Signature where
import Data.List (sort, transpose)
import Data.Data
data Color = Red | Green | Blue deriving (Eq, Show, Enum, Ord, Data)
data Width = Thin | Normal | Fat deriving (Eq, Show, Enum, Ord, Data)
data Height = Short | Medium | Tall deriving (Eq, Show, Enum, Ord, Data)
data Object = Object { color :: Color
, width :: Width
, height :: Height } deriving (Show, Data)
-- |Signature of attribute constructors used in object
signature :: Object -> [String]
signature = gmapQ (show . toConstr)
uniqueAttributes :: [Object] -> Bool
uniqueAttributes = all allDifferent . transpose . map signature
allDifferent :: (Ord a) => [a] -> Bool
allDifferent = comparePairwise . sort
where comparePairwise xs = and $ zipWith (/=) xs (drop 1 xs)
The key here is the function signature which takes an object and generically across its immediate children calculates the constructor name of each child. So:
*Signature> signature (Object Red Fat Medium)
["Red","Fat","Medium"]
*Signature>
If there are any fields other than these simple sum types, (like say an attribute of type data Weight = Weight Int or if you added a name :: String field to Object), then this will suddenly fail.
(Edited to add:) Note that you can use constrIndex . toConstr in place of show . toConstr to use an Int-valued constructor index (basically, the index starting with 1 of the constructor within the data definition), if this feels less indirect. If the Constr returned by toConstr had an Ord instance, there would be no indirection at all, but unfortunately...