wip

shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/TestTxBody.hs

@@ -13,9 +13,10 @@ import Cardano.Ledger.ShelleyMA.TxBody
     TxIn(..),
     TxOut(..),
     ChainData,
-    TxBody'(..),
+    Foo(..),
   )
 
+import qualified Cardano.Ledger.ShelleyMA.TxBody as What
 
 import GHC.Records
 import GHC.TypeLits(Symbol)
@@ -89,7 +90,17 @@ bytes (STxBody (Memo _ b)) = b
 foo ::  TxBody TestEra -> IO()
 foo x = do
   print (bytes x)
-  -- print ((getField @"txfee" x)::Coin)
+  print ((getField @"txfee" x)::Coin)
+
+-- instance HasField "coin" Foo' Int where
+  -- getField (Foo' x) = x
+
+
+-- getFooField :: Foo -> Int
+-- getFooField foo = getField @"field" foo
+
+
+
 
 {-
   print (getField @"outputs" x)
@@ -108,4 +119,4 @@ test (STxBody memo) =
      Right("",new) -> new==memo
      Left _ -> False
 
--}
+-}

shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/TxBody.hs

@@ -19,14 +19,17 @@
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 module Cardano.Ledger.ShelleyMA.TxBody
   ( TxBody(TxBody,STxBody),
     TxId(..),
     TxIn(..),
     TxOut(..),
     ChainData,
-    TxBody',
+    Foo (Foo,field,..),
+    Foo' (..),
+    TxBody' (..),
   )
   where
 
@@ -143,6 +146,23 @@ data TxBody' era = TxBody'
     forge  :: !(Value era) }
  deriving (Typeable)
 
+
+data Foo' = Foo' { coin :: Int }
+
+newtype Foo = SFoo (MemoBytes (Foo'))
+
+pattern Foo :: Int -> Foo
+pattern Foo { field } <- SFoo ( Memo (Foo' field) _)
+  where
+  Foo x = SFoo (Memo (Foo' x) mempty)
+
+
+instance HasField tag Foo' c => HasField (tag::Symbol) Foo c where
+   getField (SFoo m) = getField @tag m
+
+-- getFooField :: Foo -> Int
+-- getFooField foo = getField @"field" foo
+
 deriving instance ChainData (Value era) => Eq (TxBody' era)
 deriving instance ChainData (Value era) => Show (TxBody' era)
 deriving instance ChainData (Value era) => Generic (TxBody' era)
@@ -188,6 +208,10 @@ deriving via
 instance HasField tag (TxBody' e) c => HasField (tag::Symbol) (TxBody e) c where
    getField (STxBody (Memo x _)) = getField @tag x
 
+
+instance HasField "txfee" (TxBody e) Coin where
+  getField (STxBody m) = getField @"txfee" m
+
 -- Make a Pattern so the newtype and the MemoBytes are hidden
 
 pattern TxBody ::
@@ -229,4 +253,4 @@ bytes (STxBody (Memo _ b)) = b
 foo :: (Era era,ChainData (Value era)) => TxBody era -> IO()
 foo x = do
   print (bytes x)
-  print (getField @"inputs" x)
+  --print (getField @"inputs" x)