2
\$\begingroup\$

I was writing an application with a few Monads in a transformer stack. The top level application state resides in a TVar, and various components of the application operate on parts of it.

I wrote a helper function to extract those parts:

hoistStateWithLens :: S.MonadState outerState m => 
                      Simple Lens outerState innerState -> 
                      S.State innerState a ->
                      m a
hoistStateWithLens acc op = do
    s <- S.get
    let sp = s ^. acc
    let (res, sp') = S.runState op sp
    S.put (s & acc .~ sp')
    return res

And I extract it from my main state as such:

runWebMState :: MonadTrans t => State appState a -> t (WebM appState) a
runWebMState x = 
    let 
        runWebMState_ :: State appState a -> WebM appState a
        runWebMState_ f = do
            appStateTVar <- ask
            liftIO . atomically $ do
                appState <- readTVar appStateTVar
                let (fResult, appState') = runState f appState
                writeTVar appStateTVar appState'
                return fResult
    in webM $ runWebMState_ x

Ensuring atomic access (multiple web handlers can run at once).

Using it in my application code gets pretty easy:

runRandom x = runWebMState $ hoistStateWithLens gen x

-- sample use of runRandom
get "/random" $ do
    x <- runRandom $ state . randomR (1 :: Int,100)
    text . pack . show $ x

I wanted to gather some feedback about the implementation and the idea itself. The whole project is OpenSource and available on GitHub.

\$\endgroup\$
  • \$\begingroup\$ It has been 3.5 years. Do you want to review your own code? \$\endgroup\$ – Zeta Apr 9 '18 at 11:54

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.