{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.HardFork.Combinator.Node.Metrics () where

import           Data.SOP.Strict

import           Ouroboros.Consensus.Block.SupportsMetrics
import           Ouroboros.Consensus.Util

import           Ouroboros.Consensus.HardFork.Combinator.Abstract
import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras
import           Ouroboros.Consensus.HardFork.Combinator.Basics
import           Ouroboros.Consensus.HardFork.Combinator.Block

instance CanHardFork xs => BlockSupportsMetrics (HardForkBlock xs) where
  isSelfIssued :: BlockConfig (HardForkBlock xs)
-> Header (HardForkBlock xs) -> WhetherSelfIssued
isSelfIssued BlockConfig (HardForkBlock xs)
cfg Header (HardForkBlock xs)
hdr =
        NS (K WhetherSelfIssued) xs -> CollapseTo NS WhetherSelfIssued
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
      (NS (K WhetherSelfIssued) xs -> CollapseTo NS WhetherSelfIssued)
-> NS (K WhetherSelfIssued) xs -> CollapseTo NS WhetherSelfIssued
forall a b. (a -> b) -> a -> b
$ Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    BlockConfig a -> Header a -> K WhetherSelfIssued a)
-> Prod NS BlockConfig xs
-> NS Header xs
-> NS (K WhetherSelfIssued) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a)
-> Prod h f xs
-> h f' xs
-> h f'' xs
hczipWith
          Proxy SingleEraBlock
proxySingle
          (WhetherSelfIssued -> K WhetherSelfIssued a
forall k a (b :: k). a -> K a b
K (WhetherSelfIssued -> K WhetherSelfIssued a)
-> (BlockConfig a -> Header a -> WhetherSelfIssued)
-> BlockConfig a
-> Header a
-> K WhetherSelfIssued a
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: BlockConfig a -> Header a -> WhetherSelfIssued
forall blk.
BlockSupportsMetrics blk =>
BlockConfig blk -> Header blk -> WhetherSelfIssued
isSelfIssued)
          (PerEraBlockConfig xs -> NP BlockConfig xs
forall (xs :: [*]). PerEraBlockConfig xs -> NP BlockConfig xs
getPerEraBlockConfig (PerEraBlockConfig xs -> NP BlockConfig xs)
-> PerEraBlockConfig xs -> NP BlockConfig xs
forall a b. (a -> b) -> a -> b
$ BlockConfig (HardForkBlock xs) -> PerEraBlockConfig xs
forall (xs :: [*]).
BlockConfig (HardForkBlock xs) -> PerEraBlockConfig xs
hardForkBlockConfigPerEra BlockConfig (HardForkBlock xs)
cfg)
          (OneEraHeader xs -> NS Header xs
forall (xs :: [*]). OneEraHeader xs -> NS Header xs
getOneEraHeader      (OneEraHeader xs -> NS Header xs)
-> OneEraHeader xs -> NS Header xs
forall a b. (a -> b) -> a -> b
$ Header (HardForkBlock xs) -> OneEraHeader xs
forall (xs :: [*]). Header (HardForkBlock xs) -> OneEraHeader xs
getHardForkHeader         Header (HardForkBlock xs)
hdr)