CODEWITHSUNDEEP
haskellgenericsghctypeclass
GlinesMome
GlinesMome

Reputation: 1629

Overlapping instances with Generic-related code

I am trying to produce data structure which mimics a toJSON structure:

{-# 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 ())

I have the following types:

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

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

They have this structure:

(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

In my understanding it should be resolved as follows:

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

While I have these errors:

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)
   |

Is there a way to remove the ambiguity?

Upvotes: 0

Views: 133

Answers (1)

dfeuer
dfeuer

Reputation: 48581

Several things are weird here.

The class kinds

Typically, you'll want to make your Generic classes take types of kind Type -> Type or k -> Type, and not to worry about the p parameter unless you need to deal with Generic1. So I'd expect something more like

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

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

If you use AllowAmbiguousTypes, then you can drop the proxies too.

Certain instances

These are really unusual and confusing:

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

The first one should be dropped altogether. You can change the second one to branch the way you want. Here's one way:

{-# 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)

As far as I can tell, the only GUnnamedSpec instances used are the K1 ones. This is because (I believe) the only thing that can be under an S1 in a Rep is a K1 (this is different for Rep1, but you don't need that for your purpose). Assuming this is right, you can simplify further.

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)

Upvotes: 3

Related Questions