存在的反模式，如何避免

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 ... } 

無論其...

我們喜歡讓周圍的油漆和變異他們整個拉絲工藝，因爲它們的創建和銷燬成本很高。一個paint可以是一個像[bgColor red，fgColor blue，字體「Tahoma」]之類的列表，或者它可以是一個指向內部結構的指針，這個指針是繪製系統使用的（這是對GDI的抽象，但最終會抽象通過direct2d和coregraphics），它們具有「繪畫」對象，我不想一遍又一遍地重新創建，然後綁定。

在我看來，存在的美妙之處在於，他們可以不透明地包裝某些東西來抽象它，並且我們可以將它保存在某個地方，然後將其拉回來，無論如何。當你部分申請時，我認爲存在的問題是你部分申請的東西現在「卡在」容器內。這是一個例子。說我有一個像

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

我在哪裏可以放置指針？當我將Paint賦予Canvas中的某個函數時，他如何獲得指針？什麼是設計這個API的正確方法？

Answer 1

接口

首先，你要問 「我有什麼要求？」。讓我們用簡單的英語我們想要一個帆布做的狀態（這些都是基於你的問題我的猜測）：

• 有些畫布可以具有各種形狀，把他們
• 有些畫布可已經把他們
文本
• 有些畫布改變他們的基礎上油漆
• 我們不知道什麼油漆還沒有什麼，但他們會針對不同的畫布不同

現在我們這些想法轉化爲哈斯克爾。 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是有問題的哈斯克爾。這是很難的類型系統來弄清楚發生了什麼事情在類，如

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()] 

這不挺的工作，因爲我們不」 t有一個(Monad m) => Monoid (m())的實例，因此ex將起作用。我們可以使用reducer軟件包中的Data.Semigroup.Monad，或者自己添加一個，但這會讓我們陷入不連貫的情況。這將會是更容易改變前到：

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變壓器」。

現在我們意識到我們的畫布實現最有可能是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) 

一種實現

如果你可以讓你的代碼工作在不引入抽象的情況下使用各種顏色繪製點，框，線和文本，我們可以將其更改爲實現第一部分的界面。