📜 ⬆️ ⬇️

An example of solving a typical OOP problem in the Haskell language

Consider a typical task, from those that are usually considered "OOP-Eshnymi." There is a list of data (objects) having not identical structures (according to scientific, heterogeneous list), with that, on each one you need to perform the same actions - simply, each can be transferred to a certain function. The first thing that comes to mind is GUI elements, but for example they don’t work, you need to plug in large packets and the code takes too much space, which has no relation to the essence of OOP in Haskell.

You can simplify to graphic primitives - a rectangle and a circle. But, displaying graphics will also distract attention. Perhaps even simplified. Let the final action be the output of messages to the terminal, for example

paint rectangle, Rect {left = 10, top = 20, right = 600, bottom = 400}
paint circle, radius=150 and centre=(50,300)

A dear reader connects the imagination.
')
And so, we define two types of data describing figures ( Note: there are many ways to solve the problem. Some alternatives are given in the comments to this article ).
 data Rect = Rect { left :: Int , top :: Int , right :: Int , bottom :: Int } deriving Show data Circle = Circle { x :: Int , y :: Int , radius :: Int } 

Now we need to decide how to combine them into a non-uniform list. Integration through Algebraic Data Type (ADT)
 data Figures = RectFigure Rect | CircleFigure Circle 

undesirable. In addition to the need to search for designers with each treatment, the ADT will require a change in it with each addition of a new shape. Does the base class C ++, the OOP hierarchy, require changes when adding a child? A properly designed is not required. Well, in Haskell it should be better, not worse!

Haskell already has inheritance of type classes and instantiation of type classes, which can also be considered as inheritance.
Here is a base class with the "twists" I came up with for example.
 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 --   .    

The external function, for each instance of our types, will call paint :: a -> Handle -> IO () , which is implemented directly in this class. Instead of a pointer to a graphics context, or whatever the outline, the simplified “drawing” function accepts a file handle. It displays the string “paint”, a description of the output object that it receives from the say function (we imitate the mechanism of virtual functions), as well as the area of ​​the described rectangle. Why square? Further it will be clear why I needed it.

We connect the convenient RecordWildCards extension and describe the base class instances for our types.
 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 

So far, everything is simple. For Circle, I did not use deriving Show , I formed a “string manually”, I really wanted to. The rest is nothing special. It remains to combine different types into one list. To do this, I will use the ExistentialQuantification extension, which allows you to combine, together with data, functions from instances (instances) of specific types. To do this, you need to create a simple auxiliary type.
 data Figure = forall a. Paint a => Figure a 

"Spell" forall a. Paint a means that along with data of a certain type a, the functions of the Paint class for this type will also be wrapped (Of course, the compiler will require that the type of the argument of the Figure constructor be an instance of the Paint class).
Together
 {-# 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 


Adding, say, a triangle is trivial. It is interesting to add something that is very similar, its implementation will lead to duplication of code, and try to eliminate duplicate code.

Take a rounded rectangle. Duplicate code in the example is the calculation of the area of ​​the described rectangle.
Haskell (unlike OOP languages) does not allow to increase, expand (by OOP-effective inherit) data types, including the structure. We'll have to nest the structure describing the rectangle into the new structure.
 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 

It would seem that everything is great, we use the code from the instance Paint Rect to implement new functions in the instance Paint Roundrect . But, imagine that in a real project we have 42 inheritances from Rect , and 28 functions were defined for Rect , which should do the same for both the Rect type and for inheritances from it. I would have to write functions many times, like
 circumSquare (Roundrect {..}) = circumSquare baseRect -- …. funN (TypeM {..}) = funN baseRect 

which is boring. This suggests the creation of an intermediate instance of the Paint class, in which the code common to all inheritances will be implemented, and unique, albeit implemented in a separate class. I am going to link both classes using the data family , which is enabled using {- # LANGUAGE TypeFamilies # -} (of course, the type family is also enabled).
We define the family of all rectangles.
 data family RectFamily a 

And a class using this family
 class PaintRect a where getRect :: RectFamily a -> Rect rectSay :: RectFamily a -> String 

In the class, as I promised, the unique features of each rectangle will be implemented. getRect will return the coordinates of the rectangle wherever they are hidden in the type. And rectSay is just the previously defined say for rectangles.

Now an instance of the Paint class for the family in which, on the contrary, the functions are implemented are the same for all rectangles.
 instance PaintRect a => Paint (RectFamily a) where say = rectSay circumSquare w = let (Rect {..}) = getRect w in ( right - left ) * ( bottom - top ) 

As you can see, say just calls rectSay , described above. And the area of ​​the described rectangle is calculated equally for all rectangles (at least, let it be so for example).

For each type of shape you will have to come up with the name of a new constructor (in this case, RectWrap).
 data instance RectFamily Rect = RectWrap Rect instance PaintRect Rect where getRect (RectWrap r) = r rectSay (RectWrap r) = "rectangle, " ++ show r 

For Rect everything is easy. getRect returns the Rect itself expanded from a RectWrap . The rectSay function is also trivial. By the way, it can be written as
  rectSay w = "rectangle, " ++ show (getRect w) 

Roundrect is a bit more complicated.
 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 

Finally, all together, a little combed. For example, added functions - constructors for shape types.
Complete, final code
 {-# 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