1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveFunctor #-}
3{-# LANGUAGE EmptyDataDecls #-}
4{-# LANGUAGE StandaloneDeriving #-}
5{-# LANGUAGE TemplateHaskell #-}
6{-# LANGUAGE TypeFamilies #-}
7
8#if __GLASGOW_HASKELL__ >= 702
9{-# LANGUAGE DeriveGeneric #-}
10#endif
11-----------------------------------------------------------------------------
12-- |
13-- Module      :  GenericSpec
14-- Copyright   :  (C) 2011-2016 Edward Kmett
15-- License     :  BSD-style (see the file LICENSE)
16--
17-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
18-- Stability   :  provisional
19--
20-- Tests for generically derived 'Distributive' instances.
21----------------------------------------------------------------------------
22module GenericsSpec (main, spec) where
23
24import Test.Hspec
25
26#if __GLASGOW_HASKELL__ >= 702
27import           Data.Distributive (Distributive(..))
28import           Data.Distributive.Generic (genericCollect, genericDistribute)
29
30# if __GLASGOW_HASKELL__ >= 706
31import           Generics.Deriving.Base hiding (Rep)
32# else
33import qualified Generics.Deriving.TH as Generics (deriveAll1)
34# endif
35#endif
36
37main :: IO ()
38main = hspec spec
39
40spec :: Spec
41#if __GLASGOW_HASKELL__ < 702
42spec = return ()
43#else
44spec = do
45  describe "Id" $
46    it "distribute idExample = idExample" $
47      distribute idExample `shouldBe` idExample
48  describe "Stream" $
49    it "runId (shead (stail (distribute streamExample))) = 1" $
50      runId (shead (stail (distribute streamExample))) `shouldBe` 1
51  describe "PolyRec" $
52    it "runId (plast (runId (pinit (distribute polyRecExample)))) = 1" $
53      runId (plast (runId (pinit (distribute polyRecExample)))) `shouldBe` 1
54
55newtype Id a = Id { runId :: a }
56  deriving (Eq, Functor, Show)
57instance Distributive Id where
58  collect    = genericCollect
59  distribute = genericDistribute
60
61idExample :: Id (Id Int)
62idExample = Id (Id 42)
63
64data Stream a = (:>) { shead :: a, stail :: Stream a }
65  deriving Functor
66instance Distributive Stream where
67  collect    = genericCollect
68  distribute = genericDistribute
69
70streamExample :: Id (Stream Int)
71streamExample = Id $ let s = 0 :> fmap (+1) s in s
72
73data PolyRec a = PolyRec { pinit :: Id (PolyRec a), plast :: a }
74  deriving Functor
75instance Distributive PolyRec where
76  collect    = genericCollect
77  distribute = genericDistribute
78
79polyRecExample :: Id (PolyRec Int)
80polyRecExample = Id $ let p = PolyRec (Id $ fmap (+1) p) 0 in p
81
82# if __GLASGOW_HASKELL__ >= 706
83deriving instance Generic1 Id
84deriving instance Generic1 Stream
85deriving instance Generic1 PolyRec
86# else
87$(Generics.deriveAll1 ''Id)
88$(Generics.deriveAll1 ''Stream)
89$(Generics.deriveAll1 ''PolyRec)
90# endif
91#endif
92