haskell - 理解为什么 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 方法每次都会生成自己的 map ，然后将其丢弃!

你想要这样的东西:

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