DData in hierarchical libraries

Dear Haskell Librairies Mailing List, Some time ago we discussed the inclusion of DData in hierachical libraries. I remember Simon Marlow proposing someone "thrashes out the details" and present the result for review. So, I've played with the code, to come up with a list of proposed changes. The rationale behind most of these changes is better consistency (so enventually the library can use overloading), simplicity, and readability. I understand that most of these are trival, mostly naming issues, and therefore, open the door to potentially endless and futile disscussions. My goal is just to pinpoint potential flaws, and have your opinions. Then, I would propose a complete revised code, unless Daan wishes to do so. Here comes the changes: * remove the Scc module Seems to be redundant with SCC in Data.Graph * foldL, foldR, foldI -> foldl, foldr, foldi to match Prelude.fold[lr] * remove find, favouring (!) and lookup. avoids incoherency with Data.List.find * rename "single" to "singleton" more explicit, more usual. * remove (Queue, Seq).append (favouring "<>") Unneeded redundancy; addtitonally, the name doesn't suit well partial application. (implicit infix meaning)
map (append q1) listOfQueues
means that q1 is "prepended" to each queue. * Rename subset & friends. Similarly, they have an implicit infix meaning.
filter (subset s1) listOfSets
actually keeps sets that are supersets of s1. Is there an agreed-upon (operator) name for this? * Make maps look more like collections of couples. This involves changing some functions, as such:
filter f = Map.filterWithKey (curry f)
partition f = Map.partitionWithKey (curry f)
member (k,a) m = case Map.lookup k m of Nothing -> False Just a' -> a == a'
Similarly for fold, etc. Most debatable issues: * rename (<>) to (++) * Make some types instances of Ord and Functor. Additionnaly, a root name in the hierarchy must be chosen. A simple "DData" looks good to me. Or Data.Aux is better? Cheers, JP. __________________________________ Do you Yahoo!? Yahoo! Mail SpamGuard - Read only the mail you want. http://antispam.yahoo.com/tools

JP Bernardy wrote:
map (append q1) listOfQueues
means that q1 is "prepended" to each queue.
* Rename subset & friends.
Similarly, they have an implicit infix meaning.
filter (subset s1) listOfSets
actually keeps sets that are supersets of s1.
Is there an agreed-upon (operator) name for this?
The problem with operator names is that they look ugly when qualified ("Seq.++"). Surely partial application "(subset s)" is different from a section "(`subset` s)" but is something that a Haskeller must learn anyway! Guess which argument "r" is in the instance "Functor ((->) r)". (This took me an age.)
* Make maps look more like collections of couples.
It's seems Haskell tradition to curry as much as possible (though this makes arguments and results non-symmetric, as in "quotRem" and "divMod")
* rename (<>) to (++)
Ok, but see above. Both a symbolic and a letter name are fine (like difference and \\).
* Make some types instances of Ord and Functor.
Yes! Furthermore: "MultiSet" should be named "Bag", Daans remark "that equality on elements should be defined as a structural equality instead of an equivalence relation." already applies to Set and Map! (Or may equal set look different when printed out?) Just my single cent, Christian

Christian Maeder
Surely partial application "(subset s)" is different from a section "(`subset` s)" but is something that a Haskeller must learn anyway!
I think the standard approach, that arguments are ordered to make sense in infix mode, nicely disambiguates this issue. And I think the rest of the libraries are fairly consistent. (And why not "isSubsetOf", since we're redecoration anyway?) -kzm -- If I haven't seen further, it is by standing in the footprints of giants

may I recommend the following instances as well. I would like to see Seq stay in the library. using 'Seq String' to build up complicated structures can be much much more efficient than otherwise and it is a handy idiom to not have to constantly reimplement. import Data.Monoid import qualified IntSet as IS import qualified IntMap as IM import qualified Set import qualified Map import qualified Seq import Monad instance Monoid IS.IntSet where mempty = IS.empty mappend = IS.union mconcat = IS.unions instance Monoid (IM.IntMap a) where mempty = IM.empty mappend = IM.union mconcat = IM.unions instance Ord a => Monoid (Set.Set a) where mempty = Set.empty mappend = Set.union mconcat = Set.unions instance Ord k => Monoid (Map.Map k v ) where mempty = Map.empty mappend = Map.union mconcat = Map.unions instance Monoid (Seq.Seq a) where mempty = Seq.empty mappend = (Seq.<>) instance Functor Seq.Seq where fmap f xs = Seq.fromList (map f (Seq.toList xs)) instance Functor IM.IntMap where fmap = IM.map --instance Ord k => Functor (Map.Map k) where -- fmap = Map.map instance Monad Seq.Seq where a >>= b = mconcat ( map b (Seq.toList a)) return x = Seq.single x fail _ = Seq.empty instance MonadPlus Seq.Seq where -- should this match the Monoid instance? mplus = mappend mzero = Seq.empty -- --------------------------------------------------------------------------- John Meacham - California Institute of Technology, Alum. - john@foo.net ---------------------------------------------------------------------------

JP Bernardy wrote:
Then, I would propose a complete revised code, unless Daan wishes to do so.
It would be great if you can integrate the library in fptools -- just keep my name in the source code. I think though that it would be best if you first create a package with your proposal for review before adding it to fptools. Furthermore, we should add a proper BSD style license to all the sources. I have a specific license which I will send to you that should be attached, as I have agreed this license upon some (undisclosed) companies that are using the DData library. Here are detailed comments to your proposal:
* remove the Scc module
Seems to be redundant with SCC in Data.Graph
Not quite, it abstracts over the "Int" used to designate nodes and it returns the nodes in a very well specified order. I agree with you though that it is a rather strange module in the whole of DData and that it may be better to remove it.
* foldL, foldR, foldI -> foldl, foldr, foldi
to match Prelude.fold[lr]
The drawback of this is of course that you get even more name clashes with the prelude... requiring a "import Prelude" clause or "hiding (foldr, ...)" clause... Maybe it is better for the user to say "foldr = foldR" if they don't want to qualify their names?
remove find, favouring (!) and lookup.
What do you mean by this?
* rename "single" to "singleton"
Good plan, although I am in favor of adding "singleton" and marking "single" as deprecated in the documents. (so my old code can at least compile)
remove (Queue, Seq).append (favouring "<>")
I do not like this. I would rather vote for removing the operator. "append" is absolutely clear, while "<>" doesn't mean anything for the naive reader. That is why all my operators are also implemented by an explicit function.
map (append q1) listOfQueues
means that q1 is "prepended" to each queue.
Well, you can also write "map (q1 `append`) listOfQueues" :-)
* Rename subset & friends.
Good plan. Lets go for "isSubsetOf" or something.
* Make maps look more like collections of couples.
What !?! Why would you like to do that? It goes totally against the spirit of Haskell.
* rename (<>) to (++) * Make some types instances of Ord and Functor.
Maybe it is a good idea to make more data structures instances of Functor, Monad, and MonadPlus. Or maybe the proposed Monoid etc. Note that operations like "fmap" don't make sense for Set's as the type is more constraint, i.e.:
Set.map :: (a -> a) -> Set a -> Set a
This gives you the required behaviour, like "mappend" for concatenation. Things like (++) were specifically reserved for lists by the Haskell98 committee -- regardless whether you like it, I think we should stick with that philosophy. All the best, Daan.

JP Bernardy
Some time ago we discussed the inclusion of DData in hierachical libraries. .... Additionnaly, a root name in the hierarchy must be chosen. A simple "DData" looks good to me. Or Data.Aux is better?
One of the design principles of the hierarchical libraries is to *never* use catch-all names like "Aux", "Misc", "Etc". They convey no meaning, and the point of the hierarchy is to name by semantic category, based on the functionality of the modules. By a similar argument, the name "DData", while fine as a name for the package itself, does not convey sufficient distinguishing information as the root prefix of the modules themselves. Probably the simple "Data" prefix is exactly what you want, unless there are significant overlaps with the module names already in the "base" package. Regards, Malcolm

--- Malcolm Wallace
JP Bernardy
writes: Some time ago we discussed the inclusion of DData in hierachical libraries. .... Additionnaly, a root name in the hierarchy must be chosen. A simple "DData" looks good to me. Or Data.Aux is better?
One of the design principles of the hierarchical libraries is to *never* use catch-all names like "Aux", "Misc", "Etc". They convey no meaning, and the point of the hierarchy is to name by semantic category, based on the functionality of the modules.
Really, that was a joke for regular readers of the list. Yet, your remarks makes much sense and I completely agree.
By a similar argument, the name "DData", while fine as a name for the package itself, does not convey sufficient distinguishing information as the root prefix of the modules themselves. Probably the simple "Data" prefix is exactly what you want, unless there are significant overlaps with the module names already in the "base" package.
Well, DData is meant to replace Data.Set and Data.FiniteMap, and add some functionality. DData has "Set" and "Map", among other things. There's no real difference that justifies one being named FiniteMap and the other Map, though. Perhaps, DData is a fine name while it is "under review". Cheers, JP. __________________________________ Do you Yahoo!? Get better spam protection with Yahoo! Mail. http://antispam.yahoo.com/tools

Am Donnerstag, 26. Februar 2004 15:07 schrieb JP Bernardy:
[...]
Well, DData is meant to replace Data.Set and Data.FiniteMap, and add some functionality.
Is it for sure that Data.Set and Data.FiniteMap will be replaced by the DData stuff? Will the DData modules get the Data prefix when they are included in the hierarchical libraries?
[...]
Wolfgang
participants (7)
-
Christian Maeder
-
Daan Leijen
-
John Meacham
-
JP Bernardy
-
Ketil Malde
-
Malcolm Wallace
-
Wolfgang Jeltsch