From 80666e9b384277eb208fa99476634ee1559b3a7c Mon Sep 17 00:00:00 2001 From: Simon Hengel Date: Sun, 14 Oct 2012 00:21:07 +0200 Subject: Simplify RnM type --- src/Haddock/Interface/Rename.hs | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) (limited to 'src/Haddock/Interface/Rename.hs') diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs index 358fb964..792e571a 100644 --- a/src/Haddock/Interface/Rename.hs +++ b/src/Haddock/Interface/Rename.hs @@ -82,33 +82,32 @@ renameInterface dflags renamingEnv warnings iface = -------------------------------------------------------------------------------- -newtype GenRnM n a = - RnM { unRn :: (n -> (Bool, DocName)) -- name lookup function - -> (a,[n]) +newtype RnM a = + RnM { unRn :: (Name -> (Bool, DocName)) -- name lookup function + -> (a,[Name]) } -type RnM a = GenRnM Name a - -instance Monad (GenRnM n) where +instance Monad RnM where (>>=) = thenRn return = returnRn -instance Functor (GenRnM n) where +instance Functor RnM where fmap f x = do a <- x; return (f a) -instance Applicative (GenRnM n) where +instance Applicative RnM where pure = return (<*>) = ap -returnRn :: a -> GenRnM n a +returnRn :: a -> RnM a returnRn a = RnM (const (a,[])) -thenRn :: GenRnM n a -> (a -> GenRnM n b) -> GenRnM n b +thenRn :: RnM a -> (a -> RnM b) -> RnM b m `thenRn` k = RnM (\lkp -> case unRn m lkp of (a,out1) -> case unRn (k a) lkp of (b,out2) -> (b,out1++out2)) getLookupRn :: RnM (Name -> (Bool, DocName)) getLookupRn = RnM (\lkp -> (lkp,[])) + outRn :: Name -> RnM () outRn name = RnM (const ((),[name])) -- cgit v1.2.3