Можно упростить до графических примитивов – прямоугольника и круга. Но, отображение графики тоже отвлечёт внимание. Пожалуй, упрощу ещё. Пусть конечное действие будет вывод сообщений в терминал, например
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
This entry passed through the Full-Text RSS service - if this is your content and you're reading it on someone else's site, please read the FAQ at http://ift.tt/jcXqJW.
Комментариев нет:
Отправить комментарий