{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}

module Cardano.Api.Internal.Tx.BuildTxWith
  ( BuildTxWith (..)
  , BuildTx
  , ViewTx
  , buildTxWithToMaybe
  )
where

-- ----------------------------------------------------------------------------
-- Building vs viewing transactions
--

data ViewTx

data BuildTx

data BuildTxWith build a where
  ViewTx :: BuildTxWith ViewTx a
  BuildTxWith :: a -> BuildTxWith BuildTx a

instance Functor (BuildTxWith build) where
  fmap :: forall a b. (a -> b) -> BuildTxWith build a -> BuildTxWith build b
fmap a -> b
_ BuildTxWith build a
ViewTx = BuildTxWith build b
BuildTxWith ViewTx b
forall a. BuildTxWith ViewTx a
ViewTx
  fmap a -> b
f (BuildTxWith a
x) = b -> BuildTxWith BuildTx b
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (a -> b
f a
x)

instance Applicative (BuildTxWith ViewTx) where
  pure :: forall a. a -> BuildTxWith ViewTx a
pure a
_ = BuildTxWith ViewTx a
forall a. BuildTxWith ViewTx a
ViewTx
  BuildTxWith ViewTx (a -> b)
_ <*> :: forall a b.
BuildTxWith ViewTx (a -> b)
-> BuildTxWith ViewTx a -> BuildTxWith ViewTx b
<*> BuildTxWith ViewTx a
_ = BuildTxWith ViewTx b
forall a. BuildTxWith ViewTx a
ViewTx

instance Applicative (BuildTxWith BuildTx) where
  pure :: forall a. a -> BuildTxWith BuildTx a
pure = a -> BuildTxWith BuildTx a
forall a. a -> BuildTxWith BuildTx a
BuildTxWith
  (BuildTxWith a -> b
f) <*> :: forall a b.
BuildTxWith BuildTx (a -> b)
-> BuildTxWith BuildTx a -> BuildTxWith BuildTx b
<*> (BuildTxWith a
a) = b -> BuildTxWith BuildTx b
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (a -> b
f a
a)

buildTxWithToMaybe :: BuildTxWith build a -> Maybe a
buildTxWithToMaybe :: forall build a. BuildTxWith build a -> Maybe a
buildTxWithToMaybe BuildTxWith build a
ViewTx = Maybe a
forall a. Maybe a
Nothing
buildTxWithToMaybe (BuildTxWith a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a

deriving instance Eq a => Eq (BuildTxWith build a)

deriving instance Show a => Show (BuildTxWith build a)