diff --git a/persistent-mongoDB/test/main.hs b/persistent-mongoDB/test/main.hs index 4b8dfac15..f35faddb0 100644 --- a/persistent-mongoDB/test/main.hs +++ b/persistent-mongoDB/test/main.hs @@ -1,15 +1,16 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE DataKinds, ExistentialQuantification #-} +{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -Wno-unused-top-binds #-} import qualified Data.ByteString as BS @@ -17,8 +18,8 @@ import Data.IntMap (IntMap) import qualified Data.Text as T import Data.Time import Database.MongoDB (runCommand1) -import Text.Blaze.Html import Test.QuickCheck +import Text.Blaze.Html -- FIXME: should this be added? (RawMongoHelpers module wasn't used) -- import qualified RawMongoHelpers @@ -53,6 +54,7 @@ import qualified PersistentTest import qualified Recursive import qualified RenameTest import qualified SumTypeTest +import qualified TypeLitFieldDefsTest import qualified UpsertTest type Tuple = (,) @@ -130,6 +132,7 @@ main = do (db' (deleteWhere ([] :: [Filter (LargeNumberTest.NumberGeneric backend)]))) MaxLenTest.specsWith dbNoCleanup MaybeFieldDefsTest.specsWith dbNoCleanup + TypeLitFieldDefsTest.specsWith dbNoCleanup Recursive.specsWith (db' Recursive.cleanup) SumTypeTest.specsWith (dbNoCleanup) Nothing diff --git a/persistent-mysql/test/main.hs b/persistent-mysql/test/main.hs index 00d670655..cd0a21804 100644 --- a/persistent-mysql/test/main.hs +++ b/persistent-mysql/test/main.hs @@ -46,6 +46,7 @@ import qualified MpsCustomPrefixTest import qualified MpsNoPrefixTest import qualified PersistUniqueTest import qualified PersistentTest +import qualified TypeLitFieldDefsTest -- FIXME: Not used... should it be? -- import qualified PrimaryTest import qualified RawSqlTest @@ -129,6 +130,7 @@ main = do , UniqueTest.uniqueMigrate , MaxLenTest.maxlenMigrate , MaybeFieldDefsTest.maybeFieldDefMigrate + , TypeLitFieldDefsTest.typeLitFieldDefsMigrate , Recursive.recursiveMigrate , CompositeTest.compositeMigrate , PersistUniqueTest.migration @@ -178,6 +180,7 @@ main = do LargeNumberTest.specsWith db UniqueTest.specsWith db MaybeFieldDefsTest.specsWith db + TypeLitFieldDefsTest.specsWith db MaxLenTest.specsWith db Recursive.specsWith db SumTypeTest.specsWith db (Just (runMigrationSilent SumTypeTest.sumTypeMigrate)) diff --git a/persistent-postgresql/test/PgInit.hs b/persistent-postgresql/test/PgInit.hs index 87c9b447f..cdad410fb 100644 --- a/persistent-postgresql/test/PgInit.hs +++ b/persistent-postgresql/test/PgInit.hs @@ -48,6 +48,7 @@ import Init , MonadFail , RunDb , TestFn(..) + , UUID(..) , arbText , asIO , assertEmpty @@ -55,35 +56,35 @@ import Init , assertNotEqual , isTravis , liftA2 + , sqlSettingsUuid , truncateTimeOfDay , truncateToMicro , truncateUTCTime , (==@) , (@/=) , (@==) - , UUID(..) - , sqlSettingsUuid ) -- re-exports import Control.Exception (SomeException) import Control.Monad (forM_, liftM, replicateM, void, when) import Control.Monad.Trans.Reader -import Data.Aeson (ToJSON, FromJSON, Value(..), object) +import Data.Aeson (FromJSON, ToJSON, Value(..), object) +import qualified Data.Text.Encoding as TE import Database.Persist.Postgresql.JSON () import Database.Persist.Sql.Raw.QQ import Database.Persist.SqlBackend import Database.Persist.TH ( MkPersistSettings(..) - , mkMigrate , migrateModels + , mkEntityDefList + , mkMigrate , mkPersist , persistLowerCase , persistUpperCase + , setImplicitIdDef , share , sqlSettings - , setImplicitIdDef - , mkEntityDefList ) import Test.Hspec ( Arg @@ -102,7 +103,6 @@ import Test.Hspec import Test.Hspec.Expectations.Lifted import Test.QuickCheck.Instances () import UnliftIO -import qualified Data.Text.Encoding as TE -- testing import Test.HUnit (Assertion, assertBool, assertFailure, (@=?), (@?=)) diff --git a/persistent-postgresql/test/main.hs b/persistent-postgresql/test/main.hs index d840d12cd..c00650ac0 100644 --- a/persistent-postgresql/test/main.hs +++ b/persistent-postgresql/test/main.hs @@ -58,6 +58,7 @@ import qualified RenameTest import qualified SumTypeTest import qualified TransactionLevelTest import qualified TreeTest +import qualified TypeLitFieldDefsTest import qualified UniqueTest import qualified UpsertTest import qualified UpsertWhere @@ -121,6 +122,7 @@ main = do , UniqueTest.uniqueMigrate , MaxLenTest.maxlenMigrate , MaybeFieldDefsTest.maybeFieldDefMigrate + , TypeLitFieldDefsTest.typeLitFieldDefsMigrate , Recursive.recursiveMigrate , CompositeTest.compositeMigrate , TreeTest.treeMigrate @@ -174,6 +176,7 @@ main = do UniqueTest.specsWith runConnAssert MaxLenTest.specsWith runConnAssert MaybeFieldDefsTest.specsWith runConnAssert + TypeLitFieldDefsTest.specsWith runConnAssert Recursive.specsWith runConnAssert SumTypeTest.specsWith runConnAssert (Just (runMigrationSilent SumTypeTest.sumTypeMigrate)) MigrationTest.specsWith runConnAssert diff --git a/persistent-sqlite/test/main.hs b/persistent-sqlite/test/main.hs index f8d98b984..f8a7a87ea 100644 --- a/persistent-sqlite/test/main.hs +++ b/persistent-sqlite/test/main.hs @@ -45,6 +45,7 @@ import qualified Recursive import qualified RenameTest import qualified SumTypeTest import qualified TransactionLevelTest +import qualified TypeLitFieldDefsTest import qualified UniqueTest import qualified UpsertTest @@ -162,6 +163,7 @@ main = do , UniqueTest.uniqueMigrate , MaxLenTest.maxlenMigrate , MaybeFieldDefsTest.maybeFieldDefMigrate + , TypeLitFieldDefsTest.typeLitFieldDefsMigrate , Recursive.recursiveMigrate , CompositeTest.compositeMigrate , MigrationTest.migrationMigrate @@ -209,6 +211,7 @@ main = do UniqueTest.specsWith db MaxLenTest.specsWith db MaybeFieldDefsTest.specsWith db + TypeLitFieldDefsTest.specsWith db Recursive.specsWith db SumTypeTest.specsWith db (Just (runMigrationSilent SumTypeTest.sumTypeMigrate)) MigrationOnlyTest.specsWith db diff --git a/persistent-test/persistent-test.cabal b/persistent-test/persistent-test.cabal index 43ef3ee9f..72e900b80 100644 --- a/persistent-test/persistent-test.cabal +++ b/persistent-test/persistent-test.cabal @@ -53,6 +53,7 @@ library SumTypeTest TransactionLevelTest TreeTest + TypeLitFieldDefsTest UniqueTest UpsertTest LongIdentifierTest diff --git a/persistent-test/src/TypeLitFieldDefsTest.hs b/persistent-test/src/TypeLitFieldDefsTest.hs new file mode 100644 index 000000000..263ccc668 --- /dev/null +++ b/persistent-test/src/TypeLitFieldDefsTest.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-unused-top-binds #-} + +module TypeLitFieldDefsTest (specsWith, typeLitFieldDefsMigrate) where + +import Data.Maybe (fromJust) +import GHC.TypeLits +import Init + +newtype Finite (n :: Nat) = Finite Int + deriving (Show, Eq) + +instance PersistField (Finite n) where + toPersistValue (Finite n) = toPersistValue n + fromPersistValue = fmap Finite . fromPersistValue + +instance PersistFieldSql (Finite n) where + sqlType _ = sqlType (Proxy :: Proxy Int) + +newtype Labelled (t :: Symbol) = Labelled Int + deriving (Show, Eq) + +instance PersistField (Labelled n) where + toPersistValue (Labelled n) = toPersistValue n + fromPersistValue = fmap Labelled . fromPersistValue + +instance PersistFieldSql (Labelled n) where + sqlType _ = sqlType (Proxy :: Proxy Int) + +share [mkPersist sqlSettings { mpsGeneric = True }, mkMigrate "typeLitFieldDefsMigrate"] [persistLowerCase| + TypeLitFieldDefsNumeric + one (Finite 1) + twenty (Finite 20) + deriving Eq Show + + TypeLitFieldDefsLabelled + one (Labelled "one") + twenty (Labelled "twenty") + deriving Eq Show +|] + +one :: Finite 1 +one = Finite 1 + +oneLabelled :: Labelled "one" +oneLabelled = Labelled 1 + +twenty :: Finite 20 +twenty = Finite 20 + +twentyLabelled :: Labelled "twenty" +twentyLabelled = Labelled 20 + +specsWith :: Runner backend m => RunDb backend m -> Spec +specsWith runDb = + describe "Type Lit Field Definitions" $ do + it "runs appropriate migrations" $ runDb $ do + numKey <- insert $ TypeLitFieldDefsNumeric one twenty + num <- getJust numKey + liftIO $ typeLitFieldDefsNumericOne num @?= one + liftIO $ typeLitFieldDefsNumericTwenty num @?= twenty + + labelledKey <- insert $ TypeLitFieldDefsLabelled oneLabelled twentyLabelled + lbl <- getJust labelledKey + liftIO $ typeLitFieldDefsLabelledOne lbl @?= oneLabelled + liftIO $ typeLitFieldDefsLabelledTwenty lbl @?= twentyLabelled diff --git a/persistent/ChangeLog.md b/persistent/ChangeLog.md index 39d1ec156..e08f256bd 100644 --- a/persistent/ChangeLog.md +++ b/persistent/ChangeLog.md @@ -2,6 +2,8 @@ ## 2.14.0.0 (unreleased) +* [#1343](https://github.com/yesodweb/persistent/pull/1343) + * Implement Type Literal based field definitions * [#1387](https://github.com/yesodweb/persistent/pull/1387) * Better UX with `insert`. We now report a type error when you try to `insert` an `Entity` or a function, and we also forbid `insert`ing if the @@ -47,7 +49,6 @@ * Increasing test coverage for errors thrown when parsing entity definitions ## 2.13.3.4 - * [#1379](https://github.com/yesodweb/persistent/pull/1379) * `mkPersist` now generates code that compiles under `NoFieldSelectors` and `DuplicateRecordFields` even if field labels are not prefixed * [#1376](https://github.com/yesodweb/persistent/pull/1376) diff --git a/persistent/Database/Persist/Quasi/Internal.hs b/persistent/Database/Persist/Quasi/Internal.hs index 63d7884db..8f67e991b 100644 --- a/persistent/Database/Persist/Quasi/Internal.hs +++ b/persistent/Database/Persist/Quasi/Internal.hs @@ -47,13 +47,14 @@ module Database.Persist.Quasi.Internal , ForeignFieldReference(..) , mkKeyConType , isHaskellUnboundField + , FieldTypeLit(..) ) where import Prelude hiding (lines) import Control.Applicative (Alternative((<|>))) +import Data.Char (isDigit, isLower, isSpace, isUpper, toLower) import Control.Monad -import Data.Char (isLower, isSpace, isUpper, toLower) import Data.List (find, foldl') import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NEL @@ -64,8 +65,9 @@ import Data.Text (Text) import qualified Data.Text as T import Database.Persist.EntityDef.Internal import Database.Persist.Types +import Database.Persist.Types.Base import Language.Haskell.TH.Syntax (Lift) -import Text.Read (readEither) +import qualified Text.Read as R data ParseState a = PSDone | PSFail String | PSSuccess a Text deriving Show @@ -95,17 +97,48 @@ parseFieldType t0 = x -> PSFail $ show x parse1 :: Text -> ParseState FieldType - parse1 t = + parse1 t = fromMaybe (PSFail (show t)) $ do case T.uncons t of - Nothing -> PSDone - Just (c, t') - | isSpace c -> parse1 $ T.dropWhile isSpace t' - | c == '(' -> parseEnclosed ')' id t' - | c == '[' -> parseEnclosed ']' FTList t' - | isUpper c || c == '\'' -> - let (a, b) = T.break (\x -> isSpace x || x `elem` ("()[]"::String)) t' - in PSSuccess (parseFieldTypePiece c a) b - | otherwise -> PSFail $ show (c, t') + Nothing -> pure PSDone + Just (x, xs) -> + parseSpace x xs + <|> parseParenEnclosed x xs + <|> parseList x xs + <|> parseNumericLit x xs + <|> parseTextLit x xs + <|> parseTypeCon x xs + + parseSpace :: Char -> Text -> Maybe (ParseState FieldType) + parseSpace c t = do + guard (isSpace c) + pure $ parse1 (T.dropWhile isSpace t) + + parseParenEnclosed c t = do + guard (c == '(') + pure $ parseEnclosed ')' id t + + parseList c t = do + guard (c == '[') + pure $ parseEnclosed ']' FTList t + + parseTextLit :: Char -> Text -> Maybe (ParseState FieldType) + parseTextLit c t = do + guard (c == '"') + let (a, b) = T.break (== '"') t + lit = FTLit (TextTypeLit a) + pure $ PSSuccess lit (T.drop 1 b) + + parseNumericLit :: Char -> Text -> Maybe (ParseState FieldType) + parseNumericLit c t = do + guard (isDigit c && T.all isDigit t) + let (a, b) = breakAtNextSpace t + lit <- FTLit . IntTypeLit <$> readMaybe (T.cons c a) + pure $ PSSuccess lit b + + parseTypeCon c t = do + guard (isUpper c || c == '\'') + let (a, b) = breakAtNextSpace t + pure $ PSSuccess (parseFieldTypePiece c a) b goMany :: ([FieldType] -> a) -> Text -> ParseState a goMany front t = @@ -113,7 +146,10 @@ parseFieldType t0 = PSSuccess x t' -> goMany (front . (x:)) t' PSFail err -> PSFail err PSDone -> PSSuccess (front []) t - -- _ -> + +breakAtNextSpace :: Text -> (Text, Text) +breakAtNextSpace = + T.break isSpace parseFieldTypePiece :: Char -> Text -> FieldType parseFieldTypePiece fstChar rest = @@ -1457,11 +1493,7 @@ parseCascadeAction -> Maybe CascadeAction parseCascadeAction prfx text = do cascadeStr <- T.stripPrefix ("On" <> toPrefix prfx) text - case readEither (T.unpack cascadeStr) of - Right a -> - Just a - Left _ -> - Nothing + readMaybe cascadeStr where toPrefix cp = case cp of @@ -1486,3 +1518,6 @@ isHaskellUnboundField fd = -- @since 2.13.0.0 getUnboundEntityNameHS :: UnboundEntityDef -> EntityNameHS getUnboundEntityNameHS = entityHaskell . unboundEntityDef + +readMaybe :: Read a => Text -> Maybe a +readMaybe = R.readMaybe . T.unpack diff --git a/persistent/Database/Persist/TH.hs b/persistent/Database/Persist/TH.hs index afdc16d27..26b3af54e 100644 --- a/persistent/Database/Persist/TH.hs +++ b/persistent/Database/Persist/TH.hs @@ -2671,6 +2671,8 @@ ftToType = \case ConT ''Int64 FTTypeCon (Just m) t -> ConT $ mkName $ unpack $ concat [m, ".", t] + FTLit l -> + LitT (typeLitToTyLit l) FTTypePromoted t -> PromotedT $ mkName $ T.unpack t FTApp x y -> @@ -2678,6 +2680,11 @@ ftToType = \case FTList x -> ListT `AppT` ftToType x +typeLitToTyLit :: FieldTypeLit -> TyLit +typeLitToTyLit = \case + IntTypeLit n -> NumTyLit n + TextTypeLit t -> StrTyLit (T.unpack t) + infixr 5 ++ (++) :: Monoid m => m -> m -> m (++) = mappend diff --git a/persistent/Database/Persist/Types/Base.hs b/persistent/Database/Persist/Types/Base.hs index 89e675240..45d941a3b 100644 --- a/persistent/Database/Persist/Types/Base.hs +++ b/persistent/Database/Persist/Types/Base.hs @@ -411,11 +411,17 @@ parseFieldAttrs = fmap $ \case data FieldType = FTTypeCon (Maybe Text) Text -- ^ Optional module and name. + | FTLit FieldTypeLit | FTTypePromoted Text | FTApp FieldType FieldType | FTList FieldType deriving (Show, Eq, Read, Ord, Lift) +data FieldTypeLit + = IntTypeLit Integer + | TextTypeLit Text + deriving (Show, Eq, Read, Ord, Lift) + isFieldNotGenerated :: FieldDef -> Bool isFieldNotGenerated = isNothing . fieldGenerated diff --git a/persistent/persistent.cabal b/persistent/persistent.cabal index 8c39ca365..02c21b620 100644 --- a/persistent/persistent.cabal +++ b/persistent/persistent.cabal @@ -189,6 +189,7 @@ test-suite test Database.Persist.TH.SharedPrimaryKeySpec Database.Persist.THSpec Database.Persist.TH.ToFromPersistValuesSpec + Database.Persist.TH.TypeLitFieldDefsSpec TemplateTestImports default-language: Haskell2010 diff --git a/persistent/test/Database/Persist/QuasiSpec.hs b/persistent/test/Database/Persist/QuasiSpec.hs index 4bdacfa9b..7b19b9d51 100644 --- a/persistent/test/Database/Persist/QuasiSpec.hs +++ b/persistent/test/Database/Persist/QuasiSpec.hs @@ -140,6 +140,15 @@ spec = describe "Quasi" $ do ] ) + it "handles numbers" $ + parseLine " one (Finite 1)" `shouldBe` + Just + ( Line 2 + [ Token "one" + , Token "Finite 1" + ] + ) + it "handles quotes" $ parseLine " \"foo bar\" \"baz\"" `shouldBe` Just @@ -678,6 +687,22 @@ CustomerTransfer , (FieldNameHS "uuid", FTTypeCon Nothing "TransferUuid") ] + describe "type literals" $ do + it "should be able to parse type literals" $ do + let simplifyField field = + (unboundFieldNameHS field, unboundFieldType field) + let tickedDefinition = [st| +WithFinite + one (Finite 1) + twenty (Labelled "twenty") +|] + let [withFinite] = parse lowerCaseSettings tickedDefinition + + (simplifyField <$> unboundEntityFields withFinite) `shouldBe` + [ (FieldNameHS "one", FTApp (FTTypeCon Nothing "Finite") (FTLit (IntTypeLit 1))) + , (FieldNameHS "twenty", FTApp (FTTypeCon Nothing "Labelled") (FTLit (TextTypeLit "twenty"))) + ] + describe "parseFieldType" $ do it "simple types" $ parseFieldType "FooBar" `shouldBe` Right (FTTypeCon Nothing "FooBar") @@ -704,6 +729,12 @@ CustomerTransfer baz = FTTypeCon Nothing "Baz" parseFieldType "Foo [Bar] Baz" `shouldBe` Right ( foo `FTApp` bars `FTApp` baz) + it "numeric type literals" $ do + let expected = FTApp (FTTypeCon Nothing "Finite") (FTLit (IntTypeLit 1)) + parseFieldType "Finite 1" `shouldBe` Right expected + it "string type literals" $ do + let expected = FTApp (FTTypeCon Nothing "Labelled") (FTLit (TextTypeLit "twenty")) + parseFieldType "Labelled \"twenty\"" `shouldBe` Right expected it "nested list / parens (list inside parens)" $ do let maybeCon = FTTypeCon Nothing "Maybe" int = FTTypeCon Nothing "Int" @@ -715,7 +746,7 @@ CustomerTransfer parseFieldType "[Maybe (Maybe Int)]" `shouldBe` Right (FTList (maybeCon `FTApp` (maybeCon `FTApp` int))) it "fails on lowercase starts" $ do - parseFieldType "nothanks" `shouldBe` Left "PSFail ('n',\"othanks\")" + parseFieldType "nothanks" `shouldBe` Left "PSFail \"nothanks\"" describe "#1175 empty entity" $ do let subject = diff --git a/persistent/test/Database/Persist/TH/TypeLitFieldDefsSpec.hs b/persistent/test/Database/Persist/TH/TypeLitFieldDefsSpec.hs new file mode 100644 index 000000000..1d316cf3a --- /dev/null +++ b/persistent/test/Database/Persist/TH/TypeLitFieldDefsSpec.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-unused-local-binds #-} + +module Database.Persist.TH.TypeLitFieldDefsSpec where + +import GHC.TypeLits +import TemplateTestImports + +newtype Finite (n :: Nat) = Finite Int + +instance PersistField (Finite n) where + toPersistValue (Finite n) = toPersistValue n + fromPersistValue = fmap Finite . fromPersistValue + +instance PersistFieldSql (Finite n) where + sqlType _ = sqlType (Proxy :: Proxy Int) + +newtype Labelled (t :: Symbol) = Labelled Int + +instance PersistField (Labelled n) where + toPersistValue (Labelled n) = toPersistValue n + fromPersistValue = fmap Labelled . fromPersistValue + +instance PersistFieldSql (Labelled n) where + sqlType _ = sqlType (Proxy :: Proxy Int) + +mkPersist sqlSettings [persistLowerCase| +WithFinite + one (Finite 1) + twenty (Finite 20) + +WithLabelled + one (Labelled "one") + twenty (Labelled "twenty") +|] + +spec :: Spec +spec = describe "TypeLitFieldDefs" $ do + it "should support numeric type literal fields in entity definition" $ do + let mkFinite :: Finite 1 -> Finite 20 -> WithFinite + mkFinite = WithFinite + compiles + + it "should support string based type literal fields in entity definition" $ do + let mkLabelled :: Labelled "one" -> Labelled "twenty" -> WithLabelled + mkLabelled = WithLabelled + compiles + +compiles :: Expectation +compiles = True `shouldBe` True diff --git a/persistent/test/Database/Persist/THSpec.hs b/persistent/test/Database/Persist/THSpec.hs index 369ace6bc..0c2c26b34 100644 --- a/persistent/test/Database/Persist/THSpec.hs +++ b/persistent/test/Database/Persist/THSpec.hs @@ -67,6 +67,7 @@ import qualified Database.Persist.TH.RequireOnlyPersistImportSpec as RequireOnly import qualified Database.Persist.TH.SharedPrimaryKeyImportedSpec as SharedPrimaryKeyImportedSpec import qualified Database.Persist.TH.SharedPrimaryKeySpec as SharedPrimaryKeySpec import qualified Database.Persist.TH.ToFromPersistValuesSpec as ToFromPersistValuesSpec +import qualified Database.Persist.TH.TypeLitFieldDefsSpec as TypeLitFieldDefsSpec import qualified Database.Persist.TH.SumSpec as SumSpec -- test to ensure we can have types ending in Id that don't trash the TH @@ -187,6 +188,7 @@ spec = describe "THSpec" $ do SharedPrimaryKeyImportedSpec.spec ImplicitIdColSpec.spec MaybeFieldDefsSpec.spec + TypeLitFieldDefsSpec.spec MigrationOnlySpec.spec NoFieldSelectorsSpec.spec EmbedSpec.spec