0

Database.Esqueletoデータベースに保存されているデータに基づいてクエリを動的に作成したいと考えています (DynamicQuery Database.Persist以下のコード スニペットのエンティティを参照してください)。op以下のコードはコンパイルされますが、定義が繰り返されているため (テキスト フィールド タイプ、op2日フィールド タイプ、およびフィールド タイプ) 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 に答える