Search code examples
postgresqlhaskelltemplate-haskellghcjs

Is it possible GHCJS to reuse code generated by Template Haskell


At this moment GHCJS fails to compile postgresql-simple package (see [1]). I want to use persistent package to generate DB models. I wonder is it possible to compile models with GHC itself and re-use code generated by Template Haskell in GHCJS sources?


I have a workaround for my issue already, but the question is still relevant however. I'll leave it open for few days and if no one will answer how to use code generated with Template Haskell I'll close it. I've pasted resulting code at the bottom.

UPDATE:
thomie suggested me -dth-dec-file flag, which could be written as language pragma in models file, e.g. {-# OPTIONS_GHC -dth-dec-file #-}. Then after running stack build command there is a file Model.th.hs under .stack-work/dist/<arch>/<cabal-version>/build/src folder. This file looks like valid Haskell, however GHC rejects it because of parse error (see code at the bottom). However, I've found a way to compile model with GHCJS. I've added condition in cabal file to remove postgresql-simple from dependencies:

-- project.cabal
library
  -- ...
  if impl(ghcjs)
    build-depends:       persistent
                       , persistent-template
  else
    build-depends:       persistent
                       , persistent-postgresql
                       , persistent-template
                       , postgresql-simple

Code generated by Template Haskell (to test this code I copied this file in project source folder and added module declaration at top)

-- src/Model.hs:(16,1)-(17,54): Splicing declarations
instance Database.Persist.Class.PersistField.PersistField Manufacturer where
  Database.Persist.Class.PersistField.toPersistValue
    = \ ent_a9ov
        -> (Database.Persist.Types.Base.PersistMap
            GHC.Base.$
              (GHC.List.zip
                 (GHC.Base.map Data.Text.pack ["name"])
                 ((GHC.Base.map Database.Persist.Class.PersistField.toPersistValue)
                  GHC.Base.$
                    (Database.Persist.Class.PersistEntity.toPersistFields ent_a9ov))))
  Database.Persist.Class.PersistField.fromPersistValue
    = ((\ x_a9ow
          -> let columns_a9ox = Data.HashMap.Strict.fromList x_a9ow
             in
               (Database.Persist.Class.PersistEntity.fromPersistValues
                GHC.Base.$
                  ((GHC.Base.map
                      (\ name_a9oy
                         -> case
                                Data.HashMap.Base.lookup (Data.Text.pack name_a9oy) columns_a9ox
                            of {
                              GHC.Base.Just v_a9oz -> v_a9oz
                              GHC.Base.Nothing -> Database.Persist.Types.Base.PersistNull }))
                   GHC.Base.$ ["name"])))
       Control.Monad.<=<
         Database.Persist.Class.PersistField.getPersistMap)
instance Database.Persist.Sql.Class.PersistFieldSql Manufacturer where
  Database.Persist.Sql.Class.sqlType _
    = Database.Persist.Types.Base.SqlString
data Manufacturer
  = Manufacturer {manufacturerName :: !Text}
  deriving (Show, Read, Typeable)
type ManufacturerId =
    Database.Persist.Class.PersistEntity.Key Manufacturer
instance Database.Persist.Class.PersistEntity.PersistEntity Manufacturer where
  type Database.Persist.Class.PersistEntity.PersistEntityBackend Manufacturer = Database.Persist.Sql.Types.SqlBackend
  data Database.Persist.Class.PersistEntity.Unique Manufacturer
    = UniqueManufacturer Text
  newtype Database.Persist.Class.PersistEntity.Key Manufacturer
    = ManufacturerKey {unManufacturerKey :: Database.Persist.Class.PersistStore.BackendKey Database.Persist.Sql.Types.SqlBackend}
    deriving (GHC.Show.Show,
              GHC.Read.Read,
              GHC.Classes.Eq,
              GHC.Classes.Ord,
              Web.PathPieces.PathPiece,
              Web.HttpApiData.Internal.ToHttpApiData,
              Web.HttpApiData.Internal.FromHttpApiData,
              Database.Persist.Class.PersistField.PersistField,
              Database.Persist.Sql.Class.PersistFieldSql,
              Data.Aeson.Types.Class.ToJSON,
              Data.Aeson.Types.Class.FromJSON)
  data Database.Persist.Class.PersistEntity.EntityField Manufacturer typ
    = typ ~ Database.Persist.Class.PersistEntity.Key Manufacturer =>
      ManufacturerId |
      typ ~ Text => ManufacturerName
  Database.Persist.Class.PersistEntity.keyToValues
    = ((GHC.Types.: [])
       GHC.Base..
         (Database.Persist.Class.PersistField.toPersistValue
          GHC.Base.. unManufacturerKey))
  Database.Persist.Class.PersistEntity.keyFromValues
    = ((GHC.Base.fmap ManufacturerKey)
       GHC.Base..
         (Database.Persist.Class.PersistField.fromPersistValue
          GHC.Base.. Database.Persist.TH.headNote))
  Database.Persist.Class.PersistEntity.entityDef _
    = Database.Persist.Types.Base.EntityDef
        (Database.Persist.Types.Base.HaskellName
           (Database.Persist.TH.packPTH "Manufacturer"))
        (Database.Persist.Types.Base.DBName
           (Database.Persist.TH.packPTH "manufacturer"))
        (Database.Persist.Types.Base.FieldDef
           (Database.Persist.Types.Base.HaskellName
              (Database.Persist.TH.packPTH "Id"))
           (Database.Persist.Types.Base.DBName
              (Database.Persist.TH.packPTH "id"))
           (Database.Persist.Types.Base.FTTypeCon
              GHC.Base.Nothing (Database.Persist.TH.packPTH "ManufacturerId"))
           Database.Persist.Types.Base.SqlInt64
           []
           GHC.Types.True
           (Database.Persist.Types.Base.ForeignRef
              (Database.Persist.Types.Base.HaskellName
                 (Database.Persist.TH.packPTH "Manufacturer"))
              (Database.Persist.Types.Base.FTTypeCon
                 (GHC.Base.Just (Database.Persist.TH.packPTH "Data.Int"))
                 (Database.Persist.TH.packPTH "Int64"))))
        [Database.Persist.TH.packPTH "json"]
        [Database.Persist.Types.Base.FieldDef
           (Database.Persist.Types.Base.HaskellName
              (Database.Persist.TH.packPTH "name"))
           (Database.Persist.Types.Base.DBName
              (Database.Persist.TH.packPTH "name"))
           (Database.Persist.Types.Base.FTTypeCon
              GHC.Base.Nothing (Database.Persist.TH.packPTH "Text"))
           Database.Persist.Types.Base.SqlString
           []
           GHC.Types.True
           Database.Persist.Types.Base.NoReference]
        [Database.Persist.Types.Base.UniqueDef
           (Database.Persist.Types.Base.HaskellName
              (Database.Persist.TH.packPTH "UniqueManufacturer"))
           (Database.Persist.Types.Base.DBName
              (Database.Persist.TH.packPTH "unique_manufacturer"))
           [(Database.Persist.Types.Base.HaskellName
               (Database.Persist.TH.packPTH "name"), 
             Database.Persist.Types.Base.DBName
               (Database.Persist.TH.packPTH "name"))]
           []]
        []
        [Database.Persist.TH.packPTH "Show",
         Database.Persist.TH.packPTH "Read",
         Database.Persist.TH.packPTH "Typeable"]
        (Data.Map.Base.fromList [])
        GHC.Types.False
  Database.Persist.Class.PersistEntity.toPersistFields
    (Manufacturer x_a9oA)
    = [Database.Persist.Class.PersistField.SomePersistField x_a9oA]
  Database.Persist.Class.PersistEntity.fromPersistValues [x1_a9oC]
    = Manufacturer
      Data.Functor.<$>
        ((Database.Persist.TH.mapLeft
            (Database.Persist.TH.fieldError
               (Database.Persist.TH.packPTH "name")))
         GHC.Base.. Database.Persist.Class.PersistField.fromPersistValue)
          x1_a9oC
  Database.Persist.Class.PersistEntity.fromPersistValues x_a9oB
    = (Data.Either.Left
       GHC.Base.$
         (GHC.Base.mappend
            (Database.Persist.TH.packPTH
               "Manufacturer: fromPersistValues failed on: ")
            (Data.Text.pack GHC.Base.$ (GHC.Show.show x_a9oB))))
  Database.Persist.Class.PersistEntity.persistUniqueToFieldNames
    (UniqueManufacturer {})
    = [(Database.Persist.Types.Base.HaskellName
          (Database.Persist.TH.packPTH "name"), 
        Database.Persist.Types.Base.DBName
          (Database.Persist.TH.packPTH "name"))]
  Database.Persist.Class.PersistEntity.persistUniqueToValues
    (UniqueManufacturer x_a9oD)
    = [Database.Persist.Class.PersistField.toPersistValue x_a9oD]
  Database.Persist.Class.PersistEntity.persistUniqueKeys
    (Manufacturer _name_a9oE)
    = [UniqueManufacturer _name_a9oE]
  Database.Persist.Class.PersistEntity.persistFieldDef ManufacturerId
    = Database.Persist.Types.Base.FieldDef
        (Database.Persist.Types.Base.HaskellName
           (Database.Persist.TH.packPTH "Id"))
        (Database.Persist.Types.Base.DBName
           (Database.Persist.TH.packPTH "id"))
        (Database.Persist.Types.Base.FTTypeCon
           GHC.Base.Nothing (Database.Persist.TH.packPTH "ManufacturerId"))
        Database.Persist.Types.Base.SqlInt64
        []
        GHC.Types.True
        (Database.Persist.Types.Base.ForeignRef
           (Database.Persist.Types.Base.HaskellName
              (Database.Persist.TH.packPTH "Manufacturer"))
           (Database.Persist.Types.Base.FTTypeCon
              (GHC.Base.Just (Database.Persist.TH.packPTH "Data.Int"))
              (Database.Persist.TH.packPTH "Int64")))
  Database.Persist.Class.PersistEntity.persistFieldDef
    ManufacturerName
    = Database.Persist.Types.Base.FieldDef
        (Database.Persist.Types.Base.HaskellName
           (Database.Persist.TH.packPTH "name"))
        (Database.Persist.Types.Base.DBName
           (Database.Persist.TH.packPTH "name"))
        (Database.Persist.Types.Base.FTTypeCon
           GHC.Base.Nothing (Database.Persist.TH.packPTH "Text"))
        Database.Persist.Types.Base.SqlString
        []
        GHC.Types.True
        Database.Persist.Types.Base.NoReference
  Database.Persist.Class.PersistEntity.persistIdField
    = ManufacturerId
  Database.Persist.Class.PersistEntity.fieldLens ManufacturerId
    = Database.Persist.TH.lensPTH
        Database.Persist.Class.PersistEntity.entityKey
        (\ (Database.Persist.Class.PersistEntity.Entity _ value_a9oF)
           key_a9oG
           -> Database.Persist.Class.PersistEntity.Entity key_a9oG value_a9oF)
  Database.Persist.Class.PersistEntity.fieldLens ManufacturerName
    = Database.Persist.TH.lensPTH
        (manufacturerName
         GHC.Base.. Database.Persist.Class.PersistEntity.entityVal)
        (\ (Database.Persist.Class.PersistEntity.Entity key_a9oH
                                                        value_a9oI)
           x_a9oJ
           -> Database.Persist.Class.PersistEntity.Entity
                key_a9oH (value_a9oI {manufacturerName = x_a9oJ}))
instance Database.Persist.Class.PersistStore.ToBackendKey Database.Persist.Sql.Types.SqlBackend Manufacturer where
  Database.Persist.Class.PersistStore.toBackendKey
    = unManufacturerKey
  Database.Persist.Class.PersistStore.fromBackendKey
    = ManufacturerKey
instance Data.Aeson.Types.Class.ToJSON Manufacturer where
  Data.Aeson.Types.Class.toJSON (Manufacturer name_a9oL)
    = Data.Aeson.Types.Internal.object
        [((Data.Text.pack "name") Data.Aeson.Types.Instances..= name_a9oL)]
instance Data.Aeson.Types.Class.FromJSON Manufacturer where
  Data.Aeson.Types.Class.parseJSON
    (Data.Aeson.Types.Internal.Object obj_a9oK)
    = ((GHC.Base.pure Manufacturer)
       GHC.Base.<*>
         (obj_a9oK Data.Aeson.Types.Instances..: (Data.Text.pack "name")))
  Data.Aeson.Types.Class.parseJSON _ = GHC.Base.mzero
instance Data.Aeson.Types.Class.ToJSON (Database.Persist.Class.PersistEntity.Entity Manufacturer) where
  Data.Aeson.Types.Class.toJSON
    = Database.Persist.Class.PersistEntity.entityIdToJSON
instance Data.Aeson.Types.Class.FromJSON (Database.Persist.Class.PersistEntity.Entity Manufacturer) where
  Data.Aeson.Types.Class.parseJSON
    = Database.Persist.Class.PersistEntity.entityIdFromJSON
migrateAll :: Database.Persist.Sql.Types.Migration
migrateAll
  = do { let defs_a9oM
               = [Database.Persist.Types.Base.EntityDef
                    (Database.Persist.Types.Base.HaskellName
                       (Database.Persist.TH.packPTH "Manufacturer"))
                    (Database.Persist.Types.Base.DBName
                       (Database.Persist.TH.packPTH "manufacturer"))
                    (Database.Persist.Types.Base.FieldDef
                       (Database.Persist.Types.Base.HaskellName
                          (Database.Persist.TH.packPTH "Id"))
                       (Database.Persist.Types.Base.DBName
                          (Database.Persist.TH.packPTH "id"))
                       (Database.Persist.Types.Base.FTTypeCon
                          GHC.Base.Nothing (Database.Persist.TH.packPTH "ManufacturerId"))
                       Database.Persist.Types.Base.SqlInt64
                       []
                       GHC.Types.True
                       (Database.Persist.Types.Base.ForeignRef
                          (Database.Persist.Types.Base.HaskellName
                             (Database.Persist.TH.packPTH "Manufacturer"))
                          (Database.Persist.Types.Base.FTTypeCon
                             (GHC.Base.Just (Database.Persist.TH.packPTH "Data.Int"))
                             (Database.Persist.TH.packPTH "Int64"))))
                    [Database.Persist.TH.packPTH "json"]
                    [Database.Persist.Types.Base.FieldDef
                       (Database.Persist.Types.Base.HaskellName
                          (Database.Persist.TH.packPTH "name"))
                       (Database.Persist.Types.Base.DBName
                          (Database.Persist.TH.packPTH "name"))
                       (Database.Persist.Types.Base.FTTypeCon
                          GHC.Base.Nothing (Database.Persist.TH.packPTH "Text"))
                       Database.Persist.Types.Base.SqlString
                       []
                       GHC.Types.True
                       Database.Persist.Types.Base.NoReference]
                    [Database.Persist.Types.Base.UniqueDef
                       (Database.Persist.Types.Base.HaskellName
                          (Database.Persist.TH.packPTH "UniqueManufacturer"))
                       (Database.Persist.Types.Base.DBName
                          (Database.Persist.TH.packPTH "unique_manufacturer"))
                       [(Database.Persist.Types.Base.HaskellName
                           (Database.Persist.TH.packPTH "name"), 
                         Database.Persist.Types.Base.DBName
                           (Database.Persist.TH.packPTH "name"))]
                       []]
                    []
                    [Database.Persist.TH.packPTH "Show",
                     Database.Persist.TH.packPTH "Read",
                     Database.Persist.TH.packPTH "Typeable"]
                    (Data.Map.Base.fromList [])
                    GHC.Types.False];
         Database.Persist.Sql.Migration.migrate
           defs_a9oM
           (Database.Persist.Types.Base.EntityDef
              (Database.Persist.Types.Base.HaskellName
                 (Database.Persist.TH.packPTH "Manufacturer"))
              (Database.Persist.Types.Base.DBName
                 (Database.Persist.TH.packPTH "manufacturer"))
              (Database.Persist.Types.Base.FieldDef
                 (Database.Persist.Types.Base.HaskellName
                    (Database.Persist.TH.packPTH "Id"))
                 (Database.Persist.Types.Base.DBName
                    (Database.Persist.TH.packPTH "id"))
                 (Database.Persist.Types.Base.FTTypeCon
                    GHC.Base.Nothing (Database.Persist.TH.packPTH "ManufacturerId"))
                 Database.Persist.Types.Base.SqlInt64
                 []
                 GHC.Types.True
                 (Database.Persist.Types.Base.ForeignRef
                    (Database.Persist.Types.Base.HaskellName
                       (Database.Persist.TH.packPTH "Manufacturer"))
                    (Database.Persist.Types.Base.FTTypeCon
                       (GHC.Base.Just (Database.Persist.TH.packPTH "Data.Int"))
                       (Database.Persist.TH.packPTH "Int64"))))
              [Database.Persist.TH.packPTH "json"]
              [Database.Persist.Types.Base.FieldDef
                 (Database.Persist.Types.Base.HaskellName
                    (Database.Persist.TH.packPTH "name"))
                 (Database.Persist.Types.Base.DBName
                    (Database.Persist.TH.packPTH "name"))
                 (Database.Persist.Types.Base.FTTypeCon
                    GHC.Base.Nothing (Database.Persist.TH.packPTH "Text"))
                 Database.Persist.Types.Base.SqlString
                 []
                 GHC.Types.True
                 Database.Persist.Types.Base.NoReference]
              [Database.Persist.Types.Base.UniqueDef
                 (Database.Persist.Types.Base.HaskellName
                    (Database.Persist.TH.packPTH "UniqueManufacturer"))
                 (Database.Persist.Types.Base.DBName
                    (Database.Persist.TH.packPTH "unique_manufacturer"))
                 [(Database.Persist.Types.Base.HaskellName
                     (Database.Persist.TH.packPTH "name"), 
                   Database.Persist.Types.Base.DBName
                     (Database.Persist.TH.packPTH "name"))]
                 []]
              []
              [Database.Persist.TH.packPTH "Show",
               Database.Persist.TH.packPTH "Read",
               Database.Persist.TH.packPTH "Typeable"]
              (Data.Map.Base.fromList [])
              GHC.Types.False) }

Error message reported parse error at -> on line starting with GHC.Base.Nothing ->

(\ name_a9oy
     -> case
            Data.HashMap.Base.lookup (Data.Text.pack name_a9oy) columns_a9ox
        of {
          GHC.Base.Just v_a9oz -> v_a9oz
          GHC.Base.Nothing -> Database.Persist.Types.Base.PersistNull }))

Solution

  • EDIT: You can't directly reuse code generated in a ghc build, but you can simply use the module containing your Persistent database model in your ghcjs code. This will generate and build the database stuff with GHCJS and it is then available to your GHCJS code.