From 6c131ba04ab1455827d985704e4411aa19185f5f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Baldur=20Bl=C3=B6ndal?= <baldurpet@gmail.com>
Date: Mon, 31 May 2021 15:43:56 +0100
Subject: DerivingVia for Hsc instances. GND for NonDetFastString and
 LexicalFastString.

---
 compiler/GHC/Data/FastString.hs     | 15 ++++++---------
 compiler/GHC/Data/Graph/Directed.hs |  2 +-
 compiler/GHC/Driver/Env/Types.hs    | 22 ++++++----------------
 3 files changed, 13 insertions(+), 26 deletions(-)

diff --git a/compiler/GHC/Data/FastString.hs b/compiler/GHC/Data/FastString.hs
index 655dd80005..33ceedd44c 100644
--- a/compiler/GHC/Data/FastString.hs
+++ b/compiler/GHC/Data/FastString.hs
@@ -1,6 +1,7 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE UnboxedTuples #-}
@@ -265,14 +266,12 @@ uniqCompareFS fs1 fs2 = compare (uniq fs1) (uniq fs2)
 -- is not deterministic from one run to the other.
 newtype NonDetFastString
    = NonDetFastString FastString
-   deriving (Eq,Data)
+   deriving newtype (Eq, Show)
+   deriving stock Data
 
 instance Ord NonDetFastString where
    compare (NonDetFastString fs1) (NonDetFastString fs2) = uniqCompareFS fs1 fs2
 
-instance Show NonDetFastString where
-   show (NonDetFastString fs) = show fs
-
 -- | Lexical FastString
 --
 -- This is a simple FastString wrapper with an Ord instance using
@@ -280,14 +279,12 @@ instance Show NonDetFastString where
 -- representation). Hence it is deterministic from one run to the other.
 newtype LexicalFastString
    = LexicalFastString FastString
-   deriving (Eq,Data)
+   deriving newtype (Eq, Show)
+   deriving stock Data
 
 instance Ord LexicalFastString where
    compare (LexicalFastString fs1) (LexicalFastString fs2) = lexicalCompareFS fs1 fs2
 
-instance Show LexicalFastString where
-   show (LexicalFastString fs) = show fs
-
 -- -----------------------------------------------------------------------------
 -- Construction
 
diff --git a/compiler/GHC/Data/Graph/Directed.hs b/compiler/GHC/Data/Graph/Directed.hs
index 60d3393680..c773898596 100644
--- a/compiler/GHC/Data/Graph/Directed.hs
+++ b/compiler/GHC/Data/Graph/Directed.hs
@@ -106,7 +106,7 @@ data Node key payload = DigraphNode {
   }
 
 
-instance (Outputable a, Outputable b) => Outputable (Node  a b) where
+instance (Outputable a, Outputable b) => Outputable (Node a b) where
   ppr (DigraphNode a b c) = ppr (a, b, c)
 
 emptyGraph :: Graph a
diff --git a/compiler/GHC/Driver/Env/Types.hs b/compiler/GHC/Driver/Env/Types.hs
index c0cb9c9cda..7301ae70b3 100644
--- a/compiler/GHC/Driver/Env/Types.hs
+++ b/compiler/GHC/Driver/Env/Types.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DerivingVia #-}
+
 module GHC.Driver.Env.Types
   ( Hsc(..)
   , HscEnv(..)
@@ -22,25 +23,15 @@ import GHC.Utils.Logger
 import GHC.Utils.TmpFs
 import {-# SOURCE #-} GHC.Driver.Plugins
 
-import Control.Monad ( ap )
 import Control.Monad.IO.Class
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.State
 import Data.IORef
 
 -- | The Hsc monad: Passing an environment and diagnostic state
 newtype Hsc a = Hsc (HscEnv -> Messages GhcMessage -> IO (a, Messages GhcMessage))
-    deriving (Functor)
-
-instance Applicative Hsc where
-    pure a = Hsc $ \_ w -> return (a, w)
-    (<*>) = ap
-
-instance Monad Hsc where
-    Hsc m >>= k = Hsc $ \e w -> do (a, w1) <- m e w
-                                   case k a of
-                                       Hsc k' -> k' e w1
-
-instance MonadIO Hsc where
-    liftIO io = Hsc $ \_ w -> do a <- io; return (a, w)
+    deriving (Functor, Applicative, Monad, MonadIO)
+      via ReaderT HscEnv (StateT (Messages GhcMessage) IO)
 
 instance HasDynFlags Hsc where
     getDynFlags = Hsc $ \e w -> return (hsc_dflags e, w)
@@ -129,4 +120,3 @@ data HscEnv
         , hsc_tmpfs :: !TmpFs
                 -- ^ Temporary files
  }
-
-- 
cgit v1.2.1