How to generalize an Opaleye Query in Haskell (Using Vinyl)? - postgresql

Question

My question is between the huge banners in the code block below.
Forgive the code dump, this is all pasted here for anyone wanting to replicate, and this code does work as expected, although it's a bit strange. Notice the last two lines, they print proper SQL.
Goal:
I have tables with primary keys of type Text, specifically, emails. Instead of writing a new query function for each table, I took upon the task of generalizing the function, so that I could type-safely query any table that has emails.
Problem:
In order to get this to work, I had to include:
instance Default Constant CEmail (Column PGText) where
def = undefined
Which makes me think I'm doing something wrong. Any advice for building a query that can find records from any table that has Emails?
{- 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

Drop the extraneous Default Constant f (Column PGTest) constraint and you should be good to go:
#!/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"
The constant email call uses the (already extant) Default Constant Text (Column PGText) constraint; were email to have type CEmail instead you would need a non-trivial non-undefined-using instance.