2017-04-13 21 views
1

我PostgreSQL數據庫中一個表的數據類型的字段之一是一個包裝爲UUID的新類型,名爲ItemIdOpaleye newtype

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 

我還是相當新的哈斯克爾,但這個問題似乎是該Opaleye不知道如何將ItemId轉換爲PGUuid,但我知道它可以將UUID轉換爲PGUuid。如何編寫實例以允許Opaleye執行此轉換?

回答

1

問題似乎是Opaleye不知道怎麼項目Id轉換成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') 

,然後你可以使用它在哈斯克爾側和Opaleye側都無需編寫額外的實例。