动态选择Database.Esqueleto SQL运算符

Question

I want to create Database.Esqueleto queries dynamically based on data stored in the database (see DynamicQuery Database.Persist entity in the code snippet below). The code below compiles but it is not very elegant because of repeated definitions ( op for Text field type, op2 for Day field type, and op3 for Bool field type).

Is it possible to write a more general function similar to op that could be used in all cases in the definition of expr ?

Trying to reuse op for the Day field type where op2 is used results in the following error message:

test.hs:68:46:
Couldn't match expected type `Text' with actual type `Day'
Expected type: EntityField (ItemGeneric backend0) Text
  Actual type: EntityField (ItemGeneric backend0) Day
In the second argument of `(^.)', namely `ItemInserted'
In the first argument of `op', namely `(mp ^. ItemInserted)'

The code snippet follows:

{-# LANGUAGE EmptyDataDecls    #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TypeFamilies      #-}
{-# LANGUAGE RankNTypes        #-}

import Database.Esqueleto
import Database.Esqueleto.Internal.Sql
import Data.Time.Calendar
import Data.Text (Text)
import qualified Data.Text as T
import Database.Persist.TH
import Database.Persist.Sqlite hiding ((==.), (!=.), (>=.), (<=.))
import Control.Monad.IO.Class (liftIO)

import Enums
{- enumerated field types have to be in a separate module due to GHC
-- stage restriction. Enums.hs contains the following definitions:
{-# LANGUAGE TemplateHaskell   #-}
module Enums where
import Database.Persist.TH

data DynField = DynFieldName | DynFieldInserted | DynFieldActive deriving (Eq, Read, Show)

derivePersistField "DynField"

data SqlBinOp = SqlBinOpLike | SqlBinOpLtEq | SqlBinOpGtEq | SqlBinOpNotEq | SqlBinOpEq deriving (Eq, Read, Show)

derivePersistField "SqlBinOp"

-}


share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
DynamicQuery 
    field DynField
    op SqlBinOp
    value Text
Item
    name Text
    inserted Day
    active Bool 
|]

safeRead :: forall a. Read a => Text -> Maybe a
safeRead s = case (reads $ T.unpack s) of
   [(v,_)] -> Just v
   _ -> Nothing

getItems dc = do

    select $ from $ \mp -> do
        where_ $ expr mp
        return $ mp ^. ItemId
    where
        value = dynamicQueryValue dc
        boolValue = case safeRead value of
            Just b -> b
            Nothing -> False
        dateValue = case safeRead value of
            Just dt -> dt
            Nothing -> fromGregorian 1900 1 1
        expr = \mp -> case dynamicQueryField dc of
            DynFieldName           -> (mp ^. ItemName) `op` val value
            DynFieldInserted       -> (mp ^. ItemInserted) `op2` val dateValue
            DynFieldActive         -> (mp ^. ItemActive) `op3` val boolValue
        op = case dynamicQueryOp dc of
            SqlBinOpEq -> (==.)
            SqlBinOpNotEq -> (!=.)
            SqlBinOpGtEq -> (>=.)
            SqlBinOpLtEq -> (<=.)
            SqlBinOpLike -> unsafeSqlBinOp " ILIKE "

        op2 = case dynamicQueryOp dc of
            SqlBinOpEq -> (==.)
            SqlBinOpNotEq -> (!=.)
            SqlBinOpGtEq -> (>=.)
            SqlBinOpLtEq -> (<=.)
            SqlBinOpLike -> unsafeSqlBinOp " ILIKE "

        op3 = case dynamicQueryOp dc of
            SqlBinOpEq -> (==.)
            SqlBinOpNotEq -> (!=.)
            SqlBinOpGtEq -> (>=.)
            SqlBinOpLtEq -> (<=.)
            SqlBinOpLike -> unsafeSqlBinOp " ILIKE "

main = runSqlite ":memory:" $ do
    runMigration migrateAll
    _ <- insert $ Item "item 1" (fromGregorian 2014 2 11) True
    _ <- insert $ Item "item 2" (fromGregorian 2014 2 12) False
    let dc = DynamicQuery DynFieldName SqlBinOpEq "item 1"
    items <- getItems dc
    liftIO $ print items

Answer 1

Using the operators you gave on your example, it's just a matter of providing an explicit type signature. The following works fine:

expr = \mp -> case dynamicQueryField dc of
    DynFieldName     -> (mp ^. ItemName)     `op` val value
    DynFieldInserted -> (mp ^. ItemInserted) `op` val dateValue
    DynFieldActive   -> (mp ^. ItemActive)   `op` val boolValue

op :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value Bool)
op = case dynamicQueryOp dc of
    SqlBinOpEq    -> (==.)
    SqlBinOpNotEq -> (!=.)
    SqlBinOpGtEq  -> (>=.)
    SqlBinOpLtEq  -> (<=.)
    SqlBinOpLike  -> unsafeSqlBinOp " ILIKE "

If any of the operators had more constraints on its arguments (eg, Num a ), then the approach above would force the whole op to have the union of all constraints.