Пример решения типичной ООП задачи на языке Haskell

Рассмотрим типичную задачу, из тех, что обычно считаются «ООП-эшными». Имеется список данных (объектов) имеющих не одинаковые структуры (по научному, гетерогенный список), при чём, над каждым нужно выполнять одинаковые действия – по простому, каждый можно передать в некую функцию. Первое, что приходит на ум – элементы GUI, но для примера они не годятся, понадобится подключать большие пакеты и слишком много места займёт код, к сущности ООП в Haskell отношения не имеющий.

Можно упростить до графических примитивов – прямоугольника и круга. Но, отображение графики тоже отвлечёт внимание. Пожалуй, упрощу ещё. Пусть конечное действие будет вывод сообщений в терминал, например

paint rectangle, Rect {left = 10, top = 20, right = 600, bottom = 400}
paint circle, radius=150 and centre=(50,300)

А Уважаемый Читатель подключит воображение.

И так, мы определяем два типа данных, описывающих фигуры (Примечание: существует множество способов решения задачи. Некоторые альтернативы приведены в комментариях к этой статье).

data Rect = Rect { left   :: Int
                 , top    :: Int
                 , right  :: Int
                 , bottom :: Int
                 } deriving Show

data Circle = Circle { x      :: Int
                     , y      :: Int
                     , radius :: Int
                     }

Сейчас нужно решить, как их объединить в неоднородный список. Объединение через Алгебраический Тип Данных (АТД)

data Figures = RectFigure Rect
             | CircleFigure Circle

нежелательно. Кроме необходимости перебора конструкторов при каждом обращении, АТД потребует вносить изменение в него при каждом добавлении новой фигуры. Разве в базовый класс С++, в ООП иерархии, требуется вносить изменения при добавлении потомка? В правильно спроектированный не требуется. Ну, так в Haskell должно быть лучше, а не хуже!

В Haskell уже имеются наследования классов типов и инстанцирование классов типов, которое тоже можно рассматривать как наследование.
Вот такой базовый класс с «наворотами» я придумал для примера.

class Paint a where
  paint:: a -> Handle -> IO ()
  paint o handle = hPutStrLn handle $ "paint " ++ say o ++ "   S=" ++ show ( circumSquare o )

  say:: a -> String  -- как бы абстрактный метод
  circumSquare:: a -> Int -- ещё один абстрактный. Площадь описанного прямоугольника

Внешняя функция, для каждого экземпляра наших типов, будет вызывать paint:: a -> Handle -> IO (), которая реализована прямо в этом классе. Вместо указателя на графический контекст, или какую ни будь канву, упрощённая функция «рисования» принимает хэндл файла. Она выводит строку «paint », описание выводимого объекта, получаемого ею от функции say (имитируем механизм виртуальных функций), а так же площадь описанного прямоугольника. Зачем площадь? Далее видно будет, зачем она мне понадобилась.

Подключим удобное расширение RecordWildCards и опишем экземпляры базового класса для наших типов.

instance Paint Rect where
  say r = "rectangle, " ++ show r  
  circumSquare (Rect {..}) = ( right - left ) * ( bottom - top )

instance Paint Circle where
  say (Circle {..}) = "circle, radius=" ++ show radius ++ "  and centre=(" ++ show x ++
                      "," ++ show y ++ ")"  
  circumSquare (Circle {..}) = (2*radius)^2

Пока всё просто. Для Circle я не воспользовался deriving Show, сформировал «строку вручную», уж так мне захотелось. В остальном ничего особенного. Осталось объединить разные типы в один список. Для этого я воспользуюсь расширением ExistentialQuantification, которое позволяет объединять вместе с данными, функции из инстансов (экземпляров) конкретных типов. Что бы это сделать, понадобится создать простой вспомогательный тип.

data Figure = forall a. Paint a =>  Figure a

«Заклинание» forall a. Paint a означает, что вместе с данными некого типа а, будут завёрнуты и функции класса Paint для этого типа (Разумеется, компилятор потребует, чтобы тип аргумента конструктора Figure был экземпляром класса Paint).

Добавить, допустим, треугольник тривиально. Интересно, добавить что то, что очень похоже, его реализация приведёт к дублированию кода, и постараться исключить дублирующийся код.

Возьмём прямоугольник с закруглёнными углами. Дублирующийся код в примере – это расчёт площади описанного прямоугольника.
Haskell (в отличии от ООП языков) не позволяет наращивать, расширять (по ООП-эшному наследовать) типы данных, в том числе и структуры. Придётся вложить структуру описывающую прямоугольник в новую структуру.

data Roundrect = Roundrect { baseRect :: Rect 
                           , roundR   :: Int
                           }

instance Paint Roundrect where
    say (Roundrect {..}) = "round rectangle, " ++ show baseRect ++ " and roundR=" ++ show roundR 
    circumSquare (Roundrect {..}) = circumSquare baseRect

Казалось бы, всё замечательно, мы пользуемся кодом из instance Paint Rect для реализации новых функций в instance Paint Roundrect. Но, представьте, что в реальном проекте у нас 42 наследования от Rect, и для Rect были определены 28 функций, которые должны делать одно и тоже, и для типа Rect, и для наследований от него. Пришлось бы много раз записать функции, вроде

circumSquare (Roundrect {..}) = circumSquare baseRect 
-- ….
funN (TypeM  {..}) = funN baseRect

что скучно. Напрашивается создание промежуточного экземпляра класса Paint, в котором будет реализован общий для всех наследований код, а уникальный, пусть реализуется в отдельном классе. Связать оба класса я собираюсь с помощью data family, которое включается с помощью {-# LANGUAGE TypeFamilies #-} (разумеется, type family при этом тоже включается).
Определяем семейство всяких прямоугольников.

data family RectFamily a

И класс использующий это семейство

class PaintRect a where
    getRect :: RectFamily a -> Rect
    rectSay :: RectFamily a -> String

В классе, как я и обещал, будут реализованы уникальные особенности каждого прямоугольника. getRect будет возвращать координаты прямоугольника, где бы они не были запрятаны в типе. А rectSay – это просто ранее определённая say для прямоугольников.

Теперь экземпляр класса Paint для семейства, в котором реализуются, наоборот, одинаковые для всех прямоугольников функции.

instance PaintRect a => Paint (RectFamily a) where
  say = rectSay
  circumSquare w = let (Rect {..}) = getRect w 
                   in ( right - left ) * ( bottom - top )

Как видим, say просто вызывает rectSay, описанную выше. А площадь описанного прямоугольника рассчитывается одинаково для всех прямоугольников (по крайней мере, пусть будет так для примера).

Для каждого типа фигуры придётся придумать имя нового конструктора (в данном случае RectWrap).

data instance RectFamily Rect = RectWrap Rect

instance PaintRect Rect where
    getRect (RectWrap r) = r
    rectSay (RectWrap r) = "rectangle, " ++ show r  

Для Rect всё проще простого. getRect возвращает сам Rect развёрнутый из RectWrap. Функция rectSay тоже тривиальна. Кстати, её можно записать и как

    rectSay w = "rectangle, " ++ show (getRect w)

Для Roundrect чуть сложнее.

data instance RectFamily Roundrect = RoundrectWrap Roundrect

instance PaintRect Roundrect where
    getRect (RoundrectWrap r) = baseRect r
    rectSay (RoundrectWrap (Roundrect {..})) = "round rectangle, " ++ show baseRect ++ " and roundR=" ++ show roundR   

Наконец, всё вместе, немного причёсанное. Например, добавлены функции – конструкторы для типов фигур.