2

甜蜜而简单，持久连接如何工作？考虑以下模型：

Person
    number Int
    numberOfEyes Int
    firstName FirstnamesId
    lastName LastnamesId
Lastnames
    lastname String
Firstnames
    firstname String

假设我只有一个人的号码，我如何检索他的全名和他的眼睛数量？

我尝试查看haskellers.org 源，但找不到任何连接示例。我还查看了yesod 书中关于加入的章节，但它只让我眼前一亮。我的 Haskell 知识水平非常低，所以要温柔。

4

1 回答 1

4

以下是具有相同结果类型的两种方法：

  1. 新类型的 sql，基于 Felipe Lessa 的“ esqueleto ”包，它是基于持久性的

  2. 和之前的rawSql方式

    只需添加 1 或 2 作为测试的参数

{- file prova.hs-}
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, OverloadedStrings #-}
{-# LANGUAGE GADTs, FlexibleContexts, ConstraintKinds, ScopedTypeVariables #-}
import Prelude hiding (catch)
import Control.Exception  
import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.TH
import Control.Monad.IO.Class (liftIO)
import Data.Text (Text)
import Database.Persist.Quasi
import Database.Esqueleto as Esql
import Database.Persist.GenericSql (SqlPersist, rawSql)
import Control.Monad.Logger (MonadLogger)
import Control.Monad.Trans.Resource (MonadResourceBase)
import System.Environment (getProgName, getArgs)   
import System.Exit (exitSuccess, exitWith, ExitCode(..))
import Text.Printf (printf)

import QQStr(str)  -- heredoc quasiquoter module

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persist|
Person
    number Int
    numberOfEyes Int
    firstName FirstnamesId
    lastName LastnamesId
    UniquePersonNumber number 
    deriving Show

Lastnames
    lastname String
    deriving Show

Firstnames
    firstname String
    deriving Show
|]

-- the esqueleto way

-- with this type annotation it could be run in a yesod handler with ''runDB''
getPersonInfoByNumber :: (PersistQuery SqlPersist m, MonadLogger m, MonadResourceBase m) => Int -> SqlPersist m (Maybe (Int, String, String))
getPersonInfoByNumber pNumber = do
    result <- select $ from $ \(fn `InnerJoin` p `InnerJoin` ln) -> do
            on ((p ^. PersonFirstName) Esql.==. (fn ^. FirstnamesId))
            on ((p ^. PersonLastName) Esql.==. (ln ^. LastnamesId))
            where_ ((p ^. PersonNumber) Esql.==. val pNumber)
            return (p , fn, ln)

    case result of
        [(Entity _ p, Entity _ fn, Entity _ ln)] -> return $ Just (personNumberOfEyes p, firstnamesFirstname fn, lastnamesLastname ln)
        _ -> return Nothing

-- the rawSql way

stmt = [str|SELECT ??, ??, ??
                          FROM Person, Lastnames, Firstnames
                          ON Person.firstName = Firstnames.id
                          AND Person.lastName = Lastnames.id
                          WHERE Person.number = ?
                         |]
                         
getPersonInfoByNumberRaw :: (PersistQuery SqlPersist m, MonadLogger m, MonadResourceBase m) => Int -> SqlPersist m (Maybe (Int, String, String))
getPersonInfoByNumberRaw pNumber = do
    result <- rawSql stmt [toPersistValue pNumber]

    case result of
        [(Entity _ p, Entity _ fn, Entity _ ln)] -> return $ Just (personNumberOfEyes p, firstnamesFirstname fn, lastnamesLastname ln)
        _ -> return Nothing

        
main :: IO ()
main = do
    args <- getArgs
    nomProg <- getProgName
    case args of
        [] -> do
             printf "%s: just specify 1 for esqueleto or 2 for rawSql.\n" nomProg
             exitWith (ExitFailure 1)

        [arg] -> (withSqliteConn ":memory:" $ runSqlConn $ do
              runMigration migrateAll
 
              let myNumber = 5
              fnId <- insert $ Firstnames "John"
              lnId <- insert $ Lastnames "Doe"

              -- in case of insert collision, because of UniquePersonNumber constraint
              --    insertUnique does not throw exceptions, returns success in a Maybe result
              --    insert would throw an exception 

              maybePersId <- insertUnique $ Person {personNumber = myNumber, personNumberOfEyes=2,
                                                personFirstName = fnId, personLastName = lnId}

              info <- case arg of
                          "1" -> getPersonInfoByNumber myNumber
                          _ -> getPersonInfoByNumberRaw myNumber
              liftIO $ putStrLn $ show info
              )
              `catch` (\(excep::SomeException) -> 
                               putStrLn $ "AppSqlError: " ++ show excep)

heredoc quasiquoter 的额外模块

module QQStr(str) where

import Prelude
import Language.Haskell.TH
import Language.Haskell.TH.Quote

str = QuasiQuoter { quoteExp = stringE, quotePat = undefined
                  , quoteType = undefined, quoteDec = undefined }

执行：

gabi64@zotac-ion:~/webs/yesod/prova$ ./cabal-dev/bin/prova 1
Migrating: CREATE TABLE "Person"("id" INTEGER PRIMARY KEY,"number" INTEGER NOT NULL,"numberOfEyes" INTEGER NOT NULL,"firstName" INTEGER NOT NULL REFERENCES "Firstnames","lastName" INTEGER NOT NULL REFERENCES "Lastnames")
Migrating: CREATE TABLE "Lastnames"("id" INTEGER PRIMARY KEY,"lastname" VARCHAR NOT NULL)
Migrating: CREATE TABLE "Firstnames"("id" INTEGER PRIMARY KEY,"firstname" VARCHAR NOT NULL)
Just (2,"John","Doe")
于 2012-09-18T19:15:28.893 回答