Commit b6a5e949 authored by twanvl's avatar twanvl
Browse files

Tests for DeriveFunctor

parent 80de94c5
......@@ -18,3 +18,5 @@ test('drv021', normal, compile, [''])
test('deriving-1935', normal, compile, [''])
test('T2378', normal, compile, [''])
test('T2856', normal, compile, [''])
test('drv-functor1', normal, compile, [''])
test('drv-functor2', normal, compile, [''])
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
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 = ComplexContraint (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)
......@@ -23,3 +23,5 @@ test('T2604', normal, compile_fail, [''])
test('T2701', normal, compile_fail, [''])
test('T2851', normal, compile_fail, [''])
test('T2721', normal, compile_fail, [''])
test('drvfail-functor1', normal, compile_fail, [''])
test('drvfail-functor2', normal, compile_fail, [''])
module ShouldFail where
-- Derive Functor without a DeriveFunctor language pragma
data List a = Nil | Cons a (List a)
deriving Functor
drvfail-functor1.hs:6:13:
Can't make a derived instance of `Functor List'
(You need -XDeriveFunctor to derive an instance for this class)
In the data type declaration for `List'
{-# LANGUAGE DeriveFunctor #-}
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-contraints 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)
drvfail-functor2.hs:7:13:
Can't make a derived instance of `Functor InFunctionArgument'
(`InFunctionArgument' uses the type variable in a function argument)
In the newtype declaration for `InFunctionArgument'
drvfail-functor2.hs:10:13:
Can't make a derived instance of `Functor OnSecondArg'
(`OnSecondArg' uses the type variable in an argument other than the last)
In the newtype declaration for `OnSecondArg'
drvfail-functor2.hs:15:13:
Cannot derive well-kinded instance of form `Functor (NoArguments ...)'
Class `Functor' expects an argument of kind `* -> *'
In the newtype declaration for `NoArguments'
drvfail-functor2.hs:20:13:
Can't derive instances where the instance context mentions
type variables that are not data type parameters
Offending constraint: Eq a
When deriving the instance for (Functor StupidConstraint)
drvfail-functor2.hs:26:13:
No instance for (Functor NoFunctor)
arising from the 'deriving' clause of a data type declaration
at drvfail-functor2.hs:26:13-19
Possible fix:
add an instance declaration for (Functor NoFunctor)
or use a standalone 'deriving instance' declaration instead,
so you can specify the instance context yourself
When deriving the instance for (Functor UseNoFunctor)
......@@ -26,3 +26,4 @@ test('drvrun020', normal, compile_and_run, [''])
test('drvrun021', normal, compile_and_run, [''])
test('drvrun022', normal, compile_and_run, ['-package syb'])
test('T2529', normal, compile_and_run, [''])
test('drvrun-functor1', normal, compile_and_run, [''])
{-# LANGUAGE DeriveFunctor #-}
module Main where
-- Derive functor for a simple data type
data List a = Nil | Cons a (List a)
deriving (Functor,Show)
someList = Cons 1 (Cons 1 (Cons 2 (Cons 3 Nil)))
doubleList = fmap (*2) someList
test1 = do
putStr "normal: " >> print someList
putStr "double: " >> print doubleList
-- Derive functor for a data type with functions and tuples
data ReaderWriter r w a = RW { runRW :: r -> (a,w) }
deriving (Functor)
data Cont r a = Cont { runCont :: (a -> r) -> r }
deriving (Functor)
test2 = do
let rw = RW (\r -> ("something",r*3))
putStr "normal: " >> print (runRW rw 123)
putStr "reverse: " >> print (runRW (fmap reverse rw) 456)
let five = Cont ($ 5)
putStr "normal: " >> runCont five print
putStr "double: " >> runCont (fmap (*2) five) print
-- Derive functor in such a way that we need a constraint
newtype Compose f g a = Compose (f (g a))
deriving (Functor,Show)
listOfLists = Compose [[1,2,3],[7,8,9]]
test3 = do
putStr "normal: " >> print listOfLists
putStr "double: " >> print (fmap (*2) listOfLists)
-- All tests
main = do
test1
test2
test3
normal: Cons 1 (Cons 1 (Cons 2 (Cons 3 Nil)))
double: Cons 2 (Cons 2 (Cons 4 (Cons 6 Nil)))
normal: ("something",369)
reverse: ("gnihtemos",1368)
normal: 5
double: 10
normal: Compose [[1,2,3],[7,8,9]]
double: Compose [[2,4,6],[14,16,18]]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment