理解为什么 MVar 不更新？

Question

鉴于以下 "TinyUrl" 网络应用程序：

import Prelude ()
import Prelude.Compat
import Data.Aeson.Types
import GHC.Generics
import Lucid
import Network.Wai
import Network.Wai.Handler.Warp
import Servant
import Servant.HTML.Lucid
import Control.Concurrent.MVar
import Data.Map
import Control.Monad.Except

type API = "tinyUrl" :> ValueAPI

type ValueAPI = Capture "value" String :> (
                       Get '[JSON] ResolvedTinyUrl
                  :<|> ReqBody '[JSON] UpdatedTinyUrl :> PutNoContent '[JSON] NoContent
        )

newtype TinyUrl = TinyUrl String deriving (Generic, Ord, Eq, Show)

instance ToJSON TinyUrl

newtype ResolvedTinyUrl = ResolvedTinyUrl { value :: TinyUrl } deriving Generic

data UpdatedTinyUrl = UpdatedTinyUrl
  { v :: String } deriving Generic

instance ToJSON ResolvedTinyUrl

instance FromJSON UpdatedTinyUrl

newtype ResolvedUrls = ResolvedUrls (MVar (Map TinyUrl String))

tinyUrlAPI :: Proxy API
tinyUrlAPI = Proxy

server :: IO (MVar (Map TinyUrl String)) -> Server API
server ioMap = tinyUrlOperations

  where tinyUrlOperations v =
          get v :<|> put v

          where get :: String -> Handler ResolvedTinyUrl
                get s = Handler $ do
                  map    <- lift $ ioMap
                  m      <- lift $ readMVar map
                  _      <- lift $ putStrLn ("m " ++ show m)
                  found  <- lift $ return $ Data.Map.lookup (TinyUrl s) m
                  case found of
                     Just a  -> return $ ResolvedTinyUrl (TinyUrl a)
                     Nothing -> (lift $ putStrLn ("did not find " ++ s)) >> throwError err404

                put :: String -> UpdatedTinyUrl -> Handler NoContent
                put key (UpdatedTinyUrl value) = Handler $ do
                 map     <- lift $ ioMap
                 m       <- lift $ takeMVar map
                 updated <- lift $ return $ Data.Map.insert (TinyUrl key) value m
                 _       <- lift $ putStrLn $ "updated:" ++ (show updated)
                 _       <- lift $ putMVar map updated
                 return NoContent


app :: IO (MVar (Map TinyUrl String)) -> Application
app map = serve tinyUrlAPI (server map)

main :: IO ()
main = run 8081 $ app (newMVar $ Data.Map.empty)

在本地启动应用程序后，我不明白为什么我的 PUT 实际上没有更新 MVar Map。

$curl -i -X PUT -H "Content-Type: application/json" -d '{"v" : "bar"}'  \
     localhost:8081/tinyUrl/foo
HTTP/1.1 204 No Content
Date: Fri, 20 Oct 2017 11:52:41 GMT
Server: Warp/3.2.13
Content-Type: application/json;charset=utf-8

$curl -i localhost:8081/tinyUrl/foo
HTTP/1.1 404 Not Found
Transfer-Encoding: chunked
Date: Fri, 20 Oct 2017 11:52:46 GMT
Server: Warp/3.2.13

Answer 1

这看起来不对：

server :: IO (MVar (Map TinyUrl String)) -> Server API
server ioMap = ...

上面的

ioMap 是一个 IO 操作，在您的情况下，每次使用它都会创建一个新的 MVar。您的 get/put 方法每次都会生成自己的地图，然后扔掉！

你想要这样的东西：

server :: MVar (Map TinyUrl String) -> Server API
server map = ...

app :: MVar (Map TinyUrl String) -> Application
app map = serve tinyUrlAPI (server map)

main :: IO ()
main = do
  map <- newMVar $ Data.Map.empty -- run this only once
  run 8081 $ app map

理解为什么 MVar 不更新？

Understanding Why MVar Isn't Updating?

haskell

servant