{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Util.Orphans () where

import           Cardano.Crypto.DSIGN.Class
import           Cardano.Crypto.DSIGN.Mock (MockDSIGN)
import           Cardano.Crypto.Hash (Hash)
import           Cardano.Ledger.Genesis (NoGenesis (..))
import           Codec.CBOR.Decoding (Decoder)
import           Codec.Serialise (Serialise (..))
import           Control.Tracer (Tracer)
import           Data.Bimap (Bimap)
import qualified Data.Bimap as Bimap
import           Data.IntPSQ (IntPSQ)
import qualified Data.IntPSQ as PSQ
import           Data.SOP.BasicFunctors
import           NoThunks.Class (InspectHeap (..), InspectHeapNamed (..),
                     NoThunks (..), OnlyCheckWhnfNamed (..), allNoThunks,
                     noThunksInKeysAndValues)
import           Ouroboros.Network.Util.ShowProxy
import           System.FS.API (SomeHasFS)
import           System.FS.API.Types (FsPath, Handle)
import           System.FS.CRC (CRC (CRC))

{-------------------------------------------------------------------------------
  Serialise
-------------------------------------------------------------------------------}

instance Serialise (Hash h a) where

instance Serialise (VerKeyDSIGN MockDSIGN) where
  encode :: VerKeyDSIGN MockDSIGN -> Encoding
encode = VerKeyDSIGN MockDSIGN -> Encoding
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> Encoding
encodeVerKeyDSIGN
  decode :: forall s. Decoder s (VerKeyDSIGN MockDSIGN)
decode = Decoder s (VerKeyDSIGN MockDSIGN)
forall v s. DSIGNAlgorithm v => Decoder s (VerKeyDSIGN v)
decodeVerKeyDSIGN

{-------------------------------------------------------------------------------
  NoThunks
-------------------------------------------------------------------------------}

instance NoThunks (NoGenesis era) where
  showTypeOf :: Proxy (NoGenesis era) -> String
showTypeOf Proxy (NoGenesis era)
_ = String
"NoGenesis"
  wNoThunks :: Context -> NoGenesis era -> IO (Maybe ThunkInfo)
wNoThunks Context
_ NoGenesis era
NoGenesis = Maybe ThunkInfo -> IO (Maybe ThunkInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ThunkInfo
forall a. Maybe a
Nothing

instance (NoThunks k, NoThunks v)
      => NoThunks (Bimap k v) where
  wNoThunks :: Context -> Bimap k v -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt = Context -> [(k, v)] -> IO (Maybe ThunkInfo)
forall k v.
(NoThunks k, NoThunks v) =>
Context -> [(k, v)] -> IO (Maybe ThunkInfo)
noThunksInKeysAndValues Context
ctxt ([(k, v)] -> IO (Maybe ThunkInfo))
-> (Bimap k v -> [(k, v)]) -> Bimap k v -> IO (Maybe ThunkInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bimap k v -> [(k, v)]
forall a b. Bimap a b -> [(a, b)]
Bimap.toList

instance ( NoThunks p
         , NoThunks v
         , Ord p
         ) => NoThunks (IntPSQ p v) where
  showTypeOf :: Proxy (IntPSQ p v) -> String
showTypeOf Proxy (IntPSQ p v)
_ = String
"IntPSQ"
  wNoThunks :: Context -> IntPSQ p v -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt =
        [IO (Maybe ThunkInfo)] -> IO (Maybe ThunkInfo)
allNoThunks
      ([IO (Maybe ThunkInfo)] -> IO (Maybe ThunkInfo))
-> (IntPSQ p v -> [IO (Maybe ThunkInfo)])
-> IntPSQ p v
-> IO (Maybe ThunkInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, p, v) -> [IO (Maybe ThunkInfo)])
-> [(Int, p, v)] -> [IO (Maybe ThunkInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
k, p
p, v
v) ->
        [ Context -> Int -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt Int
k
        , Context -> p -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt p
p
        , Context -> v -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt v
v])
      ([(Int, p, v)] -> [IO (Maybe ThunkInfo)])
-> (IntPSQ p v -> [(Int, p, v)])
-> IntPSQ p v
-> [IO (Maybe ThunkInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntPSQ p v -> [(Int, p, v)]
forall p v. IntPSQ p v -> [(Int, p, v)]
PSQ.toList

deriving via OnlyCheckWhnfNamed "Decoder" (Decoder s a) instance NoThunks (Decoder s a)

deriving via OnlyCheckWhnfNamed "Tracer" (Tracer m ev) instance NoThunks (Tracer m ev)

instance NoThunks a => NoThunks (K a b) where
  showTypeOf :: Proxy (K a b) -> String
showTypeOf Proxy (K a b)
_ = Proxy a -> String
forall a. NoThunks a => Proxy a -> String
showTypeOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
  wNoThunks :: Context -> K a b -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt (K a
a) = Context -> a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
wNoThunks (String
"K"String -> Context -> Context
forall a. a -> [a] -> [a]
:Context
ctxt) a
a

{-------------------------------------------------------------------------------
  fs-api
-------------------------------------------------------------------------------}

deriving via InspectHeap FsPath instance NoThunks FsPath
deriving newtype instance NoThunks CRC
deriving via InspectHeapNamed "Handle" (Handle h)
    instance NoThunks (Handle h)
deriving via OnlyCheckWhnfNamed "SomeHasFS" (SomeHasFS m)
    instance NoThunks (SomeHasFS m)