Рассмотрим типичную задачу, из тех, что обычно считаются «ООП-эшными». Имеется список данных (объектов) имеющих не одинаковые структуры (по научному, гетерогенный список), при чём, над каждым нужно выполнять одинаковые действия – по простому, каждый можно передать в некую функцию. Первое, что приходит на ум – элементы 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 a = 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 a = forall a. Paint a => Figure a lst :: [Figure a] 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 a = 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 a 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 a 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 a mkRoundrect l t r b rr = Figure $ RoundrectWrap $ Roundrect (Rect l t r b) rr -- Список фигур разных типов. lst :: [Figure a] lst = [ mkRect 10 20 600 400, mkCircle 50 300 150, mkRoundrect 30 40 500 200 5 ] -- Отображаем фигуры разных типов. main = forM_ lst $ \ (Figure obj) -> paint obj stdout
ссылка на оригинал статьи http://habrahabr.ru/post/263575/
Добавить комментарий