database - 对 Yesod 中的 selectOneMany 感到困惑

Question

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

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

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

我试着浏览 haskellers.org source但找不到任何连接示例。我还检查了 chapter on joins在旧书中，但它只让我眼花缭乱。我的 Haskell 知识水平很低，所以要温和。

Answer 1

以下是两种结果类型相同的方法:

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")