如何在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类型，而您需要一个非平凡的非定义 - 使用实例。