Permalink
Browse files

Make 'c' superclass of GTraversable

  • Loading branch information...
feuerbach committed Mar 14, 2013
1 parent 6ab0d81 commit d12da16d86629fd2f8385834363bf03353caf80d
Showing with 13 additions and 11 deletions.
  1. +1 −1 Data/Generics/Traversable/Core.hs
  2. +9 −9 Data/Generics/Traversable/Instances.hs
  3. +3 −1 Data/Generics/Traversable/TH.hs
@@ -4,7 +4,7 @@ module Data.Generics.Traversable.Core where
import GHC.Exts (Constraint)
import Control.Applicative
-class GTraversable (c :: * -> Constraint) a where
+class c a => GTraversable (c :: * -> Constraint) a where
-- | Applicative traversal over (a subset of) immediate subterms. This is
-- a generic version of 'traverse' from "Data.Traversable".
--
@@ -7,22 +7,22 @@ import Data.Generics.Traversable.Core
import Data.Generics.Traversable.TH
import Control.Applicative
-instance GTraversable c ()
-instance GTraversable c Bool
-instance GTraversable c Int
-instance GTraversable c Integer
-instance GTraversable c Float
-instance GTraversable c Double
-instance GTraversable c Char
-instance GTraversable c Ordering
+instance c () => GTraversable c ()
+instance c Bool => GTraversable c Bool
+instance c Int => GTraversable c Int
+instance c Integer => GTraversable c Integer
+instance c Float => GTraversable c Float
+instance c Double => GTraversable c Double
+instance c Char => GTraversable c Char
+instance c Ordering => GTraversable c Ordering
deriveGTraversable ''Maybe
deriveGTraversable ''Either
deriveGTraversable ''(,)
deriveGTraversable ''(,,)
-- Uniform instance for lists
-instance (GTraversable c a, c a) => GTraversable c [a] where
+instance (GTraversable c a, c a, c [a]) => GTraversable c [a] where
gtraverse f = go where
go [] = pure []
go (x:xs) = (:) <$> f x <*> go xs
@@ -85,7 +85,9 @@ deriveGTraversable name = do
funD 'gtraverse [ clause [] (normalB $ gtraverseExpr typeName) [] ]
]
- context = sequence $ gtraversableContext ++ userContext
+ context = sequence $ gtraversableContext ++ userContext ++ selfContext
+
+ selfContext = [ classP ctx $ pure appliedType ]
gtraversableContext = [ classP ''GTraversable [varT ctx, varT name ] | name <- typeParams ]

0 comments on commit d12da16

Please sign in to comment.