Question

我想根据存储在数据库中的数据动态创建Database.Esqueleto个查询（请参阅下面代码片段中的DynamicQuery Database.Persist实体）。下面的代码编译但不是很优雅，因为重复的定义（文本字段类型为op，日字段类型为op2，op3字段类型为Bool 。

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

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

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具有所有约束的并集。

动态选择Database.Esqueleto SQL运算符

1 个答案: