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 Data.Text (Text)
import qualified Data.Map as M
import qualified Data.Text as T

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

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)