1
1
mirror of https://github.com/anoma/juvix.git synced 2024-12-24 16:12:14 +03:00

Support running nockma code with a running Anoma client (#3180)

This PR:

1. Adds a new interpretation for the Anoma effect, which makes gRPC
calls to an existing Anoma client instead of spawning a new one.
2. Adds a new `nockma run` mode, `with-client`, which can be used to run
an Anoma program against a running Anoma client, using its URL and gRPC
port.
3. separates the `nockma run` command into subcommands.

CLI docs:

## `nockma run`

```
Usage: juvix dev nockma run COMMAND

  Subcommands used to run an Anoma program. Use with artefacts obtained from
  compilation with the anoma target

Available options:
  -h,--help                Show this help text

Available commands:
  builtin-evaluator        Run with the builtin Nockma evaluator
  ephemeral-client         Run with an ephemeral Anoma client
  with-client              Run with a running Anoma client
```

### `with-client`

```
Usage: juvix dev nockma run with-client
         NOCKMA_FILE [--args ARGS_FILE] (-p|--grpc-port PORT) [--url URL]

  Run with a running Anoma client

Available options:
  NOCKMA_FILE              Path to a .nockma file
  --args ARGS_FILE         Path to file containing args. The args file should
                           contain a list (i.e. to pass 2 and [1 4] as args, the
                           contents should be [2 [1 4] 0]).
  -p,--grpc-port PORT      The GRPC port of a running Anoma client
  --url URL                The URL of a running Anoma client. default: localhost
  -h,--help                Show this help text
```

### `ephemeral-client`

```
Usage: juvix dev nockma run ephemeral-client
         NOCKMA_FILE [--args ARGS_FILE] --anoma-dir ANOMA_DIR

  Run with an ephemeral Anoma client

Available options:
  NOCKMA_FILE              Path to a .nockma file
  --args ARGS_FILE         Path to file containing args. The args file should
                           contain a list (i.e. to pass 2 and [1 4] as args, the
                           contents should be [2 [1 4] 0]).
  --anoma-dir ANOMA_DIR    Path to anoma repository
  -h,--help                Show this help text
```

### `builtin-evaluator`

```
Usage: juvix dev nockma run builtin-evaluator
         NOCKMA_FILE [--args ARGS_FILE] [--profile]

  Run with the builtin Nockma evaluator

Available options:
  NOCKMA_FILE              Path to a .nockma file
  --args ARGS_FILE         Path to file containing args. The args file should
                           contain a list (i.e. to pass 2 and [1 4] as args, the
                           contents should be [2 [1 4] 0]).
  --profile                Report evaluator profiling statistics
  -h,--help                Show this help text
```
This commit is contained in:
Paul Cadman 2024-11-20 07:53:21 +00:00 committed by GitHub
parent 455249db4d
commit 865842046d
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
13 changed files with 266 additions and 80 deletions

View File

@ -12,7 +12,7 @@ data NockmaCommand
= NockmaRepl NockmaReplOptions
| NockmaEval NockmaEvalOptions
| NockmaFormat NockmaFormatOptions
| NockmaRun NockmaRunOptions
| NockmaRun NockmaRunCommand
| NockmaEncode NockmaEncodeOptions
| NockmaIde NockmaIdeCommand
deriving stock (Data)
@ -53,8 +53,8 @@ parseNockmaCommand =
runInfo :: ParserInfo NockmaCommand
runInfo =
info
(NockmaRun <$> parseNockmaRunOptions)
(progDesc ("Run an Anoma program. It should be used with artefacts obtained from compilation with the anoma target. If the --" <> anomaDirOptLongStr <> " is given, then it runs the code in an anoma node"))
(NockmaRun <$> parseNockmaRunCommand)
(progDesc "Subcommands used to run an Anoma program. Use with artefacts obtained from compilation with the anoma target")
commandFromAsm :: Mod CommandFields NockmaCommand
commandFromAsm = command "eval" fromAsmInfo

View File

@ -1,51 +1,13 @@
module Commands.Dev.Nockma.Run where
import Anoma.Effect
import Commands.Base hiding (Atom)
import Commands.Base
import Commands.Dev.Nockma.Run.BuiltinEvaluator as BuiltinEvaluator
import Commands.Dev.Nockma.Run.EphemeralClient as EphemeralClient
import Commands.Dev.Nockma.Run.Options
import Juvix.Compiler.Nockma.Anoma
import Juvix.Compiler.Nockma.EvalCompiled
import Juvix.Compiler.Nockma.Evaluator
import Juvix.Compiler.Nockma.Pretty
import Juvix.Compiler.Nockma.Translation.FromSource qualified as Nockma
import Commands.Dev.Nockma.Run.WithClient as WithClient
runCommand :: forall r. (Members AppEffects r) => NockmaRunOptions -> Sem r ()
runCommand opts = do
afile <- fromAppPathFile inputFile
argsFile <- mapM fromAppPathFile (opts ^. nockmaRunArgs)
parsedArgs <- runAppError @JuvixError (mapM Nockma.cueJammedFileOrPretty argsFile)
parsedTerm <- runAppError @JuvixError (Nockma.cueJammedFileOrPretty afile)
case parsedTerm of
TermAtom {} -> exitFailMsg "Expected nockma input to be a cell"
t@(TermCell {}) -> case opts ^. nockmaRunAnomaDir of
Just path -> do
anomaDir <- AnomaPath <$> fromAppPathDir path
runInAnoma anomaDir t (maybe [] unfoldList parsedArgs)
Nothing -> do
let formula = anomaCallTuple parsedArgs
(counts, res) <-
runOpCounts
. runReader defaultEvalOptions
. runOutputSem @(Term Natural) (logInfo . mkAnsiText . ppTrace)
$ evalCompiledNock' t formula
putStrLn (ppPrint res)
let statsFile = replaceExtension' ".profile" afile
writeFileEnsureLn statsFile (prettyText counts)
where
inputFile :: AppPath File
inputFile = opts ^. nockmaRunFile
runInAnoma :: (Members AppEffects r) => AnomaPath -> Term Natural -> [Term Natural] -> Sem r ()
runInAnoma anoma t args = runAppError @SimpleError . runAnomaEphemeral anoma $ do
res <-
runNockma
RunNockmaInput
{ _runNockmaProgram = t,
_runNockmaArgs = args
}
let traces = res ^. runNockmaTraces
renderStdOutLn (annotate AnnImportant $ "Traces (" <> show (length traces) <> "):")
forM_ traces $ \tr ->
renderStdOutLn (ppPrint tr)
renderStdOutLn (annotate AnnImportant "Result:")
renderStdOutLn (ppPrint (res ^. runNockmaResult))
runCommand :: forall r. (Members AppEffects r) => NockmaRunCommand -> Sem r ()
runCommand = \case
NockmaRunBuiltinEvaluator opts -> BuiltinEvaluator.runCommand opts
NockmaRunEphemeralClient opts -> EphemeralClient.runCommand opts
NockmaRunWithClient opts -> WithClient.runCommand opts

View File

@ -0,0 +1,38 @@
module Commands.Dev.Nockma.Run.Anoma where
import Anoma.Effect
import Commands.Base hiding (Atom)
import Juvix.Compiler.Nockma.Pretty
import Juvix.Compiler.Nockma.Translation.FromSource qualified as Nockma
data RunCommandArgs = RunCommandArgs
{ _runCommandArgsFile :: Maybe (AppPath File),
_runCommandProgramFile :: AppPath File
}
makeLenses ''RunCommandArgs
runInAnoma :: forall r. (Members '[Error SimpleError, Anoma] r, Members AppEffects r) => RunCommandArgs -> Sem r ()
runInAnoma runArgs = do
afile <- fromAppPathFile (runArgs ^. runCommandProgramFile)
argsFile <- mapM fromAppPathFile (runArgs ^. runCommandArgsFile)
parsedArgs <- runAppError @JuvixError (mapM Nockma.cueJammedFileOrPretty argsFile)
parsedTerm <- runAppError @JuvixError (Nockma.cueJammedFileOrPretty afile)
case parsedTerm of
TermAtom {} -> exitFailMsg "Expected nockma input to be a cell"
t@(TermCell {}) -> go t (maybe [] unfoldList parsedArgs)
where
go :: Term Natural -> [Term Natural] -> Sem r ()
go t args = do
res <-
runNockma
RunNockmaInput
{ _runNockmaProgram = t,
_runNockmaArgs = args
}
let traces = res ^. runNockmaTraces
renderStdOutLn (annotate AnnImportant $ "Traces (" <> show (length traces) <> "):")
forM_ traces $ \tr ->
renderStdOutLn (ppPrint tr)
renderStdOutLn (annotate AnnImportant "Result:")
renderStdOutLn (ppPrint (res ^. runNockmaResult))

View File

@ -0,0 +1,29 @@
module Commands.Dev.Nockma.Run.BuiltinEvaluator where
import Commands.Base hiding (Atom)
import Commands.Dev.Nockma.Run.BuiltinEvaluator.Options
import Juvix.Compiler.Nockma.Anoma
import Juvix.Compiler.Nockma.EvalCompiled
import Juvix.Compiler.Nockma.Evaluator
import Juvix.Compiler.Nockma.Pretty
import Juvix.Compiler.Nockma.Translation.FromSource qualified as Nockma
runCommand :: forall r. (Members AppEffects r) => NockmaRunBuiltinEvaluatorOptions -> Sem r ()
runCommand opts = do
afile <- fromAppPathFile (opts ^. nockmaRunBuiltinFile)
argsFile <- mapM fromAppPathFile (opts ^. nockmaRunBuiltinArgs)
parsedArgs <- runAppError @JuvixError (mapM Nockma.cueJammedFileOrPretty argsFile)
parsedTerm <- runAppError @JuvixError (Nockma.cueJammedFileOrPretty afile)
case parsedTerm of
TermAtom {} -> exitFailMsg "Expected nockma input to be a cell"
t@(TermCell {}) -> do
let formula = anomaCallTuple parsedArgs
(counts, res) <-
runOpCounts
. runReader defaultEvalOptions
. runOutputSem @(Term Natural) (logInfo . mkAnsiText . ppTrace)
$ evalCompiledNock' t formula
putStrLn (ppPrint res)
when (opts ^. nockmaRunBuiltinProfile) $ do
let statsFile = replaceExtension' ".profile" afile
writeFileEnsureLn statsFile (prettyText counts)

View File

@ -0,0 +1,23 @@
module Commands.Dev.Nockma.Run.BuiltinEvaluator.Options where
import CommonOptions
data NockmaRunBuiltinEvaluatorOptions = NockmaRunBuiltinEvaluatorOptions
{ _nockmaRunBuiltinFile :: AppPath File,
_nockmaRunBuiltinProfile :: Bool,
_nockmaRunBuiltinArgs :: Maybe (AppPath File)
}
deriving stock (Data)
makeLenses ''NockmaRunBuiltinEvaluatorOptions
parseNockmaRunBuiltinEvaluatorOptions :: Parser NockmaRunBuiltinEvaluatorOptions
parseNockmaRunBuiltinEvaluatorOptions = do
_nockmaRunBuiltinFile <- parseInputFile FileExtNockma
_nockmaRunBuiltinArgs <- optional anomaArgsOpt
_nockmaRunBuiltinProfile <-
switch
( long "profile"
<> help "Report evaluator profiling statistics"
)
pure NockmaRunBuiltinEvaluatorOptions {..}

View File

@ -0,0 +1,19 @@
module Commands.Dev.Nockma.Run.EphemeralClient where
import Anoma.Effect
import Commands.Base hiding (Atom)
import Commands.Dev.Nockma.Run.Anoma
import Commands.Dev.Nockma.Run.EphemeralClient.Options
runCommand :: forall r. (Members AppEffects r) => NockmaRunEphemeralClientOptions -> Sem r ()
runCommand opts = do
anomaDir <- AnomaPath <$> fromAppPathDir (opts ^. nockmaRunEphemeralAnomaDir)
runAppError @SimpleError
. runAnomaEphemeral anomaDir
$ runInAnoma runArgs
where
runArgs =
RunCommandArgs
{ _runCommandProgramFile = opts ^. nockmaRunEphemeralFile,
_runCommandArgsFile = opts ^. nockmaRunEphemeralArgs
}

View File

@ -0,0 +1,19 @@
module Commands.Dev.Nockma.Run.EphemeralClient.Options where
import CommonOptions
data NockmaRunEphemeralClientOptions = NockmaRunEphemeralClientOptions
{ _nockmaRunEphemeralFile :: AppPath File,
_nockmaRunEphemeralAnomaDir :: AppPath Dir,
_nockmaRunEphemeralArgs :: Maybe (AppPath File)
}
deriving stock (Data)
makeLenses ''NockmaRunEphemeralClientOptions
parseNockmaRunEphemeralClientOptions :: Parser NockmaRunEphemeralClientOptions
parseNockmaRunEphemeralClientOptions = do
_nockmaRunEphemeralFile <- parseInputFile FileExtNockma
_nockmaRunEphemeralArgs <- optional anomaArgsOpt
_nockmaRunEphemeralAnomaDir <- anomaDirOpt
pure NockmaRunEphemeralClientOptions {..}

View File

@ -1,34 +1,51 @@
module Commands.Dev.Nockma.Run.Options where
module Commands.Dev.Nockma.Run.Options
( module Commands.Dev.Nockma.Run.BuiltinEvaluator.Options,
module Commands.Dev.Nockma.Run.EphemeralClient.Options,
module Commands.Dev.Nockma.Run.WithClient.Options,
module Commands.Dev.Nockma.Run.Options,
)
where
import Commands.Dev.Nockma.Run.BuiltinEvaluator.Options
import Commands.Dev.Nockma.Run.EphemeralClient.Options
import Commands.Dev.Nockma.Run.WithClient.Options
import CommonOptions
data NockmaRunOptions = NockmaRunOptions
{ _nockmaRunFile :: AppPath File,
_nockmaRunAnomaDir :: Maybe (AppPath Dir),
_nockmaRunProfile :: Bool,
_nockmaRunArgs :: Maybe (AppPath File)
}
data NockmaRunCommand
= NockmaRunBuiltinEvaluator NockmaRunBuiltinEvaluatorOptions
| NockmaRunEphemeralClient NockmaRunEphemeralClientOptions
| NockmaRunWithClient NockmaRunWithClientOptions
deriving stock (Data)
makeLenses ''NockmaRunOptions
makeLenses ''NockmaRunCommand
parseNockmaRunOptions :: Parser NockmaRunOptions
parseNockmaRunOptions = do
_nockmaRunFile <- parseInputFile FileExtNockma
_nockmaRunArgs <- optional $ do
_pathPath <-
option
somePreFileOpt
( long "args"
<> metavar "ARGS_FILE"
<> help "Path to file containing args. When run on anoma, the args file should contain a list (i.e. to pass 2 and [1 4] as args, the contents should be [2 [1 4] 0])."
<> action "file"
)
pure AppPath {_pathIsInput = True, ..}
_nockmaRunAnomaDir <- optional anomaDirOpt
_nockmaRunProfile <-
switch
( long "profile"
<> help "Report evaluator profiling statistics"
)
pure NockmaRunOptions {..}
parseNockmaRunCommand :: Parser NockmaRunCommand
parseNockmaRunCommand =
hsubparser
( mconcat
[ commandRunBuiltinEvaluator,
commandRunEphemeralClient,
commandRunWithClient
]
)
commandRunBuiltinEvaluator :: Mod CommandFields NockmaRunCommand
commandRunBuiltinEvaluator =
command "builtin-evaluator" $
info
(NockmaRunBuiltinEvaluator <$> parseNockmaRunBuiltinEvaluatorOptions)
(progDesc "Run with the builtin Nockma evaluator")
commandRunEphemeralClient :: Mod CommandFields NockmaRunCommand
commandRunEphemeralClient =
command "ephemeral-client" $
info
(NockmaRunEphemeralClient <$> parseNockmaRunEphemeralClientOptions)
(progDesc "Run with an ephemeral Anoma client")
commandRunWithClient :: Mod CommandFields NockmaRunCommand
commandRunWithClient =
command "with-client" $
info
(NockmaRunWithClient <$> parseNockmaRunWithClientOptions)
(progDesc "Run with a running Anoma client")

View File

@ -0,0 +1,23 @@
module Commands.Dev.Nockma.Run.WithClient where
import Anoma.Effect
import Commands.Base hiding (Atom)
import Commands.Dev.Nockma.Run.Anoma
import Commands.Dev.Nockma.Run.WithClient.Options
runCommand :: forall r. (Members AppEffects r) => NockmaRunWithClientOptions -> Sem r ()
runCommand opts =
runAppError @SimpleError
. runAnomaWithClient grpcInfo
$ runInAnoma runArgs
where
grpcInfo =
AnomaGrpcClientInfo
{ _anomaGrpcClientInfoUrl = opts ^. nockmaRunWithClientUrl,
_anomaGrpcClientInfoPort = opts ^. nockmaRunWithClientGrpcPort
}
runArgs =
RunCommandArgs
{ _runCommandProgramFile = opts ^. nockmaRunWithClientFile,
_runCommandArgsFile = opts ^. nockmaRunWithClientArgs
}

View File

@ -0,0 +1,35 @@
module Commands.Dev.Nockma.Run.WithClient.Options where
import CommonOptions
data NockmaRunWithClientOptions = NockmaRunWithClientOptions
{ _nockmaRunWithClientFile :: AppPath File,
_nockmaRunWithClientGrpcPort :: Int,
_nockmaRunWithClientUrl :: String,
_nockmaRunWithClientArgs :: Maybe (AppPath File)
}
deriving stock (Data)
makeLenses ''NockmaRunWithClientOptions
parseNockmaRunWithClientOptions :: Parser NockmaRunWithClientOptions
parseNockmaRunWithClientOptions = do
_nockmaRunWithClientFile <- parseInputFile FileExtNockma
_nockmaRunWithClientArgs <- optional anomaArgsOpt
_nockmaRunWithClientGrpcPort <-
option
(fromIntegral <$> naturalNumberOpt)
( long "grpc-port"
<> short 'p'
<> help ("The GRPC port of a running Anoma client")
<> metavar "PORT"
)
_nockmaRunWithClientUrl <- do
let defaultUrl :: String = "localhost"
strOption
( long "url"
<> help ("The URL of a running Anoma client. default: " <> defaultUrl)
<> value defaultUrl
<> metavar "URL"
)
pure NockmaRunWithClientOptions {..}

View File

@ -95,6 +95,18 @@ anomaDirOpt = do
_pathPath = path
}
anomaArgsOpt :: Parser (AppPath File)
anomaArgsOpt = do
_pathPath <-
option
somePreFileOpt
( long "args"
<> metavar "ARGS_FILE"
<> help "Path to file containing args. The args file should contain a list (i.e. to pass 2 and [1 4] as args, the contents should be [2 [1 4] 0])."
<> action "file"
)
pure AppPath {_pathIsInput = True, ..}
parseNumThreads :: Parser NumThreads
parseNumThreads = do
option

View File

@ -13,6 +13,7 @@ module Anoma.Effect.Base
anomaProcessHandle,
anomaPath,
runAnomaEphemeral,
runAnomaWithClient,
launchAnoma,
module Anoma.Rpc.Base,
module Juvix.Compiler.Nockma.Translation.FromTree,
@ -117,6 +118,14 @@ runAnomaEphemeral anomapath body = runReader anomapath . runProcess $ do
(`interpret` inject body) $ \case
AnomaRpc method i -> anomaRpc' method i
runAnomaWithClient :: forall r a. (Members '[Logger, EmbedIO, Error SimpleError] r) => AnomaGrpcClientInfo -> Sem (Anoma ': r) a -> Sem r a
runAnomaWithClient grpcInfo body =
runProcess
. runReader grpcInfo
$ (`interpret` inject body)
$ \case
AnomaRpc method i -> anomaRpc' method i
launchAnoma :: (Members '[Logger, EmbedIO, Error SimpleError] r) => AnomaPath -> Sem r ProcessHandle
launchAnoma anomapath = runReader anomapath . runProcess $ do
cproc <- anomaCreateProcess

View File

@ -155,7 +155,7 @@ tests:
cd $temp
juvix --log-level error compile anoma $testdir/test001.juvix --debug
[ -f test001.debug.nockma ]
juvix dev nockma run test001.debug.nockma --args $testdir/test001-args.debug.nockma
juvix dev nockma run builtin-evaluator test001.debug.nockma --args $testdir/test001-args.debug.nockma
stdout: |
106
exit-status: 0
@ -171,7 +171,7 @@ tests:
cd $temp
juvix --log-level error compile anoma $testdir/test001.juvix
[ -f test001.nockma ]
juvix dev nockma run test001.nockma --args $testdir/test001-args.debug.nockma
juvix dev nockma run builtin-evaluator test001.nockma --args $testdir/test001-args.debug.nockma
stdout: |
106
exit-status: 0