{-# LANGUAGE LambdaCase #-} module Example.Effects.Users where import Control.Concurrent.MVar import Data.Map.Strict (Map) import Data.Map.Strict qualified as M import Data.Text (Text) import Effectful import Effectful.Dispatch.Dynamic data User = User { id :: Int , firstName :: Text , lastName :: Text , age :: Int , isActive :: Bool } deriving (Show) -- Load a user AND do next if missing? data Users :: Effect where LoadUser :: Int -> Users m (Maybe User) LoadUsers :: Users m [User] SaveUser :: User -> Users m () ModifyUser :: Int -> (User -> User) -> Users m () DeleteUser :: Int -> Users m () type instance DispatchOf Users = 'Dynamic type UserStore = MVar (Map Int User) runUsersIO :: (IOE :> es) => UserStore -> Eff (Users : es) a -> Eff es a runUsersIO var = interpret $ \_ -> \case LoadUser uid -> load uid LoadUsers -> loadAll SaveUser u -> save u ModifyUser uid f -> modify uid f DeleteUser uid -> delete uid where load :: (MonadIO m) => Int -> m (Maybe User) load uid = do us <- liftIO $ readMVar var pure $ M.lookup uid us save :: (MonadIO m) => User -> m () save u = do liftIO $ modifyMVar_ var $ \us -> pure $ M.insert u.id u us loadAll :: (MonadIO m) => m [User] loadAll = do us <- liftIO $ readMVar var pure $ M.elems us modify :: (MonadIO m) => Int -> (User -> User) -> m () modify uid f = liftIO $ do modifyMVar_ var $ \us -> do pure $ M.adjust f uid us delete :: (MonadIO m) => Int -> m () delete uid = do liftIO $ modifyMVar_ var $ \us -> pure $ M.delete uid us initUsers :: (MonadIO m) => m UserStore initUsers = liftIO $ newMVar $ M.fromList $ map (\u -> (u.id, u)) users where users = [ User 1 "Joe" "Blow" 32 True , User 2 "Sara" "Dane" 24 False , User 3 "Billy" "Bob" 48 False , User 4 "Felicia" "Korvus" 84 True ]