Можно упростить до графических примитивов – прямоугольника и круга. Но, отображение графики тоже отвлечёт внимание. Пожалуй, упрощу ещё. Пусть конечное действие будет вывод сообщений в терминал, например
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
Комментарии (7)
Rimsan
27.07.2015 13:08+6Спасибо за статью, как раз недавно разбирался немного с хаскеллом.
Пример слегка демотивирует — выглядит громоздко и нечитаемо по сравнению с ООП-версией.
Yuuri
27.07.2015 19:24+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 }
KolodeznyDiver Автор
27.07.2015 20:11+3Рад Вашему энтузиазму. (Без сарказма). Статью антипаттерн читал по ссылки с dev.stephendiehl.com/hask — это частное мнение, а не абсолют. То, что задачу можно решить разными способами, не сомневаюсь. И разные варианты имеют свои недостатки. Например, у Вас исходные координаты теряются, превращаясь сразу в строки. Конкретный пример решается, но, если потребуется координаты использовать разными способами, то станет посложнее (хотя, тоже решается). Я знаю и то что, в Haskell, вобщем то, не стОит применять ООП-шаблоны, а использовать Haskell-евские приёмы. Однако, есть тенденция — arxiv.org/pdf/cs/0509027v1.pdf
Кратко: у меня пример, демонстрирующий некоторые языковые расширения и использование классов типов. У Вас другой пример. Ничего не имею против. Поставлю лайк на Ваш ответ.Yuuri
27.07.2015 20:50+1Что значит «теряются» (если они вон используются в нескольких местах), что значит «сразу» (особенно учитывая ленивую модель)?
То, что задачу можно решить разными способами, не сомневаюсь.
Это да. Однако обсуждения – они в первую очередь для «зрителей», и если забредший на функциональный огонёк неофит ужаснётся, сколько всего нужно накрутить, чтобы решить такую простую в ОО-языке задачу, то ему стоит увидеть и альтернативный подход.
Возможно, статье лучше бы подошло название вроде «Эмуляция традиционного ООП на языке Haskell».KolodeznyDiver Автор
27.07.2015 21:20+1Что значит «теряются» (если они вон используются в нескольких местах)
В смысле, что их не получить из списка [Figure], т.е. мы вынуждены реализовать все возможные действия как функции в Figure, т.е. объединяем хранение с логикой и представлением.
Возможно, статье лучше бы подошло название вроде «Эмуляция традиционного ООП на языке Haskell».
Мне кажется, что эмуляция — это, например, wiki.haskell.org/OOP_vs_type_classes, п.5. По классу типов на каждый тип данных.
То что у меня тоже сохраняются исходные данные и приходится использовать ExistentialQuantification — ну, не является оно абсолютным злом. По Вашей же ссылке: «Замыкания — это объекты для бедных!». Я, конечно, так не считаю, но название пока оставлю. Вставлю в начало статьи упоминание о приведённой ниже Вашей альтернативе.
Googolplex
Мне кажется, или это должно быть
т.е. у тайпконструктора Figure не должно быть параметра? Ведь он квантифицируется forall'ом, следовательно, это связанная типовая переменная внутри самого определения типа.
KolodeznyDiver Автор
Вы правы. Поправил. Спасибо.