如何推廣Haskell中的Opaleye查詢（使用乙烯基）？

Question

我的問題是在下面的代碼塊巨大的橫幅之間。

原諒代碼轉儲，這是所有粘貼在這裏想要的任何人複製，而這種代碼確實工作如預期，雖然這是一個有點陌生。注意最後兩行，它們打印正確的SQL。

目標：

我有Text類型的主鍵，具體地，電子郵件的表。我沒有爲每個表格編寫新的查詢函數，而是承擔了推廣該函數的任務，以便我可以安全地查詢任何有電子郵件的表。

問題：

爲了得到這個工作，我必須包括：

instance Default Constant CEmail (Column PGText) where 
    def = undefined 

這讓我覺得我做錯了什麼。任何關於構建查詢的建議，可以從任何具有電子郵件的表中查找記錄？

{- stack 
--resolver lts-8.2 
--install-ghc 
exec ghci 
--package aeson 
--package composite-base 
--package composite-aeson 
--package text 
--package string-conversions 
--package postgres-simple 
--package vinyl 
-} 

{-# LANGUAGE 
Arrows 
, DataKinds 
, OverloadedStrings 
, PatternSynonyms 
, TypeOperators 
, TemplateHaskell 
, FlexibleContexts 
, RankNTypes 

, ConstraintKinds 
, TypeSynonymInstances 
, FlexibleInstances 
, MultiParamTypeClasses 
#-} 

import Data.Vinyl (RElem) 
import Data.Functor.Identity (Identity) 
import Data.Vinyl.TypeLevel (RIndex) 
import Composite.Aeson (JsonFormat, defaultJsonFormatRec, recJsonFormat, toJsonWithFormat) 
import Composite.Opaleye (defaultRecTable) 

import Composite.Record (Record, Rec(RNil), (:->), pattern (:*:)) 
import Composite.TH (withOpticsAndProxies) 
import Control.Arrow (returnA) 
import Control.Lens (view) 
import Data.Int (Int64) 
import Data.Proxy (Proxy(Proxy)) 
import Data.Text (Text) 
import Opaleye 
import Opaleye.Internal.TableMaker (ColumnMaker) 
import Data.String.Conversions (cs) 
import qualified Data.Aeson as Aeson 

import qualified Database.PostgreSQL.Simple as PGS -- used for printSql 
import Data.Profunctor.Product.Default (Default(def)) 


-------------------------------------------------- 
-- | Types 


-- | Newtype ClearPassword so it can't be passed around as ordinary Text 
newtype ClearPassword a = ClearPassword a 

withOpticsAndProxies [d| 
    type FEmail = "email" :-> Text 
    type CEmail = "email" :-> Column PGText 

    type FAge = "age" :-> Text 
    type CAge = "age" :-> Column PGText 

    type FClearPassword = "clearpass" :-> ClearPassword Text 
    type CHashPassword = "hashpass" :-> Column PGText 
    |] 


-------------------------------------------------- 
-- | Db Setup 

-- | Helper Fn 
printSql :: Default Unpackspec a a => Query a -> IO() 
printSql = putStrLn . maybe "Empty query" id . showSqlForPostgres 

-- | Db Records 
type DbUser = '[CEmail, CAge] 
type DbPassword = '[CEmail, CHashPassword] 


-------------------------------------------------- 
-------------------------------------------------- 
-- 
-- LOOK HERE vvvvvvvvvvvvvvvvvvvvvvvv 
-- 
-------------------------------------------------- 
-------------------------------------------------- 

type RecWith f rs = (Default ColumnMaker (Record rs) (Record rs), 
        Default Constant f (Column PGText), 
        RElem f rs (RIndex f rs)) 

-- | queryByEmail needs this, but totally works if `def` is declared 
-- as `undefined` ??? 
instance Default Constant CEmail (Column PGText) where 
    def = undefined 

queryByEmail :: (RecWith CEmail rs) => 
       Table a (Record rs) -> Text -> QueryArr() (Record rs) 
queryByEmail table email = proc() -> do 
    u <- queryTable table -<() 
    let uEmail = view cEmail u 
    restrict -< uEmail .=== constant email 
    returnA -< u 

-------------------------------------------------- 
-------------------------------------------------- 
-- 
-- LOOK UP ^^^^^^^^^^^^^^^^^^^^^^^^ 
-- 
-------------------------------------------------- 
-------------------------------------------------- 

userTable :: Table (Record DbUser) (Record DbUser) 
userTable = Table "user" defaultRecTable 

-- | Password 
passwordTable :: Table (Record DbPassword) (Record DbPassword) 
passwordTable = Table "password" defaultRecTable 

-- SELECT ... FROM "user" ... 
queryUserTest = printSql $ queryByEmail userTable "hi" 

-- SELECT ... FROM "password" ... 
queryPasswordTest = printSql $ queryByEmail passwordTable "hi" 

Answer 1

降外來Default Constant f (Column PGTest)約束，你要善於去：

#!/usr/bin/env stack 
{- stack --resolver lts-8.11 --install-ghc exec ghci --package aeson --package composite-base --package composite-aeson --package text --package string-conversions --package vinyl --package composite-opaleye -} 
{-# LANGUAGE Arrows, DataKinds, OverloadedStrings, PatternSynonyms, TypeOperators, TemplateHaskell, FlexibleContexts, RankNTypes, ConstraintKinds, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses #-} 

import Composite.Opaleye (defaultRecTable) 
import Composite.Record (Record, (:->)) 
import Composite.TH (withOpticsAndProxies) 
import Control.Arrow (returnA) 
import Control.Lens (view) 
import Data.Profunctor.Product.Default (Default) 
import Data.Text (Text) 
import Data.Vinyl (RElem) 
import Data.Vinyl.TypeLevel (RIndex) 
import Opaleye.Internal.TableMaker (ColumnMaker) 

import Opaleye 


newtype ClearPassword a = ClearPassword a 

withOpticsAndProxies [d| 
    type FEmail = "email" :-> Text 
    type CEmail = "email" :-> Column PGText 

    type FAge = "age" :-> Text 
    type CAge = "age" :-> Column PGText 

    type FClearPassword = "clearpass" :-> ClearPassword Text 
    type CHashPassword = "hashpass" :-> Column PGText 
    |] 

type DbUser = '[CEmail, CAge] 
type DbPassword = '[CEmail, CHashPassword] 

printSql :: Default Unpackspec a a => Query a -> IO() 
printSql = putStrLn . maybe "Empty query" id . showSqlForPostgres 

queryByEmail :: (RElem CEmail rs (RIndex CEmail rs), Default ColumnMaker (Record rs) (Record rs)) => Table a (Record rs) -> Text -> QueryArr() (Record rs) 
queryByEmail table email = proc() -> do 
    u <- queryTable table -<() 
    let uEmail = view cEmail u 
    restrict -< uEmail .=== constant email 
    returnA -< u 

userTable :: Table (Record DbUser) (Record DbUser) 
userTable = Table "user" defaultRecTable 

passwordTable :: Table (Record DbPassword) (Record DbPassword) 
passwordTable = Table "password" defaultRecTable 

queryUserTest = printSql $ queryByEmail userTable "hi" 
queryPasswordTest = printSql $ queryByEmail passwordTable "hi" 

的constant email調用使用（已現存）Default Constant Text (Column PGText)約束;是email有類型CEmail而不是你需要一個非平凡的非undefined使用實例。