Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

partially monomorphise & de-generify Env #4521

Merged
merged 22 commits into from
Oct 12, 2022
Merged

partially monomorphise & de-generify Env #4521

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
22 commits
Select commit Hold shift + click to select a range
6f9786c
hide-env
NadiaYvette Oct 10, 2022
5cbd4a3
SetKeyVal exposes an inextricable precursor to the Generic usage in the
NadiaYvette Oct 10, 2022
b1c5479
Hide usage of Action Set case in setConst.
NadiaYvette Oct 11, 2022
aab193f
Monomorphise the User case of the Store type.
NadiaYvette Oct 11, 2022
8ddfaed
Remove Tag, Setters
NadiaYvette Oct 11, 2022
64ccd8d
Remove unSet & consumeName
NadiaYvette Oct 11, 2022
d707426
Fold Name into Store
NadiaYvette Oct 11, 2022
4d22bb9
Remove [gs]et(NetworkId|SocketPath) accessors.
NadiaYvette Oct 11, 2022
80feb2a
Remove LoggingLayer case of Store.
NadiaYvette Oct 11, 2022
42c40a5
Remove ProtocolParameterMode case from Store
NadiaYvette Oct 11, 2022
359874c
Remove BenchTracers case from Store
NadiaYvette Oct 11, 2022
2d49382
Remove Genesis case of Store
NadiaYvette Oct 11, 2022
f175d16
Share Env accessor code
NadiaYvette Oct 11, 2022
29db9a0
Remove Protocol case of Store
NadiaYvette Oct 11, 2022
4a7eb72
Env hlint warning cleanup
NadiaYvette Oct 12, 2022
8f8991a
Fix extraneous parentheses flagged by hlint
NadiaYvette Oct 12, 2022
2fd0d23
Remove SNetworkId case of Store
NadiaYvette Oct 12, 2022
12447bc
Remove SSocketPath from Store
NadiaYvette Oct 12, 2022
499e245
Remove KeyName case from Store
NadiaYvette Oct 12, 2022
c883487
Remove ThreadName from Store
NadiaYvette Oct 12, 2022
731e16d
Remove Store altogether
NadiaYvette Oct 12, 2022
a848918
Merge branch 'tx-generator/4174-reusable-api-and-library' into nyc-api-2
mgmeier Oct 12, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 3 additions & 3 deletions bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -83,10 +83,10 @@ withEra era action = do
setProtocolParameters :: ProtocolParametersSource -> ActionM ()
setProtocolParameters s = case s of
QueryLocalNode -> do
set ProtocolParameterMode ProtocolParameterQuery
setProtoParamMode ProtocolParameterQuery
UseLocalProtocolFile file -> do
protocolParameters <- liftIO $ readProtocolParametersFile file
set ProtocolParameterMode $ ProtocolParameterLocal protocolParameters
setProtoParamMode $ ProtocolParameterLocal protocolParameters

readSigningKey :: KeyName -> SigningKeyFile -> ActionM ()
readSigningKey name filePath =
Expand Down Expand Up @@ -199,7 +199,7 @@ queryRemoteProtocolParameters = do

getProtocolParameters :: ActionM ProtocolParameters
getProtocolParameters = do
get ProtocolParameterMode >>= \case
getProtoParamMode >>= \case
ProtocolParameterQuery -> queryRemoteProtocolParameters
ProtocolParameterLocal parameters -> return parameters

Expand Down
17 changes: 15 additions & 2 deletions bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,8 @@ module Cardano.Benchmarking.Script.Env (
, traceDebug
, traceError
, traceBenchTxSubmit
, getProtoParamMode
, setProtoParamMode
, get
, set
) where
Expand All @@ -42,10 +44,12 @@ import Cardano.Benchmarking.Script.Store

import Cardano.TxGenerator.Types (TxGenError(..))

data Env = Env { dmap :: DMap Store Identity }
data Env = Env { dmap :: DMap Store Identity
, protoParams :: Maybe ProtocolParameterMode
}

emptyEnv :: Env
emptyEnv = Env { dmap = DMap.empty }
emptyEnv = Env { dmap = DMap.empty, protoParams = Nothing }
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Just a very minor nitpick about formatting -- I'd:

  1. break the line, between = and Env aligning the latter naturally.
  2. break the line, just before the , aligning the latter with the {
  3. make the trailing } on its own line

...which is how multi-line is done frequently.


type ActionM a = ExceptT Error (RWST IOManager () Env IO) a

Expand Down Expand Up @@ -73,12 +77,21 @@ askIOManager = lift RWS.ask
set :: Store v -> v -> ActionM ()
set key val = lift $ RWS.modify $ (\e -> e { dmap = DMap.insert key (pure val) (dmap e)})

setProtoParamMode :: ProtocolParameterMode -> ActionM ()
setProtoParamMode val = lift $ RWS.modify $ (\e -> e { protoParams = pure val })
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Given that you'll have more of those cases, I'd split this into a combination of:

  1. the generic lift . RWS.modify helper and have it accept the:
  2. the Env modifier for specific cases


get :: Store v -> ActionM v
get key = do
lift (RWS.gets $ (\e -> DMap.lookup key $ dmap e)) >>= \case
Just (Identity v) -> return v
Nothing -> throwE $ LookupError key

getProtoParamMode :: ActionM ProtocolParameterMode
getProtoParamMode = do
lift (RWS.gets $ (\e -> protoParams e)) >>= \case
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Here, we can similarly to the setter, extract a generic helper that calls a supplied reader on top of the common lift . RWS.gets part.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'll mop up the read accessors in a sweep after finishing off all the Store cases. The set accessors might still be worthwhile vs. open-coding, though lift $ modify lambda isn't too big a deal either.

Just x -> return x
Nothing -> throwE $ UserError "Unset ProtocolParams"

traceBenchTxSubmit :: (forall txId. x -> Tracer.TraceBenchTxSubmit txId) -> x -> ActionM ()
traceBenchTxSubmit tag msg = do
tracers <- get BenchTracers
Expand Down
1 change: 0 additions & 1 deletion bench/tx-generator/src/Cardano/Benchmarking/Script/Store.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,6 @@ data Store v where
KeyName :: !String -> Store (SigningKey PaymentKey)
ThreadName :: !String -> Store AsyncBenchmarkControl
WalletName :: !String -> Store WalletRef
ProtocolParameterMode :: Store ProtocolParameterMode

type KeyName = Store (SigningKey PaymentKey)
type ThreadName = Store AsyncBenchmarkControl
Expand Down