{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module EVM.TTY where
import Brick
import Brick.Widgets.Border
import Brick.Widgets.Center
import Brick.Widgets.List
import EVM
import EVM.ABI (decodeAbiValue, emptyAbi, abiTypeSolidity, AbiType(..))
import EVM.SymExec (maxIterationsReached, symCalldata)
import EVM.Expr (simplify)
import EVM.Dapp (DappInfo(..), emptyDapp, dappInfo, Test, extractSig, Test(..), srcMap, unitTestMethods)
import EVM.Debug
import EVM.Fetch (Fetcher)
import EVM.Fetch qualified as Fetch
import EVM.Format (showWordExact, showWordExplanation, contractNamePart,
contractPathPart, showTraceTree, prettyIfConcreteWord, formatExpr)
import EVM.Hexdump (prettyHex)
import EVM.Solvers (SolverGroup)
import EVM.Op
import EVM.Solidity hiding (storageLayout)
import EVM.Types hiding (padRight, Max)
import EVM.UnitTest
import EVM.Stepper (Stepper)
import EVM.Stepper qualified as Stepper
import EVM.StorageLayout
import EVM.TTYCenteredList qualified as Centered
import Optics.Core
import Optics.State
import Optics.TH
import Control.Monad.Operational qualified as Operational
import Control.Monad.State.Strict hiding (state)
import Data.Aeson.Optics
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.List (sort, find)
import Data.Maybe (isJust, fromJust, fromMaybe, isNothing)
import Data.Map (Map, insert, lookupLT, singleton, filter, (!?))
import Data.Map qualified as Map
import Data.Text (Text, pack)
import Data.Text qualified as T
import Data.Text qualified as Text
import Data.Text.Encoding (decodeUtf8)
import Data.Vector qualified as Vec
import Data.Vector.Storable qualified as SVec
import Data.Version (showVersion)
import Graphics.Vty qualified as V
import System.Console.Haskeline qualified as Readline
import Paths_hevm qualified as Paths
import Text.Wrap
import Witch (into)
data Name
= AbiPane
| StackPane
| BytecodePane
| TracePane
| SolidityPane
| TestPickerPane
| BrowserPane
|
deriving (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
/= :: Name -> Name -> Bool
Eq, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Name -> ShowS
showsPrec :: Int -> Name -> ShowS
$cshow :: Name -> String
show :: Name -> String
$cshowList :: [Name] -> ShowS
showList :: [Name] -> ShowS
Show, Eq Name
Eq Name
-> (Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Name -> Name -> Ordering
compare :: Name -> Name -> Ordering
$c< :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
>= :: Name -> Name -> Bool
$cmax :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
min :: Name -> Name -> Name
Ord)
type UiWidget = Widget Name
data UiVmState = UiVmState
{ UiVmState -> VM
vm :: VM
, UiVmState -> Int
step :: Int
, UiVmState -> Map Int (VM, Stepper ())
snapshots :: Map Int (VM, Stepper ())
, UiVmState -> Stepper ()
stepper :: Stepper ()
, UiVmState -> Bool
showMemory :: Bool
, UiVmState -> UnitTestOptions
testOpts :: UnitTestOptions
}
data UiTestPickerState = UiTestPickerState
{ UiTestPickerState -> GenericList Name Vector (Text, Text)
tests :: List Name (Text, Text)
, UiTestPickerState -> DappInfo
dapp :: DappInfo
, UiTestPickerState -> UnitTestOptions
opts :: UnitTestOptions
}
data UiBrowserState = UiBrowserState
{ UiBrowserState -> GenericList Name Vector (Addr, Contract)
contracts :: List Name (Addr, Contract)
, UiBrowserState -> UiVmState
vm :: UiVmState
}
data UiState
= ViewVm UiVmState
| ViewContracts UiBrowserState
| ViewPicker UiTestPickerState
| ViewHelp UiVmState
makeFieldLabelsNoPrefix ''UiVmState
makeFieldLabelsNoPrefix ''UiTestPickerState
makeFieldLabelsNoPrefix ''UiBrowserState
makePrisms ''UiState
snapshotInterval :: Int
snapshotInterval :: Int
snapshotInterval = Int
50
type Pred a = a -> Bool
data StepMode
= Step !Int
| StepUntil (Pred VM)
data Continuation a
= Stopped a
| Continue (Stepper a)
interpret
:: (?fetcher :: Fetcher
, ?maxIter :: Maybe Integer)
=> StepMode
-> Stepper a
-> StateT UiVmState IO (Continuation a)
interpret :: forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode =
ProgramView Action a -> StateT UiVmState IO (Continuation a)
forall a.
ProgramView Action a -> StateT UiVmState IO (Continuation a)
eval (ProgramView Action a -> StateT UiVmState IO (Continuation a))
-> (Stepper a -> ProgramView Action a)
-> Stepper a
-> StateT UiVmState IO (Continuation a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stepper a -> ProgramView Action a
forall (instr :: * -> *) a. Program instr a -> ProgramView instr a
Operational.view
where
eval
:: Operational.ProgramView Stepper.Action a
-> StateT UiVmState IO (Continuation a)
eval :: forall a.
ProgramView Action a -> StateT UiVmState IO (Continuation a)
eval (Operational.Return a
x) =
Continuation a -> StateT UiVmState IO (Continuation a)
forall a. a -> StateT UiVmState IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Continuation a
forall a. a -> Continuation a
Stopped a
x)
eval (Action b
action Operational.:>>= b -> ProgramT Action Identity a
k) =
case Action b
action of
Action b
Stepper.Run -> do
Optic' A_Lens NoIx UiVmState (Maybe VMResult)
-> StateT UiVmState IO (Maybe VMResult)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm Optic A_Lens NoIx UiVmState UiVmState VM VM
-> Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> Optic' A_Lens NoIx UiVmState (Maybe VMResult)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
#result) StateT UiVmState IO (Maybe VMResult)
-> (Maybe VMResult -> StateT UiVmState IO (Continuation a))
-> StateT UiVmState IO (Continuation a)
forall a b.
StateT UiVmState IO a
-> (a -> StateT UiVmState IO b) -> StateT UiVmState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just VMResult
_ -> do
b
vm <- Optic' A_Lens NoIx UiVmState b -> StateT UiVmState IO b
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic' A_Lens NoIx UiVmState b
#vm
StepMode
-> ProgramT Action Identity a
-> StateT UiVmState IO (Continuation a)
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (b -> ProgramT Action Identity a
k b
vm)
Maybe VMResult
Nothing -> do
StepMode
-> ProgramT Action Identity a
-> StateT UiVmState IO (Continuation a)
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
keepExecuting StepMode
mode (Stepper VM
Stepper.run Stepper VM
-> (VM -> ProgramT Action Identity a) -> ProgramT Action Identity a
forall a b.
ProgramT Action Identity a
-> (a -> ProgramT Action Identity b) -> ProgramT Action Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
VM -> ProgramT Action Identity a
k)
Action b
Stepper.Exec -> do
Optic' A_Lens NoIx UiVmState (Maybe b)
-> StateT UiVmState IO (Maybe b)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm Optic A_Lens NoIx UiVmState UiVmState VM VM
-> Optic A_Lens NoIx VM VM (Maybe b) (Maybe b)
-> Optic' A_Lens NoIx UiVmState (Maybe b)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx VM VM (Maybe b) (Maybe b)
#result) StateT UiVmState IO (Maybe b)
-> (Maybe b -> StateT UiVmState IO (Continuation a))
-> StateT UiVmState IO (Continuation a)
forall a b.
StateT UiVmState IO a
-> (a -> StateT UiVmState IO b) -> StateT UiVmState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just b
r ->
StepMode
-> ProgramT Action Identity a
-> StateT UiVmState IO (Continuation a)
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (b -> ProgramT Action Identity a
k b
r)
Maybe b
Nothing -> do
StepMode
-> ProgramT Action Identity a
-> StateT UiVmState IO (Continuation a)
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
keepExecuting StepMode
mode (Stepper VMResult
Stepper.exec Stepper VMResult
-> (VMResult -> ProgramT Action Identity a)
-> ProgramT Action Identity a
forall a b.
ProgramT Action Identity a
-> (a -> ProgramT Action Identity b) -> ProgramT Action Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
VMResult -> ProgramT Action Identity a
k)
Stepper.Ask (PleaseChoosePath Expr 'EWord
_ Bool -> EVM ()
cont) -> do
VM
vm <- Optic A_Lens NoIx UiVmState UiVmState VM VM
-> StateT UiVmState IO VM
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm
case VM -> Maybe Integer -> Maybe Bool
maxIterationsReached VM
vm ?maxIter::Maybe Integer
Maybe Integer
?maxIter of
Maybe Bool
Nothing -> Continuation a -> StateT UiVmState IO (Continuation a)
forall a. a -> StateT UiVmState IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Continuation a -> StateT UiVmState IO (Continuation a))
-> Continuation a -> StateT UiVmState IO (Continuation a)
forall a b. (a -> b) -> a -> b
$ ProgramT Action Identity a -> Continuation a
forall a. Stepper a -> Continuation a
Continue (b -> ProgramT Action Identity a
k ())
Just Bool
n -> StepMode
-> ProgramT Action Identity a
-> StateT UiVmState IO (Continuation a)
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (Bool -> EVM ()
cont (Bool -> Bool
not Bool
n)) Stepper ()
-> (() -> ProgramT Action Identity a) -> ProgramT Action Identity a
forall a b.
ProgramT Action Identity a
-> (a -> ProgramT Action Identity b) -> ProgramT Action Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
() -> ProgramT Action Identity a
k)
Stepper.Wait (PleaseAskSMT (Lit W256
c) [Prop]
_ BranchCondition -> EVM ()
continue) ->
StepMode
-> ProgramT Action Identity a
-> StateT UiVmState IO (Continuation a)
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (BranchCondition -> EVM ()
continue (Bool -> BranchCondition
Case (W256
c W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
> W256
0))) Stepper ()
-> (() -> ProgramT Action Identity a) -> ProgramT Action Identity a
forall a b.
ProgramT Action Identity a
-> (a -> ProgramT Action Identity b) -> ProgramT Action Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
() -> ProgramT Action Identity a
k)
Stepper.Wait Query
q -> do
do EVM b
m <- IO (EVM b) -> StateT UiVmState IO (EVM b)
forall a. IO a -> StateT UiVmState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (?fetcher::Query -> IO (EVM b)
Query -> IO (EVM b)
?fetcher Query
q)
StepMode
-> ProgramT Action Identity a
-> StateT UiVmState IO (Continuation a)
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (EVM b -> Stepper b
forall a. EVM a -> Stepper a
Stepper.evm EVM b
m Stepper b
-> (b -> ProgramT Action Identity a) -> ProgramT Action Identity a
forall a b.
ProgramT Action Identity a
-> (a -> ProgramT Action Identity b) -> ProgramT Action Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
k)
Stepper.IOAct StateT VM IO b
q -> do
LensLike' (Zoomed (StateT VM IO) b) UiVmState VM
-> StateT VM IO b -> StateT UiVmState IO b
forall c.
LensLike' (Zoomed (StateT VM IO) c) UiVmState VM
-> StateT VM IO c -> StateT UiVmState IO c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (Optic A_Lens NoIx UiVmState UiVmState VM VM
-> LensVL UiVmState UiVmState VM VM
forall k (is :: IxList) s t a b.
Is k A_Lens =>
Optic k is s t a b -> LensVL s t a b
toLensVL Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm) ((VM -> IO (b, VM)) -> StateT VM IO b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (StateT VM IO b -> VM -> IO (b, VM)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT VM IO b
q)) StateT UiVmState IO b
-> (b -> StateT UiVmState IO (Continuation a))
-> StateT UiVmState IO (Continuation a)
forall a b.
StateT UiVmState IO a
-> (a -> StateT UiVmState IO b) -> StateT UiVmState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StepMode
-> ProgramT Action Identity a
-> StateT UiVmState IO (Continuation a)
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (ProgramT Action Identity a
-> StateT UiVmState IO (Continuation a))
-> (b -> ProgramT Action Identity a)
-> b
-> StateT UiVmState IO (Continuation a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ProgramT Action Identity a
k
Stepper.EVM EVM b
m -> do
VM
vm <- Optic A_Lens NoIx UiVmState UiVmState VM VM
-> StateT UiVmState IO VM
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm
let (b
r, VM
vm1) = EVM b -> VM -> (b, VM)
forall s a. State s a -> s -> (a, s)
runState EVM b
m VM
vm
Optic A_Lens NoIx UiVmState UiVmState VM VM
-> VM -> StateT UiVmState IO ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm VM
vm1
StepMode
-> ProgramT Action Identity a
-> StateT UiVmState IO (Continuation a)
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (Stepper VMResult
Stepper.exec Stepper VMResult
-> ProgramT Action Identity a -> ProgramT Action Identity a
forall a b.
ProgramT Action Identity a
-> ProgramT Action Identity b -> ProgramT Action Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (b -> ProgramT Action Identity a
k b
r))
keepExecuting :: (?fetcher :: Fetcher
, ?maxIter :: Maybe Integer)
=> StepMode
-> Stepper a
-> StateT UiVmState IO (Continuation a)
keepExecuting :: forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
keepExecuting StepMode
mode Stepper a
restart = case StepMode
mode of
Step Int
0 -> do
Continuation a -> StateT UiVmState IO (Continuation a)
forall a. a -> StateT UiVmState IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stepper a -> Continuation a
forall a. Stepper a -> Continuation a
Continue Stepper a
restart)
Step Int
i -> do
Stepper a -> StateT UiVmState IO ()
forall a. Stepper a -> StateT UiVmState IO ()
stepOneOpcode Stepper a
restart
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret (Int -> StepMode
Step (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Stepper a
restart
StepUntil Pred VM
p -> do
VM
vm <- Optic A_Lens NoIx UiVmState UiVmState VM VM
-> StateT UiVmState IO VM
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm
if Pred VM
p VM
vm
then
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret (Int -> StepMode
Step Int
0) Stepper a
restart
else do
Stepper a -> StateT UiVmState IO ()
forall a. Stepper a -> StateT UiVmState IO ()
stepOneOpcode Stepper a
restart
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret (Pred VM -> StepMode
StepUntil Pred VM
p) Stepper a
restart
isUnitTestContract :: Text -> DappInfo -> Bool
isUnitTestContract :: Text -> DappInfo -> Bool
isUnitTestContract Text
name DappInfo
dapp =
Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
name (((Text, [(Test, [AbiType])]) -> Text)
-> [(Text, [(Test, [AbiType])])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [(Test, [AbiType])]) -> Text
forall a b. (a, b) -> a
fst DappInfo
dapp.unitTests)
mkVty :: IO V.Vty
mkVty :: IO Vty
mkVty = do
Vty
vty <- Config -> IO Vty
V.mkVty Config
V.defaultConfig
Output -> Mode -> Bool -> IO ()
V.setMode (Vty -> Output
V.outputIface Vty
vty) Mode
V.BracketedPaste Bool
True
Vty -> IO Vty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vty
vty
runFromVM :: SolverGroup -> Fetch.RpcInfo -> Maybe Integer -> DappInfo -> VM -> IO VM
runFromVM :: SolverGroup -> RpcInfo -> Maybe Integer -> DappInfo -> VM -> IO VM
runFromVM SolverGroup
solvers RpcInfo
rpcInfo Maybe Integer
maxIter' DappInfo
dappinfo VM
vm = do
let
opts :: UnitTestOptions
opts = UnitTestOptions
{ $sel:solvers:UnitTestOptions :: SolverGroup
solvers = SolverGroup
solvers
, $sel:rpcInfo:UnitTestOptions :: RpcInfo
rpcInfo = RpcInfo
rpcInfo
, $sel:verbose:UnitTestOptions :: Maybe Int
verbose = Maybe Int
forall a. Maybe a
Nothing
, $sel:maxIter:UnitTestOptions :: Maybe Integer
maxIter = Maybe Integer
maxIter'
, $sel:askSmtIters:UnitTestOptions :: Integer
askSmtIters = Integer
1
, $sel:smtTimeout:UnitTestOptions :: Maybe Natural
smtTimeout = Maybe Natural
forall a. Maybe a
Nothing
, $sel:smtDebug:UnitTestOptions :: Bool
smtDebug = Bool
False
, $sel:solver:UnitTestOptions :: Maybe Text
solver = Maybe Text
forall a. Maybe a
Nothing
, $sel:maxDepth:UnitTestOptions :: Maybe Int
maxDepth = Maybe Int
forall a. Maybe a
Nothing
, $sel:match:UnitTestOptions :: Text
match = Text
""
, $sel:fuzzRuns:UnitTestOptions :: Int
fuzzRuns = Int
1
, $sel:replay:UnitTestOptions :: Maybe (Text, ByteString)
replay = String -> Maybe (Text, ByteString)
forall a. HasCallStack => String -> a
internalError String
"irrelevant"
, $sel:vmModifier:UnitTestOptions :: VM -> VM
vmModifier = VM -> VM
forall a. a -> a
id
, $sel:testParams:UnitTestOptions :: TestVMParams
testParams = String -> TestVMParams
forall a. HasCallStack => String -> a
internalError String
"irrelevant"
, $sel:dapp:UnitTestOptions :: DappInfo
dapp = DappInfo
dappinfo
, $sel:ffiAllowed:UnitTestOptions :: Bool
ffiAllowed = Bool
False
, $sel:covMatch:UnitTestOptions :: Maybe Text
covMatch = Maybe Text
forall a. Maybe a
Nothing
}
ui0 :: UiVmState
ui0 = VM -> UnitTestOptions -> Stepper () -> UiVmState
initUiVmState VM
vm UnitTestOptions
opts (ProgramT Action Identity (Either EvmError (Expr 'Buf))
-> Stepper ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ProgramT Action Identity (Either EvmError (Expr 'Buf))
Stepper.execFully)
Vty
v <- IO Vty
mkVty
UiState
ui2 <- Vty
-> IO Vty
-> Maybe (BChan ())
-> App UiState () Name
-> UiState
-> IO UiState
forall n e s.
Ord n =>
Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO s
customMain Vty
v IO Vty
mkVty Maybe (BChan ())
forall a. Maybe a
Nothing (UnitTestOptions -> App UiState () Name
app UnitTestOptions
opts) (UiVmState -> UiState
ViewVm UiVmState
ui0)
case UiState
ui2 of
ViewVm UiVmState
ui -> VM -> IO VM
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UiVmState
ui.vm
UiState
_ -> String -> IO VM
forall a. HasCallStack => String -> a
internalError String
"customMain returned prematurely"
initUiVmState :: VM -> UnitTestOptions -> Stepper () -> UiVmState
initUiVmState :: VM -> UnitTestOptions -> Stepper () -> UiVmState
initUiVmState VM
vm0 UnitTestOptions
opts Stepper ()
script =
UiVmState
{ $sel:vm:UiVmState :: VM
vm = VM
vm0
, $sel:stepper:UiVmState :: Stepper ()
stepper = Stepper ()
script
, $sel:step:UiVmState :: Int
step = Int
0
, $sel:snapshots:UiVmState :: Map Int (VM, Stepper ())
snapshots = Int -> (VM, Stepper ()) -> Map Int (VM, Stepper ())
forall k a. k -> a -> Map k a
singleton Int
0 (VM
vm0, Stepper ()
script)
, $sel:showMemory:UiVmState :: Bool
showMemory = Bool
False
, $sel:testOpts:UiVmState :: UnitTestOptions
testOpts = UnitTestOptions
opts
}
debuggableTests :: UnitTestOptions -> (Text, [(Test, [AbiType])]) -> [(Text, Text)]
debuggableTests :: UnitTestOptions -> (Text, [(Test, [AbiType])]) -> [(Text, Text)]
debuggableTests UnitTestOptions{Bool
Int
Integer
Maybe Int
Maybe Integer
Maybe Natural
Maybe (Text, ByteString)
RpcInfo
Maybe Text
Text
SolverGroup
DappInfo
TestVMParams
VM -> VM
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
rpcInfo :: RpcInfo
solvers :: SolverGroup
verbose :: Maybe Int
maxIter :: Maybe Integer
askSmtIters :: Integer
smtDebug :: Bool
maxDepth :: Maybe Int
smtTimeout :: Maybe Natural
solver :: Maybe Text
covMatch :: Maybe Text
match :: Text
fuzzRuns :: Int
replay :: Maybe (Text, ByteString)
vmModifier :: VM -> VM
dapp :: DappInfo
testParams :: TestVMParams
ffiAllowed :: Bool
..} (Text
contractname, [(Test, [AbiType])]
tests) = case Maybe (Text, ByteString)
replay of
Maybe (Text, ByteString)
Nothing -> [(Text
contractname, Test -> Text
extractSig (Test -> Text) -> Test -> Text
forall a b. (a -> b) -> a -> b
$ (Test, [AbiType]) -> Test
forall a b. (a, b) -> a
fst (Test, [AbiType])
x) | (Test, [AbiType])
x <- [(Test, [AbiType])]
tests, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Test, [AbiType]) -> Bool
isFuzzTest (Test, [AbiType])
x]
Just (Text
sig, ByteString
_) -> [(Text
contractname, Test -> Text
extractSig (Test -> Text) -> Test -> Text
forall a b. (a -> b) -> a -> b
$ (Test, [AbiType]) -> Test
forall a b. (a, b) -> a
fst (Test, [AbiType])
x) | (Test, [AbiType])
x <- [(Test, [AbiType])]
tests, Bool -> Bool
not ((Test, [AbiType]) -> Bool
isFuzzTest (Test, [AbiType])
x) Bool -> Bool -> Bool
|| Test -> Text
extractSig ((Test, [AbiType]) -> Test
forall a b. (a, b) -> a
fst (Test, [AbiType])
x) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
sig]
isFuzzTest :: (Test, [AbiType]) -> Bool
isFuzzTest :: (Test, [AbiType]) -> Bool
isFuzzTest (SymbolicTest Text
_, [AbiType]
_) = Bool
False
isFuzzTest (ConcreteTest Text
_, []) = Bool
False
isFuzzTest (ConcreteTest Text
_, [AbiType]
_) = Bool
True
isFuzzTest (InvariantTest Text
_, [AbiType]
_) = Bool
True
main :: UnitTestOptions -> FilePath -> Maybe BuildOutput -> IO ()
main :: UnitTestOptions -> String -> Maybe BuildOutput -> IO ()
main UnitTestOptions
opts String
root Maybe BuildOutput
buildOutput = do
let
dapp :: DappInfo
dapp = DappInfo
-> (BuildOutput -> DappInfo) -> Maybe BuildOutput -> DappInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DappInfo
emptyDapp (String -> BuildOutput -> DappInfo
dappInfo String
root) Maybe BuildOutput
buildOutput
ui :: UiState
ui = UiTestPickerState -> UiState
ViewPicker (UiTestPickerState -> UiState) -> UiTestPickerState -> UiState
forall a b. (a -> b) -> a -> b
$ UiTestPickerState
{ $sel:tests:UiTestPickerState :: GenericList Name Vector (Text, Text)
tests =
Name
-> Vector (Text, Text)
-> Int
-> GenericList Name Vector (Text, Text)
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list
Name
TestPickerPane
([(Text, Text)] -> Vector (Text, Text)
forall a. [a] -> Vector a
Vec.fromList
(((Text, [(Test, [AbiType])]) -> [(Text, Text)])
-> [(Text, [(Test, [AbiType])])] -> [(Text, Text)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(UnitTestOptions -> (Text, [(Test, [AbiType])]) -> [(Text, Text)]
debuggableTests UnitTestOptions
opts)
DappInfo
dapp.unitTests))
Int
1
, $sel:dapp:UiTestPickerState :: DappInfo
dapp = DappInfo
dapp
, $sel:opts:UiTestPickerState :: UnitTestOptions
opts = UnitTestOptions
opts
}
Vty
v <- IO Vty
mkVty
UiState
_ <- Vty
-> IO Vty
-> Maybe (BChan ())
-> App UiState () Name
-> UiState
-> IO UiState
forall n e s.
Ord n =>
Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO s
customMain Vty
v IO Vty
mkVty Maybe (BChan ())
forall a. Maybe a
Nothing (UnitTestOptions -> App UiState () Name
app UnitTestOptions
opts) (UiState
ui :: UiState)
() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
takeStep
:: (?fetcher :: Fetcher
,?maxIter :: Maybe Integer)
=> UiVmState
-> StepMode
-> EventM n UiState ()
takeStep :: forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
ui StepMode
mode =
IO (Continuation (), UiVmState)
-> EventM n UiState (Continuation (), UiVmState)
forall a. IO a -> EventM n UiState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Continuation (), UiVmState)
nxt EventM n UiState (Continuation (), UiVmState)
-> ((Continuation (), UiVmState) -> EventM n UiState ())
-> EventM n UiState ()
forall a b.
EventM n UiState a
-> (a -> EventM n UiState b) -> EventM n UiState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(Stopped (), UiVmState
_) ->
() -> EventM n UiState ()
forall a. a -> EventM n UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(Continue Stepper ()
steps, UiVmState
ui') ->
UiState -> EventM n UiState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
ViewVm (UiVmState
ui' UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState (Stepper ()) (Stepper ())
#stepper Stepper ()
steps))
where
m :: StateT UiVmState IO (Continuation ())
m = StepMode -> Stepper () -> StateT UiVmState IO (Continuation ())
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode UiVmState
ui.stepper
nxt :: IO (Continuation (), UiVmState)
nxt = StateT UiVmState IO (Continuation ())
-> UiVmState -> IO (Continuation (), UiVmState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT UiVmState IO (Continuation ())
m UiVmState
ui
backstepUntil
:: (?fetcher :: Fetcher
,?maxIter :: Maybe Integer)
=> (UiVmState -> Pred VM) -> EventM n UiState ()
backstepUntil :: forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
(UiVmState -> Pred VM) -> EventM n UiState ()
backstepUntil UiVmState -> Pred VM
p = EventM n UiState UiState
forall s (m :: * -> *). MonadState s m => m s
get EventM n UiState UiState
-> (UiState -> EventM n UiState ()) -> EventM n UiState ()
forall a b.
EventM n UiState a
-> (a -> EventM n UiState b) -> EventM n UiState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
case UiVmState
s.step of
Int
0 -> () -> EventM n UiState ()
forall a. a -> EventM n UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Int
n -> do
UiVmState
s1 <- IO UiVmState -> EventM n UiState UiVmState
forall a. IO a -> EventM n UiState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UiVmState -> EventM n UiState UiVmState)
-> IO UiVmState -> EventM n UiState UiVmState
forall a b. (a -> b) -> a -> b
$ (?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> IO UiVmState
UiVmState -> IO UiVmState
backstep UiVmState
s
let
snapshots' :: Map Int (VM, Stepper ())
snapshots' = ((VM, Stepper ()) -> Bool)
-> Map Int (VM, Stepper ()) -> Map Int (VM, Stepper ())
forall a k. (a -> Bool) -> Map k a -> Map k a
Data.Map.filter (UiVmState -> Pred VM
p UiVmState
s1 Pred VM -> ((VM, Stepper ()) -> VM) -> (VM, Stepper ()) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VM, Stepper ()) -> VM
forall a b. (a, b) -> a
fst) UiVmState
s1.snapshots
case Int -> Map Int (VM, Stepper ()) -> Maybe (Int, (VM, Stepper ()))
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
lookupLT Int
n Map Int (VM, Stepper ())
snapshots' of
Maybe (Int, (VM, Stepper ()))
Nothing ->
let
(Int
step', (VM
vm', Stepper ()
stepper')) = Maybe (Int, (VM, Stepper ())) -> (Int, (VM, Stepper ()))
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Int, (VM, Stepper ())) -> (Int, (VM, Stepper ())))
-> Maybe (Int, (VM, Stepper ())) -> (Int, (VM, Stepper ()))
forall a b. (a -> b) -> a -> b
$ Int -> Map Int (VM, Stepper ()) -> Maybe (Int, (VM, Stepper ()))
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
lookupLT (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) UiVmState
s.snapshots
s2 :: UiVmState
s2 = UiVmState
s1
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState VM VM
-> VM -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm VM
vm'
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState Cache Cache
-> Cache -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm Optic A_Lens NoIx UiVmState UiVmState VM VM
-> Optic A_Lens NoIx VM VM Cache Cache
-> Optic A_Lens NoIx UiVmState UiVmState Cache Cache
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx VM VM Cache Cache
#cache) UiVmState
s1.vm.cache
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState Int Int
-> Int -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState Int Int
#step Int
step'
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState (Stepper ()) (Stepper ())
#stepper Stepper ()
stepper'
in UiVmState -> StepMode -> EventM n UiState ()
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s2 (Int -> StepMode
Step Int
0)
Just (Int
step', (VM
vm', Stepper ()
stepper')) ->
let
s2 :: UiVmState
s2 = UiVmState
s1
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState VM VM
-> VM -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm VM
vm'
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState Cache Cache
-> Cache -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm Optic A_Lens NoIx UiVmState UiVmState VM VM
-> Optic A_Lens NoIx VM VM Cache Cache
-> Optic A_Lens NoIx UiVmState UiVmState Cache Cache
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx VM VM Cache Cache
#cache) UiVmState
s1.vm.cache
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState Int Int
-> Int -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState Int Int
#step Int
step'
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState (Stepper ()) (Stepper ())
#stepper Stepper ()
stepper'
in UiVmState -> StepMode -> EventM n UiState ()
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s2 (Pred VM -> StepMode
StepUntil (Bool -> Bool
not (Bool -> Bool) -> Pred VM -> Pred VM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UiVmState -> Pred VM
p UiVmState
s1))
UiState
_ -> () -> EventM n UiState ()
forall a. a -> EventM n UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
backstep
:: (?fetcher :: Fetcher
,?maxIter :: Maybe Integer)
=> UiVmState -> IO UiVmState
backstep :: (?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> IO UiVmState
backstep UiVmState
s =
case UiVmState
s.step of
Int
0 -> UiVmState -> IO UiVmState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UiVmState
s
Int
n ->
let
(Int
step, (VM
vm, Stepper ()
stepper)) = Maybe (Int, (VM, Stepper ())) -> (Int, (VM, Stepper ()))
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Int, (VM, Stepper ())) -> (Int, (VM, Stepper ())))
-> Maybe (Int, (VM, Stepper ())) -> (Int, (VM, Stepper ()))
forall a b. (a -> b) -> a -> b
$ Int -> Map Int (VM, Stepper ()) -> Maybe (Int, (VM, Stepper ()))
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
lookupLT Int
n UiVmState
s.snapshots
s1 :: UiVmState
s1 = UiVmState
s
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState VM VM
-> VM -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm VM
vm
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState Cache Cache
-> Cache -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm Optic A_Lens NoIx UiVmState UiVmState VM VM
-> Optic A_Lens NoIx VM VM Cache Cache
-> Optic A_Lens NoIx UiVmState UiVmState Cache Cache
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx VM VM Cache Cache
#cache) UiVmState
s.vm.cache
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState Int Int
-> Int -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState Int Int
#step Int
step
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState (Stepper ()) (Stepper ())
#stepper Stepper ()
stepper
stepsToTake :: Int
stepsToTake = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
step Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
in
StateT UiVmState IO (Continuation ())
-> UiVmState -> IO (Continuation (), UiVmState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (StepMode -> Stepper () -> StateT UiVmState IO (Continuation ())
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret (Int -> StepMode
Step Int
stepsToTake) Stepper ()
stepper) UiVmState
s1 IO (Continuation (), UiVmState)
-> ((Continuation (), UiVmState) -> IO UiVmState) -> IO UiVmState
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(Continue Stepper ()
steps, UiVmState
ui') -> UiVmState -> IO UiVmState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UiVmState -> IO UiVmState) -> UiVmState -> IO UiVmState
forall a b. (a -> b) -> a -> b
$ UiVmState
ui' UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState (Stepper ()) (Stepper ())
#stepper Stepper ()
steps
(Continuation (), UiVmState)
_ -> String -> IO UiVmState
forall a. HasCallStack => String -> a
internalError String
"unexpected end"
appEvent
:: (?fetcher::Fetcher, ?maxIter :: Maybe Integer) =>
BrickEvent Name e ->
EventM Name UiState ()
appEvent :: forall e.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
BrickEvent Name e -> EventM Name UiState ()
appEvent (VtyEvent e :: Event
e@(V.EvKey Key
V.KDown [])) = EventM Name UiState UiState
forall s (m :: * -> *). MonadState s m => m s
get EventM Name UiState UiState
-> (UiState -> EventM Name UiState ()) -> EventM Name UiState ()
forall a b.
EventM Name UiState a
-> (a -> EventM Name UiState b) -> EventM Name UiState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewContracts UiBrowserState
_s -> do
LensLike'
(Zoomed
(EventM Name (GenericList Name Vector (Addr, Contract))) ())
UiState
(GenericList Name Vector (Addr, Contract))
-> EventM Name (GenericList Name Vector (Addr, Contract)) ()
-> EventM Name UiState ()
forall c.
LensLike'
(Zoomed (EventM Name (GenericList Name Vector (Addr, Contract))) c)
UiState
(GenericList Name Vector (Addr, Contract))
-> EventM Name (GenericList Name Vector (Addr, Contract)) c
-> EventM Name UiState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom
(Optic
An_AffineTraversal
NoIx
UiState
UiState
(GenericList Name Vector (Addr, Contract))
(GenericList Name Vector (Addr, Contract))
-> LensLike'
(Zoomed
(EventM Name (GenericList Name Vector (Addr, Contract))) ())
UiState
(GenericList Name Vector (Addr, Contract))
forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf (Optic
An_AffineTraversal
NoIx
UiState
UiState
(GenericList Name Vector (Addr, Contract))
(GenericList Name Vector (Addr, Contract))
-> LensLike'
(Zoomed
(EventM Name (GenericList Name Vector (Addr, Contract))) ())
UiState
(GenericList Name Vector (Addr, Contract)))
-> Optic
An_AffineTraversal
NoIx
UiState
UiState
(GenericList Name Vector (Addr, Contract))
(GenericList Name Vector (Addr, Contract))
-> LensLike'
(Zoomed
(EventM Name (GenericList Name Vector (Addr, Contract))) ())
UiState
(GenericList Name Vector (Addr, Contract))
forall a b. (a -> b) -> a -> b
$ Prism' UiState UiBrowserState
_ViewContracts Prism' UiState UiBrowserState
-> Optic
A_Lens
NoIx
UiBrowserState
UiBrowserState
(GenericList Name Vector (Addr, Contract))
(GenericList Name Vector (Addr, Contract))
-> Optic
An_AffineTraversal
NoIx
UiState
UiState
(GenericList Name Vector (Addr, Contract))
(GenericList Name Vector (Addr, Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
A_Lens
NoIx
UiBrowserState
UiBrowserState
(GenericList Name Vector (Addr, Contract))
(GenericList Name Vector (Addr, Contract))
#contracts)
(Event -> EventM Name (GenericList Name Vector (Addr, Contract)) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e)
() -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ViewPicker UiTestPickerState
_s -> do
LensLike'
(Zoomed (EventM Name (GenericList Name Vector (Text, Text))) ())
UiState
(GenericList Name Vector (Text, Text))
-> EventM Name (GenericList Name Vector (Text, Text)) ()
-> EventM Name UiState ()
forall c.
LensLike'
(Zoomed (EventM Name (GenericList Name Vector (Text, Text))) c)
UiState
(GenericList Name Vector (Text, Text))
-> EventM Name (GenericList Name Vector (Text, Text)) c
-> EventM Name UiState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom
(Optic
An_AffineTraversal
NoIx
UiState
UiState
(GenericList Name Vector (Text, Text))
(GenericList Name Vector (Text, Text))
-> LensLike'
(Zoomed (EventM Name (GenericList Name Vector (Text, Text))) ())
UiState
(GenericList Name Vector (Text, Text))
forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf (Optic
An_AffineTraversal
NoIx
UiState
UiState
(GenericList Name Vector (Text, Text))
(GenericList Name Vector (Text, Text))
-> LensLike'
(Zoomed (EventM Name (GenericList Name Vector (Text, Text))) ())
UiState
(GenericList Name Vector (Text, Text)))
-> Optic
An_AffineTraversal
NoIx
UiState
UiState
(GenericList Name Vector (Text, Text))
(GenericList Name Vector (Text, Text))
-> LensLike'
(Zoomed (EventM Name (GenericList Name Vector (Text, Text))) ())
UiState
(GenericList Name Vector (Text, Text))
forall a b. (a -> b) -> a -> b
$ Prism' UiState UiTestPickerState
_ViewPicker Prism' UiState UiTestPickerState
-> Optic
A_Lens
NoIx
UiTestPickerState
UiTestPickerState
(GenericList Name Vector (Text, Text))
(GenericList Name Vector (Text, Text))
-> Optic
An_AffineTraversal
NoIx
UiState
UiState
(GenericList Name Vector (Text, Text))
(GenericList Name Vector (Text, Text))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
A_Lens
NoIx
UiTestPickerState
UiTestPickerState
(GenericList Name Vector (Text, Text))
(GenericList Name Vector (Text, Text))
#tests)
(Event -> EventM Name (GenericList Name Vector (Text, Text)) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e)
() -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure()
UiState
_ -> () -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent e :: Event
e@(V.EvKey Key
V.KUp [])) = EventM Name UiState UiState
forall s (m :: * -> *). MonadState s m => m s
get EventM Name UiState UiState
-> (UiState -> EventM Name UiState ()) -> EventM Name UiState ()
forall a b.
EventM Name UiState a
-> (a -> EventM Name UiState b) -> EventM Name UiState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewContracts UiBrowserState
_s -> do
LensLike'
(Zoomed
(EventM Name (GenericList Name Vector (Addr, Contract))) ())
UiState
(GenericList Name Vector (Addr, Contract))
-> EventM Name (GenericList Name Vector (Addr, Contract)) ()
-> EventM Name UiState ()
forall c.
LensLike'
(Zoomed (EventM Name (GenericList Name Vector (Addr, Contract))) c)
UiState
(GenericList Name Vector (Addr, Contract))
-> EventM Name (GenericList Name Vector (Addr, Contract)) c
-> EventM Name UiState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom
(Optic
An_AffineTraversal
NoIx
UiState
UiState
(GenericList Name Vector (Addr, Contract))
(GenericList Name Vector (Addr, Contract))
-> LensLike'
(Zoomed
(EventM Name (GenericList Name Vector (Addr, Contract))) ())
UiState
(GenericList Name Vector (Addr, Contract))
forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf (Optic
An_AffineTraversal
NoIx
UiState
UiState
(GenericList Name Vector (Addr, Contract))
(GenericList Name Vector (Addr, Contract))
-> LensLike'
(Zoomed
(EventM Name (GenericList Name Vector (Addr, Contract))) ())
UiState
(GenericList Name Vector (Addr, Contract)))
-> Optic
An_AffineTraversal
NoIx
UiState
UiState
(GenericList Name Vector (Addr, Contract))
(GenericList Name Vector (Addr, Contract))
-> LensLike'
(Zoomed
(EventM Name (GenericList Name Vector (Addr, Contract))) ())
UiState
(GenericList Name Vector (Addr, Contract))
forall a b. (a -> b) -> a -> b
$ Prism' UiState UiBrowserState
_ViewContracts Prism' UiState UiBrowserState
-> Optic
A_Lens
NoIx
UiBrowserState
UiBrowserState
(GenericList Name Vector (Addr, Contract))
(GenericList Name Vector (Addr, Contract))
-> Optic
An_AffineTraversal
NoIx
UiState
UiState
(GenericList Name Vector (Addr, Contract))
(GenericList Name Vector (Addr, Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
A_Lens
NoIx
UiBrowserState
UiBrowserState
(GenericList Name Vector (Addr, Contract))
(GenericList Name Vector (Addr, Contract))
#contracts)
(Event -> EventM Name (GenericList Name Vector (Addr, Contract)) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e)
ViewPicker UiTestPickerState
_s -> do
LensLike'
(Zoomed (EventM Name (GenericList Name Vector (Text, Text))) ())
UiState
(GenericList Name Vector (Text, Text))
-> EventM Name (GenericList Name Vector (Text, Text)) ()
-> EventM Name UiState ()
forall c.
LensLike'
(Zoomed (EventM Name (GenericList Name Vector (Text, Text))) c)
UiState
(GenericList Name Vector (Text, Text))
-> EventM Name (GenericList Name Vector (Text, Text)) c
-> EventM Name UiState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom
(Optic
An_AffineTraversal
NoIx
UiState
UiState
(GenericList Name Vector (Text, Text))
(GenericList Name Vector (Text, Text))
-> LensLike'
(Zoomed (EventM Name (GenericList Name Vector (Text, Text))) ())
UiState
(GenericList Name Vector (Text, Text))
forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf (Optic
An_AffineTraversal
NoIx
UiState
UiState
(GenericList Name Vector (Text, Text))
(GenericList Name Vector (Text, Text))
-> LensLike'
(Zoomed (EventM Name (GenericList Name Vector (Text, Text))) ())
UiState
(GenericList Name Vector (Text, Text)))
-> Optic
An_AffineTraversal
NoIx
UiState
UiState
(GenericList Name Vector (Text, Text))
(GenericList Name Vector (Text, Text))
-> LensLike'
(Zoomed (EventM Name (GenericList Name Vector (Text, Text))) ())
UiState
(GenericList Name Vector (Text, Text))
forall a b. (a -> b) -> a -> b
$ Prism' UiState UiTestPickerState
_ViewPicker Prism' UiState UiTestPickerState
-> Optic
A_Lens
NoIx
UiTestPickerState
UiTestPickerState
(GenericList Name Vector (Text, Text))
(GenericList Name Vector (Text, Text))
-> Optic
An_AffineTraversal
NoIx
UiState
UiState
(GenericList Name Vector (Text, Text))
(GenericList Name Vector (Text, Text))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
A_Lens
NoIx
UiTestPickerState
UiTestPickerState
(GenericList Name Vector (Text, Text))
(GenericList Name Vector (Text, Text))
#tests)
(Event -> EventM Name (GenericList Name Vector (Text, Text)) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e)
() -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure()
UiState
_ -> () -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey Key
V.KEsc [])) = EventM Name UiState UiState
forall s (m :: * -> *). MonadState s m => m s
get EventM Name UiState UiState
-> (UiState -> EventM Name UiState ()) -> EventM Name UiState ()
forall a b.
EventM Name UiState a
-> (a -> EventM Name UiState b) -> EventM Name UiState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s -> do
let opts :: UnitTestOptions
opts = UiVmState
s UiVmState
-> Optic' A_Lens NoIx UiVmState UnitTestOptions -> UnitTestOptions
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx UiVmState UnitTestOptions
#testOpts
dapp :: DappInfo
dapp = UnitTestOptions
opts.dapp
tests :: [(Text, Text)]
tests = ((Text, [(Test, [AbiType])]) -> [(Text, Text)])
-> [(Text, [(Test, [AbiType])])] -> [(Text, Text)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (UnitTestOptions -> (Text, [(Test, [AbiType])]) -> [(Text, Text)]
debuggableTests UnitTestOptions
opts) DappInfo
dapp.unitTests
case [(Text, Text)]
tests of
[] -> EventM Name UiState ()
forall n s. EventM n s ()
halt
[(Text, Text)]
ts ->
UiState -> EventM Name UiState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiState -> EventM Name UiState ())
-> UiState -> EventM Name UiState ()
forall a b. (a -> b) -> a -> b
$ UiTestPickerState -> UiState
ViewPicker (UiTestPickerState -> UiState) -> UiTestPickerState -> UiState
forall a b. (a -> b) -> a -> b
$ UiTestPickerState
{ $sel:tests:UiTestPickerState :: GenericList Name Vector (Text, Text)
tests = Name
-> Vector (Text, Text)
-> Int
-> GenericList Name Vector (Text, Text)
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Name
TestPickerPane ([(Text, Text)] -> Vector (Text, Text)
forall a. [a] -> Vector a
Vec.fromList [(Text, Text)]
ts) Int
1
, $sel:dapp:UiTestPickerState :: DappInfo
dapp = DappInfo
dapp
, $sel:opts:UiTestPickerState :: UnitTestOptions
opts = UnitTestOptions
opts
}
ViewHelp UiVmState
s -> UiState -> EventM Name UiState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
ViewVm UiVmState
s)
ViewContracts UiBrowserState
s -> UiState -> EventM Name UiState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
ViewVm (UiVmState -> UiState) -> UiVmState -> UiState
forall a b. (a -> b) -> a -> b
$ UiBrowserState
s UiBrowserState
-> Optic' A_Lens NoIx UiBrowserState UiVmState -> UiVmState
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx UiBrowserState UiVmState
#vm)
UiState
_ -> EventM Name UiState ()
forall n s. EventM n s ()
halt
appEvent (VtyEvent (V.EvKey Key
V.KEnter [])) = EventM Name UiState UiState
forall s (m :: * -> *). MonadState s m => m s
get EventM Name UiState UiState
-> (UiState -> EventM Name UiState ()) -> EventM Name UiState ()
forall a b.
EventM Name UiState a
-> (a -> EventM Name UiState b) -> EventM Name UiState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
UiState -> EventM Name UiState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiState -> EventM Name UiState ())
-> (UiBrowserState -> UiState)
-> UiBrowserState
-> EventM Name UiState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UiBrowserState -> UiState
ViewContracts (UiBrowserState -> EventM Name UiState ())
-> UiBrowserState -> EventM Name UiState ()
forall a b. (a -> b) -> a -> b
$ UiBrowserState
{ $sel:contracts:UiBrowserState :: GenericList Name Vector (Addr, Contract)
contracts =
Name
-> Vector (Addr, Contract)
-> Int
-> GenericList Name Vector (Addr, Contract)
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list
Name
BrowserPane
([(Addr, Contract)] -> Vector (Addr, Contract)
forall a. [a] -> Vector a
Vec.fromList (Map Addr Contract -> [(Addr, Contract)]
forall k a. Map k a -> [(k, a)]
Map.toList UiVmState
s.vm.env.contracts))
Int
2
, $sel:vm:UiBrowserState :: UiVmState
vm = UiVmState
s
}
ViewPicker UiTestPickerState
s ->
case GenericList Name Vector (Text, Text) -> Maybe (Int, (Text, Text))
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement UiTestPickerState
s.tests of
Maybe (Int, (Text, Text))
Nothing -> String -> EventM Name UiState ()
forall a. HasCallStack => String -> a
internalError String
"nothing selected"
Just (Int
_, (Text, Text)
x) -> do
let initVm :: UiVmState
initVm = UnitTestOptions -> (Text, Text) -> UiVmState
initialUiVmStateForTest UiTestPickerState
s.opts (Text, Text)
x
UiState -> EventM Name UiState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
ViewVm UiVmState
initVm)
UiState
_ -> () -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'm') [])) = EventM Name UiState UiState
forall s (m :: * -> *). MonadState s m => m s
get EventM Name UiState UiState
-> (UiState -> EventM Name UiState ()) -> EventM Name UiState ()
forall a b.
EventM Name UiState a
-> (a -> EventM Name UiState b) -> EventM Name UiState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s -> UiState -> EventM Name UiState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
ViewVm (UiVmState -> UiState) -> UiVmState -> UiState
forall a b. (a -> b) -> a -> b
$ Optic A_Lens NoIx UiVmState UiVmState Bool Bool
-> (Bool -> Bool) -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx UiVmState UiVmState Bool Bool
#showMemory Bool -> Bool
not UiVmState
s)
UiState
_ -> () -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'h') [])) = EventM Name UiState UiState
forall s (m :: * -> *). MonadState s m => m s
get EventM Name UiState UiState
-> (UiState -> EventM Name UiState ()) -> EventM Name UiState ()
forall a b.
EventM Name UiState a
-> (a -> EventM Name UiState b) -> EventM Name UiState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s -> UiState -> EventM Name UiState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
ViewHelp UiVmState
s)
UiState
_ -> () -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
' ') [])) =
let
loop :: InputT IO ()
loop = do
String -> InputT IO (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
Readline.getInputLine String
"% " InputT IO (Maybe String)
-> (Maybe String -> InputT IO ()) -> InputT IO ()
forall a b. InputT IO a -> (a -> InputT IO b) -> InputT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just String
hey -> String -> InputT IO ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
Readline.outputStrLn String
hey
Maybe String
Nothing -> () -> InputT IO ()
forall a. a -> InputT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
String -> InputT IO (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
Readline.getInputLine String
"% " InputT IO (Maybe String)
-> (Maybe String -> InputT IO ()) -> InputT IO ()
forall a b. InputT IO a -> (a -> InputT IO b) -> InputT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just String
hey' -> String -> InputT IO ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
Readline.outputStrLn String
hey'
Maybe String
Nothing -> () -> InputT IO ()
forall a. a -> InputT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
in do
UiState
s <- EventM Name UiState UiState
forall s (m :: * -> *). MonadState s m => m s
get
IO UiState -> EventM Name UiState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume (IO UiState -> EventM Name UiState ())
-> IO UiState -> EventM Name UiState ()
forall a b. (a -> b) -> a -> b
$ do
Settings IO -> InputT IO () -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
Readline.runInputT Settings IO
forall (m :: * -> *). MonadIO m => Settings m
Readline.defaultSettings InputT IO ()
loop
UiState -> IO UiState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UiState
s
appEvent (VtyEvent (V.EvKey (V.KChar Char
'n') [])) = EventM Name UiState UiState
forall s (m :: * -> *). MonadState s m => m s
get EventM Name UiState UiState
-> (UiState -> EventM Name UiState ()) -> EventM Name UiState ()
forall a b.
EventM Name UiState a
-> (a -> EventM Name UiState b) -> EventM Name UiState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
Bool -> EventM Name UiState () -> EventM Name UiState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe VMResult -> Bool
forall a. Maybe a -> Bool
isNothing (UiVmState
s UiVmState
-> Optic' A_Lens NoIx UiVmState (Maybe VMResult) -> Maybe VMResult
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm Optic A_Lens NoIx UiVmState UiVmState VM VM
-> Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> Optic' A_Lens NoIx UiVmState (Maybe VMResult)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
#result)) (EventM Name UiState () -> EventM Name UiState ())
-> EventM Name UiState () -> EventM Name UiState ()
forall a b. (a -> b) -> a -> b
$
UiVmState -> StepMode -> EventM Name UiState ()
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s (Int -> StepMode
Step Int
1)
UiState
_ -> () -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'N') [])) = EventM Name UiState UiState
forall s (m :: * -> *). MonadState s m => m s
get EventM Name UiState UiState
-> (UiState -> EventM Name UiState ()) -> EventM Name UiState ()
forall a b.
EventM Name UiState a
-> (a -> EventM Name UiState b) -> EventM Name UiState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
Bool -> EventM Name UiState () -> EventM Name UiState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe VMResult -> Bool
forall a. Maybe a -> Bool
isNothing (UiVmState
s UiVmState
-> Optic' A_Lens NoIx UiVmState (Maybe VMResult) -> Maybe VMResult
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm Optic A_Lens NoIx UiVmState UiVmState VM VM
-> Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> Optic' A_Lens NoIx UiVmState (Maybe VMResult)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
#result)) (EventM Name UiState () -> EventM Name UiState ())
-> EventM Name UiState () -> EventM Name UiState ()
forall a b. (a -> b) -> a -> b
$
UiVmState -> StepMode -> EventM Name UiState ()
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s (Pred VM -> StepMode
StepUntil (UiVmState -> Pred VM
isNextSourcePosition UiVmState
s))
UiState
_ -> () -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'n') [Modifier
V.MCtrl])) = EventM Name UiState UiState
forall s (m :: * -> *). MonadState s m => m s
get EventM Name UiState UiState
-> (UiState -> EventM Name UiState ()) -> EventM Name UiState ()
forall a b.
EventM Name UiState a
-> (a -> EventM Name UiState b) -> EventM Name UiState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
Bool -> EventM Name UiState () -> EventM Name UiState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe VMResult -> Bool
forall a. Maybe a -> Bool
isNothing (UiVmState
s UiVmState
-> Optic' A_Lens NoIx UiVmState (Maybe VMResult) -> Maybe VMResult
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm Optic A_Lens NoIx UiVmState UiVmState VM VM
-> Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> Optic' A_Lens NoIx UiVmState (Maybe VMResult)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
#result)) (EventM Name UiState () -> EventM Name UiState ())
-> EventM Name UiState () -> EventM Name UiState ()
forall a b. (a -> b) -> a -> b
$
UiVmState -> StepMode -> EventM Name UiState ()
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s (Pred VM -> StepMode
StepUntil (UiVmState -> Pred VM
isNextSourcePositionWithoutEntering UiVmState
s))
UiState
_ -> () -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'e') [])) = EventM Name UiState UiState
forall s (m :: * -> *). MonadState s m => m s
get EventM Name UiState UiState
-> (UiState -> EventM Name UiState ()) -> EventM Name UiState ()
forall a b.
EventM Name UiState a
-> (a -> EventM Name UiState b) -> EventM Name UiState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
Bool -> EventM Name UiState () -> EventM Name UiState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe VMResult -> Bool
forall a. Maybe a -> Bool
isNothing (UiVmState
s UiVmState
-> Optic' A_Lens NoIx UiVmState (Maybe VMResult) -> Maybe VMResult
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm Optic A_Lens NoIx UiVmState UiVmState VM VM
-> Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> Optic' A_Lens NoIx UiVmState (Maybe VMResult)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
#result)) (EventM Name UiState () -> EventM Name UiState ())
-> EventM Name UiState () -> EventM Name UiState ()
forall a b. (a -> b) -> a -> b
$
UiVmState -> StepMode -> EventM Name UiState ()
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s (Pred VM -> StepMode
StepUntil (UiVmState -> Pred VM
isExecutionHalted UiVmState
s))
UiState
_ -> () -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'a') [])) = EventM Name UiState UiState
forall s (m :: * -> *). MonadState s m => m s
get EventM Name UiState UiState
-> (UiState -> EventM Name UiState ()) -> EventM Name UiState ()
forall a b.
EventM Name UiState a
-> (a -> EventM Name UiState b) -> EventM Name UiState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
let
(VM
vm, Stepper ()
stepper) = Maybe (VM, Stepper ()) -> (VM, Stepper ())
forall a. HasCallStack => Maybe a -> a
fromJust (Int -> Map Int (VM, Stepper ()) -> Maybe (VM, Stepper ())
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
0 UiVmState
s.snapshots)
s' :: UiVmState
s' = UiVmState
s
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState VM VM
-> VM -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm VM
vm
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState Cache Cache
-> Cache -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm Optic A_Lens NoIx UiVmState UiVmState VM VM
-> Optic A_Lens NoIx VM VM Cache Cache
-> Optic A_Lens NoIx UiVmState UiVmState Cache Cache
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx VM VM Cache Cache
#cache) UiVmState
s.vm.cache
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState Int Int
-> Int -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState Int Int
#step Int
0
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState (Stepper ()) (Stepper ())
#stepper Stepper ()
stepper
in UiVmState -> StepMode -> EventM Name UiState ()
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s' (Int -> StepMode
Step Int
0)
UiState
_ -> () -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'p') [])) = EventM Name UiState UiState
forall s (m :: * -> *). MonadState s m => m s
get EventM Name UiState UiState
-> (UiState -> EventM Name UiState ()) -> EventM Name UiState ()
forall a b.
EventM Name UiState a
-> (a -> EventM Name UiState b) -> EventM Name UiState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
case UiVmState
s.step of
Int
0 ->
() -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Int
n -> do
let
(Int
step, (VM
vm, Stepper ()
stepper)) = Maybe (Int, (VM, Stepper ())) -> (Int, (VM, Stepper ()))
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Int, (VM, Stepper ())) -> (Int, (VM, Stepper ())))
-> Maybe (Int, (VM, Stepper ())) -> (Int, (VM, Stepper ()))
forall a b. (a -> b) -> a -> b
$ Int -> Map Int (VM, Stepper ()) -> Maybe (Int, (VM, Stepper ()))
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
lookupLT Int
n UiVmState
s.snapshots
s1 :: UiVmState
s1 = UiVmState
s
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState VM VM
-> VM -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm VM
vm
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState Cache Cache
-> Cache -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm Optic A_Lens NoIx UiVmState UiVmState VM VM
-> Optic A_Lens NoIx VM VM Cache Cache
-> Optic A_Lens NoIx UiVmState UiVmState Cache Cache
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx VM VM Cache Cache
#cache) UiVmState
s.vm.cache
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState Int Int
-> Int -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState Int Int
#step Int
step
UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState (Stepper ()) (Stepper ())
#stepper Stepper ()
stepper
stepsToTake :: Int
stepsToTake = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
step Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
UiVmState -> StepMode -> EventM Name UiState ()
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s1 (Int -> StepMode
Step Int
stepsToTake)
UiState
_ -> () -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'P') [])) =
(UiVmState -> Pred VM) -> EventM Name UiState ()
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
(UiVmState -> Pred VM) -> EventM n UiState ()
backstepUntil UiVmState -> Pred VM
isNextSourcePosition
appEvent (VtyEvent (V.EvKey (V.KChar Char
'p') [Modifier
V.MCtrl])) =
(UiVmState -> Pred VM) -> EventM Name UiState ()
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
(UiVmState -> Pred VM) -> EventM n UiState ()
backstepUntil UiVmState -> Pred VM
isNextSourcePositionWithoutEntering
appEvent (VtyEvent (V.EvKey (V.KChar Char
'0') [])) = EventM Name UiState UiState
forall s (m :: * -> *). MonadState s m => m s
get EventM Name UiState UiState
-> (UiState -> EventM Name UiState ()) -> EventM Name UiState ()
forall a b.
EventM Name UiState a
-> (a -> EventM Name UiState b) -> EventM Name UiState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
case Optic' A_Lens NoIx UiVmState (Maybe VMResult)
-> UiVmState -> Maybe VMResult
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm Optic A_Lens NoIx UiVmState UiVmState VM VM
-> Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> Optic' A_Lens NoIx UiVmState (Maybe VMResult)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
#result) UiVmState
s of
Just (HandleEffect (Choose (PleaseChoosePath Expr 'EWord
_ Bool -> EVM ()
contin))) ->
UiVmState -> StepMode -> EventM Name UiState ()
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep (UiVmState
s UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState (Stepper ()) (Stepper ())
#stepper (EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (Bool -> EVM ()
contin Bool
True) Stepper () -> Stepper () -> Stepper ()
forall a b.
ProgramT Action Identity a
-> ProgramT Action Identity b -> ProgramT Action Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UiVmState
s.stepper))
(Int -> StepMode
Step Int
1)
Maybe VMResult
_ -> () -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
UiState
_ -> () -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'1') [])) = EventM Name UiState UiState
forall s (m :: * -> *). MonadState s m => m s
get EventM Name UiState UiState
-> (UiState -> EventM Name UiState ()) -> EventM Name UiState ()
forall a b.
EventM Name UiState a
-> (a -> EventM Name UiState b) -> EventM Name UiState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
case UiVmState
s.vm.result of
Just (HandleEffect (Choose (PleaseChoosePath Expr 'EWord
_ Bool -> EVM ()
contin))) ->
UiVmState -> StepMode -> EventM Name UiState ()
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep (UiVmState
s UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx UiVmState UiVmState (Stepper ()) (Stepper ())
#stepper (EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (Bool -> EVM ()
contin Bool
False) Stepper () -> Stepper () -> Stepper ()
forall a b.
ProgramT Action Identity a
-> ProgramT Action Identity b -> ProgramT Action Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UiVmState
s.stepper))
(Int -> StepMode
Step Int
1)
Maybe VMResult
_ -> () -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
UiState
_ -> () -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'f') [Modifier
V.MCtrl])) =
ViewportScroll Name -> forall s. Direction -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage (Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
TracePane) Direction
Down
appEvent (VtyEvent (V.EvKey (V.KChar Char
'b') [Modifier
V.MCtrl])) =
ViewportScroll Name -> forall s. Direction -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage (Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
TracePane) Direction
Up
appEvent (VtyEvent Event
e) = do
LensLike'
(Zoomed (EventM Name (GenericList Name Vector (Text, Text))) ())
UiState
(GenericList Name Vector (Text, Text))
-> EventM Name (GenericList Name Vector (Text, Text)) ()
-> EventM Name UiState ()
forall c.
LensLike'
(Zoomed (EventM Name (GenericList Name Vector (Text, Text))) c)
UiState
(GenericList Name Vector (Text, Text))
-> EventM Name (GenericList Name Vector (Text, Text)) c
-> EventM Name UiState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (Optic
An_AffineTraversal
NoIx
UiState
UiState
(GenericList Name Vector (Text, Text))
(GenericList Name Vector (Text, Text))
-> (GenericList Name Vector (Text, Text)
-> Focusing
(StateT (EventState Name) IO)
()
(GenericList Name Vector (Text, Text)))
-> UiState
-> Focusing (StateT (EventState Name) IO) () UiState
forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf (Prism' UiState UiTestPickerState
_ViewPicker Prism' UiState UiTestPickerState
-> Optic
A_Lens
NoIx
UiTestPickerState
UiTestPickerState
(GenericList Name Vector (Text, Text))
(GenericList Name Vector (Text, Text))
-> Optic
An_AffineTraversal
NoIx
UiState
UiState
(GenericList Name Vector (Text, Text))
(GenericList Name Vector (Text, Text))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
A_Lens
NoIx
UiTestPickerState
UiTestPickerState
(GenericList Name Vector (Text, Text))
(GenericList Name Vector (Text, Text))
#tests))
(Event -> EventM Name (GenericList Name Vector (Text, Text)) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e)
appEvent BrickEvent Name e
_ = () -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
app :: UnitTestOptions -> App UiState () Name
app :: UnitTestOptions -> App UiState () Name
app UnitTestOptions{Bool
Int
Integer
Maybe Int
Maybe Integer
Maybe Natural
Maybe (Text, ByteString)
RpcInfo
Maybe Text
Text
SolverGroup
DappInfo
TestVMParams
VM -> VM
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
rpcInfo :: RpcInfo
solvers :: SolverGroup
verbose :: Maybe Int
maxIter :: Maybe Integer
askSmtIters :: Integer
smtDebug :: Bool
maxDepth :: Maybe Int
smtTimeout :: Maybe Natural
solver :: Maybe Text
covMatch :: Maybe Text
match :: Text
fuzzRuns :: Int
replay :: Maybe (Text, ByteString)
vmModifier :: VM -> VM
dapp :: DappInfo
testParams :: TestVMParams
ffiAllowed :: Bool
..} =
let ?fetcher = SolverGroup -> RpcInfo -> Fetcher
Fetch.oracle SolverGroup
solvers RpcInfo
rpcInfo
?maxIter = ?maxIter::Maybe Integer
Maybe Integer
maxIter
in App
{ appDraw :: UiState -> [Widget Name]
appDraw = UiState -> [Widget Name]
drawUi
, appChooseCursor :: UiState -> [CursorLocation Name] -> Maybe (CursorLocation Name)
appChooseCursor = UiState -> [CursorLocation Name] -> Maybe (CursorLocation Name)
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
neverShowCursor
, appHandleEvent :: BrickEvent Name () -> EventM Name UiState ()
appHandleEvent = BrickEvent Name () -> EventM Name UiState ()
forall e.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
BrickEvent Name e -> EventM Name UiState ()
appEvent
, appStartEvent :: EventM Name UiState ()
appStartEvent = () -> EventM Name UiState ()
forall a. a -> EventM Name UiState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
, appAttrMap :: UiState -> AttrMap
appAttrMap = AttrMap -> UiState -> AttrMap
forall a b. a -> b -> a
const (Attr -> [(AttrName, Attr)] -> AttrMap
attrMap Attr
V.defAttr [(AttrName, Attr)]
myTheme)
}
initialUiVmStateForTest
:: UnitTestOptions
-> (Text, Text)
-> UiVmState
initialUiVmStateForTest :: UnitTestOptions -> (Text, Text) -> UiVmState
initialUiVmStateForTest opts :: UnitTestOptions
opts@UnitTestOptions{Bool
Int
Integer
Maybe Int
Maybe Integer
Maybe Natural
Maybe (Text, ByteString)
RpcInfo
Maybe Text
Text
SolverGroup
DappInfo
TestVMParams
VM -> VM
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
rpcInfo :: RpcInfo
solvers :: SolverGroup
verbose :: Maybe Int
maxIter :: Maybe Integer
askSmtIters :: Integer
smtDebug :: Bool
maxDepth :: Maybe Int
smtTimeout :: Maybe Natural
solver :: Maybe Text
covMatch :: Maybe Text
match :: Text
fuzzRuns :: Int
replay :: Maybe (Text, ByteString)
vmModifier :: VM -> VM
dapp :: DappInfo
testParams :: TestVMParams
ffiAllowed :: Bool
..} (Text
theContractName, Text
theTestName) = VM -> UnitTestOptions -> Stepper () -> UiVmState
initUiVmState VM
vm0 UnitTestOptions
opts Stepper ()
script
where
cd :: (Expr 'Buf, [Prop])
cd = case Test
test of
SymbolicTest Text
_ -> Text -> [AbiType] -> [String] -> Expr 'Buf -> (Expr 'Buf, [Prop])
symCalldata Text
theTestName [AbiType]
types [] (Text -> Expr 'Buf
AbstractBuf Text
"txdata")
Test
_ -> (String -> Expr 'Buf
forall a. HasCallStack => String -> a
internalError String
"unreachable", String -> [Prop]
forall a. HasCallStack => String -> a
error (String -> [Prop]) -> String -> [Prop]
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. HasCallStack => String -> a
internalError String
"unreachable")
(Test
test, [AbiType]
types) = Maybe (Test, [AbiType]) -> (Test, [AbiType])
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Test, [AbiType]) -> (Test, [AbiType]))
-> Maybe (Test, [AbiType]) -> (Test, [AbiType])
forall a b. (a -> b) -> a -> b
$ ((Test, [AbiType]) -> Bool)
-> [(Test, [AbiType])] -> Maybe (Test, [AbiType])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Test
test',[AbiType]
_) -> Test -> Text
extractSig Test
test' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
theTestName) ([(Test, [AbiType])] -> Maybe (Test, [AbiType]))
-> [(Test, [AbiType])] -> Maybe (Test, [AbiType])
forall a b. (a -> b) -> a -> b
$ SolcContract -> [(Test, [AbiType])]
unitTestMethods SolcContract
testContract
testContract :: SolcContract
testContract = Maybe SolcContract -> SolcContract
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe SolcContract -> SolcContract)
-> Maybe SolcContract -> SolcContract
forall a b. (a -> b) -> a -> b
$ Text -> Map Text SolcContract -> Maybe SolcContract
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
theContractName DappInfo
dapp.solcByName
vm0 :: VM
vm0 =
UnitTestOptions -> SolcContract -> VM
initialUnitTestVm UnitTestOptions
opts SolcContract
testContract
script :: Stepper ()
script = do
EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (EVM () -> Stepper ()) -> (Text -> EVM ()) -> Text -> Stepper ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceData -> EVM ()
pushTrace (TraceData -> EVM ()) -> (Text -> TraceData) -> Text -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TraceData
EntryTrace (Text -> Stepper ()) -> Text -> Stepper ()
forall a b. (a -> b) -> a -> b
$
Text
"test " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
theTestName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
theContractName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
UnitTestOptions -> SolcContract -> Stepper ()
initializeUnitTest UnitTestOptions
opts SolcContract
testContract
case Test
test of
ConcreteTest Text
_ -> do
let args :: AbiValue
args = case Maybe (Text, ByteString)
replay of
Maybe (Text, ByteString)
Nothing -> AbiValue
emptyAbi
Just (Text
sig, ByteString
callData) ->
if Text
theTestName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
sig
then AbiType -> ByteString -> AbiValue
decodeAbiValue (Vector AbiType -> AbiType
AbiTupleType ([AbiType] -> Vector AbiType
forall a. [a] -> Vector a
Vec.fromList [AbiType]
types)) ByteString
callData
else AbiValue
emptyAbi
ProgramT Action Identity Bool -> Stepper ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UnitTestOptions
-> Text -> AbiValue -> ProgramT Action Identity Bool
runUnitTest UnitTestOptions
opts Text
theTestName AbiValue
args)
SymbolicTest Text
_ -> do
ProgramT Action Identity (Expr 'End) -> Stepper ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UnitTestOptions
-> Text
-> (Expr 'Buf, [Prop])
-> ProgramT Action Identity (Expr 'End)
execSymTest UnitTestOptions
opts Text
theTestName (Expr 'Buf, [Prop])
cd)
InvariantTest Text
_ -> do
[Addr]
targets <- UnitTestOptions -> Stepper [Addr]
getTargetContracts UnitTestOptions
opts
let randomRun :: Stepper (Bool, RLP)
randomRun = UnitTestOptions
-> Text -> [ExploreTx] -> [Addr] -> Int -> Stepper (Bool, RLP)
initialExplorationStepper UnitTestOptions
opts Text
theTestName [] [Addr]
targets (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
20 Maybe Int
maxDepth)
Stepper (Bool, RLP) -> Stepper ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Stepper (Bool, RLP) -> Stepper ())
-> Stepper (Bool, RLP) -> Stepper ()
forall a b. (a -> b) -> a -> b
$ case Maybe (Text, ByteString)
replay of
Maybe (Text, ByteString)
Nothing -> Stepper (Bool, RLP)
randomRun
Just (Text
sig, ByteString
cd') ->
if Text
theTestName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
sig
then UnitTestOptions
-> Text -> [ExploreTx] -> [Addr] -> Int -> Stepper (Bool, RLP)
initialExplorationStepper UnitTestOptions
opts Text
theTestName (ByteString -> [ExploreTx]
decodeCalls ByteString
cd') [Addr]
targets ([ExploreTx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ByteString -> [ExploreTx]
decodeCalls ByteString
cd'))
else Stepper (Bool, RLP)
randomRun
myTheme :: [(AttrName, V.Attr)]
myTheme :: [(AttrName, Attr)]
myTheme =
[ (AttrName
selectedAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.standout)
, (AttrName
dimAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.dim)
, (AttrName
borderAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.dim)
, (AttrName
wordAttr, Color -> Attr
fg Color
V.yellow)
, (AttrName
boldAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.bold)
, (AttrName
activeAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.standout)
]
drawUi :: UiState -> [UiWidget]
drawUi :: UiState -> [Widget Name]
drawUi (ViewVm UiVmState
s) = UiVmState -> [Widget Name]
drawVm UiVmState
s
drawUi (ViewPicker UiTestPickerState
s) = UiTestPickerState -> [Widget Name]
drawTestPicker UiTestPickerState
s
drawUi (ViewContracts UiBrowserState
s) = UiBrowserState -> [Widget Name]
drawVmBrowser UiBrowserState
s
drawUi (ViewHelp UiVmState
_) = [Widget Name]
drawHelpView
drawHelpView :: [UiWidget]
drawHelpView :: [Widget Name]
drawHelpView =
[ Widget Name -> Widget Name
forall n. Widget n -> Widget n
center (Widget Name -> Widget Name)
-> (String -> Widget Name) -> String -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
borderWithLabel Widget Name
forall {n}. Widget n
version (Widget Name -> Widget Name)
-> (String -> Widget Name) -> String -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
4 (Widget Name -> Widget Name)
-> (String -> Widget Name) -> String -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padTopBottom Int
2 (Widget Name -> Widget Name)
-> (String -> Widget Name) -> String -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Widget Name
forall n. String -> Widget n
str (String -> Widget Name) -> String -> Widget Name
forall a b. (a -> b) -> a -> b
$
String
"Esc Exit the debugger\n\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
"a Step to start\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
"e Step to end\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
"n Step fwds by one instruction\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
"N Step fwds to the next source position\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
"C-n Step fwds to the next source position skipping CALL & CREATE\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
"p Step back by one instruction\n\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
"P Step back to the previous source position\n\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
"C-p Step back to the previous source position skipping CALL & CREATE\n\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
"m Toggle memory pane\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
"0 Choose the branch which does not jump \n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
"1 Choose the branch which does jump \n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
"Down Step to next entry in the callstack / Scroll memory pane\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
"Up Step to previous entry in the callstack / Scroll memory pane\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
"C-f Page memory pane fwds\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
"C-b Page memory pane back\n\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
"Enter Contracts browser"
]
where
version :: Widget n
version =
Text -> Widget n
forall n. Text -> Widget n
txt Text
"Hevm " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+>
String -> Widget n
forall n. String -> Widget n
str (Version -> String
showVersion Version
Paths.version) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+>
Text -> Widget n
forall n. Text -> Widget n
txt Text
" - Key bindings"
drawTestPicker :: UiTestPickerState -> [UiWidget]
drawTestPicker :: UiTestPickerState -> [Widget Name]
drawTestPicker UiTestPickerState
ui =
[ Widget Name -> Widget Name
forall n. Widget n -> Widget n
center (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Unit tests") (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
80 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
(Bool -> (Text, Text) -> Widget Name)
-> Bool -> GenericList Name Vector (Text, Text) -> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList
(\Bool
selected (Text
x, Text
y) ->
Bool -> Widget Name -> Widget Name
forall n. Bool -> Widget n -> Widget n
withHighlight Bool
selected (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Text -> Widget Name
forall n. Text -> Widget n
txt Text
" Debug " Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Text
contractNamePart Text
x) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget Name
forall n. Text -> Widget n
txt Text
"::" Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget Name
forall n. Text -> Widget n
txt Text
y)
Bool
True
UiTestPickerState
ui.tests
]
drawVmBrowser :: UiBrowserState -> [UiWidget]
drawVmBrowser :: UiBrowserState -> [Widget Name]
drawVmBrowser UiBrowserState
ui =
[ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox
[ Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Contracts") (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
60 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
(Bool -> (Addr, Contract) -> Widget Name)
-> Bool -> GenericList Name Vector (Addr, Contract) -> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList
(\Bool
selected (Addr
k, Contract
c') ->
Bool -> Widget Name -> Widget Name
forall n. Bool -> Widget n -> Widget n
withHighlight Bool
selected (Widget Name -> Widget Name)
-> ([Text] -> Widget Name) -> [Text] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> ([Text] -> Text) -> [Text] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Widget Name) -> [Text] -> Widget Name
forall a b. (a -> b) -> a -> b
$
[ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"<unknown contract>" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$
W256
-> Map W256 (CodeType, SolcContract)
-> Maybe (CodeType, SolcContract)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Contract -> W256
forall {r} {t}. HasField "codehash" r (Expr 'EWord) => r -> t
maybeHash Contract
c') DappInfo
dapp.solcByHash Maybe (CodeType, SolcContract)
-> ((CodeType, SolcContract) -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (.contractName) (SolcContract -> Text)
-> ((CodeType, SolcContract) -> SolcContract)
-> (CodeType, SolcContract)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeType, SolcContract) -> SolcContract
forall a b. (a, b) -> b
snd
, Text
"\n"
, Text
" ", String -> Text
pack (Addr -> String
forall a. Show a => a -> String
show Addr
k)
])
Bool
True
UiBrowserState
ui.contracts
, case (CodeType, SolcContract) -> SolcContract
forall a b. (a, b) -> b
snd ((CodeType, SolcContract) -> SolcContract)
-> Maybe (CodeType, SolcContract) -> Maybe SolcContract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> W256
-> Map W256 (CodeType, SolcContract)
-> Maybe (CodeType, SolcContract)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Contract -> W256
forall {r} {t}. HasField "codehash" r (Expr 'EWord) => r -> t
maybeHash Contract
c) DappInfo
dapp.solcByHash of
Maybe SolcContract
Nothing ->
[Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox
[ Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Contract information") (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox
[ Text -> Widget Name
forall n. Text -> Widget n
txt (Text
"Codehash: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Expr 'EWord -> String
forall a. Show a => a -> String
show Contract
c.codehash))
, Text -> Widget Name
forall n. Text -> Widget n
txt (Text
"Nonce: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> W256 -> Text
showWordExact Contract
c.nonce)
, Text -> Widget Name
forall n. Text -> Widget n
txt (Text
"Balance: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> W256 -> Text
showWordExact Contract
c.balance)
]
]
Just SolcContract
sol ->
[Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox
[ Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Contract information") (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
2) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox
[ Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Name: " Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Text
contractNamePart SolcContract
sol.contractName)
, Text -> Widget Name
forall n. Text -> Widget n
txt Text
"File: " Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Text
contractPathPart SolcContract
sol.contractName)
, Text -> Widget Name
forall n. Text -> Widget n
txt Text
" "
, Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Constructor inputs:"
, [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name)
-> (((Text, AbiType) -> Widget Name) -> [Widget Name])
-> ((Text, AbiType) -> Widget Name)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Text, AbiType) -> Widget Name)
-> [(Text, AbiType)] -> [Widget Name])
-> [(Text, AbiType)]
-> ((Text, AbiType) -> Widget Name)
-> [Widget Name]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Text, AbiType) -> Widget Name)
-> [(Text, AbiType)] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map SolcContract
sol.constructorInputs (((Text, AbiType) -> Widget Name) -> Widget Name)
-> ((Text, AbiType) -> Widget Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$
\(Text
name, AbiType
abiType) -> Text -> Widget Name
forall n. Text -> Widget n
txt (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AbiType -> Text
abiTypeSolidity AbiType
abiType)
, Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Public methods:"
, [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name)
-> ((Method -> Widget Name) -> [Widget Name])
-> (Method -> Widget Name)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Method -> Widget Name) -> [Method] -> [Widget Name])
-> [Method] -> (Method -> Widget Name) -> [Widget Name]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Method -> Widget Name) -> [Method] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map ([Method] -> [Method]
forall a. Ord a => [a] -> [a]
sort (Map FunctionSelector Method -> [Method]
forall k a. Map k a -> [a]
Map.elems SolcContract
sol.abiMap)) ((Method -> Widget Name) -> Widget Name)
-> (Method -> Widget Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$
\Method
method -> Text -> Widget Name
forall n. Text -> Widget n
txt (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Method
method.methodSignature)
]
, Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Storage slots") (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox
((Text -> Widget Name) -> [Text] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Widget Name
forall n. Text -> Widget n
txt (DappInfo -> SolcContract -> [Text]
storageLayout DappInfo
dapp SolcContract
sol))
]
]
]
where
dapp :: DappInfo
dapp = UiBrowserState
ui.vm.testOpts.dapp
(Int
_, (Addr
_, Contract
c)) = Maybe (Int, (Addr, Contract)) -> (Int, (Addr, Contract))
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Int, (Addr, Contract)) -> (Int, (Addr, Contract)))
-> Maybe (Int, (Addr, Contract)) -> (Int, (Addr, Contract))
forall a b. (a -> b) -> a -> b
$ GenericList Name Vector (Addr, Contract)
-> Maybe (Int, (Addr, Contract))
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement UiBrowserState
ui.contracts
maybeHash :: r -> t
maybeHash r
ch = Maybe (Maybe W256 -> t) -> Maybe W256 -> t
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe (Maybe W256 -> t)
forall a. HasCallStack => String -> a
internalError String
"cannot find concrete codehash for partially symbolic code") (Expr 'EWord -> Maybe W256
maybeLitWord r
ch.codehash)
drawVm :: UiVmState -> [UiWidget]
drawVm :: UiVmState -> [Widget Name]
drawVm UiVmState
ui =
[ Int -> Widget Name -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n -> Widget n
ifTallEnough (Int
20 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)
( [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox
[ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
20 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ UiVmState -> Widget Name
drawBytecodePane UiVmState
ui
, Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
20 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ UiVmState -> Widget Name
drawStackPane UiVmState
ui
, UiVmState -> Widget Name
drawSolidityPane UiVmState
ui
, Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
20 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ UiVmState -> Widget Name
drawTracePane UiVmState
ui
, Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
2 Widget Name
drawHelpBar
]
)
( [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox
[ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox
[ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
20 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ UiVmState -> Widget Name
drawBytecodePane UiVmState
ui
, Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
20 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ UiVmState -> Widget Name
drawStackPane UiVmState
ui
]
, [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox
[ UiVmState -> Widget Name
drawSolidityPane UiVmState
ui
, UiVmState -> Widget Name
drawTracePane UiVmState
ui
]
, Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
2 Widget Name
drawHelpBar
]
)
]
drawHelpBar :: UiWidget
drawHelpBar :: Widget Name
drawHelpBar = Widget Name
forall {n}. Widget n
hBorder Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter Widget Name
help
where
help :: Widget Name
help =
[Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox (((Text, Text) -> Widget Name) -> [(Text, Text)] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, Text
v) -> Text -> Widget Name
forall n. Text -> Widget n
txt Text
k Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name -> Widget Name
forall n. Widget n -> Widget n
dim (Text -> Widget Name
forall n. Text -> Widget n
txt (Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") "))) [(Text, Text)]
helps)
helps :: [(Text, Text)]
helps =
[
(Text
"n", Text
"step")
, (Text
"p", Text
"step back")
, (Text
"a", Text
"step to start")
, (Text
"e", Text
"step to end")
, (Text
"m", Text
"toggle memory")
, (Text
"Esc", Text
"exit")
, (Text
"h", Text
"more help")
]
stepOneOpcode :: Stepper a -> StateT UiVmState IO ()
stepOneOpcode :: forall a. Stepper a -> StateT UiVmState IO ()
stepOneOpcode Stepper a
restart = do
Int
n <- Optic A_Lens NoIx UiVmState UiVmState Int Int
-> StateT UiVmState IO Int
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic A_Lens NoIx UiVmState UiVmState Int Int
#step
Bool -> StateT UiVmState IO () -> StateT UiVmState IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
snapshotInterval Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (StateT UiVmState IO () -> StateT UiVmState IO ())
-> StateT UiVmState IO () -> StateT UiVmState IO ()
forall a b. (a -> b) -> a -> b
$ do
VM
vm <- Optic A_Lens NoIx UiVmState UiVmState VM VM
-> StateT UiVmState IO VM
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm
Optic
A_Lens
NoIx
UiVmState
UiVmState
(Map Int (VM, Stepper ()))
(Map Int (VM, Stepper ()))
-> (Map Int (VM, Stepper ()) -> Map Int (VM, Stepper ()))
-> StateT UiVmState IO ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying Optic
A_Lens
NoIx
UiVmState
UiVmState
(Map Int (VM, Stepper ()))
(Map Int (VM, Stepper ()))
#snapshots (Int
-> (VM, Stepper ())
-> Map Int (VM, Stepper ())
-> Map Int (VM, Stepper ())
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Int
n (VM
vm, Stepper a -> Stepper ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Stepper a
restart))
Optic A_Lens NoIx UiVmState UiVmState VM VM
-> (VM -> VM) -> StateT UiVmState IO ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying Optic A_Lens NoIx UiVmState UiVmState VM VM
#vm (EVM () -> VM -> VM
forall s a. State s a -> s -> s
execState EVM ()
exec1)
Optic A_Lens NoIx UiVmState UiVmState Int Int
-> (Int -> Int) -> StateT UiVmState IO ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying Optic A_Lens NoIx UiVmState UiVmState Int Int
#step (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
isNewTraceAdded
:: UiVmState -> Pred VM
isNewTraceAdded :: UiVmState -> Pred VM
isNewTraceAdded UiVmState
ui VM
vm =
let
currentTraceTree :: [Int]
currentTraceTree = Tree Trace -> Int
forall a. Tree a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tree Trace -> Int) -> [Tree Trace] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VM -> [Tree Trace]
traceForest UiVmState
ui.vm
newTraceTree :: [Int]
newTraceTree = Tree Trace -> Int
forall a. Tree a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tree Trace -> Int) -> [Tree Trace] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VM -> [Tree Trace]
traceForest VM
vm
in [Int]
currentTraceTree [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Int]
newTraceTree
isNextSourcePosition
:: UiVmState -> Pred VM
isNextSourcePosition :: UiVmState -> Pred VM
isNextSourcePosition UiVmState
ui VM
vm =
let dapp :: DappInfo
dapp = UiVmState
ui.testOpts.dapp
initialPosition :: Maybe SrcMap
initialPosition = DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp UiVmState
ui.vm
in DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp VM
vm Maybe SrcMap -> Maybe SrcMap -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe SrcMap
initialPosition
isNextSourcePositionWithoutEntering
:: UiVmState -> Pred VM
isNextSourcePositionWithoutEntering :: UiVmState -> Pred VM
isNextSourcePositionWithoutEntering UiVmState
ui VM
vm =
let
dapp :: DappInfo
dapp = UiVmState
ui.testOpts.dapp
vm0 :: VM
vm0 = UiVmState
ui.vm
initialPosition :: Maybe SrcMap
initialPosition = DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp VM
vm0
initialHeight :: Int
initialHeight = [Frame] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length VM
vm0.frames
in
case DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp VM
vm of
Maybe SrcMap
Nothing ->
Bool
False
Just SrcMap
here ->
let
moved :: Bool
moved = SrcMap -> Maybe SrcMap
forall a. a -> Maybe a
Just SrcMap
here Maybe SrcMap -> Maybe SrcMap -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe SrcMap
initialPosition
deeper :: Bool
deeper = [Frame] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length VM
vm.frames Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
initialHeight
boring :: Bool
boring =
case SourceCache -> SrcMap -> Maybe ByteString
srcMapCode DappInfo
dapp.sources SrcMap
here of
Just ByteString
bs ->
ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
"contract " ByteString
bs
Maybe ByteString
Nothing ->
Bool
True
in
Bool
moved Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
deeper Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
boring
isExecutionHalted :: UiVmState -> Pred VM
isExecutionHalted :: UiVmState -> Pred VM
isExecutionHalted UiVmState
_ VM
vm = Maybe VMResult -> Bool
forall a. Maybe a -> Bool
isJust VM
vm.result
currentSrcMap :: DappInfo -> VM -> Maybe SrcMap
currentSrcMap :: DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp VM
vm = do
Contract
this <- VM -> Maybe Contract
currentContract VM
vm
Int
i <- Contract
this.opIxMap Vector Int -> Int -> Maybe Int
forall a. Storable a => Vector a -> Int -> Maybe a
SVec.!? VM
vm.state.pc
DappInfo -> Contract -> Int -> Maybe SrcMap
srcMap DappInfo
dapp Contract
this Int
i
drawStackPane :: UiVmState -> UiWidget
drawStackPane :: UiVmState -> Widget Name
drawStackPane UiVmState
ui =
let
gasText :: Text
gasText = W256 -> Text
showWordExact (Word64 -> W256
forall target source. From source target => source -> target
into UiVmState
ui.vm.state.gas)
labelText :: Widget Name
labelText = Text -> Widget Name
forall n. Text -> Widget n
txt (Text
"Gas available: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
gasText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"; stack:")
stackList :: GenericList Name Vector (Int, Expr 'EWord)
stackList = Name
-> Vector (Int, Expr 'EWord)
-> Int
-> GenericList Name Vector (Int, Expr 'EWord)
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Name
StackPane ([(Int, Expr 'EWord)] -> Vector (Int, Expr 'EWord)
forall a. [a] -> Vector a
Vec.fromList ([(Int, Expr 'EWord)] -> Vector (Int, Expr 'EWord))
-> [(Int, Expr 'EWord)] -> Vector (Int, Expr 'EWord)
forall a b. (a -> b) -> a -> b
$ [Int] -> [Expr 'EWord] -> [(Int, Expr 'EWord)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1 :: Int)..] (Expr 'EWord -> Expr 'EWord
forall (a :: EType). Expr a -> Expr a
simplify (Expr 'EWord -> Expr 'EWord) -> [Expr 'EWord] -> [Expr 'EWord]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UiVmState
ui.vm.state.stack)) Int
2
in Widget Name -> Widget Name
forall n. Widget n -> Widget n
hBorderWithLabel Widget Name
labelText Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=>
(Bool -> (Int, Expr 'EWord) -> Widget Name)
-> Bool
-> GenericList Name Vector (Int, Expr 'EWord)
-> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList
(\Bool
_ (Int
i, Expr 'EWord
w) ->
[Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox
[ Bool -> Widget Name -> Widget Name
forall n. Bool -> Widget n -> Widget n
withHighlight Bool
True (String -> Widget Name
forall n. String -> Widget n
str (String
"#" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "))
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget Name
forall n. String -> Widget n
ourWrap (Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Text
prettyIfConcreteWord Expr 'EWord
w)
, Widget Name -> Widget Name
forall n. Widget n -> Widget n
dim (Text -> Widget Name
forall n. Text -> Widget n
txt (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
w of
Maybe W256
Nothing -> Text
""
Just W256
u -> W256 -> DappInfo -> Text
showWordExplanation W256
u UiVmState
ui.testOpts.dapp))
])
Bool
False
GenericList Name Vector (Int, Expr 'EWord)
stackList
message :: VM -> String
message :: VM -> String
message VM
vm =
case VM
vm.result of
Just (VMSuccess (ConcreteBuf ByteString
msg)) ->
String
"VMSuccess: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (ByteStringS -> String
forall a. Show a => a -> String
show (ByteStringS -> String) -> ByteStringS -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteStringS
ByteStringS ByteString
msg)
Just (VMSuccess (Expr 'Buf
msg)) ->
String
"VMSuccess: <symbolicbuffer> " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Expr 'Buf -> String
forall a. Show a => a -> String
show Expr 'Buf
msg)
Just (VMFailure (Revert Expr 'Buf
msg)) ->
String
"VMFailure: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Expr 'Buf -> String
forall a. Show a => a -> String
show Expr 'Buf
msg)
Just (VMFailure EvmError
err) ->
String
"VMFailure: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> EvmError -> String
forall a. Show a => a -> String
show EvmError
err
Just (Unfinished PartialExec
p) ->
String
"Could not continue execution: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PartialExec -> String
forall a. Show a => a -> String
show PartialExec
p
Just (HandleEffect Effect
e) ->
String
"Handling side effect: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Effect -> String
forall a. Show a => a -> String
show Effect
e
Maybe VMResult
Nothing ->
String
"Executing EVM code in " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Addr -> String
forall a. Show a => a -> String
show VM
vm.state.contract
drawBytecodePane :: UiVmState -> UiWidget
drawBytecodePane :: UiVmState -> Widget Name
drawBytecodePane UiVmState
ui =
let
vm :: VM
vm = UiVmState
ui.vm
move :: GenericList Name Vector (Int, Op)
-> GenericList Name Vector (Int, Op)
move = (GenericList Name Vector (Int, Op)
-> GenericList Name Vector (Int, Op))
-> (Int
-> GenericList Name Vector (Int, Op)
-> GenericList Name Vector (Int, Op))
-> Maybe Int
-> GenericList Name Vector (Int, Op)
-> GenericList Name Vector (Int, Op)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GenericList Name Vector (Int, Op)
-> GenericList Name Vector (Int, Op)
forall a. a -> a
id Int
-> GenericList Name Vector (Int, Op)
-> GenericList Name Vector (Int, Op)
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo (Maybe Int
-> GenericList Name Vector (Int, Op)
-> GenericList Name Vector (Int, Op))
-> Maybe Int
-> GenericList Name Vector (Int, Op)
-> GenericList Name Vector (Int, Op)
forall a b. (a -> b) -> a -> b
$ VM -> Maybe Int
vmOpIx VM
vm
in
Widget Name -> Widget Name
forall n. Widget n -> Widget n
hBorderWithLabel (String -> Widget Name
forall n. String -> Widget n
str (String -> Widget Name) -> String -> Widget Name
forall a b. (a -> b) -> a -> b
$ VM -> String
message VM
vm) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=>
(Bool -> (Int, Op) -> Widget Name)
-> Bool -> GenericList Name Vector (Int, Op) -> Widget Name
forall n e.
(Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> List n e -> Widget n
Centered.renderList
(\Bool
active (Int, Op)
x -> if Bool -> Bool
not Bool
active
then AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dimAttr ((Int, Op) -> Widget Name
forall a n. (Integral a, Show a) => (a, Op) -> Widget n
opWidget (Int, Op)
x)
else AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
boldAttr ((Int, Op) -> Widget Name
forall a n. (Integral a, Show a) => (a, Op) -> Widget n
opWidget (Int, Op)
x))
Bool
False
(GenericList Name Vector (Int, Op)
-> GenericList Name Vector (Int, Op)
move (GenericList Name Vector (Int, Op)
-> GenericList Name Vector (Int, Op))
-> GenericList Name Vector (Int, Op)
-> GenericList Name Vector (Int, Op)
forall a b. (a -> b) -> a -> b
$ Name
-> Vector (Int, Op) -> Int -> GenericList Name Vector (Int, Op)
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Name
BytecodePane
(Vector (Int, Op)
-> (Contract -> Vector (Int, Op))
-> Maybe Contract
-> Vector (Int, Op)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Vector (Int, Op)
forall a. Monoid a => a
mempty (.codeOps) (VM -> Maybe Contract
currentContract VM
vm))
Int
1)
dim :: Widget n -> Widget n
dim :: forall n. Widget n -> Widget n
dim = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dimAttr
withHighlight :: Bool -> Widget n -> Widget n
withHighlight :: forall n. Bool -> Widget n -> Widget n
withHighlight Bool
False = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dimAttr
withHighlight Bool
True = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
boldAttr
prettyIfConcrete :: Expr Buf -> String
prettyIfConcrete :: Expr 'Buf -> String
prettyIfConcrete (ConcreteBuf ByteString
x) = Int -> ByteString -> String
prettyHex Int
40 ByteString
x
prettyIfConcrete Expr 'Buf
x = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> Text
forall (a :: EType). Expr a -> Text
formatExpr (Expr 'Buf -> Text) -> Expr 'Buf -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> Expr 'Buf
forall (a :: EType). Expr a -> Expr a
simplify Expr 'Buf
x
drawTracePane :: UiVmState -> UiWidget
drawTracePane :: UiVmState -> Widget Name
drawTracePane UiVmState
s =
let vm :: VM
vm = UiVmState
s.vm
dapp :: DappInfo
dapp = UiVmState
s.testOpts.dapp
traceList :: GenericList Name Vector Text
traceList =
Name -> Vector Text -> Int -> GenericList Name Vector Text
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list
Name
TracePane
([Text] -> Vector Text
forall a. [a] -> Vector a
Vec.fromList
([Text] -> Vector Text) -> (VM -> [Text]) -> VM -> Vector Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines
(Text -> [Text]) -> (VM -> Text) -> VM -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DappInfo -> VM -> Text
showTraceTree DappInfo
dapp
(VM -> Vector Text) -> VM -> Vector Text
forall a b. (a -> b) -> a -> b
$ VM
vm)
Int
1
in case UiVmState
s.showMemory of
Bool
True -> Name -> ViewportType -> Widget Name -> Widget Name
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport Name
TracePane ViewportType
Vertical (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Widget Name -> Widget Name
forall n. Widget n -> Widget n
hBorderWithLabel (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Calldata")
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> String -> Widget Name
forall n. String -> Widget n
ourWrap (Expr 'Buf -> String
prettyIfConcrete VM
vm.state.calldata)
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name -> Widget Name
forall n. Widget n -> Widget n
hBorderWithLabel (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Returndata")
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> String -> Widget Name
forall n. String -> Widget n
ourWrap (Expr 'Buf -> String
prettyIfConcrete VM
vm.state.returndata)
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name -> Widget Name
forall n. Widget n -> Widget n
hBorderWithLabel (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Output")
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> String -> Widget Name
forall n. String -> Widget n
ourWrap (String -> (VMResult -> String) -> Maybe VMResult -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" VMResult -> String
forall a. Show a => a -> String
show VM
vm.result)
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name -> Widget Name
forall n. Widget n -> Widget n
hBorderWithLabel (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Cache")
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> String -> Widget Name
forall n. String -> Widget n
ourWrap (Map (CodeLocation, Int) Bool -> String
forall a. Show a => a -> String
show VM
vm.cache.path)
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name -> Widget Name
forall n. Widget n -> Widget n
hBorderWithLabel (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Path Conditions")
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> (String -> Widget Name
forall n. String -> Widget n
ourWrap (String -> Widget Name) -> String -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Prop] -> String
forall a. Show a => a -> String
show ([Prop] -> String) -> [Prop] -> String
forall a b. (a -> b) -> a -> b
$ VM
vm.constraints)
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name -> Widget Name
forall n. Widget n -> Widget n
hBorderWithLabel (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Memory")
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> (String -> Widget Name
forall n. String -> Widget n
ourWrap (Expr 'Buf -> String
prettyIfConcrete VM
vm.state.memory))
Bool
False ->
Widget Name -> Widget Name
forall n. Widget n -> Widget n
hBorderWithLabel (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Trace")
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> (Bool -> Text -> Widget Name)
-> Bool -> GenericList Name Vector Text -> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList
(\Bool
_ Text
x -> Text -> Widget Name
forall n. Text -> Widget n
txt Text
x)
Bool
False
(Int -> GenericList Name Vector Text -> GenericList Name Vector Text
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo (GenericList Name Vector Text -> Int
forall a. GenericList Name Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length GenericList Name Vector Text
traceList) GenericList Name Vector Text
traceList)
ourWrap :: String -> Widget n
ourWrap :: forall n. String -> Widget n
ourWrap = WrapSettings -> String -> Widget n
forall n. WrapSettings -> String -> Widget n
strWrapWith WrapSettings
settings
where
settings :: WrapSettings
settings = WrapSettings
{ preserveIndentation :: Bool
preserveIndentation = Bool
True
, breakLongWords :: Bool
breakLongWords = Bool
True
, fillStrategy :: FillStrategy
fillStrategy = FillStrategy
NoFill
, fillScope :: FillScope
fillScope = FillScope
FillAfterFirst
}
solidityList :: VM -> DappInfo -> List Name (Int, ByteString)
solidityList :: VM -> DappInfo -> List Name (Int, ByteString)
solidityList VM
vm DappInfo
dapp =
Name
-> Vector (Int, ByteString) -> Int -> List Name (Int, ByteString)
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Name
SolidityPane
(case DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp VM
vm of
Maybe SrcMap
Nothing -> Vector (Int, ByteString)
forall a. Monoid a => a
mempty
Just SrcMap
x ->
Vector (Int, ByteString)
-> Maybe (Vector (Int, ByteString)) -> Vector (Int, ByteString)
forall a. a -> Maybe a -> a
fromMaybe
(String -> Vector (Int, ByteString)
forall a. HasCallStack => String -> a
internalError String
"unable to find line for source map")
(Optic'
An_AffineFold
NoIx
(Map Int (Vector ByteString))
(Vector (Int, ByteString))
-> Map Int (Vector ByteString) -> Maybe (Vector (Int, ByteString))
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (
Index (Map Int (Vector ByteString))
-> Optic'
(IxKind (Map Int (Vector ByteString)))
NoIx
(Map Int (Vector ByteString))
(IxValue (Map Int (Vector ByteString)))
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix SrcMap
x.file
Optic
(IxKind (Map Int (Vector ByteString)))
NoIx
(Map Int (Vector ByteString))
(Map Int (Vector ByteString))
(Vector ByteString)
(Vector ByteString)
-> Optic
A_Getter
NoIx
(Vector ByteString)
(Vector ByteString)
(Vector (Int, ByteString))
(Vector (Int, ByteString))
-> Optic'
An_AffineFold
NoIx
(Map Int (Vector ByteString))
(Vector (Int, ByteString))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Vector ByteString -> Vector (Int, ByteString))
-> Optic
A_Getter
NoIx
(Vector ByteString)
(Vector ByteString)
(Vector (Int, ByteString))
(Vector (Int, ByteString))
forall s a. (s -> a) -> Getter s a
to ((Int -> ByteString -> (Int, ByteString))
-> Vector ByteString -> Vector (Int, ByteString)
forall a b. (Int -> a -> b) -> Vector a -> Vector b
Vec.imap (,)))
DappInfo
dapp.sources.lines))
Int
1
drawSolidityPane :: UiVmState -> UiWidget
drawSolidityPane :: UiVmState -> Widget Name
drawSolidityPane UiVmState
ui =
let dapp :: DappInfo
dapp = UiVmState
ui.testOpts.dapp
dappSrcs :: SourceCache
dappSrcs = DappInfo
dapp.sources
vm :: VM
vm = UiVmState
ui.vm
in case DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp VM
vm of
Maybe SrcMap
Nothing -> Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max (Widget Name -> Widget Name
forall n. Widget n -> Widget n
hBorderWithLabel (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"<no source map>"))
Just SrcMap
sm ->
let
rows :: Maybe (Vector ByteString)
rows = SourceCache
dappSrcs.lines Map Int (Vector ByteString) -> Int -> Maybe (Vector ByteString)
forall k a. Ord k => Map k a -> k -> Maybe a
!? SrcMap
sm.file
subrange :: Int -> Maybe (Int, Int)
subrange :: Int -> Maybe (Int, Int)
subrange Int
i = do
Vector ByteString
rs <- Maybe (Vector ByteString)
rows
Vector ByteString -> (Int, Int) -> Int -> Maybe (Int, Int)
lineSubrange Vector ByteString
rs (SrcMap
sm.offset, SrcMap
sm.length) Int
i
fileName :: Maybe Text
fileName :: Maybe Text
fileName = String -> Text
T.pack (String -> Text)
-> ((String, ByteString) -> String) -> (String, ByteString) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, ByteString) -> String
forall a b. (a, b) -> a
fst ((String, ByteString) -> Text)
-> Maybe (String, ByteString) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DappInfo
dapp.sources.files Map Int (String, ByteString) -> Int -> Maybe (String, ByteString)
forall k a. Ord k => Map k a -> k -> Maybe a
!? SrcMap
sm.file)
lineNo :: Maybe Int
lineNo :: Maybe Int
lineNo = ((\Int
a -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Int -> Maybe Int)
-> ((String, Int) -> Int) -> (String, Int) -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Int) -> Int
forall a b. (a, b) -> b
snd) ((String, Int) -> Maybe Int) -> Maybe (String, Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SourceCache -> SrcMap -> Maybe (String, Int)
srcMapCodePos DappInfo
dapp.sources SrcMap
sm
in [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox
[ Widget Name -> Widget Name
forall n. Widget n -> Widget n
hBorderWithLabel (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"<unknown>" Maybe Text
fileName)
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget Name
forall n. String -> Widget n
str (String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"?" Int -> String
forall a. Show a => a -> String
show Maybe Int
lineNo))
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget Name
forall n. Text -> Widget n
txt (Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"?"
(DappInfo
dapp.astSrcMap SrcMap
sm
Maybe Value -> (Value -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Optic' An_AffineTraversal NoIx Value Text -> Value -> Maybe Text
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Key -> AffineTraversal' Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"name" AffineTraversal' Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
, (Bool -> (Int, ByteString) -> Widget Name)
-> Bool -> List Name (Int, ByteString) -> Widget Name
forall n e.
(Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> List n e -> Widget n
Centered.renderList
(\Bool
_ (Int
i, ByteString
line) ->
let s :: Text
s = case ByteString -> Text
decodeUtf8 ByteString
line of Text
"" -> Text
" "; Text
y -> Text
y
in case Int -> Maybe (Int, Int)
subrange Int
i of
Maybe (Int, Int)
Nothing -> Bool -> Widget Name -> Widget Name
forall n. Bool -> Widget n -> Widget n
withHighlight Bool
False (Text -> Widget Name
forall n. Text -> Widget n
txt Text
s)
Just (Int
a, Int
b) ->
let (Text
x, Text
y, Text
z) = ( Int -> Text -> Text
Text.take Int
a Text
s
, Int -> Text -> Text
Text.take Int
b (Int -> Text -> Text
Text.drop Int
a Text
s)
, Int -> Text -> Text
Text.drop (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b) Text
s
)
in [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ Bool -> Widget Name -> Widget Name
forall n. Bool -> Widget n -> Widget n
withHighlight Bool
False (Text -> Widget Name
forall n. Text -> Widget n
txt Text
x)
, Bool -> Widget Name -> Widget Name
forall n. Bool -> Widget n -> Widget n
withHighlight Bool
True (Text -> Widget Name
forall n. Text -> Widget n
txt Text
y)
, Bool -> Widget Name -> Widget Name
forall n. Bool -> Widget n -> Widget n
withHighlight Bool
False (Text -> Widget Name
forall n. Text -> Widget n
txt Text
z)
])
Bool
False
(((List Name (Int, ByteString) -> List Name (Int, ByteString))
-> (Int
-> List Name (Int, ByteString) -> List Name (Int, ByteString))
-> Maybe Int
-> List Name (Int, ByteString)
-> List Name (Int, ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe List Name (Int, ByteString) -> List Name (Int, ByteString)
forall a. a -> a
id Int -> List Name (Int, ByteString) -> List Name (Int, ByteString)
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Maybe Int
lineNo)
(VM -> DappInfo -> List Name (Int, ByteString)
solidityList VM
vm DappInfo
dapp))
]
ifTallEnough :: Int -> Widget n -> Widget n -> Widget n
ifTallEnough :: forall n. Int -> Widget n -> Widget n -> Widget n
ifTallEnough Int
need Widget n
w1 Widget n
w2 =
Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
Context n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
if Optic' A_Lens NoIx (Context n) Int -> Context n -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (LensVL (Context n) (Context n) Int Int
-> Optic' A_Lens NoIx (Context n) Int
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (Int -> f Int) -> Context n -> f (Context n)
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
LensVL (Context n) (Context n) Int Int
availHeightL) Context n
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
need
then Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
w1
else Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
w2
opWidget :: (Integral a, Show a) => (a, Op) -> Widget n
opWidget :: forall a n. (Integral a, Show a) => (a, Op) -> Widget n
opWidget = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> ((a, Op) -> Text) -> (a, Op) -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> ((a, Op) -> String) -> (a, Op) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Op) -> String
forall a. (Integral a, Show a) => (a, Op) -> String
opString
selectedAttr :: AttrName; selectedAttr :: AttrName
selectedAttr = String -> AttrName
attrName String
"selected"
dimAttr :: AttrName; dimAttr :: AttrName
dimAttr = String -> AttrName
attrName String
"dim"
wordAttr :: AttrName; wordAttr :: AttrName
wordAttr = String -> AttrName
attrName String
"word"
boldAttr :: AttrName; boldAttr :: AttrName
boldAttr = String -> AttrName
attrName String
"bold"
activeAttr :: AttrName; activeAttr :: AttrName
activeAttr = String -> AttrName
attrName String
"active"