[Haskell-cafe] Problem with Model entity (persistent-template)
Hadruki
hadruki at protonmail.com
Sun May 10 14:44:10 UTC 2020
Hi
I have a project built around servant + persistent(-postgresql) + esqueleto (and many other libraries).
I recently upgraded it to newer versions of GHC and my dependencies and I'm running into a problem which I don't fully understand.
```
• Couldn't match a lifted type with an unlifted type
arising from the coercion of the method ‘==’
from type ‘ghc-prim-0.5.3:GHC.Prim.Int#
-> ghc-prim-0.5.3:GHC.Prim.Int# -> Bool’
to type ‘Key ActivationCode -> Key ActivationCode -> Bool’
• When deriving the instance for (Eq (Key ActivationCode))
+ other similar
```
(full trace + Model.hs below)
I get these errors on all my model entities.
First of all I don't really understand the error message and I don't understand why I am getting it. I am using these entities (and their key) in esqueleto database operations:
```
findActivationCodeById :: ActivationCodeId -> IO (Entity ActivationCode)
```
I don't get the error if I build with `stack build --fast` (at least the Model.hs builds).
I've tried to reproduce this on a smaller project with nothing but this Model file however it compiles there.
Additionally even if I remove the `deriving Eq` it doesn't change the error (it's still deriving Eq, Ord, ..).
Could anyone give me some hints where I should start looking? Is it due to a language extension?
In my (generated) cabal
```
default-extensions: TypeOperators OverloadedStrings DeriveGeneric RecordWildCards DuplicateRecordFields StrictData
```
Thanks!
Model.hs (trimmed down to just one entity)
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-} -- allow json in data model
module Prolix.Model.Model where
import qualified Data.Aeson as Aeson
import qualified Data.Fixed as Fixed
import Data.Text (Text)
import Data.Time
import Data.Typeable (Typeable)
import Database.Persist.Postgresql
import Database.Persist.TH
import GHC.Generics
share [ mkPersist sqlSettings
, mkDeleteCascade sqlSettings
, mkMigrate "migrateAll"
] [persistLowerCase|
ActivationCode json
productCode Int sql=accd_product_code
code Text sql=accd_code
provider Text sql=accd_provider
exported Bool sql=accd_exported
exportedOn UTCTime Maybe sql=accd_exported_on
createdOn UTCTime sql=accd_created_on default=now()
modifiedOn UTCTime sql=accd_modified_on default=now()
UniqueActivationCode code provider
deriving Eq Ord Show Generic
|]
Full trace
[ 54 of 155] Compiling Prolix.Model.Model ( src/Prolix/Model/Model.hs, .stack-work/dist/x86_64-osx/Cabal-2.4.0.1/build/Prolix/Model/Model.o ) [Optimisation flags changed]
/src/hadruki/prolix/src/Prolix/Model/Model.hs:35:1: error:
• Couldn't match a lifted type with an unlifted type
arising from the coercion of the method ‘==’
from type ‘ghc-prim-0.5.3:GHC.Prim.Int#
-> ghc-prim-0.5.3:GHC.Prim.Int# -> Bool’
to type ‘Key ActivationCode -> Key ActivationCode -> Bool’
• When deriving the instance for (Eq (Key ActivationCode))
|
35 | share [ mkPersist sqlSettings
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
/src/hadruki/prolix/src/Prolix/Model/Model.hs:35:1: error:
• Couldn't match a lifted type with an unlifted type
arising from the coercion of the method ‘compare’
from type ‘ghc-prim-0.5.3:GHC.Prim.Int#
-> ghc-prim-0.5.3:GHC.Prim.Int# -> Ordering’
to type ‘Key ActivationCode -> Key ActivationCode -> Ordering’
• When deriving the instance for (Ord (Key ActivationCode))
|
35 | share [ mkPersist sqlSettings
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
/src/hadruki/prolix/src/Prolix/Model/Model.hs:35:1: error:
• Couldn't match a lifted type with an unlifted type
arising from the coercion of the method ‘path-pieces-0.2.1:Web.PathPieces.toPathPiece’
from type ‘ghc-prim-0.5.3:GHC.Prim.Int# -> Text’
to type ‘Key ActivationCode -> Text’
• When deriving the instance for (path-pieces-0.2.1:Web.PathPieces.PathPiece
(Key ActivationCode))
|
35 | share [ mkPersist sqlSettings
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
/src/hadruki/prolix/src/Prolix/Model/Model.hs:35:1: error:
• Couldn't match a lifted type with an unlifted type
arising from the coercion of the method ‘Web.Internal.HttpApiData.toUrlPiece’
from type ‘ghc-prim-0.5.3:GHC.Prim.Int# -> Text’
to type ‘Key ActivationCode -> Text’
• When deriving the instance for (Web.Internal.HttpApiData.ToHttpApiData
(Key ActivationCode))
|
35 | share [ mkPersist sqlSettings
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
/src/hadruki/prolix/src/Prolix/Model/Model.hs:35:1: error:
• No instance for (Web.Internal.HttpApiData.FromHttpApiData
ghc-prim-0.5.3:GHC.Prim.Int#)
arising from the 'deriving' clause of a data type declaration
Possible fix:
use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
• When deriving the instance for (Web.Internal.HttpApiData.FromHttpApiData
(Key ActivationCode))
|
35 | share [ mkPersist sqlSettings
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
/src/hadruki/prolix/src/Prolix/Model/Model.hs:35:1: error:
• Couldn't match a lifted type with an unlifted type
arising from the coercion of the method ‘toPersistValue’
from type ‘ghc-prim-0.5.3:GHC.Prim.Int# -> PersistValue’
to type ‘Key ActivationCode -> PersistValue’
• When deriving the instance for (PersistField
(Key ActivationCode))
|
35 | share [ mkPersist sqlSettings
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
/src/hadruki/prolix/src/Prolix/Model/Model.hs:35:1: error:
• Couldn't match a lifted type with an unlifted type
arising from the coercion of the method ‘sqlType’
from type ‘Data.Proxy.Proxy ghc-prim-0.5.3:GHC.Prim.Int#
-> SqlType’
to type ‘Data.Proxy.Proxy (Key ActivationCode) -> SqlType’
• When deriving the instance for (PersistFieldSql
(Key ActivationCode))
|
35 | share [ mkPersist sqlSettings
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
/src/hadruki/prolix/src/Prolix/Model/Model.hs:35:1: error:
• Couldn't match a lifted type with an unlifted type
arising from the coercion of the method ‘Aeson.toJSON’
from type ‘ghc-prim-0.5.3:GHC.Prim.Int# -> Aeson.Value’
to type ‘Key ActivationCode -> Aeson.Value’
• When deriving the instance for (Aeson.ToJSON
(Key ActivationCode))
|
35 | share [ mkPersist sqlSettings
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
/src/hadruki/prolix/src/Prolix/Model/Model.hs:35:1: error:
• No instance for (Aeson.FromJSON ghc-prim-0.5.3:GHC.Prim.Int#)
arising from the 'deriving' clause of a data type declaration
Possible fix:
use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
• When deriving the instance for (Aeson.FromJSON
(Key ActivationCode))
|
35 | share [ mkPersist sqlSettings
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20200510/3b07b6d9/attachment.html>
More information about the Haskell-Cafe
mailing list