与 Generic 相关的代码重叠实例

Overlapping instances with Generic-related code

我正在尝试生成模仿 toJSON 结构的数据结构:

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fprint-potential-instances #-}

module Gen where

import Data.Proxy
import GHC.Generics
import GHC.TypeLits

data Syntax
  = ObjectS String [Syntax]
  | IntS String
  | CharS String
  deriving (Eq, Show, Generic)

target :: [Syntax]
target = [IntS "rfLeft", ObjectS "rfRight" [CharS "sfOne"]]

class GUnnamedSpec f where
  genericUnnamedSpec :: Proxy f -> String -> Syntax

instance GUnnamedSpec Int where -- U1
  genericUnnamedSpec _ = IntS

instance GUnnamedSpec Char where -- U2
  genericUnnamedSpec _ = CharS

instance (Spec f) => GUnnamedSpec f where -- U3
  genericUnnamedSpec _ n = ObjectS n $ spec $ Proxy @f

instance (GUnnamedSpec f) => GUnnamedSpec (Rec0 f p) where -- U4
  genericUnnamedSpec _ = genericUnnamedSpec $ Proxy @f

instance (GUnnamedSpec (f p)) => GUnnamedSpec (D1 m f p) where -- U5
  genericUnnamedSpec _ = genericUnnamedSpec $ Proxy @(f p)

instance (GUnnamedSpec (f p)) => GUnnamedSpec (S1 ('MetaSel 'Nothing u s l) f p) where -- U6
  genericUnnamedSpec _ = genericUnnamedSpec $ Proxy @(f p)

instance (GUnnamedSpec (f p)) => GUnnamedSpec (C1 m f p) where -- U7
  genericUnnamedSpec _ = genericUnnamedSpec $ Proxy @(f p)

class GNamedSpec f where
  genericNamedSpec :: Proxy (f p) -> [Syntax]

instance (GNamedSpec f, GNamedSpec g) => GNamedSpec (f :*: g) where -- N1
  genericNamedSpec _ = genericNamedSpec (Proxy @(f ())) <> genericNamedSpec (Proxy @(g ()))

instance (GUnnamedSpec (f ()), KnownSymbol n) => GNamedSpec (S1 ('MetaSel ('Just n) u s l) f) where -- N2
  genericNamedSpec _ = [genericUnnamedSpec (Proxy @(f ())) $ symbolVal (Proxy @n)]

instance (GNamedSpec f) => GNamedSpec (D1 m f) where -- N3
  genericNamedSpec _ = genericNamedSpec $ Proxy @(f ())

instance (GNamedSpec f) => GNamedSpec (C1 m f) where -- N4
  genericNamedSpec _ = genericNamedSpec $ Proxy @(f ())

class Spec a where
  spec :: Proxy a -> [Syntax]
  default spec :: (Generic a, GNamedSpec (Rep a)) => Proxy a -> [Syntax]
  spec _ = genericNamedSpec $ Proxy @(Rep a ())

我有以下类型:

data RootT = RootT
  { rfLeft :: Int,
    rfRight :: SubT
  }
  deriving (Eq, Show, Generic, Spec)

data SubT = SubT {sfOne :: Char}
  deriving (Eq, Show, Generic, Spec)

他们有这样的结构:

(undefined :: Rep SubT p)
  :: D1
       ('MetaData "SubT" "Gen" "main" 'False)
       (C1
          ('MetaCons "SubT" 'PrefixI 'True)
          (S1
             ('MetaSel
                ('Just "sfOne")
                'NoSourceUnpackedness
                'NoSourceStrictness
                'DecidedLazy)
             (Rec0 Char)))
       p
*Gen GHC.Generics> :t (undefined :: Rep RootT p)
(undefined :: Rep RootT p)
  :: D1
       ('MetaData "RootT" "Gen" "main" 'False)
       (C1
          ('MetaCons "RootT" 'PrefixI 'True)
          (S1
             ('MetaSel
                ('Just "rfLeft")
                'NoSourceUnpackedness
                'NoSourceStrictness
                'DecidedLazy)
             (Rec0 Int)
           :*: S1
                 ('MetaSel
                    ('Just "rfRight")
                    'NoSourceUnpackedness
                    'NoSourceStrictness
                    'DecidedLazy)
                 (Rec0 SubT)))
       p

按我的理解应该是这样解决的:

SubT: N4 -> N3 -> N2 -> U4 -> U2
RootT: N4 -> N3 -> N1 -> (N2 -> U4 -> U2, N2 -> U4 -> U3)

当我遇到这些错误时:

Gen.hs:26:32: error:
    • Overlapping instances for GUnnamedSpec (K1 R Int ())
        arising from the 'deriving' clause of a data type declaration
      Matching instances:
        instance Spec f => GUnnamedSpec f
          -- Defined at Gen.hs:49:10
        ...plus one instance involving out-of-scope types
          instance GUnnamedSpec f => GUnnamedSpec (Rec0 f p)
            -- Defined at Gen.hs:52:10
    • When deriving the instance for (Spec RootT)
   |
26 |   deriving (Eq, Show, Generic, Spec)
   |                                ^^^^

Gen.hs:29:32: error:
    • Overlapping instances for GUnnamedSpec (K1 R Char ())
        arising from the 'deriving' clause of a data type declaration
      Matching instances:
        instance Spec f => GUnnamedSpec f
          -- Defined at Gen.hs:49:10
        ...plus one instance involving out-of-scope types
          instance GUnnamedSpec f => GUnnamedSpec (Rec0 f p)
            -- Defined at Gen.hs:52:10
    • When deriving the instance for (Spec SubT)
   |
29 |   deriving (Eq, Show, Generic, Spec)
   |                 

有没有办法消除歧义?

这里有几件事很奇怪。

class种

通常,您需要让 Generic classes 采用 Type -> Typek -> Type 类型,而不用担心 p参数除非你需要处理Generic1。所以我期待更像

的东西
class GUnnamedSpec (f :: Type -> Type) where
  genericUnnamedSpec :: Proxy f -> String -> Syntax

class GNamedSpec (f :: Type -> Type) where
  genericNamedSpec :: Proxy f -> [Syntax]

如果您使用 AllowAmbiguousTypes,那么您也可以删除代理。

某些情况

这些确实不寻常且令人困惑:

instance Spec f => GUnnamedSpec f where -- U3
  genericUnnamedSpec _ n = ObjectS n $ spec $ Proxy @f

instance (GUnnamedSpec f) => GUnnamedSpec (Rec0 f p) where -- U4
  genericUnnamedSpec _ = genericUnnamedSpec $ Proxy @f

第一个应该完全放弃。您可以更改第二个分支以按照您想要的方式进行分支。这是一种方法:

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE AllowAmbiguousTypes#-}
{-# OPTIONS_GHC -fprint-potential-instances #-}

module Gen where

import Data.Proxy
import GHC.Generics
import GHC.TypeLits
import Data.Kind (Type)
import Data.Semigroup (Semigroup (..))

data Syntax
  = ObjectS String [Syntax]
  | IntS String
  | CharS String
  deriving (Eq, Show, Generic)

target :: [Syntax]
target = [IntS "rfLeft", ObjectS "rfRight" [CharS "sfOne"]]

class GUnnamedSpec (f :: Type -> Type) where
  genericUnnamedSpec :: String -> Syntax

instance GUnnamedSpec (K1 i Int) where -- U1
  genericUnnamedSpec = IntS

instance GUnnamedSpec (K1 i Char) where -- U2
  genericUnnamedSpec = CharS

instance {-# OVERLAPPABLE #-} Spec a => GUnnamedSpec (K1 i a) where -- U4
  genericUnnamedSpec n = ObjectS n $ spec @a

instance GUnnamedSpec f => GUnnamedSpec (D1 m f) where -- U5
  genericUnnamedSpec = genericUnnamedSpec @f

instance GUnnamedSpec f => GUnnamedSpec (S1 ('MetaSel 'Nothing u s l) f) where -- U6
  genericUnnamedSpec = genericUnnamedSpec @f

instance GUnnamedSpec f => GUnnamedSpec (C1 m f) where -- U7
  genericUnnamedSpec = genericUnnamedSpec @f

class GNamedSpec (f :: Type -> Type) where
  genericNamedSpec :: [Syntax]

instance (GNamedSpec f, GNamedSpec g) => GNamedSpec (f :*: g) where -- N1
  genericNamedSpec = genericNamedSpec @f <> genericNamedSpec @g

instance (GUnnamedSpec f, KnownSymbol n) => GNamedSpec (S1 ('MetaSel ('Just n) u s l) f) where -- N2
  genericNamedSpec = [genericUnnamedSpec @f $ symbolVal (Proxy @n)]

instance GNamedSpec f => GNamedSpec (D1 m f) where -- N3
  genericNamedSpec = genericNamedSpec @f

instance GNamedSpec f => GNamedSpec (C1 m f) where -- N4
  genericNamedSpec = genericNamedSpec @f

class Spec (a :: Type) where
  spec :: [Syntax]
  default spec :: (Generic a, GNamedSpec (Rep a)) => [Syntax]
  spec = genericNamedSpec @(Rep a)

据我所知,唯一使用的 GUnnamedSpec 个实例是 K1 个实例。这是因为(我相信)唯一可以在 Rep 中的 S1 下的是 K1(这与 Rep1 不同,但你不出于您的目的需要它)。假设这是正确的,你可以进一步简化。

class UnnamedSpec a where
  unnamedSpec :: String -> Syntax

instance UnnamedSpec Int where -- U1
  unnamedSpec = IntS

instance UnnamedSpec Char where -- U2
  unnamedSpec = CharS

instance {-# OVERLAPPABLE #-} Spec a => UnnamedSpec a where -- U4
  unnamedSpec n = ObjectS n $ spec @a


class GNamedSpec (f :: Type -> Type) where
  genericNamedSpec :: [Syntax]

instance (GNamedSpec f, GNamedSpec g) => GNamedSpec (f :*: g) where -- N1
  genericNamedSpec = genericNamedSpec @f <> genericNamedSpec @g

instance (UnnamedSpec a, KnownSymbol n) => GNamedSpec (S1 ('MetaSel ('Just n) u s l) (K1 i a)) where -- N2
  genericNamedSpec = [unnamedSpec @a $ symbolVal (Proxy @n)]

instance GNamedSpec f => GNamedSpec (D1 m f) where -- N3
  genericNamedSpec = genericNamedSpec @f

instance GNamedSpec f => GNamedSpec (C1 m f) where -- N4
  genericNamedSpec = genericNamedSpec @f

class Spec (a :: Type) where
  spec :: [Syntax]
  default spec :: (Generic a, GNamedSpec (Rep a)) => [Syntax]
  spec = genericNamedSpec @(Rep a)