Merge remote-tracking branch 'origin/fix-graph-errors' into typescript-graphs

src/Data/Syntax.hs

@@ -99,7 +99,7 @@ infixContext context left right operators = uncurry (&) <$> postContextualizeThr
 
 -- | An identifier of some other construct, whether a containing declaration (e.g. a class name) or a reference (e.g. a variable).
 newtype Identifier a = Identifier Name
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 Identifier where liftEq = genericLiftEq
 instance Ord1 Identifier where liftCompare = genericLiftCompare
@@ -111,6 +111,8 @@ instance Evaluatable Identifier where
 instance FreeVariables1 Identifier where
   liftFreeVariables _ (Identifier x) = pure x
 
+instance Declarations1 Identifier where
+  liftDeclaredName _ (Identifier x) = pure x
 
 newtype Program a = Program [a]
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)

src/Data/Syntax/Declaration.hs

@@ -27,6 +27,9 @@ instance Evaluatable Function where
     pure v
     where paramNames = foldMap (freeVariables . subterm)
 
+instance Declarations a => Declarations (Function a) where
+  declaredName Function{..} = declaredName functionName
+
 
 data Method a = Method { methodContext :: ![a], methodReceiver :: !a, methodName :: !a, methodParameters :: ![a], methodBody :: !a }
   deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
@@ -98,6 +101,12 @@ instance Evaluatable VariableDeclaration where
   eval (VariableDeclaration [])   = unit
   eval (VariableDeclaration decs) = multiple =<< traverse subtermValue decs
 
+instance Declarations a => Declarations (VariableDeclaration a) where
+  declaredName (VariableDeclaration vars) = case vars of
+    [var] -> declaredName var
+    _     -> Nothing
+
+
 -- | A TypeScript/Java style interface declaration to implement.
 data InterfaceDeclaration a = InterfaceDeclaration { interfaceDeclarationContext :: ![a], interfaceDeclarationIdentifier :: !a, interfaceDeclarationBody :: !a }
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
@@ -109,6 +118,9 @@ instance Show1 InterfaceDeclaration where liftShowsPrec = genericLiftShowsPrec
 -- TODO: Implement Eval instance for InterfaceDeclaration
 instance Evaluatable InterfaceDeclaration
 
+instance Declarations a => Declarations (InterfaceDeclaration a) where
+  declaredName InterfaceDeclaration{..} = declaredName interfaceDeclarationIdentifier
+
 
 -- | A public field definition such as a field definition in a JavaScript class.
 data PublicFieldDefinition a = PublicFieldDefinition { publicFieldContext :: ![a], publicFieldPropertyName :: !a, publicFieldValue :: !a }
@@ -135,8 +147,8 @@ instance Evaluatable Variable
 data Class a = Class { classContext :: ![a], classIdentifier :: !a, classSuperclasses :: ![a], classBody :: !a }
   deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
-instance FreeVariables a => Declarations (Class a) where
-  declaredName (Class _ name _ _) = either (const Nothing) Just (freeVariable name)
+instance Declarations a => Declarations (Class a) where
+  declaredName (Class _ name _ _) = declaredName name
 
 instance Diffable Class where
   equivalentBySubterm = Just . classIdentifier
@@ -227,3 +239,6 @@ instance Show1 TypeAlias where liftShowsPrec = genericLiftShowsPrec
 
 -- TODO: Implement Eval instance for TypeAlias
 instance Evaluatable TypeAlias
+
+instance Declarations a => Declarations (TypeAlias a) where
+  declaredName TypeAlias{..} = declaredName typeAliasIdentifier

src/Language/TypeScript/Syntax.hs

@@ -437,7 +437,7 @@ instance Show1 AmbientDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable AmbientDeclaration where
   eval (AmbientDeclaration body) = subtermValue body
 
-data EnumDeclaration a = EnumDeclaration { _enumDeclarationIdentifier :: !a, _enumDeclarationBody :: ![a] }
+data EnumDeclaration a = EnumDeclaration { enumDeclarationIdentifier :: !a, _enumDeclarationBody :: ![a] }
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 EnumDeclaration where liftEq = genericLiftEq
@@ -445,6 +445,9 @@ instance Ord1 EnumDeclaration where liftCompare = genericLiftCompare
 instance Show1 EnumDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable EnumDeclaration
 
+instance Declarations a => Declarations (EnumDeclaration a) where
+  declaredName EnumDeclaration{..} = declaredName enumDeclarationIdentifier
+
 newtype ExtendsClause a = ExtendsClause { _extendsClauses :: [a] }
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
@@ -626,6 +629,9 @@ instance Evaluatable InternalModule where
     letrec' name $ \addr ->
       eval xs <* makeNamespace name addr []
 
+instance Declarations a => Declarations (InternalModule a) where
+  declaredName InternalModule{..} = declaredName internalModuleIdentifier
+
 
 data ImportAlias a = ImportAlias { _importAliasSubject :: !a, _importAlias :: !a }
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
@@ -659,13 +665,15 @@ instance Ord1 ClassHeritage where liftCompare = genericLiftCompare
 instance Show1 ClassHeritage where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ClassHeritage
 
-data AbstractClass a = AbstractClass { _abstractClassIdentifier :: !a,  _abstractClassTypeParameters :: !a, _classHeritage :: ![a], _classBody :: !a }
+data AbstractClass a = AbstractClass { abstractClassIdentifier :: !a,  _abstractClassTypeParameters :: !a, _classHeritage :: ![a], _classBody :: !a }
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 AbstractClass where liftEq = genericLiftEq
 instance Ord1 AbstractClass where liftCompare = genericLiftCompare
 instance Show1 AbstractClass where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable AbstractClass
+instance Declarations a => Declarations (AbstractClass a) where
+  declaredName AbstractClass{..} = declaredName abstractClassIdentifier
 
 data JsxElement a = JsxElement { _jsxOpeningElement :: !a,  _jsxElements :: ![a], _jsxClosingElement :: !a }
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)