fix TH code for changed Entity typeclass

Author: s9gf4ult

postgresql-query.cabal

@@ -1,5 +1,5 @@
 name:                postgresql-query
-version:             1.4.0
+version:             2.0.0
 
 synopsis: Sql interpolating quasiquote plus some kind of primitive ORM
           using it
@@ -78,6 +78,8 @@ library
                , semigroups
                , template-haskell
                , text
+               , th-lift
+               , th-lift-instances
                , time
                , transformers
                , transformers-base

src/Database/PostgreSQL/Query/TH.hs

@@ -17,14 +17,18 @@ module Database.PostgreSQL.Query.TH
 import Prelude
 
 import Control.Applicative
+import Control.Monad
 import Data.Default
 import Data.FileEmbed ( embedFile )
+import Data.String
 import Database.PostgreSQL.Query.Entity ( Entity(..) )
 import Database.PostgreSQL.Query.TH.SqlExp
+import Database.PostgreSQL.Query.Types ( FN(..) )
 import Database.PostgreSQL.Simple.FromRow ( FromRow(..), field )
 import Database.PostgreSQL.Simple.ToRow ( ToRow(..) )
 import Database.PostgreSQL.Simple.Types ( Query(..) )
 import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
 
 -- | Return constructor name
 cName :: (Monad m) => Con -> m Name
@@ -196,12 +200,15 @@ deriveEntity opts tname = do
                 [(mkName unidname, NotStrict, idtype)]
         iddec = NewtypeInstD [] entityIdName [ConT tname]
                 idcon (eoDeriveClasses opts)
-        tblName = eoTableName opts tnames
-        fldNames = map (eoColumnNames opts . nameBase) $ cFieldNames tcon
+        tblName = fromString $ eoTableName opts tnames
+        fldNames = map (fromString . eoColumnNames opts . nameBase)
+                   $ cFieldNames tcon
     VarE ntableName  <- [e|tableName|]
     VarE nfieldNames <- [e|fieldNames|]
-    let tbldec = FunD ntableName  [Clause [WildP] (NormalB $ LitE  $ stringL tblName) []]
-        flddec = FunD nfieldNames [Clause [WildP] (NormalB $ ListE $ map (LitE . stringL) fldNames) []]
+    tblExp <- lift (tblName :: FN)
+    fldExp <- mapM lift (fldNames :: [FN])
+    let tbldec = FunD ntableName  [Clause [WildP] (NormalB tblExp) []]
+        flddec = FunD nfieldNames [Clause [WildP] (NormalB $ ListE fldExp) []]
         ret = InstanceD [] econt
               [ iddec, tbldec, flddec ]
         syndec = TySynD (mkName idname) [] (AppT (ConT entityIdName) (ConT tname))

src/Database/PostgreSQL/Query/Types.hs

@@ -53,6 +53,8 @@ import Database.PostgreSQL.Simple.FromField
 import Database.PostgreSQL.Simple.ToField
     ( ToField )
 import GHC.Generics
+import Instances.TH.Lift ()
+import Language.Haskell.TH.Lift ( deriveLift )
 
 import qualified Data.List as L
 import qualified Control.Monad.Trans.State.Lazy as STL
@@ -75,6 +77,7 @@ newtype InetText = InetText
     } deriving ( IsString, Eq, Ord, Read, Show
                , Typeable, Monoid, ToField )
 
+
 instance FromField InetText where
     fromField fld Nothing = returnError ConversionFailed
                             fld "can not convert Null to InetText"
@@ -121,6 +124,8 @@ FN ["user","name"]
 newtype FN = FN [Text]
     deriving (Ord, Eq, Show, Monoid, Typeable, Generic)
 
+$(deriveLift ''FN)
+
 instance ToSqlBuilder FN where
     toSqlBuilder (FN tt) =
         mconcat