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

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