動態選擇Database.Esqueleto SQL運算符

Question

我想根據存儲在數據庫中的數據動態創建Database.Esqueleto查詢（請參見下面的代碼片段中的DynamicQuery Database.Persist實體）。下面的代碼編譯，但它不是因爲重複定義（op文本字段類型，op2對日字段類型，併爲op3場Bool型）非常優雅。

是否可以編寫類似於op的更一般的功能，可以在所有情況下使用expr的定義？

試圖重用op對於其中op2使用會導致以下錯誤消息的日字段類型：

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

的代碼片段如下：

{-# 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擁有的所有約束的工會更多的約束。