1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
#if MIN_VERSION_template_haskell(2,12,0)
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE TypeApplications #-}
#endif
{-|
Module: DerivingViaSpec
Copyright: (C) 2015-2017 Ryan Scott
License: BSD-style (see the file LICENSE)
Maintainer: Ryan Scott
Portability: Template Haskell
@hspec@ tests for 'deriveGND' and 'deriveVia'.
-}
module DerivingViaSpec where
import Prelude ()
import Prelude.Compat
import Test.Hspec
#if MIN_VERSION_template_haskell(2,12,0)
import Data.Deriving.Via
class Container (f :: * -> *) where
type Inside f a
peekInside :: f a -> Inside f a
instance Container (Either a) where
type Inside (Either a) b = Maybe b
peekInside (Left{}) = Nothing
peekInside (Right x) = Just x
newtype Down a = MkDown a deriving Show
$(deriveGND [t| forall a. Eq a => Eq (Down a) |])
instance Ord a => Ord (Down a) where
compare (MkDown x) (MkDown y) = y `compare` x
newtype Id a = MkId a deriving Show
$(deriveGND [t| forall a. Eq a => Eq (Id a) |])
$(deriveVia [t| forall a. Ord a => Ord (Id a) `Via` Down a |])
instance Container Id where
type Inside Id a = a
peekInside (MkId x) = x
newtype MyEither a b = MkMyEither (Either a b) deriving Show
$(deriveGND [t| forall a. Functor (MyEither a) |])
$(deriveVia [t| forall a b. (Eq a, Eq b) => Eq (MyEither a b) `Via` Id (Either a b) |])
$(deriveVia [t| forall a. Applicative (MyEither a) `Via` (Either a) |])
$(deriveVia [t| forall a. Container (MyEither a) `Via` (Either a) |])
newtype Wrap f a = MkWrap (f a) deriving Show
$(deriveGND [t| forall f. Container f => Container (Wrap f) |])
class MFunctor (t :: (* -> *) -> * -> *) where
hoist :: (forall a. m a -> n a) -> t m b -> t n b
newtype TaggedTrans tag trans (m :: * -> *) a = MkTaggedTrans (trans m a) deriving Show
$(deriveGND [t| forall tag trans. MFunctor trans => MFunctor (TaggedTrans tag trans) |])
#endif
main :: IO ()
main = hspec spec
spec :: Spec
spec = parallel $ do
#if MIN_VERSION_template_haskell(2,12,0)
describe "Id" $
it "should compare items in reverse order" $
compare (MkId "hello") (MkId "world") `shouldBe` GT
#endif
pure ()
|
