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

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

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...

Answer 2

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