{-# Language TemplateHaskell #-}
{-# Language ImplicitParams #-}
{-# Language DataKinds #-}
module EVM.TTY where

import Prelude hiding (lookup, Word)

import Brick
import Brick.Widgets.Border
import Brick.Widgets.Center
import Brick.Widgets.List

import EVM
import EVM.ABI (abiTypeSolidity, decodeAbiValue, AbiType(..), emptyAbi)
import EVM.SymExec (maxIterationsReached, symCalldata)
import EVM.Dapp (DappInfo, dappInfo, Test, extractSig, Test(..), srcMap)
import EVM.Dapp (dappUnitTests, unitTestMethods, dappSolcByName, dappSolcByHash, dappSources)
import EVM.Dapp (dappAstSrcMap)
import EVM.Debug
import EVM.Format (showWordExact, showWordExplanation)
import EVM.Format (contractNamePart, contractPathPart, showTraceTree)
import EVM.Hexdump (prettyHex)
import EVM.Op
import EVM.Solidity hiding (storageLayout)
import EVM.Types hiding (padRight)
import EVM.UnitTest
import EVM.RLP (RLP(..))
import EVM.StorageLayout

import EVM.Stepper (Stepper)
import qualified EVM.Stepper as Stepper
import qualified Control.Monad.Operational as Operational

import EVM.Fetch (Fetcher)

import Control.Lens hiding (List)
import Control.Monad.Trans.Reader
import Control.Monad.State.Strict hiding (state)

import Data.Aeson.Lens
import Data.ByteString (ByteString)
import Data.Maybe (isJust, fromJust, fromMaybe)
import Data.Map (Map, insert, lookupLT, singleton, filter)
import Data.Text (Text, pack)
import Data.Text.Encoding (decodeUtf8)
import Data.List (sort, find)
import Data.Version (showVersion)
import Data.SBV hiding (solver)

import qualified Data.SBV.Internals as SBV
import qualified Data.ByteString as BS
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Vector as Vec
import qualified Data.Vector.Storable as SVec
import qualified Graphics.Vty as V
import qualified System.Console.Haskeline as Readline

import qualified EVM.TTYCenteredList as Centered

import qualified Paths_hevm as Paths

data Name
  = AbiPane
  | StackPane
  | BytecodePane
  | TracePane
  | SolidityPane
  | TestPickerPane
  | BrowserPane
  | Pager
  deriving (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: 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
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> 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
min :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$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
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
$cp1Ord :: Eq Name
Ord)

type UiWidget = Widget Name

data UiVmState = UiVmState
  { UiVmState -> VM
_uiVm           :: VM
  , UiVmState -> Int
_uiStep         :: Int
  , UiVmState -> Map Int (VM, Stepper ())
_uiSnapshots    :: Map Int (VM, Stepper ())
  , UiVmState -> Stepper ()
_uiStepper      :: Stepper ()
  , UiVmState -> Bool
_uiShowMemory   :: Bool
  , UiVmState -> UnitTestOptions
_uiTestOpts     :: UnitTestOptions
  }

data UiTestPickerState = UiTestPickerState
  { UiTestPickerState -> List Name (Text, Text)
_testPickerList :: List Name (Text, Text)
  , UiTestPickerState -> DappInfo
_testPickerDapp :: DappInfo
  , UiTestPickerState -> UnitTestOptions
_testOpts       :: UnitTestOptions
  }

data UiBrowserState = UiBrowserState
  { UiBrowserState -> List Name (Addr, Contract)
_browserContractList :: List Name (Addr, Contract)
  , UiBrowserState -> UiVmState
_browserVm :: UiVmState
  }

data UiState
  = ViewVm UiVmState
  | ViewContracts UiBrowserState
  | ViewPicker UiTestPickerState
  | ViewHelp UiVmState

makeLenses ''UiVmState
makeLenses ''UiTestPickerState
makeLenses ''UiBrowserState
makePrisms ''UiState

-- caching VM states lets us backstep efficiently
snapshotInterval :: Int
snapshotInterval :: Int
snapshotInterval = Int
50

type Pred a = a -> Bool

data StepMode
  = Step !Int                  -- ^ Run a specific number of steps
  | StepUntil (Pred VM)        -- ^ Finish when a VM predicate holds

-- | Each step command in the terminal should finish immediately
-- with one of these outcomes.
data Continuation a
     = Stopped a              -- ^ Program finished
     | Continue (Stepper a)   -- ^ Took one step; more steps to go


-- | This turns a @Stepper@ into a state action usable
-- from within the TTY loop, yielding a @StepOutcome@ depending on the @StepMode@.
interpret
  :: (?fetcher :: Fetcher
  ,   ?maxIter :: Maybe Integer)
  => StepMode
  -> Stepper a
  -> StateT UiVmState IO (Continuation a)
interpret :: StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode =

  -- Like the similar interpreters in @EVM.UnitTest@ and @EVM.VMTest@,
  -- this one is implemented as an "operational monad interpreter".

  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 :: ProgramView Action a -> StateT UiVmState IO (Continuation a)
eval (Operational.Return a
x) =
      Continuation a -> StateT UiVmState IO (Continuation 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
          -- Have we reached the final result of this action?
          Getting (Maybe VMResult) UiVmState (Maybe VMResult)
-> StateT UiVmState IO (Maybe VMResult)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((VM -> Const (Maybe VMResult) VM)
-> UiVmState -> Const (Maybe VMResult) UiVmState
Lens' UiVmState VM
uiVm ((VM -> Const (Maybe VMResult) VM)
 -> UiVmState -> Const (Maybe VMResult) UiVmState)
-> ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
    -> VM -> Const (Maybe VMResult) VM)
-> Getting (Maybe VMResult) UiVmState (Maybe VMResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result) StateT UiVmState IO (Maybe VMResult)
-> (Maybe VMResult -> StateT UiVmState IO (Continuation a))
-> StateT UiVmState IO (Continuation a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just VMResult
_ -> do
              -- Yes, proceed with the next action.
              VM
vm <- Getting VM UiVmState VM -> StateT UiVmState IO VM
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting VM UiVmState VM
Lens' UiVmState VM
uiVm
              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
vm)
            Maybe VMResult
Nothing -> do
              -- No, keep performing the current action
              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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
VM -> ProgramT Action Identity a
k)

        -- Stepper wants to keep executing?
        Action b
Stepper.Exec -> do
          -- Have we reached the final result of this action?
          Getting (Maybe VMResult) UiVmState (Maybe VMResult)
-> StateT UiVmState IO (Maybe VMResult)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((VM -> Const (Maybe VMResult) VM)
-> UiVmState -> Const (Maybe VMResult) UiVmState
Lens' UiVmState VM
uiVm ((VM -> Const (Maybe VMResult) VM)
 -> UiVmState -> Const (Maybe VMResult) UiVmState)
-> ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
    -> VM -> Const (Maybe VMResult) VM)
-> Getting (Maybe VMResult) UiVmState (Maybe VMResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result) StateT UiVmState IO (Maybe VMResult)
-> (Maybe VMResult -> StateT UiVmState IO (Continuation a))
-> StateT UiVmState IO (Continuation a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just VMResult
r ->
              -- Yes, proceed with the next action.
              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
VMResult
r)
            Maybe VMResult
Nothing -> do
              -- No, keep performing the current action
              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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
VMResult -> ProgramT Action Identity a
k)

        -- Stepper is waiting for user input from a query
        Stepper.Ask (PleaseChoosePath Whiff
_ Bool -> EVM ()
cont) -> do
          -- ensure we aren't stepping past max iterations
          VM
vm <- Getting VM UiVmState VM -> StateT UiVmState IO VM
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting VM UiVmState VM
Lens' UiVmState VM
uiVm
          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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
() -> ProgramT Action Identity a
k)

        -- Stepper wants to make a query and wait for the results?
        Stepper.Wait Query
q -> do
          do EVM b
m <- IO (EVM b) -> StateT UiVmState IO (EVM b)
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
k)

        -- Stepper wants to make a query and wait for the results?
        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 (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (StateT VM IO) b) UiVmState VM
Lens' UiVmState VM
uiVm ((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 (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 wants to modify the VM.
        Stepper.EVM EVM b
m -> do
          VM
vm <- Getting VM UiVmState VM -> StateT UiVmState IO VM
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting VM UiVmState VM
Lens' UiVmState VM
uiVm
          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
          ASetter UiVmState UiVmState VM VM -> VM -> StateT UiVmState IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter UiVmState UiVmState VM VM
Lens' UiVmState VM
uiVm 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 (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 :: StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
keepExecuting StepMode
mode Stepper a
restart = case StepMode
mode of
  Step Int
0 -> do
    -- We come here when we've continued while stepping,
    -- either from a query or from a return;
    -- we should pause here and wait for the user.
    Continuation a -> StateT UiVmState IO (Continuation 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
    -- Run one instruction and recurse
    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 <- Getting VM UiVmState VM -> StateT UiVmState IO VM
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting VM UiVmState VM
Lens' UiVmState VM
uiVm
    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
        -- Run one instruction and recurse
        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 (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 (Getting
  [(Text, [(Test, [AbiType])])]
  DappInfo
  [(Text, [(Test, [AbiType])])]
-> DappInfo -> [(Text, [(Test, [AbiType])])]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  [(Text, [(Test, [AbiType])])]
  DappInfo
  [(Text, [(Test, [AbiType])])]
Lens' DappInfo [(Text, [(Test, [AbiType])])]
dappUnitTests DappInfo
dapp))

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 (m :: * -> *) a. Monad m => a -> m a
return Vty
vty

runFromVM :: Maybe Integer -> DappInfo -> (Query -> IO (EVM ())) -> VM -> IO VM
runFromVM :: Maybe Integer -> DappInfo -> Fetcher -> VM -> IO VM
runFromVM Maybe Integer
maxIter' DappInfo
dappinfo Fetcher
oracle' VM
vm = do

  let
    opts :: UnitTestOptions
opts = UnitTestOptions :: Fetcher
-> Maybe Int
-> Maybe Integer
-> Maybe Int
-> Maybe Integer
-> Maybe State
-> Maybe Text
-> Text
-> Int
-> Maybe (Text, ByteString)
-> (VM -> VM)
-> DappInfo
-> TestVMParams
-> Bool
-> UnitTestOptions
UnitTestOptions
      { oracle :: Fetcher
oracle            = Fetcher
oracle'
      , verbose :: Maybe Int
verbose           = Maybe Int
forall a. Maybe a
Nothing
      , maxIter :: Maybe Integer
maxIter           = Maybe Integer
maxIter'
      , smtTimeout :: Maybe Integer
smtTimeout        = Maybe Integer
forall a. Maybe a
Nothing
      , smtState :: Maybe State
smtState          = Maybe State
forall a. Maybe a
Nothing
      , solver :: Maybe Text
solver            = Maybe Text
forall a. Maybe a
Nothing
      , maxDepth :: Maybe Int
maxDepth          = Maybe Int
forall a. Maybe a
Nothing
      , match :: Text
match             = Text
""
      , fuzzRuns :: Int
fuzzRuns          = Int
1
      , replay :: Maybe (Text, ByteString)
replay            = String -> Maybe (Text, ByteString)
forall a. HasCallStack => String -> a
error String
"irrelevant"
      , vmModifier :: VM -> VM
vmModifier        = VM -> VM
forall a. a -> a
id
      , testParams :: TestVMParams
testParams        = String -> TestVMParams
forall a. HasCallStack => String -> a
error String
"irrelevant"
      , dapp :: DappInfo
dapp              = DappInfo
dappinfo
      , allowFFI :: Bool
allowFFI          = Bool
False
      }
    ui0 :: UiVmState
ui0 = VM -> UnitTestOptions -> Stepper () -> UiVmState
initUiVmState VM
vm UnitTestOptions
opts (ProgramT Action Identity (Either Error Buffer) -> Stepper ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ProgramT Action Identity (Either Error Buffer)
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 (m :: * -> *) a. Monad m => a -> m a
return (Getting VM UiVmState VM -> UiVmState -> VM
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting VM UiVmState VM
Lens' UiVmState VM
uiVm UiVmState
ui)
    UiState
_ -> String -> IO VM
forall a. HasCallStack => String -> a
error String
"internal error: customMain returned prematurely"


initUiVmState :: VM -> UnitTestOptions -> Stepper () -> UiVmState
initUiVmState :: VM -> UnitTestOptions -> Stepper () -> UiVmState
initUiVmState VM
vm0 UnitTestOptions
opts Stepper ()
script =
  UiVmState :: VM
-> Int
-> Map Int (VM, Stepper ())
-> Stepper ()
-> Bool
-> UnitTestOptions
-> UiVmState
UiVmState
    { _uiVm :: VM
_uiVm           = VM
vm0
    , _uiStepper :: Stepper ()
_uiStepper      = Stepper ()
script
    , _uiStep :: Int
_uiStep         = Int
0
    , _uiSnapshots :: Map Int (VM, Stepper ())
_uiSnapshots    = Int -> (VM, Stepper ()) -> Map Int (VM, Stepper ())
forall k a. k -> a -> Map k a
singleton Int
0 (VM
vm0, Stepper ()
script)
    , _uiShowMemory :: Bool
_uiShowMemory   = Bool
False
    , _uiTestOpts :: UnitTestOptions
_uiTestOpts     = UnitTestOptions
opts
    }


-- filters out fuzztests, unless they have
-- explicitly been given an argument by `replay`
debuggableTests :: UnitTestOptions -> (Text, [(Test, [AbiType])]) -> [(Text, Text)]
debuggableTests :: UnitTestOptions -> (Text, [(Test, [AbiType])]) -> [(Text, Text)]
debuggableTests UnitTestOptions{Bool
Int
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Fetcher
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Fetcher
allowFFI :: UnitTestOptions -> Bool
dapp :: UnitTestOptions -> DappInfo
testParams :: UnitTestOptions -> TestVMParams
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
maxDepth :: UnitTestOptions -> Maybe Int
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Fetcher
..} (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 -> FilePath -> IO ()
main :: UnitTestOptions -> String -> String -> IO ()
main UnitTestOptions
opts String
root String
jsonFilePath =
  String -> IO (Maybe (Map Text SolcContract, SourceCache))
readSolc String
jsonFilePath IO (Maybe (Map Text SolcContract, SourceCache))
-> (Maybe (Map Text SolcContract, SourceCache) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    \case
      Maybe (Map Text SolcContract, SourceCache)
Nothing ->
        String -> IO ()
forall a. HasCallStack => String -> a
error String
"Failed to read Solidity JSON"
      Just (Map Text SolcContract
contractMap, SourceCache
sourceCache) -> do
        let
          dapp :: DappInfo
dapp = String -> Map Text SolcContract -> SourceCache -> DappInfo
dappInfo String
root Map Text SolcContract
contractMap SourceCache
sourceCache
          ui :: UiState
ui = UiTestPickerState -> UiState
ViewPicker (UiTestPickerState -> UiState) -> UiTestPickerState -> UiState
forall a b. (a -> b) -> a -> b
$ UiTestPickerState :: List Name (Text, Text)
-> DappInfo -> UnitTestOptions -> UiTestPickerState
UiTestPickerState
            { _testPickerList :: List Name (Text, Text)
_testPickerList =
                Name -> Vector (Text, Text) -> Int -> List Name (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)
                    (Getting
  [(Text, [(Test, [AbiType])])]
  DappInfo
  [(Text, [(Test, [AbiType])])]
-> DappInfo -> [(Text, [(Test, [AbiType])])]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  [(Text, [(Test, [AbiType])])]
  DappInfo
  [(Text, [(Test, [AbiType])])]
Lens' DappInfo [(Text, [(Test, [AbiType])])]
dappUnitTests DappInfo
dapp)))
                  Int
1
            , _testPickerDapp :: DappInfo
_testPickerDapp = DappInfo
dapp
            , _testOpts :: UnitTestOptions
_testOpts = 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 (m :: * -> *) a. Monad m => a -> m a
return ()

takeStep
  :: (?fetcher :: Fetcher
     ,?maxIter :: Maybe Integer)
  => UiVmState
  -> StepMode
  -> EventM n (Next UiState)
takeStep :: UiVmState -> StepMode -> EventM n (Next UiState)
takeStep UiVmState
ui StepMode
mode =
  IO (Continuation (), UiVmState)
-> EventM n (Continuation (), UiVmState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Continuation (), UiVmState)
nxt EventM n (Continuation (), UiVmState)
-> ((Continuation (), UiVmState) -> EventM n (Next UiState))
-> EventM n (Next UiState)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (Stopped (), UiVmState
ui') ->
      UiState -> EventM n (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiVmState -> UiState
ViewVm UiVmState
ui')
    (Continue Stepper ()
steps, UiVmState
ui') -> do
      UiState -> EventM n (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiVmState -> UiState
ViewVm (UiVmState
ui' UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
Lens' UiVmState (Stepper ())
uiStepper 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 (Getting (Stepper ()) UiVmState (Stepper ())
-> UiVmState -> Stepper ()
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Stepper ()) UiVmState (Stepper ())
Lens' UiVmState (Stepper ())
uiStepper UiVmState
ui)
    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) -> UiVmState -> EventM n (Next UiState)
backstepUntil :: (UiVmState -> Pred VM) -> UiVmState -> EventM n (Next UiState)
backstepUntil UiVmState -> Pred VM
p UiVmState
s =
  case Getting Int UiVmState Int -> UiVmState -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int UiVmState Int
Lens' UiVmState Int
uiStep UiVmState
s of
    Int
0 -> UiState -> EventM n (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiVmState -> UiState
ViewVm UiVmState
s)
    Int
n -> do
      UiVmState
s1 <- UiVmState -> EventM n UiVmState
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> EventM n UiVmState
backstep UiVmState
s
      let
        -- find a previous vm that satisfies the predicate
        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) (Getting
  (Map Int (VM, Stepper ())) UiVmState (Map Int (VM, Stepper ()))
-> UiVmState -> Map Int (VM, Stepper ())
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Int (VM, Stepper ())) UiVmState (Map Int (VM, Stepper ()))
Lens' UiVmState (Map Int (VM, Stepper ()))
uiSnapshots UiVmState
s1)
      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
        -- If no such vm exists, go to the beginning
        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) (Getting
  (Map Int (VM, Stepper ())) UiVmState (Map Int (VM, Stepper ()))
-> UiVmState -> Map Int (VM, Stepper ())
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Int (VM, Stepper ())) UiVmState (Map Int (VM, Stepper ()))
Lens' UiVmState (Map Int (VM, Stepper ()))
uiSnapshots UiVmState
s)
            s2 :: UiVmState
s2 = UiVmState
s1
              UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState VM VM -> VM -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState VM VM
Lens' UiVmState VM
uiVm VM
vm'
              UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState Cache Cache
-> Cache -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set (ASetter UiVmState UiVmState VM VM
Lens' UiVmState VM
uiVm ASetter UiVmState UiVmState VM VM
-> ((Cache -> Identity Cache) -> VM -> Identity VM)
-> ASetter UiVmState UiVmState Cache Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cache -> Identity Cache) -> VM -> Identity VM
Lens' VM Cache
cache) (Getting Cache UiVmState Cache -> UiVmState -> Cache
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((VM -> Const Cache VM) -> UiVmState -> Const Cache UiVmState
Lens' UiVmState VM
uiVm ((VM -> Const Cache VM) -> UiVmState -> Const Cache UiVmState)
-> ((Cache -> Const Cache Cache) -> VM -> Const Cache VM)
-> Getting Cache UiVmState Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cache -> Const Cache Cache) -> VM -> Const Cache VM
Lens' VM Cache
cache) UiVmState
s1)
              UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState Int Int
-> Int -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState Int Int
Lens' UiVmState Int
uiStep Int
step'
              UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
Lens' UiVmState (Stepper ())
uiStepper Stepper ()
stepper'
          in UiVmState -> StepMode -> EventM n (Next UiState)
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n (Next UiState)
takeStep UiVmState
s2 (Int -> StepMode
Step Int
0)
        -- step until the predicate doesn't hold
        Just (Int
step', (VM
vm', Stepper ()
stepper')) ->
          let
            s2 :: UiVmState
s2 = UiVmState
s1
              UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState VM VM -> VM -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState VM VM
Lens' UiVmState VM
uiVm VM
vm'
              UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState Cache Cache
-> Cache -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set (ASetter UiVmState UiVmState VM VM
Lens' UiVmState VM
uiVm ASetter UiVmState UiVmState VM VM
-> ((Cache -> Identity Cache) -> VM -> Identity VM)
-> ASetter UiVmState UiVmState Cache Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cache -> Identity Cache) -> VM -> Identity VM
Lens' VM Cache
cache) (Getting Cache UiVmState Cache -> UiVmState -> Cache
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((VM -> Const Cache VM) -> UiVmState -> Const Cache UiVmState
Lens' UiVmState VM
uiVm ((VM -> Const Cache VM) -> UiVmState -> Const Cache UiVmState)
-> ((Cache -> Const Cache Cache) -> VM -> Const Cache VM)
-> Getting Cache UiVmState Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cache -> Const Cache Cache) -> VM -> Const Cache VM
Lens' VM Cache
cache) UiVmState
s1)
              UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState Int Int
-> Int -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState Int Int
Lens' UiVmState Int
uiStep Int
step'
              UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
Lens' UiVmState (Stepper ())
uiStepper Stepper ()
stepper'
          in UiVmState -> StepMode -> EventM n (Next UiState)
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n (Next 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))

backstep
  :: (?fetcher :: Fetcher
     ,?maxIter :: Maybe Integer)
  => UiVmState -> EventM n UiVmState
backstep :: UiVmState -> EventM n UiVmState
backstep UiVmState
s = case Getting Int UiVmState Int -> UiVmState -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int UiVmState Int
Lens' UiVmState Int
uiStep UiVmState
s of
  -- We're already at the first step; ignore command.
  Int
0 -> UiVmState -> EventM n UiVmState
forall (m :: * -> *) a. Monad m => a -> m a
return UiVmState
s
  -- To step backwards, we revert to the previous snapshot
  -- and execute n - 1 `mod` snapshotInterval steps from there.

  -- We keep the current cache so we don't have to redo
  -- any blocking queries, and also the memory view.
  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 (Getting
  (Map Int (VM, Stepper ())) UiVmState (Map Int (VM, Stepper ()))
-> UiVmState -> Map Int (VM, Stepper ())
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Int (VM, Stepper ())) UiVmState (Map Int (VM, Stepper ()))
Lens' UiVmState (Map Int (VM, Stepper ()))
uiSnapshots UiVmState
s)
      s1 :: UiVmState
s1 = UiVmState
s
        UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState VM VM -> VM -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState VM VM
Lens' UiVmState VM
uiVm VM
vm
        UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState Cache Cache
-> Cache -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set (ASetter UiVmState UiVmState VM VM
Lens' UiVmState VM
uiVm ASetter UiVmState UiVmState VM VM
-> ((Cache -> Identity Cache) -> VM -> Identity VM)
-> ASetter UiVmState UiVmState Cache Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cache -> Identity Cache) -> VM -> Identity VM
Lens' VM Cache
cache) (Getting Cache UiVmState Cache -> UiVmState -> Cache
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((VM -> Const Cache VM) -> UiVmState -> Const Cache UiVmState
Lens' UiVmState VM
uiVm ((VM -> Const Cache VM) -> UiVmState -> Const Cache UiVmState)
-> ((Cache -> Const Cache Cache) -> VM -> Const Cache VM)
-> Getting Cache UiVmState Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cache -> Const Cache Cache) -> VM -> Const Cache VM
Lens' VM Cache
cache) UiVmState
s)
        UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState Int Int
-> Int -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState Int Int
Lens' UiVmState Int
uiStep Int
step
        UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
Lens' UiVmState (Stepper ())
uiStepper 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
      IO UiVmState -> EventM n UiVmState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UiVmState -> EventM n UiVmState)
-> IO UiVmState -> EventM n UiVmState
forall a b. (a -> b) -> a -> b
$ 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        (Continue Stepper ()
steps, UiVmState
ui') -> UiVmState -> IO UiVmState
forall (m :: * -> *) a. Monad m => a -> m a
return (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
& ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
Lens' UiVmState (Stepper ())
uiStepper Stepper ()
steps
        (Continuation (), UiVmState)
_ -> String -> IO UiVmState
forall a. HasCallStack => String -> a
error String
"unexpected end"

appEvent
  :: (?fetcher::Fetcher, ?maxIter :: Maybe Integer) =>
  UiState ->
  BrickEvent Name e ->
  EventM Name (Next UiState)

-- Contracts: Down - list down
appEvent :: UiState -> BrickEvent Name e -> EventM Name (Next UiState)
appEvent (ViewContracts UiBrowserState
s) (VtyEvent e :: Event
e@(V.EvKey Key
V.KDown [])) = do
  UiBrowserState
s' <- UiBrowserState
-> Lens' UiBrowserState (List Name (Addr, Contract))
-> (Event
    -> List Name (Addr, Contract)
    -> EventM Name (List Name (Addr, Contract)))
-> Event
-> EventM Name UiBrowserState
forall a b e n.
a -> Lens' a b -> (e -> b -> EventM n b) -> e -> EventM n a
handleEventLensed UiBrowserState
s
    Lens' UiBrowserState (List Name (Addr, Contract))
browserContractList
    Event
-> List Name (Addr, Contract)
-> EventM Name (List Name (Addr, Contract))
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> GenericList n t e -> EventM n (GenericList n t e)
handleListEvent
    Event
e
  UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiBrowserState -> UiState
ViewContracts UiBrowserState
s')

-- Contracts: Up - list up
appEvent (ViewContracts UiBrowserState
s) (VtyEvent e :: Event
e@(V.EvKey Key
V.KUp [])) = do
  UiBrowserState
s' <- UiBrowserState
-> Lens' UiBrowserState (List Name (Addr, Contract))
-> (Event
    -> List Name (Addr, Contract)
    -> EventM Name (List Name (Addr, Contract)))
-> Event
-> EventM Name UiBrowserState
forall a b e n.
a -> Lens' a b -> (e -> b -> EventM n b) -> e -> EventM n a
handleEventLensed UiBrowserState
s
    Lens' UiBrowserState (List Name (Addr, Contract))
browserContractList
    Event
-> List Name (Addr, Contract)
-> EventM Name (List Name (Addr, Contract))
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> GenericList n t e -> EventM n (GenericList n t e)
handleListEvent
    Event
e
  UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiBrowserState -> UiState
ViewContracts UiBrowserState
s')

-- Vm Overview: Esc - return to test picker or exit
appEvent st :: UiState
st@(ViewVm UiVmState
s) (VtyEvent (V.EvKey Key
V.KEsc [])) =
  let opts :: UnitTestOptions
opts = Getting UnitTestOptions UiVmState UnitTestOptions
-> UiVmState -> UnitTestOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UnitTestOptions UiVmState UnitTestOptions
Lens' UiVmState UnitTestOptions
uiTestOpts UiVmState
s
      dapp' :: DappInfo
dapp' = UnitTestOptions -> DappInfo
dapp (Getting UnitTestOptions UiVmState UnitTestOptions
-> UiVmState -> UnitTestOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UnitTestOptions UiVmState UnitTestOptions
Lens' UiVmState UnitTestOptions
uiTestOpts UiVmState
s)
      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)
                (Getting
  [(Text, [(Test, [AbiType])])]
  DappInfo
  [(Text, [(Test, [AbiType])])]
-> DappInfo -> [(Text, [(Test, [AbiType])])]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  [(Text, [(Test, [AbiType])])]
  DappInfo
  [(Text, [(Test, [AbiType])])]
Lens' DappInfo [(Text, [(Test, [AbiType])])]
dappUnitTests DappInfo
dapp')
  in case [(Text, Text)]
tests of
    [] -> UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
halt UiState
st
    [(Text, Text)]
ts ->
      UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiState -> EventM Name (Next UiState))
-> (UiTestPickerState -> UiState)
-> UiTestPickerState
-> EventM Name (Next UiState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UiTestPickerState -> UiState
ViewPicker (UiTestPickerState -> EventM Name (Next UiState))
-> UiTestPickerState -> EventM Name (Next UiState)
forall a b. (a -> b) -> a -> b
$
      UiTestPickerState :: List Name (Text, Text)
-> DappInfo -> UnitTestOptions -> UiTestPickerState
UiTestPickerState
        { _testPickerList :: List Name (Text, Text)
_testPickerList =
            Name -> Vector (Text, Text) -> Int -> List Name (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
        , _testPickerDapp :: DappInfo
_testPickerDapp = DappInfo
dapp'
        , _testOpts :: UnitTestOptions
_testOpts = UnitTestOptions
opts
        }

-- Vm Overview: Enter - open contracts view
appEvent (ViewVm UiVmState
s) (VtyEvent (V.EvKey Key
V.KEnter [])) =
  UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiState -> EventM Name (Next UiState))
-> (UiBrowserState -> UiState)
-> UiBrowserState
-> EventM Name (Next UiState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UiBrowserState -> UiState
ViewContracts (UiBrowserState -> EventM Name (Next UiState))
-> UiBrowserState -> EventM Name (Next UiState)
forall a b. (a -> b) -> a -> b
$ UiBrowserState :: List Name (Addr, Contract) -> UiVmState -> UiBrowserState
UiBrowserState
    { _browserContractList :: List Name (Addr, Contract)
_browserContractList =
        Name
-> Vector (Addr, Contract) -> Int -> List Name (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 (Getting (Map Addr Contract) UiVmState (Map Addr Contract)
-> UiVmState -> Map Addr Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((VM -> Const (Map Addr Contract) VM)
-> UiVmState -> Const (Map Addr Contract) UiVmState
Lens' UiVmState VM
uiVm ((VM -> Const (Map Addr Contract) VM)
 -> UiVmState -> Const (Map Addr Contract) UiVmState)
-> ((Map Addr Contract
     -> Const (Map Addr Contract) (Map Addr Contract))
    -> VM -> Const (Map Addr Contract) VM)
-> Getting (Map Addr Contract) UiVmState (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Env -> Const (Map Addr Contract) Env)
-> VM -> Const (Map Addr Contract) VM
Lens' VM Env
env ((Env -> Const (Map Addr Contract) Env)
 -> VM -> Const (Map Addr Contract) VM)
-> ((Map Addr Contract
     -> Const (Map Addr Contract) (Map Addr Contract))
    -> Env -> Const (Map Addr Contract) Env)
-> (Map Addr Contract
    -> Const (Map Addr Contract) (Map Addr Contract))
-> VM
-> Const (Map Addr Contract) VM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract
 -> Const (Map Addr Contract) (Map Addr Contract))
-> Env -> Const (Map Addr Contract) Env
Lens' Env (Map Addr Contract)
contracts) UiVmState
s)))
          Int
2
    , _browserVm :: UiVmState
_browserVm = UiVmState
s
    }

-- Vm Overview: m - toggle memory pane
appEvent (ViewVm UiVmState
s) (VtyEvent (V.EvKey (V.KChar Char
'm') [])) =
  UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiVmState -> UiState
ViewVm (ASetter UiVmState UiVmState Bool Bool
-> (Bool -> Bool) -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter UiVmState UiVmState Bool Bool
Lens' UiVmState Bool
uiShowMemory Bool -> Bool
not UiVmState
s))

-- Vm Overview: h - open help view
appEvent (ViewVm UiVmState
s) (VtyEvent (V.EvKey (V.KChar Char
'h') []))
  = UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiState -> EventM Name (Next UiState))
-> (UiVmState -> UiState)
-> UiVmState
-> EventM Name (Next UiState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UiVmState -> UiState
ViewHelp (UiVmState -> EventM Name (Next UiState))
-> UiVmState -> EventM Name (Next UiState)
forall a b. (a -> b) -> a -> b
$ UiVmState
s

-- Vm Overview: spacebar - read input
appEvent (ViewVm UiVmState
s) (VtyEvent (V.EvKey (V.KChar Char
' ') [])) =
  let
    loop :: InputT IO UiState
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 (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 (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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
      UiState -> InputT IO UiState
forall (m :: * -> *) a. Monad m => a -> m a
return (UiVmState -> UiState
ViewVm UiVmState
s)
  in
    IO UiState -> EventM Name (Next UiState)
forall s n. IO s -> EventM n (Next s)
suspendAndResume (IO UiState -> EventM Name (Next UiState))
-> IO UiState -> EventM Name (Next UiState)
forall a b. (a -> b) -> a -> b
$
      Settings IO -> InputT IO UiState -> IO UiState
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 UiState
loop

-- todo refactor to zipper step forward
-- Vm Overview: n - step
appEvent (ViewVm UiVmState
s) (VtyEvent (V.EvKey (V.KChar Char
'n') [])) =
  if Maybe VMResult -> Bool
forall a. Maybe a -> Bool
isJust (Maybe VMResult -> Bool) -> Maybe VMResult -> Bool
forall a b. (a -> b) -> a -> b
$ Getting (Maybe VMResult) UiVmState (Maybe VMResult)
-> UiVmState -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((VM -> Const (Maybe VMResult) VM)
-> UiVmState -> Const (Maybe VMResult) UiVmState
Lens' UiVmState VM
uiVm ((VM -> Const (Maybe VMResult) VM)
 -> UiVmState -> Const (Maybe VMResult) UiVmState)
-> ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
    -> VM -> Const (Maybe VMResult) VM)
-> Getting (Maybe VMResult) UiVmState (Maybe VMResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result) UiVmState
s
  then UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiVmState -> UiState
ViewVm UiVmState
s)
  else UiVmState -> StepMode -> EventM Name (Next UiState)
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n (Next UiState)
takeStep UiVmState
s (Int -> StepMode
Step Int
1)

-- Vm Overview: N - step
appEvent (ViewVm UiVmState
s) (VtyEvent (V.EvKey (V.KChar Char
'N') [])) =
  if Maybe VMResult -> Bool
forall a. Maybe a -> Bool
isJust (Maybe VMResult -> Bool) -> Maybe VMResult -> Bool
forall a b. (a -> b) -> a -> b
$ Getting (Maybe VMResult) UiVmState (Maybe VMResult)
-> UiVmState -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((VM -> Const (Maybe VMResult) VM)
-> UiVmState -> Const (Maybe VMResult) UiVmState
Lens' UiVmState VM
uiVm ((VM -> Const (Maybe VMResult) VM)
 -> UiVmState -> Const (Maybe VMResult) UiVmState)
-> ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
    -> VM -> Const (Maybe VMResult) VM)
-> Getting (Maybe VMResult) UiVmState (Maybe VMResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result) UiVmState
s
  then UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiVmState -> UiState
ViewVm UiVmState
s)
  else UiVmState -> StepMode -> EventM Name (Next UiState)
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n (Next UiState)
takeStep UiVmState
s
       (Pred VM -> StepMode
StepUntil (UiVmState -> Pred VM
isNextSourcePosition UiVmState
s))

-- Vm Overview: C-n - step
appEvent (ViewVm UiVmState
s) (VtyEvent (V.EvKey (V.KChar Char
'n') [Modifier
V.MCtrl])) =
  if Maybe VMResult -> Bool
forall a. Maybe a -> Bool
isJust (Maybe VMResult -> Bool) -> Maybe VMResult -> Bool
forall a b. (a -> b) -> a -> b
$ Getting (Maybe VMResult) UiVmState (Maybe VMResult)
-> UiVmState -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((VM -> Const (Maybe VMResult) VM)
-> UiVmState -> Const (Maybe VMResult) UiVmState
Lens' UiVmState VM
uiVm ((VM -> Const (Maybe VMResult) VM)
 -> UiVmState -> Const (Maybe VMResult) UiVmState)
-> ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
    -> VM -> Const (Maybe VMResult) VM)
-> Getting (Maybe VMResult) UiVmState (Maybe VMResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result) UiVmState
s
  then UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiVmState -> UiState
ViewVm UiVmState
s)
  else UiVmState -> StepMode -> EventM Name (Next UiState)
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n (Next UiState)
takeStep UiVmState
s
    (Pred VM -> StepMode
StepUntil (UiVmState -> Pred VM
isNextSourcePositionWithoutEntering UiVmState
s))

-- Vm Overview: e - step
appEvent (ViewVm UiVmState
s) (VtyEvent (V.EvKey (V.KChar Char
'e') [])) =
  if Maybe VMResult -> Bool
forall a. Maybe a -> Bool
isJust (Maybe VMResult -> Bool) -> Maybe VMResult -> Bool
forall a b. (a -> b) -> a -> b
$ Getting (Maybe VMResult) UiVmState (Maybe VMResult)
-> UiVmState -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((VM -> Const (Maybe VMResult) VM)
-> UiVmState -> Const (Maybe VMResult) UiVmState
Lens' UiVmState VM
uiVm ((VM -> Const (Maybe VMResult) VM)
 -> UiVmState -> Const (Maybe VMResult) UiVmState)
-> ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
    -> VM -> Const (Maybe VMResult) VM)
-> Getting (Maybe VMResult) UiVmState (Maybe VMResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result) UiVmState
s
  then UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiVmState -> UiState
ViewVm UiVmState
s)
  else UiVmState -> StepMode -> EventM Name (Next UiState)
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n (Next UiState)
takeStep UiVmState
s
    (Pred VM -> StepMode
StepUntil (UiVmState -> Pred VM
isExecutionHalted UiVmState
s))

-- Vm Overview: a - step
appEvent (ViewVm UiVmState
s) (VtyEvent (V.EvKey (V.KChar Char
'a') [])) =
      -- We keep the current cache so we don't have to redo
      -- any blocking queries.
      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 (Getting
  (Map Int (VM, Stepper ())) UiVmState (Map Int (VM, Stepper ()))
-> UiVmState -> Map Int (VM, Stepper ())
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Int (VM, Stepper ())) UiVmState (Map Int (VM, Stepper ()))
Lens' UiVmState (Map Int (VM, Stepper ()))
uiSnapshots UiVmState
s))
        s' :: UiVmState
s' = UiVmState
s
          UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState VM VM -> VM -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState VM VM
Lens' UiVmState VM
uiVm VM
vm
          UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState Cache Cache
-> Cache -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set (ASetter UiVmState UiVmState VM VM
Lens' UiVmState VM
uiVm ASetter UiVmState UiVmState VM VM
-> ((Cache -> Identity Cache) -> VM -> Identity VM)
-> ASetter UiVmState UiVmState Cache Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cache -> Identity Cache) -> VM -> Identity VM
Lens' VM Cache
cache) (Getting Cache UiVmState Cache -> UiVmState -> Cache
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((VM -> Const Cache VM) -> UiVmState -> Const Cache UiVmState
Lens' UiVmState VM
uiVm ((VM -> Const Cache VM) -> UiVmState -> Const Cache UiVmState)
-> ((Cache -> Const Cache Cache) -> VM -> Const Cache VM)
-> Getting Cache UiVmState Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cache -> Const Cache Cache) -> VM -> Const Cache VM
Lens' VM Cache
cache) UiVmState
s)
          UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState Int Int
-> Int -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState Int Int
Lens' UiVmState Int
uiStep Int
0
          UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
Lens' UiVmState (Stepper ())
uiStepper Stepper ()
stepper

      in UiVmState -> StepMode -> EventM Name (Next UiState)
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n (Next UiState)
takeStep UiVmState
s' (Int -> StepMode
Step Int
0)

-- Vm Overview: p - backstep
appEvent st :: UiState
st@(ViewVm UiVmState
s) (VtyEvent (V.EvKey (V.KChar Char
'p') [])) =
  case Getting Int UiVmState Int -> UiVmState -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int UiVmState Int
Lens' UiVmState Int
uiStep UiVmState
s of
    Int
0 ->
      -- We're already at the first step; ignore command.
      UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue UiState
st
    Int
n -> do
      -- To step backwards, we revert to the previous snapshot
      -- and execute n - 1 `mod` snapshotInterval steps from there.

      -- We keep the current cache so we don't have to redo
      -- any blocking queries, and also the memory view.
      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 (Getting
  (Map Int (VM, Stepper ())) UiVmState (Map Int (VM, Stepper ()))
-> UiVmState -> Map Int (VM, Stepper ())
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Int (VM, Stepper ())) UiVmState (Map Int (VM, Stepper ()))
Lens' UiVmState (Map Int (VM, Stepper ()))
uiSnapshots UiVmState
s)
        s1 :: UiVmState
s1 = UiVmState
s
          UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState VM VM -> VM -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState VM VM
Lens' UiVmState VM
uiVm VM
vm -- set the vm to the one from the snapshot
          UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState Cache Cache
-> Cache -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set (ASetter UiVmState UiVmState VM VM
Lens' UiVmState VM
uiVm ASetter UiVmState UiVmState VM VM
-> ((Cache -> Identity Cache) -> VM -> Identity VM)
-> ASetter UiVmState UiVmState Cache Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cache -> Identity Cache) -> VM -> Identity VM
Lens' VM Cache
cache) (Getting Cache UiVmState Cache -> UiVmState -> Cache
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((VM -> Const Cache VM) -> UiVmState -> Const Cache UiVmState
Lens' UiVmState VM
uiVm ((VM -> Const Cache VM) -> UiVmState -> Const Cache UiVmState)
-> ((Cache -> Const Cache Cache) -> VM -> Const Cache VM)
-> Getting Cache UiVmState Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cache -> Const Cache Cache) -> VM -> Const Cache VM
Lens' VM Cache
cache) UiVmState
s) -- persist the cache
          UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState Int Int
-> Int -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState Int Int
Lens' UiVmState Int
uiStep Int
step
          UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
Lens' UiVmState (Stepper ())
uiStepper 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 (Next UiState)
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n (Next UiState)
takeStep UiVmState
s1 (Int -> StepMode
Step Int
stepsToTake)

-- Vm Overview: P - backstep to previous source
appEvent (ViewVm UiVmState
s) (VtyEvent (V.EvKey (V.KChar Char
'P') [])) =
  (UiVmState -> Pred VM) -> UiVmState -> EventM Name (Next UiState)
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
(UiVmState -> Pred VM) -> UiVmState -> EventM n (Next UiState)
backstepUntil UiVmState -> Pred VM
isNextSourcePosition UiVmState
s

-- Vm Overview: c-p - backstep to previous source avoiding CALL and CREATE
appEvent (ViewVm UiVmState
s) (VtyEvent (V.EvKey (V.KChar Char
'p') [Modifier
V.MCtrl])) =
  (UiVmState -> Pred VM) -> UiVmState -> EventM Name (Next UiState)
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
(UiVmState -> Pred VM) -> UiVmState -> EventM n (Next UiState)
backstepUntil UiVmState -> Pred VM
isNextSourcePositionWithoutEntering UiVmState
s

-- Vm Overview: 0 - choose no jump
appEvent (ViewVm UiVmState
s) (VtyEvent (V.EvKey (V.KChar Char
'0') [])) =
  case Getting (Maybe VMResult) UiVmState (Maybe VMResult)
-> UiVmState -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((VM -> Const (Maybe VMResult) VM)
-> UiVmState -> Const (Maybe VMResult) UiVmState
Lens' UiVmState VM
uiVm ((VM -> Const (Maybe VMResult) VM)
 -> UiVmState -> Const (Maybe VMResult) UiVmState)
-> ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
    -> VM -> Const (Maybe VMResult) VM)
-> Getting (Maybe VMResult) UiVmState (Maybe VMResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result) UiVmState
s of
    Just (VMFailure (Choose (PleaseChoosePath Whiff
_ Bool -> EVM ()
contin))) ->
      UiVmState -> StepMode -> EventM Name (Next UiState)
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n (Next UiState)
takeStep (UiVmState
s UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
Lens' UiVmState (Stepper ())
uiStepper (EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (Bool -> EVM ()
contin Bool
True) Stepper () -> Stepper () -> Stepper ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Getting (Stepper ()) UiVmState (Stepper ())
-> UiVmState -> Stepper ()
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Stepper ()) UiVmState (Stepper ())
Lens' UiVmState (Stepper ())
uiStepper UiVmState
s)))
        (Int -> StepMode
Step Int
1)
    Maybe VMResult
_ -> UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiVmState -> UiState
ViewVm UiVmState
s)

-- Vm Overview: 1 - choose jump
appEvent (ViewVm UiVmState
s) (VtyEvent (V.EvKey (V.KChar Char
'1') [])) =
  case Getting (Maybe VMResult) UiVmState (Maybe VMResult)
-> UiVmState -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((VM -> Const (Maybe VMResult) VM)
-> UiVmState -> Const (Maybe VMResult) UiVmState
Lens' UiVmState VM
uiVm ((VM -> Const (Maybe VMResult) VM)
 -> UiVmState -> Const (Maybe VMResult) UiVmState)
-> ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
    -> VM -> Const (Maybe VMResult) VM)
-> Getting (Maybe VMResult) UiVmState (Maybe VMResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result) UiVmState
s of
    Just (VMFailure (Choose (PleaseChoosePath Whiff
_ Bool -> EVM ()
contin))) ->
      UiVmState -> StepMode -> EventM Name (Next UiState)
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n (Next UiState)
takeStep (UiVmState
s UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
Lens' UiVmState (Stepper ())
uiStepper (EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (Bool -> EVM ()
contin Bool
False) Stepper () -> Stepper () -> Stepper ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Getting (Stepper ()) UiVmState (Stepper ())
-> UiVmState -> Stepper ()
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Stepper ()) UiVmState (Stepper ())
Lens' UiVmState (Stepper ())
uiStepper UiVmState
s)))
        (Int -> StepMode
Step Int
1)
    Maybe VMResult
_ -> UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiVmState -> UiState
ViewVm UiVmState
s)


-- Any: Esc - return to Vm Overview or Exit
appEvent UiState
s (VtyEvent (V.EvKey Key
V.KEsc [])) =
  case UiState
s of
    (ViewHelp UiVmState
x) -> UiVmState -> EventM Name (Next UiState)
forall n. UiVmState -> EventM n (Next UiState)
overview UiVmState
x
    (ViewContracts UiBrowserState
x) -> UiVmState -> EventM Name (Next UiState)
forall n. UiVmState -> EventM n (Next UiState)
overview (UiVmState -> EventM Name (Next UiState))
-> UiVmState -> EventM Name (Next UiState)
forall a b. (a -> b) -> a -> b
$ Getting UiVmState UiBrowserState UiVmState
-> UiBrowserState -> UiVmState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UiVmState UiBrowserState UiVmState
Lens' UiBrowserState UiVmState
browserVm UiBrowserState
x
    UiState
_ -> UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
halt UiState
s
  where
    overview :: UiVmState -> EventM n (Next UiState)
overview = UiState -> EventM n (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiState -> EventM n (Next UiState))
-> (UiVmState -> UiState) -> UiVmState -> EventM n (Next UiState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UiVmState -> UiState
ViewVm

-- UnitTest Picker: Enter - select from list
appEvent (ViewPicker UiTestPickerState
s) (VtyEvent (V.EvKey Key
V.KEnter [])) =
  case List Name (Text, Text) -> Maybe (Int, (Text, Text))
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (Getting
  (List Name (Text, Text)) UiTestPickerState (List Name (Text, Text))
-> UiTestPickerState -> List Name (Text, Text)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (List Name (Text, Text)) UiTestPickerState (List Name (Text, Text))
Lens' UiTestPickerState (List Name (Text, Text))
testPickerList UiTestPickerState
s) of
    Maybe (Int, (Text, Text))
Nothing -> String -> EventM Name (Next UiState)
forall a. HasCallStack => String -> a
error String
"nothing selected"
    Just (Int
_, (Text, Text)
x) -> do
      UiVmState
initVm <- IO UiVmState -> EventM Name UiVmState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UiVmState -> EventM Name UiVmState)
-> IO UiVmState -> EventM Name UiVmState
forall a b. (a -> b) -> a -> b
$ UnitTestOptions -> (Text, Text) -> IO UiVmState
initialUiVmStateForTest (Getting UnitTestOptions UiTestPickerState UnitTestOptions
-> UiTestPickerState -> UnitTestOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UnitTestOptions UiTestPickerState UnitTestOptions
Lens' UiTestPickerState UnitTestOptions
testOpts UiTestPickerState
s) (Text, Text)
x
      UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiState -> EventM Name (Next UiState))
-> (UiVmState -> UiState)
-> UiVmState
-> EventM Name (Next UiState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UiVmState -> UiState
ViewVm (UiVmState -> EventM Name (Next UiState))
-> UiVmState -> EventM Name (Next UiState)
forall a b. (a -> b) -> a -> b
$ UiVmState
initVm

-- UnitTest Picker: (main) - render list
appEvent (ViewPicker UiTestPickerState
s) (VtyEvent Event
e) = do
  UiTestPickerState
s' <- UiTestPickerState
-> Lens' UiTestPickerState (List Name (Text, Text))
-> (Event
    -> List Name (Text, Text) -> EventM Name (List Name (Text, Text)))
-> Event
-> EventM Name UiTestPickerState
forall a b e n.
a -> Lens' a b -> (e -> b -> EventM n b) -> e -> EventM n a
handleEventLensed UiTestPickerState
s
    Lens' UiTestPickerState (List Name (Text, Text))
testPickerList
    Event
-> List Name (Text, Text) -> EventM Name (List Name (Text, Text))
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> GenericList n t e -> EventM n (GenericList n t e)
handleListEvent
    Event
e
  UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiTestPickerState -> UiState
ViewPicker UiTestPickerState
s')

-- Page: Down - scroll
appEvent (ViewVm UiVmState
s) (VtyEvent (V.EvKey Key
V.KDown [])) =
  if Getting Bool UiVmState Bool -> UiVmState -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool UiVmState Bool
Lens' UiVmState Bool
uiShowMemory UiVmState
s then
    ViewportScroll Name -> Int -> EventM Name ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy (Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
TracePane) Int
1 EventM Name ()
-> EventM Name (Next UiState) -> EventM Name (Next UiState)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiVmState -> UiState
ViewVm UiVmState
s)
  else
    if Maybe VMResult -> Bool
forall a. Maybe a -> Bool
isJust (Maybe VMResult -> Bool) -> Maybe VMResult -> Bool
forall a b. (a -> b) -> a -> b
$ Getting (Maybe VMResult) UiVmState (Maybe VMResult)
-> UiVmState -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((VM -> Const (Maybe VMResult) VM)
-> UiVmState -> Const (Maybe VMResult) UiVmState
Lens' UiVmState VM
uiVm ((VM -> Const (Maybe VMResult) VM)
 -> UiVmState -> Const (Maybe VMResult) UiVmState)
-> ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
    -> VM -> Const (Maybe VMResult) VM)
-> Getting (Maybe VMResult) UiVmState (Maybe VMResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result) UiVmState
s
    then UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiVmState -> UiState
ViewVm UiVmState
s)
    else UiVmState -> StepMode -> EventM Name (Next UiState)
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n (Next UiState)
takeStep UiVmState
s
         (Pred VM -> StepMode
StepUntil (UiVmState -> Pred VM
isNewTraceAdded UiVmState
s))

-- Page: Up - scroll
appEvent (ViewVm UiVmState
s) (VtyEvent (V.EvKey Key
V.KUp [])) =
  if Getting Bool UiVmState Bool -> UiVmState -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool UiVmState Bool
Lens' UiVmState Bool
uiShowMemory UiVmState
s then
    ViewportScroll Name -> Int -> EventM Name ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy (Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
TracePane) (-Int
1) EventM Name ()
-> EventM Name (Next UiState) -> EventM Name (Next UiState)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue (UiVmState -> UiState
ViewVm UiVmState
s)
  else
    (UiVmState -> Pred VM) -> UiVmState -> EventM Name (Next UiState)
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
(UiVmState -> Pred VM) -> UiVmState -> EventM n (Next UiState)
backstepUntil UiVmState -> Pred VM
isNewTraceAdded UiVmState
s

-- Page: C-f - Page down
appEvent UiState
s (VtyEvent (V.EvKey (V.KChar Char
'f') [Modifier
V.MCtrl])) =
  ViewportScroll Name -> Direction -> EventM Name ()
forall n. ViewportScroll n -> Direction -> EventM n ()
vScrollPage (Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
TracePane) Direction
Down EventM Name ()
-> EventM Name (Next UiState) -> EventM Name (Next UiState)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue UiState
s

-- Page: C-b - Page up
appEvent UiState
s (VtyEvent (V.EvKey (V.KChar Char
'b') [Modifier
V.MCtrl])) =
  ViewportScroll Name -> Direction -> EventM Name ()
forall n. ViewportScroll n -> Direction -> EventM n ()
vScrollPage (Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
TracePane) Direction
Up EventM Name ()
-> EventM Name (Next UiState) -> EventM Name (Next UiState)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue UiState
s

-- Default
appEvent UiState
s BrickEvent Name e
_ = UiState -> EventM Name (Next UiState)
forall s n. s -> EventM n (Next s)
continue UiState
s

app :: UnitTestOptions -> App UiState () Name
app :: UnitTestOptions -> App UiState () Name
app UnitTestOptions
opts =
  let ?fetcher = oracle opts
      ?maxIter = maxIter opts
  in App :: forall s e n.
(s -> [Widget n])
-> (s -> [CursorLocation n] -> Maybe (CursorLocation n))
-> (s -> BrickEvent n e -> EventM n (Next s))
-> (s -> EventM n s)
-> (s -> AttrMap)
-> App s e n
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 :: UiState -> BrickEvent Name () -> EventM Name (Next UiState)
appHandleEvent = UiState -> BrickEvent Name () -> EventM Name (Next UiState)
forall e.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiState -> BrickEvent Name e -> EventM Name (Next UiState)
appEvent
  , appStartEvent :: UiState -> EventM Name UiState
appStartEvent = UiState -> EventM Name UiState
forall (m :: * -> *) a. Monad m => a -> m a
return
  , 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)
  -> IO UiVmState
initialUiVmStateForTest :: UnitTestOptions -> (Text, Text) -> IO UiVmState
initialUiVmStateForTest opts :: UnitTestOptions
opts@UnitTestOptions{Bool
Int
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Fetcher
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Fetcher
allowFFI :: UnitTestOptions -> Bool
dapp :: UnitTestOptions -> DappInfo
testParams :: UnitTestOptions -> TestVMParams
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
maxDepth :: UnitTestOptions -> Maybe Int
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Fetcher
..} (Text
theContractName, Text
theTestName) = do
  let state' :: State
state' = State -> Maybe State -> State
forall a. a -> Maybe a -> a
fromMaybe (String -> State
forall a. HasCallStack => String -> a
error String
"Internal Error: missing smtState") Maybe State
smtState
  ([SWord 8]
buf, W256
len) <- (ReaderT State IO ([SWord 8], W256)
 -> State -> IO ([SWord 8], W256))
-> State
-> ReaderT State IO ([SWord 8], W256)
-> IO ([SWord 8], W256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT State IO ([SWord 8], W256) -> State -> IO ([SWord 8], W256)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT State
state' (ReaderT State IO ([SWord 8], W256) -> IO ([SWord 8], W256))
-> ReaderT State IO ([SWord 8], W256) -> IO ([SWord 8], W256)
forall a b. (a -> b) -> a -> b
$ QueryT IO ([SWord 8], W256) -> ReaderT State IO ([SWord 8], W256)
forall (m :: * -> *) a. QueryT m a -> ReaderT State m a
SBV.runQueryT (QueryT IO ([SWord 8], W256) -> ReaderT State IO ([SWord 8], W256))
-> QueryT IO ([SWord 8], W256)
-> ReaderT State IO ([SWord 8], W256)
forall a b. (a -> b) -> a -> b
$ Text -> [AbiType] -> [String] -> QueryT IO ([SWord 8], W256)
symCalldata Text
theTestName [AbiType]
types []
  let 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
            EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (EVM () -> Stepper ()) -> EVM () -> Stepper ()
forall a b. (a -> b) -> a -> b
$ (VM -> VM) -> EVM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify VM -> VM
symbolify
            ProgramT Action Identity (Bool, VM) -> Stepper ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UnitTestOptions
-> Text -> (Buffer, SymWord) -> ProgramT Action Identity (Bool, VM)
execSymTest UnitTestOptions
opts Text
theTestName ([SWord 8] -> Buffer
SymbolicBuffer [SWord 8]
buf, W256 -> SymWord
w256lit W256
len))
          InvariantTest Text
_ -> do
            [Addr]
targets <- UnitTestOptions -> Stepper [Addr]
getTargetContracts UnitTestOptions
opts
            let randomRun :: Stepper (Bool, RLP)
randomRun = UnitTestOptions
-> Text
-> [ExploreTx]
-> [Addr]
-> RLP
-> Int
-> Stepper (Bool, RLP)
explorationStepper UnitTestOptions
opts Text
theTestName [] [Addr]
targets ([RLP] -> RLP
List []) (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]
-> RLP
-> Int
-> Stepper (Bool, RLP)
explorationStepper UnitTestOptions
opts Text
theTestName (ByteString -> [ExploreTx]
decodeCalls ByteString
cd) [Addr]
targets ([RLP] -> RLP
List []) ([ExploreTx] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ByteString -> [ExploreTx]
decodeCalls ByteString
cd))
                else Stepper (Bool, RLP)
randomRun
  UiVmState -> IO UiVmState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UiVmState -> IO UiVmState) -> UiVmState -> IO UiVmState
forall a b. (a -> b) -> a -> b
$ VM -> UnitTestOptions -> Stepper () -> UiVmState
initUiVmState VM
vm0 UnitTestOptions
opts Stepper ()
script
  where
    Just (Test
test, [AbiType]
types) = ((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
    Just SolcContract
testContract =
      Getting (Maybe SolcContract) DappInfo (Maybe SolcContract)
-> DappInfo -> Maybe SolcContract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Map Text SolcContract
 -> Const (Maybe SolcContract) (Map Text SolcContract))
-> DappInfo -> Const (Maybe SolcContract) DappInfo
Lens' DappInfo (Map Text SolcContract)
dappSolcByName ((Map Text SolcContract
  -> Const (Maybe SolcContract) (Map Text SolcContract))
 -> DappInfo -> Const (Maybe SolcContract) DappInfo)
-> ((Maybe SolcContract
     -> Const (Maybe SolcContract) (Maybe SolcContract))
    -> Map Text SolcContract
    -> Const (Maybe SolcContract) (Map Text SolcContract))
-> Getting (Maybe SolcContract) DappInfo (Maybe SolcContract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Text SolcContract)
-> Lens'
     (Map Text SolcContract) (Maybe (IxValue (Map Text SolcContract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (Map Text SolcContract)
theContractName) DappInfo
dapp
    vm0 :: VM
vm0 =
      UnitTestOptions -> SolcContract -> VM
initialUnitTestVm UnitTestOptions
opts SolcContract
testContract

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 -> List Name (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
          (Getting
  (List Name (Text, Text)) UiTestPickerState (List Name (Text, Text))
-> UiTestPickerState -> List Name (Text, Text)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (List Name (Text, Text)) UiTestPickerState (List Name (Text, Text))
Lens' UiTestPickerState (List Name (Text, Text))
testPickerList UiTestPickerState
ui)
  ]

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 -> List Name (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)
-> (Getting (First Text) DappInfo Text -> Maybe Text)
-> Getting (First Text) DappInfo Text
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Getting (First Text) DappInfo Text -> DappInfo -> Maybe Text)
-> DappInfo -> Getting (First Text) DappInfo Text -> Maybe Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Getting (First Text) DappInfo Text -> DappInfo -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview DappInfo
dapp' (Getting (First Text) DappInfo Text -> Text)
-> Getting (First Text) DappInfo Text -> Text
forall a b. (a -> b) -> a -> b
$
                       ( (Map W256 (CodeType, SolcContract)
 -> Const (First Text) (Map W256 (CodeType, SolcContract)))
-> DappInfo -> Const (First Text) DappInfo
Lens' DappInfo (Map W256 (CodeType, SolcContract))
dappSolcByHash ((Map W256 (CodeType, SolcContract)
  -> Const (First Text) (Map W256 (CodeType, SolcContract)))
 -> DappInfo -> Const (First Text) DappInfo)
-> ((Text -> Const (First Text) Text)
    -> Map W256 (CodeType, SolcContract)
    -> Const (First Text) (Map W256 (CodeType, SolcContract)))
-> Getting (First Text) DappInfo Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map W256 (CodeType, SolcContract))
-> Traversal'
     (Map W256 (CodeType, SolcContract))
     (IxValue (Map W256 (CodeType, SolcContract)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Getting W256 Contract W256 -> Contract -> W256
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting W256 Contract W256
Lens' Contract W256
codehash Contract
c')
                       (((CodeType, SolcContract)
  -> Const (First Text) (CodeType, SolcContract))
 -> Map W256 (CodeType, SolcContract)
 -> Const (First Text) (Map W256 (CodeType, SolcContract)))
-> ((Text -> Const (First Text) Text)
    -> (CodeType, SolcContract)
    -> Const (First Text) (CodeType, SolcContract))
-> (Text -> Const (First Text) Text)
-> Map W256 (CodeType, SolcContract)
-> Const (First Text) (Map W256 (CodeType, SolcContract))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SolcContract -> Const (First Text) SolcContract)
-> (CodeType, SolcContract)
-> Const (First Text) (CodeType, SolcContract)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((SolcContract -> Const (First Text) SolcContract)
 -> (CodeType, SolcContract)
 -> Const (First Text) (CodeType, SolcContract))
-> ((Text -> Const (First Text) Text)
    -> SolcContract -> Const (First Text) SolcContract)
-> (Text -> Const (First Text) Text)
-> (CodeType, SolcContract)
-> Const (First Text) (CodeType, SolcContract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> SolcContract -> Const (First Text) SolcContract
Lens' SolcContract Text
contractName )
                   , Text
"\n"
                   , Text
"  ", String -> Text
pack (Addr -> String
forall a. Show a => a -> String
show Addr
k)
                   ])
              Bool
True
              (Getting
  (List Name (Addr, Contract))
  UiBrowserState
  (List Name (Addr, Contract))
-> UiBrowserState -> List Name (Addr, Contract)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (List Name (Addr, Contract))
  UiBrowserState
  (List Name (Addr, Contract))
Lens' UiBrowserState (List Name (Addr, Contract))
browserContractList UiBrowserState
ui)
      , case (Getting (First SolcContract) DappInfo SolcContract
 -> DappInfo -> Maybe SolcContract)
-> DappInfo
-> Getting (First SolcContract) DappInfo SolcContract
-> Maybe SolcContract
forall a b c. (a -> b -> c) -> b -> a -> c
flip Getting (First SolcContract) DappInfo SolcContract
-> DappInfo -> Maybe SolcContract
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview DappInfo
dapp' ((Map W256 (CodeType, SolcContract)
 -> Const (First SolcContract) (Map W256 (CodeType, SolcContract)))
-> DappInfo -> Const (First SolcContract) DappInfo
Lens' DappInfo (Map W256 (CodeType, SolcContract))
dappSolcByHash ((Map W256 (CodeType, SolcContract)
  -> Const (First SolcContract) (Map W256 (CodeType, SolcContract)))
 -> DappInfo -> Const (First SolcContract) DappInfo)
-> ((SolcContract -> Const (First SolcContract) SolcContract)
    -> Map W256 (CodeType, SolcContract)
    -> Const (First SolcContract) (Map W256 (CodeType, SolcContract)))
-> Getting (First SolcContract) DappInfo SolcContract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map W256 (CodeType, SolcContract))
-> Traversal'
     (Map W256 (CodeType, SolcContract))
     (IxValue (Map W256 (CodeType, SolcContract)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Getting W256 Contract W256 -> Contract -> W256
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting W256 Contract W256
Lens' Contract W256
codehash Contract
c) (((CodeType, SolcContract)
  -> Const (First SolcContract) (CodeType, SolcContract))
 -> Map W256 (CodeType, SolcContract)
 -> Const (First SolcContract) (Map W256 (CodeType, SolcContract)))
-> ((SolcContract -> Const (First SolcContract) SolcContract)
    -> (CodeType, SolcContract)
    -> Const (First SolcContract) (CodeType, SolcContract))
-> (SolcContract -> Const (First SolcContract) SolcContract)
-> Map W256 (CodeType, SolcContract)
-> Const (First SolcContract) (Map W256 (CodeType, SolcContract))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SolcContract -> Const (First SolcContract) SolcContract)
-> (CodeType, SolcContract)
-> Const (First SolcContract) (CodeType, SolcContract)
forall s t a b. Field2 s t a b => Lens s t a b
_2) 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 (W256 -> String
forall a. Show a => a -> String
show (Getting W256 Contract W256 -> Contract -> W256
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting W256 Contract W256
Lens' Contract W256
codehash Contract
c)))
                  , Text -> Widget Name
forall n. Text -> Widget n
txt (Text
"Nonce: "    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word -> Text
showWordExact (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
nonce    Contract
c))
                  , Text -> Widget Name
forall n. Text -> Widget n
txt (Text
"Balance: "  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word -> Text
showWordExact (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
balance  Contract
c))
                  , Text -> Widget Name
forall n. Text -> Widget n
txt (Text
"Storage: "  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Storage -> Text
storageDisplay (Getting Storage Contract Storage -> Contract -> Storage
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Storage Contract Storage
Lens' Contract Storage
storage Contract
c))
                  ]
                ]
          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 (Getting Text SolcContract Text -> SolcContract -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text SolcContract Text
Lens' SolcContract Text
contractName SolcContract
sol))
                  , 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 (Getting Text SolcContract Text -> SolcContract -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text SolcContract Text
Lens' SolcContract Text
contractName SolcContract
sol))
                  , 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 (Getting [(Text, AbiType)] SolcContract [(Text, AbiType)]
-> SolcContract -> [(Text, AbiType)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(Text, AbiType)] SolcContract [(Text, AbiType)]
Lens' SolcContract [(Text, AbiType)]
constructorInputs SolcContract
sol) (((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 Word32 Method -> [Method]
forall k a. Map k a -> [a]
Map.elems (Getting (Map Word32 Method) SolcContract (Map Word32 Method)
-> SolcContract -> Map Word32 Method
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Word32 Method) SolcContract (Map Word32 Method)
Lens' SolcContract (Map Word32 Method)
abiMap SolcContract
sol))) ((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
<> Getting Text Method Text -> Method -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Method Text
Lens' Method Text
methodSignature Method
method)
                  , Text -> Widget Name
forall n. Text -> Widget n
txt (Text
"Storage:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Storage -> Text
storageDisplay (Getting Storage Contract Storage -> Contract -> Storage
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Storage Contract Storage
Lens' Contract Storage
storage Contract
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
"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 storageDisplay :: Storage -> Text
storageDisplay (Concrete Map Word SymWord
s) = String -> Text
pack ( [(Word, SymWord)] -> String
forall a. Show a => a -> String
show ( Map Word SymWord -> [(Word, SymWord)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Word SymWord
s))
        storageDisplay (Symbolic [(SymWord, SymWord)]
v SArray (WordN 256) (WordN 256)
_) = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [(SymWord, SymWord)] -> String
forall a. Show a => a -> String
show [(SymWord, SymWord)]
v
        dapp' :: DappInfo
dapp' = UnitTestOptions -> DappInfo
dapp (Getting UnitTestOptions UiBrowserState UnitTestOptions
-> UiBrowserState -> UnitTestOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((UiVmState -> Const UnitTestOptions UiVmState)
-> UiBrowserState -> Const UnitTestOptions UiBrowserState
Lens' UiBrowserState UiVmState
browserVm ((UiVmState -> Const UnitTestOptions UiVmState)
 -> UiBrowserState -> Const UnitTestOptions UiBrowserState)
-> Getting UnitTestOptions UiVmState UnitTestOptions
-> Getting UnitTestOptions UiBrowserState UnitTestOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting UnitTestOptions UiVmState UnitTestOptions
Lens' UiVmState UnitTestOptions
uiTestOpts) UiBrowserState
ui)
        Just (Int
_, (Addr
_, Contract
c)) = List Name (Addr, Contract) -> Maybe (Int, (Addr, Contract))
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (Getting
  (List Name (Addr, Contract))
  UiBrowserState
  (List Name (Addr, Contract))
-> UiBrowserState -> List Name (Addr, Contract)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (List Name (Addr, Contract))
  UiBrowserState
  (List Name (Addr, Contract))
Lens' UiBrowserState (List Name (Addr, Contract))
browserContractList UiBrowserState
ui)
--        currentContract  = view (dappSolcByHash . ix ) dapp

drawVm :: UiVmState -> [UiWidget]
drawVm :: UiVmState -> [Widget Name]
drawVm UiVmState
ui =
  -- EVM debugging needs a lot of space because of the 256-bit words
  -- in both the bytecode and the stack .
  --
  -- If on a very tall display, prefer a vertical layout.
  --
  -- Actually the horizontal layout would be preferrable if the display
  -- is both very tall and very wide, but this is okay for now.
  [ 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 :: Stepper a -> StateT UiVmState IO ()
stepOneOpcode Stepper a
restart = do
  Int
n <- Getting Int UiVmState Int -> StateT UiVmState IO Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int UiVmState Int
Lens' UiVmState Int
uiStep
  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 <- Getting VM UiVmState VM -> StateT UiVmState IO VM
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting VM UiVmState VM
Lens' UiVmState VM
uiVm
    ASetter
  UiVmState
  UiVmState
  (Map Int (VM, Stepper ()))
  (Map Int (VM, Stepper ()))
-> (Map Int (VM, Stepper ()) -> Map Int (VM, Stepper ()))
-> StateT UiVmState IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter
  UiVmState
  UiVmState
  (Map Int (VM, Stepper ()))
  (Map Int (VM, Stepper ()))
Lens' UiVmState (Map Int (VM, Stepper ()))
uiSnapshots (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))
  ASetter UiVmState UiVmState VM VM
-> (VM -> VM) -> StateT UiVmState IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter UiVmState UiVmState VM VM
Lens' UiVmState VM
uiVm (EVM () -> VM -> VM
forall s a. State s a -> s -> s
execState EVM ()
exec1)
  ASetter UiVmState UiVmState Int Int
-> (Int -> Int) -> StateT UiVmState IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter UiVmState UiVmState Int Int
Lens' UiVmState Int
uiStep (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 (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 (Getting VM UiVmState VM -> UiVmState -> VM
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting VM UiVmState VM
Lens' UiVmState VM
uiVm UiVmState
ui)
    newTraceTree :: [Int]
newTraceTree = Tree Trace -> 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' = UnitTestOptions -> DappInfo
dapp (Getting UnitTestOptions UiVmState UnitTestOptions
-> UiVmState -> UnitTestOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UnitTestOptions UiVmState UnitTestOptions
Lens' UiVmState UnitTestOptions
uiTestOpts UiVmState
ui)
      initialPosition :: Maybe SrcMap
initialPosition = DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp' (Getting VM UiVmState VM -> UiVmState -> VM
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting VM UiVmState VM
Lens' UiVmState VM
uiVm UiVmState
ui)
  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'           = UnitTestOptions -> DappInfo
dapp (Getting UnitTestOptions UiVmState UnitTestOptions
-> UiVmState -> UnitTestOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UnitTestOptions UiVmState UnitTestOptions
Lens' UiVmState UnitTestOptions
uiTestOpts UiVmState
ui)
    vm0 :: VM
vm0             = Getting VM UiVmState VM -> UiVmState -> VM
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting VM UiVmState VM
Lens' UiVmState VM
uiVm UiVmState
ui
    initialPosition :: Maybe SrcMap
initialPosition = DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp' VM
vm0
    initialHeight :: Int
initialHeight   = [Frame] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Getting [Frame] VM [Frame] -> VM -> [Frame]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Frame] VM [Frame]
Lens' VM [Frame]
frames VM
vm0)
  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 (t :: * -> *) a. Foldable t => t a -> Int
length (Getting [Frame] VM [Frame] -> VM -> [Frame]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Frame] VM [Frame]
Lens' VM [Frame]
frames VM
vm) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
initialHeight
          boring :: Bool
boring =
            case SourceCache -> SrcMap -> Maybe ByteString
srcMapCode (Getting SourceCache DappInfo SourceCache -> DappInfo -> SourceCache
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SourceCache DappInfo SourceCache
Lens' DappInfo SourceCache
dappSources DappInfo
dapp') 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 (((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
 -> VM -> Const (Maybe VMResult) VM)
-> VM -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result VM
vm)

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 <- (Getting (Vector Int) Contract (Vector Int)
-> Contract -> Vector Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Vector Int) Contract (Vector Int)
Lens' Contract (Vector Int)
opIxMap Contract
this) Vector Int -> Int -> Maybe Int
forall a. Storable a => Vector a -> Int -> Maybe a
SVec.!? (Getting Int VM Int -> VM -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const Int FrameState) -> VM -> Const Int VM
Lens' VM FrameState
state ((FrameState -> Const Int FrameState) -> VM -> Const Int VM)
-> ((Int -> Const Int Int) -> FrameState -> Const Int FrameState)
-> Getting Int VM Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> FrameState -> Const Int FrameState
Lens' FrameState Int
pc) VM
vm)
  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 = Word -> Text
showWordExact (Getting Word UiVmState Word -> UiVmState -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((VM -> Const Word VM) -> UiVmState -> Const Word UiVmState
Lens' UiVmState VM
uiVm ((VM -> Const Word VM) -> UiVmState -> Const Word UiVmState)
-> ((Word -> Const Word Word) -> VM -> Const Word VM)
-> Getting Word UiVmState Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FrameState -> Const Word FrameState) -> VM -> Const Word VM
Lens' VM FrameState
state ((FrameState -> Const Word FrameState) -> VM -> Const Word VM)
-> ((Word -> Const Word Word)
    -> FrameState -> Const Word FrameState)
-> (Word -> Const Word Word)
-> VM
-> Const Word VM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Const Word Word) -> FrameState -> Const Word FrameState
Lens' FrameState Word
gas) UiVmState
ui)
    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, SymWord)
stackList = Name
-> Vector (Int, SymWord)
-> Int
-> GenericList Name Vector (Int, SymWord)
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Name
StackPane ([(Int, SymWord)] -> Vector (Int, SymWord)
forall a. [a] -> Vector a
Vec.fromList ([(Int, SymWord)] -> Vector (Int, SymWord))
-> [(Int, SymWord)] -> Vector (Int, SymWord)
forall a b. (a -> b) -> a -> b
$ [Int] -> [SymWord] -> [(Int, SymWord)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1 :: Int)..] (Getting [SymWord] UiVmState [SymWord] -> UiVmState -> [SymWord]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((VM -> Const [SymWord] VM)
-> UiVmState -> Const [SymWord] UiVmState
Lens' UiVmState VM
uiVm ((VM -> Const [SymWord] VM)
 -> UiVmState -> Const [SymWord] UiVmState)
-> (([SymWord] -> Const [SymWord] [SymWord])
    -> VM -> Const [SymWord] VM)
-> Getting [SymWord] UiVmState [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FrameState -> Const [SymWord] FrameState)
-> VM -> Const [SymWord] VM
Lens' VM FrameState
state ((FrameState -> Const [SymWord] FrameState)
 -> VM -> Const [SymWord] VM)
-> (([SymWord] -> Const [SymWord] [SymWord])
    -> FrameState -> Const [SymWord] FrameState)
-> ([SymWord] -> Const [SymWord] [SymWord])
-> VM
-> Const [SymWord] VM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Const [SymWord] [SymWord])
-> FrameState -> Const [SymWord] FrameState
Lens' FrameState [SymWord]
stack) UiVmState
ui)) 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, SymWord) -> Widget Name)
-> Bool -> GenericList Name Vector (Int, SymWord) -> 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, x :: SymWord
x@(S Whiff
_ SWord 256
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
str (SymWord -> String
forall a. Show a => a -> String
show SymWord
x)
           , 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 SWord 256 -> Maybe (WordN 256)
forall a. SymVal a => SBV a -> Maybe a
unliteral SWord 256
w of
                       Maybe (WordN 256)
Nothing -> Text
""
                       Just WordN 256
u -> W256 -> DappInfo -> Text
showWordExplanation (WordN 256 -> FromSizzle (WordN 256)
forall a. FromSizzleBV a => a -> FromSizzle a
fromSizzle WordN 256
u) (DappInfo -> Text) -> DappInfo -> Text
forall a b. (a -> b) -> a -> b
$ UnitTestOptions -> DappInfo
dapp (Getting UnitTestOptions UiVmState UnitTestOptions
-> UiVmState -> UnitTestOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UnitTestOptions UiVmState UnitTestOptions
Lens' UiVmState UnitTestOptions
uiTestOpts UiVmState
ui)))
           ])
      Bool
False
      GenericList Name Vector (Int, SymWord)
stackList

message :: VM -> String
message :: VM -> String
message VM
vm =
  case ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
 -> VM -> Const (Maybe VMResult) VM)
-> VM -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result VM
vm of
    Just (VMSuccess (ConcreteBuffer 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 (SymbolicBuffer [SWord 8]
msg)) ->
      String
"VMSuccess: <symbolicbuffer> " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ([SWord 8] -> String
forall a. Show a => a -> String
show [SWord 8]
msg)
    Just (VMFailure (Revert ByteString
msg)) ->
      String
"VMFailure: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (ByteStringS -> String
forall a. Show a => a -> String
show (ByteStringS -> String)
-> (ByteString -> ByteStringS) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteStringS
ByteStringS (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString
msg)
    Just (VMFailure Error
err) ->
      String
"VMFailure: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Error -> String
forall a. Show a => a -> String
show Error
err
    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 (Getting Addr VM Addr -> VM -> Addr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM
Lens' VM FrameState
state ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM)
-> ((Addr -> Const Addr Addr)
    -> FrameState -> Const Addr FrameState)
-> Getting Addr VM Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Addr -> Const Addr Addr) -> FrameState -> Const Addr FrameState
Lens' FrameState Addr
contract) VM
vm)


drawBytecodePane :: UiVmState -> UiWidget
drawBytecodePane :: UiVmState -> Widget Name
drawBytecodePane UiVmState
ui =
  let
    vm :: VM
vm = Getting VM UiVmState VM -> UiVmState -> VM
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting VM UiVmState VM
Lens' UiVmState VM
uiVm UiVmState
ui
    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 (Getting (Vector (Int, Op)) Contract (Vector (Int, Op))
-> Contract -> Vector (Int, Op)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Vector (Int, Op)) Contract (Vector (Int, Op))
Lens' Contract (Vector (Int, Op))
codeOps) (VM -> Maybe Contract
currentContract VM
vm))
        Int
1)


dim :: Widget n -> Widget n
dim :: 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 :: 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 :: Buffer -> String
prettyIfConcrete :: Buffer -> String
prettyIfConcrete (SymbolicBuffer [SWord 8]
x) = [SWord 8] -> String
forall a. Show a => a -> String
show [SWord 8]
x
prettyIfConcrete (ConcreteBuffer ByteString
x) = Int -> ByteString -> String
prettyHex Int
40 ByteString
x

drawTracePane :: UiVmState -> UiWidget
drawTracePane :: UiVmState -> Widget Name
drawTracePane UiVmState
s =
  let vm :: VM
vm = Getting VM UiVmState VM -> UiVmState -> VM
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting VM UiVmState VM
Lens' UiVmState VM
uiVm UiVmState
s
      dapp' :: DappInfo
dapp' = UnitTestOptions -> DappInfo
dapp (Getting UnitTestOptions UiVmState UnitTestOptions
-> UiVmState -> UnitTestOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UnitTestOptions UiVmState UnitTestOptions
Lens' UiVmState UnitTestOptions
uiTestOpts UiVmState
s)
      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 Getting Bool UiVmState Bool -> UiVmState -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool UiVmState Bool
Lens' UiVmState Bool
uiShowMemory UiVmState
s of
    Bool
True ->
      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
str (Buffer -> String
prettyIfConcrete (Buffer -> String) -> Buffer -> String
forall a b. (a -> b) -> a -> b
$ (Buffer, SymWord) -> Buffer
forall a b. (a, b) -> a
fst (Getting (Buffer, SymWord) VM (Buffer, SymWord)
-> VM -> (Buffer, SymWord)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const (Buffer, SymWord) FrameState)
-> VM -> Const (Buffer, SymWord) VM
Lens' VM FrameState
state ((FrameState -> Const (Buffer, SymWord) FrameState)
 -> VM -> Const (Buffer, SymWord) VM)
-> (((Buffer, SymWord)
     -> Const (Buffer, SymWord) (Buffer, SymWord))
    -> FrameState -> Const (Buffer, SymWord) FrameState)
-> Getting (Buffer, SymWord) VM (Buffer, SymWord)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Buffer, SymWord) -> Const (Buffer, SymWord) (Buffer, SymWord))
-> FrameState -> Const (Buffer, SymWord) FrameState
Lens' FrameState (Buffer, SymWord)
calldata) VM
vm))
      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
str (Buffer -> String
prettyIfConcrete (Getting Buffer VM Buffer -> VM -> Buffer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
state ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Getting Buffer VM Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
returndata) VM
vm))
      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
str (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 (((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
 -> VM -> Const (Maybe VMResult) VM)
-> VM -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result VM
vm))
      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
str (Map (CodeLocation, Int) Bool -> String
forall a. Show a => a -> String
show (Getting
  (Map (CodeLocation, Int) Bool) VM (Map (CodeLocation, Int) Bool)
-> VM -> Map (CodeLocation, Int) Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Cache -> Const (Map (CodeLocation, Int) Bool) Cache)
-> VM -> Const (Map (CodeLocation, Int) Bool) VM
Lens' VM Cache
cache ((Cache -> Const (Map (CodeLocation, Int) Bool) Cache)
 -> VM -> Const (Map (CodeLocation, Int) Bool) VM)
-> ((Map (CodeLocation, Int) Bool
     -> Const
          (Map (CodeLocation, Int) Bool) (Map (CodeLocation, Int) Bool))
    -> Cache -> Const (Map (CodeLocation, Int) Bool) Cache)
-> Getting
     (Map (CodeLocation, Int) Bool) VM (Map (CodeLocation, Int) Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (CodeLocation, Int) Bool
 -> Const
      (Map (CodeLocation, Int) Bool) (Map (CodeLocation, Int) Bool))
-> Cache -> Const (Map (CodeLocation, Int) Bool) Cache
Lens' Cache (Map (CodeLocation, Int) Bool)
path) VM
vm))
      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
str (String -> Widget Name) -> String -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Whiff] -> String
forall a. Show a => a -> String
show ([Whiff] -> String) -> [Whiff] -> String
forall a b. (a -> b) -> a -> b
$ (SBool, Whiff) -> Whiff
forall a b. (a, b) -> b
snd ((SBool, Whiff) -> Whiff) -> [(SBool, Whiff)] -> [Whiff]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting [(SBool, Whiff)] VM [(SBool, Whiff)]
-> VM -> [(SBool, Whiff)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(SBool, Whiff)] VM [(SBool, Whiff)]
Lens' VM [(SBool, Whiff)]
constraints VM
vm)
      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
<=> Name -> ViewportType -> Widget Name -> Widget Name
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport Name
TracePane ViewportType
Vertical
            (String -> Widget Name
forall n. String -> Widget n
str (Buffer -> String
prettyIfConcrete (Getting Buffer VM Buffer -> VM -> Buffer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
state ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Getting Buffer VM Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
memory) VM
vm)))
    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 (t :: * -> *) a. Foldable t => t a -> Int
length GenericList Name Vector Text
traceList) GenericList Name Vector Text
traceList)

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 ->
          Getting
  (Vector (Int, ByteString)) DappInfo (Vector (Int, ByteString))
-> DappInfo -> Vector (Int, ByteString)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SourceCache -> Const (Vector (Int, ByteString)) SourceCache)
-> DappInfo -> Const (Vector (Int, ByteString)) DappInfo
Lens' DappInfo SourceCache
dappSources
            ((SourceCache -> Const (Vector (Int, ByteString)) SourceCache)
 -> DappInfo -> Const (Vector (Int, ByteString)) DappInfo)
-> ((Vector (Int, ByteString)
     -> Const (Vector (Int, ByteString)) (Vector (Int, ByteString)))
    -> SourceCache -> Const (Vector (Int, ByteString)) SourceCache)
-> Getting
     (Vector (Int, ByteString)) DappInfo (Vector (Int, ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Vector ByteString]
 -> Const (Vector (Int, ByteString)) [Vector ByteString])
-> SourceCache -> Const (Vector (Int, ByteString)) SourceCache
Lens' SourceCache [Vector ByteString]
sourceLines
            (([Vector ByteString]
  -> Const (Vector (Int, ByteString)) [Vector ByteString])
 -> SourceCache -> Const (Vector (Int, ByteString)) SourceCache)
-> ((Vector (Int, ByteString)
     -> Const (Vector (Int, ByteString)) (Vector (Int, ByteString)))
    -> [Vector ByteString]
    -> Const (Vector (Int, ByteString)) [Vector ByteString])
-> (Vector (Int, ByteString)
    -> Const (Vector (Int, ByteString)) (Vector (Int, ByteString)))
-> SourceCache
-> Const (Vector (Int, ByteString)) SourceCache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index [Vector ByteString]
-> Traversal' [Vector ByteString] (IxValue [Vector ByteString])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (SrcMap -> Int
srcMapFile SrcMap
x)
            ((Vector ByteString
  -> Const (Vector (Int, ByteString)) (Vector ByteString))
 -> [Vector ByteString]
 -> Const (Vector (Int, ByteString)) [Vector ByteString])
-> ((Vector (Int, ByteString)
     -> Const (Vector (Int, ByteString)) (Vector (Int, ByteString)))
    -> Vector ByteString
    -> Const (Vector (Int, ByteString)) (Vector ByteString))
-> (Vector (Int, ByteString)
    -> Const (Vector (Int, ByteString)) (Vector (Int, ByteString)))
-> [Vector ByteString]
-> Const (Vector (Int, ByteString)) [Vector ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector ByteString -> Vector (Int, ByteString))
-> (Vector (Int, ByteString)
    -> Const (Vector (Int, ByteString)) (Vector (Int, ByteString)))
-> Vector ByteString
-> Const (Vector (Int, ByteString)) (Vector ByteString)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f 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')
    Int
1

drawSolidityPane :: UiVmState -> UiWidget
drawSolidityPane :: UiVmState -> Widget Name
drawSolidityPane UiVmState
ui =
  let dapp' :: DappInfo
dapp' = UnitTestOptions -> DappInfo
dapp (Getting UnitTestOptions UiVmState UnitTestOptions
-> UiVmState -> UnitTestOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UnitTestOptions UiVmState UnitTestOptions
Lens' UiVmState UnitTestOptions
uiTestOpts UiVmState
ui)
      dappSrcs :: SourceCache
dappSrcs = Getting SourceCache DappInfo SourceCache -> DappInfo -> SourceCache
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SourceCache DappInfo SourceCache
Lens' DappInfo SourceCache
dappSources DappInfo
dapp'
      vm :: VM
vm = Getting VM UiVmState VM -> UiVmState -> VM
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting VM UiVmState VM
Lens' UiVmState VM
uiVm UiVmState
ui
  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 :: Vector ByteString
rows = (SourceCache -> [Vector ByteString]
_sourceLines SourceCache
dappSrcs) [Vector ByteString] -> Int -> Vector ByteString
forall a. [a] -> Int -> a
!! SrcMap -> Int
srcMapFile SrcMap
sm
            subrange :: Int -> Maybe (Int, Int)
subrange = Vector ByteString -> (Int, Int) -> Int -> Maybe (Int, Int)
lineSubrange Vector ByteString
rows (SrcMap -> Int
srcMapOffset SrcMap
sm, SrcMap -> Int
srcMapLength SrcMap
sm)
            fileName :: Maybe Text
            fileName :: Maybe Text
fileName = Getting (First Text) DappInfo Text -> DappInfo -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((SourceCache -> Const (First Text) SourceCache)
-> DappInfo -> Const (First Text) DappInfo
Lens' DappInfo SourceCache
dappSources ((SourceCache -> Const (First Text) SourceCache)
 -> DappInfo -> Const (First Text) DappInfo)
-> ((Text -> Const (First Text) Text)
    -> SourceCache -> Const (First Text) SourceCache)
-> Getting (First Text) DappInfo Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, ByteString)] -> Const (First Text) [(Text, ByteString)])
-> SourceCache -> Const (First Text) SourceCache
Lens' SourceCache [(Text, ByteString)]
sourceFiles (([(Text, ByteString)] -> Const (First Text) [(Text, ByteString)])
 -> SourceCache -> Const (First Text) SourceCache)
-> ((Text -> Const (First Text) Text)
    -> [(Text, ByteString)] -> Const (First Text) [(Text, ByteString)])
-> (Text -> Const (First Text) Text)
-> SourceCache
-> Const (First Text) SourceCache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index [(Text, ByteString)]
-> Traversal' [(Text, ByteString)] (IxValue [(Text, ByteString)])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (SrcMap -> Int
srcMapFile SrcMap
sm) (((Text, ByteString) -> Const (First Text) (Text, ByteString))
 -> [(Text, ByteString)] -> Const (First Text) [(Text, ByteString)])
-> ((Text -> Const (First Text) Text)
    -> (Text, ByteString) -> Const (First Text) (Text, ByteString))
-> (Text -> Const (First Text) Text)
-> [(Text, ByteString)]
-> Const (First Text) [(Text, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> (Text, ByteString) -> Const (First Text) (Text, ByteString)
forall s t a b. Field1 s t a b => Lens s t a b
_1) DappInfo
dapp'
            lineNo :: Maybe Int
            lineNo :: Maybe Int
lineNo = Maybe Int -> (Int -> Maybe Int) -> Maybe Int -> Maybe Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Int
forall a. Maybe a
Nothing (\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))
              ((Text, Int) -> Int
forall a b. (a, b) -> b
snd ((Text, Int) -> Int) -> Maybe (Text, Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                (SourceCache -> SrcMap -> Maybe (Text, Int)
srcMapCodePos
                 (Getting SourceCache DappInfo SourceCache -> DappInfo -> SourceCache
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SourceCache DappInfo SourceCache
Lens' DappInfo SourceCache
dappSources DappInfo
dapp')
                 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]
++ Maybe Int -> String
forall a. Show a => a -> String
show Maybe Int
lineNo)

                  -- Show the AST node type if present
                  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
"?"
                                    ((Getting (SrcMap -> Maybe Value) DappInfo (SrcMap -> Maybe Value)
-> DappInfo -> SrcMap -> Maybe Value
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (SrcMap -> Maybe Value) DappInfo (SrcMap -> Maybe Value)
Lens' DappInfo (SrcMap -> Maybe Value)
dappAstSrcMap DappInfo
dapp') SrcMap
sm
                                       Maybe Value -> (Value -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"name" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive 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 :: 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
c <- RenderM n Context
forall n. RenderM n Context
getContext
    if Getting Int Context Int -> Context -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Context Int
Lens' Context Int
availHeightL Context
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 :: (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 = AttrName
"selected"
dimAttr :: AttrName; dimAttr :: AttrName
dimAttr = AttrName
"dim"
wordAttr :: AttrName; wordAttr :: AttrName
wordAttr = AttrName
"word"
boldAttr :: AttrName; boldAttr :: AttrName
boldAttr = AttrName
"bold"
activeAttr :: AttrName; activeAttr :: AttrName
activeAttr = AttrName
"active"