EmbedSpec.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.EmbedSpec where

import TemplateTestImports

import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T

import Database.Persist.EntityDef
import Database.Persist.EntityDef.Internal (toEmbedEntityDef)
import Database.Persist.ImplicitIdDef
import Database.Persist.ImplicitIdDef.Internal (fieldTypeFromTypeable)
import Database.Persist.Types

mkPersist
    sqlSettings
    [persistLowerCase|

Thing
    name String
    foo  String MigrationOnly

    deriving Eq Show

EmbedThing
    someThing Thing

    deriving Eq Show

SelfEmbed
    name Text
    self SelfEmbed Maybe
    deriving Eq Show

MutualEmbed
    thing MutualTarget

MutualTarget
    thing [MutualEmbed]

ModelWithList
    names [Text]

HasMap
    map (M.Map T.Text T.Text)
    deriving Show Eq Read Ord

MapIdValue
    map (M.Map T.Text (Key Thing))
    deriving Show Eq Read Ord

|]

pass :: IO ()
pass = pure ()

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

spec :: Spec
spec = describe "EmbedSpec" $ do
    describe "ModelWithList" $ do
        let
            edef =
                entityDef $ Proxy @ModelWithList
            [fieldDef] =
                getEntityFields edef
        it "has the right type" $ do
            fieldType fieldDef
                `shouldBe` FTList (FTTypeCon Nothing "Text")
        it "has the right sqltype" $ do
            fieldSqlType fieldDef
                `shouldBe` SqlString
    describe "MapIdValue" $ do
        let
            edef =
                entityDef $ Proxy @MapIdValue
            [fieldDef] =
                getEntityFields edef
        it "has the right type" $ do
            fieldType fieldDef
                `shouldBe` ( FTTypeCon (Just "M") "Map"
                                `FTApp` FTTypeCon (Just "T") "Text"
                                `FTApp` ( FTTypeCon Nothing "Key"
                                            `FTApp` FTTypeCon Nothing "Thing"
                                        )
                           )
        it "has the right sqltype" $ do
            fieldSqlType fieldDef
                `shouldBe` SqlString
    describe "HasMap" $ do
        let
            edef =
                entityDef $ Proxy @HasMap
            [fieldDef] =
                getEntityFields edef
        it "has the right type" $ do
            fieldType fieldDef
                `shouldBe` ( FTTypeCon (Just "M") "Map"
                                `FTApp` FTTypeCon (Just "T") "Text"
                                `FTApp` FTTypeCon (Just "T") "Text"
                           )
        it "has the right sqltype" $ do
            fieldSqlType fieldDef
                `shouldBe` SqlString

    describe "SomeThing" $ do
        let
            edef =
                entityDef $ Proxy @Thing
        describe "toEmbedEntityDef" $ do
            let
                embedDef =
                    toEmbedEntityDef edef
            it "should have the same field count as Haskell fields" $ do
                length (embeddedFields embedDef)
                    `shouldBe` length (getEntityFields edef)

    describe "EmbedThing" $ do
        it "generates the right constructor" $ do
            let
                embedThing :: EmbedThing
                embedThing = EmbedThing (Thing "asdf")
            pass

    describe "SelfEmbed" $ do
        let
            edef =
                entityDef $ Proxy @SelfEmbed
        describe "fieldReference" $ do
            let
                [nameField, selfField] = getEntityFields edef
            it "has self reference" $ do
                fieldReference selfField
                    `shouldBe` NoReference
        describe "toEmbedEntityDef" $ do
            let
                embedDef =
                    toEmbedEntityDef edef
            it "has the same field count as regular def" $ do
                length (getEntityFields edef)
                    `shouldBe` length (embeddedFields embedDef)