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
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 -- .
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
data Figure = forall a. Paint a => Figure a
{-# 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
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
circumSquare (Roundrect {..}) = circumSquare baseRect -- …. funN (TypeM {..}) = funN baseRect
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 (RectWrap r) = "rectangle, " ++ show r
rectSay w = "rectangle, " ++ show (getRect w)
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 ltrb = Figure $ RectWrap (Rect ltrb) 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 xyr = Figure $ Circle xyr -- . . 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 ltrb rr = Figure $ RoundrectWrap $ Roundrect (Rect ltrb) 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
Source: https://habr.com/ru/post/263575/
All Articles