Remove some more instances

IntersectMBO · May 9, 2024 · 683e83f · 683e83f
1 parent d4b636d
commit 683e83f
Show file tree

Hide file tree

Showing 4 changed files with 19 additions and 2 deletions.
diff --git a/cabal.project b/cabal.project
@@ -36,3 +36,12 @@ import: ./asserts.cabal
 if(os(windows))
   constraints:
     bitvec -simd
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/ouroboros-network
+  tag: 431bb599940d2947b2cb99d3ae29b7f2c4cdd36d
+  --sha256: 431bb599940d2947b2cb99d3ae29b7f2c4cdd36d
+  subdir:
+    ouroboros-network-api
+    ouroboros-network-protocols
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Basics.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Basics.hs
@@ -47,8 +47,6 @@ class GetTip l where
   -- Should be 'GenesisPoint' when no blocks have been applied yet
   getTip :: l -> Point l
 
-type instance HeaderHash (Ticked l) = HeaderHash l
-
 getTipHash :: GetTip l => l -> ChainHash l
 getTipHash = pointHash . getTip
 

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP                       #-}
 {-# LANGUAGE DeriveAnyClass            #-}
 {-# LANGUAGE DeriveGeneric             #-}
 {-# LANGUAGE DerivingVia               #-}
@@ -15,6 +16,12 @@
 {-# LANGUAGE TypeOperators             #-}
 {-# LANGUAGE UndecidableInstances      #-}
 
+#if __GLASGOW_HASKELL__ >= 908
+-- GHC is a bit pickier for data family instances, but trying to remove this 
+-- one forces us to reorganize the Protocol.* modules. TODO eventually.
+{-# OPTIONS_GHC -Wno-orphans #-}
+#endif
+
 module Ouroboros.Consensus.Protocol.PBFT (
     PBft
   , PBftCanBeLeader (..)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ticked.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ticked.hs
@@ -10,6 +10,7 @@ module Ouroboros.Consensus.Ticked (Ticked (..)) where
 
 import           Data.Kind (Type)
 import           Data.SOP.BasicFunctors
+import           Ouroboros.Consensus.Block.Abstract
 import           NoThunks.Class (NoThunks)
 
 {-------------------------------------------------------------------------------
@@ -46,6 +47,8 @@ data family Ticked st :: Type
 data instance Ticked () = TickedTrivial
   deriving (Show)
 
+type instance HeaderHash (Ticked l) = HeaderHash l
+
 {-------------------------------------------------------------------------------
   Forwarding type class instances
 -------------------------------------------------------------------------------}