mirror of
https://github.com/github/semantic.git
synced 2024-12-24 23:42:31 +03:00
Define an HFunctor instance for Scope.
This commit is contained in:
parent
e135751ecc
commit
5a0799f471
@ -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)
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user