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