
Lately I've been spending more and more time trying to figure out how to resolve circular import problems. I add some new data type and suddenly someone has a new dependency and now the modules are circular. The usual solution is to move the mutually dependent definitions into the same module, but sometimes those threaten to drag in a whole zoo of other dependencies, *all* of which would have to go into the same module, which is already quite large anyway. Of course this requires lots of thought and possibly refactoring and is a big pain all around. I feel like the circular imports problem is worse in haskell than other languages. Maybe because there is a tendency to centralize all state, since you need to define it along with your state monad. But the state monad module must be one of the lower level ones, since all modules that use it must import it. However, the tendency for bits of typed data to migrate into the state means it's easy for it to eventually want to import one of its importers. And the state monad module gets larger and larger (the largest modules in my system are those that define state monads: 1186 lines, 706 lines, 1156 lines---the rest tend to be 100--300 lines). I haven't really had this problem in other languages. Maybe it's because I just don't write very big programs in other languages, or maybe because some other languages are dynamically typed and don't make you import a module to use its types, or maybe because some other languages support forward declaration (actually, ghc haskell does support a form of forward declaration in hs-boot files). I have a few techniques to get out: - Replace Things with ThingIds which have no big dependencies, and can then be looked up in a Map later. This replaces direct access with lookup and thows some extra Maybes in there, which is not very nice. - Cleverly use type variables to try to factor out the problematic type. Then I can stitch the data structure back together at a higher level with a type alias. This is sort of complicated and awkward. - Move the declarations that must be moved to the low level module, re-export them from the module that defines their (smart) constructors, and pretend like they belong to that module. This works well when it can work, but makes the code awkward to navigate and doesn't let you hide their implementation unless you give up and move the rest of the code in as well. - Just use an hs-boot. The main problem I've noticed with this so far is that you wind up with a lot of recompilation, since ghc always seems to want to start with the boot files and then recompile the loop. This makes ghci use a little more annoying. Actually, sometimes :r simply reloads the changed module, but sometimes it wants to start again at the hs-boots and recompiles a whole pile, I'm not sure what makes the difference. Probably making the loop as small as possible would help here. Is this a problem others have noticed? Any other ideas or solutions? thanks!

On Mon, 6 Sep 2010, Evan Laforge wrote:
I have a few techniques to get out:
- Replace Things with ThingIds which have no big dependencies, and can then be looked up in a Map later. This replaces direct access with lookup and thows some extra Maybes in there, which is not very nice.
- Cleverly use type variables to try to factor out the problematic type. Then I can stitch the data structure back together at a higher level with a type alias. This is sort of complicated and awkward.
That's what I typically make. It was only once, where I could not easily decide which datatype to make the parameter of the other one.
- Move the declarations that must be moved to the low level module, re-export them from the module that defines their (smart) constructors, and pretend like they belong to that module. This works well when it can work, but makes the code awkward to navigate and doesn't let you hide their implementation unless you give up and move the rest of the code in as well.
I often need Private modules anyway for package-wide definitions. Then I define the type in the Private module and export it only from the corresponding public module. Unfortunately, Haddock does not play nicely with it. I would like to tell Haddock to treat the public module as the one that defines the type.
Is this a problem others have noticed? Any other ideas or solutions?
Unfortunately no more ideas, but you may add more thoughts to http://haskell.org/haskellwiki/Mutually_recursive_modules#Resolve_mutual_rec...

Excerpts from Evan Laforge's message of Mon Sep 06 13:30:43 -0400 2010:
I feel like the circular imports problem is worse in haskell than other languages. Maybe because there is a tendency to centralize all state, since you need to define it along with your state monad. But the state monad module must be one of the lower level ones, since all modules that use it must import it. However, the tendency for bits of typed data to migrate into the state means it's easy for it to eventually want to import one of its importers. And the state monad module gets larger and larger (the largest modules in my system are those that define state monads: 1186 lines, 706 lines, 1156 lines---the rest tend to be 100--300 lines).
I have used hs-boot files to this effect. I separated data and functionality, and typeclasses, which must be in the same module as data or are considered orphaned, get definitions via a circular import. Edward

On 7 September 2010 03:44, Edward Z. Yang
Excerpts from Evan Laforge's message of Mon Sep 06 13:30:43 -0400 2010:
I feel like the circular imports problem is worse in haskell than other languages. Maybe because there is a tendency to centralize all state, since you need to define it along with your state monad. But the state monad module must be one of the lower level ones, since all modules that use it must import it. However, the tendency for bits of typed data to migrate into the state means it's easy for it to eventually want to import one of its importers. And the state monad module gets larger and larger (the largest modules in my system are those that define state monads: 1186 lines, 706 lines, 1156 lines---the rest tend to be 100--300 lines).
I have used hs-boot files to this effect. I separated data and functionality, and typeclasses, which must be in the same module as data or are considered orphaned, get definitions via a circular import.
I'm just getting to the point where I have a similar problem. I was thinking about splitting instances off from the classes (and telling GHC to not worry about orphaned instances for the instance-only modules) but then realised that some instance declarations would be circular as well, so I have to either use hs-boot files, define everything in one big module and then re-export them in ways that make sense or define all instances in one big module (at least for those types which have circular deps among instances) and re-export accordingly. -- Ivan Lazar Miljenovic Ivan.Miljenovic@gmail.com IvanMiljenovic.wordpress.com

I had the same issue zonks ago, and I resorted to using the hs-boot file method as well (which worked fine) Which I guess brings me to my second point, is this something that GHC should do automatically when it sees circular dependencies? When I asked about it earlier on #haskell, I was told that its better that way because it discourages making bad design through circular dependencies (yet in my case and I assume the other cases as well, not using the hs-boot method would have made the design much worse). Are there any cases in particular where people would be encouraged to make interface design with circular dependencies (and that design be deemed as horrible) as opposed to what seems to be more realistic case where circular dependencies rarely crop up, and when they do they actually make the design better? On Tue, Sep 7, 2010 at 1:48 PM, Ivan Lazar Miljenovic < ivan.miljenovic@gmail.com> wrote:
On 7 September 2010 03:44, Edward Z. Yang
wrote: Excerpts from Evan Laforge's message of Mon Sep 06 13:30:43 -0400 2010:
I feel like the circular imports problem is worse in haskell than other languages. Maybe because there is a tendency to centralize all state, since you need to define it along with your state monad. But the state monad module must be one of the lower level ones, since all modules that use it must import it. However, the tendency for bits of typed data to migrate into the state means it's easy for it to eventually want to import one of its importers. And the state monad module gets larger and larger (the largest modules in my system are those that define state monads: 1186 lines, 706 lines, 1156 lines---the rest tend to be 100--300 lines).
I have used hs-boot files to this effect. I separated data and functionality, and typeclasses, which must be in the same module as data or are considered orphaned, get definitions via a circular import.
I'm just getting to the point where I have a similar problem. I was thinking about splitting instances off from the classes (and telling GHC to not worry about orphaned instances for the instance-only modules) but then realised that some instance declarations would be circular as well, so I have to either use hs-boot files, define everything in one big module and then re-export them in ways that make sense or define all instances in one big module (at least for those types which have circular deps among instances) and re-export accordingly.
-- Ivan Lazar Miljenovic Ivan.Miljenovic@gmail.com IvanMiljenovic.wordpress.com _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

I was under the impression that the main reason GHC requires .hs-boot files
is that nobody has had the time or inclination to make it resolve circular
dependencies automatically, and not an intentional design decision to
encourage "good design".
On Tue, Sep 7, 2010 at 6:51 AM, Mathew de Detrich
I had the same issue zonks ago, and I resorted to using the hs-boot file method as well (which worked fine)
Which I guess brings me to my second point, is this something that GHC should do automatically when it sees circular dependencies? When I asked about it earlier on #haskell, I was told that its better that way because it discourages making bad design through circular dependencies (yet in my case and I assume the other cases as well, not using the hs-boot method would have made the design much worse). Are there any cases in particular where people would be encouraged to make interface design with circular dependencies (and that design be deemed as horrible) as opposed to what seems to be more realistic case where circular dependencies rarely crop up, and when they do they actually make the design better?
On Tue, Sep 7, 2010 at 1:48 PM, Ivan Lazar Miljenovic < ivan.miljenovic@gmail.com> wrote:
On 7 September 2010 03:44, Edward Z. Yang
wrote: Excerpts from Evan Laforge's message of Mon Sep 06 13:30:43 -0400 2010:
I feel like the circular imports problem is worse in haskell than other languages. Maybe because there is a tendency to centralize all state, since you need to define it along with your state monad. But the state monad module must be one of the lower level ones, since all modules that use it must import it. However, the tendency for bits of typed data to migrate into the state means it's easy for it to eventually want to import one of its importers. And the state monad module gets larger and larger (the largest modules in my system are those that define state monads: 1186 lines, 706 lines, 1156 lines---the rest tend to be 100--300 lines).
I have used hs-boot files to this effect. I separated data and functionality, and typeclasses, which must be in the same module as data or are considered orphaned, get definitions via a circular import.
I'm just getting to the point where I have a similar problem. I was thinking about splitting instances off from the classes (and telling GHC to not worry about orphaned instances for the instance-only modules) but then realised that some instance declarations would be circular as well, so I have to either use hs-boot files, define everything in one big module and then re-export them in ways that make sense or define all instances in one big module (at least for those types which have circular deps among instances) and re-export accordingly.
-- Ivan Lazar Miljenovic Ivan.Miljenovic@gmail.com IvanMiljenovic.wordpress.com _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

That definitely makes more sense
On 07/09/2010 3:06 PM, "Daniel Peebles"
I had the same is...

Excerpts from Evan Laforge's message of Mon Sep 06 13:30:43 -0400 2010:
I feel like the circular imports problem is worse in haskell than other languages. Maybe because there is a tendency to centralize all state, since you need to define it along with your state monad. But the state monad module must be one of the lower level ones, since all modules that use it must import it. However, the tendency for bits of typed data to migrate into the state means it's easy for it to eventually want to import one of its importers. And the state monad module gets larger and larger (the largest modules in my system are those that define state monads: 1186 lines, 706 lines, 1156 lines---the rest tend to be 100--300 lines).
I have used hs-boot files to this effect. I separated data and functionality, and typeclasses, which must be in the same module as data or are considered orphaned, get definitions via a circular import. I'm just getting to the point where I have a similar problem. I was
I was under the impression that the main reason GHC requires .hs-boot files is that nobody has had the time or inclination to make it resolve circular dependencies automatically, and not an intentional design decision to encourage "good design".
Indeed. I’ve added some notes here http://hackage.haskell.org/trac/ghc/ticket/1409#comment:37
Simon
From: haskell-cafe-bounces@haskell.org [mailto:haskell-cafe-bounces@haskell.org] On Behalf Of Daniel Peebles
Sent: 07 September 2010 06:06
To: Mathew de Detrich
Cc: Ivan Lazar Miljenovic; haskell
Subject: Re: [Haskell-cafe] circular imports
I was under the impression that the main reason GHC requires .hs-boot files is that nobody has had the time or inclination to make it resolve circular dependencies automatically, and not an intentional design decision to encourage "good design".
On Tue, Sep 7, 2010 at 6:51 AM, Mathew de Detrich

Thanks for the clarification
On 07/09/2010 5:30 PM, "Simon Peyton-Jones"

Simon Peyton-Jones schrieb:
I was under the impression that the main reason GHC requires .hs-boot files is that nobody has had the time or inclination to make it resolve circular dependencies automatically, and not an intentional design decision to encourage "good design".
Indeed. I’ve added some notes here http://hackage.haskell.org/trac/ghc/ticket/1409#comment:37
When reading this, I'm afraid adding this feature will cause more bugs than features. For me, generally working hs-boot-files would be enough, that is, hs-boot files that support all situations of mutually depending classes and instances. I still prefer non-circular modules, because I understand their relationship more easily. I prefer to explicitly state when I want cyclic imports, as I currently do with hs-boot files. As time went by, I become familiar with the discussed methods of avoiding import cycles and actually, all packages I have written so far do not contain any circular import and thus no hs-boot file.

Hello,
I had recently a really hard time splitting up my program into parts!
The natural, business-oriented split up drove me into a deadly circular
dependency.
I tried to solve it with:
- .hs-boot: It adds a lot of duplicated code and unecessary files, so I
gave up
- type variables: that too complifies the code with no obvious reasons
Finally, i ended up with putting all my types into a file names Types.hs.
It's not very satisfatory, since I like to keep the types next to their
related code and functions (like it is in the libraries).
But I founded this is the way that adds the less burden to the code.
Cheers,
Corentin
Mathew de
Detrich

That sort of code (stripped out):
In Game.hs:
data Game = Game { ...
activeRules :: [Rule]}
applyTo :: Rule -> Game -> Game
applyTo r gs = ...
In Rule.hs:
data Rule = Cond (Obs) Rule Rule
| many others..
deriving (Read, Show, Eq, Typeable)
data NamedRule = NamedRule { ...,
rule :: Rule }
isRuleLegal :: Rule -> NamedRule -> Game -> Bool
isRuleLegal = ...
In Obs.hs:
data Obs a where
ProposedBy :: Obs Int -- The player that proposed the tested rule
...
evalObs :: Obs -> NamedRule -> Game -> EvalObsType
evalObs = ...
Corentin
Johannes
Waldmann
I had recently a really hard time splitting up my program into parts! The natural, business-oriented split up drove me into a deadly circular dependency.
perhaps you could post your code (enough of it to understand the problem)? J.W. _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

corentin.dupont@ext.mpsa.com schrieb:
That sort of code (stripped out):
In Game.hs:
data Game = Game { ... activeRules :: [Rule]}
applyTo :: Rule -> Game -> Game applyTo r gs = ...
In Rule.hs:
data Rule = Cond (Obs) Rule Rule | many others.. deriving (Read, Show, Eq, Typeable)
data NamedRule = NamedRule { ..., rule :: Rule }
isRuleLegal :: Rule -> NamedRule -> Game -> Bool isRuleLegal = ...
In Obs.hs:
data Obs a where ProposedBy :: Obs Int -- The player that proposed the tested rule ...
evalObs :: Obs -> NamedRule -> Game -> EvalObsType evalObs = ...
As I see there is no cycle in the types. How about defining Game, Rule, Obs in private modules, like Private.Game, Private.Rule, Private.Obs, and implementing the functions in public modules like Game, Rule, Obs ?

Henning Thielemann
As I see there is no cycle in the types. How about defining Game, Rule, Obs in private modules, like Private.Game, Private.Rule, Private.Obs, and implementing the functions in public modules like Game, Rule, Obs ?
I guess that conflicts with the advice of putting the functions (behaviour) close to the data that it concerns. But if a function mentions two types (and the types are separate), it requires a decision - in OO as well: you would (arbitrarily) make them a method of one class or the other. J.W.

On Tue, 7 Sep 2010, Johannes Waldmann wrote:
Henning Thielemann
writes: As I see there is no cycle in the types. How about defining Game, Rule, Obs in private modules, like Private.Game, Private.Rule, Private.Obs, and implementing the functions in public modules like Game, Rule, Obs ?
I guess that conflicts with the advice of putting the functions (behaviour) close to the data that it concerns.
Of course, the public module Game shall export the Game type from Private.Game and so on. That is from the perspective of the Game package user, the Game type and related functions can be imported from the same module. The inconvenience of defining the Game type and its functions in distinct modules exists only for corentin.dupont but not for the user of his library.

That sort of code (stripped out):
In Game.hs:
data Game = Game { ... activeRules :: [Rule]}
applyTo :: Rule -> Game -> Game applyTo r gs = ...
Often, it helps to parameterize the types/functions (instead of using recursive modules to hardcode the parameters). Would something like this work for your case (taking the Game module out of the loop)? data Game rule = Game { ... activeRules :: [rule]} applyTo :: rule -> Game rule -> Game rule applyTo r gs = ...
In Rule.hs: .. isRuleLegal :: Rule -> NamedRule -> Game Rule -> Bool isRuleLegal = ...
In Obs.hs:
evalObs :: Obs -> NamedRule -> Game Rule -> EvalObsType evalObs = ...
For the record, I'd like to have recursive modules without having to go outside the language (some standardized notion of Haskell module interfaces would be nicer than implementation-specific boot files). But I'd like to have parameterized modules even more, as that would allow me to avoid many use cases of recursive modules (again, that would seem to require module interfaces). Claus

Mathew de Detrich schrieb:
I had the same issue zonks ago, and I resorted to using the hs-boot file method as well (which worked fine)
Which I guess brings me to my second point, is this something that GHC should do automatically when it sees circular dependencies? When I asked about it earlier on #haskell, I was told that its better that way because it discourages making bad design through circular dependencies (yet in my case and I assume the other cases as well, not using the hs-boot method would have made the design much worse). Are there any cases in particular where people would be encouraged to make interface design with circular dependencies (and that design be deemed as horrible) as opposed to what seems to be more realistic case where circular dependencies rarely crop up, and when they do they actually make the design better?
I like to compare it with Modula-3 where cyclic imports are strictly forbidden. There it is solved by dividing a module into an interface file and an implementation file. The interface can be compared with .hs-boot files: You can define types there, but you can also simply declare a type without its precise structure. Two mutually depending types in distinct modules could be defined as follows: A.i3: INTERFACE A; TYPE T <: REFANY; (* declare T to be a subtype of a general pointer *) END A. A.m3: MODULE A; (* the implementation part automatically imports the corresponding interface A without qualification *) IMPORT B; (* import the interface of module B *) REVEAL T = POINTER TO RECORD b : B.T END; END A. B.i3: INTERFACE B; TYPE T <: REFANY; END B. B.m3: MODULE B; IMPORT A; REVEAL T = POINTER TO RECORD a : A.T END; END B. Thus the circular dependency graph A -> B, B -> A is split into the non-circular dependency graph Ai -> Am, Ai -> Bm, Bi -> Am, Bi -> Bm Obviously this only works for pointers, but this is no problem since embedding a record in itself is not possible. Haskell cannot embed a record in another one, it uses pointers by default.
participants (11)
-
Claus Reinke
-
corentin.dupont@ext.mpsa.com
-
Daniel Peebles
-
Edward Z. Yang
-
Evan Laforge
-
Henning Thielemann
-
Henning Thielemann
-
Ivan Lazar Miljenovic
-
Johannes Waldmann
-
Mathew de Detrich
-
Simon Peyton-Jones