サーバントはいつも私がサーバントを学んでいるReaderTモナド

Question

に初期値を与え、単純なサービスを記述します。ここではソースコードは次のとおりです。

{-# LANGUAGE DataKinds #-} 
{-# LANGUAGE DeriveGeneriC#-} 
{-# LANGUAGE LambdaCase #-} 
{-# LANGUAGE TypeOperators #-} 
{-# LANGUAGE RankNTypes #-} 

module BigMama where 

import   Control.Concurrent 
import   Control.Concurrent.STM 
import   Control.Monad 
import   Control.Monad.Reader 
import   Data.Aeson 
import   Data.Aeson.Types 
import qualified Data.ByteString.Lazy.Char8 as C 
import   Data.Char 
import qualified Data.Map as M 
import   Debug.Trace 
import   GHC.Generics 
import   Prelude hiding (id) 
import   Servant 

data MicroService = MicroService 
    { name :: String 
    , port :: Int 
    , id :: Maybe String 
    } deriving (Generic) 

instance ToJSON MicroService 
instance FromJSON MicroService 

instance Show MicroService where 
    show = C.unpack . encode 

type ServiceSet = STM (TVar (M.Map String MicroService)) 

type LocalHandler = ReaderT ServiceSet IO 

defaultServices :: ServiceSet 
defaultServices = newTVar $ M.fromList [] 

type Api = 
    "bigmama" :> Get '[JSON] (Maybe MicroService) 
    :<|> "bigmama" :> ReqBody '[JSON] MicroService :> Post '[JSON] MicroService 

api :: Proxy Api 
api = Proxy 

serverT :: ServerT Api LocalHandler 
serverT = getService 
    :<|> registerService 

getService :: LocalHandler (Maybe MicroService) 
getService = do 
    stm <- ask 
    liftIO . atomically $ do 
    tvar <- stm 
    mss <- readTVar tvar 
    return $ M.lookup "file" mss 

registerService :: MicroService -> LocalHandler MicroService 
registerService ms = do 
    stm <- ask 
    liftIO . atomically $ do 
    tvar <- stm 
    mss <- readTVar tvar 
    let mss' = M.insert (name ms) ms mss 
    writeTVar tvar mss' 
    return ms 

readerToHandler' :: forall a. ServiceSet -> LocalHandler a -> Handler a 
readerToHandler' ss r = liftIO $ runReaderT r ss 

readerToHandler :: ServiceSet -> (:~>) LocalHandler Handler 
readerToHandler ss = Nat (readerToHandler' ss) 

server :: Server Api 
server = enter (readerToHandler defaultServices) serverT 

それは、リクエストごとに新しいdefaultServicesを提供サーバントのように思えます。サービスを作成するためにPOST（name = "file"）を送信し、GET要求でサービスを返すことはできません。サーバント上のリクエスト間でデータを共有する方法は？

Answer 1

すべてのリクエストに対して新しいdefaultServicesを提供するようなサーバントのようです。

あなたのコードは書かれているとおり、STMアクションです。ロジック—

defaultServices :: ServiceSet 
defaultServices = newTVar ... 

、次のこの（断片）の定義は決定的ではない実行新しいTVarを生成するSTMアクションを行います。代わりに、TVar Sを生成することができるSTMアクション値（defaultServices）を定義します。 defaultServicesがに渡される場所に続いて、あなたが—

getService = do 
    stm <- ask 
    liftIO . atomically $ do 
    tvar <- stm 
    ... 

ようなあなたのハンドラでそれを使用するあなたのReaderに保存されているアクションがdefaultServices値そのものと変わらないので、このコードは—

getService = do 
    liftIO . atomically $ do 
    tvar <- defaultServices 
    ... 

に相当しますそして、定義の代わりに、defaultServices —

getService = do 
    liftIO . atomically $ do 
    tvar <- newTVar ... 
    ... 

これは明らかに間違っています。 defaultServicesの代わりに、新しいTVarを生成するアクションがあります。TVarそのものでしょうか？そう型レベルにエイリアスせず—

type ServiceSet = STM (TVar (M.Map String MicroService)) -- From this 
type Services =  TVar (M.Map String MicroService) -- To this 

defaultServices :: Services 

今defaultServices代わりTVar Sを作成する方法の、実際のTVarを表します。 STMアクションを実行する必要があるため、初めてアクションを実行すると初めての場合はこれが難しいように見えるかもしれません。IOを逃す方法がないと“とよく分かります。”これは実際にかかわらず、信じられないほど共通で、劇中の関数の実際のstm documentationで簡単に見に正しい答えにあなたを指します。

これはあなたがunsafePerformIOを使用して取得Haskellの開発者として、あなたの生活の中で、これらのエキサイティングな時代の一つであることが判明しました。 atomicallyの定義は、あなたがしなければならないことをほぼ正確に綴っています。

はアトミックSTMの一連のアクションを実行します。

あなたはunsafePerformIOまたは unsafeInterleaveIO内atomicallyを使用することはできません。そうしようとすると、実行時に エラーが発生します。 （理由：これは効果的にサンクを評価 ある正確場合によっては、トランザクション内のトランザクション を可能にすることが可能となる。）

しかし、unsafePerformIO内部に呼び出すことができるnewTVarIO、 かつトップレベルTVarを可能にする参照割り当てられるべきである。今、あなたはunsafePerformIOを使用して製造トップレベルの値をインライン化しないようにGHCを指示しない限り、あなたはまだあなたのサイトに終わるかもしれないということであるドキュメントではありません、このパズルの最後の1枚は、あります

独自のサービスセットを持つdefaultServicesを使用してください。例えば、インライン化禁止することなく、これはこれは、簡単な修正はしかし、ちょうどdefaultServicesのあなたの定義にNOINLINEプラグマを追加で—

getService = do 
    liftIO . atomically $ do 
    mss <- readTVar defaultServices 

getService = do 
    liftIO . atomically $ do 
    mss <- readTVar (unsafePerformIO $ newTVarIO ...) 
    ... 

起こるでしょう。

defaultServices :: Services 
defaultServices = unsafePerformIO $ newTVar M.empty 
{-# NOINLINE defaultServices #-} 

---

は今、これは罰金ソリューションであり、私は喜んで生産コードでそれを使用しましたが、それにsome objectionsがあります。すでにハンドラモナドのスタックにReaderTを使用しても問題ありません（そして、上記の解決策は、何らかの理由でリファレンスのスレッドを避けている人のためのものです）、プログラムの初期化時に新しいTVarを作成し、それがどのように動作するかの簡単なスケッチは以下の通りです。

main :: IO() 
main = do 
    services <- atomically (newTVar M.empty) 
    run 8080 $ serve Proxy (server services) 

server :: TVar Services -> Server Api 
server services = enter (readerToHandler services) serverT 

getService :: LocalHandler (Maybe MicroService) 
getService = do 
    services <- ask 
    liftIO . atomically $ do 
    mss <- readTVar services 
    ...