Идиоматические Хаскелл подключения к базе данных


В этом посте я спросил о том, что бы быть идиоматические Haskell в базе абстракции. Я думал за это время, и первый ответ был похож на то, что я имел в виду, и я написал, подтверждающий это. Отбросив мерзость-это схема, что бы вы изменили и почему?

Базы данных.УГ

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Database (
    runDB
  , quickQuery
  , prepare
  , execute
  , fetchRowAl
  , DB (..)
  , module Database.HDBC.SqlValue
) where
import qualified Database.HDBC as H
import Database.HDBC.SqlValue
import Database.HDBC.Sqlite3
import Control.Monad.Reader

newtype DB a = D (ReaderT Connection IO a) deriving (Monad, MonadReader Connection, MonadIO)

runDB ::  FilePath -> DB b -> IO b
runDB path (D x) = do
  c <- connectSqlite3 path
  mkSchema c
  r <- runReaderT x c
  H.disconnect c
  return r

mkSchema conn = do
  tables <- H.getTables conn
  unless ("Location" `elem` tables) $ do
    H.handleSqlError $ H.quickQuery' conn "CREATE TABLE Location (location TEXT PRIMARY KEY)" []
    return ()
  unless ("Person" `elem` tables) $ do
    H.handleSqlError $ H.quickQuery' conn (unwords [
        "CREATE TABLE Person"
      , "(id INTEGER PRIMARY KEY AUTOINCREMENT,"
      , "name TEXT NOT NULL,"
      , "age INT NOT NULL,"
      , "location TEXT,"
      , "FOREIGN KEY (location) REFERENCES Location (location))"]) []
    return ()

quickQuery :: String -> [SqlValue] -> DB [[SqlValue]]
quickQuery q v = ask >>= \c -> liftIO $ H.quickQuery c q v

prepare :: String -> DB H.Statement
prepare q = ask >>= \c -> liftIO $ H.prepare c q

execute :: H.Statement -> [SqlValue] -> DB Integer
execute stmt v = liftIO $ H.execute stmt v

fetchRowAl :: H.Statement -> DB (Maybe [(String, SqlValue)])
fetchRowAl = liftIO . H.fetchRowAL

Модель.УГ

module Model where

import Database

data Person = Person (Maybe Int) String Int Location
newtype Location = Location String deriving (Eq)

instance Eq Person where
  (Person _ a b c) == (Person _ a' b' c') = a == a' && b == b' && c == c'

saveLocation ::  Location -> DB ()
saveLocation (Location x) = quickQuery "INSERT OR IGNORE INTO Location VALUES (?)" [toSql x] >> return ()

retrieveLocation :: String -> DB (Maybe Location)
retrieveLocation x = do
  r <- quickQuery "SELECT location FROM Location WHERE location=?" [toSql x]
  case r of
       [] -> return Nothing
       [[y]] -> return $ Just $ Location $ fromSql y

savePerson :: Person -> DB ()
savePerson (Person _ n a l@(Location loc)) = do
  saveLocation l
  quickQuery "INSERT INTO Person (name, age, location) VALUES (?, ?, ?)" [toSql n, toSql a, toSql loc]
  return ()

retrievePersons name = do
  r <- quickQuery "SELECT id, name, age, location FROM Person WHERE name=?" [toSql name]
  let persons = map makePerson r
  return persons
  where
    makePerson [sid, sname, sage, slocation] =
      Person (fromSql sid) (fromSql sname) (fromSql sage) (Location (fromSql slocation))

тесты.УГ

import Test.HUnit
import Test.Framework.Providers.HUnit
import Test.Framework (defaultMain, testGroup)
import System.Directory
import Database.HDBC (quickQuery')
import Control.Monad.Reader
import Control.Applicative
import Data.Maybe
import Database
import Model

runTest f = runDB "/tmp/test.db" f <* removeFile "/tmp/test.db"

testConnected = runTest $ do
  c <- ask
  r <- liftIO $ quickQuery' c "SELECT 'foo' AS value" []
  liftIO $ assertBool "Return value should not be empty" (length r > 0)

testQuickQuery = runTest $ do
  [[x]] <- quickQuery "SELECT ? AS value" [toSql "foo"]
  liftIO $ assertBool "quickQuery" (fromSql x == "foo")

testPrepared = runTest $ do
  stmt <- prepare "SELECT ? AS value"
  execute stmt [toSql "foo"]
  (Just r) <- fetchRowAl stmt
  let (Just x) = lookup "value" r
  liftIO $ assertBool "prepared" (fromSql x == "foo")

testRetrieveLocationNothing = runTest $ do
  r <- retrieveLocation "Turku"
  liftIO $ assertBool "Location nothing" (isNothing r)

testSaveLocation = runTest $ do
  let turku = Location "Turku"
  saveLocation turku
  (Just loc) <- retrieveLocation "Turku"
  liftIO $ assertBool "loc == turku" (loc == turku)

testSavePerson = runTest $ do
  let person = Person Nothing "Person" 25 $ Location "Turku"
  savePerson person
  [per] <- retrievePersons "Person"
  liftIO $ assertBool "model == db" $ validate person per
  where
    validate _ (Person Nothing _ _ _) = False
    validate a b = a == b

tests = [
    testGroup "Database" [
        testCase "connected" testConnected
      , testCase "quickQuery" testQuickQuery
      , testCase "testPrepared" testPrepared
    ]
  , testGroup "Model" [
        testCase "saveLocation" testSaveLocation
      , testCase "savePerson" testSavePerson
      , testCase "testRetrieveLocationNothing" testRetrieveLocationNothing
    ]
  ]

main = defaultMain tests


1562
7
задан 28 апреля 2011 в 09:04 Источник Поделиться
Комментарии
1 ответ

Во-первых, я заметил баг: после HDBC неявно запускает запросы в транзакции, и поскольку ты никогда не совершал, никакие изменения не будут применены к базе данных. Добавьте тест, который опять открывает файл, чтобы убедиться, что изменения сохраняются.

Теперь, на структуру кода.

Мне определенно нравится воспользоваться читатель монады. Он не только удержать пользователя от необходимости прохождения соединение вокруг, но он ограничивает базу операций в одном потоке (если я правильно понял, sqlite3 не поддерживает одновременный доступ к одному дескриптора соединения, не HDBC-sqlite3 для обеспечения взаимного исключения). Однако, поскольку MonadReader связи экземпляра выставлены, пользователь может все еще получить на основной связи и как-то в другой ветке. Я бы не слишком беспокоился об этом, через.

Вы можете хотеть использовать системы типа некоторые. Например, можно определить класс тип записей, которые могут храниться и извлекаться:

class Record r where
insert :: r -> DB Int -- returns the ID of the inserted row
get :: Int -> DB (Maybe r)

Еще лучше использовать типа Фантома , чтобы сохранить идентификатор типов различны:

newtype Id record = Id {unId :: Int}
deriving (Eq, Ord)

class Record r where
insert :: r -> DB (Id r)
get :: Id r -> DB (Maybe r)

Однако, есть проблема: при расположении таблицы первичный ключ-это текст, а не ИНТ. Если бы это зависело от меня, я бы отдал место в таблице целое число первичный ключ, так что:


  • Все записи имеют последовательный тип ID

  • Места могут быть переименованы без нарушения ограничения внешнего ключа.

  • На человека таблица не дублировать расположение имен. Вы не хотите, чтобы ваши базы данных взорвать, когда 200 человек взять экскурсию в Llanfairpwllgwyngyllgogerychwyrndrobwllllantysiliogogogoch.

Я рекомендую прочитать стойких главе Есод книги. Даже если вы не используете настойчивый, посмотри, как он предназначен.

Например, я заметил, что вы включили поле ID в лицо типа:

data Person = Person (Maybe Int) String Int Location

Настойчивый выбирает, чтобы сохранить идентификатор и данные отдельно. В разделе вставка дает убедительное обоснование.

Постоянные и функционирует база данных монады в одной транзакции (см. раздел PersistBackend). HDBC неявно управляет всем в транзакции, так что вы не должны сделать многое, чтобы последовать их примеру. Этот подход имеет семантическую пользу. Иногда, вы должны сделать группу операций атомарно. А не звонить начинают и совершают явно (и надеясь, что звонящий не делаем вещи в сделке), вы можете использовать тип системы, чтобы заставить код выполняться внутри транзакции.

СТМ делает что-то подобное: вы можете использовать вложенные транзакции без отклоняетесь от типа системы (например, с unsafePerformIO).

6
ответ дан 12 января 2012 в 03:01 Источник Поделиться