{-# Language UndecidableInstances, DataKinds, TypeOperators, PolyKinds,
             TypeFamilies, GADTs, LambdaCase, ScopedTypeVariables #-}

module T14556 where

import Data.Kind
import Data.Proxy

data Fn a b where
  IdSym :: Fn Type Type

type family
  (@@) (f::Fn k k') (a::k)::k' where
  IdSym @@ a = a

data KIND = X | FNARR KIND KIND

data TY :: KIND -> Type where
  ID    :: TY (FNARR X X)
  FNAPP :: TY (FNARR k k') -> TY k -> TY k'

data TyRep (kind::KIND) :: TY kind -> Type where
  TID    :: TyRep (FNARR X X)  ID
  TFnApp :: TyRep (FNARR k k') f
         -> TyRep k            a
         -> TyRep k'           (FNAPP f a)

type family
  IK (kind::KIND) :: Type where
  IK X            = Type
  IK (FNARR k k') = Fn (IK k) (IK k')

type family
  IT (ty::TY kind) :: IK kind where
  IT ID          = IdSym
  IT (FNAPP f x) = IT f @@ IT x

zero :: TyRep X a -> IT a
zero = undefined


{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeOperators #-}
module T14720 where

import Data.Kind (Type)
import Data.Type.Equality ((:~:)(..), sym, trans)
import Data.Void

data family Sing (z :: k)

class Generic (a :: Type) where
    type Rep a :: Type
    from :: a -> Rep a
    to :: Rep a -> a

class PGeneric (a :: Type) where
  type PFrom (x :: a)     :: Rep a
  type PTo   (x :: Rep a) :: a

class SGeneric k where
  sFrom :: forall (a :: k).     Sing a -> Sing (PFrom a)
  sTo   :: forall (a :: Rep k). Sing a -> Sing (PTo a :: k)

class (PGeneric k, SGeneric k) => VGeneric k where
  sTof  :: forall (a :: k).     Sing a -> PTo (PFrom a) :~: a
  sFot  :: forall (a :: Rep k). Sing a -> PFrom (PTo a :: k) :~: a

data Decision a = Proved a
                | Disproved (a -> Void)

class SDecide k where
  (%~) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Decision (a :~: b)
  default (%~) :: forall (a :: k) (b :: k). (VGeneric k, SDecide (Rep k))
               => Sing a -> Sing b -> Decision (a :~: b)
  s1 %~ s2 = case sFrom s1 %~ sFrom s2 of
    Proved (Refl :: PFrom a :~: PFrom b) ->
      case (sTof s1, sTof s2) of
          (Refl, Refl) -> Proved Refl
    Disproved contra -> Disproved (\Refl -> contra Refl)


{-# LANGUAGE ExplicitForAll, PolyKinds, TypeFamilies, DataKinds #-}

module T14729 where

import Data.Kind

data P k :: k -> Type

type family F a
type instance F Int = Bool

x :: forall (x :: Bool). P (F Int) x
x = undefined

y = x


{-# LANGUAGE GADTs, TypeOperators, DataKinds, TypeFamilies, PolyKinds #-}

module T14749 where

import Data.Kind

data KIND = STAR | KIND :> KIND

data Ty :: KIND -> Type where
  TMaybe :: Ty (STAR :> STAR)
  TApp   :: Ty (a :> b) -> (Ty a -> Ty b)

type family IK (k :: KIND) = (res :: Type) where
  IK STAR   = Type
  IK (a:>b) = IK a -> IK b

type family I (t :: Ty k) = (res :: IK k)  where
  I TMaybe     = Maybe
  I (TApp f a) = (I f) (I a)

data TyRep (k :: KIND) (t :: Ty k) where
  TyMaybe :: TyRep (STAR:>STAR) TMaybe
  TyApp   :: TyRep (a:>b) f -> TyRep a x -> TyRep b (TApp f x)

zero :: TyRep STAR a -> I a
zero x = case x of
            TyApp TyMaybe _ -> Nothing


{-# Language PolyKinds, DataKinds, KindSignatures, GADTs, TypeInType, ConstraintKinds #-}
{-# Language FlexibleContexts #-}
{-# Language RankNTypes #-}
{-# Language TypeOperators #-}
module T14845 where

import Data.Kind
import Data.Type.Equality

data A :: Type -> Type where
  MkA1 :: a ~  Int => A a
  MkA2 :: a ~~ Int => A a

data SA :: forall a. A a -> Type where
  SMkA1 :: SA MkA1
  SMkA2 :: SA MkA2


{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE PartialTypeSignatures #-}
module Bug where

import Data.Kind
import Data.Proxy

data Foo (x :: Type) :: forall (a :: x). Proxy a -> Type

quux :: forall arg. Proxy (Foo arg) -> ()
quux (_ :: _) = ()


{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeInType #-}
module Bug where

import Data.Kind
import Data.Proxy

data Foo (x :: Type) :: forall (a :: x). Proxy a -> Type

data Bar :: Type -> Type where
    MkBar :: forall x arg.
             -- Commenting out the line below makes the issue go away
             Foo arg ~ Foo arg =>
             Bar x


{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module T14991 where

import Data.Kind

type family Promote (k :: Type) :: Type
type family PromoteX (a :: k) :: Promote k

type family Demote (k :: Type) :: Type
type family DemoteX (a :: k) :: Demote k

-----
-- Type
-----

type instance Demote Type = Type
type instance Promote Type = Type

type instance DemoteX (a :: Type) = Demote a
type instance PromoteX (a :: Type) = Promote a

-----
-- Arrows
-----

data TyFun :: Type -> Type -> Type
type a ~> b = TyFun a b -> Type
infixr 0 ~>

type instance Demote  (a ~> b) = DemoteX  a -> DemoteX  b
type instance Promote (a -> b) = PromoteX a ~> PromoteX b


{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE PartialTypeSignatures #-}
module Bug where

import Data.Kind
import Data.Proxy

foo :: forall (a :: Type)
              (f :: forall (x :: a). Proxy x -> Type).
       Proxy f -> ()
foo (_ :: _) = ()


{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeInType #-}
module Bug where

import Data.Kind
import Data.Proxy

foo :: forall (a :: Type)
              (f :: forall (x :: a). Proxy x -> Type).
       Proxy f -> ()
foo _ = ()


{-# LANGUAGE PolyKinds, MultiParamTypeClasses, GADTs, ScopedTypeVariables,
             TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module Super where

import Data.Kind
import Data.Proxy
import GHC.Prim

class (a ~ b) => C a b
data SameKind :: k -> k -> Type where
  SK :: SameKind a b

bar :: forall (a :: Type) (b :: Type). C a b => Proxy a -> Proxy b -> ()
bar _ _ = const () (undefined :: forall (x :: a) (y :: b). SameKind x y)


{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeApplications #-}
module T15346 where

import Data.Kind
import Data.Proxy

-----

type family Rep (a :: Type) :: Type
type instance Rep () = ()

type family PFrom (x :: a) :: Rep a

-----

class SDecide k where
  test :: forall (a :: k). Proxy a

instance SDecide () where
  test = undefined

test1 :: forall k (a :: k). SDecide (Rep k) => Proxy a
test1 = seq (test @_ @(PFrom a)) Proxy

test2 :: forall (a :: ()). Proxy a
test2 = test1


{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE UndecidableInstances #-}
module T15419 where

import Data.Kind

data Prod a b
data Proxy p = Proxy

-----

data family Sing :: forall k. k -> Type
data instance Sing x = STuple

-----

type family Rep1 (f :: k -> Type) :: k -> Type
type instance Rep1 ((,) a) = Prod a

type family From1 (f :: Type -> Type) a (z :: f a) :: Rep1 f a
type family To1 (f :: Type -> Type) a (z :: Rep1 f a) :: f a

class Generic1 (f :: Type -> Type) where
  sFrom1 :: forall (a :: Type) (z :: f a).      Proxy z -> Sing (From1 f a z)
  sTo1   :: forall (a :: Type) (r :: Rep1 f a). Proxy r -> Proxy (To1 f a r :: f a)

instance Generic1 ((,) a) where
  sFrom1 Proxy = undefined
  sTo1   Proxy = undefined

-----

type family Fmap (g :: b) (x :: f a) :: f b
type instance Fmap (g :: b) (x :: (u, a)) = To1 ((,) u) b (Fmap g (From1 ((,) u) a x))

class PFunctor (f :: Type -> Type) where
  sFmap         :: forall a b (g :: b) (x :: f a).
                   Proxy g -> Sing x -> Proxy (Fmap g x)

instance PFunctor (Prod a) where
  sFmap _ STuple = undefined

sFmap1 :: forall (f :: Type -> Type) (u :: Type) (b :: Type) (g :: b) (x :: f u).
                 (Generic1 f,
                  PFunctor (Rep1 f),
                  Fmap g x ~ To1 f b (Fmap g (From1 f u x)) )
              => Proxy g -> Proxy x -> Proxy (Fmap g x)
sFmap1 sg sx = sTo1 (sFmap sg (sFrom1 sx))

sFmap2  :: forall (p :: Type) (a :: Type) (b :: Type) (g :: b) (x :: (p, a)).
          Proxy g -> Proxy x -> Proxy (Fmap g x)
sFmap2 = sFmap1


{-# LANGUAGE
  NoImplicitPrelude,
  TypeInType, PolyKinds, DataKinds,
  ScopedTypeVariables,
  TypeFamilies,
  UndecidableInstances
#-}

module T15666 where

import Data.Kind(Type)

data PolyType k (t :: k)

type Wrap (t :: k) = PolyType k t
type Unwrap pt = (GetType pt :: GetKind pt)

type family GetKind (pt :: Type) :: Type where
  GetKind (PolyType k t) = k

type family GetType (pt :: Type) :: k where
  GetType (PolyType k t) = t

data Composite :: a -> b -> Type

type family RecursiveWrap expr where
  RecursiveWrap (Composite a b) =
    Wrap (Composite (Unwrap (RecursiveWrap a)) (Unwrap (RecursiveWrap b)))
  RecursiveWrap x = Wrap x


{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module T15725 where

import Data.Functor.Identity (Identity(..))
import Data.Kind (Type)
import GHC.Exts (Any)

-----
-- The important bits
-----

type instance Meth (x :: Identity a) = GenericMeth x
instance SC Identity

-------------------------------------------------------------------------------

data family Sing :: forall k. k -> Type
data instance Sing :: forall a. Identity a -> Type where
  SIdentity :: Sing x -> Sing ('Identity x)

newtype Par1 p = Par1 p
data instance Sing :: forall p. Par1 p -> Type where
  SPar1 :: Sing x -> Sing ('Par1 x)

type family Rep1 (f :: Type -> Type) :: Type -> Type

class PGeneric1 (f :: Type -> Type) where
  type From1 (z :: f a)      :: Rep1 f a
  type To1   (z :: Rep1 f a) :: f a

class SGeneric1 (f :: Type -> Type) where
  sFrom1 :: forall (a :: Type) (z :: f a).      Sing z -> Sing (From1 z)
  sTo1   :: forall (a :: Type) (r :: Rep1 f a). Sing r -> Sing (To1 r :: f a)

type instance Rep1 Identity = Par1

instance PGeneric1 Identity where
  type From1 ('Identity x) = 'Par1 x
  type To1   ('Par1 x)     = 'Identity x

instance SGeneric1 Identity where
  sFrom1 (SIdentity x) = SPar1 x
  sTo1 (SPar1 x) = SIdentity x

type family GenericMeth (x :: f a) :: f a where
  GenericMeth x = To1 (Meth (From1 x))

type family Meth (x :: f a) :: f a

class SC f where
  sMeth         :: forall a (x :: f a).
                   Sing x -> Sing (Meth x)
  default sMeth :: forall a (x :: f a).
                   ( SGeneric1 f, SC (Rep1 f)
                   , Meth x ~ GenericMeth x
                   )
                => Sing x -> Sing (Meth x)
  sMeth sx = sTo1 (sMeth (sFrom1 sx))

  dummy :: f a -> ()
  dummy _ = ()

type instance Meth (x :: Par1 p) = x
instance SC Par1 where
  sMeth x = x


{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies #-}

module T15743 where

import Data.Proxy

data T (b :: Proxy (k2 :: k)) c (a :: k)


{-# LANGUAGE RankNTypes, PolyKinds, DataKinds, GADTs #-}

module T15743e where

import Data.Proxy
import Data.Kind

-- NO CUSK.
data T k (a :: k) (b :: Proxy k2) f c :: forall k3. Proxy k3 -> forall (k4 :: k5). Proxy k4 -> Type where
  MkT :: f c -> T k a b f c d e

-- Want:
-- T :: forall {k3} {k7} {k6} (k2 :: k3) (k5 :: Type).
--      forall k -> k -> Proxy k2 -> (k7 -> Type) -> k4 ->
--      forall (k3 :: k6). Proxy k3 -> forall (k4 :: k5). Proxy k4 -> Type
--
--

-- CUSK
data T2 (k :: Type) (a :: k) (b :: Proxy k2) (f :: k7 -> Type) (c :: k7) :: forall k3. Proxy k3 -> forall k5 (k4 :: k5). Proxy k4 -> Type where
  MkT2 :: f c -> T2 k a b f c d e


{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
module T15829 where

import Data.Kind

data A :: Type -> Type
data B a :: A a -> Type
type C a = B a


{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UnicodeSyntax #-}
module T16326_Compile1 where

import Data.Kind

type DApply a (b :: a -> Type) (f :: forall (x :: a) -> b x) (x :: a) =
  f x

type DComp a
           (b :: a -> Type)
           (c :: forall (x :: a). b x -> Type)
           (f :: forall (x :: a). forall (y :: b x) -> c y)
           (g :: forall (x :: a) -> b x)
           (x :: a) =
  f (g x)

type family ElimList a
                     (p :: [a] -> Type)
                     (s :: [a])
                     (pNil :: p '[])
                     (pCons :: forall (x :: a) (xs :: [a]) -> p xs -> p (x:xs))
                  :: p s where
  forall a p pNil (pCons :: forall (x :: a) (xs :: [a]) -> p xs -> p (x:xs)).
    ElimList a p '[] pNil pCons =
      pNil
  forall a p x xs pNil (pCons :: forall (x :: a) (xs :: [a]) -> p xs -> p (x:xs)).
    ElimList a p (x:xs) pNil pCons =
      pCons x xs (ElimList a p xs pNil pCons)

data Proxy' :: forall k -> k -> Type where
  MkProxy' :: forall k (a :: k). Proxy' k a

type family Proxy2' âˆ· âˆ€ k â†’ k â†’ Type where
  Proxy2' = Proxy'


{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module T16326_Compile2 where

import Data.Kind

type family Wat :: forall a. a
type Lol = Wat @(forall a -> a) (forall a -> a) (forall a. a) @(forall a. a)
               Type Bool


{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
module T16391a where

import Data.Kind

type Const (a :: Type) (b :: Type) = a
type family F :: Const Type a where
  F = Int
type TS = (Int :: Const Type a)
data T1 :: Const Type a where
  MkT1 :: T1
data T2 :: Const Type a -> Type where
  MkT2 :: T2 b


{-# LANGUAGE DataKinds, PolyKinds #-}

module T9632 where

import Data.Kind

data B = T | F
data P :: B -> Type

type B' = B
data P' :: B' -> Type


{-# LANGUAGE DataKinds, PolyKinds, UnicodeSyntax, GADTs, NoImplicitPrelude,
             TypeOperators, TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}

module TypeLevelVec where

import Data.Kind

data â„• âˆ· Type where
  O âˆ· â„•
  S âˆ· â„• â†’ â„•

type family x + y where
  O   + n = n
  S m + n = S (m + n)
infixl 5 +

data Vec âˆ· â„• â†’ Type â†’ Type where
  Nil  âˆ· Vec O a
  (:>) âˆ· a â†’ Vec n a â†’ Vec (S n) a
infixr 8 :>

type family (x âˆ· Vec n a) ++ (y âˆ· Vec m a) âˆ· Vec (n + m) a where
  Nil       ++ y = y
  (x :> xs) ++ y = x :> (xs ++ y)
infixl 5 ++


{-# LANGUAGE DataKinds, PolyKinds #-}

module BadTelescope where

import Data.Kind

data SameKind :: k -> k -> *

data X a k (b :: k) (c :: SameKind a b)


{-# LANGUAGE DataKinds, PolyKinds, ExplicitForAll #-}

module BadTelescope2 where

import Data.Kind
import Data.Proxy

data SameKind :: k -> k -> *

foo :: forall a k (b :: k). SameKind a b
foo = undefined

bar :: forall a k (b :: k) (c :: Proxy b) (d :: Proxy a). Proxy c -> SameKind b d
bar = undefined


{-# LANGUAGE PolyKinds, ExplicitForAll #-}

module BadTelescope3 where

import Data.Kind

data SameKind :: k -> k -> *

type S a k (b :: k) = SameKind a b


{-# LANGUAGE ExistentialQuantification, DataKinds, PolyKinds #-}
module BadTelescope4 where

import Data.Proxy
import Data.Kind

data SameKind :: k -> k -> *

data Bad a (c :: Proxy b) (d :: Proxy a) (x :: SameKind b d)

data Borked a (b :: k) = forall (c :: k). B (Proxy c)
  -- this last one is OK. But there was a bug involving renaming
  -- that failed here, so the test case remains.


{-# LANGUAGE PolyKinds #-}

module DepFail1 where

data Proxy k (a :: k) = P

z :: Proxy Bool
z = P

a :: Proxy Int Bool
a = P


{-# LANGUAGE DataKinds, GADTs #-}

module PromotedClass where

import Data.Proxy

data X a where
  MkX :: Show a => a -> X a

foo :: Proxy ('MkX 'True)
foo = Proxy


{-# LANGUAGE TemplateHaskell, RankNTypes, TypeOperators, DataKinds,
             PolyKinds, TypeFamilies, GADTs #-}

module RAE_T32a where

import Data.Kind

data family Sing (k :: Type) :: k -> Type

data TyArr' (a :: Type) (b :: Type) :: Type
type TyArr (a :: Type) (b :: Type) = TyArr' a b -> Type
type family (a :: TyArr k1 k2) @@ (b :: k1) :: k2
data TyPi' (a :: Type) (b :: TyArr a Type) :: Type
type TyPi (a :: Type) (b :: TyArr a Type) = TyPi' a b -> Type
type family (a :: TyPi k1 k2) @@@ (b :: k1) :: k2 @@ b
$(return [])

data MkStar (p :: Type) (x :: TyArr' p Type)
type instance MkStar p @@ x = Type
$(return [])

data Sigma (p :: Type) (r :: TyPi p (MkStar p)) :: Type where
  Sigma ::
    forall (p :: Type) (r :: TyPi p (MkStar p)) (a :: p) (b :: r @@@ a).
    Sing Type p -> Sing (TyPi p (MkStar p)) r -> Sing p a ->
    Sing (r @@@ a) b -> Sigma p r
$(return [])

data instance Sing Sigma (Sigma p r) x where
  SSigma ::
    forall (p :: Type) (r :: TyPi p (MkStar p)) (a :: p) (b :: r @@@ a)
           (sp :: Sing Type p) (sr :: Sing (TyPi p (MkStar p)) r)
           (sa :: Sing p a) (sb :: Sing (r @@@ a) b).
    Sing (Sing (r @@@ a) b) sb ->
    Sing (Sigma p r) ('Sigma sp sr sa sb)

-- I (RAE) believe this last definition is ill-typed.


{-# LANGUAGE KindSignatures, NoStarIsType #-}

module RenamingStar where

data Foo :: *


{-# LANGUAGE KindSignatures #-}

module SelfDep where

data T :: T -> *


{-# LANGUAGE DataKinds, NoPolyKinds #-}

module T11334b where

import Data.Functor.Compose
import Data.Proxy

p = Proxy :: Proxy 'Compose


{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds, PolyKinds #-}
module T11407 where

import Data.Kind

type Const a b = a

data family UhOh (f :: k1) (a :: k2) (b :: k3)
data instance UhOh (f :: * -> * -> *) (a :: x a) (b :: Const * a) = UhOh


{-# LANGUAGE MagicHash, PolyKinds, TypeFamilies, AllowAmbiguousTypes #-}

module T11471 where

import GHC.Exts
import Data.Proxy

type family F a :: k

type instance F Int = Int#

f :: Proxy a -> F a -> F a
f _ x = x

bad = f (undefined :: Proxy Int#) 3#


{-# LANGUAGE PolyKinds, TypeFamilies, MagicHash, DataKinds, RankNTypes #-}

module T11473 where

import GHC.Exts
import GHC.Types

type family Boxed (a :: k) :: *
type instance Boxed Char# = Char
type instance Boxed Char  = Char

class BoxIt (a :: TYPE lev) where
    boxed :: a -> Boxed a

instance BoxIt Char# where boxed x = C# x
instance BoxIt Char  where boxed = id

hello :: forall (r :: RuntimeRep). forall (a :: TYPE r). BoxIt a => a -> Boxed a
hello x = boxed x
{-# NOINLINE hello #-}

main :: IO ()
main = do
    print $ boxed 'c'#
    print $ boxed 'c'
    print $ hello 'c'
    print $ hello 'c'#


{-# LANGUAGE DataKinds, PolyKinds #-}

module T12081 where

data Nat = Z | S Nat

class C (n :: Nat) where
  type T n :: Nat
  f :: (a :: T n)


{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE KindSignatures #-}
module T12174 where

data V a
data T = forall (a :: S). MkT (V a)
data S = forall (a :: T). MkS (V a)


{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilyDependencies #-}

module T13135 where

import Data.Kind (Type)

class sub :<: sup
  where
    -- | Injection from @sub@ to @sup@
    inj ::  sub sig -> sup sig

instance (sub :<: sup) => (sub :<: AST sup)
  where
    inj = Sym . inj

data Sig a = Full a | (:->) a (Sig a)

infixr :->

type Sym t = (Sig t -> Type)

data AST :: Sym t -> Sym t
  where
    Sym  :: sym sig -> AST sym sig
    (:$) :: AST sym (a :-> sig) -> AST sym (Full a) -> AST sym sig

-- | Generic N-ary syntactic construct
--
-- 'Construct' gives a quick way to introduce a syntactic construct by giving its name and semantic
-- function.
data Constr sig = Constr String

smartSym :: (sub :<: sup) => sub sig -> SmartFun sup sig
smartSym = error "urk"

type family   SmartFun (sym :: Sig t -> Type) sig = f | f -> sym sig  where
-- In full glory:
-- type family SmartFun {t} (sym :: Sig t -> Type) (sig :: Sig t) :: *
--            = f | f -> {t} sym sig  where
  SmartFun sym (Full a)    = AST sym (Full a)
  SmartFun sym (a :-> sig) = AST sym (Full a) -> SmartFun sym sig

-- | Get the length of an array
arrLen ::  AST Constr (Full [a]) -> AST Constr (Full Int)
arrLen = smartSym sym where
  sym = Constr "arrLen"

{- The original bug was a failure to substitute
   properly during type-function improvement.

--------------------------------------
doTopReact
  [WD] hole{a1y1} {0}:: (SmartFun
                           t_a1x9[tau:2] sup_a1xb[tau:2] sig_a1xc[tau:2] :: *)
                        GHC.Prim.~#
                        (s_a1y0[fuv:0] :: *) (CFunEqCan)
matchFamTcM
  Matching: SmartFun t_a1x9[tau:2] sup_a1xb[tau:2] sig_a1xc[tau:2]
  Match failed
improveTopFunEqs
  SmartFun [t_a1x9[tau:2], sup_a1xb[tau:2],
            sig_a1xc[tau:2]] s_a1y0[fuv:0]
  [* ~ t_a1x9[tau:2], Constr (Sig *) ~ sup_a1xb[tau:2],
   (':->) * [a_a1wT[sk:2]] sig_a1y3[tau:2] ~ sig_a1xc[tau:2]]

Emitting new derived equality
  [D] _ {0}:: (* :: *) GHC.Prim.~# (t_a1x9[tau:2] :: *)
  [D] _ {0}:: (Constr (Sig *) :: (Sig * -> *))
                GHC.Prim.~#
              (sup_a1xb[tau:2] :: (Sig t_a1x9[tau:2] -> *))
  [D] _ {0}:: ((':->) * [a_a1wT[sk:2]] sig_a1y3[tau:2] :: Sig *)
              GHC.Prim.~#
              (sig_a1xc[tau:2] :: Sig t_a1x9[tau:2])

but sig_a1y3 :: Sig t   BAD
--------------------------------------

Instance
  forall t (sig :: Sig t) (a :: t) (sym :: Sig t -> *).
    SmartFun t sym ((:->) t a sig) = AST t sym (Full t a) -> SmartFun t sym sig

Wanted:
  SmartFun t_a1x9[tau:2] sup_a1xb[tau:2] sig_a1xc[tau:2] ~ s_a1y0[fuv:0]
  s_a1y0[fuv:0]  ~  AST * (Constr (Sig *))
                          ('Full * [a_a1wT[sk:2]])
                    -> AST * (Constr (Sig *)) ('Full * Int)

Substitution after matching RHSs
  [ t -> *
  , (sym :: Sig t -> *) -> Constr (Sig *)
  , a -> a_a1wT ]

add sig -> sig0 :: Sig t   -- Or rather Sig *

Apply to LHS

   SmartFun * (Constr (Sig *)) ((:->) * a_a1wT sig0)

improveTopFunEqs
  SmartFun [t_a1x9[tau:2], sup_a1xb[tau:2],
            sig_a1xc[tau:2]] s_a1y0[fuv:0]
  [* ~ t_a1x9[tau:2], Constr (Sig *) ~ sup_a1xb[tau:2],
   (':->) * [a_a1wT[sk:2]] sig_a1y3[tau:2] ~ sig_a1xc[tau:2]]
-}


{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds #-}

import GHC.Exts
import Prelude (Bool(True,False),Integer,Ordering,undefined)
import qualified Prelude
import Data.Kind

--------------------
-- class hierarchy

type family
  Rep (rep :: RuntimeRep) :: RuntimeRep where
  -- Rep IntRep         = IntRep
  -- Rep DoubleRep      = IntRep
  -- Rep PtrRepUnlifted = IntRep
  -- Rep PtrRepLifted   = PtrRepLifted

class Boolean (Logic a) => Eq (a :: TYPE rep) where
  type Logic (a :: TYPE rep) :: TYPE (Rep rep)
  (==) :: a -> a -> Logic a

class Eq a => POrd (a :: TYPE rep) where
  inf :: a -> a -> a

class POrd a => MinBound (a :: TYPE rep) where
  minBound :: () -> a

class POrd a => Lattice (a :: TYPE rep) where
  sup :: a -> a -> a

class (Lattice a, MinBound a) => Bounded (a :: TYPE rep) where
  maxBound :: () -> a

class Bounded a => Complemented (a :: TYPE rep) where
  not :: a -> a

class Bounded a => Heyting (a :: TYPE rep) where
  infixr 3 ==>
  (==>) :: a -> a -> a

class (Complemented a, Heyting a) => Boolean a

(||) :: Boolean a => a -> a -> a
(||) = sup

(&&) :: Boolean a => a -> a -> a
(&&) = inf


{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds, PolyKinds #-}
module T13780a where

data family Sing (a :: k)

data Foo a = a ~ Bool => MkFoo
data instance Sing (z :: Foo a) = (z ~ MkFoo) => SMkFoo


{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
module T13780b where

data family Sing (a :: k)

data instance Sing (z :: Bool) =
    z ~ False => SFalse
  | z ~ True  => STrue


{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds, PolyKinds #-}
module T13780c where

import Data.Kind
import T13780b

type family ElimBool (p :: Bool -> Type) (b :: Bool) (s :: Sing b)
                     (pFalse :: p False) (pTrue :: p True) :: p b where
  ElimBool _ _ SFalse pFalse _ = pFalse
  ElimBool _ _ STrue  _ pTrue  = pTrue


{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeInType #-}
module T13895 where

import Data.Data (Data, Typeable)
import Data.Kind

dataCast1 :: forall (a :: Type).
             Data a
          => forall (c :: Type -> Type)
                    (t :: forall (k :: Type). Typeable k => k -> Type).
             Typeable t
          => (forall d. Data d => c (t d))
          -> Maybe (c a)
dataCast1 _ = undefined


{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PolyKinds #-}

module T14066 where

import Data.Kind ( Type )
import Data.Type.Equality
import Data.Proxy
import GHC.Exts

data SameKind :: k -> k -> Type

f (x :: Proxy a) = let g :: forall k (b :: k). SameKind a b
                       g = undefined
                   in ()


{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds, UndecidableInstances #-}

module T14066c where

type family H a b where
  H a b = H b a

type X = H True Nothing  -- this should fail to kind-check.
                         -- if it's accepted, then we've inferred polymorphic recursion for H


{-# LANGUAGE RankNTypes, ScopedTypeVariables, PolyKinds #-}

module T14066d where

import Data.Proxy

g :: (forall c b (a :: c). (Proxy a, Proxy c, b)) -> ()
g _ = ()

f :: forall b. b -> (Proxy Maybe, ())
f x = (fstOf3 y :: Proxy Maybe, g y)
  where
    y :: (Proxy a, Proxy c, b)  -- this should NOT generalize over b
                                -- meaning the call to g is ill-typed
    y = (Proxy, Proxy, x)

fstOf3 (x, _, _) = x


{-# LANGUAGE MonoLocalBinds, PolyKinds, ScopedTypeVariables #-}

module T14066e where

import Data.Proxy

-- this should fail because the dependency between b and c can't be
-- determined in the type signature
h :: forall a. a -> ()
h x = ()
  where
    j :: forall c b. Proxy a -> Proxy b -> Proxy c -> Proxy b
    j _ (p1 :: Proxy b') (p2 :: Proxy c') = (p1 :: Proxy (b' :: c'))


{-# LANGUAGE PolyKinds #-}

module T14066f where

import Data.Proxy

-- a can't come before k.
type P a k = Proxy (a :: k)


{-# LANGUAGE DataKinds, PolyKinds #-}

module T14066g where

import Data.Kind

data SameKind :: k -> k -> Type

data Q a (b :: a) (d :: SameKind c b)


{-# Language PolyKinds, DataKinds, KindSignatures, GADTs, TypeInType, ConstraintKinds #-}
module T14845_fail1 where

import Data.Kind

data Struct :: (k -> Constraint) -> (k -> Type) where
  S :: cls a => Struct cls a

data Foo a where
  F :: Foo (S::Struct Eq a)


{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeInType #-}
module T14845_fail2 where

import Data.Coerce
import Data.Kind

data A :: Type -> Type where
  MkA :: Coercible a Int => A a

data SA :: forall a. A a -> Type where
  SMkA :: SA MkA


{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeInType #-}
module T15215 where

import Data.Kind

data A :: Type -> Type where
  MkA :: Show (Maybe a) => A a

data B :: Type -> Type where
  MkB :: Show a => B a

data SA :: forall a. A a -> Type where
  SMkA :: SA MkA
  SMkB :: SA MkB


{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds, TypeApplications #-}

module T15245 where

import Type.Reflection

data family K
data instance K = MkK

main = print (typeRep @'MkK)


{-# LANGUAGE ExplicitForAll, PolyKinds #-}

module T15264 where

import Data.Proxy

bad1 :: forall (a :: k). Proxy a -> ()
bad1 _ = ()

bad2 :: forall (a :: k1) (b :: k2). Proxy a -> ()
bad2 _ = ()

good :: forall k (a :: k). Proxy a -> ()
good _ = ()


{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeInType #-}
module T15308 where

import Data.Kind

data Foo (a :: Type) :: forall b. (a -> b -> Type) -> Type where
  MkFoo :: Foo a f

f :: Foo a f -> String
f = show


{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeInType #-}
module T15343 where

import Data.Kind

elimSing :: forall (p :: forall z. z). p
elimSing = undefined

data WhySym :: Type -> Type

hsym = elimSing @WhySym


{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}

module T15380 where

import Data.Kind

class Generic a where
  type Rep a :: Type

class PGeneric a where
  type To a (x :: Rep a) :: a

type family MDefault (x :: a) :: a where
  MDefault x = To (M x)

class C a where
  type M (x :: a) :: a
  type M (x :: a) = MDefault x


{-# LANGUAGE PolyKinds, MultiParamTypeClasses, DataKinds, TypeFamilies #-}

module T15591b where

import Data.Proxy
import Data.Kind

class C2 (a :: Type) (b :: Proxy a) (c :: Proxy b) where
  type T4 a c


{-# LANGUAGE PolyKinds, MultiParamTypeClasses, DataKinds, TypeFamilies #-}

module T15591c where

import Data.Proxy
import Data.Kind

class C3 (a :: Type) (b :: Proxy a) (c :: Proxy b) where
  type T5 c a


{-# LANGUAGE PolyKinds, DataKinds, ExplicitForAll #-}

module T15743 where

import Data.Kind
import Data.Proxy

data SimilarKind :: forall (c :: k) (d :: k). Proxy c -> Proxy d -> Type

data T k (c :: k) (a :: Proxy c) b (x :: SimilarKind a b)
data T2 k (c :: k) (a :: Proxy c) (b :: Proxy d) (x :: SimilarKind a b)


{-# LANGUAGE PolyKinds, DataKinds, ExplicitForAll #-}

module T15743 where

import Data.Kind
import Data.Proxy

data SimilarKind :: forall (c :: k) (d :: k). Proxy c -> Proxy d -> Type

data T2 k (c :: k) (a :: Proxy c) (b :: Proxy d) (x :: SimilarKind a b)


{-# Language RankNTypes        #-}
{-# Language PolyKinds         #-}
{-# Language KindSignatures    #-}
{-# Language DataKinds         #-}
{-# Language FlexibleInstances #-}

{-# Options_GHC -dcore-lint #-}

module T15825 where

type C k = (forall (x::k). *)

class                         X (a :: *)
instance forall k (a :: C k). X (a :: *)


{-# Language PolyKinds          #-}
{-# Language TypeApplications   #-}
{-# Language ImpredicativeTypes #-}
{-# Language LiberalTypeSynonyms #-}

module T15859 where

import Data.Kind

data A k :: k -> Type

type KindOf (a :: k) = k

a = (undefined :: KindOf A) @Int


{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
module T16326_Fail1 where

id1 :: forall a -> a -> a
id1 _ x = x

type Foo = forall a -> a -> a
id2 :: Foo
id2 _ x = x


{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
module T16326_Fail10 where

import Data.Kind

type Const a b = a

flurmp :: a -> ()
flurmp _ = ()
{-# RULES "flurmp"
    forall (x :: forall a -> a -> a). flurmp x = () #-}


{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
module T16326_Fail11 where

class C a where
  m :: b -> a
  default m :: (forall x -> x) ~ b => b -> a
  m = undefined


{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
module T16326_Fail12 where

class (forall a -> Show a) => C a


{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
module T16326_Fail2 where

foreign import ccall "blah" blah :: forall a -> a -> IO ()


{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
module T16326_Fail3 where

pattern Nil :: forall a -> [a]
pattern Nil <- undefined


{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
module T16326_Fail4 where

foo :: Maybe a -> Maybe a -> Maybe a
foo xs ys = zipWith ((<>) :: forall a -> Maybe a -> Maybe a -> Maybe a) xs ys


{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module T16326_Fail5 where

isJust :: Maybe a -> Bool
isJust (Nothing :: forall a -> Maybe a) = False
isJust (Just _)                         = True


{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
module T16326_Fail6 where

import Data.Kind

data Foo :: Type -> Type where
  MkFoo :: forall a -> a -> Foo a


{-# LANGUAGE PolyKinds #-}
module T16326_Fail7 where

import Data.Kind

-- Make sure that this doesn't parse as something goofy like
--  forall (forall :: Type -> Type) (k :: Type). forall k -> k -> Type
data Foo :: forall k -> k -> Type


{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
module T16326_Fail8 where

class C a
data Blah a
instance forall a -> C (Blah a)


{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
module T16326_Fail9 where

lol :: forall a. a
lol = undefined

t :: Bool
t = lol @(forall a -> a -> a) undefined True


{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
module T16391b where

import GHC.Exts

type family T (r :: RuntimeRep) :: TYPE r

foo :: T r
foo = foo


{-# LANGUAGE RankNTypes, PolyKinds #-}
-- NB: -fprint-explicit-runtime-reps enabled in all.T

module TypeSkolEscape where

import GHC.Types
import GHC.Exts

type Bad = forall (v :: RuntimeRep) (a :: TYPE v). a


module T11311 where

import Data.Kind

foo :: ()
foo = (id :: Type -> Type) undefined `seq` ()

main = print foo


module T11964 where

import Data.Kind
import T11964a

t1 :: T Type Int
t1 = T ()

t2 :: T Star Int
t2 = T ()


{-# LANGUAGE PolyKinds #-}
module T11964a where
import Data.Kind
type Star = Type
newtype T k (t :: k) = T ()


{-# LANGUAGE MagicHash #-}

import GHC.Prim

data TestData = First Int Double String Int Int Int Int
              | Second Char# Int# Word# Double#
              | Third TestData TestData TestData TestData
              deriving (Eq, Ord)

main = return ()


{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE PolyKinds          #-}

module AutoDeriveTypeable where

import Data.Typeable

data A = A

data B = B deriving Typeable

data C = C
deriving instance Typeable C

test = [ typeRep [A], typeRep [B], typeRep [C]
       , typeRep (Proxy :: Proxy 'B), typeRep (Proxy :: Proxy 'C)]


{-# OPTIONS_GHC -XDeriveDataTypeable #-}

-- Trac #1935
-- See Note [Superclasses of derived instance] in TcDeriv

{-# OPTIONS -fno-warn-redundant-constraints #-}

module Foo where

 import Data.Data

 data Foo a = Foo
    deriving (Data, Typeable)

 data T a = MkT (S a) deriving( Ord )

 instance Num a => Eq (T a)

 data S a = S
 instance Eq (S a)
 instance Ord (S a)


{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
module DerivingViaCompile where

import Data.Void
import Data.Complex
import Data.Functor.Const
import Data.Functor.Identity
import Data.Ratio
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Writer
import Control.Applicative hiding (WrappedMonad(..))

import Data.Bifunctor
import Data.Monoid
import Data.Kind

type f ~> g = forall xx. f xx -> g xx

-----
-- Simple example
-----

data Foo a = MkFoo a a
  deriving Show
       via (Identity (Foo a))

-----
-- Eta reduction at work
-----

newtype Flip p a b = Flip { runFlip :: p b a }

instance Bifunctor p => Bifunctor (Flip p) where
  bimap f g = Flip . bimap g f . runFlip

instance Bifunctor p => Functor (Flip p a) where
  fmap f = Flip . first f . runFlip

newtype Bar a = MkBar (Either a Int)
  deriving Functor
       via (Flip Either Int)

-----
-- Monad transformers
-----

type MTrans = (Type -> Type) -> (Type -> Type)

-- From `constraints'
data Dict c where
  Dict :: c => Dict c

newtype a :- b = Sub (a => Dict b)

infixl 1 \\
(\\) :: a => (b => r) -> (a :- b) -> r
r \\ Sub Dict = r

-- With `-XQuantifiedConstraints' this just becomes
--
--    type Lifting cls  trans = forall mm. cls mm => cls (trans mm)
--
--    type LiftingMonad trans = Lifting Monad trans
--
class LiftingMonad (trans :: MTrans) where
  proof :: Monad m :- Monad (trans m)

instance LiftingMonad (StateT s :: MTrans) where
  proof :: Monad m :- Monad (StateT s m)
  proof = Sub Dict

instance Monoid w => LiftingMonad (WriterT w :: MTrans) where
  proof :: Monad m :- Monad (WriterT w m)
  proof = Sub Dict

instance (LiftingMonad trans, LiftingMonad trans') => LiftingMonad (ComposeT trans trans' :: MTrans) where
  proof :: forall m. Monad m :- Monad (ComposeT trans trans' m)
  proof = Sub (Dict \\ proof @trans @(trans' m) \\ proof @trans' @m)

newtype Stack :: MTrans where
  Stack :: ReaderT Int (StateT Bool (WriterT String m)) a -> Stack m a
  deriving newtype
    ( Functor
    , Applicative
    , Monad
    , MonadReader Int
    , MonadState Bool
    , MonadWriter String
    )
  deriving (MonadTrans, MFunctor)
       via (ReaderT Int `ComposeT` StateT Bool `ComposeT` WriterT String)

class MFunctor (trans :: MTrans) where
  hoist :: Monad m => (m ~> m') -> (trans m ~> trans m')

instance MFunctor (ReaderT r :: MTrans) where
  hoist :: Monad m => (m ~> m') -> (ReaderT r m ~> ReaderT r m')
  hoist nat = ReaderT . fmap nat . runReaderT

instance MFunctor (StateT s :: MTrans) where
  hoist :: Monad m => (m ~> m') -> (StateT s m ~> StateT s m')
  hoist nat = StateT . fmap nat . runStateT

instance MFunctor (WriterT w :: MTrans) where
  hoist :: Monad m => (m ~> m') -> (WriterT w m ~> WriterT w m')
  hoist nat = WriterT . nat . runWriterT

infixr 9 `ComposeT`
newtype ComposeT :: MTrans -> MTrans -> MTrans where
  ComposeT :: { getComposeT :: f (g m) a } -> ComposeT f g m a
  deriving newtype (Functor, Applicative, Monad)

instance (MonadTrans f, MonadTrans g, LiftingMonad g) => MonadTrans (ComposeT f g) where
  lift :: forall m. Monad m => m ~> ComposeT f g m
  lift = ComposeT . lift . lift
    \\ proof @g @m

instance (MFunctor f, MFunctor g, LiftingMonad g) => MFunctor (ComposeT f g) where
  hoist :: forall m m'. Monad m => (m ~> m') -> (ComposeT f g m ~> ComposeT f g m')
  hoist f = ComposeT . hoist (hoist f) . getComposeT
    \\ proof @g @m

-----
-- Using tuples in a `via` type
-----

newtype X a = X (a, a)
  deriving (Semigroup, Monoid)
       via (Product a, Sum a)

  deriving (Show, Eq)
       via (a, a)

-----
-- Abstract data types
-----

class C f where
  c :: f a -> Int

newtype X2 f a = X2 (f a)

instance C (X2 f) where
  c = const 0

deriving via (X2 IO) instance C IO

----
-- Testing parser
----

newtype P0 a = P0 a             deriving Show via a
newtype P1 a = P1 [a]           deriving Show via [a]
newtype P2 a = P2 (a, a)        deriving Show via (a, a)
newtype P3 a = P3 (Maybe a)     deriving Show via (First a)
newtype P4 a = P4 (Maybe a)     deriving Show via (First $ a)
newtype P5 a = P5 a             deriving Show via (Identity $ a)
newtype P6 a = P6 [a]           deriving Show via ([] $ a)
newtype P7 a = P7 (a, a)        deriving Show via (Identity $ (a, a))
newtype P8 a = P8 (Either () a) deriving Functor via (($) (Either ()))

newtype f $ a = APP (f a) deriving newtype Show deriving newtype Functor

----
-- From Baldur's notes
----

----
-- 1
----
newtype WrapApplicative f a = WrappedApplicative (f a)
  deriving (Functor, Applicative)

instance (Applicative f, Num a) => Num (WrapApplicative f a) where
  (+)         = liftA2 (+)
  (*)         = liftA2 (*)
  negate      = fmap negate
  fromInteger = pure . fromInteger
  abs         = fmap abs
  signum      = fmap signum

instance (Applicative f, Fractional a) => Fractional (WrapApplicative f a) where
  recip        = fmap recip
  fromRational = pure . fromRational

instance (Applicative f, Floating a) => Floating (WrapApplicative f a) where
  pi    = pure pi
  sqrt  = fmap sqrt
  exp   = fmap exp
  log   = fmap log
  sin   = fmap sin
  cos   = fmap cos
  asin  = fmap asin
  atan  = fmap atan
  acos  = fmap acos
  sinh  = fmap sinh
  cosh  = fmap cosh
  asinh = fmap asinh
  atanh = fmap atanh
  acosh = fmap acosh

instance (Applicative f, Semigroup s) => Semigroup (WrapApplicative f s) where
  (<>) = liftA2 (<>)

instance (Applicative f, Monoid m) => Monoid (WrapApplicative f m) where
  mempty = pure mempty

----
-- 2
----
class Pointed p where
  pointed :: a -> p a

newtype WrapMonad f a = WrappedMonad (f a)
  deriving newtype (Pointed, Monad)

instance (Monad m, Pointed m) => Functor (WrapMonad m) where
  fmap = liftM

instance (Monad m, Pointed m) => Applicative (WrapMonad m) where
  pure  = pointed
  (<*>) = ap

-- data
data Sorted a = Sorted a a a
  deriving (Functor, Applicative)
    via (WrapMonad Sorted)
  deriving (Num, Fractional, Floating, Semigroup, Monoid)
    via (WrapApplicative Sorted a)

instance Monad Sorted where
  (>>=) :: Sorted a -> (a -> Sorted b) -> Sorted b
  Sorted a b c >>= f = Sorted a' b' c' where
    Sorted a' _  _  = f a
    Sorted _  b' _  = f b
    Sorted _  _  c' = f c

instance Pointed Sorted where
  pointed :: a -> Sorted a
  pointed a = Sorted a a a

----
-- 3
----
class IsZero a where
  isZero :: a -> Bool

newtype WrappedNumEq  a = WrappedNumEq a
newtype WrappedShow   a = WrappedShow  a
newtype WrappedNumEq2 a = WrappedNumEq2 a

instance (Num a, Eq a) => IsZero (WrappedNumEq a) where
  isZero :: WrappedNumEq a -> Bool
  isZero (WrappedNumEq a) = 0 == a

instance Show a => IsZero (WrappedShow a) where
  isZero :: WrappedShow a -> Bool
  isZero (WrappedShow a) = "0" == show a

instance (Num a, Eq a) => IsZero (WrappedNumEq2 a) where
  isZero :: WrappedNumEq2 a -> Bool
  isZero (WrappedNumEq2 a) = a + a == a

newtype INT = INT Int
  deriving newtype Show
  deriving IsZero via (WrappedNumEq Int)

newtype VOID = VOID Void deriving IsZero via (WrappedShow Void)

----
-- 4
----
class Bifunctor p => Biapplicative p where
  bipure :: a -> b -> p a b

  biliftA2
    :: (a  -> b  -> c)
    -> (a' -> b' -> c')
    -> p a a'
    -> p b b'
    -> p c c'

instance Biapplicative (,) where
  bipure = (,)

  biliftA2 f f' (a, a') (b, b') =
    (f a b, f' a' b')

newtype WrapBiapp p a b = WrapBiap (p a b)
  deriving newtype (Bifunctor, Biapplicative, Eq)

instance (Biapplicative p, Num a, Num b) => Num (WrapBiapp p a b) where
  (+) = biliftA2 (+) (+)
  (-) = biliftA2 (*) (*)
  (*) = biliftA2 (*) (*)
  negate = bimap negate negate
  abs = bimap abs abs
  signum = bimap signum signum
  fromInteger n = fromInteger n `bipure` fromInteger n

newtype INT2 = INT2 (Int, Int)
  deriving IsZero via (WrappedNumEq2 (WrapBiapp (,) Int Int))

----
-- 5
----
class Monoid a => MonoidNull a where
  null :: a -> Bool

newtype WrpMonNull a = WRM a deriving (Eq, Semigroup, Monoid)

instance (Eq a, Monoid a) => MonoidNull (WrpMonNull a) where
  null :: WrpMonNull a -> Bool
  null = (== mempty)

deriving via (WrpMonNull Any) instance MonoidNull Any
deriving via ()               instance MonoidNull ()
deriving via Ordering         instance MonoidNull Ordering

----
-- 6
----
-- https://github.com/mikeizbicki/subhask/blob/f53fd8f465747681c88276c7dabe3646fbdf7d50/src/SubHask/Algebra.hs#L635

class Lattice a where
  sup   :: a -> a -> a
  (.>=) :: a -> a -> Bool
  (.>)  :: a -> a -> Bool

newtype WrapOrd a = WrappedOrd a
  deriving newtype (Eq, Ord)

instance Ord a => Lattice (WrapOrd a) where
  sup   = max
  (.>=) = (>=)
  (.>)  = (>)

deriving via [a]    instance Ord a          => Lattice [a]
deriving via (a, b) instance (Ord a, Ord b) => Lattice (a, b)
--mkLattice_(Bool)
deriving via Bool instance Lattice Bool
--mkLattice_(Char)
deriving via Char instance Lattice Char
--mkLattice_(Int)
deriving via Int instance Lattice Int
--mkLattice_(Integer)
deriving via Integer instance Lattice Integer
--mkLattice_(Float)
deriving via Float instance Lattice Float
--mkLattice_(Double)
deriving via Double instance Lattice Double
--mkLattice_(Rational)
deriving via Rational instance Lattice Rational

----
-- 7
----
-- https://hackage.haskell.org/package/linear-1.20.7/docs/src/Linear-Affine.html

class Functor f => Additive f where
  zero :: Num a => f a
  (^+^) :: Num a => f a -> f a -> f a
  (^+^) = liftU2 (+)
  (^-^) :: Num a => f a -> f a -> f a
  x ^-^ y = x ^+^ fmap negate y
  liftU2 :: (a -> a -> a) -> f a -> f a -> f a

instance Additive [] where
  zero = []
  liftU2 f = go where
    go (x:xs) (y:ys) = f x y : go xs ys
    go [] ys = ys
    go xs [] = xs

instance Additive Maybe where
  zero = Nothing
  liftU2 f (Just a) (Just b) = Just (f a b)
  liftU2 _ Nothing ys = ys
  liftU2 _ xs Nothing = xs

instance Applicative f => Additive (WrapApplicative f) where
  zero   = pure 0
  liftU2 = liftA2

deriving via (WrapApplicative ((->) a)) instance Additive ((->) a)
deriving via (WrapApplicative Complex)  instance Additive Complex
deriving via (WrapApplicative Identity) instance Additive Identity

instance Additive ZipList where
  zero = ZipList []
  liftU2 f (ZipList xs) (ZipList ys) = ZipList (liftU2 f xs ys)

class Additive (Diff p) => Affine p where
  type Diff p :: Type -> Type

  (.-.) :: Num a => p a -> p a -> Diff p a
  (.+^) :: Num a => p a -> Diff p a -> p a
  (.-^) :: Num a => p a -> Diff p a -> p a
  p .-^ v = p .+^ fmap negate v

-- #define ADDITIVEC(CTX,T) instance CTX => Affine T where type Diff T = T ; \
--   (.-.) = (^-^) ; {-# INLINE (.-.) #-} ; (.+^) = (^+^) ; {-# INLINE (.+^) #-} ; \
--   (.-^) = (^-^) ; {-# INLINE (.-^) #-}
-- #define ADDITIVE(T) ADDITIVEC((), T)
newtype WrapAdditive f a = WrappedAdditive (f a)

instance Additive f => Affine (WrapAdditive f) where
  type Diff (WrapAdditive f) = f

  WrappedAdditive a .-. WrappedAdditive b = a ^-^ b
  WrappedAdditive a .+^ b = WrappedAdditive (a ^+^ b)
  WrappedAdditive a .-^ b = WrappedAdditive (a ^-^ b)

-- ADDITIVE(((->) a))
deriving via (WrapAdditive ((->) a)) instance Affine ((->) a)
-- ADDITIVE([])
deriving via (WrapAdditive [])       instance Affine []
-- ADDITIVE(Complex)
deriving via (WrapAdditive Complex)  instance Affine Complex
-- ADDITIVE(Maybe)
deriving via (WrapAdditive Maybe)    instance Affine Maybe
-- ADDITIVE(ZipList)
deriving via (WrapAdditive ZipList)  instance Affine ZipList
-- ADDITIVE(Identity)
deriving via (WrapAdditive Identity) instance Affine Identity

----
-- 8
----

class C2 a b c where
  c2 :: a -> b -> c

instance C2 a b (Const a b) where
  c2 x _ = Const x

newtype Fweemp a = Fweemp a
  deriving (C2 a b)
       via (Const a (b :: Type))


{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
module DerivingViaStandalone where

import Data.Kind (Type)
import Control.Applicative
import Data.Functor.Compose
import Data.Proxy
import Data.Semigroup

newtype App (f :: Type -> Type) a = App (f a)
  deriving newtype
    (Functor, Applicative)

instance (Applicative f, Semigroup a) => Semigroup (App f a) where
  (<>) = liftA2 (<>)

deriving via (App (Compose (f :: Type -> Type) g) a)
         instance (Applicative f, Applicative g, Semigroup a)
               => Semigroup (Compose f g a)

class C (a :: k -> Type)
instance C Proxy

newtype MyProxy a = MyProxy (Proxy a)
deriving via (Proxy :: Type -> Type) instance C MyProxy

class Z a b
data T a
data X1 a
data X2 a
data X3 a

deriving via (forall a. T a) instance           Z a (X1 b)
deriving via           (T a) instance forall b. Z a (X2 b)
deriving via (forall a. T a) instance forall b. Z a (X3 b)


{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE DeriveTraversable, DeriveGeneric, EmptyCase,
    DeriveDataTypeable, StandaloneDeriving, DeriveLift #-}

module DrvEmptyData where
import GHC.Generics (Generic, Generic1)
import Data.Data (Data)
import Language.Haskell.TH.Syntax (Lift)

data Void a deriving (Functor, Foldable, Traversable, Generic, Generic1, Lift)

-- We don't want to invoke the special case for phantom types here.
type role Void nominal

deriving instance Data a => Data (Void a)
deriving instance Eq (Void a)
deriving instance Ord (Void a)
deriving instance Show (Void a)
deriving instance Read (Void a)


{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts, DatatypeContexts #-}

module ShouldCompile where

import Data.Foldable
import Data.Traversable

data Trivial a = Trivial
   deriving (Functor,Foldable,Traversable)

-- lots of different things
data Strange a b c
    = T1 a b c
    | T2 c c c
    | T3 [a] [b] [c]         -- lists
    | T4 [[a]] [[b]] [[c]]   -- nested lists
    | T5 (c,(b,b),(c,c))     -- tuples
    | T6 ([c],Strange a b c) -- tycons
  deriving (Functor,Foldable,Traversable)

data NotPrimitivelyRecursive a
    = S1 (NotPrimitivelyRecursive (a,a))
    | S2 a
  deriving (Functor,Foldable,Traversable)

data Eq a => StupidConstraint a b = Stupid a b
  deriving (Functor,Foldable,Traversable)

-- requires Foldable/Traversable constraint on f and g
data Compose f g a = Compose (f (g a))
  deriving (Functor,Foldable,Traversable)


{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DatatypeContexts #-}

module ShouldCompile where

data Trivial a = Trivial
   deriving (Functor)

data Fun a = Fun (Int -> a)
  deriving (Functor)

-- lots of different things
data Strange a b c
    = T1 a b c
    | T2 [a] [b] [c]         -- lists
    | T3 [[a]] [[b]] [[c]]   -- nested lists
    | T4 (c,(b,b),(c,c))     -- tuples
    | T5 ([c],Strange a b c) -- tycons
    | T6 (Int -> c)          -- function types
    | T7 (a -> (c,a))        -- functions and tuples
    | T8 ((c -> a) -> a)     -- continuation
  deriving (Functor)

data NotPrimitivelyRecursive a
    = S1 (NotPrimitivelyRecursive (a,a))
    | S2 a
  deriving (Functor,Eq)

data Eq a => StupidConstraint a b = Stupid a b
  deriving (Functor)

-- requires Functor constraint on f and g
data Compose f g a = Compose (f (g a))
  deriving (Functor)

-- We can't derive Functor for the following type.
-- it needs both (Functor (f Int)) and (Functor (f Bool))
-- i.e.:
--  instance (Functor (f Bool), Functor (f Int)) => Functor (ComplexConstraint f)
-- This requires FlexibleContexts and UndecidableInstances
data ComplexConstraint f a = ComplexConstraint (f Int (f Bool a,a))
--  deriving (Functor)

data Universal a
    = Universal  (forall b. (b,[a]))
    | Universal2 (forall f. Functor f => (f a))
    | Universal3 (forall a. a -> Int) -- reuse a
    | NotReallyUniversal (forall b. a)
  deriving (Functor)

-- Ghc doesn't allow deriving for non-Haskell98 data constructors
data Existential b
    = forall a. ExistentialList [a]
    | forall f. Functor f => ExistentialFunctor (f b)
    | forall b. SneakyUseSameName (b -> Bool)
  -- deriving (Functor)

-- Don't get confused by synonyms
type IntFun a = Int -> a
data IntFunD a = IntFunD (IntFun a)
  deriving (Functor)


{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module ShouldCompile where

-- Deriving Functor should still work with GeneralizedNewtypeDeriving instead of DeriveFunctor

newtype List a = List [a]
  deriving (Functor)


{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE DeriveTraversable #-}

module DrvPhantom where
import GHC.Generics (Generic, Generic1)
import Data.Data (Data)
import Language.Haskell.TH.Syntax (Lift)

data NotAList a = Nil | NotCons (NotAList a)
  deriving (Functor, Foldable, Traversable)

type role NotAList phantom


{-# OPTIONS -fno-warn-redundant-constraints #-}

-- !!! canonical weird example for "deriving"
module ShouldSucceed where

data X a b
  = C1 (T a)
  | C2 (Y b)
  | C3 (X b a)
  deriving (Read, Show)

data Y b
  = D1
  | D2 (X Int b)
  deriving (Read, Show)

data T a
  = E1

instance Eq a => Show (T a) where
    showsPrec = error "show"
instance Eq a => Read (T a) where
    readsPrec = error "read"


{-# OPTIONS -fno-warn-redundant-constraints #-}

module ShouldSucceed where

data Z a b
  = C1 (T a)
  | C2 (Z [a] [b])
  deriving (Show, Read)

data T a
  = E1

instance Eq a => Show (T a) where
    showsPrec = error "show"
instance Eq a => Read (T a) where
    readsPrec = error "read"


{-# OPTIONS -fno-warn-redundant-constraints #-}

-- !!! This is the example given in TcDeriv
--
module ShouldSucceed where

data T a b
  = C1 (Foo a) (Bar b)
  | C2 Int (T b a)
  | C3 (T a a)
  deriving Eq

data Foo a = MkFoo Double a deriving ()
instance (Eq a) => Eq (Foo a)

data Bar a = MkBar Int Int deriving ()
instance (Ping b) => Eq (Bar b)

class Ping a


-- !!! simple example of deriving Ord and Eq simultaneously
--
module ShouldSucceed where

data Foo a b c
  = C1 a Int
  | C2 b Double
  | C3 c String
  deriving (Eq, Ord)


-- !!! simple example of deriving Enum
--
module ShouldSucceed where

data Foo = Foo1 | Foo2 | Foo3 | Foo4 | Foo5 | Foo6 | Foo7 | Foo8
         deriving Enum


-- !!! simple examples of deriving Ix
--
module ShouldSucceed where
import Data.Ix

data Foo = Foo1 | Foo2 | Foo3 | Foo4 | Foo5 | Foo6 | Foo7 | Foo8
         deriving (Eq, Ord, Ix, Show)

data Bar a b = MkBar a Int b Integer a


-- !!! deriving Ord on d. type with a single nullary constructor.
-- (from ghc-2.10 panic - as reported by Sergey Mechveliani <mechvel@botik.ru>)
--
module ShouldSucceed where

data D = D deriving (Eq,Ord)


-- !!! deriving Ix on d. type with nullary constructors
module ShouldSucceed where

import Data.Ix

data AD = A | B | C | D deriving (Show, Ord, Eq, Ix)


-- !!! deriving Ix on d. type with one constructor
module ShouldSucceed where

import Data.Ix

data Pair a b = Pair a b deriving (Show, Ord, Eq, Ix)


-- !!! deriving Enum on d. type with nullary constructors
module ShouldSucceed where

data AD = A | B | C | D deriving (Enum)


-- !!! deriving Enum, but not Ord.
module ShouldSucceed where

data ABC = A | B | C deriving Enum

x = [A ..C]


{-# LANGUAGE GADTs #-}

-- !!! deriving for GADTs which declare Haskell98 data types.
-- bug reported as http://ghc.haskell.org/trac/ghc/ticket/902
module ShouldSucceed where

data Maybe1 a where {
      Nothing1 :: Maybe1 a ;
      Just1    :: a -> Maybe1 a
    } deriving (Eq,Ord)


{-# LANGUAGE DeriveDataTypeable #-}

-- Deriving Typeable has various special cases
module Foo where

import Data.Typeable

data Foo1 = Foo1 deriving( Typeable )
data Foo2 a = Foo2 a deriving( Typeable )
data Foo3 a b = Foo3 a b deriving( Typeable )


{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-}

module ShouldCompile where

data T a  = T1 a | T2
newtype N = MkN Int

deriving instance Eq a => Eq (T a)
deriving instance Num N
deriving instance Eq N
deriving instance Show N


-- July 07: I'm changing this from "should_compile" to "should_fail".
-- It would generate an instance decl like
--      instance (Show (f a), Show (g a)) => Show (Pair1 f g a)
-- and that is not Haskell 98.
--
-- See Note [Exotic derived instance contexts] in TcSimplify.
-- The rule is simple: the context of a derived instance decl must
-- contain constraints of form (C tyvar) only, just as H98.

module ShouldCompile where

newtype Pair1 f g a = Pair1 {unPair1 :: (f a, g a)}
  deriving (Eq, Ord, Show)


{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
             FlexibleInstances, GeneralizedNewtypeDeriving #-}

-- Test deriving of a multi-parameter class for
-- one-argument newtype defined in the same module
module ShouldSucceed where

import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)

-- library stuff

class Monad m => MonadState s m | m -> s where
    get :: m s
    put :: s -> m ()

newtype State s a = State {
                           runState :: (s -> (a, s))
                          }

instance Functor (State s) where
    fmap = liftM

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
        return a = State $ \s -> (a, s)
        m >>= k  = State $ \s -> let
                (a, s') = runState m s
                in runState (k a) s'

instance MonadState s (State s) where
        get   = State $ \s -> (s, s)
        put s = State $ \_ -> ((), s)

-- test code

newtype Foo a = MkFoo (State Int a)
 deriving (Functor, Applicative, Monad, MonadState Int)

f :: Foo Int
f = get


{-# LANGUAGE DeriveDataTypeable #-}

module ShouldCompile where
import Data.Typeable

data A a b c d e f g h i j = A deriving (Typeable)
  -- Many args

data B a b = B (a b) deriving (Typeable)
  -- Non type-kind args


{-# LANGUAGE StandaloneDeriving, DeriveGeneric #-}

module T10487 where

import GHC.Generics

import qualified T10487_M as M

data Name = Name

deriving instance Generic Name
deriving instance Generic M.Name


{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE PolyKinds #-}
module T10524 where

import Data.Data

newtype WrappedFunctor f a = WrapFunctor (f a) deriving (Data, Typeable)

-- WrappedFunctor :: forall k. (k -> *) -> k -> *


{-# LANGUAGE PolyKinds, DeriveFunctor, RankNTypes #-}

module T10561 where

newtype Compose f g a = Compose (f (g a)) deriving Functor


{-# LANGUAGE TypeFamilies       #-}
{-# LANGUAGE DeriveFunctor      #-}
{-# LANGUAGE FlexibleInstances  #-}

module T11148 where

data family G a b c d
data instance G Int b Float d = G deriving Functor

data family H a b c d
data instance H [b] b d c = H deriving Functor


{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE MagicHash         #-}
module T11174 where

import GHC.Prim (Int#)

data IntHash a = IntHash Int#
  deriving (Functor, Foldable, Traversable)
data IntHashFun a = IntHashFun ((a -> Int#) -> a)
  deriving Functor
data IntHashTuple a = IntHashTuple Int# a (a, Int, IntHashTuple (a, Int))
  deriving (Functor, Foldable, Traversable)


{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module T1133 where

import T1133a

newtype X = X Int deriving Enum


module T1133a where

import {-# SOURCE #-} T1133


{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
module T11357 where

import GHC.Generics (Generic1)

data family   ProxyFam (a :: k)
data instance ProxyFam (a :: k) = ProxyCon deriving Generic1


{-# LANGUAGE RebindableSyntax #-}
module IfThenElseIx where

import Data.Ix (Ix, )
import Prelude

ifThenElse :: Bool -> a -> a -> a
ifThenElse True x _ = x
ifThenElse False _ x = x

data T = A | B deriving (Eq, Ord, Ix)


{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
module T11416 where

import Data.Kind

type ConstantT a b = a

newtype T f (a :: ConstantT Type f) = T (f a)
  deriving Functor

data family TFam1 (f :: k1) (a :: k2)
newtype instance TFam1 f (ConstantT a f) = TFam1 (f a)
  deriving Functor

data family TFam2 (f :: k1) (a :: k2)
newtype instance TFam2 f (a :: ConstantT Type f) = TFam2 (f a)
  deriving Functor


{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
module T11509_2 where

import GHC.Exts (Constraint)

class C1 (a :: Constraint) where
class C2 where

deriving instance C1 C2


{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StandaloneDeriving #-}
module T11509_3 where

import System.IO (Handle) -- A data type whose constructors are hidden

class C a where

deriving instance C Handle


{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
module T11732a where

import GHC.Generics

data Proxy k (a :: k) deriving Generic1

data family ProxyFam (a :: y) (b :: z)
data instance ProxyFam k (a :: k) deriving Generic1


{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
module T11732b where

data P1   (a :: k) = MkP1 deriving Functor
data P2 k (a :: k) = MkP2 deriving Functor

data family P1Fam (x :: y)
data family P2Fam (x :: y) (z :: w)
data instance P1Fam   (a :: k) deriving Functor
data instance P2Fam k (a :: k) deriving Functor


{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
module T11732c where

import Data.Kind

class Cat k (cat :: k -> k -> Type) where
  catId   :: cat a a
  catComp :: cat b c -> cat a b -> cat a c

instance Cat Type (->) where
  catId   = id
  catComp = (.)

newtype Fun2 a b = Fun2 (a -> b) deriving (Cat Type)

-- The ticket says this should work:
--   newtype Fun1 a b = Fun1 (a -> b) deriving (Cat k)
-- But that requires that the kind of (Cat k) to depend on k, where k is local
-- This is all due for an update, anyway, when #14331 is done, and it's unclear
-- what the correct behavior here is, anyway. (Richard thinks: reject!)


{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PolyKinds #-}
module T11833 where

import Data.Kind (Type)

class Category (cat :: k -> k -> Type) where
  catId   :: cat a a
  catComp :: cat b c -> cat a b -> cat a c

newtype T (c :: Type -> Type -> Type) a b = MkT (c a b) deriving Category


{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PolyKinds #-}
module T11837 where

class Category (cat :: k -> k -> *) where
  catId   :: cat a a
  catComp :: cat b c -> cat a b -> cat a c

newtype T (c :: k -> k -> *) a b = MkT (c a b) deriving Category


{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE KindSignatures #-}
module T12144_1 where

import Data.Kind (Type)

class C (a :: Type -> Type)
data T a = MkT (a -> Int) deriving C


{-# LANGUAGE DeriveAnyClass #-}
module T12144_2 where

class C1 a

instance C1 a => C1 (Foo a)

class C1 a => C2 a where
  c2 :: a -> String
  c2 _ = "C2 default"

newtype Foo a = Foo a deriving C2

foo :: C1 a => Foo a -> String
foo = c2


{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}

module T12245 where

import Data.Data ( Data )

data Foo f = Foo (f Bool) (f Int)

deriving instance Data (Foo [])
deriving instance Data (Foo Maybe)


{-# LANGUAGE DeriveFunctor, MagicHash, UnboxedTuples #-}
module T12399 where

import GHC.Exts

newtype RmLoopsM a = RmLoopsM { runRmLoops :: Int# -> (# Int#, a #) }
  deriving Functor


{-# LANGUAGE DefaultSignatures, DeriveAnyClass #-}
module T12423 where

class Eq1 f where
  (==#) :: Eq a => f a -> f a -> Bool
  default (==#) :: Eq (f a) => f a -> f a -> Bool
  (==#) = (==)

data Foo a = Foo (Either a a)
    deriving (Eq, Eq1)


{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
module T12583 where

import Data.Ix

data Foo a where
  MkFoo :: (Eq a, Ord a, Ix a) => Foo a
deriving instance Eq  (Foo a)
deriving instance Ord (Foo a)
deriving instance Ix  (Foo a)


{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
module T12594 where

import GHC.Generics

data Action = Action

class ToField a where
  toField :: a -> Action

instance ToField Int where
  -- Not the actual instance, but good enough for testing purposes
  toField _ = Action

class ToRow a where
    toRow :: a -> [Action]
    default toRow :: (Generic a, GToRow (Rep a)) => a -> [Action]
    toRow = gtoRow . from

class GToRow f where
    gtoRow :: f p -> [Action]

instance GToRow f => GToRow (M1 c i f) where
    gtoRow (M1 x) = gtoRow x

instance (GToRow f, GToRow g) => GToRow (f :*: g) where
    gtoRow (f :*: g) = gtoRow f ++ gtoRow g

instance (ToField a) => GToRow (K1 R a) where
    gtoRow (K1 a) = [toField a]

instance GToRow U1 where
    gtoRow _ = []

data Foo = Foo { bar :: Int }
  deriving (Generic, ToRow)


{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}

module T12616 where

type m ~> n = forall a. m a -> n a

class MonadTrans t where
  -- > this line works:
  -- lift :: (Monad m) => m a -> t m a
  -- > this line doesn't:
  lift :: (Monad m) => m ~> t m

data StateT s m a = StateT { runStateT :: s -> m (a, s) }

instance MonadTrans (StateT s) where
  lift xM = StateT $ \ s -> do { x <- xM ; return (x,s) }

newtype OtherStateT s m a = OtherStateT { runOtherStateT :: StateT s m a }
  deriving (MonadTrans)


{-# LANGUAGE RebindableSyntax, OverloadedStrings #-}
module T12688 where

import Prelude (String,Show(..))

newtype Text = Text String

fromString :: String -> Text
fromString = Text

x :: Text
x = "x"

newtype Foo = Foo ()
  deriving (Show)


{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module T12814 where

class C a where
  type T a

newtype Identity a = Identity a
  deriving C


{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE StandaloneDeriving #-}
module T13154a where

import GHC.Exts

class C1 a
deriving instance C1 (a -> b)

class C2 (a :: TYPE 'IntRep)
deriving instance C2 Int#


{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module T13272 where

import GHC.Generics

class TypeName a where
  typeName         :: forall proxy.
                      proxy a -> String
  default typeName :: forall proxy d f.
                      (Generic a, Rep a ~ D1 d f, Datatype d)
                   => proxy a -> String
  typeName _ = gtypeName $ from (undefined :: a)

gtypeName :: Datatype d => D1 d f p -> String
gtypeName = datatypeName

data T a = MkT a
  deriving (Generic, TypeName)


{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module T13272a where

import GHC.Generics

class TypeName a where
  typeName         :: proxy a -> String
  default typeName :: (Generic a, Rep a ~ gg, gg ~ D1 d f, Datatype d)
                   => proxy a -> String
  typeName _ = gtypeName $ from (undefined :: a)

gtypeName :: Datatype d => D1 d f p -> String
gtypeName = datatypeName

data T a = MkT a
  deriving (Generic, TypeName)


{-# Language TypeFamilies, StandaloneDeriving, GeneralizedNewtypeDeriving, UndecidableInstances #-}
module T13297 where

import Data.Kind (Type)

newtype N p m a = N (((CT p) m) a)
deriving instance (CT p ~ f, Functor (f m)) => Functor (N p m)
deriving instance (CT p ~ f, Applicative (f m)) => Applicative (N p m) -- panic when this line added

class C p where
    type CT p :: (Type -> Type) -> Type -> Type


{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# Language ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS -Wno-noncanonical-monoid-instances #-}

module T13758 where

import Data.Coerce
import GHC.Generics
import Data.Semigroup

-----

class Monoid' f where
  mempty'  :: f x
  mappend' :: f x -> f x -> f x

instance Monoid' U1 where
  mempty' = U1
  mappend' U1 U1 = U1

instance Monoid a => Monoid' (K1 i a) where
  mempty' = K1 mempty
  mappend' (K1 x) (K1 y) = K1 (x `mappend` y)

instance Monoid' f => Monoid' (M1 i c f) where
  mempty' = M1 mempty'
  mappend' (M1 x) (M1 y) = M1 (x `mappend'` y)

instance (Monoid' f, Monoid' h) => Monoid' (f :*: h) where
  mempty' = mempty' :*: mempty'
  mappend' (x1 :*: y1) (x2 :*: y2) = mappend' x1 x2 :*: mappend' y1 y2

memptydefault :: (Generic a, Monoid' (Rep a)) => a
memptydefault = to mempty'

mappenddefault :: (Generic a, Monoid' (Rep a)) => a -> a -> a
mappenddefault x y = to (mappend' (from x) (from y))

-----

newtype GenericMonoid a = GenericMonoid a

instance (Generic a, Monoid' (Rep a)) => Semigroup (GenericMonoid a) where
  (<>) = coerce (mappenddefault :: a -> a -> a)

instance (Generic a, Monoid' (Rep a)) => Monoid (GenericMonoid a) where
  mempty  = coerce (memptydefault  :: a)
  mappend = coerce (mappenddefault :: a -> a -> a)

data Urls = Urls String String String
  deriving (Show, Generic)

newtype UrlsDeriv = UD (GenericMonoid Urls)
  deriving (Semigroup, Monoid)


{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
module T13813 where

import GHC.Exts (Constraint)

type C (a :: Constraint) b = a

data T a b = C (Show a) b => MkT b
deriving instance Functor (T a)


{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -Wunused-binds #-}
module T13919 () where

import GHC.Generics

data Foo1 = Foo1 {bar1 :: String} deriving Show
data Foo2 = Foo2 {bar2 :: String} deriving Read
data Foo3 = Foo3 {bar3 :: String} deriving Generic

-- Only this one should emit a "Defined but not used" warning for its
-- record selector
data Foo4 = Foo4 {bar4 :: String} deriving Eq


{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GADTs #-}

module T13998 where

import Data.Type.Equality

class EqForall f where
  eqForall :: f a -> f a -> Bool

class EqForall f => EqForallPoly f where
  eqForallPoly :: f a -> f b -> Bool
  default eqForallPoly :: TestEquality f => f a -> f b -> Bool
  eqForallPoly = defaultEqForallPoly

defaultEqForallPoly :: (TestEquality f, EqForall f) => f a -> f b -> Bool
defaultEqForallPoly x y = case testEquality x y of
  Nothing -> False
  Just Refl -> eqForall x y

data Atom = AtomInt | AtomString | AtomBool

data Value (a :: Atom) where
  ValueInt :: Int -> Value 'AtomInt
  ValueString :: String -> Value 'AtomString
  ValueBool :: Bool -> Value 'AtomBool

instance TestEquality Value where
  testEquality (ValueInt _) (ValueInt _) = Just Refl
  testEquality (ValueString _) (ValueString _) = Just Refl
  testEquality (ValueBool _) (ValueBool _) = Just Refl
  testEquality _ _ = Nothing

instance EqForall Value where
  eqForall (ValueInt a) (ValueInt b) = a == b
  eqForall (ValueString a) (ValueString b) = a == b
  eqForall (ValueBool a) (ValueBool b) = a == b

instance EqForallPoly Value


{-# LANGUAGE TypeFamilies, KindSignatures, GADTs, GeneralizedNewtypeDeriving #-}

module T14045b where

import Data.Kind ( Type )

data family T a b :: Type

-- newtype instance T Int d = MkT (IO d)

newtype instance T Int :: Type -> Type where
   MkT :: IO d -> T Int d
  deriving( Monad, Applicative, Functor )


{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wall #-}
module Bug where

class C a where
  type T a
  data D a
  m :: a

instance C Int
deriving instance C Bool


{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE PolyKinds #-}
module Bug where

class C p q

data D = D deriving (C (a :: k))


{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Bug where

import GHC.TypeLits

newtype Baz = Baz Foo
  deriving Bar

newtype Foo = Foo Int

class Bar a where
  bar :: a

instance (TypeError (Text "Boo")) => Bar Foo where
  bar = undefined


{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module T14578 where

import Control.Applicative
import Data.Functor.Compose
import Data.Semigroup

newtype App f a = MkApp (f a)
  deriving (Functor, Applicative)

instance (Applicative f, Semigroup a) => Semigroup (App f a) where
  (<>) = liftA2 (<>)

newtype Wat f g a = MkWat (App (Compose f g) a)
  deriving Semigroup


{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
module T14579 where

import Data.Kind
import Data.Proxy

newtype Wat (x :: Proxy (a :: Type)) = MkWat (Maybe a)
  deriving Eq

newtype Glurp a = MkGlurp (Wat ('Proxy :: Proxy a))
  deriving Eq


{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Bug where

import Data.Coerce
import Data.Kind
import Data.Proxy

newtype Wat (x :: Proxy (a :: Type)) = MkWat (Maybe a)
  deriving Eq

newtype Glurp a = MkGlurp (Wat ('Proxy :: Proxy a))

instance Eq a => Eq (Glurp a) where
  (==) = coerce @(Wat ('Proxy @a) -> Wat ('Proxy @a) -> Bool)
                @(Glurp a         -> Glurp a         -> Bool)
                (==)


{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PolyKinds #-}
module T14579b where

import Data.Kind
import Data.Proxy

-- type P :: forall {k} {t :: k}. Proxy t
type P = 'Proxy

-- type Wat :: forall a. Proxy a -> *
newtype Wat (x :: Proxy (a :: Type)) = MkWat (Maybe a)
  deriving Eq

-- type Wat2 :: forall {a}. Proxy a -> *
type Wat2 = Wat

-- type Glurp :: * -> *
newtype Glurp a = MkGlurp (Wat2 (P :: Proxy a))
  deriving Eq


{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveLift #-}
module T14682 where

import Data.Data
import Data.Ix
import Language.Haskell.TH.Syntax

data Foo = Foo Int Int
  deriving (Show, Lift, Data, Eq, Ord, Ix)


{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
module T14883 where

import Data.Coerce
import Data.Kind

type Representational1 m = (forall a b. Coercible a b => Coercible (m a) (m b) :: Constraint)

class Representational1 f => Functor' f where
  fmap' :: (a -> b) -> f a -> f b

class Functor' f => Applicative' f where
  pure'  :: a -> f a
  (<*>@) :: f (a -> b) -> f a -> f b

class Functor' t => Traversable' t where
  traverse' :: Applicative' f => (a -> f b) -> t a -> f (t b)

-- Typechecks
newtype T1 m a = MkT1 (m a) deriving Functor'
deriving instance Traversable' m => Traversable' (T1 m)


{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module T14932 where

import Data.Kind (Constraint, Type)

class Zero a where
 zero :: a
 default zero :: (Code a ~ '[xs], All Zero xs) => a
 zero = undefined

type family All c xs :: Constraint where
 All c '[] = ()
 All c (x : xs) = (c x, All c xs)

type family Code (a :: Type) :: [[Type]]
type instance Code B1 = '[ '[ ] ]

data B1 = B1
 deriving Zero


{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE TypeFamilies      #-}
module T14933 where

import Data.Kind (Type)

class Wrapped s where
  type Unwrapped s :: Type

class Fork m where
    fork :: (x, m)

    default fork :: ( Wrapped m
                    , Unwrapped m ~ t
                    , Fork t
                    ) => (x, m)
    fork = undefined

newtype MyThing m = MyThing m
    deriving Fork

instance Wrapped (MyThing m) where
    type Unwrapped (MyThing m) = m


{-# LANGUAGE QuantifiedConstraints, StandaloneDeriving, GeneralizedNewtypeDeriving #-}

module T15290c where

import Prelude hiding ( Monad(..) )
import Data.Coerce ( Coercible )

class Monad m where
  (>>=) :: m a -> (a -> m b) -> m b
  join  :: m (m a) -> m a

newtype StateT s m a = StateT { runStateT :: s -> m (s, a) }

instance Monad m => Monad (StateT s m) where
  ma >>= fmb = StateT $ \s -> runStateT ma s >>= \(s1, a) -> runStateT (fmb a) s1
  join ssa = StateT $ \s -> runStateT ssa s >>= \(s, sa) -> runStateT sa s

newtype IntStateT m a = IntStateT { runIntStateT :: StateT Int m a }

deriving instance (Monad m, forall p q. Coercible p q => Coercible (m p) (m q)) => Monad (IntStateT m)


{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
module T15290d where

class C a where
  c :: Int -> forall b. b -> a

instance C Int where
  c _ _ = 42

newtype Age = MkAge Int
  deriving C


{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}

module T15398 where

newtype Radius a = Radius a deriving (Eq, Ord)

data CourseLine
data OpenDistance
data EndOfSpeedSection

data Zone k a where
    Point :: (Eq a, Ord a) => Zone CourseLine a
    Vector :: (Eq a, Ord a) => Zone OpenDistance a
    Conical :: (Eq a, Ord a) => Radius a -> Zone EndOfSpeedSection a

deriving instance Eq a => Eq (Zone k a)
deriving instance (Eq a, Ord a) => Ord (Zone k a)


{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
module T15637 where

class C a where f :: String

instance C () where f = "foo"

newtype T = T () deriving C


{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module T16179 where

class C a
newtype T a = MkT a deriving C


{-# LANGUAGE DeriveLift #-}
module T1830_2 where

import Language.Haskell.TH.Syntax (Lift)

data Nothing deriving Lift


{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}
module Foo( T ) where

-- Trac 2378

import Data.Data

newtype T f = MkT Int

deriving instance Typeable T


{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
-- Trac #2721

module T2721 where

class C a where
  type T a
  foo :: a -> T a

instance C Int where
  type T Int = Int
  foo = id

newtype N = N Int deriving(C)


{-# OPTIONS -fno-warn-redundant-constraints #-}
{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, FlexibleInstances #-}

-- Test Trac #2856

module T2856 where

import Data.Ratio

----------------------
class C a where
    data D a

instance C Bool where
    newtype D Bool = DInt Int deriving (Eq, Show, Num)

instance C a => C [a] where
    newtype D [a] = DList (Ratio a) deriving (Eq, Show, Num)

----------------------
data family W a
newtype instance W Bool = WInt Int deriving( Eq, Show )
newtype instance W [a] = WList (Ratio a) deriving( Eq, Show )

deriving instance Num (W Bool)
deriving instance (Integral a, Num a) => Num (W [a])
  -- Integral needed because superclass Eq needs it,
  -- because of the stupid context on Ratio


{-# LANGUAGE GADTs, StandaloneDeriving #-}

module T3012 where

data T a where
    Foo :: T Int
    Bar :: T Bool

deriving instance Show (T a)


{-# LANGUAGE StandaloneDeriving, DeriveFunctor #-}
module T3057 where

import T3057A

deriving instance Functor (MyType a)


module T3057A where

data MyType a b = C1 a | C2 b


{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, StandaloneDeriving, TypeOperators, UndecidableInstances #-}
module T3965 where

import Data.Data

data T f e = Inl (f e) deriving (Data, Typeable, Eq)

newtype Expr f = In (f (Expr f)) deriving Typeable

deriving instance (Typeable a, Data (a (Expr a))) => Data (Expr a)

data Var e = Var String deriving (Data, Eq, Typeable)

data Domain e g = Domain
    (Expr (T Var))
    deriving (Data, Typeable)


{-# LANGUAGE EmptyDataDecls, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
module T4220 where

import Data.Foldable
import Data.Traversable

data Void a deriving (Functor, Foldable, Traversable)


{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, EmptyDataDecls #-}
module T4302 where

import Data.Ix
import Data.Typeable
import Data.Data
import Data.Foldable
import Data.Traversable

data Test a

deriving instance Eq (Test a)
deriving instance Ord (Test a)
deriving instance Typeable Test
deriving instance Data a => Data (Test a)
deriving instance Functor Test
deriving instance Foldable Test
deriving instance Traversable Test


{-# LANGUAGE DatatypeContexts #-}

module T4325 where

data Ord a => Heap a b = Empty | Node a b [Heap a b]
    deriving Eq


{-# LANGUAGE DeriveFunctor #-}

module T4816 where

data Silly a = Silly a

data Baz o = Baz {
     foo :: o,
     bar :: Silly ()
   } deriving (Functor)


{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances, TypeFamilies, DeriveDataTypeable, StandaloneDeriving #-}

module T4896 where

import Data.Data
import Data.Typeable

--instance Typeable1 Bar where
--  typeOf1 _ = mkTyConApp (mkTyCon "Main.Bar") []
deriving instance Typeable Bar

class Foo a where
  data Bar a

data D a b = D Int a deriving (Typeable, Data)

instance Foo (D a b) where
  data Bar (D a b) = B { l :: a } deriving (Eq, Ord, Read, Show, Data)


{-# OPTIONS -fno-warn-redundant-constraints #-}

{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}

module HTk.Toolkit.TreeList (getObjectFromTreeList) where

class Eq c => CItem c

-- A bizarre instance decl!
-- People who use instance decls like this are asking for trouble
instance {-# OVERLAPPABLE #-} GUIObject w => Eq w where
  w1 == w2 = toGUIObject w1 == toGUIObject w2

data StateEntry a
  = StateEntry (TreeListObject a) a -- Comment this 'a' out and it type checks
  deriving Eq

-- The delicate point about this test is that we want to
-- infer a derived instance decl like this:
--    instance (CItem a, Eq a) => Eq (StateEntry a)
-- But note the instance decl for (Eq w) for any w!
-- There's a danger than we'll use that instance decl
-- to get the derived instance
--    instance (CItem a, GUIObject a) => Eq (StateEntry a)
-- And then that doesn't work subsequently

getObjectFromTreeList :: CItem a => StateEntry a -> Bool
getObjectFromTreeList state = state == state

data CItem a => TreeListObject a

instance {-# OVERLAPPING #-} CItem a => Eq (TreeListObject a)

class GUIObject w where
  toGUIObject     :: w -> GUIOBJECT

data GUIOBJECT

instance Eq GUIOBJECT where
  (==) = undefined
  (/=) = undefined


{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module T5939 where

import GHC.Generics

data T a = T a
deriving instance Generic (T Bool)

data family TFam a b c
data instance TFam Int b c
deriving instance Generic (TFam Int Bool c)


{-# LANGUAGE StandaloneDeriving #-}

module T6031 where

import T6031a

deriving instance Show Empty


{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE MultiParamTypeClasses, StandaloneDeriving, GeneralizedNewtypeDeriving #-}

module T7269 where

class C (a :: k)

instance C Int

newtype MyInt = MyInt Int deriving C

newtype YourInt = YourInt Int
deriving instance C YourInt


{-# LANGUAGE PolyKinds          #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}

module T7704 where

import Data.Typeable

data A1 = A1 deriving Typeable
data A2 = A2
deriving instance Typeable A2

data B1 a = B1 deriving Typeable
data B2 a = B2
deriving instance Typeable B2

data C1 a = C1 deriving Typeable
data C2 a = C2
deriving instance Typeable C2

data D1 f = D1 (f (D1 f)) deriving Typeable
data D2 f = D2 (f (D2 f))
deriving instance Typeable D2

data E1 (a :: k) f = E1 (f Int) deriving Typeable
data E2 (a :: k) f = E2 (f Int)
deriving instance Typeable E2


{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE TypeFamilies #-}

module T7710 where

import Data.Typeable

type T = Int
type family F a
type instance F Int = Int
data family D a
data instance D Int = DInt
data instance D Float = DFloat

test = [ typeRep ([] :: [T])
       , typeRep ([] :: [F Int])
       , typeRep (Proxy :: Proxy D)
       , typeRep ([] :: [D Int]) ]


{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}

module T7947 where

import Data.Data
import Data.Typeable

import T7947a
import qualified T7947b as B

deriving instance Typeable A
deriving instance Typeable B.B

deriving instance Data A
deriving instance Data B.B


module T7947a where

data A = C1 | C2 | C


module T7947b where

data B = D1 | D2 | C


{-# LANGUAGE StandaloneDeriving, GADTs, FlexibleInstances #-}

module T8128 where

data T a where
  MkT1 :: T Int
  MkT2 :: Bool -> T Bool

deriving instance Show (T Int)


{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import Control.Monad.ST
import Data.Primitive

main :: IO ()
main = do
    let xs :: [Float] = runST $ do
        barr <- mutableByteArrayFromList [1..fromIntegral n::Float]
        peekByteArray n barr
    print xs
  where
    n = 13

mutableByteArrayFromList :: forall s a . (Prim a)
                         => [a]
                         -> ST s (MutableByteArray s)
mutableByteArrayFromList xs = do
    arr <- newByteArray (length xs*sizeOf (undefined :: a))
    loop arr 0 xs
    return arr
  where
    loop :: MutableByteArray s -> Int -> [a] -> ST s ()
    loop _ _ [] = return ()

    loop arr i (x : xs) = do
        writeByteArray arr i x
        loop arr (i+1) xs

peekByteArray :: (Prim a)
              => Int
              -> MutableByteArray s
              -> ST s [a]
peekByteArray n arr =
    loop 0 arr
  where
    loop :: (Prim a)
         => Int
         -> MutableByteArray s
         -> ST s [a]
    loop i _ | i >= n = return []

    loop i arr = do
        x  <- readByteArray arr i
        xs <- loop (i+1) arr
        return (x : xs)


{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module T8165 where

import Data.Kind (Type)

-----------------------------------------------------------

class C a where
    type T a

instance C Int where
    type T Int = Bool

newtype NT = NT Int
    deriving C

-----------------------------------------------------------

class D a where
  type U a

instance D Int where
  type U Int = Int

newtype E = MkE Int
  deriving D

-----------------------------------------------------------

class C2 a b where
  type F b c a :: Type
  type G b (d :: Type -> Type) :: Type -> Type

instance C2 a y => C2 a (Either x y) where
  type F (Either x y) c a = F y c a
  type G (Either x y) d   = G y d

newtype N a = MkN (Either Int a)
  deriving (C2 x)

-----------------------------------------------------------

class HasRing a where
    type Ring a

newtype L2Norm a = L2Norm a
    deriving HasRing

newtype L1Norm a = L1Norm a
    deriving HasRing


{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}

module T8631 where

import Control.Monad.Trans.Cont
import Control.Monad.Trans.State.Lazy

newtype AnyContT m a = AnyContT { unAnyContT :: forall r . ContT r m a }

class MonadAnyCont b m where
  anyContToM :: (forall r . (a -> b r) -> b r) -> m a

instance MonadAnyCont b (AnyContT m) where
  anyContToM _ = error "foo"

data DecodeState = DecodeState

newtype DecodeAST a = DecodeAST { unDecodeAST :: AnyContT (StateT DecodeState IO) a }
  deriving (MonadAnyCont IO)


{-# LANGUAGE DataKinds, DeriveFunctor, FlexibleInstances, GADTs, KindSignatures, StandaloneDeriving #-}
module T8678 where

import Data.Kind (Type)

data {- kind -} Nat = Z | S Nat

-- GADT in parameter other than the last
data NonStandard :: Nat -> Type -> Type -> Type where
    Standard :: a -> NonStandard (S n) a b
    Non :: NonStandard n a b -> b -> NonStandard (S n) a b

deriving instance (Show a, Show b) => Show (NonStandard n a b)
deriving instance Functor (NonStandard n a)


{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
module T8740 where

data Abstract
data Reified
data Player

data Elect p a where
    ElectRefAsTypeOf :: Int -> Elect Abstract a -> Elect Abstract a
    ElectHandle :: a -> Elect Reified a
    Controller :: Elect Abstract Player
    Owner :: Elect Abstract Player
    You :: Elect Abstract Player

deriving instance (Eq a) => Eq (Elect p a)
deriving instance (Ord a) => Ord (Elect p a)


{-# LANGUAGE RankNTypes #-}

module T8758 where

class C m where
  foo :: (forall b. b -> m b) -> c -> m c

instance C [] where
  foo f c = f c


{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module T8758a where

import T8758

newtype MyList a = Mk [a]
  deriving C


{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module T8865 where
import Control.Category

instance Category Either where
  id  = error "urk1"
  (.) = error "urk2"

newtype T a b = MkT (Either a b) deriving( Category )


{-# OPTIONS_GHC -Wall #-}
{-# Language DeriveFunctor #-}
{-# Language PolyKinds #-}

module T8893 where

data V a = V [a] deriving Functor

data C x a = C (V (P x a)) deriving Functor

data P x a = P (x a) deriving Functor


{-# LANGUAGE DataKinds, StandaloneDeriving #-}

module T8950 where

import Data.Typeable

data Foo = Bar
  deriving (Eq)

data Baz = Quux

deriving instance Typeable Baz  -- shouldn't error
deriving instance Typeable Quux

rep1 = typeRep (Proxy :: Proxy Bool)
rep2 = typeRep (Proxy :: Proxy 'True)
rep3 = typeRep (Proxy :: Proxy Foo)
rep4 = typeRep (Proxy :: Proxy Bar)


{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}

module T8963 where

class C c where
   data F c r

instance C Int where
   newtype F Int r = F (IO r) deriving (Functor)


{-# LANGUAGE DeriveTraversable #-}

module T9069 where

import Data.Foldable
import Data.Traversable

data Trivial a = Trivial a
   deriving (Functor,Foldable,Traversable)


{-# Language GADTs, PolyKinds, TypeFamilies, DataKinds #-}
module Fam where

import Data.Kind (Type)

data Cmp a where
 Sup ::      Cmp a
 V   :: a -> Cmp a
 deriving (Show, Eq)

data family   CmpInterval (a :: Cmp k) (b :: Cmp k) :: Type
data instance CmpInterval (V c)         Sup          = Starting c
  deriving( Show )


{-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses #-}

module T9968 where

class C a b
data X = X deriving (C Int)


{-# LANGUAGE DeriveAnyClass #-}

module T9968 where

import Data.Bifunctor

data Blah a b = A a | B b
  deriving (Bifunctor)


{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
module DerivingViaFail where

import Control.Category
import Data.Functor.Identity

newtype Foo1 a = Foo1 a deriving Show via (Identity b)

newtype Foo2 a b = Foo2 (a -> b)
  deriving Category
    via fooo

data Foo3 deriving Eq via (forall a. a)

newtype Foo4 a = Foo4 a
deriving via (Identity b)
  instance Show (Foo4 a)


{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE StandaloneDeriving #-}
module DerivingViaFail2 where

class C a
data A = A
deriving via Maybe instance C A


module DerivingViaFail3 where

data F deriving Eq via F


{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
module DerivingViaFail4 where

class C a b where
  c :: a -> b -> Bool

instance C a a where
  c _ _ = True

newtype F1 = F1 Int
  deriving Eq via Char

newtype F2 a = MkF2 a
  deriving (C a) via (forall a. a)


{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
module ShouldFail where

import Data.Foldable
import Data.Traversable

-- Derive Traversable without Functor
data Trivial1 a = Trivial1 a
   deriving (Foldable,Traversable)

-- Derive Traversable without Foldable
data Trivial2 a = Trivial2 a
   deriving (Functor,Traversable)

-- Foldable with function type
data Infinite a = Infinite (Int -> a)
   deriving (Functor,Foldable)

-- Foldable with function type
data Cont r a = Cont ((a -> r) -> r)
   deriving (Functor,Traversable)


module ShouldFail where

-- Derive Functor without a DeriveFunctor language pragma

data List a = Nil | Cons a (List a)
    deriving Functor


{-# LANGUAGE DeriveFunctor, DatatypeContexts #-}
module ShouldFail where

-- Derive Functor on a type that uses 'a' in the wrong places

newtype InFunctionArgument a = InFunctionArgument (a -> Int)
   deriving (Functor)

newtype OnSecondArg a = OnSecondArg (Either a a)
   deriving (Functor)

-- Derive Functor on a type with no arguments

newtype NoArguments = NoArguments Int
   deriving (Functor)

-- Derive Functor on a type with extra stupid-constraints on 'a'

data Eq a => StupidConstraint a = StupidType a
   deriving (Functor)

-- A missing Functor instance

data NoFunctor a = NoFunctor
data UseNoFunctor a = UseNoFunctor (NoFunctor a)
   deriving (Functor)


{-  From: Ian Bayley
    Sent: Tuesday, June 29, 1999 3:39 PM
    To: hugs-bugs@haskell.org
    Subject: Show for higher-order nested datatypes

    Is "deriving Show" meant to work for higher-order nested datatypes ?
    Hugs hangs when loading in the following file:
-}

module Foo where

type SqMat a = SM Nil a

data SM f a = ZeroS (f (f a)) | SuccS (SM (Cons f) a)
                       deriving Show

-- Show (f (f a)), Show (SM (Cons f) a) => Show (SM f a)

data Nil a = MkNil deriving Show

data Cons f a = MkCons a (f a)
                       deriving Show


{-# LANGUAGE UndecidableInstances,
             MultiParamTypeClasses, FunctionalDependencies #-}

-- The Show instance for S would have form
--      instance X T c => Show S
-- which is hard to deal with.  It sent GHC 5.01 into
-- an infinite loop; now it should be rejected.

module ShouldFail where

data T = T Integer

class X a b | a -> b where
    f :: a -> b

instance X T c => Show T where
    show _ = ""

data S = S T deriving Show


{-# LANGUAGE FlexibleContexts #-}
-- Made GHC 5.02.2 go into a loop when doing the
-- context inference for deriving.  It only happened with
-- the -fglasgow-exts flag (it didn't diverge without),
-- so hopefully FlexibleContexts is the relevant extension.

module ShouldFail where

data Empty a = E
newtype Id a = I a
newtype Pair v w a = P ((v a), (w a))
type Square a = Square_ Empty Id a
data Square_ v w a =
        End (v (v a))
      | Zero (Square_ v (Pair w w) a)
      | One (Square_ (Pair v w) (Pair w w) a) deriving Show


-- !!! deriving Ord without deriving Eq
--
module ShouldFail where

data Foo a b
  = C1 a Int
  | C2 b Double
  deriving Ord


module ShouldFail where

data Test a = T a
  deriving( Show a, Read )


{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- Testing the newtype-deriving stuff

module ShouldFail where

import Control.Monad.State

newtype T a = T (StateT Int IO a) deriving( MonadState )
        -- Here MonadState takes two type params,
        -- but exactly one is needed.


-- !!! buggy deriving with function type, reported by Sigbjorn Finne
module ShouldFail where

data Foo = Foo (Int -> Int) deriving Eq


-- Should fail without GeneralizedNewtypeDeriving
-- Succeeds with GeneralizedNewtypeDeriving

module ShouldFail where

import Control.Monad.State

data S = S Int

newtype M a = M (StateT S IO a) deriving( Monad )


{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}

-- Various newtype-deriving failures

module ShouldFail where

class C a b

newtype T1 = T1 Int deriving( C )
        -- Wrong arity

newtype T2 = T2 Int deriving( Monad )
        -- Type constructor has wrong kind

newtype T3 a = T3 Int deriving( Monad )
        -- Rep type has wrong kind

newtype T4 a = T4 (Either a a) deriving( Monad )
        -- Eta fails


{-# LANGUAGE StandaloneDeriving #-}

module ShouldFail where

data T a = T1 a | T2

-- This fails as we need an (Eq a) context
deriving instance Eq (T a)


-- Trac #1608

module ShouldFail where

newtype Ego a = Ego a deriving (Ord)

f :: Ord a => Ego a -> Ego a -> Bool
f e1 e2 = e1 < e2


-- Test for trac #1588: unrequested generalized newtype deriving?

newtype MaybeT  m a = MaybeT  { runMaybeT  :: m (Maybe a) } deriving Eq

data    MaybeT' m a = MaybeT' { runMaybeT' :: m (Maybe a) } deriving Eq


{-# OPTIONS_GHC -XStandaloneDeriving #-}

module ShouldFail where

import System.IO( Handle )

-- T is a synonym
type T = Int
deriving instance Eq T

-- Handle is abstract
deriving instance Eq Handle


{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module T10598_fail1 where

class Z f where
  z :: f a b

data    A     = A Int deriving newtype Show
newtype B     = B Int deriving stock   Num
data    C a b = C Int deriving anyclass Z


{-# LANGUAGE DerivingStrategies #-}
module T10598_fail2 where

data    A = A Int deriving anyclass Eq
newtype B = B Int deriving newtype  Eq


{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE Safe #-}
module T10598_fail3 where

import GHC.Generics

data T = MkT Int deriving anyclass Generic


module T10598_fail4 where

data Bar = Bar
  deriving stock Eq


module T10598_fail5 where

data Foo = Foo
  deriving Eq
  deriving Ord


{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module T10598_fail6 where

newtype F x = F ([x], Maybe x) deriving Functor


module A where
import GHC.Generics
data A = A deriving (Show, Generic)
data B = B A deriving (Show)


module T1133A where

import T1133Aa

newtype X = X Int deriving Enum


module T1133Aa where

import {-# SOURCE #-} T1133A


{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE StaticPointers             #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE UndecidableSuperClasses    #-}
module T11509 where

import Data.Kind
import Data.Typeable
import GHC.StaticPtr

{-------------------------------------------------------------------------------
  Standard Cloud-Haskell-like infrastructure

  See <https://ghc.haskell.org/trac/ghc/wiki/TypeableT> for a dicussion of 'SC'.
-------------------------------------------------------------------------------}

class Serializable a -- empty class, just for demonstration purposes

instance Serializable a => Serializable [a]

data Static :: * -> * where
  StaticPtr :: StaticPtr a -> Static a
  StaticApp :: Static (a -> b) -> Static a -> Static b

staticApp :: StaticPtr (a -> b) -> Static a -> Static b
staticApp = StaticApp .  StaticPtr

data Dict :: Constraint -> * where
  Dict :: c => Dict c

class c => SC c where
  dict :: Static (Dict c)

instance (Typeable a, SC (Serializable a)) => SC (Serializable [a]) where
  dict = aux `staticApp` dict
    where
      aux :: StaticPtr (Dict (Serializable a) -> Dict (Serializable [a]))
      aux = static (\Dict -> Dict)

{-------------------------------------------------------------------------------
  Demonstrate the bug
-------------------------------------------------------------------------------}

newtype MyList a = MyList [a]

deriving instance (Typeable a, SC (Serializable a)) => SC (Serializable (MyList a))


 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE GADTs #-}

module T12163 where

data T a b where
     Mk :: Int -> b -> T Int b
     deriving (Functor)


{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UnboxedSums #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE DataKinds, PolyKinds #-}
module T12512 where

import GHC.Exts

class Wat1 (a :: TYPE ('TupleRep ['LiftedRep, 'LiftedRep]))
deriving instance Wat1 (# a, b #)

class Wat2 (a :: TYPE ('SumRep ['LiftedRep, 'LiftedRep]))
deriving instance Wat2 (# a | b #)


data Container
  = Container [Wibble Int]
  deriving (Eq, Show)

data Wibble a
  = Wibble a
  | Wobble
  deriving (Eq, Functor, Show)


module T14365A where

import {-# SOURCE #-} T14365B

main = return ()


module T14365B where

data Foo a = Foo a
  deriving (Functor)