Problem generating `SDecide` instances for custom promoted types
cgohla opened this issue · comments
I followed the README to get around the Symbol/Text problem for some types in an application. Now I'm trying to generate SDecide instances for my custom promoted type, but it seems the instances are generated incorrectly, i.e., the name mapping for the promoted types is not applied correctly.
I have a minimal example to demonstrate the problem here:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Main (main) where
import Data.Singletons.TH (genSingletons, singDecideInstances,
singletons)
import Data.Singletons.TH.Options (defaultOptions,
defunctionalizedName,
promotedDataTypeOrConName,
withOptions)
import Data.String (fromString)
import Data.String.Singletons (FromString)
import Data.Text (Text)
import GHC.TypeLits.Singletons (Symbol)
import Language.Haskell.TH (Name)
-- Term-level
newtype Message = MkMessage Text
-- Type-level
newtype PMessage = PMkMessage Symbol
$(let customPromote :: Name -> Name
customPromote n
| n == ''Message = ''PMessage
| n == 'MkMessage = 'PMkMessage
| n == ''Text = ''Symbol
| otherwise = promotedDataTypeOrConName defaultOptions n
customDefun :: Name -> Int -> Name
customDefun n sat = defunctionalizedName defaultOptions (customPromote n) sat in
withOptions defaultOptions{ promotedDataTypeOrConName = customPromote
, defunctionalizedName = customDefun
} $ do
decs1 <- genSingletons [''Message]
decs2 <- singletons [d|
hello :: Message
hello = MkMessage "hello"
|]
decs3 <- singDecideInstances [''Message]
return $ decs1 ++ decs2 ++ decs3)
main :: IO ()
main = putStrLn "Hello, Haskell!"This yields the following errors:
$ cabal build
Resolving dependencies...
Build profile: -w ghc-9.2.4 -O1
In order, the following will be built (use -v for more details):
- singletons-decide-instances-0.1.0.0 (exe:singletons-decide-instances) (file app/Main.hs changed)
Preprocessing executable 'singletons-decide-instances' for singletons-decide-instances-0.1.0.0..
Building executable 'singletons-decide-instances' for singletons-decide-instances-0.1.0.0..
[1 of 1] Compiling Main ( app/Main.hs, /home/bgohla/src/scratch/singletons-decide-instances/dist-newstyle/build/x86_64-openbsd/ghc-9.2.4/singletons-decide-instances-0.1.0.0/x/singletons-decide-instances/build/singletons-decide-instances/singletons-decide-instances-tmp/Main.o, /home/bgohla/src/scratch/singletons-decide-instances/dist-newstyle/build/x86_64-openbsd/ghc-9.2.4/singletons-decide-instances-0.1.0.0/x/singletons-decide-instances/build/singletons-decide-instances/singletons-decide-instances-tmp/Main.dyn_o )
app/Main.hs:32:2: error:
• Couldn't match kind ‘PMessage’ with ‘Message’
Expected kind ‘Message -> *’,
but ‘SMessage’ has kind ‘PMessage -> *’
• In the first argument of ‘Data.Type.Coercion.TestCoercion’, namely
‘(SMessage :: Message -> ghc-prim-0.8.0:GHC.Types.Type)’
In the instance declaration for
‘Data.Type.Coercion.TestCoercion (SMessage :: Message
-> ghc-prim-0.8.0:GHC.Types.Type)’
|
32 | $(let customPromote :: Name -> Name
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
app/Main.hs:32:2: error:
• Couldn't match kind ‘PMessage’ with ‘Message’
Expected kind ‘Message -> *’,
but ‘SMessage’ has kind ‘PMessage -> *’
• In the first argument of ‘Data.Type.Equality.TestEquality’, namely
‘(SMessage :: Message -> ghc-prim-0.8.0:GHC.Types.Type)’
In the instance declaration for
‘Data.Type.Equality.TestEquality (SMessage :: Message
-> ghc-prim-0.8.0:GHC.Types.Type)’
|
32 | $(let customPromote :: Name -> Name
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
So it seems singDecideInstances disregards the custom name mapping we defined. I have not dug into the implementation to understand what goes wrong.
A Cabal project with a freeze file is here https://github.com/cgohla/singletons-decide-instances.
I am able to reproduce this. Curiously, this does not happen if you generate SDecide instances by way of deriving Eq. That is, the following does work:
decs2 <- singletons [d|
hello :: Message
hello = MkMessage "hello"
deriving instance Eq Message
|]I'll need to take a closer look to see why singDecideInstances isn't behaving identically.
I am able to reproduce this. Curiously, this does not happen if you generate
SDecideinstances by way ofderiving Eq. That is, the following does work:decs2 <- singletons [d| hello :: Message hello = MkMessage "hello" deriving instance Eq Message |]
That would be a neat workaround, but doesn't work for me. I get this error instead:
Build profile: -w ghc-9.2.4 -O1
In order, the following will be built (use -v for more details):
- singletons-decide-instances-0.1.0.0 (exe:singletons-decide-instances) (file app/Main.hs changed)
Preprocessing executable 'singletons-decide-instances' for singletons-decide-instances-0.1.0.0..
Building executable 'singletons-decide-instances' for singletons-decide-instances-0.1.0.0..
[1 of 1] Compiling Main ( app/Main.hs, /home/bgohla/src/scratch/singletons-decide-instances/dist-newstyle/build/x86_64-openbsd/ghc-9.2.4/singletons-decide-instances-0.1.0.0/x/singletons-decide-instances/build/singletons-decide-instances/singletons-decide-instances-tmp/Main.o, /home/bgohla/src/scratch/singletons-decide-instances/dist-newstyle/build/x86_64-openbsd/ghc-9.2.4/singletons-decide-instances-0.1.0.0/x/singletons-decide-instances/build/singletons-decide-instances/singletons-decide-instances-tmp/Main.dyn_o )
app/Main.hs:49:2: error: Q monad failure
|
49 | $(let customPromote :: Name -> Name
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
app/Main.hs:49:2: error: Cannot find type annotation for ==
|
49 | $(let customPromote :: Name -> Name
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
NB I'm stuck on GHC 9.2.4 for now. Is there any way I can use your fix @RyanGlScott (without forking and patching the library myself?)
I'll need to take a closer look to see why
singDecideInstancesisn't behaving identically.
Thanks for the quick response anyway 👍 .
I am able to reproduce this. Curiously, this does not happen if you generate
SDecideinstances by way ofderiving Eq. That is, the following does work:decs2 <- singletons [d| hello :: Message hello = MkMessage "hello" deriving instance Eq Message |]That would be a neat workaround, but doesn't work for me. I get this error instead:
Build profile: -w ghc-9.2.4 -O1 In order, the following will be built (use -v for more details): - singletons-decide-instances-0.1.0.0 (exe:singletons-decide-instances) (file app/Main.hs changed) Preprocessing executable 'singletons-decide-instances' for singletons-decide-instances-0.1.0.0.. Building executable 'singletons-decide-instances' for singletons-decide-instances-0.1.0.0.. [1 of 1] Compiling Main ( app/Main.hs, /home/bgohla/src/scratch/singletons-decide-instances/dist-newstyle/build/x86_64-openbsd/ghc-9.2.4/singletons-decide-instances-0.1.0.0/x/singletons-decide-instances/build/singletons-decide-instances/singletons-decide-instances-tmp/Main.o, /home/bgohla/src/scratch/singletons-decide-instances/dist-newstyle/build/x86_64-openbsd/ghc-9.2.4/singletons-decide-instances-0.1.0.0/x/singletons-decide-instances/build/singletons-decide-instances/singletons-decide-instances-tmp/Main.dyn_o ) app/Main.hs:49:2: error: Q monad failure | 49 | $(let customPromote :: Name -> Name | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^... app/Main.hs:49:2: error: Cannot find type annotation for == | 49 | $(let customPromote :: Name -> Name | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
[...]
Nevermind. Adding Data.Eq.Singletons fixed it 🤦