在StateT中組合多個狀態

Question

我正在編寫一個作爲守護程序運行的程序。 要創建守護程序，用戶提供了一組 實現爲每個所需的類（它們中的一個是一個數據庫） 所有這些類都函數具有形式StateT s IO a，的 類型簽名的 但s爲不同的每班。

假設每個類遵循以下模式：

import Control.Monad (liftM) 
import Control.Monad.State (StateT(..), get) 

class Hammer h where 
    driveNail :: StateT h IO() 

data ClawHammer = MkClawHammer Int -- the real implementation is more complex 

instance Hammer ClawHammer where 
    driveNail = return() -- the real implementation is more complex 

-- Plus additional classes for wrenches, screwdrivers, etc. 

現在我可以定義表示由 用戶對每個「時隙」選擇的實現的記錄。

data MultiTool h = MultiTool { 
    hammer :: h 
    -- Plus additional fields for wrenches, screwdrivers, etc. 
    } 

和守護程序做大部分工作在StateT (MultiTool h ...) IO() 單子。

現在，由於多工具包含錘子，我可以在任何需要錘子的情況下使用它 。換句話說，所述MultiTool類型 可以實現任何其所包含的類，如果我寫這樣的代碼：

stateMap :: Monad m => (s -> t) -> (t -> s) -> StateT s m a -> StateT t m a 
stateMap f g (StateT h) = StateT $ liftM (fmap f) . h . g 

withHammer :: StateT h IO() -> StateT (MultiTool h) IO() 
withHammer runProgram = do 
    t <- get 
    stateMap (\h -> t {hammer=h}) hammer runProgram 

instance Hammer h => Hammer (MultiTool h) where 
    driveNail = withHammer driveNail 

但是的實現withHammer，withWrench，withScrewdriver等 基本相同。這將是很好能夠寫的東西 這樣的...

--withMember accessor runProgram = do 
-- u <- get 
-- stateMap (\h -> u {accessor=h}) accessor runProgram 

-- instance Hammer h => Hammer (MultiTool h) where 
-- driveNail = withMember hammer driveNail 

當然不會編譯不過。

我懷疑我的解決方案太面向對象。 有沒有更好的方法？ Monad變壓器，也許？ 非常感謝您的任何建議。

Answer 1

如果你想像你的情況一樣擁有一個大的全球化狀態，那麼你想要使用的是鏡頭，正如Ben所建議的那樣。我也推薦Edward Kmett的鏡頭庫。但是，還有另外一種更好的方法。

服務器具有程序連續運行並在狀態空間上執行相同操作的屬性。當你想要模塊化你的服務器時，麻煩就開始了，在這種情況下，你不僅需要一些全局狀態。你希望模塊有自己的狀態。

讓我們考慮一個模塊的東西是一種把請求到響應的：

Module :: (Request -> m Response) -> Module m 

現在，如果它有一些國家，那麼這個國家就會成爲該noticable模塊可能會給出不同下次回答。有許多方法可以做到這一點，例如如下：

Module :: s -> ((Request, s) -> m (Response s)) -> Module m 

不過來表達，這是下面的構造（我們很快就會圍繞它建立一個類型）的好得多和等效方式：

Module :: (Request -> m (Response, Module m)) -> Module m 

該模塊將請求映射到響應，但沿途也會返回自身的新版本。讓我們進一步去，使請求和響應的多態：

Module :: (a -> m (b, Module m a b)) -> Module m a b 

現在，如果一個模塊的輸出類型的另一個模塊的輸入類型相匹配，那麼你可以撰寫他們像普通的功能。這種組合是聯想性的並且具有多態性特徵。這聽起來很像一個類別，實際上它是！它是一個類別，一個應用函數和一個箭頭。

newtype Module m a b = 
    Module (a -> m (b, Module m a b)) 

instance (Monad m) => Applicative (Module m a) 
instance (Monad m) => Arrow (Module m) 
instance (Monad m) => Category (Module m) 
instance (Monad m) => Functor (Module m a) 

現在，我們可以組成具有自己獨立的本地狀態，甚至不知道它的兩個模塊！但這還不夠。我們想要更多。那些可以切換的模塊呢？讓我們擴展我們的小模塊系統，使得模塊實際上可以選擇不給一個答案：

newtype Module m a b = 
    Module (a -> m (Maybe b, Module m a b)) 

這樣的組成另一種形式的垂直於(.)：現在我們的類型也是Alternative函子家庭：

instance (Monad m) => Alternative (Module m a) 

現在模塊可以選擇是否對請求做出響應，如果沒有，則會嘗試下一個模塊。簡單。您剛剛重新創建了電線類別。 =）

當然，你不需要重塑這一點。 Netwire庫實現了這種設計模式，並帶有一個預定義「模塊」（稱爲電線）的大型庫。教程請參見Control.Wire模塊。

Answer 2

這聽起來非常像鏡頭的應用。

鏡頭是一些數據的子字段的規範。這個想法是你有一些價值toolLens和功能view和set，這樣view toolLens :: MultiTool h -> h提取工具和set toolLens :: MultiTool h -> h -> MultiTool h用一個新值替換它。然後，您可以輕鬆定義您的withMember作爲接受鏡頭的功能。

鏡頭技術最近進步很多，他們現在非常有能力。在撰寫本文時，最強大的圖書館是Edward Kmett的lens圖書館，這個圖書館有點讓人難以接受，但是一旦你找到你想要的功能，這個圖書館很簡單。您還可以在SO上搜索關於鏡片的更多問題，例如Functional lenses，鏈接到lenses, fclabels, data-accessor - which library for structure access and mutation is better或lenses標籤。

Answer 3

下面是如何使用lens的具體示例，就像其他人所談論的一樣。在下面的代碼示例中，Type1是本地狀態（即您的錘子），Type2是全局狀態（即您的多工具）。 lens提供zoom功能，更可運行的局部狀態計算該放大了由透鏡所定義的任何字段：

import Control.Lens 
import Control.Monad.Trans.Class (lift) 
import Control.Monad.Trans.State 

data Type1 = Type1 { 
    _field1 :: Int , 
    _field2 :: Double} 

field1 :: SimpleLens Type1 Int 
field1 = lens _field1 (\x a -> x { _field1 = a}) 

field2 :: SimpleLens Type1 Double 
field2 = lens _field2 (\x a -> x { _field2 = a}) 

data Type2 = Type2 { 
    _type1 :: Type1 , 
    _field3 :: String} 

type1 :: SimpleLens Type2 Type1 
type1 = lens _type1 (\x a -> x { _type1 = a}) 

field3 :: SimpleLens Type2 String 
field3 = lens _field3 (\x a -> x { _field3 = a}) 

localCode :: StateT Type1 IO() 
localCode = do 
    field1 += 3 
    field2 .= 5.0 
    lift $ putStrLn "Done!" 

globalCode :: StateT Type2 IO() 
globalCode = do 
    f1 <- zoom type1 $ do 
     localCode 
     use field1 
    field3 %= (++ show f1) 
    f3 <- use field3 
    lift $ putStrLn f3 

main = runStateT globalCode (Type2 (Type1 9 4.0) "Hello: ") 

zoom不限於一種類型的直接子字段。由於鏡頭是組合的，你可以通過做一些像深如您在一次操作中要放大：

zoom (field1a . field2c . field3b . field4j) $ do ...