Happstack에서 비 산성 값을 전달하는 방법은 무엇입니까?

Question

나는 Happstack crashcourse를 읽었습니다. 내 웹 서버는 섹션에 설명 된 거의 정확한 방법을 가지고 있습니다. Passing multiple AcidState handles around transparently

문제 저는 산성이 아니지만 Happstack 응용 프로그램 내에서 액세스하려는 가치가 있습니다. 1) PushManager는 내부적으로 많은 데이터 유형을 사용하기 때문에 나는이 일을 만들 수 없습니다

data Acid = Acid 
    { acidCountState :: AcidState CountState 
    , acidGreetingState :: AcidState GreetingState 
    , acidPushManager :: AcidState PushManager 
    } 

, 그리고/현실적이지 못하다 : 특히 내가 원하는 무엇

, push-notify-general library에서 "PushManager"를 말하는 것은 $ (deriveSafeCopy ...)를 호출하여 기본 데이터 유형 SafeCopy를 호환 가능하게 만듭니다. 2) PushManager는 단순한 값뿐만 아니라 SafeCopy와 호환되는 기능을 포함합니다.

내가 시도한 다른 것은 AcidState 데이터뿐만 아니라 AcidState 데이터도 포함하지 않는 "Acid"데이터 선언입니다. runApp의 정의를 보면 "Acid"가 Reading에만 사용되므로 State Monad로 다시 작성하면 내 필요를 충족시킬 수 있다고 생각했습니다. 그러나 그렇게 단순하지는 않습니다. 그것은 컴파일

{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, 
    TemplateHaskell, TypeFamilies, DeriveDataTypeable, 
    FlexibleContexts, ScopedTypeVariables, 
    NamedFieldPuns, DeriveFunctor, StandaloneDeriving, OverloadedStrings #-} 


import Control.Applicative   (Applicative, Alternative, (<$>)) 
import Control.Monad    (MonadPlus) 
import Control.Monad.State.Strict (MonadState, StateT, get, put, evalStateT) 
import Control.Monad.Trans   (MonadIO) 
import Data.Acid 
import Data.Data     (Data, Typeable) 

import Happstack.Server 



newtype Simple a = Simple { unSimple :: a } 
        deriving (Show) 

data CountState = CountState { count :: Integer } 
    deriving (Eq, Ord, Data, Typeable, Show) 

-- This data is equivalent to the one previously called "Acid" 
data States = States { 
    simpleState :: Simple Int 
    , acidCountState :: AcidState CountState 
    } 


initialStates :: States 
initialStates = States { simpleState = Simple 1, acidCountState = undefined } 


newtype App a = App { unApp :: ServerPartT (StateT States IO) a } 
    deriving (Functor, Alternative, Applicative, Monad     
      , MonadPlus, MonadIO, HasRqData, ServerMonad 
      , WebMonad Response, FilterMonad Response 
      , Happstack, MonadState States) 



class HasSimple m st where 
    getSimple :: m (Simple st) 
    putSimple :: (Simple st) -> m() 


instance HasSimple App Int where 
    getSimple = simpleState <$> get 
    putSimple input = do 
    whole <- get 
    put $ whole {simpleState = input} 


simpleQuery :: (Functor m 
       , HasSimple m a 
       , MonadIO m 
       , Show a 
       ) => 
       m a 
simpleQuery = do 
    (Simple a) <- getSimple 
    return a 


simpleUpdate :: (Functor m 
       , HasSimple m a 
       , MonadIO m 
       , Show a 
       ) => 
       a 
       -> m() 
simpleUpdate a = putSimple (Simple a) 


runApp :: States -> App a -> ServerPartT IO a 
runApp states (App sp) = do 
    mapServerPartT (flip evalStateT states) sp 


rootDir :: App Response 
rootDir = do 
    intVal <- simpleQuery 
    let newIntVal :: Int 
     newIntVal = intVal + 1 
    simpleUpdate newIntVal 
    ok $ toResponse $ ("hello number:" ++ (show newIntVal)) 

main :: IO() 
main = do 
    simpleHTTP nullConf $ runApp initialStates rootDir 

하지만 때마다 웹 페이지는 페이지 표시 동일한 수의 요청 : 내 임시 코드입니다. 내 코드를 다시 살펴보면 runApp의 evalStateT가 잘못된 것으로 느껴집니다. 업데이트 된 상태 값을 사용하지 않기 때문입니다.

이제 mapServerPartT 및 ServerPartT를 읽었지만 너무 복잡합니다. 누군가가 제목 줄에 대답 할 수 있다면 감사합니다. "Happstack에서 비 산성 값을 전달하는 방법"

Answer 1

mapServerPartT도 도움이되지 않습니다. 여기서 문제는 simpleHTTP에 전달하는 핸들러 함수가 들어오는 각 요청에 대해 새 스레드에서 호출되고 인수를 사용하여 runApp을 호출 할 때마다 발생한다는 것입니다. 따라서 요청이 끝날 때 값이 손실 될뿐만 아니라 여러 스레드가 요청을 처리하는 경우 각 스레드마다 상태의 개별 사본이 생성됩니다.

여러 스레드간에 공유되는 상태를 원한다는 것을 알게되면 그 대답은 스레드 간 통신을 수행하는 도구 중 하나에 의존해야합니다. 좋은 선택은 아마 우리가 들어오는 연결을 듣기 시작하기 전에 우리가 TVar을 만드는 것이 http://hackage.haskell.org/package/stm-2.4.3/docs/Control-Concurrent-STM-TVar.html

main :: IO() 
main = do 
    states <- atomically $ newTVar initialStates 
    simpleHTTP nullConf $ runApp states rootDir 

참고하는 TVar 될 것이다. 모든 요청 처리 스레드에 TVar을 전달하고 STM은 스레드간에 값을 동기화합니다.

a TVar은 (D) 내성이없는 acid-state과 약간 비슷합니다. 데이터가 저장 될 필요가 없기 때문에, stepcut의 답변에 따라, 나는 TVAR를 사용 Happstack 내에서 비 ​​산성 값을 수행 할 수 있었다

Answer 2

SafeCopy 인스턴스의 필요 등이 없습니다.

사람이 여기 단순화 코드에 관심이 있다면 : https://gist.github.com/anonymous/5686161783fd53c4e413

그리고 이것은 모두 "AcidState CountState"와 "TVAR CountState"를 수행 풀 버전입니다.

{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, 
    TemplateHaskell, TypeFamilies, DeriveDataTypeable, 
    FlexibleContexts, ScopedTypeVariables, 
    NamedFieldPuns, DeriveFunctor, StandaloneDeriving, OverloadedStrings, 
    RecordWildCards #-} 

import Happstack.Server 
import Control.Applicative   (Applicative, Alternative, (<$>)) 
import Control.Monad    (MonadPlus, msum) 
import Control.Monad.Reader  (MonadReader, ReaderT(..), ask) 
import Control.Monad.State   (get, put) 
import Control.Monad.Trans   (MonadIO, liftIO) 
import Control.Monad.Trans.Control (MonadBaseControl) 
import Data.Maybe (fromMaybe) 
import Control.Exception 
import Control.Concurrent.STM 
import Control.Concurrent.STM.TVar 
import Data.Acid hiding (update) 
import Data.Acid.Advanced (query', update') 
import Data.Acid.Local 
import Data.SafeCopy 
import Data.Data     (Data, Typeable) 
import System.FilePath    ((</>)) 


data CountState = CountState { count :: Integer } 
    deriving (Eq, Ord, Data, Typeable, Show) 

$(deriveSafeCopy 0 'base ''CountState) 

initialCountState :: CountState 
initialCountState = CountState { count = 0 } 

-- for AcidState 
incCount :: Update CountState Integer 
incCount = 
    do (CountState c) <- get 
    let c' = succ c 
    put (CountState c') 
    return c' 

$(makeAcidic ''CountState ['incCount]) 

-- for TVar 
incCountState :: App Integer 
incCountState = do 
    (_, CountState newVal) <- updateTVar incCount' 
    return newVal 
    where 
     incCount' :: CountState -> CountState 
     incCount' (CountState c) = CountState $ succ c 


data Aci = Aci 
    { acidCountState :: AcidState CountState 
    , tvarCountState :: TVar CountState 
    } 



withAci :: Maybe FilePath -> (Aci -> IO a) -> IO a 
withAci mBasePath action = do 
    initialTVarCount <- newTVarIO initialCountState 
    let basePath = fromMaybe "_state" mBasePath 
     countPath = Just $ basePath </> "count" 
    in withLocalState countPath initialCountState $ \c -> 
     action (Aci c initialTVarCount) 


-- for AcidState 
class HasAcidState m st where 
    getAcidState :: m (AcidState st) 
query :: forall event m. 
     (Functor m 
     , MonadIO m 
     , QueryEvent event 
     , HasAcidState m (EventState event) 
     ) => 
     event 
     -> m (EventResult event) 
query event = 
    do as <- getAcidState 
     query' (as :: AcidState (EventState event)) event 
update :: forall event m. 
      (Functor m 
      , MonadIO m 
      , UpdateEvent event 
      , HasAcidState m (EventState event) 
     ) => 
      event 
     -> m (EventResult event) 
update event = 
    do as <- getAcidState 
     update' (as :: AcidState (EventState event)) event 



-- for TVar 
class HasTVarState m st where 
    getTVarState :: m (TVar st) 

instance HasTVarState App CountState where 
    getTVarState = tvarCountState <$> ask 

queryTVar :: (HasTVarState m a 
      , MonadIO m 
      ) => m a 
queryTVar = do 
    as <- getTVarState 
    liftIO $ readTVarIO as 

updateTVar :: (HasTVarState m a 
       , MonadIO m) => 
       (a -> a) --^function to modify value 
       -> m (a, a) --^return value - "before change" and "after change" 
updateTVar func = do 
    as <- getTVarState 
    liftIO $ atomically $ do -- STM 
    prevVal <- readTVar as 
    let newVal = func prevVal 
    writeTVar as newVal 
    return (prevVal, newVal) 

-- | same as updateTVar, except no return 
updateTVar_ :: (HasTVarState m a 
       , MonadIO m) => 
       (a -> a) --^function to modify value 
       -> m() 
updateTVar_ func = do 
    as <- getTVarState 
    liftIO $ atomically $ modifyTVar as func 



withLocalState 
    :: (IsAcidic st 
     , Typeable st 
     ) => 
     Maybe FilePath  --^path to state directory 
    -> st     --^initial state value 
    -> (AcidState st -> IO a) --^function which uses the 
          -- `AcidState` handle 
    -> IO a 
withLocalState mPath initialState = 
    bracket (liftIO $ open initialState) 
      (liftIO . createCheckpointAndClose) 
    where 
    open = maybe openLocalState openLocalStateFrom mPath 


newtype App a = App { unApp :: ServerPartT (ReaderT Aci IO) a } 
    deriving (Functor, Alternative, Applicative, Monad     
      , MonadPlus, MonadIO, HasRqData, ServerMonad 
      , WebMonad Response, FilterMonad Response 
      , Happstack, MonadReader Aci) 


runApp :: Aci -> App a -> ServerPartT IO a 
runApp aci (App sp) = do 
    mapServerPartT (flip runReaderT aci) sp 

instance HasAcidState App CountState where 
    getAcidState = acidCountState <$> ask 


acidCounter :: App Response 
acidCounter = do 
    c <- update IncCount --^a CountState event 
    ok $ toResponse $ ("hello number acid:" ++ (show c)) 

tvarCounter :: App Response 
tvarCounter = do 
    c <- incCountState 
    ok $ toResponse $ ("hello number tvar:" ++ (show c)) 



rootDir :: App Response 
rootDir = do 
    msum 
    [ dir "favicon.ico" $ notFound (toResponse()) 
    , dir "acidCounter" acidCounter 
    , dir "tvarCounter" tvarCounter 
    , ok $ toResponse ("access /acidCounter or /tvarCounter" :: String) 
    ] 


main :: IO() 
main = do 
    withAci Nothing $ \aci -> 
    simpleHTTP nullConf $ runApp aci rootDir 

내가하려고하는거야