@@ -30,8 +30,10 @@ import Language.PureScript.CodeGen.Common (identToJs)
30import qualified Language.PureScript.Constants as C
30import qualified Language.PureScript.Constants as C
32import Control.Applicative
32import Control.Applicative
33+import Control.Monad.Error
33import Control.Monad.State
34import Control.Monad.State
34import Control.Arrow (first, second)
35import Control.Arrow (first, second)
36+import Data.Monoid ((<>))
35import Data.Maybe (catMaybes)
37import Data.Maybe (catMaybes)
37import qualified Data.Map as M
39import qualified Data.Map as M
@@ -166,7 +168,8 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls = do
166 -- Replace the type arguments with the appropriate types in the member types
168 -- Replace the type arguments with the appropriate types in the member types
167 let memberTypes = map (second (replaceAllTypeVars (zip args tys))) instanceTys
169 let memberTypes = map (second (replaceAllTypeVars (zip args tys))) instanceTys
168 -- Create values for the type instance members
170 -- Create values for the type instance members
171+ memberNames <- rethrow (strMsg ("Error in type class " ++ show className ++ ":") <>) $
169− memberNames <- map (first identToProperty) <$> mapM (memberToNameAndValue memberTypes) decls
172+ map (first identToProperty) <$> mapM (memberToNameAndValue memberTypes) decls
170 -- Create the type of the dictionary
173 -- Create the type of the dictionary
171 -- The type is an object type, but depending on type instance dependencies, may be constrained.
174 -- The type is an object type, but depending on type instance dependencies, may be constrained.
172 -- The dictionary itself is an object literal, but for reasons related to recursion, the dictionary
175 -- The dictionary itself is an object literal, but for reasons related to recursion, the dictionary
@@ -188,7 +191,7 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls = do
189 memberToNameAndValue :: [(Ident, Type)] -> Declaration -> Desugar (Ident, Value)
192 memberToNameAndValue :: [(Ident, Type)] -> Declaration -> Desugar (Ident, Value)
190 memberToNameAndValue tys' d@(ValueDeclaration ident _ _ _ _) = do
193 memberToNameAndValue tys' d@(ValueDeclaration ident _ _ _ _) = do
191− _ <- lift . maybe (Left $ mkErrorStack "Type class member type not found" Nothing) Right $ lookup ident tys'
194+ _ <- lift . maybe (Left $ mkErrorStack ("Type class does not define member '" ++ show ident ++ "'") Nothing) Right $ lookup ident tys'
192 let memberValue = typeInstanceDictionaryEntryValue d
195 let memberValue = typeInstanceDictionaryEntryValue d
193 return (ident, memberValue)
196 return (ident, memberValue)
194 memberToNameAndValue tys' (PositionedDeclaration pos d) = rethrowWithPosition pos $ do
197 memberToNameAndValue tys' (PositionedDeclaration pos d) = rethrowWithPosition pos $ do