Named type class instances

purerl · Mar 5, 2014 · 8b6c26e · 8b6c26e
1 parent 17ccc92
commit 8b6c26e
Show file tree

Hide file tree

Showing 21 changed files with 161 additions and 180 deletions.
diff --git a/RELEASE-0.5.md b/RELEASE-0.5.md
@@ -3,6 +3,10 @@
 ## Breaking Changes
 
 - Support for blocks has been removed. (paf31)
+- Type class instances must now be named (paf31)
+
+    instance showNumber :: Show Number where
+      ...
 
 ### New Features
 
@@ -24,6 +28,7 @@
 - PSCI history is in XDG config (joneshf)
 - PSCI allows loading of modules from ~ paths (joneshf)
 - PSCI can accept a list of modules to load on start from the command line (paf31)
+- Type class instances are now named, to enable easier interop with Javascript (paf31)
 
 ### Bug Fixes
 

diff --git a/docgen/Main.hs b/docgen/Main.hs
@@ -102,11 +102,11 @@ renderDeclaration n (P.TypeSynonymDeclaration name args ty) = do
 renderDeclaration n (P.TypeClassDeclaration name args ds) = do
   atIndent n $ "class " ++ P.runProperName name ++ " " ++ unwords args ++ " where"
   mapM_ (renderDeclaration (n + 2)) ds
-renderDeclaration n (P.TypeInstanceDeclaration constraints name tys _) = do
+renderDeclaration n (P.TypeInstanceDeclaration name constraints className tys _) = do
   let constraintsText = case constraints of
                           [] -> ""
                           cs -> "(" ++ intercalate "," (map (\(pn, tys') -> show pn ++ " (" ++ unwords (map (("(" ++) . (++ ")") . P.prettyPrintType) tys') ++ ")") cs) ++ ") => "
-  atIndent n $ constraintsText ++ "instance " ++ show name ++ " " ++ unwords (map (("(" ++) . (++ ")") . P.prettyPrintType) tys)
+  atIndent n $ constraintsText ++ "instance " ++ show name ++ " :: " ++ show className ++ " " ++ unwords (map (("(" ++) . (++ ")") . P.prettyPrintType) tys)
 renderDeclaration _ _ = return ()
 
 getName :: P.Declaration -> String
@@ -116,7 +116,7 @@ getName (P.DataDeclaration name _ _) = P.runProperName name
 getName (P.ExternDataDeclaration name _) = P.runProperName name
 getName (P.TypeSynonymDeclaration name _ _) = P.runProperName name
 getName (P.TypeClassDeclaration name _ _) = P.runProperName name
-getName (P.TypeInstanceDeclaration _ name _ _) = show name
+getName (P.TypeInstanceDeclaration name _ _ _ _) = show name
 getName _ = error "Invalid argument to getName"
 
 isValueDeclaration :: P.Declaration -> Bool

diff --git a/examples/passing/Applicative.purs b/examples/passing/Applicative.purs
@@ -6,7 +6,7 @@ class Applicative f where
 
 data Maybe a = Nothing | Just a
 
-instance Applicative Maybe where
+instance applicativeMaybe :: Applicative Maybe where
   pure = Just
   (<*>) (Just f) (Just a) = Just (f a)
   (<*>) _ _ = Nothing

diff --git a/examples/passing/ArrayType.purs b/examples/passing/ArrayType.purs
@@ -8,7 +8,7 @@ class Functor f where
 
 foreign import (:) :: forall a. a -> [a] -> [a]
 
-instance Functor [] where
+instance functorArray :: Functor [] where
   fmap _ [] = []
   fmap f (x:xs) = f x : fmap f xs
 

diff --git a/examples/passing/Do.purs b/examples/passing/Do.purs
@@ -4,7 +4,7 @@ import Prelude
 
 data Maybe a = Nothing | Just a
 
-instance Prelude.Monad Maybe where
+instance monadMaybe :: Prelude.Monad Maybe where
   return = Just
   (>>=) Nothing _ = Nothing
   (>>=) (Just a) f = f a

diff --git a/examples/passing/DottedModules.purs b/examples/passing/DottedModules.purs
@@ -12,7 +12,7 @@ module Main where
   import Prelude
   import Some.Module.Name
 
-  instance Some.Module.Name.Foo String where
+  instance fooString :: Some.Module.Name.Foo String where
     foo s = s
 
   unwrap (Text x) = x

diff --git a/examples/passing/EmptyTypeClass.purs b/examples/passing/EmptyTypeClass.purs
@@ -7,7 +7,7 @@ head (x:xs) = x
 
 module AllowPartialFns where
 
-instance EmptyTypeClass.Partial
+instance allowPartials :: EmptyTypeClass.Partial
 
 module Main where
 

diff --git a/examples/passing/MPTCs.purs b/examples/passing/MPTCs.purs
@@ -6,19 +6,19 @@ import Data.Array
 class NullaryTypeClass where
   greeting :: String
 
-instance NullaryTypeClass where
+instance nullaryTypeClass :: NullaryTypeClass where
   greeting = "Hello, World!"
 
 class Coerce a b where
   coerce :: a -> b
 
-instance Coerce a a where
+instance coerceRefl :: Coerce a a where
   coerce a = a
 
-instance (Prelude.Show a) => Coerce a String where
+instance coerceShow :: (Prelude.Show a) => Coerce a String where
   coerce = show
 
-instance (Coerce a b) => Coerce [a] [b] where
+instance coerceArray :: (Coerce a b) => Coerce [a] [b] where
   coerce = map coerce
 
 main = Debug.Trace.print $ coerce [greeting] :: [String]
diff --git a/examples/passing/MonadState.purs b/examples/passing/MonadState.purs
@@ -11,12 +11,12 @@ data State s a = State (s -> Tuple s a)
 
 runState s (State f) = f s
 
-instance Prelude.Monad (State s) where
+instance monadState :: Prelude.Monad (State s) where
   return a = State $ \s -> Tuple s a
   (>>=) f g = State $ \s -> let (Tuple s1 a) = runState s f in 
                             runState s1 (g a)
 
-instance MonadState s (State s) where
+instance monadStateState :: MonadState s (State s) where
   get = State (\s -> Tuple s s)
   put s = State (\_ -> Tuple s {})
 

diff --git a/examples/passing/RuntimeScopeIssue.purs b/examples/passing/RuntimeScopeIssue.purs
@@ -8,11 +8,11 @@ class A a where
 class B a where
   b :: a -> Boolean
 
-instance A Number where
+instance aNumber :: A Number where
   a 0 = true
   a n = b (n - 1)
 
-instance B Number where
+instance bNumber :: B Number where
   b 0 = false
   b n = a (n - 1)
 

diff --git a/examples/passing/TypeClasses.purs b/examples/passing/TypeClasses.purs
@@ -16,18 +16,18 @@ test8 = \_ -> show $ "testing"
 
 data Data a = Data a
 
-instance (Prelude.Show a) => Prelude.Show (Data a) where
+instance showData :: (Prelude.Show a) => Prelude.Show (Data a) where
   show (Data a) = "Data (" ++ show a ++ ")"
 
 test3 = \_ -> show (Data "testing")
 
-instance Prelude.Monad Data where
+instance monadData :: Prelude.Monad Data where
   return = Data
   (>>=) (Data a) f = f a
 
 data Maybe a = Nothing | Just a
 
-instance Prelude.Monad Maybe where
+instance monadMaybe :: Prelude.Monad Maybe where
   return = Just
   (>>=) Nothing _ = Nothing
   (>>=) (Just a) f = f a
@@ -42,13 +42,13 @@ module TypeClasses2 where
 import Prelude
 import TypeClasses
 
-instance (Prelude.Show a) => Prelude.Show [a] where
+instance showArray :: (Prelude.Show a) => Prelude.Show [a] where
   show [] = "[]"
   show (x:xs) = show x ++ ", " ++ show xs
 
 test6 = \_ -> show ["testing"]
 
-instance Prelude.Monad ((->) r) where
+instance monadFunction :: Prelude.Monad ((->) r) where
   return a r = a
   (>>=) f g r = g (f r) r
 

diff --git a/examples/passing/TypeClassesInOrder.purs b/examples/passing/TypeClassesInOrder.purs
@@ -5,7 +5,7 @@ import Prelude
 class Foo a where
   foo :: a -> String
 
-instance Foo String where
+instance fooString :: Foo String where
   foo s = s
 
 main = Debug.Trace.trace $ foo "Done"
diff --git a/examples/passing/TypeClassesWithOverlappingTypeVariables.purs b/examples/passing/TypeClassesWithOverlappingTypeVariables.purs
@@ -3,7 +3,7 @@ module Main where
   import Prelude
   import Data.Either
 
-  instance Prelude.Functor (Either a) where
+  instance functorEither :: Prelude.Functor (Either a) where
     (<$>) _ (Left x) = Left x
     (<$>) f (Right y) = Right (f y)