Factor out class ShelleyBasedBlock and type family ShelleyBlockLedgerEra (#1073)

Pending change from
#934 (comment)

Author: dnadales

ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Node.hs

@@ -112,6 +112,8 @@ import qualified Ouroboros.Consensus.Protocol.TPraos as Shelley
 import           Ouroboros.Consensus.Shelley.HFEras ()
 import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock)
 import qualified Ouroboros.Consensus.Shelley.Ledger as Shelley
+import           Ouroboros.Consensus.Shelley.Ledger.Block (IsShelleyBlock,
+                     ShelleyBlockLedgerEra)
 import           Ouroboros.Consensus.Shelley.Ledger.NetworkProtocolVersion
 import           Ouroboros.Consensus.Shelley.Node
 import           Ouroboros.Consensus.Shelley.Node.Common (ShelleyEraWithCrypto,
@@ -1119,15 +1121,6 @@ mkPartialLedgerConfigShelley transitionConfig maxMajorProtVer shelleyTriggerHard
         , shelleyTriggerHardFork = shelleyTriggerHardFork
         }
 
-class
-  ( ShelleyBasedEra (ShelleyBlockLedgerEra blk)
-  , blk ~ ShelleyBlock (BlockProtocol blk) (ShelleyBlockLedgerEra blk)
-  ) => IsShelleyBlock blk
-instance ShelleyBasedEra era => IsShelleyBlock (ShelleyBlock proto era)
-
-type family ShelleyBlockLedgerEra blk where
-  ShelleyBlockLedgerEra (ShelleyBlock proto era) = era
-
 -- | We need this wrapper to partially apply a 'TransitionConfig' in an NP.
 newtype WrapTransitionConfig blk =
     WrapTransitionConfig (L.TransitionConfig (ShelleyBlockLedgerEra blk))

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Block.hs

@@ -12,13 +12,16 @@
 {-# LANGUAGE TypeApplications           #-}
 {-# LANGUAGE TypeFamilyDependencies     #-}
 {-# LANGUAGE TypeOperators              #-}
+{-# LANGUAGE UndecidableInstances       #-}
 {-# LANGUAGE UndecidableSuperClasses    #-}
 module Ouroboros.Consensus.Shelley.Ledger.Block (
     GetHeader (..)
   , Header (..)
+  , IsShelleyBlock
   , NestedCtxt_ (..)
   , ShelleyBasedEra
   , ShelleyBlock (..)
+  , ShelleyBlockLedgerEra
   , ShelleyHash (..)
     -- * Shelley Compatibility
   , ShelleyCompatible
@@ -138,6 +141,18 @@ mkShelleyBlock raw = ShelleyBlock {
     , shelleyBlockHeaderHash = pHeaderHash $ SL.bheader raw
     }
 
+class
+  ( ShelleyCompatible (BlockProtocol blk) (ShelleyBlockLedgerEra blk)
+  , blk ~ ShelleyBlock (BlockProtocol blk) (ShelleyBlockLedgerEra blk)
+  ) => IsShelleyBlock blk
+
+instance ( proto ~ BlockProtocol (ShelleyBlock proto era)
+         , ShelleyCompatible proto era
+         ) => IsShelleyBlock (ShelleyBlock proto era)
+
+type family ShelleyBlockLedgerEra blk where
+  ShelleyBlockLedgerEra (ShelleyBlock proto era) = era
+
 data instance Header (ShelleyBlock proto era) = ShelleyHeader {
       shelleyHeaderRaw  :: !(ShelleyProtocolHeader proto)
     , shelleyHeaderHash :: !(ShelleyHash (ProtoCrypto proto))

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Cardano.hs

@@ -76,7 +76,8 @@ import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.Protocol.Praos.Translate ()
 import           Ouroboros.Consensus.Shelley.HFEras ()
 import qualified Ouroboros.Consensus.Shelley.Ledger as Shelley.Ledger
-import           Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock)
+import           Ouroboros.Consensus.Shelley.Ledger.Block (IsShelleyBlock,
+                     ShelleyBlock, ShelleyBlockLedgerEra)
 import           Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
 import           System.Directory (makeAbsolute)
 import           System.FilePath (takeDirectory, (</>))
@@ -214,12 +215,6 @@ instance AdjustFilePaths CardanoConfig where
           -- genesis data.
           }
 
-type family ShelleyBlockEra blk where
-  ShelleyBlockEra (ShelleyBlock proto era) = era
-
-class L.Era (ShelleyBlockEra blk) => IsShelleyBlock blk
-instance L.Era era => IsShelleyBlock (ShelleyBlock proto era)
-
 instance Aeson.FromJSON CardanoConfig where
   parseJSON = Aeson.withObject "CardanoConfigFile" $ \v -> do
 
@@ -241,7 +236,7 @@ instance Aeson.FromJSON CardanoConfig where
 
     triggers <- do
       let parseTrigger ::
-               forall blk era. (IsShelleyBlock blk, ShelleyBlockEra blk ~ era)
+               forall blk era. (IsShelleyBlock blk, ShelleyBlockLedgerEra blk ~ era)
             => (Aeson.Parser :.: K TriggerHardFork) blk
           parseTrigger = Comp $ fmap K $
                         (fmap TriggerHardForkAtEpoch <$> (v Aeson..:? nm))