动态选择 Database.Esqueleto SQL 运算符

Question

我想根据存储在数据库中的数据动态创建Database.Esqueleto 查询（请参阅下面代码sn-p 中的DynamicQuery Database.Persist 实体）。下面的代码可以编译，但由于重复定义，它不是很优雅（op 用于 Text 字段类型，op2 用于 Day 字段类型，op3 用于Bool 字段类型）。

是否可以编写一个类似于op 的更通用的函数，可以在expr 的定义中的所有情况下使用？

尝试对使用 op2 的 Day 字段类型重用 op 会导致以下错误消息：

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)'

代码sn-p如下：

{-# 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

使用您在示例中提供的运算符，只需提供显式类型签名即可。以下工作正常：

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 "

如果任何运算符对其参数有更多约束（例如，Num a），那么上述方法将强制整个 op 具有所有约束的联合。