From 95a8af880189d32aedab376cc4d430b1050b309c Mon Sep 17 00:00:00 2001
From: Johannes Lund <johannes.lund@iohk.io>
Date: Tue, 16 Jun 2020 12:02:34 +0200
Subject: [PATCH] wip: Trying to get jormungandr compiling with added type
 families

---
 lib/core/src/Cardano/Wallet/Network.hs                |  4 ++--
 .../src/Cardano/Pool/Jormungandr/Metrics.hs           |  9 ++++++---
 .../src/Cardano/Wallet/Jormungandr/Network.hs         | 11 +++++++++++
 3 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/lib/core/src/Cardano/Wallet/Network.hs b/lib/core/src/Cardano/Wallet/Network.hs
index 662f9b91d9a..666eaef7217 100644
--- a/lib/core/src/Cardano/Wallet/Network.hs
+++ b/lib/core/src/Cardano/Wallet/Network.hs
@@ -125,7 +125,7 @@ data NetworkLayer m target block = NetworkLayer
         -- ^ Broadcast a transaction to the chain producer
 
     , stakeDistribution
-        :: GetStakeDistribution target
+        :: GetStakeDistribution target m
 
     , getAccountBalance
         :: ChimericAccount
@@ -224,7 +224,7 @@ defaultRetryPolicy =
                                  Queries
 -------------------------------------------------------------------------------}
 
-type family GetStakeDistribution target :: *
+type family GetStakeDistribution target (m :: * -> *) :: *
 
 {-------------------------------------------------------------------------------
                                 Chain Sync
diff --git a/lib/jormungandr/src/Cardano/Pool/Jormungandr/Metrics.hs b/lib/jormungandr/src/Cardano/Pool/Jormungandr/Metrics.hs
index e58d145ad71..77ad8de1d58 100644
--- a/lib/jormungandr/src/Cardano/Pool/Jormungandr/Metrics.hs
+++ b/lib/jormungandr/src/Cardano/Pool/Jormungandr/Metrics.hs
@@ -54,12 +54,15 @@ import Cardano.Pool.Jormungandr.Performance
     ( readPoolsPerformances )
 import Cardano.Pool.Jormungandr.Ranking
     ( EpochConstants (..), unsafeMkNonNegative )
+import Cardano.Wallet.Jormungandr.Compatibility
+    ( Jormungandr )
 import Cardano.Wallet.Network
     ( ErrCurrentNodeTip
     , ErrNetworkUnavailable
     , FollowAction (..)
     , FollowExit (..)
     , FollowLog
+    , GetStakeDistribution (..)
     , NetworkLayer (currentNodeTip, stakeDistribution)
     , follow
     )
@@ -166,7 +169,7 @@ monitorStakePools
     :: Tracer IO StakePoolLog
     -> (Block, Quantity "block" Word32)
         -- ^ Genesis block and 'k'
-    -> NetworkLayer IO t Block
+    -> NetworkLayer IO Jormungandr Block
     -> DBLayer IO
     -> IO ()
 monitorStakePools tr (block0, Quantity k) nl db@DBLayer{..} = do
@@ -201,7 +204,7 @@ monitorStakePools tr (block0, Quantity k) nl db@DBLayer{..} = do
         distributions <- forM epochs $ \ep -> do
             liftIO $ traceWith tr $ MsgStakeDistribution ep
             withExceptT ErrMonitorStakePoolsNetworkUnavailable $
-                (ep,) <$> stakeDistribution nl ep
+                (ep,) <$> (stakeDistribution nl ep)
 
         currentTip <- withExceptT ErrMonitorStakePoolsCurrentNodeTip $
             currentNodeTip nl
@@ -253,7 +256,7 @@ newStakePoolLayer
     -- ^ Genesis block header
     -> (EpochNo -> Quantity "lovelace" Word64 -> EpochConstants)
     -> DBLayer IO
-    -> NetworkLayer IO t Block
+    -> NetworkLayer IO Jormungandr Block
     -> FilePath
     -- ^ A directory to cache downloaded stake pool metadata. Will be created if
     -- it does not exist.
diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs
index 816866628f7..9f1976f32cd 100644
--- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs
+++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs
@@ -107,6 +107,7 @@ import Cardano.Wallet.Jormungandr.Compatibility
 import Cardano.Wallet.Network
     ( Cursor
     , ErrGetAccountBalance (..)
+    , GetStakeDistribution
     , NetworkLayer (..)
     , NextBlocksResult (..)
     , defaultRetryPolicy
@@ -455,6 +456,16 @@ mkRawNetworkLayer np batchSize st j = NetworkLayer
             _ ->
                 RollBackward $ Cursor emptyBlockHeaders
 
+
+{-------------------------------------------------------------------------------
+                                 Queries
+-------------------------------------------------------------------------------}
+
+type instance GetStakeDistribution Jormungandr m =
+    EpochNo
+    -> ExceptT ErrNetworkUnavailable m
+        (Map PoolId (Quantity "lovelace" Word64))
+
 {-------------------------------------------------------------------------------
                              Jormungandr Cursor
 -------------------------------------------------------------------------------}