{-# 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.Expr (simplify)
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, prettyIfConcreteWord, formatExpr)
import EVM.Hexdump (prettyHex)
import EVM.SMT (SolverGroup)
import EVM.Op
import EVM.Solidity hiding (storageLayout)
import EVM.Types hiding (padRight)
import EVM.UnitTest
import EVM.StorageLayout
import Text.Wrap

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

import EVM.Fetch (Fetcher)

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

import Data.Aeson.Lens
import Data.ByteString (ByteString)
import Data.Maybe (isJust, fromJust, fromMaybe, isNothing)
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 qualified Data.ByteString as BS
import qualified Data.Text as T
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
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
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
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
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 :: forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
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".

  forall a.
ProgramView Action a -> StateT UiVmState IO (Continuation a)
eval forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (instr :: * -> *) a. Program instr a -> ProgramView instr a
Operational.view
  where
    eval
      :: Operational.ProgramView Stepper.Action a
      -> StateT UiVmState IO (Continuation a)

    eval :: forall a.
ProgramView Action a -> StateT UiVmState IO (Continuation a)
eval (Operational.Return a
x) =
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (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?
          forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM (Maybe VMResult)
result) 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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' UiVmState VM
uiVm
              forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (b -> ProgramT Action Identity a
k VM
vm)
            Maybe VMResult
Nothing -> do
              -- No, keep performing the current action
              forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
keepExecuting StepMode
mode (Stepper VM
Stepper.run forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
k)

        -- Stepper wants to keep executing?
        Action b
Stepper.Exec -> do
          -- Have we reached the final result of this action?
          forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM (Maybe VMResult)
result) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just VMResult
r ->
              -- Yes, proceed with the next action.
              forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (b -> ProgramT Action Identity a
k VMResult
r)
            Maybe VMResult
Nothing -> do
              -- No, keep performing the current action
              forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
keepExecuting StepMode
mode (Stepper VMResult
Stepper.exec forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
k)

        -- Stepper is waiting for user input from a query
        Stepper.Ask (PleaseChoosePath Expr 'EWord
_ Bool -> EVM ()
cont) -> do
          -- ensure we aren't stepping past max iterations
          VM
vm <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' UiVmState VM
uiVm
          case VM -> Maybe Integer -> Maybe Bool
maxIterationsReached VM
vm ?maxIter::Maybe Integer
?maxIter of
            Maybe Bool
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Stepper a -> Continuation a
Continue (b -> ProgramT Action Identity a
k ())
            Just Bool
n -> forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (forall a. EVM a -> Stepper a
Stepper.evm (Bool -> EVM ()
cont (Bool -> Bool
not Bool
n)) 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.Wait Query
q -> do
          do EVM b
m <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (?fetcher::Query -> IO (EVM b)
?fetcher Query
q)
             forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (forall a. EVM a -> Stepper a
Stepper.evm EVM b
m 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
          forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom Lens' UiVmState VM
uiVm (forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT VM IO b
q)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode 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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' UiVmState VM
uiVm
          let (b
r, VM
vm1) = forall s a. State s a -> s -> (a, s)
runState EVM b
m VM
vm
          forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' UiVmState VM
uiVm VM
vm1
          forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (Stepper VMResult
Stepper.exec forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (b -> ProgramT Action Identity a
k b
r))

keepExecuting :: (?fetcher :: Fetcher
              ,   ?maxIter :: Maybe Integer)
              => StepMode
              -> Stepper a
              -> StateT UiVmState IO (Continuation a)
keepExecuting :: forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
keepExecuting StepMode
mode Stepper a
restart = case StepMode
mode of
  Step Int
0 -> do
    -- 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.
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Stepper a -> Continuation a
Continue Stepper a
restart)

  Step Int
i -> do
    -- Run one instruction and recurse
    forall a. Stepper a -> StateT UiVmState IO ()
stepOneOpcode Stepper a
restart
    forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret (Int -> StepMode
Step (Int
i forall a. Num a => a -> a -> a
- Int
1)) Stepper a
restart

  StepUntil Pred VM
p -> do
    VM
vm <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' UiVmState VM
uiVm
    if Pred VM
p VM
vm
      then
        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
        forall a. Stepper a -> StateT UiVmState IO ()
stepOneOpcode Stepper a
restart
        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 =
  forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
name (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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
  forall (m :: * -> *) a. Monad m => a -> m a
return Vty
vty

runFromVM :: SolverGroup -> Fetch.RpcInfo -> Maybe Integer -> DappInfo -> VM -> IO VM
runFromVM :: SolverGroup -> RpcInfo -> Maybe Integer -> DappInfo -> VM -> IO VM
runFromVM SolverGroup
solvers RpcInfo
rpcInfo Maybe Integer
maxIter' DappInfo
dappinfo VM
vm = do

  let
    opts :: UnitTestOptions
opts = UnitTestOptions
      { solvers :: SolverGroup
solvers       = SolverGroup
solvers
      , rpcInfo :: RpcInfo
rpcInfo       = RpcInfo
rpcInfo
      , verbose :: Maybe Int
verbose       = forall a. Maybe a
Nothing
      , maxIter :: Maybe Integer
maxIter       = Maybe Integer
maxIter'
      , askSmtIters :: Maybe Integer
askSmtIters   = forall a. Maybe a
Nothing
      , smtTimeout :: Maybe Natural
smtTimeout    = forall a. Maybe a
Nothing
      , smtDebug :: Bool
smtDebug      = Bool
False
      , solver :: Maybe Text
solver        = forall a. Maybe a
Nothing
      , maxDepth :: Maybe Int
maxDepth      = forall a. Maybe a
Nothing
      , match :: Text
match         = Text
""
      , fuzzRuns :: Int
fuzzRuns      = Int
1
      , replay :: Maybe (Text, ByteString)
replay        = forall a. HasCallStack => String -> a
error String
"irrelevant"
      , vmModifier :: VM -> VM
vmModifier    = forall a. a -> a
id
      , testParams :: TestVMParams
testParams    = forall a. HasCallStack => String -> a
error String
"irrelevant"
      , dapp :: DappInfo
dapp          = DappInfo
dappinfo
      , ffiAllowed :: Bool
ffiAllowed    = Bool
False
      , covMatch :: Maybe Text
covMatch       = forall a. Maybe a
Nothing
      }
    ui0 :: UiVmState
ui0 = VM -> UnitTestOptions -> Stepper () -> UiVmState
initUiVmState VM
vm UnitTestOptions
opts (forall (f :: * -> *) a. Functor f => f a -> f ()
void Stepper (Either Error (Expr 'Buf))
Stepper.execFully)

  Vty
v <- IO Vty
mkVty
  UiState
ui2 <- 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 forall a. Maybe a
Nothing (UnitTestOptions -> App UiState () Name
app UnitTestOptions
opts) (UiVmState -> UiState
ViewVm UiVmState
ui0)
  case UiState
ui2 of
    ViewVm UiVmState
ui -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState VM
uiVm UiVmState
ui)
    UiState
_ -> 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
    { _uiVm :: VM
_uiVm           = VM
vm0
    , _uiStepper :: Stepper ()
_uiStepper      = Stepper ()
script
    , _uiStep :: Int
_uiStep         = Int
0
    , _uiSnapshots :: Map Int (VM, Stepper ())
_uiSnapshots    = 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 Natural
Maybe (Text, ByteString)
RpcInfo
Maybe Text
Text
SolverGroup
DappInfo
TestVMParams
VM -> VM
ffiAllowed :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
covMatch :: Maybe Text
solver :: Maybe Text
smtTimeout :: Maybe Natural
maxDepth :: Maybe Int
smtDebug :: Bool
askSmtIters :: Maybe Integer
maxIter :: Maybe Integer
verbose :: Maybe Int
solvers :: SolverGroup
rpcInfo :: RpcInfo
covMatch :: UnitTestOptions -> Maybe Text
ffiAllowed :: 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
smtDebug :: UnitTestOptions -> Bool
smtTimeout :: UnitTestOptions -> Maybe Natural
askSmtIters :: UnitTestOptions -> Maybe Integer
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
rpcInfo :: UnitTestOptions -> RpcInfo
solvers :: UnitTestOptions -> SolverGroup
..} (Text
contractname, [(Test, [AbiType])]
tests) = case Maybe (Text, ByteString)
replay of
  Maybe (Text, ByteString)
Nothing -> [(Text
contractname, Test -> Text
extractSig forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (Test, [AbiType])
x) | (Test, [AbiType])
x <- [(Test, [AbiType])]
tests, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Test, [AbiType]) -> Bool
isFuzzTest (Test, [AbiType])
x]
  Just (Text
sig, ByteString
_) -> [(Text
contractname, Test -> Text
extractSig forall a b. (a -> b) -> a -> b
$ 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 (forall a b. (a, b) -> a
fst (Test, [AbiType])
x) 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    \case
      Maybe (Map Text SolcContract, SourceCache)
Nothing ->
        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 forall a b. (a -> b) -> a -> b
$ UiTestPickerState
            { _testPickerList :: List Name (Text, Text)
_testPickerList =
                forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list
                  Name
TestPickerPane
                  (forall a. [a] -> Vector a
Vec.fromList
                   (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                    (UnitTestOptions -> (Text, [(Test, [AbiType])]) -> [(Text, Text)]
debuggableTests UnitTestOptions
opts)
                    (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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
_ <- 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 forall a. Maybe a
Nothing (UnitTestOptions -> App UiState () Name
app UnitTestOptions
opts) (UiState
ui :: UiState)
        forall (m :: * -> *) a. Monad m => a -> m a
return ()

takeStep
  :: (?fetcher :: Fetcher
     ,?maxIter :: Maybe Integer)
  => UiVmState
  -> StepMode
  -> EventM n UiState ()
takeStep :: forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
ui StepMode
mode =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Continuation (), UiVmState)
nxt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (Stopped (), UiVmState
_) ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    (Continue Stepper ()
steps, UiVmState
ui') ->
      forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
ViewVm (UiVmState
ui' forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' UiVmState (Stepper ())
uiStepper Stepper ()
steps))
  where
    m :: StateT UiVmState IO (Continuation ())
m = forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState (Stepper ())
uiStepper UiVmState
ui)
    nxt :: IO (Continuation (), UiVmState)
nxt = forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT UiVmState IO (Continuation ())
m UiVmState
ui

backstepUntil
  :: (?fetcher :: Fetcher
     ,?maxIter :: Maybe Integer)
  => (UiVmState -> Pred VM) -> EventM n UiState ()
backstepUntil :: forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
(UiVmState -> Pred VM) -> EventM n UiState ()
backstepUntil UiVmState -> Pred VM
p = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  ViewVm UiVmState
s ->
    case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState Int
uiStep UiVmState
s of
      Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Int
n -> do
        UiVmState
s1 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ (?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> IO UiVmState
backstep UiVmState
s
        let
          -- find a previous vm that satisfies the predicate
          snapshots' :: Map Int (VM, Stepper ())
snapshots' = forall a k. (a -> Bool) -> Map k a -> Map k a
Data.Map.filter (UiVmState -> Pred VM
p UiVmState
s1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState (Map Int (VM, Stepper ()))
uiSnapshots UiVmState
s1)
        case 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')) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => k -> Map k v -> Maybe (k, v)
lookupLT (Int
n forall a. Num a => a -> a -> a
- Int
1) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState (Map Int (VM, Stepper ()))
uiSnapshots UiVmState
s)
              s2 :: UiVmState
s2 = UiVmState
s1
                forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' UiVmState VM
uiVm VM
vm'
                forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM Cache
cache) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM Cache
cache) UiVmState
s1)
                forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' UiVmState Int
uiStep Int
step'
                forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' UiVmState (Stepper ())
uiStepper Stepper ()
stepper'
            in forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n 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
                forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' UiVmState VM
uiVm VM
vm'
                forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM Cache
cache) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM Cache
cache) UiVmState
s1)
                forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' UiVmState Int
uiStep Int
step'
                forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' UiVmState (Stepper ())
uiStepper Stepper ()
stepper'
            in forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s2 (Pred VM -> StepMode
StepUntil (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. UiVmState -> Pred VM
p UiVmState
s1))
  UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

backstep
  :: (?fetcher :: Fetcher
     ,?maxIter :: Maybe Integer)
  => UiVmState -> IO UiVmState
backstep :: (?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> IO UiVmState
backstep UiVmState
s =
  case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState Int
uiStep UiVmState
s of
    -- We're already at the first step; ignore command.
    Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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)) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => k -> Map k v -> Maybe (k, v)
lookupLT Int
n (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState (Map Int (VM, Stepper ()))
uiSnapshots UiVmState
s)
        s1 :: UiVmState
s1 = UiVmState
s
          forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' UiVmState VM
uiVm VM
vm
          forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM Cache
cache) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM Cache
cache) UiVmState
s)
          forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' UiVmState Int
uiStep Int
step
          forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' UiVmState (Stepper ())
uiStepper Stepper ()
stepper
        stepsToTake :: Int
stepsToTake = Int
n forall a. Num a => a -> a -> a
- Int
step forall a. Num a => a -> a -> a
- Int
1

      in
        forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          (Continue Stepper ()
steps, UiVmState
ui') -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ UiVmState
ui' forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' UiVmState (Stepper ())
uiStepper Stepper ()
steps
          (Continuation (), UiVmState)
_ -> forall a. HasCallStack => String -> a
error String
"unexpected end"

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

-- Contracts: Down - list down
appEvent :: forall e.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
BrickEvent Name e -> EventM Name UiState ()
appEvent (VtyEvent e :: Event
e@(V.EvKey Key
V.KDown [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  ViewContracts UiBrowserState
_s -> do
    forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom
      (Prism' UiState UiBrowserState
_ViewContracts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UiBrowserState (List Name (Addr, Contract))
browserContractList)
      (forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- Contracts: Up - list up
-- Page: Up - scroll
appEvent (VtyEvent e :: Event
e@(V.EvKey Key
V.KUp [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  ViewContracts UiBrowserState
_s -> do
    forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom
      (Prism' UiState UiBrowserState
_ViewContracts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UiBrowserState (List Name (Addr, Contract))
browserContractList)
      (forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e)
  UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- Vm Overview: Esc - return to test picker or exit
-- Any: Esc - return to Vm Overview or Exit
appEvent (VtyEvent (V.EvKey Key
V.KEsc [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  ViewVm UiVmState
s -> do
    let opts :: UnitTestOptions
opts = UiVmState
s forall s a. s -> Getting a s a -> a
^. Lens' UiVmState UnitTestOptions
uiTestOpts
        dapp' :: DappInfo
dapp' = UnitTestOptions -> DappInfo
dapp UnitTestOptions
opts
        tests :: [(Text, Text)]
tests = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (UnitTestOptions -> (Text, [(Test, [AbiType])]) -> [(Text, Text)]
debuggableTests UnitTestOptions
opts) (DappInfo
dapp' forall s a. s -> Getting a s a -> a
^. Lens' DappInfo [(Text, [(Test, [AbiType])])]
dappUnitTests)
    case [(Text, Text)]
tests of
      [] -> forall n s. EventM n s ()
halt
      [(Text, Text)]
ts ->
        forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ UiTestPickerState -> UiState
ViewPicker forall a b. (a -> b) -> a -> b
$ UiTestPickerState
          { _testPickerList :: List Name (Text, Text)
_testPickerList = forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Name
TestPickerPane (forall a. [a] -> Vector a
Vec.fromList [(Text, Text)]
ts) Int
1
          , _testPickerDapp :: DappInfo
_testPickerDapp = DappInfo
dapp'
          , _testOpts :: UnitTestOptions
_testOpts = UnitTestOptions
opts
          }
  ViewHelp UiVmState
s -> forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
ViewVm UiVmState
s)
  ViewContracts UiBrowserState
s -> forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
ViewVm forall a b. (a -> b) -> a -> b
$ UiBrowserState
s forall s a. s -> Getting a s a -> a
^. Lens' UiBrowserState UiVmState
browserVm)
  UiState
_ -> forall n s. EventM n s ()
halt

-- Vm Overview: Enter - open contracts view
-- UnitTest Picker: Enter - select from list
appEvent (VtyEvent (V.EvKey Key
V.KEnter [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  ViewVm UiVmState
s ->
    forall s (m :: * -> *). MonadState s m => s -> m ()
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. UiBrowserState -> UiState
ViewContracts forall a b. (a -> b) -> a -> b
$ UiBrowserState
      { _browserContractList :: List Name (Addr, Contract)
_browserContractList =
          forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list
            Name
BrowserPane
            (forall a. [a] -> Vector a
Vec.fromList (forall k a. Map k a -> [(k, a)]
Map.toList (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts) UiVmState
s)))
            Int
2
      , _browserVm :: UiVmState
_browserVm = UiVmState
s
      }
  ViewPicker UiTestPickerState
s ->
    case forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiTestPickerState (List Name (Text, Text))
testPickerList UiTestPickerState
s) of
      Maybe (Int, (Text, Text))
Nothing -> forall a. HasCallStack => String -> a
error String
"nothing selected"
      Just (Int
_, (Text, Text)
x) -> do
        let initVm :: UiVmState
initVm  = UnitTestOptions -> (Text, Text) -> UiVmState
initialUiVmStateForTest (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiTestPickerState UnitTestOptions
testOpts UiTestPickerState
s) (Text, Text)
x
        forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
ViewVm UiVmState
initVm)
  UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- Vm Overview: m - toggle memory pane
appEvent (VtyEvent (V.EvKey (V.KChar Char
'm') [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  ViewVm UiVmState
s -> forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
ViewVm forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' UiVmState Bool
uiShowMemory Bool -> Bool
not UiVmState
s)
  UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- Vm Overview: h - open help view
appEvent (VtyEvent (V.EvKey (V.KChar Char
'h') [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  ViewVm UiVmState
s -> forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
ViewHelp UiVmState
s)
  UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- Vm Overview: spacebar - read input
appEvent (VtyEvent (V.EvKey (V.KChar Char
' ') [])) =
  let
    loop :: InputT IO ()
loop = do
      forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
Readline.getInputLine String
"% " forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just String
hey -> forall (m :: * -> *). MonadIO m => String -> InputT m ()
Readline.outputStrLn String
hey
        Maybe String
Nothing  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
Readline.getInputLine String
"% " forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just String
hey' -> forall (m :: * -> *). MonadIO m => String -> InputT m ()
Readline.outputStrLn String
hey'
        Maybe String
Nothing   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
   in do
    UiState
s <- forall s (m :: * -> *). MonadState s m => m s
get
    forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume forall a b. (a -> b) -> a -> b
$ do
      forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
Readline.runInputT forall (m :: * -> *). MonadIO m => Settings m
Readline.defaultSettings InputT IO ()
loop
      forall (f :: * -> *) a. Applicative f => a -> f a
pure UiState
s

-- todo refactor to zipper step forward
-- Vm Overview: n - step
appEvent (VtyEvent (V.EvKey (V.KChar Char
'n') [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  ViewVm UiVmState
s ->
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing (UiVmState
s forall s a. s -> Getting a s a -> a
^. Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM (Maybe VMResult)
result)) forall a b. (a -> b) -> a -> b
$
      forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s (Int -> StepMode
Step Int
1)
  UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- Vm Overview: N - step
appEvent (VtyEvent (V.EvKey (V.KChar Char
'N') [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  ViewVm UiVmState
s ->
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing (UiVmState
s forall s a. s -> Getting a s a -> a
^. Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM (Maybe VMResult)
result)) forall a b. (a -> b) -> a -> b
$
      forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s (Pred VM -> StepMode
StepUntil (UiVmState -> Pred VM
isNextSourcePosition UiVmState
s))
  UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- Vm Overview: C-n - step
appEvent (VtyEvent (V.EvKey (V.KChar Char
'n') [Modifier
V.MCtrl])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  ViewVm UiVmState
s ->
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing (UiVmState
s forall s a. s -> Getting a s a -> a
^. Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM (Maybe VMResult)
result)) forall a b. (a -> b) -> a -> b
$
      forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s (Pred VM -> StepMode
StepUntil (UiVmState -> Pred VM
isNextSourcePositionWithoutEntering UiVmState
s))
  UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- Vm Overview: e - step
appEvent (VtyEvent (V.EvKey (V.KChar Char
'e') [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  ViewVm UiVmState
s ->
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing (UiVmState
s forall s a. s -> Getting a s a -> a
^. Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM (Maybe VMResult)
result)) forall a b. (a -> b) -> a -> b
$
      forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s (Pred VM -> StepMode
StepUntil (UiVmState -> Pred VM
isExecutionHalted UiVmState
s))
  UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- Vm Overview: a - step
appEvent (VtyEvent (V.EvKey (V.KChar Char
'a') [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  ViewVm UiVmState
s ->
    -- We keep the current cache so we don't have to redo
    -- any blocking queries.
    let
      (VM
vm, Stepper ()
stepper) = forall a. HasCallStack => Maybe a -> a
fromJust (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
0 (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState (Map Int (VM, Stepper ()))
uiSnapshots UiVmState
s))
      s' :: UiVmState
s' = UiVmState
s
        forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' UiVmState VM
uiVm VM
vm
        forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM Cache
cache) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM Cache
cache) UiVmState
s)
        forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' UiVmState Int
uiStep Int
0
        forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' UiVmState (Stepper ())
uiStepper Stepper ()
stepper

    in forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s' (Int -> StepMode
Step Int
0)
  UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- Vm Overview: p - backstep
appEvent (VtyEvent (V.EvKey (V.KChar Char
'p') [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  ViewVm UiVmState
s ->
    case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState Int
uiStep UiVmState
s of
      Int
0 ->
        -- We're already at the first step; ignore command.
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      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)) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => k -> Map k v -> Maybe (k, v)
lookupLT Int
n (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState (Map Int (VM, Stepper ()))
uiSnapshots UiVmState
s)
          s1 :: UiVmState
s1 = UiVmState
s
            forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' UiVmState VM
uiVm VM
vm -- set the vm to the one from the snapshot
            forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM Cache
cache) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM Cache
cache) UiVmState
s) -- persist the cache
            forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' UiVmState Int
uiStep Int
step
            forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' UiVmState (Stepper ())
uiStepper Stepper ()
stepper
          stepsToTake :: Int
stepsToTake = Int
n forall a. Num a => a -> a -> a
- Int
step forall a. Num a => a -> a -> a
- Int
1

        forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s1 (Int -> StepMode
Step Int
stepsToTake)
  UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

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

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

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

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

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

-- UnitTest Picker: (main) - render list
appEvent (VtyEvent Event
e) = do
  forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom
    (Prism' UiState UiTestPickerState
_ViewPicker forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UiTestPickerState (List Name (Text, Text))
testPickerList)
    (forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e)

-- Default
appEvent BrickEvent Name e
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

app :: UnitTestOptions -> App UiState () Name
app :: UnitTestOptions -> App UiState () Name
app UnitTestOptions{Bool
Int
Maybe Int
Maybe Integer
Maybe Natural
Maybe (Text, ByteString)
RpcInfo
Maybe Text
Text
SolverGroup
DappInfo
TestVMParams
VM -> VM
ffiAllowed :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
covMatch :: Maybe Text
solver :: Maybe Text
smtTimeout :: Maybe Natural
maxDepth :: Maybe Int
smtDebug :: Bool
askSmtIters :: Maybe Integer
maxIter :: Maybe Integer
verbose :: Maybe Int
solvers :: SolverGroup
rpcInfo :: RpcInfo
covMatch :: UnitTestOptions -> Maybe Text
ffiAllowed :: 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
smtDebug :: UnitTestOptions -> Bool
smtTimeout :: UnitTestOptions -> Maybe Natural
askSmtIters :: UnitTestOptions -> Maybe Integer
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
rpcInfo :: UnitTestOptions -> RpcInfo
solvers :: UnitTestOptions -> SolverGroup
..} =
  let ?fetcher = SolverGroup -> RpcInfo -> Fetcher
Fetch.oracle SolverGroup
solvers RpcInfo
rpcInfo
      ?maxIter = Maybe Integer
maxIter
  in App
  { appDraw :: UiState -> [Widget Name]
appDraw = UiState -> [Widget Name]
drawUi
  , appChooseCursor :: UiState -> [CursorLocation Name] -> Maybe (CursorLocation Name)
appChooseCursor = forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
neverShowCursor
  , appHandleEvent :: BrickEvent Name () -> EventM Name UiState ()
appHandleEvent = forall e.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
BrickEvent Name e -> EventM Name UiState ()
appEvent
  , appStartEvent :: EventM Name UiState ()
appStartEvent = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , appAttrMap :: UiState -> AttrMap
appAttrMap = forall a b. a -> b -> a
const (Attr -> [(AttrName, Attr)] -> AttrMap
attrMap Attr
V.defAttr [(AttrName, Attr)]
myTheme)
  }

initialUiVmStateForTest
  :: UnitTestOptions
  -> (Text, Text)
  -> UiVmState
initialUiVmStateForTest :: UnitTestOptions -> (Text, Text) -> UiVmState
initialUiVmStateForTest opts :: UnitTestOptions
opts@UnitTestOptions{Bool
Int
Maybe Int
Maybe Integer
Maybe Natural
Maybe (Text, ByteString)
RpcInfo
Maybe Text
Text
SolverGroup
DappInfo
TestVMParams
VM -> VM
ffiAllowed :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
covMatch :: Maybe Text
solver :: Maybe Text
smtTimeout :: Maybe Natural
maxDepth :: Maybe Int
smtDebug :: Bool
askSmtIters :: Maybe Integer
maxIter :: Maybe Integer
verbose :: Maybe Int
solvers :: SolverGroup
rpcInfo :: RpcInfo
covMatch :: UnitTestOptions -> Maybe Text
ffiAllowed :: 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
smtDebug :: UnitTestOptions -> Bool
smtTimeout :: UnitTestOptions -> Maybe Natural
askSmtIters :: UnitTestOptions -> Maybe Integer
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
rpcInfo :: UnitTestOptions -> RpcInfo
solvers :: UnitTestOptions -> SolverGroup
..} (Text
theContractName, Text
theTestName) = VM -> UnitTestOptions -> Stepper () -> UiVmState
initUiVmState VM
vm0 UnitTestOptions
opts Stepper ()
script
  where
    cd :: (Expr 'Buf, [Prop])
cd = case Test
test of
      SymbolicTest Text
_ -> Text -> [AbiType] -> [String] -> Expr 'Buf -> (Expr 'Buf, [Prop])
symCalldata Text
theTestName [AbiType]
types [] (Text -> Expr 'Buf
AbstractBuf Text
"txdata")
      Test
_ -> (forall a. HasCallStack => String -> a
error String
"unreachable", forall a. HasCallStack => String -> a
error String
"unreachable")
    (Test
test, [AbiType]
types) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Test
test',[AbiType]
_) -> Test -> Text
extractSig Test
test' forall a. Eq a => a -> a -> Bool
== Text
theTestName) forall a b. (a -> b) -> a -> b
$ SolcContract -> [(Test, [AbiType])]
unitTestMethods SolcContract
testContract
    testContract :: SolcContract
testContract = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' DappInfo (Map Text SolcContract)
dappSolcByName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
theContractName) DappInfo
dapp
    vm0 :: VM
vm0 =
      UnitTestOptions -> SolcContract -> VM
initialUnitTestVm UnitTestOptions
opts SolcContract
testContract
    script :: Stepper ()
script = do
      forall a. EVM a -> Stepper a
Stepper.evm forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceData -> EVM ()
pushTrace forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TraceData
EntryTrace forall a b. (a -> b) -> a -> b
$
        Text
"test " forall a. Semigroup a => a -> a -> a
<> Text
theTestName forall a. Semigroup a => a -> a -> a
<> Text
" (" forall a. Semigroup a => a -> a -> a
<> Text
theContractName 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 forall a. Eq a => a -> a -> Bool
== Text
sig
                         then AbiType -> ByteString -> AbiValue
decodeAbiValue (Vector AbiType -> AbiType
AbiTupleType (forall a. [a] -> Vector a
Vec.fromList [AbiType]
types)) ByteString
callData
                         else AbiValue
emptyAbi
          forall (f :: * -> *) a. Functor f => f a -> f ()
void (UnitTestOptions -> Text -> AbiValue -> Stepper Bool
runUnitTest UnitTestOptions
opts Text
theTestName AbiValue
args)
        SymbolicTest Text
_ -> do
          forall (f :: * -> *) a. Functor f => f a -> f ()
void (UnitTestOptions
-> Text -> (Expr 'Buf, [Prop]) -> Stepper (Expr 'End)
execSymTest UnitTestOptions
opts Text
theTestName (Expr 'Buf, [Prop])
cd)
        InvariantTest Text
_ -> do
          [Addr]
targets <- UnitTestOptions -> Stepper [Addr]
getTargetContracts UnitTestOptions
opts
          let randomRun :: Stepper (Bool, RLP)
randomRun = UnitTestOptions
-> Text -> [ExploreTx] -> [Addr] -> Int -> Stepper (Bool, RLP)
initialExplorationStepper UnitTestOptions
opts Text
theTestName [] [Addr]
targets (forall a. a -> Maybe a -> a
fromMaybe Int
20 Maybe Int
maxDepth)
          forall (f :: * -> *) a. Functor f => f a -> f ()
void 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 forall a. Eq a => a -> a -> Bool
== Text
sig
              then UnitTestOptions
-> Text -> [ExploreTx] -> [Addr] -> Int -> Stepper (Bool, RLP)
initialExplorationStepper UnitTestOptions
opts Text
theTestName (ByteString -> [ExploreTx]
decodeCalls ByteString
cd') [Addr]
targets (forall (t :: * -> *) a. Foldable t => t a -> Int
length (ByteString -> [ExploreTx]
decodeCalls ByteString
cd'))
              else Stepper (Bool, RLP)
randomRun

myTheme :: [(AttrName, V.Attr)]
myTheme :: [(AttrName, Attr)]
myTheme =
  [ (AttrName
selectedAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.standout)
  , (AttrName
dimAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.dim)
  , (AttrName
borderAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.dim)
  , (AttrName
wordAttr, Color -> Attr
fg Color
V.yellow)
  , (AttrName
boldAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.bold)
  , (AttrName
activeAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.standout)
  ]

drawUi :: UiState -> [UiWidget]
drawUi :: UiState -> [Widget Name]
drawUi (ViewVm UiVmState
s) = UiVmState -> [Widget Name]
drawVm UiVmState
s
drawUi (ViewPicker UiTestPickerState
s) = UiTestPickerState -> [Widget Name]
drawTestPicker UiTestPickerState
s
drawUi (ViewContracts UiBrowserState
s) = UiBrowserState -> [Widget Name]
drawVmBrowser UiBrowserState
s
drawUi (ViewHelp UiVmState
_) = [Widget Name]
drawHelpView

drawHelpView :: [UiWidget]
drawHelpView :: [Widget Name]
drawHelpView =
    [ forall n. Widget n -> Widget n
center forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Widget n -> Widget n -> Widget n
borderWithLabel forall {n}. Widget n
version forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall n. Int -> Widget n -> Widget n
padLeftRight Int
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Int -> Widget n -> Widget n
padTopBottom Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$
        String
"Esc    Exit the debugger\n\n" forall a. Semigroup a => a -> a -> a
<>
        String
"a      Step to start\n" forall a. Semigroup a => a -> a -> a
<>
        String
"e      Step to end\n" forall a. Semigroup a => a -> a -> a
<>
        String
"n      Step fwds by one instruction\n" forall a. Semigroup a => a -> a -> a
<>
        String
"N      Step fwds to the next source position\n" forall a. Semigroup a => a -> a -> a
<>
        String
"C-n    Step fwds to the next source position skipping CALL & CREATE\n" forall a. Semigroup a => a -> a -> a
<>
        String
"p      Step back by one instruction\n\n" forall a. Semigroup a => a -> a -> a
<>
        String
"P      Step back to the previous source position\n\n" forall a. Semigroup a => a -> a -> a
<>
        String
"C-p    Step back to the previous source position skipping CALL & CREATE\n\n" forall a. Semigroup a => a -> a -> a
<>
        String
"m      Toggle memory pane\n" forall a. Semigroup a => a -> a -> a
<>
        String
"0      Choose the branch which does not jump \n" forall a. Semigroup a => a -> a -> a
<>
        String
"1      Choose the branch which does jump \n" forall a. Semigroup a => a -> a -> a
<>
        String
"Down   Step to next entry in the callstack / Scroll memory pane\n" forall a. Semigroup a => a -> a -> a
<>
        String
"Up     Step to previous entry in the callstack / Scroll memory pane\n" forall a. Semigroup a => a -> a -> a
<>
        String
"C-f    Page memory pane fwds\n" forall a. Semigroup a => a -> a -> a
<>
        String
"C-b    Page memory pane back\n\n" forall a. Semigroup a => a -> a -> a
<>
        String
"Enter  Contracts browser"
    ]
    where
      version :: Widget n
version =
        forall n. Text -> Widget n
txt Text
"Hevm " forall n. Widget n -> Widget n -> Widget n
<+>
        forall n. String -> Widget n
str (Version -> String
showVersion Version
Paths.version) forall n. Widget n -> Widget n -> Widget n
<+>
        forall n. Text -> Widget n
txt Text
" - Key bindings"

drawTestPicker :: UiTestPickerState -> [UiWidget]
drawTestPicker :: UiTestPickerState -> [Widget Name]
drawTestPicker UiTestPickerState
ui =
  [ forall n. Widget n -> Widget n
center forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Widget n -> Widget n -> Widget n
borderWithLabel (forall n. Text -> Widget n
txt Text
"Unit tests") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall n. Int -> Widget n -> Widget n
hLimit Int
80 forall a b. (a -> b) -> a -> b
$
        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) ->
             forall n. Bool -> Widget n -> Widget n
withHighlight Bool
selected forall a b. (a -> b) -> a -> b
$
               forall n. Text -> Widget n
txt Text
" Debug " forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt (Text -> Text
contractNamePart Text
x) forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt Text
"::" forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt Text
y)
          Bool
True
          (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiTestPickerState (List Name (Text, Text))
testPickerList UiTestPickerState
ui)
  ]

drawVmBrowser :: UiBrowserState -> [UiWidget]
drawVmBrowser :: UiBrowserState -> [Widget Name]
drawVmBrowser UiBrowserState
ui =
  [ forall n. [Widget n] -> Widget n
hBox
      [ forall n. Widget n -> Widget n -> Widget n
borderWithLabel (forall n. Text -> Widget n
txt Text
"Contracts") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          forall n. Int -> Widget n -> Widget n
hLimit Int
60 forall a b. (a -> b) -> a -> b
$
            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') ->
                 forall n. Bool -> Widget n -> Widget n
withHighlight Bool
selected forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
                   [ forall a. a -> Maybe a -> a
fromMaybe Text
"<unknown contract>" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview DappInfo
dapp' forall a b. (a -> b) -> a -> b
$
                       ( Lens' DappInfo (Map W256 (CodeType, SolcContract))
dappSolcByHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (forall {t}. Contract -> t
maybeHash Contract
c')
                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SolcContract Text
contractName )
                   , Text
"\n"
                   , Text
"  ", String -> Text
pack (forall a. Show a => a -> String
show Addr
k)
                   ])
              Bool
True
              (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiBrowserState (List Name (Addr, Contract))
browserContractList UiBrowserState
ui)
      , case forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview DappInfo
dapp' (Lens' DappInfo (Map W256 (CodeType, SolcContract))
dappSolcByHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (forall {t}. Contract -> t
maybeHash Contract
c) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2) of
          Maybe SolcContract
Nothing ->
            forall n. [Widget n] -> Widget n
hBox
              [ forall n. Widget n -> Widget n -> Widget n
borderWithLabel (forall n. Text -> Widget n
txt Text
"Contract information") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
vBox
                  [ forall n. Text -> Widget n
txt (Text
"Codehash: " forall a. Semigroup a => a -> a -> a
<>    String -> Text
pack (forall a. Show a => a -> String
show (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Contract (Expr 'EWord)
codehash Contract
c)))
                  , forall n. Text -> Widget n
txt (Text
"Nonce: "    forall a. Semigroup a => a -> a -> a
<> W256 -> Text
showWordExact (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Contract W256
nonce    Contract
c))
                  , forall n. Text -> Widget n
txt (Text
"Balance: "  forall a. Semigroup a => a -> a -> a
<> W256 -> Text
showWordExact (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Contract W256
balance  Contract
c))
                  --, txt ("Storage: "  <> storageDisplay (view storage c)) -- TODO: fix this
                  ]
                ]
          Just SolcContract
sol ->
            forall n. [Widget n] -> Widget n
hBox
              [ forall n. Widget n -> Widget n -> Widget n
borderWithLabel (forall n. Text -> Widget n
txt Text
"Contract information") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
2) forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
vBox
                  [ forall n. Text -> Widget n
txt Text
"Name: " forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt (Text -> Text
contractNamePart (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' SolcContract Text
contractName SolcContract
sol))
                  , forall n. Text -> Widget n
txt Text
"File: " forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt (Text -> Text
contractPathPart (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' SolcContract Text
contractName SolcContract
sol))
                  , forall n. Text -> Widget n
txt Text
" "
                  , forall n. Text -> Widget n
txt Text
"Constructor inputs:"
                  , forall n. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' SolcContract [(Text, AbiType)]
constructorInputs SolcContract
sol) forall a b. (a -> b) -> a -> b
$
                      \(Text
name, AbiType
abiType) -> forall n. Text -> Widget n
txt (Text
"  " forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> AbiType -> Text
abiTypeSolidity AbiType
abiType)
                  , forall n. Text -> Widget n
txt Text
"Public methods:"
                  , forall n. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map (forall a. Ord a => [a] -> [a]
sort (forall k a. Map k a -> [a]
Map.elems (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' SolcContract (Map Word32 Method)
abiMap SolcContract
sol))) forall a b. (a -> b) -> a -> b
$
                      \Method
method -> forall n. Text -> Widget n
txt (Text
"  " forall a. Semigroup a => a -> a -> a
<> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Method Text
methodSignature Method
method)
                  --, txt ("Storage:" <> storageDisplay (view storage c)) -- TODO: fix this
                  ]
              , forall n. Widget n -> Widget n -> Widget n
borderWithLabel (forall n. Text -> Widget n
txt Text
"Storage slots") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
vBox
                  (forall a b. (a -> b) -> [a] -> [b]
map forall n. Text -> Widget n
txt (DappInfo -> SolcContract -> [Text]
storageLayout DappInfo
dapp' SolcContract
sol))
              ]
      ]
  ]
  where
    dapp' :: DappInfo
dapp' = UnitTestOptions -> DappInfo
dapp (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' UiBrowserState UiVmState
browserVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UiVmState UnitTestOptions
uiTestOpts) UiBrowserState
ui)
    (Int
_, (Addr
_, Contract
c)) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiBrowserState (List Name (Addr, Contract))
browserContractList UiBrowserState
ui)
--        currentContract  = view (dappSolcByHash . ix ) dapp
    maybeHash :: Contract -> t
maybeHash Contract
ch = forall a. HasCallStack => Maybe a -> a
fromJust (forall a. HasCallStack => String -> a
error String
"Internal error: cannot find concrete codehash for partially symbolic code") (Expr 'EWord -> Maybe W256
maybeLitWord (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Contract (Expr 'EWord)
codehash Contract
ch))

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.
  [ forall n. Int -> Widget n -> Widget n -> Widget n
ifTallEnough (Int
20 forall a. Num a => a -> a -> a
* Int
4)
      ( forall n. [Widget n] -> Widget n
vBox
        [ forall n. Int -> Widget n -> Widget n
vLimit Int
20 forall a b. (a -> b) -> a -> b
$ UiVmState -> Widget Name
drawBytecodePane UiVmState
ui
        , forall n. Int -> Widget n -> Widget n
vLimit Int
20 forall a b. (a -> b) -> a -> b
$ UiVmState -> Widget Name
drawStackPane UiVmState
ui
        , UiVmState -> Widget Name
drawSolidityPane UiVmState
ui
        , forall n. Int -> Widget n -> Widget n
vLimit Int
20 forall a b. (a -> b) -> a -> b
$ UiVmState -> Widget Name
drawTracePane UiVmState
ui
        , forall n. Int -> Widget n -> Widget n
vLimit Int
2 Widget Name
drawHelpBar
        ]
      )
      ( forall n. [Widget n] -> Widget n
vBox
        [ forall n. [Widget n] -> Widget n
hBox
          [ forall n. Int -> Widget n -> Widget n
vLimit Int
20 forall a b. (a -> b) -> a -> b
$ UiVmState -> Widget Name
drawBytecodePane UiVmState
ui
          , forall n. Int -> Widget n -> Widget n
vLimit Int
20 forall a b. (a -> b) -> a -> b
$ UiVmState -> Widget Name
drawStackPane UiVmState
ui
          ]
        , forall n. [Widget n] -> Widget n
hBox
          [ UiVmState -> Widget Name
drawSolidityPane UiVmState
ui
          , UiVmState -> Widget Name
drawTracePane UiVmState
ui
          ]
        , forall n. Int -> Widget n -> Widget n
vLimit Int
2 Widget Name
drawHelpBar
        ]
      )
  ]

drawHelpBar :: UiWidget
drawHelpBar :: Widget Name
drawHelpBar = forall {n}. Widget n
hBorder forall n. Widget n -> Widget n -> Widget n
<=> forall n. Widget n -> Widget n
hCenter Widget Name
help
  where
    help :: Widget Name
help =
      forall n. [Widget n] -> Widget n
hBox (forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, Text
v) -> forall n. Text -> Widget n
txt Text
k forall n. Widget n -> Widget n -> Widget n
<+> forall n. Widget n -> Widget n
dim (forall n. Text -> Widget n
txt (Text
" (" forall a. Semigroup a => a -> a -> a
<> Text
v forall a. Semigroup a => a -> a -> a
<> Text
")  "))) [(Text, Text)]
helps)

    helps :: [(Text, Text)]
helps =
      [
        (Text
"n", Text
"step")
      , (Text
"p", Text
"step back")
      , (Text
"a", Text
"step to start")
      , (Text
"e", Text
"step to end")
      , (Text
"m", Text
"toggle memory")
      , (Text
"Esc", Text
"exit")
      , (Text
"h", Text
"more help")
      ]

stepOneOpcode :: Stepper a -> StateT UiVmState IO ()
stepOneOpcode :: forall a. Stepper a -> StateT UiVmState IO ()
stepOneOpcode Stepper a
restart = do
  Int
n <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' UiVmState Int
uiStep
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
n forall a. Integral a => a -> a -> a
`mod` Int
snapshotInterval forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$ do
    VM
vm <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' UiVmState VM
uiVm
    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying Lens' UiVmState (Map Int (VM, Stepper ()))
uiSnapshots (forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Int
n (VM
vm, forall (f :: * -> *) a. Functor f => f a -> f ()
void Stepper a
restart))
  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying Lens' UiVmState VM
uiVm (forall s a. State s a -> s -> s
execState EVM ()
exec1)
  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying Lens' UiVmState Int
uiStep (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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VM -> Forest Trace
traceForest (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState VM
uiVm UiVmState
ui)
    newTraceTree :: [Int]
newTraceTree = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VM -> Forest Trace
traceForest VM
vm
  in [Int]
currentTraceTree 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 (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState UnitTestOptions
uiTestOpts UiVmState
ui)
      initialPosition :: Maybe SrcMap
initialPosition = DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState VM
uiVm UiVmState
ui)
  in DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp' VM
vm 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 (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState UnitTestOptions
uiTestOpts UiVmState
ui)
    vm0 :: VM
vm0             = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState VM
uiVm UiVmState
ui
    initialPosition :: Maybe SrcMap
initialPosition = DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp' VM
vm0
    initialHeight :: Int
initialHeight   = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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 = forall a. a -> Maybe a
Just SrcMap
here forall a. Eq a => a -> a -> Bool
/= Maybe SrcMap
initialPosition
          deeper :: Bool
deeper = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' VM [Frame]
frames VM
vm) forall a. Ord a => a -> a -> Bool
> Int
initialHeight
          boring :: Bool
boring =
            case SourceCache -> SrcMap -> Maybe ByteString
srcMapCode (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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 = forall a. Maybe a -> Bool
isJust (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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 <- (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Contract (Vector Int)
opIxMap Contract
this) forall a. Storable a => Vector a -> Int -> Maybe a
SVec.!? (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = W256 -> Text
showWordExact (forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Word64
gas) UiVmState
ui)
    labelText :: Widget Name
labelText = forall n. Text -> Widget n
txt (Text
"Gas available: " forall a. Semigroup a => a -> a -> a
<> Text
gasText forall a. Semigroup a => a -> a -> a
<> Text
"; stack:")
    stackList :: GenericList Name Vector (Int, Expr 'EWord)
stackList = forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Name
StackPane (forall a. [a] -> Vector a
Vec.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1 :: Int)..] (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: EType). Expr a -> Expr a
simplify forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' UiVmState VM
uiVm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) UiVmState
ui)) Int
2
  in forall n. Widget n -> Widget n
hBorderWithLabel Widget Name
labelText forall n. Widget n -> Widget n -> Widget n
<=>
    forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList
      (\Bool
_ (Int
i, Expr 'EWord
w) ->
         forall n. [Widget n] -> Widget n
vBox
           [ forall n. Bool -> Widget n -> Widget n
withHighlight Bool
True (forall n. String -> Widget n
str (String
"#" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
" "))
               forall n. Widget n -> Widget n -> Widget n
<+> forall n. String -> Widget n
ourWrap (Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Text
prettyIfConcreteWord Expr 'EWord
w)
           , forall n. Widget n -> Widget n
dim (forall n. Text -> Widget n
txt (Text
"   " forall a. Semigroup a => a -> a -> a
<> case Expr 'EWord -> Maybe W256
unlit Expr 'EWord
w of
                       Maybe W256
Nothing -> Text
""
                       Just W256
u -> W256 -> DappInfo -> Text
showWordExplanation W256
u forall a b. (a -> b) -> a -> b
$ UnitTestOptions -> DappInfo
dapp (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState UnitTestOptions
uiTestOpts UiVmState
ui)))
           ])
      Bool
False
      GenericList Name Vector (Int, Expr 'EWord)
stackList

message :: VM -> String
message :: VM -> String
message VM
vm =
  case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' VM (Maybe VMResult)
result VM
vm of
    Just (VMSuccess (ConcreteBuf ByteString
msg)) ->
      String
"VMSuccess: " forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ ByteString -> ByteStringS
ByteStringS ByteString
msg)
    Just (VMSuccess (Expr 'Buf
msg)) ->
      String
"VMSuccess: <symbolicbuffer> " forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show Expr 'Buf
msg)
    Just (VMFailure (EVM.Revert Expr 'Buf
msg)) ->
      String
"VMFailure: " forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show Expr 'Buf
msg)
    Just (VMFailure Error
err) ->
      String
"VMFailure: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Error
err
    Maybe VMResult
Nothing ->
      String
"Executing EVM code in " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Addr
contract) VM
vm)


drawBytecodePane :: UiVmState -> UiWidget
drawBytecodePane :: UiVmState -> Widget Name
drawBytecodePane UiVmState
ui =
  let
    vm :: VM
vm = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState VM
uiVm UiVmState
ui
    move :: GenericList Name Vector (Int, Op)
-> GenericList Name Vector (Int, Op)
move = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo forall a b. (a -> b) -> a -> b
$ VM -> Maybe Int
vmOpIx VM
vm
  in
    forall n. Widget n -> Widget n
hBorderWithLabel (forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ VM -> String
message VM
vm) forall n. Widget n -> Widget n -> Widget n
<=>
    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 forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dimAttr (forall a n. (Integral a, Show a) => (a, Op) -> Widget n
opWidget (Int, Op)
x)
                    else forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
boldAttr (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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Name
BytecodePane
        (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Contract (Vector (Int, Op))
codeOps) (VM -> Maybe Contract
currentContract VM
vm))
        Int
1)


dim :: Widget n -> Widget n
dim :: forall n. Widget n -> Widget n
dim = forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dimAttr

withHighlight :: Bool -> Widget n -> Widget n
withHighlight :: forall n. Bool -> Widget n -> Widget n
withHighlight Bool
False = forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dimAttr
withHighlight Bool
True  = forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
boldAttr

prettyIfConcrete :: Expr Buf -> String
prettyIfConcrete :: Expr 'Buf -> String
prettyIfConcrete (ConcreteBuf ByteString
x) = Int -> ByteString -> String
prettyHex Int
40 ByteString
x
prettyIfConcrete Expr 'Buf
x = Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Expr a
simplify Expr 'Buf
x

drawTracePane :: UiVmState -> UiWidget
drawTracePane :: UiVmState -> Widget Name
drawTracePane UiVmState
s =
  let vm :: VM
vm = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState VM
uiVm UiVmState
s
      dapp' :: DappInfo
dapp' = UnitTestOptions -> DappInfo
dapp (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState UnitTestOptions
uiTestOpts UiVmState
s)
      traceList :: GenericList Name Vector Text
traceList =
        forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list
          Name
TracePane
          (forall a. [a] -> Vector a
Vec.fromList
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. DappInfo -> VM -> Text
showTraceTree DappInfo
dapp'
            forall a b. (a -> b) -> a -> b
$ VM
vm)
          Int
1

  in case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState Bool
uiShowMemory UiVmState
s of
    Bool
True -> forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport Name
TracePane ViewportType
Vertical forall a b. (a -> b) -> a -> b
$
        forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
"Calldata")
        forall n. Widget n -> Widget n -> Widget n
<=> forall n. String -> Widget n
ourWrap (Expr 'Buf -> String
prettyIfConcrete (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
calldata) VM
vm))
        forall n. Widget n -> Widget n -> Widget n
<=> forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
"Returndata")
        forall n. Widget n -> Widget n -> Widget n
<=> forall n. String -> Widget n
ourWrap (Expr 'Buf -> String
prettyIfConcrete (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) VM
vm))
        forall n. Widget n -> Widget n -> Widget n
<=> forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
"Output")
        forall n. Widget n -> Widget n -> Widget n
<=> forall n. String -> Widget n
ourWrap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" forall a. Show a => a -> String
show (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' VM (Maybe VMResult)
result VM
vm))
        forall n. Widget n -> Widget n -> Widget n
<=> forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
"Cache")
        forall n. Widget n -> Widget n -> Widget n
<=> forall n. String -> Widget n
ourWrap (forall a. Show a => a -> String
show (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' VM Cache
cache forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Cache (Map (CodeLocation, Int) Bool)
path) VM
vm))
        forall n. Widget n -> Widget n -> Widget n
<=> forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
"Path Conditions")
        forall n. Widget n -> Widget n -> Widget n
<=> (forall n. String -> Widget n
ourWrap forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' VM [Prop]
constraints VM
vm)
        forall n. Widget n -> Widget n -> Widget n
<=> forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
"Memory")
        forall n. Widget n -> Widget n -> Widget n
<=> (forall n. String -> Widget n
ourWrap (Expr 'Buf -> String
prettyIfConcrete (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
memory) VM
vm)))
    Bool
False ->
      forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
"Trace")
      forall n. Widget n -> Widget n -> Widget n
<=> 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 -> forall n. Text -> Widget n
txt Text
x)
            Bool
False
            (forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo (forall (t :: * -> *) a. Foldable t => t a -> Int
length GenericList Name Vector Text
traceList) GenericList Name Vector Text
traceList)

ourWrap :: String -> Widget n
ourWrap :: forall n. String -> Widget n
ourWrap = forall n. WrapSettings -> String -> Widget n
strWrapWith WrapSettings
settings
  where
    settings :: WrapSettings
settings = WrapSettings
      { preserveIndentation :: Bool
preserveIndentation = Bool
True
      , breakLongWords :: Bool
breakLongWords = Bool
True
      , fillStrategy :: FillStrategy
fillStrategy = FillStrategy
NoFill
      , fillScope :: FillScope
fillScope = FillScope
FillAfterFirst
      }

solidityList :: VM -> DappInfo -> List Name (Int, ByteString)
solidityList :: VM -> DappInfo -> List Name (Int, ByteString)
solidityList VM
vm DappInfo
dapp' =
  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 -> forall a. Monoid a => a
mempty
        Just SrcMap
x ->
          forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' DappInfo SourceCache
dappSources
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SourceCache [Vector ByteString]
sourceLines
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (SrcMap -> Int
srcMapFile SrcMap
x)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (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 (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState UnitTestOptions
uiTestOpts UiVmState
ui)
      dappSrcs :: SourceCache
dappSrcs = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' DappInfo SourceCache
dappSources DappInfo
dapp'
      vm :: VM
vm = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' UiVmState VM
uiVm UiVmState
ui
  in case DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp' VM
vm of
    Maybe SrcMap
Nothing -> forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max (forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
"<no source map>"))
    Just SrcMap
sm ->
          let
            rows :: Vector ByteString
rows = (SourceCache -> [Vector ByteString]
_sourceLines SourceCache
dappSrcs) 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 = forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Lens' DappInfo SourceCache
dappSources forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SourceCache [(Text, ByteString)]
sourceFiles forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (SrcMap -> Int
srcMapFile SrcMap
sm) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (\Int
a -> forall a. a -> Maybe a
Just (Int
a forall a. Num a => a -> a -> a
- Int
1))
              (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                (SourceCache -> SrcMap -> Maybe (Text, Int)
srcMapCodePos
                 (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' DappInfo SourceCache
dappSources DappInfo
dapp')
                 SrcMap
sm))
          in forall n. [Widget n] -> Widget n
vBox
            [ forall n. Widget n -> Widget n
hBorderWithLabel forall a b. (a -> b) -> a -> b
$
                forall n. Text -> Widget n
txt (forall a. a -> Maybe a -> a
fromMaybe Text
"<unknown>" Maybe Text
fileName)
                  forall n. Widget n -> Widget n -> Widget n
<+> forall n. String -> Widget n
str (String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Maybe Int
lineNo)

                  -- Show the AST node type if present
                  forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt (Text
" (" forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a -> a
fromMaybe Text
"?"
                                    ((forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' DappInfo (SrcMap -> Maybe Value)
dappAstSrcMap DappInfo
dapp') SrcMap
sm
                                       forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall t. AsValue t => Key -> Traversal' t Value
key Key
"name" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String)) forall a. Semigroup a => a -> a -> a
<> Text
")")
            , 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 -> forall n. Bool -> Widget n -> Widget n
withHighlight Bool
False (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 forall a. Num a => a -> a -> a
+ Int
b) Text
s
                                          )
                          in forall n. [Widget n] -> Widget n
hBox [ forall n. Bool -> Widget n -> Widget n
withHighlight Bool
False (forall n. Text -> Widget n
txt Text
x)
                                  , forall n. Bool -> Widget n -> Widget n
withHighlight Bool
True (forall n. Text -> Widget n
txt Text
y)
                                  , forall n. Bool -> Widget n -> Widget n
withHighlight Bool
False (forall n. Text -> Widget n
txt Text
z)
                                  ])
                Bool
False
                ((forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Maybe Int
lineNo)
                  (VM -> DappInfo -> List Name (Int, ByteString)
solidityList VM
vm DappInfo
dapp'))
            ]

ifTallEnough :: Int -> Widget n -> Widget n -> Widget n
ifTallEnough :: forall n. Int -> Widget n -> Widget n -> Widget n
ifTallEnough Int
need Widget n
w1 Widget n
w2 =
  forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy forall a b. (a -> b) -> a -> b
$ do
    Context n
c <- forall n. RenderM n (Context n)
getContext
    if forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall n. Lens' (Context n) Int
availHeightL Context n
c forall a. Ord a => a -> a -> Bool
> Int
need
      then forall n. Widget n -> RenderM n (Result n)
render Widget n
w1
      else forall n. Widget n -> RenderM n (Result n)
render Widget n
w2

opWidget :: (Integral a, Show a) => (a, Op) -> Widget n
opWidget :: forall a n. (Integral a, Show a) => (a, Op) -> Widget n
opWidget = forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => (a, Op) -> String
opString

selectedAttr :: AttrName; selectedAttr :: AttrName
selectedAttr = String -> AttrName
attrName String
"selected"
dimAttr :: AttrName; dimAttr :: AttrName
dimAttr = String -> AttrName
attrName String
"dim"
wordAttr :: AttrName; wordAttr :: AttrName
wordAttr = String -> AttrName
attrName String
"word"
boldAttr :: AttrName; boldAttr :: AttrName
boldAttr = String -> AttrName
attrName String
"bold"
activeAttr :: AttrName; activeAttr :: AttrName
activeAttr = String -> AttrName
attrName String
"active"