HaskellでOpalyeクエリを一般化する方法（ビニールを使用）？

Question

私の質問は、下のコードブロックの巨大なバナーの間です。

は、コードダンプを許し、これはすべて複製したい人のためにここに貼り付けられ、そして予想通り、それは少し奇妙だが、このコードは、仕事を行います。最後の2行を確認し、適切な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がありましたが、代わりに非定義の使用されていないインスタンスが必要です。