0

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

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

尝试重用使用op的 Day 字段类型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
4

1 回答 1

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

于 2014-03-04T12:50:02.640 回答