{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

{-|
Module:      ShowSpec
Copyright:   (C) 2015-2016 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Portability: Template Haskell

@hspec@ tests for derived 'Show', 'Show1', and 'Show2' instances.
-}
module ShowSpec where

#if !defined(NEW_FUNCTOR_CLASSES)
import Data.Functor.Classes (Show1(..))
#endif
import Data.Deriving

import GHC.Exts (Char#, Double#, Float#, Int#, Word#)

import Prelude ()
import Prelude.Compat

import Test.Hspec

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

-- Plain data types

infixl 4 :@:
data TyCon1 a b = TyConPrefix { tc1 :: a, tc2 :: b }
                | (:@:) { tc3 :: b, tc4 :: a }

infixl 3 :!!:
infix  4 :@@:
infixr 5 `TyConPlain`
infixr 6 `TyConFakeInfix`
data TyConPlain a b = (:!!:) a b
                    | a :@@: b
                    | a `TyConPlain` b
                    | TyConFakeInfix a b

data TyConGADT a b where
    (:.)    ::           c ->       d        -> TyConGADT c d
    (:..)   ::           e ->       f        -> TyConGADT e f
    (:...)  ::           g ->       h -> Int -> TyConGADT g h
    (:....) :: { tcg1 :: i, tcg2 :: j }      -> TyConGADT i j

data TyCon# a b = TyCon# {
    tcA       :: a
  , tcB       :: b
  , tcInt#    :: Int#
  , tcFloat#  :: Float#
  , tcDouble# :: Double#
  , tcChar#   :: Char#
  , tcWord#   :: Word#
}

data TyCon2 a b c d where
    TyConClassConstraints    :: (Ord m, Ord n, Ord o, Ord p)
                             => m -> n -> o -> p
                             -> TyCon2 m n o p

    TyConEqualityConstraints :: (e ~ g, f ~ h, e ~ f)
                                => e -> f -> g -> h
                             -> TyCon2 e f g h

    TyConTypeRefinement1,
      TyConTypeRefinement2   :: Int -> z
                             -> TyCon2 Int Int z z

    TyConForalls             :: forall p q r s t u.
                                (Show p, Show q)
                             => p -> q -> u -> t
                             -> TyCon2 r s t u

data TyConWrap f g h a = TyConWrap1 (f a)
                       | TyConWrap2 (f (g a))
                       | TyConWrap3 (f (g (h a)))

-- Data families

data family TyFamily1 y z :: *

infixl 4 :!:
data instance TyFamily1 a b = TyFamilyPrefix { tf1 :: a, tf2 :: b }
                            | (:!:)          { tf3 :: b, tf4 :: a }

data family TyFamilyPlain y z :: *

infixl 3 :#:
infix  4 :$:
infixr 5 `TyFamilyPlain`
infixr 6 `TyFamilyFakeInfix`
data instance TyFamilyPlain a b = (:#:) a b
                                 | a :$: b
                                 | a `TyFamilyPlain` b
                                 | TyFamilyFakeInfix a b


data family TyFamilyGADT y z :: *

infixr 1 :*, :***, :****
data instance TyFamilyGADT a b where
    (:*)    ::           c ->       d        -> TyFamilyGADT c d
    (:**)   ::           e ->       f        -> TyFamilyGADT e f
    (:***)  ::           g ->       h -> Int -> TyFamilyGADT g h
    (:****) :: { tfg1 :: i, tfg2 :: j }      -> TyFamilyGADT i j

data family TyFamily# y z :: *

data instance TyFamily# a b = TyFamily# {
    tfA       :: a
  , tfB       :: b
  , tfInt#    :: Int#
  , tfFloat#  :: Float#
  , tfDouble# :: Double#
  , tfChar#   :: Char#
  , tfWord#   :: Word#
}

data family TyFamily2 w x y z :: *

data instance TyFamily2 a b c d where
    TyFamilyClassConstraints    :: (Ord m, Ord n, Ord o, Ord p)
                                => m -> n -> o -> p
                                -> TyFamily2 m n o p

    TyFamilyEqualityConstraints :: (e ~ g, f ~ h, e ~ f)
                                => e -> f -> g -> h
                                -> TyFamily2 e f g h

    TyFamilyTypeRefinement1,
      TyFamilyTypeRefinement2   :: Int -> z
                                -> TyFamily2 Int Int z z

    TyFamilyForalls             :: forall p q r s t u.
                                   (Show p, Show q)
                                => p -> q -> u -> t
                                -> TyFamily2 r s t u

data family TyFamilyWrap (w :: * -> *) (x :: * -> *) (y :: * -> *) z :: *

data instance TyFamilyWrap f g h a = TyFamilyWrap1 (f a)
                                   | TyFamilyWrap2 (f (g a))
                                   | TyFamilyWrap3 (f (g (h a)))

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

-- Plain data types

$(deriveShow  ''TyCon1)
$(deriveShow  ''TyConPlain)
$(deriveShow  ''TyConGADT)
$(deriveShow  ''TyCon#)
$(deriveShow  ''TyCon2)
instance (Show (f a), Show (f (g a)), Show (f (g (h a))))
  => Show (TyConWrap f g h a) where
    showsPrec = $(makeShowsPrec ''TyConWrap)

$(deriveShow1 ''TyCon1)
$(deriveShow1 ''TyConPlain)
$(deriveShow1 ''TyConGADT)
$(deriveShow1 ''TyCon#)
$(deriveShow1 ''TyCon2)
#if defined(NEW_FUNCTOR_CLASSES)
$(deriveShow1 ''TyConWrap)
#else
instance (Show1 f, Functor f, Show1 g, Functor g, Show1 h)
  => Show1 (TyConWrap f g h) where
    showsPrec1 = $(makeShowsPrec1 ''TyConWrap)
#endif

#if defined(NEW_FUNCTOR_CLASSES)
$(deriveShow2 ''TyCon1)
$(deriveShow2 ''TyConPlain)
$(deriveShow2 ''TyConGADT)
$(deriveShow2 ''TyCon#)
$(deriveShow2 ''TyCon2)
#endif

#if MIN_VERSION_template_haskell(2,7,0)
-- Data families

$(deriveShow  'TyFamilyPrefix)
$(deriveShow  '(:#:))
$(deriveShow  '(:*))
$(deriveShow  'TyFamily#)
$(deriveShow  'TyFamilyClassConstraints)
instance (Show (f a), Show (f (g a)), Show (f (g (h a))))
  => Show (TyFamilyWrap f g h a) where
    showsPrec = $(makeShowsPrec 'TyFamilyWrap1)

$(deriveShow1 '(:!:))
$(deriveShow1 '(:$:))
$(deriveShow1 '(:**))
$(deriveShow1 'TyFamily#)
$(deriveShow1 'TyFamilyEqualityConstraints)
# if defined(NEW_FUNCTOR_CLASSES)
$(deriveShow1 'TyFamilyWrap2)
# else
instance (Show1 f, Functor f, Show1 g, Functor g, Show1 h)
  => Show1 (TyFamilyWrap f g h) where
    showsPrec1 = $(makeShowsPrec1 'TyFamilyWrap3)
# endif

# if defined(NEW_FUNCTOR_CLASSES)
$(deriveShow2 'TyFamilyPrefix)
$(deriveShow2 'TyFamilyPlain)
$(deriveShow2 '(:***))
$(deriveShow2 'TyFamily#)
$(deriveShow2 'TyFamilyTypeRefinement1)
# endif
#endif

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

main :: IO ()
main = hspec spec

spec :: Spec
spec = pure ()