Сбит с толку selectOneMany в Yesod - PullRequest
Новая
       30

Сбит с толку selectOneMany в Yesod

2 голосов
/ 28 января 2012

Сладко, но просто, как работают постоянные объединения? Рассмотрим следующую модель: 

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

Если у меня есть только номер Человека, как мне узнать его полное имя и номер его глаза?

Я попытался просмотреть источник haskellers.org , но не смог найти примеров соединений. Я также проверил главу о соединениях в книге есод, но это только заставило мои глаза вращаться. Уровень моих знаний по Хаскеллу очень низкий, поэтому будьте осторожны.

1 Ответ

3 голосов
/ 18 сентября 2012

Вот два способа с одинаковым типом результата:

  1. новый тип SQL, основанный на пакете " 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")
...