From 03b453cb361bba98c87f1d89270e689b4e366baa Mon Sep 17 00:00:00 2001
From: Scott Olsen <scg.olsen@gmail.com>
Date: Sat, 4 Sep 2021 07:27:07 -0500
Subject: [PATCH] fix: ensure interface values aren't discarded (#1308)

A call to sequence in our handling of polymorphics would result in
discarding legitimate interface implementation results in rare cases.
Calling rights instead fixes the issue. We also need to take the union
of the results to ensure we account for cases such as polymorphically
realized interfaces (e.g. the `prn` function for a (Maybe String), other
wise, we don't resolve to concrete polymorphics for types that have
ad hoc polymorphic members.

Fixes #1307
---
 src/Polymorphism.hs | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/src/Polymorphism.hs b/src/Polymorphism.hs
index 1973cde6..0e6e69a5 100644
--- a/src/Polymorphism.hs
+++ b/src/Polymorphism.hs
@@ -7,7 +7,8 @@ module Polymorphism
   )
 where
 
-import Data.Either (fromRight)
+import Data.Either (fromRight, rights)
+import Data.List (unionBy)
 import Env
 import Managed
 import Obj
@@ -54,14 +55,16 @@ allImplementations typeEnv env functionName functionType =
     foundBindings = case getTypeBinder typeEnv functionName of
       -- this function is an interface; lookup implementations
       Right (Binder _ (XObj (Lst (XObj (Interface _ paths) _ _ : _)) _ _)) ->
-        case sequence $ map (\p -> searchValue env p) (paths ++ [(SymPath [] functionName)]) of
-          Right found -> found
-          Left _ ->
-            case findPoly env functionName functionType of
-              Right r -> [r]
-              Left _ -> (lookupEverywhere env functionName)
+        case rights $ map (\p -> searchValue env p) (paths ++ [(SymPath [] functionName)]) of
+          [] -> getPoly
+          -- getPoly might return some functions we already found. Use set ops
+          -- to remove duplicates.
+          found -> (unionBy (\x y -> (snd x) == (snd y)) found getPoly)
       -- just a regular function; look for it
       _ -> fromRight [] ((fmap (: []) (Env.getValue env functionName)) <> pure (lookupEverywhere env functionName))
+    getPoly = case findPoly env functionName functionType of
+                Right r -> [r]
+                Left _ -> (lookupEverywhere env functionName)
 
 -- | The various results when trying to find a function using 'findFunctionForMember'.
 data FunctionFinderResult