{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

module Main where

-- base
import Data.Int
  ( Int32 )

-- text
import Data.Text
  ( Text )

-- beam-core
import Database.Beam
import Database.Beam.Backend.SQL.BeamExtensions
  ( onConflictUpdateSetWhere
  , insertOnConflict
  , conflictingFields
  , runInsertReturningList
  )

-- beam-migrate
import Database.Beam.Migrate
  ( defaultMigratableDbSettings )
import Database.Beam.Migrate.Simple
  ( CheckedDatabaseSettings, autoMigrate )

-- beam-sqlite
import Database.Beam.Sqlite
  ( Sqlite, runBeamSqliteDebug )
import Database.Beam.Sqlite.Migrate
  ( migrationBackend )

-- sqlite-simple
import Database.SQLite.Simple
  ( open )

--------------------------------------------------------------------------------

data TestDb f
    = TestDb
    { usersTable :: f (TableEntity User)
    }
    deriving stock Generic

deriving anyclass instance Database be TestDb

testDb :: DatabaseSettings be TestDb
testDb = defaultDbSettings

checkedDb :: CheckedDatabaseSettings Sqlite TestDb
checkedDb = defaultMigratableDbSettings

data User f
    = User
    { userId   :: Columnar f Int32
    , userName :: Columnar f Text
    }
    deriving stock Generic

deriving stock instance Show ( PrimaryKey User Identity )
deriving stock instance Show ( User Identity )

instance Table User where
  newtype PrimaryKey User f = UserId ( Columnar f Int32 )
    deriving stock Generic
  primaryKey = UserId . userId

deriving anyclass instance Beamable User
deriving anyclass instance Beamable ( PrimaryKey User )

main :: IO ()
main = do

  conn <- open "test.sqlite"

  conflicts <-
    runBeamSqliteDebug putStrLn conn $ do

      -- Use beam-migrate to create the db for simplicity
      autoMigrate migrationBackend checkedDb

      -- Insert some users
      runInsert $
        insert ( usersTable testDb )
          ( insertValues [ User 0 "user0", User 2 "user2", User 5 "user5" ] )

      let newUsers = [ User 1 "user1", User 2 "different_user2" ]

      -- Insert some conflicting users
      runInsertReturningList $
        insertOnConflict ( usersTable testDb )
          ( insertValues newUsers )
          ( conflictingFields userId )
          ( onConflictUpdateSetWhere
            ( \ ( User { userName = fld  } )
                ( User { userName = excl } ) ->
                  fld <-. excl
            )
            ( \ ( User { userName = fld  } )
              ( User { userName = excl } ) ->
                current_ fld /=. excl
            )
          )

  print conflicts