Some orphans work

Removed `-Wno-orphans` from some modules. Un-orphan some instances from `Ouroboros.Consensus.Util.Orphans`
IntersectMBO · May 8, 2024 · d4b636d · d4b636d
1 parent 98dbae0
commit d4b636d
Show file tree

Hide file tree

Showing 6 changed files with 23 additions and 40 deletions.
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Basics.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Basics.hs
@@ -4,7 +4,6 @@
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE TypeFamilies      #-}
 {-# LANGUAGE TypeOperators     #-}
-{-# OPTIONS_GHC -Wno-orphans   #-}
 
 -- | Definition is 'IsLedger'
 --

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT.hs
@@ -14,7 +14,6 @@
 {-# LANGUAGE TypeFamilyDependencies    #-}
 {-# LANGUAGE TypeOperators             #-}
 {-# LANGUAGE UndecidableInstances      #-}
-{-# OPTIONS_GHC -Wno-orphans           #-}
 
 module Ouroboros.Consensus.Protocol.PBFT (
     PBft

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT/Crypto.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT/Crypto.hs
@@ -11,7 +11,6 @@
 {-# LANGUAGE TypeOperators          #-}
 {-# LANGUAGE UndecidableInstances   #-}
 
-{-# OPTIONS_GHC -Wno-orphans #-}
 module Ouroboros.Consensus.Protocol.PBFT.Crypto (
     PBftCrypto (..)
   , PBftMockCrypto

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs
@@ -15,7 +15,6 @@
 {-# LANGUAGE TypeFamilies         #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-{-# OPTIONS_GHC -Wno-orphans #-}
 module Ouroboros.Consensus.Storage.ChainDB.API (
     -- * Main ChainDB API
     ChainDB (..)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/Condense.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/Condense.hs
@@ -25,9 +25,7 @@ import           Cardano.Crypto.KES (MockKES, NeverKES, SigKES, SignedKES (..),
                      pattern SigSingleKES, pattern SigSumKES,
                      pattern SignKeyMockKES, pattern VerKeyMockKES,
                      pattern VerKeySingleKES, pattern VerKeySumKES)
-import           Cardano.Slotting.Block (BlockNo (..))
-import           Cardano.Slotting.Slot (EpochNo (..), SlotNo (..),
-                     WithOrigin (..))
+import           Cardano.Slotting.Slot (EpochNo (..), WithOrigin (..))
 import           Control.Monad.Class.MonadTime.SI (Time (..))
 import qualified Data.ByteString as BS.Strict
 import qualified Data.ByteString.Lazy as BS.Lazy
@@ -44,7 +42,10 @@ import           Data.Word
 import           Numeric.Natural
 import           Ouroboros.Consensus.Util.HList (All, HList (..))
 import qualified Ouroboros.Consensus.Util.HList as HList
-import           Ouroboros.Network.Block (ChainHash (..), HeaderHash, Tip (..))
+import           Ouroboros.Network.AnchoredFragment (AnchoredFragment)
+import qualified Ouroboros.Network.AnchoredFragment as AF
+import           Ouroboros.Network.Block
+import           Ouroboros.Network.Mock.Chain hiding (length)
 import           Text.Printf (printf)
 
 {-------------------------------------------------------------------------------
@@ -168,7 +169,7 @@ instance All Condense as => Condense (HList as) where
   condense as = "(" ++ intercalate "," (HList.collapse (Proxy @Condense) condense as) ++ ")"
 
 {-------------------------------------------------------------------------------
-  Orphans for ouroboros-network
+  Instances for ouroboros-network
 -------------------------------------------------------------------------------}
 
 instance Condense BlockNo where
@@ -193,8 +194,21 @@ instance Condense a => Condense (WithOrigin a) where
   condense Origin = "origin"
   condense (At a) = condense a
 
+instance Condense (HeaderHash block) => Condense (Point block) where
+    condense GenesisPoint     = "Origin"
+    condense (BlockPoint s h) = "(Point " <> condense s <> ", " <> condense h <> ")"
+
+instance Condense block => Condense (Chain block) where
+    condense Genesis   = "Genesis"
+    condense (cs :> b) = condense cs <> " :> " <> condense b
+
+instance (Condense block, HasHeader block, Condense (HeaderHash block))
+    => Condense (AnchoredFragment block) where
+    condense (AF.Empty pt) = "EmptyAnchor " <> condense (AF.anchorToPoint pt)
+    condense (cs AF.:> b)  = condense cs <> " :> " <> condense b
+
 {-------------------------------------------------------------------------------
-  Orphans for cardano-crypto-classes
+  Instances for cardano-crypto-classes
 -------------------------------------------------------------------------------}
 
 instance Condense (SigDSIGN v) => Condense (SignedDSIGN v a) where

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/Orphans.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/Orphans.hs
@@ -27,33 +27,11 @@ import           Data.SOP.BasicFunctors
 import           NoThunks.Class (InspectHeap (..), InspectHeapNamed (..),
                      NoThunks (..), OnlyCheckWhnfNamed (..), allNoThunks,
                      noThunksInKeysAndValues)
-import           Ouroboros.Consensus.Block.Abstract
-import           Ouroboros.Consensus.Util.Condense
-import           Ouroboros.Network.AnchoredFragment (AnchoredFragment)
-import qualified Ouroboros.Network.AnchoredFragment as AF
-import           Ouroboros.Network.Mock.Chain (Chain (..))
 import           Ouroboros.Network.Util.ShowProxy
 import           System.FS.API (SomeHasFS)
 import           System.FS.API.Types (FsPath, Handle)
 import           System.FS.CRC (CRC (CRC))
 
-{-------------------------------------------------------------------------------
-  Condense
--------------------------------------------------------------------------------}
-
-instance Condense (HeaderHash block) => Condense (Point block) where
-    condense GenesisPoint     = "Origin"
-    condense (BlockPoint s h) = "(Point " <> condense s <> ", " <> condense h <> ")"
-
-instance Condense block => Condense (Chain block) where
-    condense Genesis   = "Genesis"
-    condense (cs :> b) = condense cs <> " :> " <> condense b
-
-instance (Condense block, HasHeader block, Condense (HeaderHash block))
-    => Condense (AnchoredFragment block) where
-    condense (AF.Empty pt) = "EmptyAnchor " <> condense (AF.anchorToPoint pt)
-    condense (cs AF.:> b)  = condense cs <> " :> " <> condense b
-
 {-------------------------------------------------------------------------------
   Serialise
 -------------------------------------------------------------------------------}
@@ -64,12 +42,6 @@ instance Serialise (VerKeyDSIGN MockDSIGN) where
   encode = encodeVerKeyDSIGN
   decode = decodeVerKeyDSIGN
 
-{-------------------------------------------------------------------------------
-  ShowProxy
--------------------------------------------------------------------------------}
-
-instance ShowProxy SlotNo where
-
 {-------------------------------------------------------------------------------
   NoThunks
 -------------------------------------------------------------------------------}
@@ -105,9 +77,10 @@ instance NoThunks a => NoThunks (Sum a)
   fs-api
 -------------------------------------------------------------------------------}
 
+deriving via InspectHeap FsPath instance NoThunks FsPath
+deriving newtype instance NoThunks CRC
 deriving via InspectHeapNamed "Handle" (Handle h)
     instance NoThunks (Handle h)
-deriving via InspectHeap FsPath instance NoThunks FsPath
 deriving via OnlyCheckWhnfNamed "SomeHasFS" (SomeHasFS m)
     instance NoThunks (SomeHasFS m)
-deriving newtype instance NoThunks CRC
+