如何推广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使用实例。