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

  • Tutorial
Рассмотрим типичную задачу, из тех, что обычно считаются «ООП-эшными». Имеется список данных (объектов) имеющих не одинаковые структуры (по научному, гетерогенный список), при чём, над каждым нужно выполнять одинаковые действия – по простому, каждый можно передать в некую функцию. Первое, что приходит на ум – элементы 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).
Всё вместе
{-# LANGUAGE ExistentialQuantification, RecordWildCards #-}
import System.IO
import Control.Monad

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 -- ещё один абстрактный. Площадь описывающего прямоугольника
  
data Rect = Rect { left   :: Int
                 , top    :: Int
                 , right  :: Int
                 , bottom :: Int
                 } deriving Show

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

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

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

lst :: [Figure]
lst = [Figure (Rect 10 20 600 400), Figure (Circle 50 300 150)]

main = forM_  lst $ \  
            (Figure obj) -> paint obj stdout


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

Возьмём прямоугольник с закруглёнными углами. Дублирующийся код в примере – это расчёт площади описанного прямоугольника.
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   

Наконец, всё вместе, немного причёсанное. Например, добавлены функции – конструкторы для типов фигур.
Полный, окончательный код
{-# LANGUAGE ExistentialQuantification, RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

import System.IO
import Control.Monad

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 -- ещё один абстрактный. Площадь описывающего прямоугольника

data Figure = forall a. Paint a =>  Figure a
 
data Rect = Rect { left   :: Int
                 , top    :: Int
                 , right  :: Int
                 , bottom :: Int
                 } deriving Show

data family RectFamily a

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

data instance RectFamily Rect = RectWrap Rect

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

mkRect:: Int ->  Int ->  Int ->  Int -> Figure 
mkRect l t r b = Figure $ RectWrap (Rect l t r b)
  
data Circle = Circle { x      :: Int
                     , y      :: Int
                     , radius :: Int
                     }

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

mkCircle:: Int ->  Int ->  Int -> Figure
mkCircle x y r = Figure $ Circle x y r
  
-- Расширение прямоугольника в прямоугольник с закруглёнными краями. Требуется доп. поле  
data Roundrect = Roundrect { baseRect :: Rect 
                           , roundR   :: Int
                           }

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   

mkRoundrect:: Int ->  Int ->  Int ->  Int -> Int -> Figure
mkRoundrect l t r b rr = Figure $ RoundrectWrap $ Roundrect (Rect l t r b) rr

-- Список фигур разных типов.
lst :: [Figure]
lst = [ mkRect 10 20 600 400, mkCircle 50 300 150, mkRoundrect 30 40 500 200 5 ]

-- Отображаем фигуры разных типов.
main = forM_  lst $ \  
            (Figure obj) -> paint obj stdout

Similar posts

Ads
AdBlock has stolen the banner, but banners are not teeth — they will be back

More

Comments 9

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

    Мне кажется, или это должно быть
    data Figure = forall a. Paint a => Figure a
    

    т.е. у тайпконструктора Figure не должно быть параметра? Ведь он квантифицируется forall'ом, следовательно, это связанная типовая переменная внутри самого определения типа.
      0
      Вы правы. Поправил. Спасибо.
      +6
      Спасибо за статью, как раз недавно разбирался немного с хаскеллом.
      Пример слегка демотивирует — выглядит громоздко и нечитаемо по сравнению с ООП-версией.
        +3
        Для этого я воспользуюсь расширением ExistentialQuantification, которое позволяет объединять вместе с данными

        И получить антипаттерн.
        А если вспомнить, что объекты – это замыкания для бедных, требуемую задачу можно изобразить без каких-либо языковых расширений:
        import System.IO
        import Text.Printf
        
        data Figure = Figure
            { paint :: Handle -> IO ()
            , say :: String
            , circumSquare :: Int
            }
        
        base child = child
            { paint = \handle -> hPutStrLn handle $ printf "paint %s    S=%d" (say child) (circumSquare child)
            }
        
        type Point = (Int, Int)
        data Rect = Rect {left, top, right, bottom :: Int}
            deriving Show
        
        makeRect :: Point -> Point -> Rect
        makeRect (left, top) (right, bottom) = Rect left top right bottom
        
        circle :: Point -> Int -> Figure
        circle (x, y) radius = base $ Figure
            { say = printf "circle, radius=%d and centre=(%d,%d)" radius x y
            , circumSquare = (2 * radius) ^ 2
            }
        
        rect :: Point -> Point -> Figure
        rect lt@(left, top) rt@(right, bottom) = base $ Figure
            { say = show $ makeRect lt rt
            , circumSquare = (right - left) * (bottom - top)
            }
        
        roundrect :: Point -> Point -> Int -> Figure
        roundrect lt rt roundR = (rect lt rt)
            { say = printf "round rectangle, %s and roundR = %d" (show $ makeRect lt rt) roundR
            }
          +3
          Рад Вашему энтузиазму. (Без сарказма). Статью антипаттерн читал по ссылки с dev.stephendiehl.com/hask — это частное мнение, а не абсолют. То, что задачу можно решить разными способами, не сомневаюсь. И разные варианты имеют свои недостатки. Например, у Вас исходные координаты теряются, превращаясь сразу в строки. Конкретный пример решается, но, если потребуется координаты использовать разными способами, то станет посложнее (хотя, тоже решается). Я знаю и то что, в Haskell, вобщем то, не стОит применять ООП-шаблоны, а использовать Haskell-евские приёмы. Однако, есть тенденция — arxiv.org/pdf/cs/0509027v1.pdf
          Кратко: у меня пример, демонстрирующий некоторые языковые расширения и использование классов типов. У Вас другой пример. Ничего не имею против. Поставлю лайк на Ваш ответ.
            +1
            Что значит «теряются» (если они вон используются в нескольких местах), что значит «сразу» (особенно учитывая ленивую модель)?
            То, что задачу можно решить разными способами, не сомневаюсь.

            Это да. Однако обсуждения – они в первую очередь для «зрителей», и если забредший на функциональный огонёк неофит ужаснётся, сколько всего нужно накрутить, чтобы решить такую простую в ОО-языке задачу, то ему стоит увидеть и альтернативный подход.
            Возможно, статье лучше бы подошло название вроде «Эмуляция традиционного ООП на языке Haskell».
              +1
              Что значит «теряются» (если они вон используются в нескольких местах)

              В смысле, что их не получить из списка [Figure], т.е. мы вынуждены реализовать все возможные действия как функции в Figure, т.е. объединяем хранение с логикой и представлением.
              Возможно, статье лучше бы подошло название вроде «Эмуляция традиционного ООП на языке Haskell».

              Мне кажется, что эмуляция — это, например, wiki.haskell.org/OOP_vs_type_classes, п.5. По классу типов на каждый тип данных.
              То что у меня тоже сохраняются исходные данные и приходится использовать ExistentialQuantification — ну, не является оно абсолютным злом. По Вашей же ссылке: «Замыкания — это объекты для бедных!». Я, конечно, так не считаю, но название пока оставлю. Вставлю в начало статьи упоминание о приведённой ниже Вашей альтернативе.
                0
                В смысле, что их не получить из списка [Figure]

                Так и в вашем коде не получить. Т.е. получить можно, но всё, что можно сделать — это позвать функции класса Paint, разве нет?
                  0
                  data Figure = forall x . (Typeable x, Paint x) => Figure x
                  Далее безопасно кастуете и выбираете наздоровье. В добавок можно ещё и красивые линзы прикрутить.
                  В целом использование явного словаря data D = D { ... } или невного класса-типов D это достаточно близкие методы, с небольшой разницей, вроде той, что в случае класса типов, для одного параметра у нас гарантируется наличие единственной реализации функций, чего нету в случае явного словаря. Так-же из функций класса типов мы можем достать сам словарь Dict (c::Constraint) и передавать его явно или восстановить его по прокси переменной. Все тоже самое возможно и с явным словарём, но с большим количеством страданий.

        Only users with full accounts can post comments. Log in, please.