From 5a0799f471cc82a61fc93c5927c46bcd797e60e5 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 15 Jul 2019 13:00:22 -0400 Subject: [PATCH] Define an HFunctor instance for Scope. --- semantic-core/src/Data/Scope.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/semantic-core/src/Data/Scope.hs b/semantic-core/src/Data/Scope.hs index 2eef6e296..13a4e4b4a 100644 --- a/semantic-core/src/Data/Scope.hs +++ b/semantic-core/src/Data/Scope.hs @@ -15,6 +15,7 @@ module Data.Scope ) where import Control.Applicative (liftA2) +import Control.Effect.Carrier import Control.Monad ((>=>), guard) import Control.Monad.Trans.Class import Data.Function (on) @@ -46,6 +47,9 @@ incr z s = \case { Z a -> z a ; S b -> s b } newtype Scope a f b = Scope { unScope :: f (Incr a (f b)) } deriving (Foldable, Functor, Traversable) +instance HFunctor (Scope a) where + hmap f = Scope . f . fmap (fmap f) . unScope + instance (Eq a, Eq b, forall a . Eq a => Eq (f a), Monad f) => Eq (Scope a f b) where (==) = (==) `on` (unScope >=> sequenceA)