Modifying effects in a loop dynamically

ModifyEffects.hs

{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Main where

import Control.Lens
import Control.Monad.State
import Data.IORef

data Record = Record

data Player m = Player
  { addRecord    :: Record -> m ()
  , deleteRecord :: Record -> m ()
  }

data Student m = Student
  { name       :: m String
  , address    :: m String
  , changeName :: String -> m ()
  }

data Effs m = Effs
  { effsPlayer  :: Player m
  , effsStudent :: Student m
  }
makeFields ''Effs

loop :: (MonadIO m, HasPlayer effs (Player m), HasStudent effs (Student m))
     => effs -> Record -> m ()
loop effs r = do
  n <- name
  addr <- address
  liftIO $ putStrLn n
  addRecord r
  changeName (n ++ two)
  loop (effs & student %~ updateStudent) r
 where
  Player{..} = effs ^. player
  Student{..} = effs ^. student

  two = "2"

loop' :: (MonadIO m, HasPlayer effs (Player m), HasStudent effs (Student m))
      => Record -> StateT effs m ()
loop' r = do
  Player{..} <- use player
  Student{..} <- use student
  lift $ do
    n <- name
    addr <- address
    liftIO $ putStrLn n
    addRecord r
    changeName (n ++ two)
  student %= updateStudent
  loop' r
 where
  two = "2"

updateStudent :: Student m -> Student m
updateStudent s = Student
  { name       = name s
  , address    = address s
  , changeName = changeName s . (++ " again")
  }

studentIO :: String -> String -> IO (Student IO)
studentIO name address = do
  ref <- newIORef name
  return $ Student
    { name       = readIORef ref
    , address    = return address
    , changeName = writeIORef ref
    }

playerDummy :: Monad m => Player m
playerDummy = Player
  { addRecord    = const (return ())
  , deleteRecord = const (return ())
  }

main :: IO ()
main = do
  student <- studentIO "Bob" "Highway Ave"
  let effs = Effs { effsStudent = student, effsPlayer = playerDummy }

  loop effs Record
  -- Equivalent that allows effs to be modified in the middle
  void $ execStateT (loop' Record) effs