persistent-mysql-haskell-0.6.0: test/InsertDuplicateUpdate.hs

{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module InsertDuplicateUpdate where

import Data.List              (sort)

import Database.Persist.MySQL
import MyInit

share [mkPersist sqlSettings, mkMigrate "duplicateMigrate"] [persistUpperCase|
  Item
     name        Text sqltype=varchar(80)
     description Text
     price       Double Maybe
     quantity    Int Maybe

     Primary name
     deriving Eq Show Ord

  ItemSize
     Id          (Key Item) sqltype=varchar(80)
     size        Int
     deriving Eq Show Ord
|]

specs :: Spec
specs = describe "DuplicateKeyUpdate" $ do
  let item1 = Item "item1" "" (Just 3) Nothing
      item2 = Item "item2" "hello world" Nothing (Just 2)
      items = [item1, item2]
      item1Size = ItemSize 10
      item2Size = ItemSize 17
      itemsSize = [item1Size, item2Size]
  describe "insertOnDuplicateKeyUpdate" $ do
    it "inserts appropriately" $ db $ do
      deleteWhere ([] :: [Filter Item])
      insertOnDuplicateKeyUpdate item1 [ItemDescription =. "i am item 1"]
      Just item <- get (ItemKey "item1")
      item @== item1

    it "performs only updates given if record already exists" $ db $ do
      deleteWhere ([] :: [Filter Item])
      let newDescription = "I am a new description"
      _ <- insert item1
      insertOnDuplicateKeyUpdate
        (Item "item1" "i am inserted description" (Just 1) (Just 2))
        [ItemDescription =. newDescription]
      Just item <- get (ItemKey "item1")
      item @== item1 { itemDescription = newDescription }

  describe "insertEntityOnDuplicateKeyUpdate" $ do
    it "inserts appropriately" $ db $ do
      deleteWhere ([] :: [Filter Item])
      deleteWhere ([] :: [Filter ItemSize])
      key <- insert item1
      insertEntityOnDuplicateKeyUpdate (Entity (ItemSizeKey key) item1Size) [ItemSizeSize =. 42]
      Just itemSize <- get (ItemSizeKey key)
      itemSize @== item1Size

    it "performs only updates given if record already exists" $ db $ do
      deleteWhere ([] :: [Filter Item])
      deleteWhere ([] :: [Filter ItemSize])
      let newCount = 13
      key <- insert item1
      insertKey (ItemSizeKey key) item1Size
      insertEntityOnDuplicateKeyUpdate
        (Entity (ItemSizeKey key) item1Size)
        [ItemSizeSize =. newCount]
      Just itemSize <- get (ItemSizeKey key)
      itemSize @== item1Size { itemSizeSize = newCount }

  describe "insertManyOnDuplicateKeyUpdate" $ do
    it "inserts fresh records" $ db $ do
      deleteWhere ([] :: [Filter Item])
      insertMany_ items
      let newItem = Item "item3" "fresh" Nothing Nothing
      insertManyOnDuplicateKeyUpdate
        (newItem : items)
        [copyField ItemDescription]
        []
      dbItems <- map entityVal <$> selectList [] []
      sort dbItems @== sort (newItem : items)
    it "updates existing records" $ db $ do
      deleteWhere ([] :: [Filter Item])
      insertMany_ items
      insertManyOnDuplicateKeyUpdate
        items
        []
        [ItemQuantity +=. Just 1]
    it "only copies passing values" $ db $ do
      deleteWhere ([] :: [Filter Item])
      insertMany_ items
      let newItems = map (\i -> i { itemQuantity = Just 0, itemPrice = fmap (*2) (itemPrice i) }) items
          postUpdate = map (\i -> i { itemPrice = fmap (*2) (itemPrice i) }) items
      insertManyOnDuplicateKeyUpdate
        newItems
        [ copyUnlessEq ItemQuantity (Just 0)
        , copyField ItemPrice
        ]
        []
      dbItems <- sort . fmap entityVal <$> selectList [] []
      dbItems @== sort postUpdate
    it "inserts without modifying existing records if no updates specified" $ db $ do
      let newItem = Item "item3" "hi friends!" Nothing Nothing
      deleteWhere ([] :: [Filter Item])
      insertMany_ items
      insertManyOnDuplicateKeyUpdate
        (newItem : items)
        []
        []
      dbItems <- sort . fmap entityVal <$> selectList [] []
      dbItems @== sort (newItem : items)

  describe "insertEntityManyOnDuplicateKeyUpdate" $ do
    it "inserts fresh records" $ db $ do
      deleteWhere ([] :: [Filter Item])
      deleteWhere ([] :: [Filter ItemSize])
      keys <- insertMany items
      let entities = zipWith (Entity . ItemSizeKey) keys itemsSize
      void $ insertEntityMany $ tail entities
      insertEntityManyOnDuplicateKeyUpdate
        entities
        [copyField ItemSizeSize]
        []
      dbItems <- selectList [] []
      sort dbItems @== sort entities
    it "updates existing records" $ db $ do
      deleteWhere ([] :: [Filter Item])
      deleteWhere ([] :: [Filter ItemSize])
      keys <- insertMany items
      let entities = zipWith (Entity . ItemSizeKey) keys itemsSize
      void $ insertEntityMany entities
      insertEntityManyOnDuplicateKeyUpdate
        entities
        []
        [ItemSizeSize +=. 1]
      dbItems <- selectList [] []
      sort dbItems @== sort (map (\(Entity k v) -> Entity k (v { itemSizeSize = itemSizeSize v + 1 })) entities)