Haskell中关系数据的安全建模

Question

我发现想要在我的功能程序中建模关系数据是很常见的.例如,在开发网站时,我可能希望使用以下数据结构来存储有关我的用户的信息:

data User = User 
  { name :: String
  , birthDate :: Date
  }

接下来,我想存储有关用户在我的网站上发布的消息的数据:

data Message = Message
  { user :: User
  , timestamp :: Date
  , content :: String
  }

此数据结构存在多个问题:

• 我们无法区分具有相似姓名和出生日期的用户.
• 用户数据将在序列化/反序列化时重复
• 比较用户需要比较他们的数据,这可能是昂贵的操作.
• 对字段的更新User是脆弱的 - 您可能忘记更新User数据结构中的所有事件.

这些问题是可管理的,而我们的数据可以表示为树.例如,您可以像这样重构:

data User = User
  { name :: String
  , birthDate :: Date
  , messages :: [(String, Date)] -- you get the idea
  }

但是,可以将数据整形为DAG(想象任何多对多关系),甚至可以作为一般图形(好的,也许不是).在这种情况下,我倾向于通过在Maps中存储我的数据来模拟关系数据库:

newtype Id a = Id Integer
type Table a = Map (Id a) a

这种作品,但由于多种原因不安全和丑陋:

• 你只是一个Id远离无意义查找的构造函数调用.
• 在查找时,您可以获得Maybe a,但数据库通常在结构上确保存在值.
• 这很笨拙.
• 很难确保数据的参照完整性.
• 管理指数(这对于绩效非常必要)并确保其完整性更加困难和笨拙.

是否有克服这些问题的工作？

它看起来像模板Haskell可以解决它们(通常如此),但我不想重新发明轮子.

Answer 1

该ixset库将帮助您与此有关.它是支持关系部分的库,acid-state它还处理数据的版本化序列化和/或并发保证,以备不时之需.

事情大概ixset是,它可以自动管理"钥匙"为您的数据条目.

对于您的示例,可以为您的数据类型创建一对多关系,如下所示:

data User =
  User
  { name :: String
  , birthDate :: Date
  } deriving (Ord, Typeable)

data Message =
  Message
  { user :: User
  , timestamp :: Date
  , content :: String
  } deriving (Ord, Typeable)

instance Indexable Message where
  empty = ixSet [ ixGen (Proxy :: Proxy User) ]

然后,您可以找到特定用户的消息.如果你已经建立了IxSet这样的:

user1 = User "John Doe" undefined
user2 = User "John Smith" undefined

messageSet =
  foldr insert empty
  [ Message user1 undefined "bla"
  , Message user2 undefined "blu"
  ]

...然后您可以通过以下方式查找消息user1:

user1Messages = toList $ messageSet @= user1

如果您需要查找消息的用户,只需使用user正常的功能即可.这模拟了一对多的关系.

现在,对于多对多关系,情况如下:

data User =
  User
  { name :: String
  , birthDate :: Date
  , messages :: [Message]
  } deriving (Ord, Typeable)

data Message =
  Message
  { users :: [User]
  , timestamp :: Date
  , content :: String
  } deriving (Ord, Typeable)

...您创建一个索引ixFun,可以与索引列表一起使用.像这样:

instance Indexable Message where
  empty = ixSet [ ixFun users ]

instance Indexable User where
  empty = ixSet [ ixFun messages ]

要查找用户的所有消息,您仍然使用相同的功能:

user1Messages = toList $ messageSet @= user1

此外,只要您拥有用户索引:

userSet =
  foldr insert empty
  [ User "John Doe" undefined [ messageFoo, messageBar ]
  , User "John Smith" undefined [ messageBar ]
  ]

...您可以找到所有用户的消息:

messageFooUsers = toList $ userSet @= messageFoo

如果您不希望在添加新用户/消息时更新消息的用户或用户的消息,则应该创建一个中间数据类型来模拟用户和消息之间的关系,就像在SQL中一样(并删除users和messages字段):

data UserMessage = UserMessage { umUser :: User, umMessage :: Message } 

instance Indexable UserMessage where
  empty = ixSet [ ixGen (Proxy :: Proxy User), ixGen (Proxy :: Proxy Message) ]

通过创建一组这些关系,您可以通过消息和消息为用户查询用户,而无需更新任何内容.

考虑到它的作用,该库有一个非常简单的界面!

编辑:关于"需要比较的昂贵数据":ixset仅比较您在索引中指定的字段(因此,在第一个示例中查找用户的所有消息,它比较"整个用户").

您可以通过更改Ord实例来规范它所比较的​​索引字段的哪些部分.因此,如果比较用户对您来说成本很高,则可以添加userId字段并修改instance Ord User为仅比较此字段.

这也可以用来解决鸡蛋问题:如果你有一个id,但既不是a User,也不是Message？

然后,您可以简单地为id创建一个显式索引,通过该id(with userSet @= (12423 :: Id))查找用户,然后执行搜索.

Answer 2

IxSet是门票.为了帮助别人谁可能对这个职位绊倒这里有一个更充分地表示例如,

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

Answer 3

数据库包haskelldb使用另一种完全不同的表示关系数据的方法.它不像您在示例中描述的类型那样工作,但它旨在允许SQL查询的类型安全接口.它具有从数据库模式生成数据类型的工具,反之亦然.如果您总是希望使用整行,那么您描述的数据类型可以很好地工作.但是,如果您只想选择某些列来优化查询,则它们不起作用.这是HaskellDB方法有用的地方.

Answer 4

我被要求用Opaleye写一个答案.事实上,没有太多可说的,因为一旦你有了数据库模式,Opaleye代码就相当标准.无论如何,这里是,假设有一个user_table列user_id,name和birthdate,和一个message_table列user_id,time_stamp和content.

在Opaleye Basic Tutorial中更详细地解释了这种设计.

{-# 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" })

将用户表连接到消息表的示例查询 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)