Блог

Главная - Вопросы по программированию - Перекрывающиеся экземпляры с общим кодом, связанным с

Перекрывающиеся экземпляры с общим кодом, связанным с

#haskell #generics #ghc #typeclass

Вопрос:

Я пытаюсь создать структуру данных, которая имитирует структуру 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)
   |

Есть ли способ устранить двусмысленность?

Комментарии:

1. Я уверен, что в вашем примере есть некоторые детали, которые можно удалить, не затрагивая основную проблему, о которой вы спрашиваете. Сделай это.

2. Это может быть случай, когда вы просто добавляете {-# OVERLAPPABLE #-} прагму в слишком общий экземпляр, хотя я не рассматривал ваш код подробно.

3. @DavidFox, ты прав, ты можешь дать полный ответ, чтобы получить зеленый знак 🙂

Ответ №1:

Здесь есть несколько странных вещей.

Классовые виды

Как правило, вы захотите , чтобы ваши Generic классы принимали типы типа Type -> Type или k -> 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 . Это потому , что (я верю) единственное, что может быть под a S1 в a Rep , — это a 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)
Метки: ,