summaryrefslogtreecommitdiff
path: root/fig-web/src/Fig/Web/State.hs
blob: 11e0ece1e20d94d9dcc9db5d3c8eab9fc7a1b7ea (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
{-# Language TemplateHaskell #-}

module Fig.Web.State where

import Control.Lens.TH (makeLensesFor)
import Control.Lens ((<>=))
import Control.Monad.State (runStateT)

import Fig.Prelude

import qualified Data.IORef as IORef

newtype State = State
  { buffer :: Text
  }
makeLensesFor [("buffer", "buffer")] ''State

defaultState :: State
defaultState = State
  { buffer = ""
  }

type StateRef = IORef.IORef State

stateRef :: IO StateRef
stateRef = IORef.newIORef defaultState

withState ::
  MonadIO m' =>
  StateRef ->
  (forall m. (MonadIO m, MonadState State m) => m a) ->
  m' a
withState ref f = do
  s <- liftIO $ IORef.readIORef ref
  (res, s') <- liftIO $ runStateT f s
  liftIO $ IORef.writeIORef ref s'
  pure res

sayHi :: StateRef -> IO ()
sayHi ref = withState ref do
  buffer <>= "hi"