{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DefaultSignatures #-}

module Bug where
    
import GHC.Generics


--------------------------------------------------------------------------------
-- Inliner
--------------------------------------------------------------------------------

instance Generic Logic where
  type Rep Logic = D1 D1Logic
                     (C1 C1_0Logic U1 :+:
                     (C1 C1_1Logic U1 :+:
                      C1 C1_2Logic (S1 NoSelector (Rec0 Logic))))
  {-# INLINE from #-}
  from T = M1 (L1 (M1 U1))
  from F = M1 (R1 (L1 (M1 U1)))
  from (Not g1_aBc) = M1 (R1 (R1 (M1 (M1 (K1 g1_aBc)))))
  {-# INLINE to #-}
  to (M1 (L1 (M1 U1))) = T
  to (M1 (R1 (L1 (M1 U1)))) = F
  to (M1 (R1 (R1 (M1 (M1 (K1 g1_aBd)))))) = Not g1_aBd

instance Datatype D1Logic where
  datatypeName _ = "Logic"
  moduleName _ = "Bug"

instance Constructor C1_0Logic where
  conName _ = "T"

instance Constructor C1_1Logic where
  conName _ = "F"

instance Constructor C1_2Logic where
  conName _ = "Not"

data D1Logic
data C1_0Logic
data C1_1Logic
data C1_2Logic
data S1_2_0Logic


data Logic = T | F
           | Not Logic
--         | And Logic Logic
  deriving (Show)

instance GEq Logic

testEqLogic = geq (Not T) (Not F)


--------------------------------------------------------------------------------
-- Generic show (library code, only here to simplify the test case)
--------------------------------------------------------------------------------

class GEq' f where
  geq' :: f a -> f a -> Bool

instance GEq' U1 where
  {-# INLINE geq' #-}
  geq' _ _ = True

instance (GEq c) => GEq' (K1 i c) where
  {-# INLINE geq' #-}
  geq' (K1 a) (K1 b) = geq a b

instance (GEq' a) => GEq' (M1 i c a) where
  {-# INLINE geq' #-}
  geq' (M1 a) (M1 b) = geq' a b

instance (GEq' a, GEq' b) => GEq' (a :+: b) where
  {-# INLINE geq' #-}
  geq' (L1 a) (L1 b) = geq' a b
  geq' (R1 a) (R1 b) = geq' a b
  geq' _      _      = False

instance (GEq' a, GEq' b) => GEq' (a :*: b) where
  {-# INLINE geq' #-}
  geq' (a1 :*: b1) (a2 :*: b2) = geq' a1 a2 && geq' b1 b2


class GEq a where
  geq :: a -> a -> Bool

  {-# INLINE geq #-}
  default geq :: (Generic a, GEq' (Rep a)) => a -> a -> Bool
  geq x y = geq' (from x) (from y)