The implicit parameter approach is best if the environment never changes, or at least doesn't change during the computation You can rebind the variable in the middle of a computation, but it's not a good road to go down.
The easiest way to simulate a changing environment is to use the State monad. There are other techniques: lenses, nested patterns, rebinding an implicit parameter, ST monad, generating a list of changes and applying the changes to the original state, etc. But - despite having to change your syntax somewhat - I think you'll find it easiest to use a state monad to manage this.
Here's a somewhat verbose example of using State to track updates. You can make it less verbose, but I chose to keep it simple. In this example, it updates student_feesOwed as part of registering for a class. So we no longer need to calculate anything: It just grabs the value off of the Student.
import Control.Applicative
import Control.Monad.Trans.State.Strict
import Data.Monoid
import qualified Data.IntMap as M
newtype RowId a = RowId Int deriving (Eq)
data Classroom = Classroom { classroom_id :: RowId Classroom, classroom_extraFees :: Float, classroom_students :: [ RowId Student ] }
data Student = Student { student_id :: RowId Student, student_name::String, student_feesOwed::Float}
data Environment = Environment {
environment_classroom :: Maybe Classroom,
environment_students :: M.IntMap Student
}
student_totalFeesOwed :: RowId Student -> State Environment Float
student_totalFeesOwed (RowId studentId) = do
(Environment mClassroom students) <- get
case mClassroom of
Nothing -> return 0.0
Just classroom -> do
let fees = student_feesOwed $ students M.! studentId
return fees
student_addFee :: RowId Student -> Float -> State Environment ()
student_addFee studentId fee = do
modify $ \e -> e { environment_students = M.map (addFee studentId fee) $ environment_students e }
where
addFee studentId fee student =
if studentId == student_id student
then student { student_feesOwed = student_feesOwed student + fee }
else student
environment_addStudent :: Student -> State Environment ()
environment_addStudent student = do
let (RowId key) = student_id student
value = student
modify $ \e -> e { environment_students = M.insert key value (environment_students e) }
classroom_addStudent :: Classroom -> RowId Student -> State Environment ()
classroom_addStudent classroom studentId = do
modify $ \e -> e { environment_classroom = addStudent studentId <$> environment_classroom e }
where
addStudent :: RowId Student -> Classroom -> Classroom
addStudent studentId classroom = classroom { classroom_students = studentId : (classroom_students classroom) }
student_registerClass :: RowId Student -> Classroom -> State Environment ()
student_registerClass studentId classroom = do
student_addFee studentId (classroom_extraFees classroom)
modify $ \e -> e { environment_classroom = Just classroom }
classroom_addStudent classroom studentId
main = do
let studentId = RowId 1
student = Student studentId "Bob" 250.00
classroom = Classroom (RowId 1) 500.00 []
initialEnvironment = Environment Nothing mempty
let totalFeesOwed = flip evalState initialEnvironment $ do
environment_addStudent student
student_registerClass studentId classroom
totalFeesOwed <- student_totalFeesOwed studentId
return totalFeesOwed
putStrLn $ show totalFeesOwed