-
Notifications
You must be signed in to change notification settings - Fork 2
/
Main.hs
49 lines (44 loc) · 1.18 KB
/
Main.hs
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
42
43
44
45
46
47
48
49
#!/usr/bin/env stack
-- stack --resolver lts-8.12 script
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
import Control.Concurrent.Async.Lifted.Safe
import Control.Monad.Reader
import Control.Concurrent.STM
import Say
import Control.Lens
import Prelude hiding (log)
data Env = Env
{ envLog :: !(String -> IO ())
, envBalance :: !(TVar Int)
}
makeLensesWith camelCaseFields ''Env
modify :: (MonadReader env m, HasBalance env (TVar Int), MonadIO m)
=> (Int -> Int)
-> m ()
modify f = do
env <- ask
liftIO $ atomically $ modifyTVar' (env^.balance) f
logSomething :: (MonadReader env m, HasLog env (String -> IO ()), MonadIO m)
=> String
-> m ()
logSomething msg = do
env <- ask
liftIO $ (env^.log) msg
main :: IO ()
main = do
ref <- newTVarIO 4
let env = Env
{ envLog = sayString
, envBalance = ref
}
runReaderT
(concurrently
(modify (+ 1))
(logSomething "Increasing account balance"))
env
balance <- readTVarIO ref
sayString $ "Final balance: " ++ show balance