Safe modelling of relational data in Haskell

Question

I find it very common to want to model relational data in my functional programs. For example, when developing a web-site I may want to have the following data structure to stor

Answer 1

IxSet is the ticket. To help others who might stumble on this post here's a more fully expressed example,

{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, TypeFamilies, TemplateHaskell #-}

module Main (main) where

import Data.Int
import Data.Data
import Data.IxSet
import Data.Typeable

-- use newtype for everything on which you want to query; 
-- IxSet only distinguishes indexes by type
data User = User 
  { userId :: UserId
  , userName :: UserName }
  deriving (Eq, Typeable, Show, Data)
newtype UserId = UserId Int64
  deriving (Eq, Ord, Typeable, Show, Data)
newtype UserName = UserName String
  deriving (Eq, Ord, Typeable, Show, Data)

-- define the indexes, each of a distinct type
instance Indexable User where
   empty = ixSet 
      [ ixFun $ \ u -> [userId u]
      , ixFun $ \ u -> [userName u]
      ]

-- this effectively defines userId as the PK
instance Ord User where
   compare p q = compare (userId p) (userId q)

-- make a user set
userSet :: IxSet User
userSet = foldr insert empty $ fmap (\ (i,n) -> User (UserId i) (UserName n)) $ 
    zip [1..] ["Bob", "Carol", "Ted", "Alice"]

main :: IO ()
main = do
  -- Here, it's obvious why IxSet needs distinct types.
  showMe "user 1" $ userSet @= (UserId 1)
  showMe "user Carol" $ userSet @= (UserName "Carol")
  showMe "users with ids > 2" $ userSet @> (UserId 2)
  where
  showMe :: (Show a, Ord a) => String -> IxSet a -> IO ()
  showMe msg items = do
    putStr $ "-- " ++ msg
    let xs =  toList items
    putStrLn $ " [" ++ (show $ length xs) ++ "]"
    sequence_ $ fmap (putStrLn . show) xs