ImplicitIdColSpec.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Database.Persist.TH.ImplicitIdColSpec where

import TemplateTestImports

import Data.Text (Text)

import Database.Persist.ImplicitIdDef
import Database.Persist.ImplicitIdDef.Internal (fieldTypeFromTypeable)

do
    let
        uuidDef =
            mkImplicitIdDef @Text "uuid_generate_v1mc()"
        settings =
            setImplicitIdDef uuidDef sqlSettings

    mkPersist
        settings
        [persistLowerCase|

        User
            name    String
            age     Int

        |]

pass :: IO ()
pass = pure ()

asIO :: IO a -> IO a
asIO = id

spec :: Spec
spec = describe "ImplicitIdColSpec" $ do
    describe "UserKey" $ do
        it "has type Text -> Key User" $ do
            let
                userKey = UserKey "Hello"
                _ = UserKey :: Text -> UserId
            pass

    describe "getEntityId" $ do
        let
            EntityIdField idField =
                getEntityId (entityDef (Nothing @User))
        it "has SqlString SqlType" $ asIO $ do
            fieldSqlType idField `shouldBe` SqlString
        it "has Text FieldType" $ asIO $ do
            pendingWith "currently returns UserId, may not be an issue"
            fieldType idField
                `shouldBe` fieldTypeFromTypeable @Text