Modélisation sûre des données relationnelles dans Haskell

IxSet est le ticket. Pour aider les autres qui pourraient trébucher sur ce post, voici un exemple plus complet,

{-# 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

Une autre approche radicalement différente de la représentation des données relationnelles est utilisée par le paquet de base de données haskelldb. Cela ne fonctionne pas tout à fait comme les types que vous décrivez dans votre exemple, mais il est conçu pour permettre une interface de type sécurisé aux requêtes SQL. Il dispose d'outils pour générer des types de données à partir d'un schéma de base de données et vice versa. Les types de données tels que ceux que vous décrivez fonctionnent bien si vous voulez toujours travailler avec des lignes entières. Mais ils ne fonctionnent pas dans des situations où vous voulez optimisez vos requêtes en sélectionnant uniquement certaines colonnes. C'est là que L'approche HaskellDB peut être utile.

On m'a demandé d'écrire une réponse en utilisant Opaleye. En fait, il n'y a pas beaucoup à dire, car le code Opaleye est assez standard une fois que vous avez un schéma de base de données. De toute façon, ici, il est, en supposant qu'il est un user_table avec des colonnes user_id, name et birthdate, et message_table, avec colonnes user_id, time_stamp et content.

Ce type de conception est expliqué plus en détail dans le tutoriel de base Opaleye.

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Arrows #-}

import Opaleye
import Data.Profunctor.Product (p2, p3)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Control.Arrow (returnA)

data UserId a = UserId { unUserId :: a }
$(makeAdaptorAndInstance "pUserId" ''UserId)

data User' a b c = User { userId    :: a
                        , name      :: b
                        , birthDate :: c }
$(makeAdaptorAndInstance "pUser" ''User')

type User = User' (UserId (Column PGInt4))
                  (Column PGText)
                  (Column PGDate)

data Message' a b c = Message { user      :: a
                              , timestamp :: b
                              , content   :: c }
$(makeAdaptorAndInstance "pMessage" ''Message')

type Message = Message' (UserId (Column PGInt4))
                        (Column PGDate)
                        (Column PGText)


userTable :: Table User User
userTable = Table "user_table" (pUser User
  { userId    = pUserId (UserId (required "user_id"))
  , name      = required "name"
  , birthDate = required "birthdate" })

messageTable :: Table Message Message
messageTable = Table "message_table" (pMessage Message
  { user      = pUserId (UserId (required "user_id"))
  , timestamp = required "timestamp"
  , content   = required "content" })

Exemple de requête qui relie la table utilisateur à la table des messages sur le champ user_id:

usersJoinMessages :: Query (User, Message)
usersJoinMessages = proc () -> do
  aUser    <- queryTable userTable    -< ()
  aMessage <- queryTable messageTable -< ()

  restrict -< unUserId (userId aUser) .== unUserId (user aMessage)

  returnA -< (aUser, aMessage)

Je n'ai pas de solution complète, mais je suggère de jeter un oeil au paquet ixset; Il fournit un type set avec un nombre arbitraire d'indices avec lesquels les recherches peuvent être effectuées. (Il est destiné à être utilisé avec acid-state pour la persistance.)

Vous devez toujours maintenir manuellement une "clé primaire" pour chaque table, mais vous pouvez le rendre beaucoup plus facile de plusieurs façons:

1. Ajout d'un paramètre de type Id, de sorte que, par exemple, un User contient un Id User plutôt que juste un Id. Cela garantit que vous ne mélangez pas Id s pour des types distincts.

2. Rendre le type Id abstrait, et offrir une interface sûre pour en générer de nouveaux dans un contexte donné (comme une monade State qui garde la trace du IxSet pertinent et du Id actuel le plus élevé).

3. Écrire des fonctions wrapper qui vous permettent, par exemple, de fournir un User où un Id User est attendu dans les requêtes, et qui appliquent des invariants (par exemple, si chaque Message contient une clé à un User valide, cela pourrait vous permettre de rechercher le User correspondant sans gérer une valeur Maybe; le "unsafety" est contenu dans cette fonction d'assistance).

Comme note supplémentaire, vous n'avez pas besoin d'une arborescence pour que les types de données réguliers fonctionnent, car ils peuvent représenter des graphiques arbitraires; cependant, cela rend les opérations simples comme la mise à jour du nom d'un utilisateur impossible.