Remove dependency on transformers

well-typed · Apr 25, 2024 · 9ab8251 · 9ab8251
1 parent 4faad25
commit 9ab8251
Show file tree

Hide file tree

Showing 3 changed files with 27 additions and 33 deletions.
diff --git a/trace-foreign-calls/src/Plugin/TraceForeignCalls/Instrument.hs b/trace-foreign-calls/src/Plugin/TraceForeignCalls/Instrument.hs
@@ -18,15 +18,11 @@ module Plugin.TraceForeignCalls.Instrument (
 
 import Control.Monad
 import Control.Monad.IO.Class
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.Reader
 
 import GHC
-import GHC.Plugins
+import GHC.Plugins hiding (getHscEnv)
 
-import GHC.Driver.Hooks
 import GHC.Tc.Types
-import GHC.Types.TyThing
 import GHC.Utils.Logger
 
 import Plugin.TraceForeignCalls.Options
@@ -47,22 +43,13 @@ data TracerEnv = TracerEnv {
     , tracerEnvNames   :: Names
     }
 
-newtype Instrument a = Wrap { unwrap :: ReaderT TracerEnv TcM a }
-  deriving newtype
-    ( -- base
-      Functor
-    , Applicative
-    , Monad
-    , MonadIO
-      -- ghc
-    , HasDynFlags
-    , MonadThings
-      -- trace-foreign-calls
-    , HasHscEnv
-    )
+newtype Instrument a = Wrap { unwrap :: TracerEnv -> TcM a }
 
 liftTcM :: TcM a -> Instrument a
-liftTcM = Wrap . lift
+liftTcM = Wrap . const
+
+getTracerEnv :: Instrument TracerEnv
+getTracerEnv = Wrap return
 
 runInstrument :: forall a. [String] -> Instrument a -> TcM a
 runInstrument rawOptions ma = do
@@ -74,16 +61,27 @@ runInstrument rawOptions ma = do
             , tracerEnvNames = mkNames
             }
 
-    runReaderT (unwrap ma) tracerEnv
+    unwrap ma tracerEnv
 
 {-------------------------------------------------------------------------------
-  Manual instances
-
-  Unfortunately many classes in GHC do not provide instances for transformers.
+  Instances
 -------------------------------------------------------------------------------}
 
-instance HasHooks    Instrument where getHooks         = liftTcM getHooks
-instance HasModule   Instrument where getModule        = liftTcM getModule
+instance Functor Instrument where
+  fmap = liftM
+
+instance Applicative Instrument where
+  pure x = Wrap $ \_env -> return x
+  (<*>)  = ap
+
+instance Monad Instrument where
+  x >>= f = Wrap $ \env -> unwrap x env >>= \a -> unwrap (f a) env
+
+instance MonadIO Instrument where
+  liftIO = liftTcM  . liftIO
+
+instance HasDynFlags Instrument where getDynFlags      = liftTcM getDynFlags
+instance HasHscEnv   Instrument where getHscEnv        = liftTcM getHscEnv
 instance HasLogger   Instrument where getLogger        = liftTcM getLogger
 instance MonadUnique Instrument where getUniqueSupplyM = liftTcM getUniqueSupplyM
 
@@ -92,7 +90,7 @@ instance MonadUnique Instrument where getUniqueSupplyM = liftTcM getUniqueSupply
 -------------------------------------------------------------------------------}
 
 asksOption :: (Options -> a) -> Instrument a
-asksOption f = Wrap $ asks (f . tracerEnvOptions)
+asksOption f = f . tracerEnvOptions <$> getTracerEnv
 
 whenOption :: (Options -> Bool) -> Instrument a -> Instrument (Maybe a)
 whenOption f ma = do
@@ -131,4 +129,4 @@ mkNames = Names {
     }
 
 findName :: (Names -> TcM Name) -> Instrument Name
-findName f = Wrap $ ReaderT $ f . tracerEnvNames
+findName f = Wrap $ f . tracerEnvNames
diff --git a/trace-foreign-calls/src/Plugin/TraceForeignCalls/Util/GHC.hs b/trace-foreign-calls/src/Plugin/TraceForeignCalls/Util/GHC.hs
@@ -10,8 +10,6 @@ module Plugin.TraceForeignCalls.Util.GHC (
   , resolveTHName
   ) where
 
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.Reader
 import Data.String
 import Language.Haskell.TH qualified as TH
 
@@ -39,9 +37,6 @@ class (MonadIO m, HasDynFlags m) => HasHscEnv m where
 instance HasHscEnv TcM where
   getHscEnv = env_top <$> getEnv
 
-instance HasHscEnv m => HasHscEnv (ReaderT r m) where
-  getHscEnv = lift getHscEnv
-
 {-------------------------------------------------------------------------------
   Internal auxiliary: using the 'HscEnv'
 -------------------------------------------------------------------------------}

diff --git a/trace-foreign-calls/trace-foreign-calls.cabal b/trace-foreign-calls/trace-foreign-calls.cabal
@@ -54,9 +54,10 @@ library
   hs-source-dirs:
       src
   build-depends:
+      -- dependencies intentionally kept at a minimum
+      -- (we want to be able to build the boot libs with this plugin)
     , ghc              >= 9.6  && < 9.7
     , template-haskell >= 2.20 && < 2.21
-    , transformers     >= 0.6  && < 0.7
 
 test-suite test-trace-foreign-calls
   import: