{-# LANGUAGE UndecidableInstances #-}

module Hydra.API.ClientInput where

import Hydra.Prelude

import Hydra.Ledger (IsTx)

data ClientInput tx
  = Init
  | Abort
  | NewTx {forall tx. ClientInput tx -> tx
transaction :: tx}
  | GetUTxO
  | Close
  | Contest
  | Fanout
  deriving stock ((forall x. ClientInput tx -> Rep (ClientInput tx) x)
-> (forall x. Rep (ClientInput tx) x -> ClientInput tx)
-> Generic (ClientInput tx)
forall x. Rep (ClientInput tx) x -> ClientInput tx
forall x. ClientInput tx -> Rep (ClientInput tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (ClientInput tx) x -> ClientInput tx
forall tx x. ClientInput tx -> Rep (ClientInput tx) x
$cfrom :: forall tx x. ClientInput tx -> Rep (ClientInput tx) x
from :: forall x. ClientInput tx -> Rep (ClientInput tx) x
$cto :: forall tx x. Rep (ClientInput tx) x -> ClientInput tx
to :: forall x. Rep (ClientInput tx) x -> ClientInput tx
Generic)

deriving stock instance IsTx tx => Eq (ClientInput tx)
deriving stock instance IsTx tx => Show (ClientInput tx)
deriving anyclass instance IsTx tx => ToJSON (ClientInput tx)
deriving anyclass instance IsTx tx => FromJSON (ClientInput tx)

instance Arbitrary tx => Arbitrary (ClientInput tx) where
  arbitrary :: Gen (ClientInput tx)
arbitrary = Gen (ClientInput tx)
forall a.
(Generic a, GA UnsizedOpts (Rep a),
 UniformWeight (Weights_ (Rep a))) =>
Gen a
genericArbitrary

  -- NOTE: Somehow, can't use 'genericShrink' here as GHC is complaining about
  -- Overlapping instances with 'UTxOType tx' even though for a fixed `tx`, there
  -- should be only one 'UTxOType tx'
  shrink :: ClientInput tx -> [ClientInput tx]
shrink = \case
    ClientInput tx
Init -> []
    ClientInput tx
Abort -> []
    NewTx tx
tx -> tx -> ClientInput tx
forall tx. tx -> ClientInput tx
NewTx (tx -> ClientInput tx) -> [tx] -> [ClientInput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> tx -> [tx]
forall a. Arbitrary a => a -> [a]
shrink tx
tx
    ClientInput tx
GetUTxO -> []
    ClientInput tx
Close -> []
    ClientInput tx
Contest -> []
    ClientInput tx
Fanout -> []