The following code took me several hours to work out. I post it here, so perhaps other can avoid the difficulties of working out how to use existential types. Improvements welcome. If anyone thinks it is worth it I could add it to the wiki under existential types (I didn't find the examples there very helpful). Hopefully my newreader won't destroy the layout. Rene. {-# OPTIONS -fglasgow-exts #-} module Record where -- Demo of an extensible updatable database using Data.Dynamic and Data.Map -- which can be updated by a list of updates which are implemented -- using existential types. import Control.Concurrent.MVar import qualified Data.Map as M import Data.Dynamic type Tables = M.Map Int Dynamic -- the dynamic database -- look up a table in the database based on it's type class Typeable a => GetType a where getValue :: Tables -> MVar a getValue tables = case M.lookup index tables of Just d -> case fromDynamic d of Just e -> e _ -> error $ "Table with index " ++ show index ++ " not in database." where index = tabIndex (undefined::a) tabIndex :: a -> Int -- Manually create indexes for each table. This could be probably done automatically -- using Oleg's type to integer code. instance GetType IntColl where tabIndex _ = 1 instance GetType CatString where tabIndex _ = 2 -- Define the update function for the table class (GetType m) => Table m where apply :: (m ->m) -> Tables -> IO () apply f tables = modifyMVar_ table (\v -> return $! f v) where table :: MVar m table = getValue tables -- Existential type to allow updates to various tables data SRec = forall m. Table m => SRec (m -> m) update_db tables (SRec f) = apply f tables -- helper function -- Define how the update is done to each table class Mod_def r m | r -> m where apply_record :: r -> m -> m -- Define a type for each table data IntColl = IntColl Int deriving (Typeable, Show) data CatString = CatString String deriving (Typeable, Show) instance Mod_def Int IntColl where apply_record i (IntColl j) = IntColl (i + j) instance Mod_def String CatString where apply_record i (CatString j) = CatString (i ++ j) -- Register the tables instance Table IntColl instance Table CatString -- Create an update record updater :: forall r m. (Table m, Mod_def r m) => r -> SRec updater rec = SRec ((\db -> apply_record rec db) :: (m -> m)) -- Some simple tests to get the typing right newDB :: (GetType a) => a -> IO Tables newDB x = do var <- newMVar x return $! M.singleton (tabIndex x) $ toDyn var test2 :: SRec -> IO () test2 f = newDB (IntColl 3) >>= (\ db -> update_db db f) test3 = test2 (updater (1::Int)) newTable :: (Typeable (MVar a), GetType a) => a -> IO (Int, Dynamic) newTable x = do mv <- newMVar x return (tabIndex x, toDyn mv) test4 = do initial_db <- sequence [newTable $ IntColl 5, newTable $ CatString " again"] let db = M.fromList initial_db mapM (update_db db) [updater (1::Int), updater "hello"] content <- readMVar (getValue db :: MVar IntColl) print content