Fix #886

examples/passing/InstanceBeforeClass.purs

@@ -0,0 +1,9 @@
+module Main where
+
+instance fooNumber :: Foo Number where
+  foo = 0
+
+class Foo a where
+  foo :: a
+
+main = Debug.Trace.trace "Done"

src/Language/PureScript/AST/Declarations.hs

@@ -261,11 +261,18 @@ isExternDecl (PositionedDeclaration _ _ d) = isExternDecl d
 isExternDecl _ = False
 
 -- |
--- Test if a declaration is a type class or instance declaration
+-- Test if a declaration is a type class instance declaration
+--
+isTypeClassInstanceDeclaration :: Declaration -> Bool
+isTypeClassInstanceDeclaration TypeInstanceDeclaration{} = True
+isTypeClassInstanceDeclaration (PositionedDeclaration _ _ d) = isTypeClassInstanceDeclaration d
+isTypeClassInstanceDeclaration _ = False
+
+-- |
+-- Test if a declaration is a type class declaration
 --
 isTypeClassDeclaration :: Declaration -> Bool
 isTypeClassDeclaration TypeClassDeclaration{} = True
-isTypeClassDeclaration TypeInstanceDeclaration{} = True
 isTypeClassDeclaration (PositionedDeclaration _ _ d) = isTypeClassDeclaration d
 isTypeClassDeclaration _ = False
 

src/Language/PureScript/Sugar/BindingGroups.hs

@@ -78,6 +78,7 @@ createBindingGroups moduleName = mapM f <=< handleDecls
              filter isExternInstanceDecl ds ++
              dataBindingGroupDecls ++
              filter isTypeClassDeclaration ds ++
+             filter isTypeClassInstanceDeclaration ds ++
              filter isFixityDecl ds ++
              filter isExternDecl ds ++
              bindingGroupDecls

src/Language/PureScript/Sugar/TypeClasses.hs

@@ -38,7 +38,7 @@ import Control.Applicative
 import Control.Arrow (first, second)
 import Control.Monad.Except
 import Control.Monad.State
-import Data.List ((\\), find)
+import Data.List ((\\), find, sortBy)
 import Data.Maybe (catMaybes, mapMaybe, isJust)
 
 import qualified Data.Map as M
@@ -56,8 +56,14 @@ desugarTypeClasses = flip evalStateT M.empty . mapM desugarModule
 
 desugarModule :: (Functor m, Applicative m, MonadSupply m, MonadError ErrorStack m) => Module -> Desugar m Module
 desugarModule (Module coms name decls (Just exps)) = do
-  (newExpss, declss) <- unzip <$> parU decls (desugarDecl name exps)
+  (newExpss, declss) <- unzip <$> parU (sortBy classesFirst decls) (desugarDecl name exps)
   return $ Module coms name (concat declss) $ Just (exps ++ catMaybes newExpss)
+  where
+  classesFirst :: Declaration -> Declaration -> Ordering
+  classesFirst d1 d2 
+    | isTypeClassDeclaration d1 && not (isTypeClassDeclaration d2) = LT
+    | not (isTypeClassDeclaration d1) && isTypeClassDeclaration d2 = GT
+    | otherwise = EQ
 desugarModule _ = error "Exports should have been elaborated in name desugaring"
 
 {- Desugar type class and type class instance declarations