<div dir="ltr">Hi,
<div><br></div><div>We're trying to optimise the way lenses are built and imported in our project (there are 500+ of them!) . In the simplified version that I have presented below, whenever a new HasX class is added to the LensClasses module, both User & Main end up getting recompiled even though they have nothing to do with the newly added type-class. I've read and re-read "Recompilation Avoidance" [1], but haven't been able to figure out why this would be happening.</div><div><br></div><div>PS: To work-around this issue we've had to give each HasX class an independent module of its own. We specifically import only those which are required (all of this is done via a code-gen tool). This has resulted in an explosion of modules and is probably causing slow-down of our build process [2]</div><div><br></div><div><b>LensClasses.hs:</b></div><div><br></div><div><div><font face="monospace, monospace">    {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}</font></div><div><font face="monospace, monospace">    module LensClasses where</font></div><div><font face="monospace, monospace">    import Control.Lens<br></font></div><div><font face="monospace, monospace">    class HasName s a | s -> a where name :: Lens' s a<br></font></div><div><font face="monospace, monospace">    class HasEmail s a | s -> a where email :: Lens' s a</font></div><div><font face="monospace, monospace">    class HasAge s a | s -> a where age :: Lens' s a</font></div><div><br></div></div><div><b>User.hs (which defines a few lenses for the User record):</b></div><div><br></div><div><div><font face="monospace, monospace">    {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, TypeSynonymInstances, FlexibleInstances #-}</font></div><div><font face="monospace, monospace">    module User</font></div><div><font face="monospace, monospace">      ( module User</font></div><div><font face="monospace, monospace">      , HasName(..)</font></div><div><font face="monospace, monospace">      , HasEmail(..)) where</font></div><div><font face="monospace, monospace">    import LensClasses(HasName(..), HasEmail(..), HasVariantName(..))</font></div><div><font face="monospace, monospace">    data User = User  { _userName :: String  , _userEmail :: String  } deriving (Eq, Show)</font></div><div><font face="monospace, monospace">    instance HasName User String where</font></div><div><font face="monospace, monospace">      {-# INLINE name #-}</font></div><div><font face="monospace, monospace">      name fctor (User name_ email_) = fmap (\dragon -> User dragon email_) (fctor name_)</font></div><div><font face="monospace, monospace">    instance HasEmail User String where</font></div><div><font face="monospace, monospace">      {-# INLINE email #-}</font></div><div><font face="monospace, monospace">      email fctor (User name_ email_) = fmap (\dragon -> User name_ dragon) (fctor email_)</font></div><div><font face="monospace, monospace"><br></font></div></div><div><b>Main.hs (the final call site/s):</b></div><div><br></div><div><div><font face="monospace, monospace">    module Main where</font></div><div><font face="monospace, monospace">    import Control.Lens</font></div><div><font face="monospace, monospace">    import User</font></div><div><font face="monospace, monospace">    main :: IO ()</font></div><div><font face="monospace, monospace">    main = do</font></div><div><font face="monospace, monospace">      let u = User "saurabh" "<a href="mailto:saurabhnanda@gmail.com">saurabhnanda@gmail.com</a>"</font></div><div><font face="monospace, monospace">      putStrLn $ u ^. name</font></div></div><div><br></div><div>[1] <a href="https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance">https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance</a> </div><div>[2] <a href="https://www.reddit.com/r/haskell/comments/76zljl/hotswapping_haskell_at_facebook_jon_coens/doi0s4q/">https://www.reddit.com/r/haskell/comments/76zljl/hotswapping_haskell_at_facebook_jon_coens/doi0s4q/</a></div></div>