Skip to content

Instantly share code, notes, and snippets.

@kayvank

kayvank/budgeted-action.hs

Created July 6, 2025 16:32
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save kayvank/be68328327ef1c044b35b48604e6b5ab to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save kayvank/be68328327ef1c044b35b48604e6b5ab to your computer and use it in GitHub Desktop.
Download ZIP
exec-time budget an action
Raw
budgeted-action.hs
{- |
CLI parsing and budgetting execution time
-}
{-# LANGUAGE LambdaCase #-}
{-
CLI: --simulation-name ping-pong --number-seconds 45
-}
import Control.Concurrent.Async (async, race)
import Control.Concurrent (myThreadId, threadDelay)
import Control.Monad (forever)
import Control.Exception (finally)
import Options.Applicative (Parser, ParserInfo, execParser, info, helper, metavar, option, progDesc
, header, fullDesc, progDesc, showDefault
, value, help, long, auto, strOption ,(<**>))
f1 ::
String ->
-- ^ simulation name
Int ->
-- ^ default delay
IO ()
f1 name delay = h1 `finally` h2
where
h1 = do
mythreadid <- myThreadId
forever $ do
putStrLn
$ "simulation name: " <> name
<> "mythreadid: "
<> show mythreadid
<> " delay-secs: "
<> show delay
threadDelay delay
h2 = putStrLn $ "finally invoded on f1.h2"
data Cli = Cli
{ simulationName :: String
, simulationExecSeconds :: Int
} deriving (Show)
cli :: Parser Cli
cli = Cli
<$> strOption
( long "simulation-name"
<> metavar "SIMULATION"
<> help "simulation to execute, options are `ping-pong` `run-node` `run-pure`"
)
<*> option auto
( long "seconds"
<> metavar "SIMULATION"
<> help "number of seconds to run the simulation"
<> showDefault
<> value 15
)
cliOpts :: ParserInfo Cli
cliOpts = info (cli <**> helper)
( fullDesc
<> progDesc "Print a greeting for SIMULATION"
<> header "iohk-interview assignment"
)
main :: IO ()
main = do
cliParams <- execParser cliOpts
print cliParams
e <- race
(f1 (simulationName cliParams) 1_000_000)
(threadDelay $ ((simulationExecSeconds cliParams ) * 1_000_000) )
print "hello"
@kayvank
Copy link
Author

kayvank commented Jul 6, 2025

to execute:

chmod cli.hs 755
./cli.hs --help
./cli.hs --simulation-name ping-pong ## this will run with default budget of 15 seconds

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment