{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}

module EVM.Solidity
  ( solidity
  , solcRuntime
  , yul
  , yulRuntime
  , JumpType (..)
  , SolcContract (..)
  , Contracts (..)
  , ProjectType (..)
  , BuildOutput (..)
  , StorageItem (..)
  , SourceCache (..)
  , SrcMap (..)
  , CodeType (..)
  , Method (..)
  , SlotType (..)
  , Reference(..)
  , Mutability(..)
  , readBuildOutput
  , functionAbi
  , makeSrcMaps
  , readSolc
  , readJSON
  , readStdJSON
  , stripBytecodeMetadata
  , stripBytecodeMetadataSym
  , signature
  , solc
  , Language(..)
  , stdjson
  , parseMethodInput
  , lineSubrange
  , astIdMap
  , astSrcMap
  , containsLinkerHole
  , makeSourceCache
) where

import EVM.ABI
import EVM.Types hiding (Success)

import Optics.Core
import Optics.Operators.Unsafe

import Control.Applicative
import Control.Monad
import Control.Monad.IO.Unlift
import Data.Aeson hiding (json)
import Data.Aeson.Types
import Data.Aeson.Optics
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Scientific
import Data.ByteString (ByteString, readFile)
import Data.ByteString qualified as BS
import Data.ByteString.Base16 qualified as BS16
import Data.ByteString.Lazy (toStrict)
import Data.Char (isDigit)
import Data.Foldable
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.HashMap.Strict qualified as HMap
import Data.List (sort, isPrefixOf, isInfixOf, isSuffixOf, elemIndex, tails, findIndex)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Maybe
import Data.Semigroup
import Data.Sequence (Seq)
import Data.Text (pack, intercalate)
import Data.Text qualified as T
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Data.Vector (Vector)
import Data.Vector qualified as Vector
import Data.Word (Word8)
import Options.Generic
import Prelude hiding (readFile, writeFile)
import System.FilePattern.Directory
import System.FilePath.Posix
import System.Process
import Text.Read (readMaybe)
import Witch (unsafeInto)


data StorageItem = StorageItem
  { StorageItem -> SlotType
slotType :: SlotType
  , StorageItem -> Int
offset :: Int
  , StorageItem -> Int
slot :: Int
  } deriving (Int -> StorageItem -> ShowS
[StorageItem] -> ShowS
StorageItem -> [Char]
(Int -> StorageItem -> ShowS)
-> (StorageItem -> [Char])
-> ([StorageItem] -> ShowS)
-> Show StorageItem
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StorageItem -> ShowS
showsPrec :: Int -> StorageItem -> ShowS
$cshow :: StorageItem -> [Char]
show :: StorageItem -> [Char]
$cshowList :: [StorageItem] -> ShowS
showList :: [StorageItem] -> ShowS
Show, StorageItem -> StorageItem -> Bool
(StorageItem -> StorageItem -> Bool)
-> (StorageItem -> StorageItem -> Bool) -> Eq StorageItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StorageItem -> StorageItem -> Bool
== :: StorageItem -> StorageItem -> Bool
$c/= :: StorageItem -> StorageItem -> Bool
/= :: StorageItem -> StorageItem -> Bool
Eq)

data SlotType
  -- Note that mapping keys can only be elementary;
  -- that excludes arrays, contracts, and mappings.
  = StorageMapping (NonEmpty AbiType) AbiType
  | StorageValue AbiType
--  | StorageArray AbiType
  deriving SlotType -> SlotType -> Bool
(SlotType -> SlotType -> Bool)
-> (SlotType -> SlotType -> Bool) -> Eq SlotType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SlotType -> SlotType -> Bool
== :: SlotType -> SlotType -> Bool
$c/= :: SlotType -> SlotType -> Bool
/= :: SlotType -> SlotType -> Bool
Eq

instance Show SlotType where
 show :: SlotType -> [Char]
show (StorageValue AbiType
t) = AbiType -> [Char]
forall a. Show a => a -> [Char]
show AbiType
t
 show (StorageMapping NonEmpty AbiType
s AbiType
t) =
   (AbiType -> ShowS) -> [Char] -> NonEmpty AbiType -> [Char]
forall a b. (a -> b -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
   (\AbiType
x [Char]
y ->
       [Char]
"mapping("
       [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> AbiType -> [Char]
forall a. Show a => a -> [Char]
show AbiType
x
       [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" => "
       [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
y
       [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
")")
   (AbiType -> [Char]
forall a. Show a => a -> [Char]
show AbiType
t) NonEmpty AbiType
s

instance Read SlotType where
  readsPrec :: Int -> ReadS SlotType
readsPrec Int
_ t :: [Char]
t@(Char
'm':Char
'a':Char
'p':Char
'p':Char
'i':Char
'n':Char
'g':Char
'(':[Char]
s) =
    let (Text
lhs,[Text]
rhs) = case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
" => " ([Char] -> Text
pack [Char]
s) of
          (Text
l:[Text]
r) -> (Text
l,[Text]
r)
          [Text]
_ -> [Char] -> (Text, [Text])
forall a. HasCallStack => [Char] -> a
internalError ([Char] -> (Text, [Text])) -> [Char] -> (Text, [Text])
forall a b. (a -> b) -> a -> b
$ [Char]
"could not parse storage item: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
t
        first :: AbiType
first = Maybe AbiType -> AbiType
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe AbiType -> AbiType) -> Maybe AbiType -> AbiType
forall a b. (a -> b) -> a -> b
$ Vector AbiType -> Text -> Maybe AbiType
parseTypeName Vector AbiType
forall a. Monoid a => a
mempty Text
lhs
        target :: AbiType
target = Maybe AbiType -> AbiType
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe AbiType -> AbiType) -> Maybe AbiType -> AbiType
forall a b. (a -> b) -> a -> b
$ Vector AbiType -> Text -> Maybe AbiType
parseTypeName Vector AbiType
forall a. Monoid a => a
mempty (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
")" Text
"" ([Text] -> Text
forall a. HasCallStack => [a] -> a
last [Text]
rhs))
        rest :: [AbiType]
rest = (Text -> AbiType) -> [Text] -> [AbiType]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe AbiType -> AbiType
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe AbiType -> AbiType)
-> (Text -> Maybe AbiType) -> Text -> AbiType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector AbiType -> Text -> Maybe AbiType
parseTypeName Vector AbiType
forall a. Monoid a => a
mempty (Text -> Maybe AbiType) -> (Text -> Text) -> Text -> Maybe AbiType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"mapping(" Text
""))) (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
rhs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Text]
rhs)
    in [(NonEmpty AbiType -> AbiType -> SlotType
StorageMapping (AbiType
first AbiType -> [AbiType] -> NonEmpty AbiType
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| [AbiType]
rest) AbiType
target, [Char]
"")]
  readsPrec Int
_ [Char]
s = [(AbiType -> SlotType
StorageValue (AbiType -> SlotType) -> AbiType -> SlotType
forall a b. (a -> b) -> a -> b
$ AbiType -> Maybe AbiType -> AbiType
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> AbiType
forall a. HasCallStack => [Char] -> a
internalError ([Char] -> AbiType) -> [Char] -> AbiType
forall a b. (a -> b) -> a -> b
$ [Char]
"could not parse storage item: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
s) (Vector AbiType -> Text -> Maybe AbiType
parseTypeName Vector AbiType
forall a. Monoid a => a
mempty ([Char] -> Text
pack [Char]
s)),[Char]
"")]

data SolcContract = SolcContract
  { SolcContract -> W256
runtimeCodehash  :: W256
  , SolcContract -> W256
creationCodehash :: W256
  , SolcContract -> ByteString
runtimeCode      :: ByteString
  , SolcContract -> ByteString
creationCode     :: ByteString
  , SolcContract -> Text
contractName     :: Text
  , SolcContract -> [(Text, AbiType)]
constructorInputs :: [(Text, AbiType)]
  , SolcContract -> Map FunctionSelector Method
abiMap           :: Map FunctionSelector Method
  , SolcContract -> Map W256 Event
eventMap         :: Map W256 Event
  , SolcContract -> Map W256 SolError
errorMap         :: Map W256 SolError
  , SolcContract -> Map W256 [Reference]
immutableReferences :: Map W256 [Reference]
  , SolcContract -> Maybe (Map Text StorageItem)
storageLayout    :: Maybe (Map Text StorageItem)
  , SolcContract -> Seq SrcMap
runtimeSrcmap    :: Seq SrcMap
  , SolcContract -> Seq SrcMap
creationSrcmap   :: Seq SrcMap
  } deriving (Int -> SolcContract -> ShowS
[SolcContract] -> ShowS
SolcContract -> [Char]
(Int -> SolcContract -> ShowS)
-> (SolcContract -> [Char])
-> ([SolcContract] -> ShowS)
-> Show SolcContract
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SolcContract -> ShowS
showsPrec :: Int -> SolcContract -> ShowS
$cshow :: SolcContract -> [Char]
show :: SolcContract -> [Char]
$cshowList :: [SolcContract] -> ShowS
showList :: [SolcContract] -> ShowS
Show, SolcContract -> SolcContract -> Bool
(SolcContract -> SolcContract -> Bool)
-> (SolcContract -> SolcContract -> Bool) -> Eq SolcContract
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SolcContract -> SolcContract -> Bool
== :: SolcContract -> SolcContract -> Bool
$c/= :: SolcContract -> SolcContract -> Bool
/= :: SolcContract -> SolcContract -> Bool
Eq, (forall x. SolcContract -> Rep SolcContract x)
-> (forall x. Rep SolcContract x -> SolcContract)
-> Generic SolcContract
forall x. Rep SolcContract x -> SolcContract
forall x. SolcContract -> Rep SolcContract x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SolcContract -> Rep SolcContract x
from :: forall x. SolcContract -> Rep SolcContract x
$cto :: forall x. Rep SolcContract x -> SolcContract
to :: forall x. Rep SolcContract x -> SolcContract
Generic)

data Method = Method
  { Method -> [(Text, AbiType)]
output :: [(Text, AbiType)]
  , Method -> [(Text, AbiType)]
inputs :: [(Text, AbiType)]
  , Method -> Text
name :: Text
  , Method -> Text
methodSignature :: Text
  , Method -> Mutability
mutability :: Mutability
  } deriving (Int -> Method -> ShowS
[Method] -> ShowS
Method -> [Char]
(Int -> Method -> ShowS)
-> (Method -> [Char]) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Method -> ShowS
showsPrec :: Int -> Method -> ShowS
$cshow :: Method -> [Char]
show :: Method -> [Char]
$cshowList :: [Method] -> ShowS
showList :: [Method] -> ShowS
Show, Method -> Method -> Bool
(Method -> Method -> Bool)
-> (Method -> Method -> Bool) -> Eq Method
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Method -> Method -> Bool
== :: Method -> Method -> Bool
$c/= :: Method -> Method -> Bool
/= :: Method -> Method -> Bool
Eq, Eq Method
Eq Method
-> (Method -> Method -> Ordering)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Method)
-> (Method -> Method -> Method)
-> Ord Method
Method -> Method -> Bool
Method -> Method -> Ordering
Method -> Method -> Method
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Method -> Method -> Ordering
compare :: Method -> Method -> Ordering
$c< :: Method -> Method -> Bool
< :: Method -> Method -> Bool
$c<= :: Method -> Method -> Bool
<= :: Method -> Method -> Bool
$c> :: Method -> Method -> Bool
> :: Method -> Method -> Bool
$c>= :: Method -> Method -> Bool
>= :: Method -> Method -> Bool
$cmax :: Method -> Method -> Method
max :: Method -> Method -> Method
$cmin :: Method -> Method -> Method
min :: Method -> Method -> Method
Ord, (forall x. Method -> Rep Method x)
-> (forall x. Rep Method x -> Method) -> Generic Method
forall x. Rep Method x -> Method
forall x. Method -> Rep Method x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Method -> Rep Method x
from :: forall x. Method -> Rep Method x
$cto :: forall x. Rep Method x -> Method
to :: forall x. Rep Method x -> Method
Generic)

data Mutability
  = Pure       -- ^ specified to not read blockchain state
  | View       -- ^ specified to not modify the blockchain state
  | NonPayable -- ^ function does not accept Ether - the default
  | Payable    -- ^ function accepts Ether
 deriving (Int -> Mutability -> ShowS
[Mutability] -> ShowS
Mutability -> [Char]
(Int -> Mutability -> ShowS)
-> (Mutability -> [Char])
-> ([Mutability] -> ShowS)
-> Show Mutability
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mutability -> ShowS
showsPrec :: Int -> Mutability -> ShowS
$cshow :: Mutability -> [Char]
show :: Mutability -> [Char]
$cshowList :: [Mutability] -> ShowS
showList :: [Mutability] -> ShowS
Show, Mutability -> Mutability -> Bool
(Mutability -> Mutability -> Bool)
-> (Mutability -> Mutability -> Bool) -> Eq Mutability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mutability -> Mutability -> Bool
== :: Mutability -> Mutability -> Bool
$c/= :: Mutability -> Mutability -> Bool
/= :: Mutability -> Mutability -> Bool
Eq, Eq Mutability
Eq Mutability
-> (Mutability -> Mutability -> Ordering)
-> (Mutability -> Mutability -> Bool)
-> (Mutability -> Mutability -> Bool)
-> (Mutability -> Mutability -> Bool)
-> (Mutability -> Mutability -> Bool)
-> (Mutability -> Mutability -> Mutability)
-> (Mutability -> Mutability -> Mutability)
-> Ord Mutability
Mutability -> Mutability -> Bool
Mutability -> Mutability -> Ordering
Mutability -> Mutability -> Mutability
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Mutability -> Mutability -> Ordering
compare :: Mutability -> Mutability -> Ordering
$c< :: Mutability -> Mutability -> Bool
< :: Mutability -> Mutability -> Bool
$c<= :: Mutability -> Mutability -> Bool
<= :: Mutability -> Mutability -> Bool
$c> :: Mutability -> Mutability -> Bool
> :: Mutability -> Mutability -> Bool
$c>= :: Mutability -> Mutability -> Bool
>= :: Mutability -> Mutability -> Bool
$cmax :: Mutability -> Mutability -> Mutability
max :: Mutability -> Mutability -> Mutability
$cmin :: Mutability -> Mutability -> Mutability
min :: Mutability -> Mutability -> Mutability
Ord, (forall x. Mutability -> Rep Mutability x)
-> (forall x. Rep Mutability x -> Mutability) -> Generic Mutability
forall x. Rep Mutability x -> Mutability
forall x. Mutability -> Rep Mutability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Mutability -> Rep Mutability x
from :: forall x. Mutability -> Rep Mutability x
$cto :: forall x. Rep Mutability x -> Mutability
to :: forall x. Rep Mutability x -> Mutability
Generic)

-- | A mapping from contract identifiers (filepath:name) to a SolcContract object
newtype Contracts = Contracts (Map Text SolcContract)
  deriving newtype (Int -> Contracts -> ShowS
[Contracts] -> ShowS
Contracts -> [Char]
(Int -> Contracts -> ShowS)
-> (Contracts -> [Char])
-> ([Contracts] -> ShowS)
-> Show Contracts
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Contracts -> ShowS
showsPrec :: Int -> Contracts -> ShowS
$cshow :: Contracts -> [Char]
show :: Contracts -> [Char]
$cshowList :: [Contracts] -> ShowS
showList :: [Contracts] -> ShowS
Show, Contracts -> Contracts -> Bool
(Contracts -> Contracts -> Bool)
-> (Contracts -> Contracts -> Bool) -> Eq Contracts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Contracts -> Contracts -> Bool
== :: Contracts -> Contracts -> Bool
$c/= :: Contracts -> Contracts -> Bool
/= :: Contracts -> Contracts -> Bool
Eq, NonEmpty Contracts -> Contracts
Contracts -> Contracts -> Contracts
(Contracts -> Contracts -> Contracts)
-> (NonEmpty Contracts -> Contracts)
-> (forall b. Integral b => b -> Contracts -> Contracts)
-> Semigroup Contracts
forall b. Integral b => b -> Contracts -> Contracts
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Contracts -> Contracts -> Contracts
<> :: Contracts -> Contracts -> Contracts
$csconcat :: NonEmpty Contracts -> Contracts
sconcat :: NonEmpty Contracts -> Contracts
$cstimes :: forall b. Integral b => b -> Contracts -> Contracts
stimes :: forall b. Integral b => b -> Contracts -> Contracts
Semigroup, Semigroup Contracts
Contracts
Semigroup Contracts
-> Contracts
-> (Contracts -> Contracts -> Contracts)
-> ([Contracts] -> Contracts)
-> Monoid Contracts
[Contracts] -> Contracts
Contracts -> Contracts -> Contracts
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Contracts
mempty :: Contracts
$cmappend :: Contracts -> Contracts -> Contracts
mappend :: Contracts -> Contracts -> Contracts
$cmconcat :: [Contracts] -> Contracts
mconcat :: [Contracts] -> Contracts
Monoid)

-- | A mapping from contract identifiers (filepath:name) to their ast json
newtype Asts = Asts (Map Text Value)
  deriving newtype (Int -> Asts -> ShowS
[Asts] -> ShowS
Asts -> [Char]
(Int -> Asts -> ShowS)
-> (Asts -> [Char]) -> ([Asts] -> ShowS) -> Show Asts
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Asts -> ShowS
showsPrec :: Int -> Asts -> ShowS
$cshow :: Asts -> [Char]
show :: Asts -> [Char]
$cshowList :: [Asts] -> ShowS
showList :: [Asts] -> ShowS
Show, Asts -> Asts -> Bool
(Asts -> Asts -> Bool) -> (Asts -> Asts -> Bool) -> Eq Asts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Asts -> Asts -> Bool
== :: Asts -> Asts -> Bool
$c/= :: Asts -> Asts -> Bool
/= :: Asts -> Asts -> Bool
Eq, NonEmpty Asts -> Asts
Asts -> Asts -> Asts
(Asts -> Asts -> Asts)
-> (NonEmpty Asts -> Asts)
-> (forall b. Integral b => b -> Asts -> Asts)
-> Semigroup Asts
forall b. Integral b => b -> Asts -> Asts
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Asts -> Asts -> Asts
<> :: Asts -> Asts -> Asts
$csconcat :: NonEmpty Asts -> Asts
sconcat :: NonEmpty Asts -> Asts
$cstimes :: forall b. Integral b => b -> Asts -> Asts
stimes :: forall b. Integral b => b -> Asts -> Asts
Semigroup, Semigroup Asts
Asts
Semigroup Asts
-> Asts
-> (Asts -> Asts -> Asts)
-> ([Asts] -> Asts)
-> Monoid Asts
[Asts] -> Asts
Asts -> Asts -> Asts
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Asts
mempty :: Asts
$cmappend :: Asts -> Asts -> Asts
mappend :: Asts -> Asts -> Asts
$cmconcat :: [Asts] -> Asts
mconcat :: [Asts] -> Asts
Monoid)

-- | Solidity source files are identified either by their location in the vfs, or by a src map identifier
data SrcFile = SrcFile
  { SrcFile -> Int
id :: Int
  , SrcFile -> [Char]
filepath :: FilePath
  }
  deriving (Int -> SrcFile -> ShowS
[SrcFile] -> ShowS
SrcFile -> [Char]
(Int -> SrcFile -> ShowS)
-> (SrcFile -> [Char]) -> ([SrcFile] -> ShowS) -> Show SrcFile
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SrcFile -> ShowS
showsPrec :: Int -> SrcFile -> ShowS
$cshow :: SrcFile -> [Char]
show :: SrcFile -> [Char]
$cshowList :: [SrcFile] -> ShowS
showList :: [SrcFile] -> ShowS
Show, SrcFile -> SrcFile -> Bool
(SrcFile -> SrcFile -> Bool)
-> (SrcFile -> SrcFile -> Bool) -> Eq SrcFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SrcFile -> SrcFile -> Bool
== :: SrcFile -> SrcFile -> Bool
$c/= :: SrcFile -> SrcFile -> Bool
/= :: SrcFile -> SrcFile -> Bool
Eq, Eq SrcFile
Eq SrcFile
-> (SrcFile -> SrcFile -> Ordering)
-> (SrcFile -> SrcFile -> Bool)
-> (SrcFile -> SrcFile -> Bool)
-> (SrcFile -> SrcFile -> Bool)
-> (SrcFile -> SrcFile -> Bool)
-> (SrcFile -> SrcFile -> SrcFile)
-> (SrcFile -> SrcFile -> SrcFile)
-> Ord SrcFile
SrcFile -> SrcFile -> Bool
SrcFile -> SrcFile -> Ordering
SrcFile -> SrcFile -> SrcFile
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SrcFile -> SrcFile -> Ordering
compare :: SrcFile -> SrcFile -> Ordering
$c< :: SrcFile -> SrcFile -> Bool
< :: SrcFile -> SrcFile -> Bool
$c<= :: SrcFile -> SrcFile -> Bool
<= :: SrcFile -> SrcFile -> Bool
$c> :: SrcFile -> SrcFile -> Bool
> :: SrcFile -> SrcFile -> Bool
$c>= :: SrcFile -> SrcFile -> Bool
>= :: SrcFile -> SrcFile -> Bool
$cmax :: SrcFile -> SrcFile -> SrcFile
max :: SrcFile -> SrcFile -> SrcFile
$cmin :: SrcFile -> SrcFile -> SrcFile
min :: SrcFile -> SrcFile -> SrcFile
Ord)

-- | A mapping from source files to (maybe) their contents
newtype Sources = Sources (Map SrcFile (Maybe ByteString))
  deriving newtype (Int -> Sources -> ShowS
[Sources] -> ShowS
Sources -> [Char]
(Int -> Sources -> ShowS)
-> (Sources -> [Char]) -> ([Sources] -> ShowS) -> Show Sources
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sources -> ShowS
showsPrec :: Int -> Sources -> ShowS
$cshow :: Sources -> [Char]
show :: Sources -> [Char]
$cshowList :: [Sources] -> ShowS
showList :: [Sources] -> ShowS
Show, Sources -> Sources -> Bool
(Sources -> Sources -> Bool)
-> (Sources -> Sources -> Bool) -> Eq Sources
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sources -> Sources -> Bool
== :: Sources -> Sources -> Bool
$c/= :: Sources -> Sources -> Bool
/= :: Sources -> Sources -> Bool
Eq, NonEmpty Sources -> Sources
Sources -> Sources -> Sources
(Sources -> Sources -> Sources)
-> (NonEmpty Sources -> Sources)
-> (forall b. Integral b => b -> Sources -> Sources)
-> Semigroup Sources
forall b. Integral b => b -> Sources -> Sources
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Sources -> Sources -> Sources
<> :: Sources -> Sources -> Sources
$csconcat :: NonEmpty Sources -> Sources
sconcat :: NonEmpty Sources -> Sources
$cstimes :: forall b. Integral b => b -> Sources -> Sources
stimes :: forall b. Integral b => b -> Sources -> Sources
Semigroup, Semigroup Sources
Sources
Semigroup Sources
-> Sources
-> (Sources -> Sources -> Sources)
-> ([Sources] -> Sources)
-> Monoid Sources
[Sources] -> Sources
Sources -> Sources -> Sources
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Sources
mempty :: Sources
$cmappend :: Sources -> Sources -> Sources
mappend :: Sources -> Sources -> Sources
$cmconcat :: [Sources] -> Sources
mconcat :: [Sources] -> Sources
Monoid)

data BuildOutput = BuildOutput
  { BuildOutput -> Contracts
contracts :: Contracts
  , BuildOutput -> SourceCache
sources   :: SourceCache
  }
  deriving (Int -> BuildOutput -> ShowS
[BuildOutput] -> ShowS
BuildOutput -> [Char]
(Int -> BuildOutput -> ShowS)
-> (BuildOutput -> [Char])
-> ([BuildOutput] -> ShowS)
-> Show BuildOutput
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildOutput -> ShowS
showsPrec :: Int -> BuildOutput -> ShowS
$cshow :: BuildOutput -> [Char]
show :: BuildOutput -> [Char]
$cshowList :: [BuildOutput] -> ShowS
showList :: [BuildOutput] -> ShowS
Show, BuildOutput -> BuildOutput -> Bool
(BuildOutput -> BuildOutput -> Bool)
-> (BuildOutput -> BuildOutput -> Bool) -> Eq BuildOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildOutput -> BuildOutput -> Bool
== :: BuildOutput -> BuildOutput -> Bool
$c/= :: BuildOutput -> BuildOutput -> Bool
/= :: BuildOutput -> BuildOutput -> Bool
Eq)

instance Semigroup BuildOutput where
  (BuildOutput Contracts
a SourceCache
b) <> :: BuildOutput -> BuildOutput -> BuildOutput
<> (BuildOutput Contracts
c SourceCache
d) = Contracts -> SourceCache -> BuildOutput
BuildOutput (Contracts
a Contracts -> Contracts -> Contracts
forall a. Semigroup a => a -> a -> a
<> Contracts
c) (SourceCache
b SourceCache -> SourceCache -> SourceCache
forall a. Semigroup a => a -> a -> a
<> SourceCache
d)
instance Monoid BuildOutput where
  mempty :: BuildOutput
mempty = Contracts -> SourceCache -> BuildOutput
BuildOutput Contracts
forall a. Monoid a => a
mempty SourceCache
forall a. Monoid a => a
mempty

-- | The various project types understood by hevm
data ProjectType = DappTools | CombinedJSON | Foundry | FoundryStdLib
  deriving (ProjectType -> ProjectType -> Bool
(ProjectType -> ProjectType -> Bool)
-> (ProjectType -> ProjectType -> Bool) -> Eq ProjectType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProjectType -> ProjectType -> Bool
== :: ProjectType -> ProjectType -> Bool
$c/= :: ProjectType -> ProjectType -> Bool
/= :: ProjectType -> ProjectType -> Bool
Eq, Int -> ProjectType -> ShowS
[ProjectType] -> ShowS
ProjectType -> [Char]
(Int -> ProjectType -> ShowS)
-> (ProjectType -> [Char])
-> ([ProjectType] -> ShowS)
-> Show ProjectType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProjectType -> ShowS
showsPrec :: Int -> ProjectType -> ShowS
$cshow :: ProjectType -> [Char]
show :: ProjectType -> [Char]
$cshowList :: [ProjectType] -> ShowS
showList :: [ProjectType] -> ShowS
Show, ReadPrec [ProjectType]
ReadPrec ProjectType
Int -> ReadS ProjectType
ReadS [ProjectType]
(Int -> ReadS ProjectType)
-> ReadS [ProjectType]
-> ReadPrec ProjectType
-> ReadPrec [ProjectType]
-> Read ProjectType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ProjectType
readsPrec :: Int -> ReadS ProjectType
$creadList :: ReadS [ProjectType]
readList :: ReadS [ProjectType]
$creadPrec :: ReadPrec ProjectType
readPrec :: ReadPrec ProjectType
$creadListPrec :: ReadPrec [ProjectType]
readListPrec :: ReadPrec [ProjectType]
Read, ReadM ProjectType
Maybe Text
-> Maybe Text -> Maybe Char -> Maybe [Char] -> Parser [ProjectType]
Maybe Text
-> Maybe Text -> Maybe Char -> Maybe [Char] -> Parser ProjectType
(Maybe Text
 -> Maybe Text -> Maybe Char -> Maybe [Char] -> Parser ProjectType)
-> (Maybe Text
    -> Maybe Text
    -> Maybe Char
    -> Maybe [Char]
    -> Parser [ProjectType])
-> ReadM ProjectType
-> (forall (proxy :: * -> *). proxy ProjectType -> [Char])
-> ParseField ProjectType
forall a.
(Maybe Text
 -> Maybe Text -> Maybe Char -> Maybe [Char] -> Parser a)
-> (Maybe Text
    -> Maybe Text -> Maybe Char -> Maybe [Char] -> Parser [a])
-> ReadM a
-> (forall (proxy :: * -> *). proxy a -> [Char])
-> ParseField a
forall (proxy :: * -> *). proxy ProjectType -> [Char]
$cparseField :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe [Char] -> Parser ProjectType
parseField :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe [Char] -> Parser ProjectType
$cparseListOfField :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe [Char] -> Parser [ProjectType]
parseListOfField :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe [Char] -> Parser [ProjectType]
$creadField :: ReadM ProjectType
readField :: ReadM ProjectType
$cmetavar :: forall (proxy :: * -> *). proxy ProjectType -> [Char]
metavar :: forall (proxy :: * -> *). proxy ProjectType -> [Char]
ParseField)

data SourceCache = SourceCache
  { SourceCache -> Map Int ([Char], ByteString)
files  :: Map Int (FilePath, ByteString)
  , SourceCache -> Map Int (Vector ByteString)
lines  :: Map Int (Vector ByteString)
  , SourceCache -> Map Text Value
asts   :: Map Text Value
  } deriving (Int -> SourceCache -> ShowS
[SourceCache] -> ShowS
SourceCache -> [Char]
(Int -> SourceCache -> ShowS)
-> (SourceCache -> [Char])
-> ([SourceCache] -> ShowS)
-> Show SourceCache
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceCache -> ShowS
showsPrec :: Int -> SourceCache -> ShowS
$cshow :: SourceCache -> [Char]
show :: SourceCache -> [Char]
$cshowList :: [SourceCache] -> ShowS
showList :: [SourceCache] -> ShowS
Show, SourceCache -> SourceCache -> Bool
(SourceCache -> SourceCache -> Bool)
-> (SourceCache -> SourceCache -> Bool) -> Eq SourceCache
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceCache -> SourceCache -> Bool
== :: SourceCache -> SourceCache -> Bool
$c/= :: SourceCache -> SourceCache -> Bool
/= :: SourceCache -> SourceCache -> Bool
Eq, (forall x. SourceCache -> Rep SourceCache x)
-> (forall x. Rep SourceCache x -> SourceCache)
-> Generic SourceCache
forall x. Rep SourceCache x -> SourceCache
forall x. SourceCache -> Rep SourceCache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SourceCache -> Rep SourceCache x
from :: forall x. SourceCache -> Rep SourceCache x
$cto :: forall x. Rep SourceCache x -> SourceCache
to :: forall x. Rep SourceCache x -> SourceCache
Generic)

data Reference = Reference
  { Reference -> Int
start :: Int,
    Reference -> Int
length :: Int
  } deriving (Int -> Reference -> ShowS
[Reference] -> ShowS
Reference -> [Char]
(Int -> Reference -> ShowS)
-> (Reference -> [Char])
-> ([Reference] -> ShowS)
-> Show Reference
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Reference -> ShowS
showsPrec :: Int -> Reference -> ShowS
$cshow :: Reference -> [Char]
show :: Reference -> [Char]
$cshowList :: [Reference] -> ShowS
showList :: [Reference] -> ShowS
Show, Reference -> Reference -> Bool
(Reference -> Reference -> Bool)
-> (Reference -> Reference -> Bool) -> Eq Reference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Reference -> Reference -> Bool
== :: Reference -> Reference -> Bool
$c/= :: Reference -> Reference -> Bool
/= :: Reference -> Reference -> Bool
Eq)

instance FromJSON Reference where
  parseJSON :: Value -> Parser Reference
parseJSON (Object Object
v) = Int -> Int -> Reference
Reference
    (Int -> Int -> Reference)
-> Parser Int -> Parser (Int -> Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"start"
    Parser (Int -> Reference) -> Parser Int -> Parser Reference
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"length"
  parseJSON Value
invalid =
    [Char] -> Value -> Parser Reference
forall a. [Char] -> Value -> Parser a
typeMismatch [Char]
"Transaction" Value
invalid

instance Semigroup SourceCache where
  SourceCache Map Int ([Char], ByteString)
a Map Int (Vector ByteString)
b Map Text Value
c <> :: SourceCache -> SourceCache -> SourceCache
<> SourceCache Map Int ([Char], ByteString)
d Map Int (Vector ByteString)
e Map Text Value
f = Map Int ([Char], ByteString)
-> Map Int (Vector ByteString) -> Map Text Value -> SourceCache
SourceCache (Map Int ([Char], ByteString)
a Map Int ([Char], ByteString)
-> Map Int ([Char], ByteString) -> Map Int ([Char], ByteString)
forall a. Semigroup a => a -> a -> a
<> Map Int ([Char], ByteString)
d) (Map Int (Vector ByteString)
b Map Int (Vector ByteString)
-> Map Int (Vector ByteString) -> Map Int (Vector ByteString)
forall a. Semigroup a => a -> a -> a
<> Map Int (Vector ByteString)
e) (Map Text Value
c Map Text Value -> Map Text Value -> Map Text Value
forall a. Semigroup a => a -> a -> a
<> Map Text Value
f)

instance Monoid SourceCache where
  mempty :: SourceCache
mempty = Map Int ([Char], ByteString)
-> Map Int (Vector ByteString) -> Map Text Value -> SourceCache
SourceCache Map Int ([Char], ByteString)
forall a. Monoid a => a
mempty Map Int (Vector ByteString)
forall a. Monoid a => a
mempty Map Text Value
forall a. Monoid a => a
mempty

data JumpType = JumpInto | JumpFrom | JumpRegular
  deriving (Int -> JumpType -> ShowS
[JumpType] -> ShowS
JumpType -> [Char]
(Int -> JumpType -> ShowS)
-> (JumpType -> [Char]) -> ([JumpType] -> ShowS) -> Show JumpType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JumpType -> ShowS
showsPrec :: Int -> JumpType -> ShowS
$cshow :: JumpType -> [Char]
show :: JumpType -> [Char]
$cshowList :: [JumpType] -> ShowS
showList :: [JumpType] -> ShowS
Show, JumpType -> JumpType -> Bool
(JumpType -> JumpType -> Bool)
-> (JumpType -> JumpType -> Bool) -> Eq JumpType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JumpType -> JumpType -> Bool
== :: JumpType -> JumpType -> Bool
$c/= :: JumpType -> JumpType -> Bool
/= :: JumpType -> JumpType -> Bool
Eq, Eq JumpType
Eq JumpType
-> (JumpType -> JumpType -> Ordering)
-> (JumpType -> JumpType -> Bool)
-> (JumpType -> JumpType -> Bool)
-> (JumpType -> JumpType -> Bool)
-> (JumpType -> JumpType -> Bool)
-> (JumpType -> JumpType -> JumpType)
-> (JumpType -> JumpType -> JumpType)
-> Ord JumpType
JumpType -> JumpType -> Bool
JumpType -> JumpType -> Ordering
JumpType -> JumpType -> JumpType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JumpType -> JumpType -> Ordering
compare :: JumpType -> JumpType -> Ordering
$c< :: JumpType -> JumpType -> Bool
< :: JumpType -> JumpType -> Bool
$c<= :: JumpType -> JumpType -> Bool
<= :: JumpType -> JumpType -> Bool
$c> :: JumpType -> JumpType -> Bool
> :: JumpType -> JumpType -> Bool
$c>= :: JumpType -> JumpType -> Bool
>= :: JumpType -> JumpType -> Bool
$cmax :: JumpType -> JumpType -> JumpType
max :: JumpType -> JumpType -> JumpType
$cmin :: JumpType -> JumpType -> JumpType
min :: JumpType -> JumpType -> JumpType
Ord, (forall x. JumpType -> Rep JumpType x)
-> (forall x. Rep JumpType x -> JumpType) -> Generic JumpType
forall x. Rep JumpType x -> JumpType
forall x. JumpType -> Rep JumpType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JumpType -> Rep JumpType x
from :: forall x. JumpType -> Rep JumpType x
$cto :: forall x. Rep JumpType x -> JumpType
to :: forall x. Rep JumpType x -> JumpType
Generic)

data SrcMap = SM {
  SrcMap -> Int
offset        :: {-# UNPACK #-} !Int,
  SrcMap -> Int
length        :: {-# UNPACK #-} !Int,
  SrcMap -> Int
file          :: {-# UNPACK #-} !Int,
  SrcMap -> JumpType
jump          :: JumpType,
  SrcMap -> Int
modifierDepth :: {-# UNPACK #-} !Int
} deriving (Int -> SrcMap -> ShowS
[SrcMap] -> ShowS
SrcMap -> [Char]
(Int -> SrcMap -> ShowS)
-> (SrcMap -> [Char]) -> ([SrcMap] -> ShowS) -> Show SrcMap
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SrcMap -> ShowS
showsPrec :: Int -> SrcMap -> ShowS
$cshow :: SrcMap -> [Char]
show :: SrcMap -> [Char]
$cshowList :: [SrcMap] -> ShowS
showList :: [SrcMap] -> ShowS
Show, SrcMap -> SrcMap -> Bool
(SrcMap -> SrcMap -> Bool)
-> (SrcMap -> SrcMap -> Bool) -> Eq SrcMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SrcMap -> SrcMap -> Bool
== :: SrcMap -> SrcMap -> Bool
$c/= :: SrcMap -> SrcMap -> Bool
/= :: SrcMap -> SrcMap -> Bool
Eq, Eq SrcMap
Eq SrcMap
-> (SrcMap -> SrcMap -> Ordering)
-> (SrcMap -> SrcMap -> Bool)
-> (SrcMap -> SrcMap -> Bool)
-> (SrcMap -> SrcMap -> Bool)
-> (SrcMap -> SrcMap -> Bool)
-> (SrcMap -> SrcMap -> SrcMap)
-> (SrcMap -> SrcMap -> SrcMap)
-> Ord SrcMap
SrcMap -> SrcMap -> Bool
SrcMap -> SrcMap -> Ordering
SrcMap -> SrcMap -> SrcMap
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SrcMap -> SrcMap -> Ordering
compare :: SrcMap -> SrcMap -> Ordering
$c< :: SrcMap -> SrcMap -> Bool
< :: SrcMap -> SrcMap -> Bool
$c<= :: SrcMap -> SrcMap -> Bool
<= :: SrcMap -> SrcMap -> Bool
$c> :: SrcMap -> SrcMap -> Bool
> :: SrcMap -> SrcMap -> Bool
$c>= :: SrcMap -> SrcMap -> Bool
>= :: SrcMap -> SrcMap -> Bool
$cmax :: SrcMap -> SrcMap -> SrcMap
max :: SrcMap -> SrcMap -> SrcMap
$cmin :: SrcMap -> SrcMap -> SrcMap
min :: SrcMap -> SrcMap -> SrcMap
Ord, (forall x. SrcMap -> Rep SrcMap x)
-> (forall x. Rep SrcMap x -> SrcMap) -> Generic SrcMap
forall x. Rep SrcMap x -> SrcMap
forall x. SrcMap -> Rep SrcMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SrcMap -> Rep SrcMap x
from :: forall x. SrcMap -> Rep SrcMap x
$cto :: forall x. Rep SrcMap x -> SrcMap
to :: forall x. Rep SrcMap x -> SrcMap
Generic)

data SrcMapParseState
  = F1 String Int
  | F2 Int String Int
  | F3 Int Int String Int
  | F4 Int Int Int (Maybe JumpType)
  | F5 Int Int Int JumpType String
  | Fe
  deriving Int -> SrcMapParseState -> ShowS
[SrcMapParseState] -> ShowS
SrcMapParseState -> [Char]
(Int -> SrcMapParseState -> ShowS)
-> (SrcMapParseState -> [Char])
-> ([SrcMapParseState] -> ShowS)
-> Show SrcMapParseState
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SrcMapParseState -> ShowS
showsPrec :: Int -> SrcMapParseState -> ShowS
$cshow :: SrcMapParseState -> [Char]
show :: SrcMapParseState -> [Char]
$cshowList :: [SrcMapParseState] -> ShowS
showList :: [SrcMapParseState] -> ShowS
Show

data CodeType = Creation | Runtime
  deriving (Int -> CodeType -> ShowS
[CodeType] -> ShowS
CodeType -> [Char]
(Int -> CodeType -> ShowS)
-> (CodeType -> [Char]) -> ([CodeType] -> ShowS) -> Show CodeType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodeType -> ShowS
showsPrec :: Int -> CodeType -> ShowS
$cshow :: CodeType -> [Char]
show :: CodeType -> [Char]
$cshowList :: [CodeType] -> ShowS
showList :: [CodeType] -> ShowS
Show, CodeType -> CodeType -> Bool
(CodeType -> CodeType -> Bool)
-> (CodeType -> CodeType -> Bool) -> Eq CodeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CodeType -> CodeType -> Bool
== :: CodeType -> CodeType -> Bool
$c/= :: CodeType -> CodeType -> Bool
/= :: CodeType -> CodeType -> Bool
Eq, Eq CodeType
Eq CodeType
-> (CodeType -> CodeType -> Ordering)
-> (CodeType -> CodeType -> Bool)
-> (CodeType -> CodeType -> Bool)
-> (CodeType -> CodeType -> Bool)
-> (CodeType -> CodeType -> Bool)
-> (CodeType -> CodeType -> CodeType)
-> (CodeType -> CodeType -> CodeType)
-> Ord CodeType
CodeType -> CodeType -> Bool
CodeType -> CodeType -> Ordering
CodeType -> CodeType -> CodeType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CodeType -> CodeType -> Ordering
compare :: CodeType -> CodeType -> Ordering
$c< :: CodeType -> CodeType -> Bool
< :: CodeType -> CodeType -> Bool
$c<= :: CodeType -> CodeType -> Bool
<= :: CodeType -> CodeType -> Bool
$c> :: CodeType -> CodeType -> Bool
> :: CodeType -> CodeType -> Bool
$c>= :: CodeType -> CodeType -> Bool
>= :: CodeType -> CodeType -> Bool
$cmax :: CodeType -> CodeType -> CodeType
max :: CodeType -> CodeType -> CodeType
$cmin :: CodeType -> CodeType -> CodeType
min :: CodeType -> CodeType -> CodeType
Ord)

-- Obscure but efficient parser for the Solidity sourcemap format.
makeSrcMaps :: Text -> Maybe (Seq SrcMap)
makeSrcMaps :: Text -> Maybe (Seq SrcMap)
makeSrcMaps = (\case (Seq SrcMap
_, SrcMapParseState
Fe, SrcMap
_) -> Maybe (Seq SrcMap)
forall a. Maybe a
Nothing; (Seq SrcMap, SrcMapParseState, SrcMap)
x -> Seq SrcMap -> Maybe (Seq SrcMap)
forall a. a -> Maybe a
Just ((Seq SrcMap, SrcMapParseState, SrcMap) -> Seq SrcMap
done (Seq SrcMap, SrcMapParseState, SrcMap)
x))
             ((Seq SrcMap, SrcMapParseState, SrcMap) -> Maybe (Seq SrcMap))
-> (Text -> (Seq SrcMap, SrcMapParseState, SrcMap))
-> Text
-> Maybe (Seq SrcMap)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Seq SrcMap, SrcMapParseState, SrcMap)
 -> Char -> (Seq SrcMap, SrcMapParseState, SrcMap))
-> (Seq SrcMap, SrcMapParseState, SrcMap)
-> Text
-> (Seq SrcMap, SrcMapParseState, SrcMap)
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' ((Char
 -> (Seq SrcMap, SrcMapParseState, SrcMap)
 -> (Seq SrcMap, SrcMapParseState, SrcMap))
-> (Seq SrcMap, SrcMapParseState, SrcMap)
-> Char
-> (Seq SrcMap, SrcMapParseState, SrcMap)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char
-> (Seq SrcMap, SrcMapParseState, SrcMap)
-> (Seq SrcMap, SrcMapParseState, SrcMap)
go) (Seq SrcMap
forall a. Monoid a => a
mempty, [Char] -> Int -> SrcMapParseState
F1 [] Int
1, Int -> Int -> Int -> JumpType -> Int -> SrcMap
SM Int
0 Int
0 Int
0 JumpType
JumpRegular Int
0)
  where
    done :: (Seq SrcMap, SrcMapParseState, SrcMap) -> Seq SrcMap
done (Seq SrcMap
xs, SrcMapParseState
s, SrcMap
p) = let (Seq SrcMap
xs', SrcMapParseState
_, SrcMap
_) = Char
-> (Seq SrcMap, SrcMapParseState, SrcMap)
-> (Seq SrcMap, SrcMapParseState, SrcMap)
go Char
';' (Seq SrcMap
xs, SrcMapParseState
s, SrcMap
p) in Seq SrcMap
xs'
    readR :: [Char] -> Int
readR = [Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Int) -> ShowS -> [Char] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse

    go :: Char -> (Seq SrcMap, SrcMapParseState, SrcMap) -> (Seq SrcMap, SrcMapParseState, SrcMap)
    go :: Char
-> (Seq SrcMap, SrcMapParseState, SrcMap)
-> (Seq SrcMap, SrcMapParseState, SrcMap)
go Char
':' (Seq SrcMap
xs, F1 [] Int
_, p :: SrcMap
p@(SM Int
a Int
_ Int
_ JumpType
_ Int
_))     = (Seq SrcMap
xs, Int -> [Char] -> Int -> SrcMapParseState
F2 Int
a [] Int
1, SrcMap
p)
    go Char
':' (Seq SrcMap
xs, F1 [Char]
ds Int
k, SrcMap
p)                    = (Seq SrcMap
xs, Int -> [Char] -> Int -> SrcMapParseState
F2 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* ([Char] -> Int
readR [Char]
ds)) [] Int
1, SrcMap
p)
    go Char
'-' (Seq SrcMap
xs, F1 [] Int
_, SrcMap
p)                    = (Seq SrcMap
xs, [Char] -> Int -> SrcMapParseState
F1 [] (-Int
1), SrcMap
p)
    go Char
d   (Seq SrcMap
xs, F1 [Char]
ds Int
k, SrcMap
p) | Char -> Bool
isDigit Char
d        = (Seq SrcMap
xs, [Char] -> Int -> SrcMapParseState
F1 (Char
d Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
ds) Int
k, SrcMap
p)
    go Char
';' (Seq SrcMap
xs, F1 [] Int
k, SrcMap
p)                    = (Seq SrcMap
xs Seq SrcMap -> SrcMap -> Seq SrcMap
forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p, [Char] -> Int -> SrcMapParseState
F1 [] Int
k, SrcMap
p)
    go Char
';' (Seq SrcMap
xs, F1 [Char]
ds Int
k, SM Int
_ Int
b Int
c JumpType
d Int
e)         = let p' :: SrcMap
p' = Int -> Int -> Int -> JumpType -> Int -> SrcMap
SM (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* ([Char] -> Int
readR [Char]
ds)) Int
b Int
c JumpType
d Int
e in (Seq SrcMap
xs Seq SrcMap -> SrcMap -> Seq SrcMap
forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', [Char] -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')

    go Char
'-' (Seq SrcMap
xs, F2 Int
a [] Int
_, SrcMap
p)                  = (Seq SrcMap
xs, Int -> [Char] -> Int -> SrcMapParseState
F2 Int
a [] (-Int
1), SrcMap
p)
    go Char
d   (Seq SrcMap
xs, F2 Int
a [Char]
ds Int
k, SrcMap
p) | Char -> Bool
isDigit Char
d      = (Seq SrcMap
xs, Int -> [Char] -> Int -> SrcMapParseState
F2 Int
a (Char
d Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
ds) Int
k, SrcMap
p)
    go Char
':' (Seq SrcMap
xs, F2 Int
a [] Int
_, p :: SrcMap
p@(SM Int
_ Int
b Int
_ JumpType
_ Int
_))   = (Seq SrcMap
xs, Int -> Int -> [Char] -> Int -> SrcMapParseState
F3 Int
a Int
b [] Int
1, SrcMap
p)
    go Char
':' (Seq SrcMap
xs, F2 Int
a [Char]
ds Int
k, SrcMap
p)                  = (Seq SrcMap
xs, Int -> Int -> [Char] -> Int -> SrcMapParseState
F3 Int
a (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* ([Char] -> Int
readR [Char]
ds)) [] Int
1, SrcMap
p)
    go Char
';' (Seq SrcMap
xs, F2 Int
a [] Int
_, SM Int
_ Int
b Int
c JumpType
d Int
e)       = let p' :: SrcMap
p' = Int -> Int -> Int -> JumpType -> Int -> SrcMap
SM Int
a Int
b Int
c JumpType
d Int
e in (Seq SrcMap
xs Seq SrcMap -> SrcMap -> Seq SrcMap
forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', [Char] -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')
    go Char
';' (Seq SrcMap
xs, F2 Int
a [Char]
ds Int
k, SM Int
_ Int
_ Int
c JumpType
d Int
e)       = let p' :: SrcMap
p' = Int -> Int -> Int -> JumpType -> Int -> SrcMap
SM Int
a (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* ([Char] -> Int
readR [Char]
ds)) Int
c JumpType
d Int
e in
                                                 (Seq SrcMap
xs Seq SrcMap -> SrcMap -> Seq SrcMap
forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', [Char] -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')

    go Char
d   (Seq SrcMap
xs, F3 Int
a Int
b [Char]
ds Int
k, SrcMap
p) | Char -> Bool
isDigit Char
d    = (Seq SrcMap
xs, Int -> Int -> [Char] -> Int -> SrcMapParseState
F3 Int
a Int
b (Char
d Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
ds) Int
k, SrcMap
p)
    go Char
'-' (Seq SrcMap
xs, F3 Int
a Int
b [] Int
_, SrcMap
p)                = (Seq SrcMap
xs, Int -> Int -> [Char] -> Int -> SrcMapParseState
F3 Int
a Int
b [] (-Int
1), SrcMap
p)
    go Char
':' (Seq SrcMap
xs, F3 Int
a Int
b [] Int
_, p :: SrcMap
p@(SM Int
_ Int
_ Int
c JumpType
_ Int
_)) = (Seq SrcMap
xs, Int -> Int -> Int -> Maybe JumpType -> SrcMapParseState
F4 Int
a Int
b Int
c Maybe JumpType
forall a. Maybe a
Nothing, SrcMap
p)
    go Char
':' (Seq SrcMap
xs, F3 Int
a Int
b [Char]
ds Int
k, SrcMap
p)                = (Seq SrcMap
xs, Int -> Int -> Int -> Maybe JumpType -> SrcMapParseState
F4 Int
a Int
b (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* ([Char] -> Int
readR [Char]
ds)) Maybe JumpType
forall a. Maybe a
Nothing, SrcMap
p)
    go Char
';' (Seq SrcMap
xs, F3 Int
a Int
b [] Int
_, SM Int
_ Int
_ Int
c JumpType
d Int
e)     = let p' :: SrcMap
p' = Int -> Int -> Int -> JumpType -> Int -> SrcMap
SM Int
a Int
b Int
c JumpType
d Int
e in (Seq SrcMap
xs Seq SrcMap -> SrcMap -> Seq SrcMap
forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', [Char] -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')
    go Char
';' (Seq SrcMap
xs, F3 Int
a Int
b [Char]
ds Int
k, SM Int
_ Int
_ Int
_ JumpType
d Int
e)     = let p' :: SrcMap
p' = Int -> Int -> Int -> JumpType -> Int -> SrcMap
SM Int
a Int
b (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* ([Char] -> Int
readR [Char]
ds)) JumpType
d Int
e in
                                                 (Seq SrcMap
xs Seq SrcMap -> SrcMap -> Seq SrcMap
forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', [Char] -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')

    go Char
'i' (Seq SrcMap
xs, F4 Int
a Int
b Int
c Maybe JumpType
Nothing, SrcMap
p)           = (Seq SrcMap
xs, Int -> Int -> Int -> Maybe JumpType -> SrcMapParseState
F4 Int
a Int
b Int
c (JumpType -> Maybe JumpType
forall a. a -> Maybe a
Just JumpType
JumpInto), SrcMap
p)
    go Char
'o' (Seq SrcMap
xs, F4 Int
a Int
b Int
c Maybe JumpType
Nothing, SrcMap
p)           = (Seq SrcMap
xs, Int -> Int -> Int -> Maybe JumpType -> SrcMapParseState
F4 Int
a Int
b Int
c (JumpType -> Maybe JumpType
forall a. a -> Maybe a
Just JumpType
JumpFrom), SrcMap
p)
    go Char
'-' (Seq SrcMap
xs, F4 Int
a Int
b Int
c Maybe JumpType
Nothing, SrcMap
p)           = (Seq SrcMap
xs, Int -> Int -> Int -> Maybe JumpType -> SrcMapParseState
F4 Int
a Int
b Int
c (JumpType -> Maybe JumpType
forall a. a -> Maybe a
Just JumpType
JumpRegular), SrcMap
p)
    go Char
':' (Seq SrcMap
xs, F4 Int
a Int
b Int
c (Just JumpType
d),  SrcMap
p)         = (Seq SrcMap
xs, Int -> Int -> Int -> JumpType -> [Char] -> SrcMapParseState
F5 Int
a Int
b Int
c JumpType
d [], SrcMap
p)
    go Char
':' (Seq SrcMap
xs, F4 Int
a Int
b Int
c Maybe JumpType
_, p :: SrcMap
p@(SM Int
_ Int
_ Int
_ JumpType
d Int
_))  = (Seq SrcMap
xs, Int -> Int -> Int -> JumpType -> [Char] -> SrcMapParseState
F5 Int
a Int
b Int
c JumpType
d [], SrcMap
p)
    go Char
';' (Seq SrcMap
xs, F4 Int
a Int
b Int
c Maybe JumpType
_, SM Int
_ Int
_ Int
_ JumpType
d Int
e)      = let p' :: SrcMap
p' = Int -> Int -> Int -> JumpType -> Int -> SrcMap
SM Int
a Int
b Int
c JumpType
d Int
e in
                                                 (Seq SrcMap
xs Seq SrcMap -> SrcMap -> Seq SrcMap
forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', [Char] -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')

    go Char
d   (Seq SrcMap
xs, F5 Int
a Int
b Int
c JumpType
j [Char]
ds, SrcMap
p) | Char -> Bool
isDigit Char
d  = (Seq SrcMap
xs, Int -> Int -> Int -> JumpType -> [Char] -> SrcMapParseState
F5 Int
a Int
b Int
c JumpType
j (Char
d Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
ds), SrcMap
p)
    go Char
';' (Seq SrcMap
xs, F5 Int
a Int
b Int
c JumpType
j [], SrcMap
_)              = let p' :: SrcMap
p' = Int -> Int -> Int -> JumpType -> Int -> SrcMap
SM Int
a Int
b Int
c JumpType
j (-Int
1) in -- solc <0.6
                                                 (Seq SrcMap
xs Seq SrcMap -> SrcMap -> Seq SrcMap
forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', [Char] -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')
    go Char
';' (Seq SrcMap
xs, F5 Int
a Int
b Int
c JumpType
j [Char]
ds, SrcMap
_)              = let p' :: SrcMap
p' = Int -> Int -> Int -> JumpType -> Int -> SrcMap
SM Int
a Int
b Int
c JumpType
j ([Char] -> Int
readR [Char]
ds) in -- solc >=0.6
                                                 (Seq SrcMap
xs Seq SrcMap -> SrcMap -> Seq SrcMap
forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', [Char] -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')

    go Char
c (Seq SrcMap
xs, SrcMapParseState
state, SrcMap
p)                        = (Seq SrcMap
xs, [Char] -> SrcMapParseState
forall a. HasCallStack => [Char] -> a
internalError ([Char]
"srcmap: y u " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> [Char]
forall a. Show a => a -> [Char]
show Char
c [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" in state" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcMapParseState -> [Char]
forall a. Show a => a -> [Char]
show SrcMapParseState
state [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"?!?"), SrcMap
p)

-- | Reads all solc output json files found under the provided filepath and returns them merged into a BuildOutput
readBuildOutput :: FilePath -> ProjectType -> IO (Either String BuildOutput)
readBuildOutput :: [Char] -> ProjectType -> IO (Either [Char] BuildOutput)
readBuildOutput [Char]
root ProjectType
DappTools = do
  let outDir :: [Char]
outDir = [Char]
root [Char] -> ShowS
</> [Char]
"out"
  [[Char]]
jsons <- [Char] -> IO [[Char]]
findJsonFiles [Char]
outDir
  case [[Char]]
jsons of
    [[Char]
x] -> ProjectType -> [Char] -> [Char] -> IO (Either [Char] BuildOutput)
readSolc ProjectType
DappTools [Char]
root ([Char]
outDir [Char] -> ShowS
</> [Char]
x)
    [] -> Either [Char] BuildOutput -> IO (Either [Char] BuildOutput)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] BuildOutput -> IO (Either [Char] BuildOutput))
-> ([Char] -> Either [Char] BuildOutput)
-> [Char]
-> IO (Either [Char] BuildOutput)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] BuildOutput
forall a b. a -> Either a b
Left ([Char] -> IO (Either [Char] BuildOutput))
-> [Char] -> IO (Either [Char] BuildOutput)
forall a b. (a -> b) -> a -> b
$ [Char]
"no json files found in: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
outDir
    [[Char]]
_ -> Either [Char] BuildOutput -> IO (Either [Char] BuildOutput)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] BuildOutput -> IO (Either [Char] BuildOutput))
-> ([Char] -> Either [Char] BuildOutput)
-> [Char]
-> IO (Either [Char] BuildOutput)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] BuildOutput
forall a b. a -> Either a b
Left ([Char] -> IO (Either [Char] BuildOutput))
-> [Char] -> IO (Either [Char] BuildOutput)
forall a b. (a -> b) -> a -> b
$ [Char]
"multiple json files found in: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
outDir
readBuildOutput [Char]
root ProjectType
CombinedJSON = do
  let outDir :: [Char]
outDir = [Char]
root [Char] -> ShowS
</> [Char]
"out"
  [[Char]]
jsons <- [Char] -> IO [[Char]]
findJsonFiles [Char]
outDir
  case [[Char]]
jsons of
    [[Char]
x] -> ProjectType -> [Char] -> [Char] -> IO (Either [Char] BuildOutput)
readSolc ProjectType
CombinedJSON [Char]
root ([Char]
outDir [Char] -> ShowS
</> [Char]
x)
    [] -> Either [Char] BuildOutput -> IO (Either [Char] BuildOutput)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] BuildOutput -> IO (Either [Char] BuildOutput))
-> ([Char] -> Either [Char] BuildOutput)
-> [Char]
-> IO (Either [Char] BuildOutput)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] BuildOutput
forall a b. a -> Either a b
Left ([Char] -> IO (Either [Char] BuildOutput))
-> [Char] -> IO (Either [Char] BuildOutput)
forall a b. (a -> b) -> a -> b
$ [Char]
"no json files found in: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
outDir
    [[Char]]
_ -> Either [Char] BuildOutput -> IO (Either [Char] BuildOutput)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] BuildOutput -> IO (Either [Char] BuildOutput))
-> ([Char] -> Either [Char] BuildOutput)
-> [Char]
-> IO (Either [Char] BuildOutput)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] BuildOutput
forall a b. a -> Either a b
Left ([Char] -> IO (Either [Char] BuildOutput))
-> [Char] -> IO (Either [Char] BuildOutput)
forall a b. (a -> b) -> a -> b
$ [Char]
"multiple json files found in: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
outDir
readBuildOutput [Char]
root ProjectType
_ = do
  let outDir :: [Char]
outDir = [Char]
root [Char] -> ShowS
</> [Char]
"out"
  [[Char]]
jsons <- [Char] -> IO [[Char]]
findJsonFiles [Char]
outDir
  case ([[Char]] -> [[Char]]
filterMetadata [[Char]]
jsons) of
    [] -> Either [Char] BuildOutput -> IO (Either [Char] BuildOutput)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] BuildOutput -> IO (Either [Char] BuildOutput))
-> ([Char] -> Either [Char] BuildOutput)
-> [Char]
-> IO (Either [Char] BuildOutput)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] BuildOutput
forall a b. a -> Either a b
Left ([Char] -> IO (Either [Char] BuildOutput))
-> [Char] -> IO (Either [Char] BuildOutput)
forall a b. (a -> b) -> a -> b
$ [Char]
"no json files found in: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
outDir
    [[Char]]
js -> do
      Either [Char] [BuildOutput]
outputs <- [Either [Char] BuildOutput] -> Either [Char] [BuildOutput]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Either [Char] BuildOutput] -> Either [Char] [BuildOutput])
-> IO [Either [Char] BuildOutput]
-> IO (Either [Char] [BuildOutput])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> IO (Either [Char] BuildOutput))
-> [[Char]] -> IO [Either [Char] BuildOutput]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ProjectType -> [Char] -> [Char] -> IO (Either [Char] BuildOutput)
readSolc ProjectType
Foundry [Char]
root) ((ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> ShowS
(</>) ([Char]
outDir))) [[Char]]
js)
      Either [Char] BuildOutput -> IO (Either [Char] BuildOutput)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] BuildOutput -> IO (Either [Char] BuildOutput))
-> (Either [Char] [BuildOutput] -> Either [Char] BuildOutput)
-> Either [Char] [BuildOutput]
-> IO (Either [Char] BuildOutput)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([BuildOutput] -> BuildOutput)
-> Either [Char] [BuildOutput] -> Either [Char] BuildOutput
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [BuildOutput] -> BuildOutput
forall a. Monoid a => [a] -> a
mconcat) (Either [Char] [BuildOutput] -> IO (Either [Char] BuildOutput))
-> Either [Char] [BuildOutput] -> IO (Either [Char] BuildOutput)
forall a b. (a -> b) -> a -> b
$ Either [Char] [BuildOutput]
outputs

-- | Finds all json files under the provided filepath, searches recursively
findJsonFiles :: FilePath -> IO [FilePath]
findJsonFiles :: [Char] -> IO [[Char]]
findJsonFiles [Char]
root =  ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [Char]
"kompiled") -- HACK: this gets added to `out` by `kontrol`
                  ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [[Char]] -> IO [[Char]]
getDirectoryFiles [Char]
root [[Char]
"**/*.json"]

-- | Filters out metadata json files
filterMetadata :: [FilePath] -> [FilePath]
filterMetadata :: [[Char]] -> [[Char]]
filterMetadata = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf [Char]
".metadata.json")

makeSourceCache :: FilePath -> Sources -> Asts -> IO SourceCache
makeSourceCache :: [Char] -> Sources -> Asts -> IO SourceCache
makeSourceCache [Char]
root (Sources Map SrcFile (Maybe ByteString)
sources) (Asts Map Text Value
asts) = do
  Map Int ([Char], ByteString)
files <- [(Int, ([Char], ByteString))] -> Map Int ([Char], ByteString)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Int, ([Char], ByteString))] -> Map Int ([Char], ByteString))
-> IO [(Int, ([Char], ByteString))]
-> IO (Map Int ([Char], ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SrcFile, Maybe ByteString)]
-> ((SrcFile, Maybe ByteString) -> IO (Int, ([Char], ByteString)))
-> IO [(Int, ([Char], ByteString))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map SrcFile (Maybe ByteString) -> [(SrcFile, Maybe ByteString)]
forall k a. Map k a -> [(k, a)]
Map.toList Map SrcFile (Maybe ByteString)
sources) (\x :: (SrcFile, Maybe ByteString)
x@(SrcFile Int
id' [Char]
fp, Maybe ByteString
_) -> do
      ByteString
contents <- case (SrcFile, Maybe ByteString)
x of
        (SrcFile
_,  Just ByteString
content) -> ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
content
        (SrcFile Int
_ [Char]
_, Maybe ByteString
Nothing) -> [Char] -> IO ByteString
BS.readFile ([Char]
root [Char] -> ShowS
</> [Char]
fp)
      (Int, ([Char], ByteString)) -> IO (Int, ([Char], ByteString))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
id', ([Char]
fp, ByteString
contents))
    )
  SourceCache -> IO SourceCache
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceCache -> IO SourceCache) -> SourceCache -> IO SourceCache
forall a b. (a -> b) -> a -> b
$! SourceCache
    { $sel:files:SourceCache :: Map Int ([Char], ByteString)
files = Map Int ([Char], ByteString)
files
    , $sel:lines:SourceCache :: Map Int (Vector ByteString)
lines = (([Char], ByteString) -> Vector ByteString)
-> Map Int ([Char], ByteString) -> Map Int (Vector ByteString)
forall a b. (a -> b) -> Map Int a -> Map Int b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([ByteString] -> Vector ByteString
forall a. [a] -> Vector a
Vector.fromList ([ByteString] -> Vector ByteString)
-> (([Char], ByteString) -> [ByteString])
-> ([Char], ByteString)
-> Vector ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
BS.split Word8
0xa (ByteString -> [ByteString])
-> (([Char], ByteString) -> ByteString)
-> ([Char], ByteString)
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], ByteString) -> ByteString
forall a b. (a, b) -> b
snd) Map Int ([Char], ByteString)
files
    , $sel:asts:SourceCache :: Map Text Value
asts  = Map Text Value
asts
    }

lineSubrange ::
  Vector ByteString -> (Int, Int) -> Int -> Maybe (Int, Int)
lineSubrange :: Vector ByteString -> (Int, Int) -> Int -> Maybe (Int, Int)
lineSubrange Vector ByteString
xs (Int
s1, Int
n1) Int
i =
  let
    ks :: Vector Int
ks = (ByteString -> Int) -> Vector ByteString -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
Vector.map (\ByteString
x -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
x) Vector ByteString
xs
    s2 :: Int
s2  = Vector Int -> Int
forall a. Num a => Vector a -> a
Vector.sum (Int -> Vector Int -> Vector Int
forall a. Int -> Vector a -> Vector a
Vector.take Int
i Vector Int
ks)
    n2 :: Int
n2  = Vector Int
ks Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
Vector.! Int
i
  in
    if Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s2 Bool -> Bool -> Bool
|| Int
s1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
s2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2
    then Maybe (Int, Int)
forall a. Maybe a
Nothing
    else (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s2, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
s2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s1) Int
n1)

readSolc :: ProjectType -> FilePath -> FilePath -> IO (Either String BuildOutput)
readSolc :: ProjectType -> [Char] -> [Char] -> IO (Either [Char] BuildOutput)
readSolc ProjectType
pt [Char]
root [Char]
fp = do
  -- NOTE: we cannot and must not use Data.Text.IO.readFile because that takes the locale
  --       and may fail with very strange errors when the JSON it's reading
  --       contains any UTF-8 character -- which it will with foundry
  let fileContents :: IO Text
fileContents = (ByteString -> Text) -> IO ByteString -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
Data.Text.Encoding.decodeUtf8 ([Char] -> IO ByteString
Data.ByteString.readFile [Char]
fp)
  (ProjectType -> Text -> Text -> Maybe (Contracts, Asts, Sources)
readJSON ProjectType
pt ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
takeBaseName [Char]
fp) (Text -> Maybe (Contracts, Asts, Sources))
-> IO Text -> IO (Maybe (Contracts, Asts, Sources))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
fileContents) IO (Maybe (Contracts, Asts, Sources))
-> (Maybe (Contracts, Asts, Sources)
    -> IO (Either [Char] BuildOutput))
-> IO (Either [Char] BuildOutput)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    \case
      Maybe (Contracts, Asts, Sources)
Nothing -> Either [Char] BuildOutput -> IO (Either [Char] BuildOutput)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] BuildOutput -> IO (Either [Char] BuildOutput))
-> ([Char] -> Either [Char] BuildOutput)
-> [Char]
-> IO (Either [Char] BuildOutput)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] BuildOutput
forall a b. a -> Either a b
Left ([Char] -> IO (Either [Char] BuildOutput))
-> [Char] -> IO (Either [Char] BuildOutput)
forall a b. (a -> b) -> a -> b
$ [Char]
"unable to parse: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
fp
      Just (Contracts
contracts, Asts
asts, Sources
sources) -> do
        SourceCache
sourceCache <- [Char] -> Sources -> Asts -> IO SourceCache
makeSourceCache [Char]
root Sources
sources Asts
asts
        Either [Char] BuildOutput -> IO (Either [Char] BuildOutput)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BuildOutput -> Either [Char] BuildOutput
forall a b. b -> Either a b
Right (Contracts -> SourceCache -> BuildOutput
BuildOutput Contracts
contracts SourceCache
sourceCache))

yul :: Text -> Text -> IO (Maybe ByteString)
yul :: Text -> Text -> IO (Maybe ByteString)
yul Text
contractName Text
src = do
  Text
json <- Language -> Text -> IO Text
solc Language
Yul Text
src
  let f :: Value
f = (Text
json Text -> Optic' An_AffineTraversal NoIx Text Value -> Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Text Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"contracts") Value -> Optic' An_AffineTraversal NoIx Value Value -> Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key (Text -> Key
Key.fromText Text
"hevm.sol")
      c :: Value
c = Value
f Value -> Optic' An_AffineTraversal NoIx Value Value -> Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key (Text -> Key
Key.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
contractName then Text
"object" else Text
contractName)
      bytecode :: Text
bytecode = Value
c Value -> Optic' An_AffineTraversal NoIx Value Value -> Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"evm" Value -> Optic' An_AffineTraversal NoIx Value Value -> Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"bytecode" Value -> Optic' An_AffineTraversal NoIx Value Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"object" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String
  Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> ByteString
toCode Text
contractName) (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
bytecode)

yulRuntime :: Text -> Text -> IO (Maybe ByteString)
yulRuntime :: Text -> Text -> IO (Maybe ByteString)
yulRuntime Text
contractName Text
src = do
  Text
json <- Language -> Text -> IO Text
solc Language
Yul Text
src
  let f :: Value
f = (Text
json Text -> Optic' An_AffineTraversal NoIx Text Value -> Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Text Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"contracts") Value -> Optic' An_AffineTraversal NoIx Value Value -> Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key (Text -> Key
Key.fromText Text
"hevm.sol")
      c :: Value
c = Value
f Value -> Optic' An_AffineTraversal NoIx Value Value -> Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key (Text -> Key
Key.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
contractName then Text
"object" else Text
contractName)
      bytecode :: Text
bytecode = Value
c Value -> Optic' An_AffineTraversal NoIx Value Value -> Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"evm" Value -> Optic' An_AffineTraversal NoIx Value Value -> Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"deployedBytecode" Value -> Optic' An_AffineTraversal NoIx Value Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"object" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String
  Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> ByteString
toCode Text
contractName) (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
bytecode)

solidity
  :: (MonadUnliftIO m)
  => Text -> Text -> m (Maybe ByteString)
solidity :: forall (m :: * -> *).
MonadUnliftIO m =>
Text -> Text -> m (Maybe ByteString)
solidity Text
contract Text
src = IO (Maybe ByteString) -> m (Maybe ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
-> IO (Maybe ByteString) -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ do
  Text
json <- Language -> Text -> IO Text
solc Language
Solidity Text
src
  let (Contracts Map Text SolcContract
sol, Asts
_, Sources
_) = Maybe (Contracts, Asts, Sources) -> (Contracts, Asts, Sources)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Contracts, Asts, Sources) -> (Contracts, Asts, Sources))
-> Maybe (Contracts, Asts, Sources) -> (Contracts, Asts, Sources)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Contracts, Asts, Sources)
readStdJSON Text
json
  Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Text -> Map Text SolcContract -> Maybe SolcContract
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text
"hevm.sol:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contract) Map Text SolcContract
sol Maybe SolcContract
-> (SolcContract -> ByteString) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (.creationCode)

solcRuntime
  :: (MonadUnliftIO m)
  => Text -> Text -> m (Maybe ByteString)
solcRuntime :: forall (m :: * -> *).
MonadUnliftIO m =>
Text -> Text -> m (Maybe ByteString)
solcRuntime Text
contract Text
src = IO (Maybe ByteString) -> m (Maybe ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
-> IO (Maybe ByteString) -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ do
  Text
json <- Language -> Text -> IO Text
solc Language
Solidity Text
src
  case Text -> Maybe (Contracts, Asts, Sources)
readStdJSON Text
json of
    Just (Contracts Map Text SolcContract
sol, Asts
_, Sources
_) -> Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Text -> Map Text SolcContract -> Maybe SolcContract
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text
"hevm.sol:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contract) Map Text SolcContract
sol Maybe SolcContract
-> (SolcContract -> ByteString) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (.runtimeCode)
    Maybe (Contracts, Asts, Sources)
Nothing -> [Char] -> IO (Maybe ByteString)
forall a. HasCallStack => [Char] -> a
internalError ([Char] -> IO (Maybe ByteString))
-> [Char] -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ [Char]
"unable to parse solidity output:\n" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Text -> [Char]
T.unpack Text
json)

functionAbi :: Text -> IO Method
functionAbi :: Text -> IO Method
functionAbi Text
f = do
  Text
json <- Language -> Text -> IO Text
solc Language
Solidity (Text
"contract ABI { function " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" public {}}")
  let (Contracts Map Text SolcContract
sol, Asts
_, Sources
_) = (Contracts, Asts, Sources)
-> Maybe (Contracts, Asts, Sources) -> (Contracts, Asts, Sources)
forall a. a -> Maybe a -> a
fromMaybe
                                ([Char] -> (Contracts, Asts, Sources)
forall a. HasCallStack => [Char] -> a
internalError ([Char] -> (Contracts, Asts, Sources))
-> (Text -> [Char]) -> Text -> (Contracts, Asts, Sources)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> (Contracts, Asts, Sources))
-> Text -> (Contracts, Asts, Sources)
forall a b. (a -> b) -> a -> b
$ Text
"unable to parse solc output:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
json)
                                (Text -> Maybe (Contracts, Asts, Sources)
readStdJSON Text
json)
  case Map FunctionSelector Method -> [(FunctionSelector, Method)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map FunctionSelector Method -> [(FunctionSelector, Method)])
-> Map FunctionSelector Method -> [(FunctionSelector, Method)]
forall a b. (a -> b) -> a -> b
$ (Maybe SolcContract -> SolcContract
forall a. HasCallStack => Maybe a -> a
fromJust (Text -> Map Text SolcContract -> Maybe SolcContract
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"hevm.sol:ABI" Map Text SolcContract
sol)).abiMap of
     [(FunctionSelector
_,Method
b)] -> Method -> IO Method
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Method
b
     [(FunctionSelector, Method)]
_ -> [Char] -> IO Method
forall a. HasCallStack => [Char] -> a
internalError [Char]
"unexpected abi format"

force :: String -> Maybe a -> a
force :: forall a. [Char] -> Maybe a -> a
force [Char]
s = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> a
forall a. HasCallStack => [Char] -> a
internalError [Char]
s)

readJSON :: ProjectType -> Text -> Text -> Maybe (Contracts, Asts, Sources)
readJSON :: ProjectType -> Text -> Text -> Maybe (Contracts, Asts, Sources)
readJSON ProjectType
DappTools Text
_ Text
json = Text -> Maybe (Contracts, Asts, Sources)
readStdJSON Text
json
readJSON ProjectType
CombinedJSON Text
_ Text
json = Text -> Maybe (Contracts, Asts, Sources)
readCombinedJSON Text
json
readJSON ProjectType
_ Text
contractName Text
json = Text -> Text -> Maybe (Contracts, Asts, Sources)
readFoundryJSON Text
contractName Text
json

-- | Reads a foundry json output
readFoundryJSON :: Text -> Text -> Maybe (Contracts, Asts, Sources)
readFoundryJSON :: Text -> Text -> Maybe (Contracts, Asts, Sources)
readFoundryJSON Text
contractName Text
json = do
  Value
runtime <- Text
json Text -> Optic' An_AffineTraversal NoIx Text Value -> Maybe Value
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Text Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"deployedBytecode"
  ByteString
runtimeCode <- (Text -> Text -> ByteString
toCode Text
contractName) (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
strip0x'' (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
runtime Value -> Optic' An_AffineTraversal NoIx Value Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"object" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String
  Seq SrcMap
runtimeSrcMap <- case Value
runtime Value -> Optic' An_AffineTraversal NoIx Value Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"sourceMap" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String of
    Maybe Text
Nothing -> Text -> Maybe (Seq SrcMap)
makeSrcMaps Text
""
    Maybe Text
smap -> Text -> Maybe (Seq SrcMap)
makeSrcMaps (Text -> Maybe (Seq SrcMap)) -> Maybe Text -> Maybe (Seq SrcMap)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
smap

  Value
creation <- Text
json Text -> Optic' An_AffineTraversal NoIx Text Value -> Maybe Value
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Text Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"bytecode"
  ByteString
creationCode <- (Text -> Text -> ByteString
toCode Text
contractName) (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
strip0x'' (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
creation Value -> Optic' An_AffineTraversal NoIx Value Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"object" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String
  Seq SrcMap
creationSrcMap <- case Value
creation Value -> Optic' An_AffineTraversal NoIx Value Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"sourceMap" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String of
    Maybe Text
Nothing -> Text -> Maybe (Seq SrcMap)
makeSrcMaps Text
""
    Maybe Text
smap -> Text -> Maybe (Seq SrcMap)
makeSrcMaps (Text -> Maybe (Seq SrcMap)) -> Maybe Text -> Maybe (Seq SrcMap)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
smap

  Value
ast <- Text
json Text -> Optic' An_AffineTraversal NoIx Text Value -> Maybe Value
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Text Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"ast"
  Text
path <- Value
ast Value -> Optic' An_AffineTraversal NoIx Value Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"absolutePath" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String

  [Value]
abi <- Vector Value -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector Value -> [Value]) -> Maybe (Vector Value) -> Maybe [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
json Text
-> Optic' An_AffineTraversal NoIx Text (Vector Value)
-> Maybe (Vector Value)
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Text Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"abi" Optic' An_AffineTraversal NoIx Text Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Optic' An_AffineTraversal NoIx Text (Vector Value)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
_Array

  Int
id' <- Integer -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (Integer -> Int) -> Maybe Integer -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
json Text
-> Optic' An_AffineTraversal NoIx Text Integer -> Maybe Integer
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Text Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"id" Optic' An_AffineTraversal NoIx Text Value
-> Optic A_Prism NoIx Value Value Integer Integer
-> Optic' An_AffineTraversal NoIx Text Integer
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Integer Integer
forall t. AsNumber t => Prism' t Integer
_Integer

  let contract :: SolcContract
contract = SolcContract
        { $sel:runtimeCodehash:SolcContract :: W256
runtimeCodehash     = ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
runtimeCode)
        , $sel:creationCodehash:SolcContract :: W256
creationCodehash    = ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
creationCode)
        , $sel:runtimeCode:SolcContract :: ByteString
runtimeCode         = ByteString
runtimeCode
        , $sel:creationCode:SolcContract :: ByteString
creationCode        = ByteString
creationCode
        , $sel:contractName:SolcContract :: Text
contractName        = Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contractName
        , $sel:abiMap:SolcContract :: Map FunctionSelector Method
abiMap              = [Value] -> Map FunctionSelector Method
mkAbiMap [Value]
abi
        , $sel:eventMap:SolcContract :: Map W256 Event
eventMap            = [Value] -> Map W256 Event
mkEventMap [Value]
abi
        , $sel:errorMap:SolcContract :: Map W256 SolError
errorMap            = [Value] -> Map W256 SolError
mkErrorMap [Value]
abi
        , $sel:runtimeSrcmap:SolcContract :: Seq SrcMap
runtimeSrcmap       = Seq SrcMap
runtimeSrcMap
        , $sel:creationSrcmap:SolcContract :: Seq SrcMap
creationSrcmap      = Seq SrcMap
creationSrcMap
        , $sel:constructorInputs:SolcContract :: [(Text, AbiType)]
constructorInputs   = [Value] -> [(Text, AbiType)]
mkConstructor [Value]
abi
        , $sel:storageLayout:SolcContract :: Maybe (Map Text StorageItem)
storageLayout       = Maybe Value -> Maybe (Map Text StorageItem)
mkStorageLayout (Maybe Value -> Maybe (Map Text StorageItem))
-> Maybe Value -> Maybe (Map Text StorageItem)
forall a b. (a -> b) -> a -> b
$ Text
json Text -> Optic' An_AffineTraversal NoIx Text Value -> Maybe Value
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Text Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"storageLayout"
        , $sel:immutableReferences:SolcContract :: Map W256 [Reference]
immutableReferences = Map W256 [Reference]
forall a. Monoid a => a
mempty -- TODO: foundry doesn't expose this?
        }
  (Contracts, Asts, Sources) -> Maybe (Contracts, Asts, Sources)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( Map Text SolcContract -> Contracts
Contracts (Map Text SolcContract -> Contracts)
-> Map Text SolcContract -> Contracts
forall a b. (a -> b) -> a -> b
$ Text -> SolcContract -> Map Text SolcContract
forall k a. k -> a -> Map k a
Map.singleton (Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contractName) SolcContract
contract
         , Map Text Value -> Asts
Asts      (Map Text Value -> Asts) -> Map Text Value -> Asts
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Map Text Value
forall k a. k -> a -> Map k a
Map.singleton Text
path Value
ast
         , Map SrcFile (Maybe ByteString) -> Sources
Sources   (Map SrcFile (Maybe ByteString) -> Sources)
-> Map SrcFile (Maybe ByteString) -> Sources
forall a b. (a -> b) -> a -> b
$ SrcFile -> Maybe ByteString -> Map SrcFile (Maybe ByteString)
forall k a. k -> a -> Map k a
Map.singleton (Int -> [Char] -> SrcFile
SrcFile Int
id' (Text -> [Char]
T.unpack Text
path)) Maybe ByteString
forall a. Maybe a
Nothing
         )

-- | Parses the standard json output from solc
readStdJSON :: Text -> Maybe (Contracts, Asts, Sources)
readStdJSON :: Text -> Maybe (Contracts, Asts, Sources)
readStdJSON Text
json = do
  HashMap Text Value
contracts <- Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
KeyMap.toHashMapText (Object -> HashMap Text Value)
-> Maybe Object -> Maybe (HashMap Text Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
json Text -> Optic' An_AffineTraversal NoIx Text Object -> Maybe Object
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Text Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"contracts" Optic' An_AffineTraversal NoIx Text Value
-> Optic A_Prism NoIx Value Value Object Object
-> Optic' An_AffineTraversal NoIx Text Object
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Object Object
forall t. AsValue t => Prism' t Object
_Object
  -- TODO: support the general case of "urls" and "content" in the standard json
  HashMap Text Value
sources <- Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
KeyMap.toHashMapText (Object -> HashMap Text Value)
-> Maybe Object -> Maybe (HashMap Text Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Text
json Text -> Optic' An_AffineTraversal NoIx Text Object -> Maybe Object
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Text Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"sources" Optic' An_AffineTraversal NoIx Text Value
-> Optic A_Prism NoIx Value Value Object Object
-> Optic' An_AffineTraversal NoIx Text Object
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Object Object
forall t. AsValue t => Prism' t Object
_Object
  let asts :: HashMap Text Value
asts = [Char] -> Maybe Value -> Value
forall a. [Char] -> Maybe a -> a
force [Char]
"JSON lacks abstract syntax trees." (Maybe Value -> Value) -> (Value -> Maybe Value) -> Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' An_AffineTraversal NoIx Value Value -> Value -> Maybe Value
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"ast") (Value -> Value) -> HashMap Text Value -> HashMap Text Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text Value
sources
      contractMap :: Map Text (SolcContract, HashMap Text Text)
contractMap = HashMap Text Value -> Map Text (SolcContract, HashMap Text Text)
forall s.
AsValue s =>
HashMap Text s -> Map Text (SolcContract, HashMap Text Text)
f HashMap Text Value
contracts
      getId :: Text -> Int
getId Text
src = Integer -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ ([Char] -> Maybe Value -> Value
forall a. [Char] -> Maybe a -> a
force [Char]
"" (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMap.lookup Text
src HashMap Text Value
sources) Value -> Optic' An_AffineTraversal NoIx Value Integer -> Integer
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"id" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Integer Integer
-> Optic' An_AffineTraversal NoIx Value Integer
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Integer Integer
forall t. AsNumber t => Prism' t Integer
_Integer
      contents :: Text -> (SrcFile, Maybe ByteString)
contents Text
src = (Int -> [Char] -> SrcFile
SrcFile (Text -> Int
getId Text
src) (Text -> [Char]
T.unpack Text
src), Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMap.lookup Text
src ([HashMap Text Text] -> HashMap Text Text
forall a. Monoid a => [a] -> a
mconcat ([HashMap Text Text] -> HashMap Text Text)
-> [HashMap Text Text] -> HashMap Text Text
forall a b. (a -> b) -> a -> b
$ Map Text (HashMap Text Text) -> [HashMap Text Text]
forall k a. Map k a -> [a]
Map.elems (Map Text (HashMap Text Text) -> [HashMap Text Text])
-> Map Text (HashMap Text Text) -> [HashMap Text Text]
forall a b. (a -> b) -> a -> b
$ (SolcContract, HashMap Text Text) -> HashMap Text Text
forall a b. (a, b) -> b
snd ((SolcContract, HashMap Text Text) -> HashMap Text Text)
-> Map Text (SolcContract, HashMap Text Text)
-> Map Text (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (SolcContract, HashMap Text Text)
contractMap))
  (Contracts, Asts, Sources) -> Maybe (Contracts, Asts, Sources)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( Map Text SolcContract -> Contracts
Contracts (Map Text SolcContract -> Contracts)
-> Map Text SolcContract -> Contracts
forall a b. (a -> b) -> a -> b
$ (SolcContract, HashMap Text Text) -> SolcContract
forall a b. (a, b) -> a
fst ((SolcContract, HashMap Text Text) -> SolcContract)
-> Map Text (SolcContract, HashMap Text Text)
-> Map Text SolcContract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (SolcContract, HashMap Text Text)
contractMap
         , Map Text Value -> Asts
Asts      (Map Text Value -> Asts) -> Map Text Value -> Asts
forall a b. (a -> b) -> a -> b
$ [(Text, Value)] -> Map Text Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList HashMap Text Value
asts)
         , Map SrcFile (Maybe ByteString) -> Sources
Sources   (Map SrcFile (Maybe ByteString) -> Sources)
-> Map SrcFile (Maybe ByteString) -> Sources
forall a b. (a -> b) -> a -> b
$ [(SrcFile, Maybe ByteString)] -> Map SrcFile (Maybe ByteString)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(SrcFile, Maybe ByteString)] -> Map SrcFile (Maybe ByteString))
-> [(SrcFile, Maybe ByteString)] -> Map SrcFile (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Text -> (SrcFile, Maybe ByteString)
contents (Text -> (SrcFile, Maybe ByteString))
-> [Text] -> [(SrcFile, Maybe ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ HashMap Text Value -> [Text]
forall k v. HashMap k v -> [k]
HMap.keys HashMap Text Value
sources)
         )
  where
    f :: (AsValue s) => HMap.HashMap Text s -> (Map Text (SolcContract, (HMap.HashMap Text Text)))
    f :: forall s.
AsValue s =>
HashMap Text s -> Map Text (SolcContract, HashMap Text Text)
f HashMap Text s
x = [(Text, (SolcContract, HashMap Text Text))]
-> Map Text (SolcContract, HashMap Text Text)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, (SolcContract, HashMap Text Text))]
 -> Map Text (SolcContract, HashMap Text Text))
-> (HashMap Text s -> [(Text, (SolcContract, HashMap Text Text))])
-> HashMap Text s
-> Map Text (SolcContract, HashMap Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Text, s) -> [(Text, (SolcContract, HashMap Text Text))])
-> [(Text, s)] -> [(Text, (SolcContract, HashMap Text Text))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, s) -> [(Text, (SolcContract, HashMap Text Text))]
forall {s}.
AsValue s =>
(Text, s) -> [(Text, (SolcContract, HashMap Text Text))]
g) ([(Text, s)] -> [(Text, (SolcContract, HashMap Text Text))])
-> (HashMap Text s -> [(Text, s)])
-> HashMap Text s
-> [(Text, (SolcContract, HashMap Text Text))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text s -> [(Text, s)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList (HashMap Text s -> Map Text (SolcContract, HashMap Text Text))
-> HashMap Text s -> Map Text (SolcContract, HashMap Text Text)
forall a b. (a -> b) -> a -> b
$ HashMap Text s
x
    g :: (Text, s) -> [(Text, (SolcContract, HashMap Text Text))]
g (Text
s, s
x) = Text -> (Text, Value) -> (Text, (SolcContract, HashMap Text Text))
h Text
s ((Text, Value) -> (Text, (SolcContract, HashMap Text Text)))
-> [(Text, Value)] -> [(Text, (SolcContract, HashMap Text Text))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList (Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
KeyMap.toHashMapText (Object -> Maybe Object -> Object
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Object
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Could not parse json object") (Optic' A_Prism NoIx s Object -> s -> Maybe Object
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic' A_Prism NoIx s Object
forall t. AsValue t => Prism' t Object
_Object s
x)))
    h :: Text -> (Text, Value) -> (Text, (SolcContract, HMap.HashMap Text Text))
    h :: Text -> (Text, Value) -> (Text, (SolcContract, HashMap Text Text))
h Text
s (Text
c, Value
x) =
      let
        evmstuff :: Value
evmstuff = Value
x Value -> Optic' An_AffineTraversal NoIx Value Value -> Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"evm"
        sc :: Text
sc = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c
        runtime :: Value
runtime = Value
evmstuff Value -> Optic' An_AffineTraversal NoIx Value Value -> Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"deployedBytecode"
        creation :: Value
creation =  Value
evmstuff Value -> Optic' An_AffineTraversal NoIx Value Value -> Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"bytecode"
        theRuntimeCode :: ByteString
theRuntimeCode = (Text -> Text -> ByteString
toCode Text
sc) (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Value
runtime Value -> Optic' An_AffineTraversal NoIx Value Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"object" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String
        theCreationCode :: ByteString
theCreationCode = (Text -> Text -> ByteString
toCode Text
sc) (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Value
creation Value -> Optic' An_AffineTraversal NoIx Value Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"object" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String
        srcContents :: Maybe (HMap.HashMap Text Text)
        srcContents :: Maybe (HashMap Text Text)
srcContents = do Text
metadata <- Value
x Value -> Optic' An_AffineTraversal NoIx Value Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"metadata" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String
                         HashMap Text Value
srcs <- Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
KeyMap.toHashMapText (Object -> HashMap Text Value)
-> Maybe Object -> Maybe (HashMap Text Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
metadata Text -> Optic' An_AffineTraversal NoIx Text Object -> Maybe Object
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Text Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"sources" Optic' An_AffineTraversal NoIx Text Value
-> Optic A_Prism NoIx Value Value Object Object
-> Optic' An_AffineTraversal NoIx Text Object
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Object Object
forall t. AsValue t => Prism' t Object
_Object
                         HashMap Text Text -> Maybe (HashMap Text Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Text Text -> Maybe (HashMap Text Text))
-> HashMap Text Text -> Maybe (HashMap Text Text)
forall a b. (a -> b) -> a -> b
$ (Value -> Text) -> HashMap Text Value -> HashMap Text Text
forall a b. (a -> b) -> HashMap Text a -> HashMap Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                           (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Text
forall a. HasCallStack => [Char] -> a
internalError [Char]
"could not parse contents field into a string") (Maybe Text -> Text) -> (Value -> Maybe Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' An_AffineTraversal NoIx Value Text -> Value -> Maybe Text
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"content" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String))
                           ((Value -> Bool) -> HashMap Text Value -> HashMap Text Value
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HMap.filter (Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Value -> Bool) -> (Value -> Maybe Value) -> Value -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' An_AffineTraversal NoIx Value Value -> Value -> Maybe Value
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"content")) HashMap Text Value
srcs)
        abis :: [Value]
abis = [Char] -> Maybe [Value] -> [Value]
forall a. [Char] -> Maybe a -> a
force ([Char]
"abi key not found in " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> [Char]
forall a. Show a => a -> [Char]
show Value
x) (Maybe [Value] -> [Value]) -> Maybe [Value] -> [Value]
forall a b. (a -> b) -> a -> b
$
          Vector Value -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector Value -> [Value]) -> Maybe (Vector Value) -> Maybe [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
x Value
-> Optic' An_AffineTraversal NoIx Value (Vector Value)
-> Maybe (Vector Value)
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"abi" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Optic' An_AffineTraversal NoIx Value (Vector Value)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
_Array
      in (Text
sc, (SolcContract {
        $sel:runtimeCode:SolcContract :: ByteString
runtimeCode      = ByteString
theRuntimeCode,
        $sel:creationCode:SolcContract :: ByteString
creationCode     = ByteString
theCreationCode,
        $sel:runtimeCodehash:SolcContract :: W256
runtimeCodehash  = ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
theRuntimeCode),
        $sel:creationCodehash:SolcContract :: W256
creationCodehash = ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
theCreationCode),
        $sel:runtimeSrcmap:SolcContract :: Seq SrcMap
runtimeSrcmap    = [Char] -> Maybe (Seq SrcMap) -> Seq SrcMap
forall a. [Char] -> Maybe a -> a
force [Char]
"srcmap-runtime" (Text -> Maybe (Seq SrcMap)
makeSrcMaps (Value
runtime Value -> Optic' An_AffineTraversal NoIx Value Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"sourceMap" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String)),
        $sel:creationSrcmap:SolcContract :: Seq SrcMap
creationSrcmap   = [Char] -> Maybe (Seq SrcMap) -> Seq SrcMap
forall a. [Char] -> Maybe a -> a
force [Char]
"srcmap" (Text -> Maybe (Seq SrcMap)
makeSrcMaps (Value
creation Value -> Optic' An_AffineTraversal NoIx Value Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"sourceMap" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String)),
        $sel:contractName:SolcContract :: Text
contractName = Text
sc,
        $sel:constructorInputs:SolcContract :: [(Text, AbiType)]
constructorInputs = [Value] -> [(Text, AbiType)]
mkConstructor [Value]
abis,
        $sel:abiMap:SolcContract :: Map FunctionSelector Method
abiMap        = [Value] -> Map FunctionSelector Method
mkAbiMap [Value]
abis,
        $sel:eventMap:SolcContract :: Map W256 Event
eventMap      = [Value] -> Map W256 Event
mkEventMap [Value]
abis,
        $sel:errorMap:SolcContract :: Map W256 SolError
errorMap      = [Value] -> Map W256 SolError
mkErrorMap [Value]
abis,
        $sel:storageLayout:SolcContract :: Maybe (Map Text StorageItem)
storageLayout = Maybe Value -> Maybe (Map Text StorageItem)
mkStorageLayout (Maybe Value -> Maybe (Map Text StorageItem))
-> Maybe Value -> Maybe (Map Text StorageItem)
forall a b. (a -> b) -> a -> b
$ Value
x Value -> Optic' An_AffineTraversal NoIx Value Value -> Maybe Value
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"storageLayout",
        $sel:immutableReferences:SolcContract :: Map W256 [Reference]
immutableReferences = Map W256 [Reference]
-> Maybe (Map W256 [Reference]) -> Map W256 [Reference]
forall a. a -> Maybe a -> a
fromMaybe Map W256 [Reference]
forall a. Monoid a => a
mempty (Maybe (Map W256 [Reference]) -> Map W256 [Reference])
-> Maybe (Map W256 [Reference]) -> Map W256 [Reference]
forall a b. (a -> b) -> a -> b
$
          do Value
x' <- Value
runtime Value -> Optic' An_AffineTraversal NoIx Value Value -> Maybe Value
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"immutableReferences"
             case Value -> Result (Map W256 [Reference])
forall a. FromJSON a => Value -> Result a
fromJSON Value
x' of
               Success Map W256 [Reference]
a -> Map W256 [Reference] -> Maybe (Map W256 [Reference])
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map W256 [Reference]
a
               Result (Map W256 [Reference])
_ -> Maybe (Map W256 [Reference])
forall a. Maybe a
Nothing
      }, HashMap Text Text -> Maybe (HashMap Text Text) -> HashMap Text Text
forall a. a -> Maybe a -> a
fromMaybe HashMap Text Text
forall a. Monoid a => a
mempty Maybe (HashMap Text Text)
srcContents))

-- deprecate me soon
readCombinedJSON :: Text -> Maybe (Contracts, Asts, Sources)
readCombinedJSON :: Text -> Maybe (Contracts, Asts, Sources)
readCombinedJSON Text
json = do
  Map Text SolcContract
contracts <- HashMap Text Value -> Map Text SolcContract
forall {v1}. AsValue v1 => HashMap Text v1 -> Map Text SolcContract
f (HashMap Text Value -> Map Text SolcContract)
-> (Object -> HashMap Text Value)
-> Object
-> Map Text SolcContract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
KeyMap.toHashMapText (Object -> Map Text SolcContract)
-> Maybe Object -> Maybe (Map Text SolcContract)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text
json Text -> Optic' An_AffineTraversal NoIx Text Object -> Maybe Object
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Text Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"contracts" Optic' An_AffineTraversal NoIx Text Value
-> Optic A_Prism NoIx Value Value Object Object
-> Optic' An_AffineTraversal NoIx Text Object
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Object Object
forall t. AsValue t => Prism' t Object
_Object)
  [Maybe Text]
sources <- Vector (Maybe Text) -> [Maybe Text]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector (Maybe Text) -> [Maybe Text])
-> (Vector Value -> Vector (Maybe Text))
-> Vector Value
-> [Maybe Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Maybe Text) -> Vector Value -> Vector (Maybe Text)
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Optic A_Prism NoIx Value Value Text Text -> Value -> Maybe Text
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String) (Vector Value -> [Maybe Text])
-> Maybe (Vector Value) -> Maybe [Maybe Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
json Text
-> Optic' An_AffineTraversal NoIx Text (Vector Value)
-> Maybe (Vector Value)
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Text Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"sourceList" Optic' An_AffineTraversal NoIx Text Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Optic' An_AffineTraversal NoIx Text (Vector Value)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
_Array
  (Contracts, Asts, Sources) -> Maybe (Contracts, Asts, Sources)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( Map Text SolcContract -> Contracts
Contracts Map Text SolcContract
contracts
       , Map Text Value -> Asts
Asts ([(Text, Value)] -> Map Text Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList HashMap Text Value
asts))
       , Map SrcFile (Maybe ByteString) -> Sources
Sources (Map SrcFile (Maybe ByteString) -> Sources)
-> Map SrcFile (Maybe ByteString) -> Sources
forall a b. (a -> b) -> a -> b
$ [(SrcFile, Maybe ByteString)] -> Map SrcFile (Maybe ByteString)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(SrcFile, Maybe ByteString)] -> Map SrcFile (Maybe ByteString))
-> [(SrcFile, Maybe ByteString)] -> Map SrcFile (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$
           (\(Text
path, Int
id') -> (Int -> [Char] -> SrcFile
SrcFile Int
id' (Text -> [Char]
T.unpack Text
path), Maybe ByteString
forall a. Maybe a
Nothing)) ((Text, Int) -> (SrcFile, Maybe ByteString))
-> [(Text, Int)] -> [(SrcFile, Maybe ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
             [Text] -> [Int] -> [(Text, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Text]
sources) [Int
0..]
       )
  where
    asts :: HashMap Text Value
asts = Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
KeyMap.toHashMapText (Object -> HashMap Text Value) -> Object -> HashMap Text Value
forall a b. (a -> b) -> a -> b
$ Object -> Maybe Object -> Object
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Object
forall a. HasCallStack => [Char] -> a
error [Char]
"JSON lacks abstract syntax trees.") (Text
json Text -> Optic' An_AffineTraversal NoIx Text Object -> Maybe Object
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Text Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"sources" Optic' An_AffineTraversal NoIx Text Value
-> Optic A_Prism NoIx Value Value Object Object
-> Optic' An_AffineTraversal NoIx Text Object
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Object Object
forall t. AsValue t => Prism' t Object
_Object)
    f :: HashMap Text v1 -> Map Text SolcContract
f HashMap Text v1
x = [(Text, SolcContract)] -> Map Text SolcContract
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, SolcContract)] -> Map Text SolcContract)
-> (HashMap Text SolcContract -> [(Text, SolcContract)])
-> HashMap Text SolcContract
-> Map Text SolcContract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text SolcContract -> [(Text, SolcContract)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList (HashMap Text SolcContract -> Map Text SolcContract)
-> HashMap Text SolcContract -> Map Text SolcContract
forall a b. (a -> b) -> a -> b
$ (Text -> v1 -> SolcContract)
-> HashMap Text v1 -> HashMap Text SolcContract
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HMap.mapWithKey Text -> v1 -> SolcContract
forall {s}. AsValue s => Text -> s -> SolcContract
g HashMap Text v1
x
    g :: Text -> s -> SolcContract
g Text
s s
x =
      let
        theRuntimeCode :: ByteString
theRuntimeCode = (Text -> Text -> ByteString
toCode Text
s) (s
x s -> Optic' An_AffineTraversal NoIx s Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"bin-runtime" AffineTraversal' s Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx s Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String)
        theCreationCode :: ByteString
theCreationCode = (Text -> Text -> ByteString
toCode Text
s) (s
x s -> Optic' An_AffineTraversal NoIx s Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"bin" AffineTraversal' s Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx s Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String)
        abis :: [Value]
abis = Vector Value -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector Value -> [Value]) -> Vector Value -> [Value]
forall a b. (a -> b) -> a -> b
$ case (s
x s -> AffineTraversal' s Value -> Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"abi") Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Maybe (Vector Value)
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
_Array of
                 Just Vector Value
v -> Vector Value
v                                       -- solc >= 0.8
                 Maybe (Vector Value)
Nothing -> (s
x s -> Optic' An_AffineTraversal NoIx s Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"abi" AffineTraversal' s Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx s Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String) Text -> Optic' A_Prism NoIx Text (Vector Value) -> Vector Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Optic' A_Prism NoIx Text (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
_Array -- solc <  0.8
      in SolcContract {
        $sel:runtimeCode:SolcContract :: ByteString
runtimeCode      = ByteString
theRuntimeCode,
        $sel:creationCode:SolcContract :: ByteString
creationCode     = ByteString
theCreationCode,
        $sel:runtimeCodehash:SolcContract :: W256
runtimeCodehash  = ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
theRuntimeCode),
        $sel:creationCodehash:SolcContract :: W256
creationCodehash = ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
theCreationCode),
        $sel:runtimeSrcmap:SolcContract :: Seq SrcMap
runtimeSrcmap    = [Char] -> Maybe (Seq SrcMap) -> Seq SrcMap
forall a. [Char] -> Maybe a -> a
force [Char]
"internal error: srcmap-runtime" (Text -> Maybe (Seq SrcMap)
makeSrcMaps (s
x s -> Optic' An_AffineTraversal NoIx s Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"srcmap-runtime" AffineTraversal' s Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx s Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String)),
        $sel:creationSrcmap:SolcContract :: Seq SrcMap
creationSrcmap   = [Char] -> Maybe (Seq SrcMap) -> Seq SrcMap
forall a. [Char] -> Maybe a -> a
force [Char]
"internal error: srcmap" (Text -> Maybe (Seq SrcMap)
makeSrcMaps (s
x s -> Optic' An_AffineTraversal NoIx s Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"srcmap" AffineTraversal' s Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx s Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String)),
        $sel:contractName:SolcContract :: Text
contractName = Text
s,
        $sel:constructorInputs:SolcContract :: [(Text, AbiType)]
constructorInputs = [Value] -> [(Text, AbiType)]
mkConstructor [Value]
abis,
        $sel:abiMap:SolcContract :: Map FunctionSelector Method
abiMap       = [Value] -> Map FunctionSelector Method
mkAbiMap [Value]
abis,
        $sel:eventMap:SolcContract :: Map W256 Event
eventMap     = [Value] -> Map W256 Event
mkEventMap [Value]
abis,
        $sel:errorMap:SolcContract :: Map W256 SolError
errorMap     = [Value] -> Map W256 SolError
mkErrorMap [Value]
abis,
        $sel:storageLayout:SolcContract :: Maybe (Map Text StorageItem)
storageLayout = Maybe Value -> Maybe (Map Text StorageItem)
mkStorageLayout (Maybe Value -> Maybe (Map Text StorageItem))
-> Maybe Value -> Maybe (Map Text StorageItem)
forall a b. (a -> b) -> a -> b
$ s
x s -> AffineTraversal' s Value -> Maybe Value
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"storage-layout",
        $sel:immutableReferences:SolcContract :: Map W256 [Reference]
immutableReferences = Map W256 [Reference]
forall a. Monoid a => a
mempty -- TODO: deprecate combined-json
      }

mkAbiMap :: [Value] -> Map FunctionSelector Method
mkAbiMap :: [Value] -> Map FunctionSelector Method
mkAbiMap [Value]
abis = [(FunctionSelector, Method)] -> Map FunctionSelector Method
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(FunctionSelector, Method)] -> Map FunctionSelector Method)
-> [(FunctionSelector, Method)] -> Map FunctionSelector Method
forall a b. (a -> b) -> a -> b
$
  let
    relevant :: [Value]
relevant = (Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Value
y -> Text
"function" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Value
y Value -> Optic' An_AffineTraversal NoIx Value Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"type" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String) [Value]
abis
    f :: s -> (FunctionSelector, Method)
f s
abi =
      (ByteString -> FunctionSelector
abiKeccak (Text -> ByteString
encodeUtf8 (s -> Text
forall s. AsValue s => s -> Text
signature s
abi)),
       Method { $sel:name:Method :: Text
name = s
abi s -> Optic' An_AffineTraversal NoIx s Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"name" AffineTraversal' s Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx s Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String
              , $sel:methodSignature:Method :: Text
methodSignature = s -> Text
forall s. AsValue s => s -> Text
signature s
abi
              , $sel:inputs:Method :: [(Text, AbiType)]
inputs = (Value -> (Text, AbiType)) -> [Value] -> [(Text, AbiType)]
forall a b. (a -> b) -> [a] -> [b]
map Value -> (Text, AbiType)
forall s. AsValue s => s -> (Text, AbiType)
parseMethodInput
                 (Vector Value -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (s
abi s
-> Optic' An_AffineTraversal NoIx s (Vector Value) -> Vector Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"inputs" AffineTraversal' s Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Optic' An_AffineTraversal NoIx s (Vector Value)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
_Array))
              , $sel:output:Method :: [(Text, AbiType)]
output = (Value -> (Text, AbiType)) -> [Value] -> [(Text, AbiType)]
forall a b. (a -> b) -> [a] -> [b]
map Value -> (Text, AbiType)
forall s. AsValue s => s -> (Text, AbiType)
parseMethodInput
                 (Vector Value -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (s
abi s
-> Optic' An_AffineTraversal NoIx s (Vector Value) -> Vector Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"outputs" AffineTraversal' s Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Optic' An_AffineTraversal NoIx s (Vector Value)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
_Array))
              , $sel:mutability:Method :: Mutability
mutability = Text -> Mutability
parseMutability
                 (s
abi s -> Optic' An_AffineTraversal NoIx s Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"stateMutability" AffineTraversal' s Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx s Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String)
              })
  in Value -> (FunctionSelector, Method)
forall {s}. AsValue s => s -> (FunctionSelector, Method)
f (Value -> (FunctionSelector, Method))
-> [Value] -> [(FunctionSelector, Method)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
relevant

mkEventMap :: [Value] -> Map W256 Event
mkEventMap :: [Value] -> Map W256 Event
mkEventMap [Value]
abis = [(W256, Event)] -> Map W256 Event
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(W256, Event)] -> Map W256 Event)
-> [(W256, Event)] -> Map W256 Event
forall a b. (a -> b) -> a -> b
$
  let
    relevant :: [Value]
relevant = (Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Value
y -> Text
"event" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Value
y Value -> Optic' An_AffineTraversal NoIx Value Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"type" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String) [Value]
abis
    f :: s -> (W256, Event)
f s
abi =
     ( ByteString -> W256
keccak' (Text -> ByteString
encodeUtf8 (s -> Text
forall s. AsValue s => s -> Text
signature s
abi))
     , Text -> Anonymity -> [(Text, AbiType, Indexed)] -> Event
Event
       (s
abi s -> Optic' An_AffineTraversal NoIx s Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"name" AffineTraversal' s Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx s Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String)
       (case s
abi s -> Optic' An_AffineTraversal NoIx s Bool -> Bool
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"anonymous" AffineTraversal' s Value
-> Optic A_Prism NoIx Value Value Bool Bool
-> Optic' An_AffineTraversal NoIx s Bool
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Bool Bool
forall t. AsValue t => Prism' t Bool
_Bool of
         Bool
True -> Anonymity
Anonymous
         Bool
False -> Anonymity
NotAnonymous)
       ((Value -> (Text, AbiType, Indexed))
-> [Value] -> [(Text, AbiType, Indexed)]
forall a b. (a -> b) -> [a] -> [b]
map (\Value
y ->
        ( Value
y Value -> Optic' An_AffineTraversal NoIx Value Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"name" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String
        , [Char] -> Maybe AbiType -> AbiType
forall a. [Char] -> Maybe a -> a
force [Char]
"type" (Value -> Maybe AbiType
forall s. AsValue s => s -> Maybe AbiType
parseTypeName' Value
y)
        , if Value
y Value -> Optic' An_AffineTraversal NoIx Value Bool -> Bool
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"indexed" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Bool Bool
-> Optic' An_AffineTraversal NoIx Value Bool
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Bool Bool
forall t. AsValue t => Prism' t Bool
_Bool
          then Indexed
Indexed
          else Indexed
NotIndexed
        ))
       (Vector Value -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector Value -> [Value]) -> Vector Value -> [Value]
forall a b. (a -> b) -> a -> b
$ s
abi s
-> Optic' An_AffineTraversal NoIx s (Vector Value) -> Vector Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"inputs" AffineTraversal' s Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Optic' An_AffineTraversal NoIx s (Vector Value)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
_Array))
     )
  in Value -> (W256, Event)
forall {s}. AsValue s => s -> (W256, Event)
f (Value -> (W256, Event)) -> [Value] -> [(W256, Event)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
relevant

mkErrorMap :: [Value] -> Map W256 SolError
mkErrorMap :: [Value] -> Map W256 SolError
mkErrorMap [Value]
abis = [(W256, SolError)] -> Map W256 SolError
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(W256, SolError)] -> Map W256 SolError)
-> [(W256, SolError)] -> Map W256 SolError
forall a b. (a -> b) -> a -> b
$
  let
    relevant :: [Value]
relevant = (Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Value
y -> Text
"error" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Value
y Value -> Optic' An_AffineTraversal NoIx Value Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"type" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String) [Value]
abis
    f :: s -> (W256, SolError)
f s
abi =
     ( W256 -> W256
stripKeccak (W256 -> W256) -> W256 -> W256
forall a b. (a -> b) -> a -> b
$ ByteString -> W256
keccak' (Text -> ByteString
encodeUtf8 (s -> Text
forall s. AsValue s => s -> Text
signature s
abi))
     , Text -> [AbiType] -> SolError
SolError
       (s
abi s -> Optic' An_AffineTraversal NoIx s Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"name" AffineTraversal' s Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx s Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String)
       ((Value -> AbiType) -> [Value] -> [AbiType]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Maybe AbiType -> AbiType
forall a. [Char] -> Maybe a -> a
force [Char]
"internal error: type" (Maybe AbiType -> AbiType)
-> (Value -> Maybe AbiType) -> Value -> AbiType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe AbiType
forall s. AsValue s => s -> Maybe AbiType
parseTypeName')
       (Vector Value -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector Value -> [Value]) -> Vector Value -> [Value]
forall a b. (a -> b) -> a -> b
$ s
abi s
-> Optic' An_AffineTraversal NoIx s (Vector Value) -> Vector Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"inputs" AffineTraversal' s Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Optic' An_AffineTraversal NoIx s (Vector Value)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
_Array))
     )
  in Value -> (W256, SolError)
forall {s}. AsValue s => s -> (W256, SolError)
f (Value -> (W256, SolError)) -> [Value] -> [(W256, SolError)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
relevant
  where
    stripKeccak :: W256 -> W256
    stripKeccak :: W256 -> W256
stripKeccak = [Char] -> W256
forall a. Read a => [Char] -> a
read ([Char] -> W256) -> (W256 -> [Char]) -> W256 -> W256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
10 ShowS -> (W256 -> [Char]) -> W256 -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. W256 -> [Char]
forall a. Show a => a -> [Char]
show

mkConstructor :: [Value] -> [(Text, AbiType)]
mkConstructor :: [Value] -> [(Text, AbiType)]
mkConstructor [Value]
abis =
  let
    isConstructor :: s -> Bool
isConstructor s
y =
      Text
"constructor" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== s
y s -> Optic' An_AffineTraversal NoIx s Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"type" AffineTraversal' s Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx s Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String
  in
    case (Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter Value -> Bool
forall {s}. AsValue s => s -> Bool
isConstructor [Value]
abis of
      [Value
abi] -> (Value -> (Text, AbiType)) -> [Value] -> [(Text, AbiType)]
forall a b. (a -> b) -> [a] -> [b]
map Value -> (Text, AbiType)
forall s. AsValue s => s -> (Text, AbiType)
parseMethodInput (Vector Value -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Value
abi Value
-> Optic' An_AffineTraversal NoIx Value (Vector Value)
-> Vector Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"inputs" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Optic' An_AffineTraversal NoIx Value (Vector Value)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
_Array))
      [] -> [] -- default constructor has zero inputs
      [Value]
_  -> [Char] -> [(Text, AbiType)]
forall a. HasCallStack => [Char] -> a
internalError [Char]
"strange: contract has multiple constructors"

mkStorageLayout :: Maybe Value -> Maybe (Map Text StorageItem)
mkStorageLayout :: Maybe Value -> Maybe (Map Text StorageItem)
mkStorageLayout Maybe Value
Nothing = Maybe (Map Text StorageItem)
forall a. Maybe a
Nothing
mkStorageLayout (Just Value
json) = do
  Vector Value
items <- Value
json Value
-> Optic' An_AffineTraversal NoIx Value (Vector Value)
-> Maybe (Vector Value)
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"storage" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Optic' An_AffineTraversal NoIx Value (Vector Value)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
_Array
  Value
types <- Value
json Value -> Optic' An_AffineTraversal NoIx Value Value -> Maybe Value
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"types"
  ([(Text, StorageItem)] -> Map Text StorageItem)
-> Maybe [(Text, StorageItem)] -> Maybe (Map Text StorageItem)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Text, StorageItem)] -> Map Text StorageItem
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Value]
-> (Value -> Maybe (Text, StorageItem))
-> Maybe [(Text, StorageItem)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Vector Value -> [Value]
forall a. Vector a -> [a]
Vector.toList Vector Value
items) ((Value -> Maybe (Text, StorageItem))
 -> Maybe [(Text, StorageItem)])
-> (Value -> Maybe (Text, StorageItem))
-> Maybe [(Text, StorageItem)]
forall a b. (a -> b) -> a -> b
$ \Value
item ->
    do Text
name <- Value
item Value -> Optic' An_AffineTraversal NoIx Value Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"label" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String
       Int
offset <- Value
item Value
-> Optic' An_AffineTraversal NoIx Value Scientific
-> Maybe Scientific
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"offset" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Scientific Scientific
-> Optic' An_AffineTraversal NoIx Value Scientific
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Scientific Scientific
forall t. AsNumber t => Prism' t Scientific
_Number Maybe Scientific -> (Scientific -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger
       Text
slot <- Value
item Value -> Optic' An_AffineTraversal NoIx Value Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"slot" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String
       Key
typ <- Text -> Key
Key.fromText (Text -> Key) -> Maybe Text -> Maybe Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
item Value -> Optic' An_AffineTraversal NoIx Value Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"type" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String
       Text
slotType <- Value
types Value -> Optic' An_AffineTraversal NoIx Value Value -> Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
typ Value -> Optic' An_AffineTraversal NoIx Value Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"label" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String
       (Text, StorageItem) -> Maybe (Text, StorageItem)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
name, SlotType -> Int -> Int -> StorageItem
StorageItem ([Char] -> SlotType
forall a. Read a => [Char] -> a
read ([Char] -> SlotType) -> [Char] -> SlotType
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
slotType) Int
offset ([Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
slot)))

signature :: AsValue s => s -> Text
signature :: forall s. AsValue s => s -> Text
signature s
abi =
  case s
abi s -> Optic' An_AffineTraversal NoIx s Value -> Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"type" of
    Value
"fallback" -> Text
"<fallback>"
    Value
_ ->
      [Text] -> Text
forall a. Monoid a => [a] -> a
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [
        Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"<constructor>" (s
abi s -> Optic' An_AffineTraversal NoIx s Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"name" Optic' An_AffineTraversal NoIx s Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx s Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String), Text
"(",
        Text -> [Text] -> Text
intercalate Text
","
          ((Value -> Text) -> [Value] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Value
x -> Value
x Value -> Optic' An_AffineTraversal NoIx Value Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"type" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String)
            (Vector Value -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector Value -> [Value]) -> Vector Value -> [Value]
forall a b. (a -> b) -> a -> b
$ s
abi s
-> Optic' An_AffineTraversal NoIx s (Vector Value) -> Vector Value
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> Optic' An_AffineTraversal NoIx s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"inputs" Optic' An_AffineTraversal NoIx s Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Optic' An_AffineTraversal NoIx s (Vector Value)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
_Array)),
        Text
")"
      ]

-- Helper function to convert the fields to the desired type
parseTypeName' :: AsValue s => s -> Maybe AbiType
parseTypeName' :: forall s. AsValue s => s -> Maybe AbiType
parseTypeName' s
x =
  Vector AbiType -> Text -> Maybe AbiType
parseTypeName
    (Vector AbiType -> Maybe (Vector AbiType) -> Vector AbiType
forall a. a -> Maybe a -> a
fromMaybe Vector AbiType
forall a. Monoid a => a
mempty (Maybe (Vector AbiType) -> Vector AbiType)
-> Maybe (Vector AbiType) -> Vector AbiType
forall a b. (a -> b) -> a -> b
$ s
x s
-> Optic' An_AffineFold NoIx s (Vector AbiType)
-> Maybe (Vector AbiType)
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"components" AffineTraversal' s Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Optic An_AffineTraversal NoIx s s (Vector Value) (Vector Value)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
_Array Optic An_AffineTraversal NoIx s s (Vector Value) (Vector Value)
-> Optic
     A_Getter
     NoIx
     (Vector Value)
     (Vector Value)
     (Vector AbiType)
     (Vector AbiType)
-> Optic' An_AffineFold NoIx s (Vector AbiType)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Vector Value -> Vector AbiType)
-> Optic
     A_Getter
     NoIx
     (Vector Value)
     (Vector Value)
     (Vector AbiType)
     (Vector AbiType)
forall s a. (s -> a) -> Getter s a
to Vector Value -> Vector AbiType
parseComponents)
    (s
x s -> Optic' An_AffineTraversal NoIx s Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"type" AffineTraversal' s Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx s Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String)
  where parseComponents :: Vector Value -> Vector AbiType
parseComponents = (Value -> AbiType) -> Vector Value -> Vector AbiType
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Value -> AbiType) -> Vector Value -> Vector AbiType)
-> (Value -> AbiType) -> Vector Value -> Vector AbiType
forall a b. (a -> b) -> a -> b
$ (Text, AbiType) -> AbiType
forall a b. (a, b) -> b
snd ((Text, AbiType) -> AbiType)
-> (Value -> (Text, AbiType)) -> Value -> AbiType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> (Text, AbiType)
forall s. AsValue s => s -> (Text, AbiType)
parseMethodInput

parseMutability :: Text -> Mutability
parseMutability :: Text -> Mutability
parseMutability Text
"view" = Mutability
View
parseMutability Text
"pure" = Mutability
Pure
parseMutability Text
"nonpayable" = Mutability
NonPayable
parseMutability Text
"payable" = Mutability
Payable
parseMutability Text
_ = [Char] -> Mutability
forall a. HasCallStack => [Char] -> a
internalError [Char]
"unknown function mutability"

-- This actually can also parse a method output! :O
parseMethodInput :: AsValue s => s -> (Text, AbiType)
parseMethodInput :: forall s. AsValue s => s -> (Text, AbiType)
parseMethodInput s
x =
  ( s
x s -> Optic' An_AffineTraversal NoIx s Text -> Text
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Key -> AffineTraversal' s Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"name" AffineTraversal' s Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx s Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String
  , [Char] -> Maybe AbiType -> AbiType
forall a. [Char] -> Maybe a -> a
force [Char]
"method type" (s -> Maybe AbiType
forall s. AsValue s => s -> Maybe AbiType
parseTypeName' s
x)
  )

containsLinkerHole :: Text -> Bool
containsLinkerHole :: Text -> Bool
containsLinkerHole = Text -> Text -> Bool
regexMatches Text
"__\\$[a-z0-9]{34}\\$__"

toCode :: Text -> Text -> ByteString
toCode :: Text -> Text -> ByteString
toCode Text
contractName Text
t = case ByteString -> Either Text ByteString
BS16.decodeBase16 (Text -> ByteString
encodeUtf8 Text
t) of
  Right ByteString
d -> ByteString
d
  Left Text
e -> if Text -> Bool
containsLinkerHole Text
t
            then [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text
"Error toCode: unlinked libraries detected in bytecode, in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contractName)
            else [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text
"Error toCode:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contractName)

solc :: Language -> Text -> IO Text
solc :: Language -> Text -> IO Text
solc Language
lang Text
src =
  [Char] -> Text
T.pack ([Char] -> Text) -> IO [Char] -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [[Char]] -> [Char] -> IO [Char]
readProcess
    [Char]
"solc"
    [[Char]
"--standard-json"]
    (Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Language -> Text -> Text
stdjson Language
lang Text
src)

data Language = Solidity | Yul
  deriving (Int -> Language -> ShowS
[Language] -> ShowS
Language -> [Char]
(Int -> Language -> ShowS)
-> (Language -> [Char]) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Language -> ShowS
showsPrec :: Int -> Language -> ShowS
$cshow :: Language -> [Char]
show :: Language -> [Char]
$cshowList :: [Language] -> ShowS
showList :: [Language] -> ShowS
Show)

data StandardJSON = StandardJSON Language Text
-- more options later perhaps

instance ToJSON StandardJSON where
  toJSON :: StandardJSON -> Value
toJSON (StandardJSON Language
lang Text
src) =
    [Pair] -> Value
object [ Key
"language" Key -> [Char] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Language -> [Char]
forall a. Show a => a -> [Char]
show Language
lang
           , Key
"sources" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Pair] -> Value
object [Key
"hevm.sol" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
                                   [Pair] -> Value
object [Key
"content" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
src]]
           , Key
"settings" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
             [Pair] -> Value
object [ Key
"outputSelection" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
                    [Pair] -> Value
object [Key
"*" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
                      [Pair] -> Value
object [Key
"*" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ([[Char]] -> Value
forall a. ToJSON a => a -> Value
toJSON
                              [[Char]
"metadata" :: String,
                               [Char]
"evm.bytecode",
                               [Char]
"evm.deployedBytecode",
                               [Char]
"abi",
                               [Char]
"storageLayout",
                               [Char]
"evm.bytecode.sourceMap",
                               [Char]
"evm.bytecode.linkReferences",
                               [Char]
"evm.bytecode.generatedSources",
                               [Char]
"evm.deployedBytecode.sourceMap",
                               [Char]
"evm.deployedBytecode.linkReferences",
                               [Char]
"evm.deployedBytecode.generatedSources",
                               [Char]
"evm.deployedBytecode.immutableReferences"
                              ]),
                              Key
"" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ([[Char]] -> Value
forall a. ToJSON a => a -> Value
toJSON [[Char]
"ast" :: String])
                             ]
                            ]
                    ]
           ]

stdjson :: Language -> Text -> Text
stdjson :: Language -> Text -> Text
stdjson Language
lang Text
src = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ StandardJSON -> ByteString
forall a. ToJSON a => a -> ByteString
encode (StandardJSON -> ByteString) -> StandardJSON -> ByteString
forall a b. (a -> b) -> a -> b
$ Language -> Text -> StandardJSON
StandardJSON Language
lang Text
src

-- | When doing CREATE and passing constructor arguments, Solidity loads
-- the argument data via the creation bytecode, since there is no "calldata"
-- for CREATE.
--
-- This interferes with our ability to look up the current contract by
-- codehash, so we must somehow strip away this extra suffix. Luckily
-- we can detect the end of the actual bytecode by looking for the
-- "metadata hash". (Not 100% correct, but works in practice.)
--
-- Actually, we strip away the entire BZZR suffix too, because as long
-- as the codehash matches otherwise, we don't care if there is some
-- difference there.
stripBytecodeMetadata :: ByteString -> ByteString
stripBytecodeMetadata :: ByteString -> ByteString
stripBytecodeMetadata ByteString
bs =
  let stripCandidates :: [(ByteString, ByteString)]
stripCandidates = (ByteString -> ByteString -> (ByteString, ByteString))
-> ByteString -> ByteString -> (ByteString, ByteString)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
bs (ByteString -> (ByteString, ByteString))
-> [ByteString] -> [(ByteString, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
knownBzzrPrefixes in
    case ((ByteString, ByteString) -> Bool)
-> [(ByteString, ByteString)] -> Maybe (ByteString, ByteString)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
forall a. Monoid a => a
mempty) (ByteString -> Bool)
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd) [(ByteString, ByteString)]
stripCandidates of
      Maybe (ByteString, ByteString)
Nothing -> ByteString
bs
      Just (ByteString
b, ByteString
_) -> ByteString
b

stripBytecodeMetadataSym :: [Expr Byte] -> [Expr Byte]
stripBytecodeMetadataSym :: [Expr 'Byte] -> [Expr 'Byte]
stripBytecodeMetadataSym [Expr 'Byte]
b =
  let
    concretes :: [Maybe Word8]
    concretes :: [Maybe Word8]
concretes = Expr 'Byte -> Maybe Word8
maybeLitByte (Expr 'Byte -> Maybe Word8) -> [Expr 'Byte] -> [Maybe Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr 'Byte]
b
    bzzrs :: [[Maybe Word8]]
    bzzrs :: [[Maybe Word8]]
bzzrs = (Word8 -> Maybe Word8) -> [Word8] -> [Maybe Word8]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just) ([Word8] -> [Maybe Word8])
-> (ByteString -> [Word8]) -> ByteString -> [Maybe Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack (ByteString -> [Maybe Word8]) -> [ByteString] -> [[Maybe Word8]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
knownBzzrPrefixes
    candidates :: [Bool]
candidates = (([Maybe Word8] -> [Maybe Word8] -> Bool)
-> [Maybe Word8] -> [Maybe Word8] -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Maybe Word8] -> [Maybe Word8] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
Data.List.isInfixOf [Maybe Word8]
concretes) ([Maybe Word8] -> Bool) -> [[Maybe Word8]] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Maybe Word8]]
bzzrs
  in case Bool -> [Bool] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Bool
True [Bool]
candidates of
    Maybe Int
Nothing -> [Expr 'Byte]
b
    Just Int
i -> let ind :: Int
ind = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ [Maybe Word8] -> [Maybe Word8] -> Maybe Int
forall a. Eq a => [a] -> [a] -> Maybe Int
infixIndex ([[Maybe Word8]]
bzzrs [[Maybe Word8]] -> Int -> [Maybe Word8]
forall a. HasCallStack => [a] -> Int -> a
!! Int
i) [Maybe Word8]
concretes
              in Int -> [Expr 'Byte] -> [Expr 'Byte]
forall a. Int -> [a] -> [a]
take Int
ind [Expr 'Byte]
b

infixIndex :: (Eq a) => [a] -> [a] -> Maybe Int
infixIndex :: forall a. Eq a => [a] -> [a] -> Maybe Int
infixIndex [a]
needle [a]
haystack = ([a] -> Bool) -> [[a]] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
needle) ([a] -> [[a]]
forall a. [a] -> [[a]]
tails [a]
haystack)

knownBzzrPrefixes :: [ByteString]
knownBzzrPrefixes :: [ByteString]
knownBzzrPrefixes = [
  -- a1 65 "bzzr0" 0x58 0x20 (solc <= 0.5.8)
  [Word8] -> ByteString
BS.pack [Word8
0xa1, Word8
0x65, Word8
98, Word8
122, Word8
122, Word8
114, Word8
48, Word8
0x58, Word8
0x20],
  -- a2 65 "bzzr0" 0x58 0x20 (solc >= 0.5.9)
  [Word8] -> ByteString
BS.pack [Word8
0xa2, Word8
0x65, Word8
98, Word8
122, Word8
122, Word8
114, Word8
48, Word8
0x58, Word8
0x20],
  -- a2 65 "bzzr1" 0x58 0x20 (solc >= 0.5.11)
  [Word8] -> ByteString
BS.pack [Word8
0xa2, Word8
0x65, Word8
98, Word8
122, Word8
122, Word8
114, Word8
49, Word8
0x58, Word8
0x20],
  -- a2 64 "ipfs" 0x58 0x22 (solc >= 0.6.0)
  [Word8] -> ByteString
BS.pack [Word8
0xa2, Word8
0x64, Word8
0x69, Word8
0x70, Word8
0x66, Word8
0x73, Word8
0x58, Word8
0x22]
  ]

-- | Every node in the AST has an ID, and other nodes reference those
-- IDs.  This function recurses through the tree looking for objects
-- with the "id" key and makes a big map from ID to value.
astIdMap :: Foldable f => f Value -> Map Int Value
astIdMap :: forall (f :: * -> *). Foldable f => f Value -> Map Int Value
astIdMap = (Value -> Map Int Value) -> f Value -> Map Int Value
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Map Int Value
f
  where
    f :: Value -> Map Int Value
    f :: Value -> Map Int Value
f (Array Vector Value
x) = (Value -> Map Int Value) -> Vector Value -> Map Int Value
forall m a. Monoid m => (a -> m) -> Vector a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Map Int Value
f Vector Value
x
    f v :: Value
v@(Object Object
x) =
      let t :: Map Int Value
t = (Value -> Map Int Value) -> [Value] -> Map Int Value
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Map Int Value
f (Object -> [Value]
forall v. KeyMap v -> [v]
KeyMap.elems Object
x)
      in case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"id" Object
x of
        Maybe Value
Nothing         -> Map Int Value
t
        Just (Number Scientific
i) -> Map Int Value
t Map Int Value -> Map Int Value -> Map Int Value
forall a. Semigroup a => a -> a -> a
<> Int -> Value -> Map Int Value
forall k a. k -> a -> Map k a
Map.singleton (Scientific -> Int
forall b. Integral b => Scientific -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Scientific
i) Value
v
        Just Value
_          -> Map Int Value
t
    f Value
_ = Map Int Value
forall a. Monoid a => a
mempty

astSrcMap :: Map Int Value -> (SrcMap -> Maybe Value)
astSrcMap :: Map Int Value -> SrcMap -> Maybe Value
astSrcMap Map Int Value
astIds =
  \(SM Int
i Int
n Int
f JumpType
_ Int
_)  -> (Int, Int, Int) -> Map (Int, Int, Int) Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int
i, Int
n, Int
f) Map (Int, Int, Int) Value
tmp
  where
    tmp :: Map (Int, Int, Int) Value
    tmp :: Map (Int, Int, Int) Value
tmp =
       [((Int, Int, Int), Value)] -> Map (Int, Int, Int) Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      ([((Int, Int, Int), Value)] -> Map (Int, Int, Int) Value)
-> (Map Int Value -> [((Int, Int, Int), Value)])
-> Map Int Value
-> Map (Int, Int, Int) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Maybe ((Int, Int, Int), Value))
-> [Value] -> [((Int, Int, Int), Value)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
        (\Value
v -> do
          Text
src <- Optic' An_AffineTraversal NoIx Value Text -> Value -> Maybe Text
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"src" Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
_String) Value
v
          [Int
i, Int
n, Int
f] <- (Text -> Maybe Int) -> [Text] -> Maybe [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Int) -> (Text -> [Char]) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack) ((Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
src)
          ((Int, Int, Int), Value) -> Maybe ((Int, Int, Int), Value)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int
i, Int
n, Int
f), Value
v)
        )
      ([Value] -> [((Int, Int, Int), Value)])
-> (Map Int Value -> [Value])
-> Map Int Value
-> [((Int, Int, Int), Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Int Value -> [Value]
forall k a. Map k a -> [a]
Map.elems
      (Map Int Value -> Map (Int, Int, Int) Value)
-> Map Int Value -> Map (Int, Int, Int) Value
forall a b. (a -> b) -> a -> b
$ Map Int Value
astIds

-- needs to be here not Format due to cyclic module deps
strip0x'' :: Text -> Text
strip0x'' :: Text -> Text
strip0x'' Text
s = if Text
"0x" Text -> Text -> Bool
`T.isPrefixOf` Text
s then Int -> Text -> Text
T.drop Int
2 Text
s else Text
s