对 Yesod 中的 selectOneMany 感到困惑

Posted 2023-04-01

【中文标题】对 Yesod 中的 selectOneMany 感到困惑

【英文标题】：Baffled by selectOneMany in Yesod

【发布时间】：2012-01-28 18:18:43

【问题描述】：

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

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

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

我尝试查看haskellers.org source，但找不到任何连接示例。我还查看了 yesod 书中的chapter on joins，但它只会让我眼前一亮。我的 Haskell 知识水平很低，所以要温柔。

【参考方案1】：

这里有两种结果类型相同的方法：

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

和之前的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")

【讨论】：

我已经从 Haskell 继续前进，但我会冒险假设这是正确的，无需测试。 :)