WIP on fingertree instance

Author: ninioArtillero

ouroboros-consensus-diffusion/ouroboros-consensus-diffusion.cabal

@@ -282,6 +282,7 @@ library unstable-consensus-conformance-testlib
     containers,
     contra-tracer,
     directory,
+    fingertree,
     fs-api ^>=0.4,
     fs-sim ^>=0.4,
     hashable,

ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/OrphanInstances.hs

@@ -1,4 +1,6 @@
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -9,23 +11,29 @@ module Test.Consensus.OrphanInstances () where
 import Cardano.Slotting.Time (SlotLength)
 import Control.Monad.Class.MonadTime.SI (Time)
 import Data.Aeson
-  ( FromJSON
-  , ToJSON (toEncoding)
-  , defaultOptions
-  , genericToEncoding
+import Data.FingerTree (FingerTree (..))
+import Data.FingerTree.Strict
+  ( Measured
+  , StrictFingerTree
+  , forceToStrict
+  , fromList
+  , fromStrict
   )
-import Data.FingerTree.Strict (StrictFingerTree)
+import Data.Foldable (toList)
 import GHC.Generics
 import Ouroboros.Consensus.Block.Abstract (GenesisWindow (..))
 import Ouroboros.Consensus.Config (SecurityParam (..))
 
 -- import Ouroboros.Network.AnchoredFragment (AnchoredFragment, AnchoredSeq)
+
+import Data.ByteString (StrictByteString)
 import Ouroboros.Network.AnchoredSeq (AnchoredSeq (..))
 import Test.Consensus.BlockTree (BlockTree (..), BlockTreeBranch (..))
 import Test.Consensus.PointSchedule
   ( BlockFetchTimeout (..)
   , CSJParams (..)
   , ChainSyncTimeout (..)
+  , ForecastRange (..)
   , GenesisTest (..)
   , LoPBucketParams (..)
   , PointSchedule (..)
@@ -50,6 +58,10 @@ deriving instance Generic GenesisWindow
 instance ToJSON GenesisWindow
 instance FromJSON GenesisWindow
 
+deriving instance Generic ForecastRange
+instance ToJSON ForecastRange
+instance FromJSON ForecastRange
+
 deriving instance Generic Delta
 instance ToJSON Delta
 instance FromJSON Delta
@@ -88,8 +100,14 @@ deriving instance Generic (BlockTreeBranch blk)
 instance ToJSON blk => ToJSON (BlockTreeBranch blk)
 instance FromJSON blk => FromJSON (BlockTreeBranch blk)
 
-instance (ToJSON v, ToJSON a, ToJSON b) => ToJSON (AnchoredSeq v a b)
-instance (FromJSON v, FromJSON a, FromJSON b) => FromJSON (AnchoredSeq v a b)
+instance (MeasuredWith v a b, ToJSON v, ToJSON a, ToJSON b) => ToJSON (AnchoredSeq v a b)
+instance (Anchorable v a b, FromJSON v, FromJSON a, FromJSON b) => FromJSON (AnchoredSeq v a b)
+
+instance (Measured v a, FromJSON a) => FromJSON (StrictFingerTree v a) where
+  parseJSON v = fromList <$> parseJSON v
+
+instance ToJSON a => ToJSON (StrictFingerTree v a) where
+  toJSON sft = toJSON $ toList sft
 
 -- *** 'PointSchedule' field related instances