蛇眼新型

Question

PostgreSQL数据库中表的数据类型中的一个字段是一个名为ItemId的新型包装UUID。

import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Data.DateTime (DateTime)
import Data.UUID
import GHC.Generics
import qualified Opaleye as O
import Data.Text (pack, Text)

newtype ItemId = ItemId UUID
  deriving (Show, Eq, Generic)

toItemId :: UUID -> ItemId
toItemId = ItemId

fromItemId :: ItemId -> UUID
fromItemId (ItemId x) = x

data Item' id name desc num most
  = Item {
    _itemId          :: id,
    _itemName        :: name,
    _itemDesc        :: desc,
    _numTimesOrdered :: num,
    _mostRecentOrder :: most
 }

type ItemRead = Item' ItemId Text Text Int DateTime
type ItemWrite = Item' (Maybe ItemId) Text Text (Maybe Int) (Maybe DateTime)
type ItemColRead = Item' (O.Column O.PGUuid)
                         (O.Column O.PGText)
                         (O.Column O.PGText)
                         (O.Column O.PGInt4)
                         (O.Column O.PGTimestamptz)
type ItemColWrite = Item' (Maybe (O.Column O.PGUuid))
                          (O.Column O.PGText)
                          (O.Column O.PGText)
                          (Maybe (O.Column O.PGInt4))
                          (Maybe (O.Column O.PGTimestamptz))

$(makeAdaptorAndInstance "pItem" ''Item')

itemTable :: O.Table ItemColWrite ItemColRead
itemTable = O.Table "items" (pItem Item { _itemId          = O.optional "id"
                                        , _itemName        = O.required "name"
                                        , _itemDesc        = O.required "desc"
                                        , _numTimesOrdered = O.optional "numTimesOrdered"
                                        , _mostRecentOrder = O.optional "mostRecentOrder"
                                        })

itemToPG :: ItemWrite -> ItemColWrite
itemToPG = pItem Item { _itemId          = const Nothing
                      , _itemName        = O.pgStrictText
                      , _itemDesc        = O.pgStrictText
                      , _numTimesOrdered = const Nothing
                      , _mostRecentOrder = const Nothing
                      }

但是，当我编译我的项目时，GHC抛出：

/home/gigavinyl/Projects/ordermage/src/Api/Item.hs:34:3: error:
    • No instance for (O.QueryRunnerColumnDefault O.PGUuid ItemId)
        arising from a use of ‘O.runInsertManyReturning’
    • In the second argument of ‘(<$>)’, namely
        ‘O.runInsertManyReturning con itemTable [itemToPG item] _itemId’
      In the second argument of ‘($)’, namely
        ‘listToMaybe
         <$> O.runInsertManyReturning con itemTable [itemToPG item] _itemId’
      In the expression:
        liftIO
        $ listToMaybe
          <$> O.runInsertManyReturning con itemTable [itemToPG item] _itemId

其中src/Api/Item.hs是：

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}

module Api.Item where

import Control.Monad.IO.Class (liftIO)
import Data.Maybe (listToMaybe)
import Database.PostgreSQL.Simple (Connection)
import Models.Item
import Queries.Item
import Servant
import qualified Opaleye as O

type ItemApi =
   Get '[JSON] [ItemRead]                                      :<|>
   Capture "itemId" ItemId     :> Get '[JSON] (Maybe ItemRead) :<|>
   ReqBody '[JSON] ItemWrite   :> Post '[JSON] (Maybe ItemId)

itemServer :: Connection -> Server ItemApi
itemServer con =
  getItems con    :<|>
  getItemById con :<|>
  postItem con

getItems :: Connection -> Handler [ItemRead]
getItems con = liftIO $ O.runQuery con itemsQuery

getItemById :: Connection -> ItemId -> Handler (Maybe ItemRead)
getItemById con itemID = liftIO $ listToMaybe <$> O.runQuery con (itemByIdQuery itemID)

postItem :: Connection -> ItemWrite -> Handler (Maybe ItemId)
postItem con item = liftIO $ listToMaybe <$>
  O.runInsertManyReturning con itemTable [itemToPG item] _itemId

对于Haskell来说，我仍然是个新手，但问题似乎是，Opaleye不知道如何将ItemId转换为PGUuid，但我知道它可以将UUID转换为PGUuid。我将如何编写实例以允许Opaleye完成此转换？

Answer 1

问题似乎是，Opaleye不知道如何将ItemId转换为PGUuid，但我知道它可以将UUID转换为PGUuid

情况正好相反。它试图将Column PGUuid转换为ItemId，而它只知道如何将其转换为UUID。一种方法是自己添加实例：

instance O.QueryRunnerColumnDefault O.PGUuid ItemId where
  queryRunnerColumnDefault =
         O.queryRunnerColumn id ItemId queryRunnerColumnDefault

另一种方法是使ItemId多态：

newtype ItemId' a = ItemId a
$(makeAdaptorAndInstance "pItemId" ''ItemId')

然后，您可以在Haskell端和Opaleye端使用它，而不必编写额外的实例。