When I have functions that are pure but depend on some common state(say in a config file, or retrieved from a database at startup), I like to use implicit parameters to hide it. You can use a type alias to avoid it cluttering up most signatures. Below, a value of type 'Environmental Float' means 'A float value, dependent on some fixed environment containing all students and the single unique classroom'. If you have a deep chain of 'Environmental a' values, the implicit parameter will be automatically propagated to the deepest parts of the expression.
You could also use a Reader monad, but they seem to require more invasive syntactic changes: They are better if you later expect to need other monads like IO, but if you're just doing calculations they're overkill. You could also define a type alias 'Environmental a = Environment -> a', but then if you have multiple such states they don't compose well(they require you to apply the implicit state in the correct order, and it can be a little awkward to propagate the parameter).
Here's how I would start to structure your example in a larger project:
{-# LANGUAGE ImplicitParams,RankNTypes #-}
import qualified Data.IntMap as M
newtype RowId a = RowId Int
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 :: Classroom,
environment_students :: M.IntMap Student
}
type Environmental a = (?e :: Environment) => a
classroom :: (?e :: Environment) => Classroom
classroom = environment_classroom ?e
students :: (?e :: Environment) => M.IntMap Student
students = environment_students ?e
student_totalFeesOwed :: RowId Student -> Environmental Float
student_totalFeesOwed (RowId studentId) = classroom_extraFees classroom + (student_feesOwed $ students M.! studentId)
main = do
let student = Student (RowId 1) "Bob" 250.00
let ?e = Environment {
environment_classroom = Classroom (RowId 1) 500.00 [ RowId 1 ],
environment_students = M.fromList [ (1, student) ]
}
putStrLn $ show $ student_totalFeesOwed $ RowId 1