haskell - 存在反模式，如何避免

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)，它们具有“绘制”对象，我不想一遍又一遍地重新创建然后绑定(bind)。

在我看来，存在主义的美妙之处在于它们可以不透明地包裹一些东西来抽象它，我们可以把它保存在某个地方，把它拉回来，等等。当您部分应用时，我认为存在问题，即您部分应用的东西现在“卡在”容器内。这是一个例子。说我有一个像

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

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

Answer 1

接口(interface)

首先，您需要问“我的要求是什么？”。让我们用简单的英语说明我们想要 Canvas 做什么(这些是我根据您的问题做出的猜测):

有些 Canvas 上可以有形状

有些 Canvas 上可以放文字

有些 Canvas 会根据油漆改变它们的作用

我们还不知道什么是颜料，但对于不同的 Canvas ，它们会有所不同

现在我们将这些想法翻译成 Haskell。 Haskell 是一种“类型优先”的语言，所以当我们谈论需求和设计时，我们可能在谈论类型。

在 Haskell 中，当我们在谈论类型时看到“some”这个词时，我们会想到类型类。例如，show类说“某些类型可以表示为字符串”。

当我们谈论一些我们还不知道的东西时，在谈论需求时，那是一种我们还不知道它是什么的类型。那是一个类型变量。

“穿上它们”似乎意味着我们会拿一块 Canvas ，在上面放一些东西，然后再有一块 Canvas 。

现在我们可以为这些需求中的每一个编写类:

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

一些例子

本节将介绍对有用 Canvas 的额外要求，除了我们已经制定的那些。这是我们更换时丢失的类似物 c -> c与 c在 Canvas 类中。

让我们从您的第一个示例代码开始， 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 .一个 Monoid需要身份和关联性。假设在 Canvas 上进行了绘图操作而使它们保持原状是否合理？这听起来很合理。假设三个绘图操作，以相同的顺序进行，即使前两个一起执行，然后第三个，或者如果第一个执行，然后第二个和第三个一起执行，也做同样的事情是否合理？ ?同样，这对我来说似乎很合理。这建议我们可以写 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.Monad从 reducers 包中，或者自己添加一个，但这会使我们陷入不连贯的情况。将 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 中的单位。与第二个单位相同。我们这里的困难表明了额外的要求，我们一开始无法完全理解:

Canvas 扩展了现有的操作序列，提供绘制、书写文本等操作。

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

当您听到“指令序列”时，您应该想到:“monad”。

当你用“扩展”来限定它时，你应该想到:“monadtransformer”。

现在我们意识到我们的 Canvas 实现很可能是一个 monad 转换器。我们可以回到我们的界面，并改变它，使每个类都是一个 monad 的类，类似于转换器的 MonadIO class 和 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)

一个实现

如果您可以使您的代码在不引入抽象的情况下使用各种油漆来绘制点、框、线和文本，我们可以将其更改为实现第一部分中的接口(interface)。