2017-10-20 6 views
1

은 다음 "티니 URL"웹 응용 프로그램을 감안할 때 : 내 PUT 실제로 MVar Map를 업데이트하지 않는 이유MVar가 업데이트되지 않는 이유 이해?

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) 

로컬 응용 프로그램을 시작한 후, 나는 이해가 안 돼요.

$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 

답변

8

이 잘못 같습니다

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

ioMap 위, 귀하의 경우, 그것은 사용되는 새로운 MVar 모든 시간을 만들 것 IO 작업입니다. 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 
:

당신은 뭔가를 원하는