From dd5cf213d648f758afd03441e9e087ffba1d1881 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 6 Dec 2019 14:49:57 -0500
Subject: [PATCH] Derive HFoldable instances for syntax types.

---
 semantic-core/src/Core/Core.hs                 |  7 ++++---
 semantic-python/src/Language/Python/Failure.hs | 18 +++++++++---------
 2 files changed, 13 insertions(+), 12 deletions(-)

diff --git a/semantic-core/src/Core/Core.hs b/semantic-core/src/Core/Core.hs
index 1e584cd53..d90c5b859 100644
--- a/semantic-core/src/Core/Core.hs
+++ b/semantic-core/src/Core/Core.hs
@@ -48,6 +48,7 @@ import Data.Text (Text)
 import GHC.Generics (Generic1)
 import GHC.Stack
 import Source.Span
+import Syntax.Foldable
 import Syntax.Module
 import Syntax.Scope
 import Syntax.Stack
@@ -91,6 +92,7 @@ infixl 9 :.
 infix  3 :=
 
 instance HFunctor Core
+instance HFoldable Core
 instance HTraversable Core
 
 deriving instance (Eq   a, forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Core f a)
@@ -232,9 +234,8 @@ data Ann ann f a
   deriving (Eq, Foldable, Functor, Generic1, Ord, Show, Traversable)
 
 instance HFunctor (Ann ann)
-
-instance HTraversable (Ann ann) where
-  htraverse f (Ann a x) = Ann a <$> f x
+instance HFoldable (Ann ann)
+instance HTraversable (Ann ann)
 
 instance RightModule (Ann ann) where
   Ann l b >>=* f = Ann l (b >>= f)
diff --git a/semantic-python/src/Language/Python/Failure.hs b/semantic-python/src/Language/Python/Failure.hs
index 599a12119..81c9f98ce 100644
--- a/semantic-python/src/Language/Python/Failure.hs
+++ b/semantic-python/src/Language/Python/Failure.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE DeriveFoldable, DeriveFunctor, DeriveTraversable, ExistentialQuantification, FlexibleContexts,
-             KindSignatures, LambdaCase, MultiParamTypeClasses, QuantifiedConstraints, RankNTypes, StandaloneDeriving,
-             TypeOperators #-}
+{-# LANGUAGE DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, ExistentialQuantification,
+             FlexibleContexts, KindSignatures, LambdaCase, MultiParamTypeClasses, QuantifiedConstraints, RankNTypes,
+             StandaloneDeriving, TypeOperators #-}
 
 module Language.Python.Failure
   ( Failure (..)
@@ -15,6 +15,8 @@ import Control.Effect.Carrier
 import Control.Monad.Fail
 import Data.Coerce
 import Data.Kind
+import GHC.Generics (Generic1)
+import Syntax.Foldable
 import Syntax.Module
 import Syntax.Term
 import Syntax.Traversable
@@ -32,16 +34,14 @@ deriving instance Functor (Failure f)
 deriving instance Foldable (Failure f)
 deriving instance Traversable (Failure f)
 
-instance HFunctor Failure where hmap _ = coerce
-
-instance HTraversable Failure where
-  htraverse _ = \case
-    Unimplemented x -> pure (Unimplemented x)
-    InvariantViolated y -> pure (InvariantViolated y)
+instance HFunctor Failure
+instance HFoldable Failure
+instance HTraversable Failure
 
 instance RightModule Failure where
   a >>=* _ = coerce a
 
+
 unimplemented :: (Show ast, Member Failure sig, Carrier sig m) => ast -> m a
 unimplemented = send . Unimplemented . show