github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-25 16:02:43 +03:00
Code Issues Projects Releases Wiki Activity

Define an HFunctor instance for Scope.

Browse Source
This commit is contained in:
Rob Rix 2019-07-15 13:00:22 -04:00
parent e135751ecc
commit 5a0799f471
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 4 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
semantic-core/src/Data/Scope.hs
View File

@ -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)