Baffled by selectOneMany in Yesod

前端 未结 1 930
半阙折子戏
半阙折子戏 2021-01-22 15:12

Sweet but simple, how do Persistent joins work? Consider the following model:

Person
    number Int
    numberOfEyes Int
    firstName FirstnamesId
    lastName          


        
相关标签:
1条回答
  • 2021-01-22 15:51

    Here are two ways with identical result type:

    1. the new typed sql, based on the "esqueleto" package from Felipe Lessa which is persistent based

    2. and the previous rawSql way

      just add 1 or 2 as argument to the test


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

    extra module for 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 }
    

    execution:

    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")
    
    0 讨论(0)
提交回复
热议问题