存在的反模式,如何避免

Question

下面似乎有用...但它看起来很笨拙.

data Point = Point Int Int
data Box = Box Int Int
data Path = Path [Point]
data Text = Text

data Color = Color Int Int Int
    data WinPaintContext = WinPaintContext Graphics.Win32.HDC

class CanvasClass vc paint where
    drawLine :: vc -> paint -> Point -> Point -> IO ()
    drawRect :: vc -> paint -> Box -> IO ()
    drawPath :: vc -> paint -> Path -> IO ()

class (CanvasClass vc paint) => TextBasicClass vc paint where
    basicDrawText :: vc -> paint -> Point -> String -> IO ()

instance CanvasClass WinPaintContext WinPaint where
    drawLine = undefined
    drawRect = undefined
    drawPath = undefined

instance TextBasicClass WinPaintContext WinPaint where
    basicDrawText (WinPaintContext a) = winBasicDrawText a

op :: CanvasClass vc paint => vc -> Box -> IO ()
op canvas _ = do
    basicDrawText canvas WinPaint (Point 30 30) "Hi"

open :: IO ()
open = do
    makeWindow (Box 300 300) op

winBasicDrawText :: Graphics.Win32.HDC -> WinPaint -> Point -> String -> IO ()
winBasicDrawText hdc _ (Point x y) str = do
    Graphics.Win32.setBkMode hdc Graphics.Win32.tRANSPARENT
    Graphics.Win32.setTextColor hdc (Graphics.Win32.rgb 255 255 0)
    Graphics.Win32.textOut hdc 20 20 str
    return ()

windowsOnPaint :: (WinPaintContext -> Box -> IO ()) ->
                  Graphics.Win32.RECT ->
                  Graphics.Win32.HDC ->
                  IO ()
windowsOnPaint f rect hdc = f (WinPaintContext hdc) (Box 30 30)

makeWindow :: Box -> (WinPaintContext -> Box -> IO ()) -> IO ()
makeWindow (Box w h) onPaint =
  Graphics.Win32.allocaPAINTSTRUCT $ \ lpps -> do
  hwnd <- createWindow w h (wndProc lpps (windowsOnPaint onPaint))
  messagePump hwnd

现在,似乎首选的方法就是简单地拥有

data Canvas = Canvas {
    drawLine :: Point -> Point -> IO (),
    drawRect :: Box -> IO (),
    drawPath :: Path -> IO ()
}

hdc2Canvas :: Graphics.Win32.HDC -> Paint -> IO ( Canvas )
hdc2Canvas hdc paint = Canvas { drawLine = winDrawLine hdc paint ... }

然而...

我们喜欢在整个绘图过程中保持颜色并改变它们,因为它们的制作和销毁成本很高.一个油漆可能只是一个像[bgColor red,fgColor blue,font"Tahoma"]之类的东西,或者它可能是一个指向绘图系统使用的内部结构的指针(这是对Windows GDI的抽象,但最终会抽象在direct2d和coregraphics),它有"画"对象,我不想一遍又一遍地重新创建然后绑定.

在我心中存在的美丽之处在于它们可以不透明地包裹着某些东西来抽象它,我们可以把它保存在某个地方,把它拉回来,无论如何.当您部分申请时,我认为存在的问题是,您已部分应用的东西现在"卡在"容器内部.这是一个例子.说我有一个油漆对象

data Paint = Paint {
    setFg :: Color -> IO () ,
    setBg :: Color -> IO ()
}

我在哪里可以放置指针？当我将Paint赋予Canvas中的某些功能时,他如何获得指针？设计此API的正确方法是什么？

Answer 1

界面

首先,您需要问"我的要求是什么？".让我们用简单的英语说明我们想要画布做什么(这些是我根据你的问题猜测的):

• 有些画布可以有形状
• 有些画布可以放置文字
• 一些画布根据油漆改变他们的行为
• 我们还不知道什么是油漆,但它们对于不同的画布会有所不同

现在我们将这些想法转化为Haskell.Haskell是一种"类型优先"的语言,所以当我们讨论需求和设计时,我们可能正在谈论类型.

• 在Haskell中,当我们在讨论类型时看到"some"这个词时,我们会想到类型类.例如,show该类说"某些类型可以表示为字符串".
• 当我们谈论我们尚未了解的事情时,在谈论需求时,这是一种我们不知道它是什么的类型.这是一个类型变量.
• "穿上它们"似乎意味着我们需要一块帆布,在上面放一些东西,并再次使用画布.

现在我们可以为每个要求编写类:

class ShapeCanvas c where -- c is the type of the Canvas
    draw :: Shape -> c -> c

class TextCanvas c where
    write :: Text -> c -> c

class PaintCanvas p c where -- p is the type of Paint
    load :: p -> c -> c

类型变量c仅使用一次,显示为c -> c.这表明我们可以通过更换使这些更普遍的c -> c使用c.

class ShapeCanvas c where -- c is the type of the canvas
    draw :: Shape -> c

class TextCanvas c where
    write :: Text -> c

class PaintCanvas p c where -- p is the type of paint
    load :: p -> c

现在PaintCanvas看来class在Haskell中存在问题.类型系统很难弄清楚课程中发生了什么

class Implicitly a b where
    convert :: b -> a

我通过改变PaintCanvas利用TypeFamilies扩展来缓解这个问题.

class PaintCanvas c where 
    type Paint c :: * -- (Paint c) is the type of Paint for canvases of type c
    load :: (Paint c) -> c

现在,让我们为我们的界面整理所有内容,包括形状和文本的数据类型(修改后对我有意义):

{-# LANGUAGE TypeFamilies #-}

module Data.Canvas (
    Point(..),
    Shape(..),
    Text(..),
    ShapeCanvas(..),
    TextCanvas(..),
    PaintCanvas(..)
) where

data Point = Point Int Int

data Shape = Dot Point
           | Box Point Point 
           | Path [Point]

data Text = Text Point String

class ShapeCanvas c where -- c is the type of the Canvas
    draw :: Shape -> c

class TextCanvas c where
    write :: Text -> c

class PaintCanvas c where 
    type Paint c :: * -- (Paint c) is the type of Paint for canvases of type c
    load :: (Paint c) -> c

一些例子

本节将介绍除了我们已经制定的有用画布之外的其他要求.这是我们,当我们失去了取代模拟c -> c与c画布类.

让我们从您的第一个示例代码开始op.使用我们的新界面,它简单地说:

op :: (TextCanvas c) => c
op = write $ Text (Point 30 30) "Hi"

让我们做一个稍微复杂的例子.绘制"X"的东西怎么样？我们可以制作"X"的第一个笔画

ex :: (ShapeCanvas c) => c
ex = draw $ Path [Point 10 10, Point 20 20]

但是我们没有办法为横行添加另一个Path.我们需要一些方法将两个绘图步骤放在一起.类型的东西c -> c -> c是完美的.最简单的Haskell类我能想到的,提供这个Monoid a的mappend :: a -> a -> a.A Monoid需要身份和相关性.假设画布上的绘画操作不受影响,这是否合理？这听起来很合理.假设以相同的顺序完成的三个绘制操作即使前两个一起执行,然后是第三个,或者如果执行第一个,然后第二个和第三个一起执行,则是合理的？再说一遍,这对我来说似乎很合理.这表明我们可以写成ex:

ex :: (Monoid c, ShapeCanvas c) => c
ex = (draw $ Path [Point 10 10, Point 20 20]) `mappend` (draw $ Path [Point 10 20, Point 20 10])

最后,让我们考虑交互式的东西,根据外部事物决定要绘制什么:

randomDrawing :: (MonadIO m, ShapeCanvas (m ()), TextCanvas (m ())) => m ()
randomDrawing = do
    index <- liftIO . getStdRandom $ randomR (0,2)
    choices !! index        
    where choices = [op, ex, return ()]

这不太有效,因为我们没有一个实例,(Monad m) => Monoid (m ())因此ex可以工作.我们可以使用Data.Semigroup.Monadreducers包,或者自己添加一个,但这会让我们陷入不连贯的境地.将ex更改为:

ex :: (Monad m, ShapeCanvas (m ())) => m ()
ex = do
    draw $ Path [Point 10 10, Point 20 20]
    draw $ Path [Point 10 20, Point 20 10]

但是类型系统不能完全弄清楚第一个draw单元与第二个单元相同.我们在这里的困难提出了额外的要求,我们最初无法完全理解:

• 画布扩展现有的操作序列,提供绘图,书写文本等操作.

直接从http://www.haskellforall.com/2013/06/from-zero-to-cooperative-threads-in-33.html窃取:

• 当你听到"指令序列"时,你应该想:"monad".
• 当你用"延伸"来限定它时你应该想:"monad transformer".

现在我们意识到我们的canvas实现很可能是monad转换器.我们可以回到我们的界面,并更改它,以便每个类都是monad的类,类似于变换器的MonadIO类和mtl的monad类.

界面,重新审视

{-# LANGUAGE TypeFamilies #-}

module Data.Canvas (
    Point(..),
    Shape(..),
    Text(..),
    ShapeCanvas(..),
    TextCanvas(..),
    PaintCanvas(..)
) where

data Point = Point Int Int

data Shape = Dot Point
           | Box Point Point 
           | Path [Point]

data Text = Text Point String

class Monad m => ShapeCanvas m where -- c is the type of the Canvas
    draw :: Shape -> m ()

class Monad m => TextCanvas m where
    write :: Text -> m ()

class Monad m => PaintCanvas m where 
    type Paint m :: * -- (Paint c) is the type of Paint for canvases of type c
    load :: (Paint m) -> m ()

重新考虑的例子

现在我们所有的示例绘图操作都是一些未知的动作Monad:

op :: (TextCanvas m) => m ()
op = write $ Text (Point 30 30) "Hi"

ex :: (ShapeCanvas m) => m ()
ex = do
    draw $ Path [Point 10 10, Point 20 20]
    draw $ Path [Point 10 20, Point 20 10]


randomDrawing :: (MonadIO m, ShapeCanvas m, TextCanvas m) => m ()
randomDrawing = do
    index <- liftIO . getStdRandom $ randomR (0,2)
    choices !! index        
    where choices = [op, ex, return ()]

我们也可以用油漆做一个例子.由于我们不知道哪些涂料将存在,因此它们都必须在外部提供(作为示例的参数):

checkerBoard :: (ShapeCanvas m, PaintCanvas m) => Paint m -> Paint m -> m ()
checkerBoard red black = 
    do
        load red
        draw $ Box (Point 10 10) (Point 20 20)
        draw $ Box (Point 20 20) (Point 30 30)
        load black
        draw $ Box (Point 10 20) (Point 20 30)
        draw $ Box (Point 20 10) (Point 30 20)

实施

如果您可以使用各种绘图来使代码工作以绘制点,框,线和文本而不引入抽象,我们可以更改它以实现第一部分中的接口.