Yesterday, I wrote an email with no subject header:
I'm attempting to construct an abstract data type with a deferred representation. [...]
I got rid of those annoying Map and Set newtype wrappers from my previous post, after realising that the only reason I had needed them was to eliminate a coverage condition failure on a FooLike class parameter that wasn't rightfully part of the FooLike abstraction. Having eliminated that thinko, it all seems rather obvious now (revised code follows). It's been said that the type system is good at telling you when you've done something wrong, but this is the first time I've seen it give strong hints that something is unnecessarily overcomplicated even though it does work.
{-# LANGUAGE FunctionalDependencies #-}
import qualified Data.IntMap as IM import qualified Data.IntSet as IS import qualified Data.Map as M import qualified Data.Set as S
-- MapLike and SetLike classes, used as the basis for the -- implementation of the Foo abstract datatype.
class MapLike k v m | m -> k v where emptyM :: m insertWithM :: (v -> v -> v) -> k -> v -> m -> m toListM :: m -> [(k,v)]
class SetLike e s | s -> e where singletonS :: e -> s unionS :: s -> s -> s toListS :: s -> [e]
-- Implementation of Foo abstract datatype as simple top-level functions. -- No need for a concrete type at this point.
tl_emptyF :: (MapLike k s m, SetLike e s) => m tl_emptyF = emptyM
tl_insertF :: (MapLike k s m, SetLike e s) => k -> e -> m -> m tl_insertF k e m = insertWithM unionS k (singletonS e) m
tl_toListF :: (MapLike k s m, SetLike e s) => m -> [(k,e)] tl_toListF m = [ (k,e) | (k,s) <- toListM m, e <- toListS s ]
-- FooLike class API for Foo abstract datatype.
class FooLike k e f | f -> k e where emptyF :: f insertF :: k -> e -> f -> f toListF :: f -> [(k,e)]
-- Generic FooLike instance, constructed in terms of MapLike and SetLike. -- Details of the concrete type are deferred.
newtype Foo k e s m = Foo m
instance (MapLike k s m, SetLike e s) => FooLike k e (Foo k e s m) where emptyF = Foo tl_emptyF insertF k e (Foo m) = Foo (tl_insertF k e m) toListF (Foo m) = tl_toListF m
-- Some MapLike and SetLike instances, for the tests that follow.
instance Ord k => MapLike k v (M.Map k v) where emptyM = M.empty insertWithM = M.insertWith toListM = M.toList
instance MapLike Int v (IM.IntMap v) where emptyM = IM.empty insertWithM = IM.insertWith toListM = IM.toList
instance Ord e => SetLike e (S.Set e) where singletonS = S.singleton unionS = S.union toListS = S.toList
instance SetLike Int IS.IntSet where singletonS = IS.singleton unionS = IS.union toListS = IS.toList
-- Some simple tests.
type FooOrdOrd k e = Foo k e (S.Set e) (M.Map k (S.Set e)) type FooIntOrd e = Foo Int e (S.Set e) (IM.IntMap (S.Set e)) type FooOrdInt k = Foo k Int IS.IntSet (M.Map k IS.IntSet) type FooIntInt = Foo Int Int IS.IntSet (IM.IntMap IS.IntSet)
testFoo t = toListF $ insertF 3 2 $ insertF 5 1 $ insertF 3 2 $ insertF 5 2 $ asTypeOf emptyF t
main = do print $ testFoo (undefined :: FooOrdOrd Integer Integer) print $ testFoo (undefined :: FooIntOrd Integer) print $ testFoo (undefined :: FooOrdInt Integer) print $ testFoo (undefined :: FooIntInt)