module EVM.Flatten (flatten) where

-- This module concatenates all the imported dependencies
-- of a given source file, so that you can paste the result
-- into Remix or the Etherscan contract verification page.
--
-- The concatenated files are stripped of import directives
-- and compiler version pragmas are merged into just one.
--
-- This module is mostly independent from the rest of Hevm,
-- using only the source code metadata support modules.

import EVM.Dapp (DappInfo, dappSources, regexMatches)
import EVM.Solidity (sourceAsts)
import EVM.Demand (demand)

-- We query and alter the Solidity code using the compiler's AST.
-- The AST is a deep JSON structure, so we use Aeson and Lens.
import Control.Lens (preview, view, universe)
import Data.Aeson (Value (String))
import Data.Aeson.Lens (key, _String, _Array, _Integer)

-- We use the FGL graph library for the topological sort.
-- (We use four FGL functions and they're all in different modules!)
import qualified Data.Graph.Inductive.Graph as Fgl
import qualified Data.Graph.Inductive.PatriciaTree as Fgl
import qualified Data.Graph.Inductive.Query.BFS as Fgl
import qualified Data.Graph.Inductive.Query.DFS as Fgl

-- The Solidity version pragmas can be arbitrary SemVer ranges,
-- so we use this library to parse them.
import Data.SemVer (SemVerRange, parseSemVerRange)
import qualified Data.SemVer as SemVer

import Control.Monad (forM)
import Data.ByteString (ByteString)
import Data.Foldable (foldl', toList)
import Data.List (sort, nub, (\\))
import Data.Map (Map, (!), (!?))
import Data.Maybe (mapMaybe, isJust, catMaybes, fromMaybe)
import Data.Text (Text, unpack, pack, intercalate)
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Text.Read (readMaybe)

import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.ByteString as BS

-- Define an alias for FGL graphs with text nodes and unlabeled edges.
type FileGraph = Fgl.Gr Text ()

-- | Get field either inside 'attributes' object (combined-json format)
-- or directly.
getAttribute :: Text -> Value -> Maybe Value
getAttribute :: Text -> Value -> Maybe Value
getAttribute s :: Text
s v :: Value
v = case Getting (First Value) Value Value -> Value -> Maybe Value
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key "attributes" Getting (First Value) Value Value
-> Getting (First Value) Value Value
-> Getting (First Value) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
s) Value
v of
  Nothing -> Getting (First Value) Value Value -> Value -> Maybe Value
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
s) Value
v
  Just r :: Value
r  -> Value -> Maybe Value
forall a. a -> Maybe a
Just Value
r

-- Given the AST of a source file, resolve all its imported paths.
importsFrom :: Value -> [Text]
importsFrom :: Value -> [Text]
importsFrom ast :: Value
ast =
  let
    -- We use the astonishing `universe` function from Lens
    -- to get a lazy list of every node in the AST structure.
    allNodes :: [Value]
    allNodes :: [Value]
allNodes = Value -> [Value]
forall a. Plated a => a -> [a]
universe Value
ast

    -- Given some subvalue in the AST, we check if it's an import,
    -- and if so, return its resolved import path.
    resolveImport :: Value -> Maybe Text
    resolveImport :: Value -> Maybe Text
resolveImport node :: Value
node =
      case Getting (First Value) Value Value -> Value -> Maybe Value
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key "nodeType") Value
node of
        Just (String "ImportDirective") -> Getting Text Value Text -> Value -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Value Text
forall t. AsPrimitive t => Prism' t Text
_String (Value -> Text) -> Maybe Value -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Value -> Maybe Value
getAttribute "absolutePath" Value
node
        _ ->
          case Getting (First Value) Value Value -> Value -> Maybe Value
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key "name") Value
node of
            Just (String "ImportDirective") ->
              Getting Text Value Text -> Value -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Value Text
forall t. AsPrimitive t => Prism' t Text
_String (Value -> Text) -> Maybe Value -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Value -> Maybe Value
getAttribute "absolutePath" Value
node
            _ ->
              Maybe Text
forall a. Maybe a
Nothing

  -- Now we just try to resolve import paths at all subnodes.
  in (Value -> Maybe Text) -> [Value] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Value -> Maybe Text
resolveImport [Value]
allNodes

flatten :: DappInfo -> Text -> IO ()
flatten :: DappInfo -> Text -> IO ()
flatten dapp :: DappInfo
dapp target :: Text
target = do
  let
    -- The nodes and edges are defined below.
    graph :: FileGraph
    graph :: FileGraph
graph = [LNode Text] -> [LEdge ()] -> FileGraph
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
Fgl.mkGraph [LNode Text]
nodes [LEdge ()]
edges

    -- The graph nodes are ints with source paths as labels.
    nodes :: [(Int, Text)]
    nodes :: [LNode Text]
nodes = [Int] -> [Text] -> [LNode Text]
forall a b. [a] -> [b] -> [(a, b)]
zip [1..] (Map Text Value -> [Text]
forall k a. Map k a -> [k]
Map.keys Map Text Value
asts)

    -- The graph edges are defined by module imports.
    edges :: [LEdge ()]
edges =
      [ (Map Text Int
indices Map Text Int -> Text -> Int
forall k a. Ord k => Map k a -> k -> a
! Text
s, Map Text Int
indices Map Text Int -> Text -> Int
forall k a. Ord k => Map k a -> k -> a
! Text
t, ()) -- Edge from S to T
      | (s :: Text
s, v :: Value
v) <- Map Text Value -> [(Text, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Value
asts      -- for every file S
      , Text
t      <- Value -> [Text]
importsFrom Value
v ]      -- and every T imported by S.

    -- We can look up the node index for a source file path.
    indices :: Map Text Int
    indices :: Map Text Int
indices = [(Text, Int)] -> Map Text Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text
v, Int
k) | (k :: Int
k, v :: Text
v) <- [LNode Text]
nodes]

    -- The JSON ASTs are indexed by source file path.
    asts :: Map Text Value
    asts :: Map Text Value
asts = Getting (Map Text Value) DappInfo (Map Text Value)
-> DappInfo -> Map Text Value
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SourceCache -> Const (Map Text Value) SourceCache)
-> DappInfo -> Const (Map Text Value) DappInfo
Lens' DappInfo SourceCache
dappSources ((SourceCache -> Const (Map Text Value) SourceCache)
 -> DappInfo -> Const (Map Text Value) DappInfo)
-> ((Map Text Value -> Const (Map Text Value) (Map Text Value))
    -> SourceCache -> Const (Map Text Value) SourceCache)
-> Getting (Map Text Value) DappInfo (Map Text Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Text Value -> Const (Map Text Value) (Map Text Value))
-> SourceCache -> Const (Map Text Value) SourceCache
Lens' SourceCache (Map Text Value)
sourceAsts) DappInfo
dapp

    topScopeIds :: [Integer]
    topScopeIds :: [Integer]
topScopeIds = [[Integer]] -> [Integer]
forall a. Monoid a => [a] -> a
mconcat ([[Integer]] -> [Integer]) -> [[Integer]] -> [Integer]
forall a b. (a -> b) -> a -> b
$ (Value -> [Integer]) -> [Value] -> [[Integer]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> [Integer]
f ([Value] -> [[Integer]]) -> [Value] -> [[Integer]]
forall a b. (a -> b) -> a -> b
$ Map Text Value -> [Value]
forall k a. Map k a -> [a]
Map.elems Map Text Value
asts
      where
        id' :: Value -> Maybe Integer
id' = Getting (First Integer) Value Integer -> Value -> Maybe Integer
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key "id" ((Value -> Const (First Integer) Value)
 -> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Integer) Value Integer
forall t. AsNumber t => Prism' t Integer
_Integer)
        f :: Value -> [Integer]
f ast :: Value
ast =
          [ String -> Maybe Integer -> Integer
forall a. String -> Maybe a -> a
fromJust' "no id for SourceUnit" (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Integer
id' Value
node
          | Value
node <- Value -> [Value]
forall a. Plated a => a -> [a]
universe Value
ast
          , Text -> Value -> Bool
nodeIs "SourceUnit" Value
node
          ]

    contractsAndStructsToRename :: Map Integer Text
    contractsAndStructsToRename :: Map Integer Text
contractsAndStructsToRename =
      [(Integer, Text)] -> Map Integer Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        ([(Integer, Text)] -> Map Integer Text)
-> [(Integer, Text)] -> Map Integer Text
forall a b. (a -> b) -> a -> b
$ [(Integer, Text)] -> [(Integer, Text)]
indexed [ (Integer, Text)
x | (Integer, Text)
x <- [(Integer, Text)]
xs, ((Integer, Text) -> Text
forall a b. (a, b) -> b
snd (Integer, Text)
x) Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
xs' ]
      where
        xs :: [(Integer, Text)]
xs = (Value -> [(Integer, Text)]) -> [Value] -> [(Integer, Text)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Value -> [(Integer, Text)]
f ([Value] -> [(Integer, Text)]) -> [Value] -> [(Integer, Text)]
forall a b. (a -> b) -> a -> b
$ Map Text Value -> [Value]
forall k a. Map k a -> [a]
Map.elems Map Text Value
asts
        xs' :: [Text]
xs' = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
repeated ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ ((Integer, Text) -> Text) -> [(Integer, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer, Text) -> Text
forall a b. (a, b) -> b
snd [(Integer, Text)]
xs
        scope :: Value -> Maybe Integer
scope x :: Value
x = Text -> Value -> Maybe Value
getAttribute "scope" Value
x Maybe Value -> (Value -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Getting (First Integer) Value Integer -> Value -> Maybe Integer
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Integer) Value Integer
forall t. AsNumber t => Prism' t Integer
_Integer
        name :: Value -> Maybe Text
name x :: Value
x = Text -> Value -> Maybe Value
getAttribute "name" Value
x Maybe Value -> (Value -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String
        id' :: Value -> Maybe Integer
id' = Getting (First Integer) Value Integer -> Value -> Maybe Integer
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key "id" ((Value -> Const (First Integer) Value)
 -> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Integer) Value Integer
forall t. AsNumber t => Prism' t Integer
_Integer)
        p :: Value -> Bool
p x :: Value
x = (Text -> Value -> Bool
nodeIs "ContractDefinition" Value
x Bool -> Bool -> Bool
|| Text -> Value -> Bool
nodeIs "StructDefinition" Value
x)
          Bool -> Bool -> Bool
&& (String -> Maybe Integer -> Integer
forall a. String -> Maybe a -> a
fromJust' "no contract/struct scope" (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Integer
scope Value
x) Integer -> [Integer] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Integer]
topScopeIds
        f :: Value -> [(Integer, Text)]
f ast :: Value
ast =
          [ ( String -> Maybe Integer -> Integer
forall a. String -> Maybe a -> a
fromJust' "no id for top scoped contract or struct" (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Integer
id' Value
node
            , String -> Maybe Text -> Text
forall a. String -> Maybe a -> a
fromJust' "no id for top scoped contract or struct" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Text
name Value
node
            )
          | Value
node <- Value -> [Value]
forall a. Plated a => a -> [a]
universe Value
ast
          , Value -> Bool
p Value
node
          ]

    contractStructs :: [(Integer, (Integer, Text))]
    contractStructs :: [(Integer, (Integer, Text))]
contractStructs = [[(Integer, (Integer, Text))]] -> [(Integer, (Integer, Text))]
forall a. Monoid a => [a] -> a
mconcat ([[(Integer, (Integer, Text))]] -> [(Integer, (Integer, Text))])
-> [[(Integer, (Integer, Text))]] -> [(Integer, (Integer, Text))]
forall a b. (a -> b) -> a -> b
$ (Value -> [(Integer, (Integer, Text))])
-> [Value] -> [[(Integer, (Integer, Text))]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> [(Integer, (Integer, Text))]
f ([Value] -> [[(Integer, (Integer, Text))]])
-> [Value] -> [[(Integer, (Integer, Text))]]
forall a b. (a -> b) -> a -> b
$ Map Text Value -> [Value]
forall k a. Map k a -> [a]
Map.elems Map Text Value
asts
      where
        scope :: Value -> Maybe Integer
scope x :: Value
x = Text -> Value -> Maybe Value
getAttribute "scope" Value
x Maybe Value -> (Value -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Getting (First Integer) Value Integer -> Value -> Maybe Integer
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Integer) Value Integer
forall t. AsNumber t => Prism' t Integer
_Integer
        cname :: Value -> Maybe Text
cname x :: Value
x = Text -> Value -> Maybe Value
getAttribute "canonicalName" Value
x Maybe Value -> (Value -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String
        id' :: Value -> Maybe Integer
id' = Getting (First Integer) Value Integer -> Value -> Maybe Integer
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key "id" ((Value -> Const (First Integer) Value)
 -> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Integer) Value Integer
forall t. AsNumber t => Prism' t Integer
_Integer)
        p :: Value -> Bool
p x :: Value
x = (Text -> Value -> Bool
nodeIs "StructDefinition" Value
x)
          Bool -> Bool -> Bool
&& (String -> Maybe Integer -> Integer
forall a. String -> Maybe a -> a
fromJust' "nested struct" (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Integer
scope Value
x) Integer -> Map Integer Text -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Integer Text
contractsAndStructsToRename
        f :: Value -> [(Integer, (Integer, Text))]
f ast :: Value
ast =
          [ let
              id'' :: Integer
id'' = String -> Maybe Integer -> Integer
forall a. String -> Maybe a -> a
fromJust' "no id for nested struct" (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Integer
id' Value
node
              cname' :: Text
cname' = String -> Maybe Text -> Text
forall a. String -> Maybe a -> a
fromJust'
                ("no canonical name of nested struct with id:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
id'') (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Text
cname Value
node
              ref :: Integer
ref = String -> Maybe Integer -> Integer
forall a. String -> Maybe a -> a
fromJust'
                ("no scope of nested struct with id:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
id'') (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Integer
scope Value
node
            in
              (Integer
id'', (Integer
ref, Text
cname'))
          | Value
node <- Value -> [Value]
forall a. Plated a => a -> [a]
universe Value
ast
          , Value -> Bool
p Value
node
          ]

  -- We use the target source file to make a relevant subgraph
  -- with only files transitively depended on from the target.
  case Text -> Map Text Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
target Map Text Int
indices of
    Nothing ->
      String -> IO ()
forall a. HasCallStack => String -> a
error "didn't find contract AST"
    Just root :: Int
root -> do
      let
        -- Restrict the graph to only the needed nodes,
        -- discovered via breadth-first search from the target.
        subgraph :: Fgl.Gr Text ()
        subgraph :: FileGraph
subgraph = [Int] -> FileGraph -> FileGraph
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[Int] -> gr a b -> gr a b
Fgl.subgraph (Int -> FileGraph -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> [Int]
Fgl.bfs Int
root FileGraph
graph) FileGraph
graph

        -- Now put the source file paths in the right order
        -- by sorting topologically.
        ordered :: [Text]
        ordered :: [Text]
ordered = [Text] -> [Text]
forall a. [a] -> [a]
reverse (FileGraph -> [Text]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [a]
Fgl.topsort' FileGraph
subgraph)

        -- Take the highest Solidity version from all pragmas.
        pragma :: Text
        pragma :: Text
pragma = [Value] -> Text
maximalPragma (Map Text Value -> [Value]
forall k a. Map k a -> [a]
Map.elems ((Text -> Value -> Bool) -> Map Text Value -> Map Text Value
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\k :: Text
k _ -> Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
ordered) Map Text Value
asts))

        license :: Text
        license :: Text
license = [Value] -> Text
joinLicenses (Map Text Value -> [Value]
forall k a. Map k a -> [a]
Map.elems ((Text -> Value -> Bool) -> Map Text Value -> Map Text Value
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\k :: Text
k _ -> Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
ordered) Map Text Value
asts))
      -- Read the source files in order and strip unwanted directives.
      -- Also add an informative comment with the original source file path.
      [ByteString]
sources <-
        [Text] -> (Text -> IO ByteString) -> IO [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Text]
ordered ((Text -> IO ByteString) -> IO [ByteString])
-> (Text -> IO ByteString) -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ \path :: Text
path -> do
          ByteString
src <- String -> IO ByteString
BS.readFile (Text -> String
unpack Text
path)
          ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
            [ "////// ", Text -> ByteString
encodeUtf8 Text
path, "\n"
            -- Fold over a list of source transforms
            , (ByteString, Int) -> ByteString
forall a b. (a, b) -> a
fst
                (Map Integer Text
-> [(Integer, (Integer, Text))]
-> (ByteString, Int)
-> Value
-> (ByteString, Int)
prefixContractAst
                  Map Integer Text
contractsAndStructsToRename
                  [(Integer, (Integer, Text))]
contractStructs
                  ((ByteString, Int) -> Value -> (ByteString, Int)
stripImportsAndPragmas (ByteString -> (ByteString, Int)
stripLicense ByteString
src) (Map Text Value
asts Map Text Value -> Text -> Value
forall k a. Ord k => Map k a -> k -> a
! Text
path))
                  (Map Text Value
asts Map Text Value -> Text -> Value
forall k a. Ord k => Map k a -> k -> a
! Text
path))
            , "\n"
            ]

      -- Force all evaluation before any printing happens, to avoid
      -- partial output.
      Text -> IO ()
forall (m :: * -> *) a. (MonadIO m, NFData a) => a -> m ()
demand Text
target; Text -> IO ()
forall (m :: * -> *) a. (MonadIO m, NFData a) => a -> m ()
demand Text
pragma; [ByteString] -> IO ()
forall (m :: * -> *) a. (MonadIO m, NFData a) => a -> m ()
demand [ByteString]
sources

      -- Finally print the whole concatenation.
      String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "// hevm: flattened sources of " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
target
      String -> IO ()
putStrLn (Text -> String
unpack Text
license)
      String -> IO ()
putStrLn (Text -> String
unpack Text
pragma)
      ByteString -> IO ()
BS.putStr ([ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat [ByteString]
sources)

joinLicenses :: [Value] -> Text
joinLicenses :: [Value] -> Text
joinLicenses asts :: [Value]
asts =
  case [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Value -> Maybe Text) -> [Value] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\ast :: Value
ast -> Text -> Value -> Maybe Value
getAttribute "license" Value
ast Maybe Value -> (Value -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String) [Value]
asts of
    [] -> ""
    x :: [Text]
x -> "// SPDX-License-Identifier: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate " AND " [Text]
x

-- | Construct a new Solidity version pragma for the highest mentioned version
--  given a list of source file ASTs.
maximalPragma :: [Value] -> Text
maximalPragma :: [Value] -> Text
maximalPragma asts :: [Value]
asts = (
    case (Value -> Maybe SemVerRange) -> [Value] -> [SemVerRange]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Value -> Maybe SemVerRange
versions [Value]
asts of
      [] -> "" -- allow for no pragma 
      xs :: [SemVerRange]
xs ->
        "pragma solidity "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (SemVerRange -> String
forall a. Show a => a -> String
show ([SemVerRange] -> SemVerRange
rangeIntersection [SemVerRange]
xs))
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ";\n"
  )
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> ([Value] -> [Text]) -> [Value] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> ([Value] -> [Text]) -> [Value] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text] -> [Text]) -> ([Value] -> [Text]) -> [Value] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Text) -> [Value] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ast :: Value
ast ->
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ([Value] -> Text) -> [[Value]] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (\xs :: [Value]
xs -> "pragma "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate " " [Text
x | String x :: Text
x <- [Value]
xs]
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ";\n")
        (Value -> [[Value]]
otherPragmas Value
ast)
    )
  ) [Value]
asts


  where
    isVersionPragma :: [Value] -> Bool
    isVersionPragma :: [Value] -> Bool
isVersionPragma (String "solidity" : _) = Bool
True
    isVersionPragma _ = Bool
False

    pragmaComponents :: Value -> [[Value]]
    pragmaComponents :: Value -> [[Value]]
pragmaComponents ast :: Value
ast = [[Value]]
components
      where
        ps :: [Value]
        ps :: [Value]
ps = (Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Value -> Bool
nodeIs "PragmaDirective") (Value -> [Value]
forall a. Plated a => a -> [a]
universe Value
ast)

        components :: [[Value]]
        components :: [[Value]]
components = [Maybe [Value]] -> [[Value]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [Value]] -> [[Value]]) -> [Maybe [Value]] -> [[Value]]
forall a b. (a -> b) -> a -> b
$
          (Value -> Maybe [Value]) -> [Value] -> [Maybe [Value]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (((Vector Value -> [Value]) -> Maybe (Vector Value) -> Maybe [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Value -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) (Maybe (Vector Value) -> Maybe [Value])
-> (Value -> Maybe (Vector Value)) -> Value -> Maybe [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\x :: Value
x -> Text -> Value -> Maybe Value
getAttribute "literals" Value
x Maybe Value
-> (Value -> Maybe (Vector Value)) -> Maybe (Vector Value)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Getting (First (Vector Value)) Value (Vector Value)
-> Value -> Maybe (Vector Value)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First (Vector Value)) Value (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
_Array))
          [Value]
ps

    -- Simple way to combine many SemVer ranges.  We don't actually
    -- optimize these boolean expressions, so the resulting pragma
    -- might be redundant, like ">=0.4.23 >=0.5.0 <0.6.0".
    rangeIntersection :: [SemVerRange] -> SemVerRange
    rangeIntersection :: [SemVerRange] -> SemVerRange
rangeIntersection = (SemVerRange -> SemVerRange -> SemVerRange)
-> [SemVerRange] -> SemVerRange
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 SemVerRange -> SemVerRange -> SemVerRange
SemVer.And ([SemVerRange] -> SemVerRange)
-> ([SemVerRange] -> [SemVerRange]) -> [SemVerRange] -> SemVerRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SemVerRange] -> [SemVerRange]
forall a. Eq a => [a] -> [a]
nub ([SemVerRange] -> [SemVerRange])
-> ([SemVerRange] -> [SemVerRange])
-> [SemVerRange]
-> [SemVerRange]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SemVerRange] -> [SemVerRange]
forall a. Ord a => [a] -> [a]
sort

    -- Get the semantic version range from a source file's pragma,
    -- or nothing if no pragma present.
    versions :: Value -> Maybe SemVerRange
    versions :: Value -> Maybe SemVerRange
versions ast :: Value
ast = ([Value] -> SemVerRange) -> Maybe [Value] -> Maybe SemVerRange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Value] -> SemVerRange
grok Maybe [Value]
components
      where
        components :: Maybe [Value]
        components :: Maybe [Value]
components =
          case ([Value] -> Bool) -> [[Value]] -> [[Value]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Value] -> Bool
isVersionPragma (Value -> [[Value]]
pragmaComponents Value
ast) of
            [_:xs :: [Value]
xs] -> [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [Value]
xs
            []  -> Maybe [Value]
forall a. Maybe a
Nothing
            x :: [[Value]]
x   -> String -> Maybe [Value]
forall a. HasCallStack => String -> a
error (String -> Maybe [Value]) -> String -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ "multiple version pragmas" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [[Value]] -> String
forall a. Show a => a -> String
show [[Value]]
x

        grok :: [Value] -> SemVerRange
        grok :: [Value] -> SemVerRange
grok xs :: [Value]
xs =
          let
            rangeText :: Text
rangeText = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
x | String x :: Text
x <- [Value]
xs]
          in
            case Text -> Either ParseError SemVerRange
parseSemVerRange Text
rangeText of
              Right r :: SemVerRange
r -> SemVerRange
r
              Left _ ->
                String -> SemVerRange
forall a. HasCallStack => String -> a
error ("failed to parse SemVer range " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
rangeText)

    otherPragmas :: Value -> [[Value]]
    otherPragmas :: Value -> [[Value]]
otherPragmas = (([Value] -> Bool) -> [[Value]] -> [[Value]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Value] -> Bool) -> [Value] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Bool
isVersionPragma)) ([[Value]] -> [[Value]])
-> (Value -> [[Value]]) -> Value -> [[Value]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> [[Value]]
pragmaComponents

nodeIs :: Text -> Value -> Bool
nodeIs :: Text -> Value -> Bool
nodeIs t :: Text
t x :: Value
x = Bool
isSourceNode Bool -> Bool -> Bool
&& Bool
hasRightName
  where
    isSourceNode :: Bool
isSourceNode =
      Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Getting (First Value) Value Value -> Value -> Maybe Value
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key "src") Value
x)
    hasRightName :: Bool
hasRightName =
      Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key "name" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String) Value
x
      Bool -> Bool -> Bool
|| Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key "nodeType" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String) Value
x

-- | Removes all lines containing "SPDX-License-Identifier"
stripLicense :: ByteString -> (ByteString, Int)
stripLicense :: ByteString -> (ByteString, Int)
stripLicense bs :: ByteString
bs =
  (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unlines ([Text]
lines' [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Text]
licenseLines), - [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Text -> Int) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
Text.length) (Text -> Int) -> [Text] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
licenseLines))
  where lines' :: [Text]
lines' = Text -> [Text]
Text.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
bs
        licenseLines :: [Text]
licenseLines = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
regexMatches "SPDX-License-Identifier") [Text]
lines'

-- | (bytes, offset) where offset is added or incremeneted as text is
-- inserted or removed from the source file
stripImportsAndPragmas :: (ByteString, Int) -> Value -> (ByteString, Int)
stripImportsAndPragmas :: (ByteString, Int) -> Value -> (ByteString, Int)
stripImportsAndPragmas bso :: (ByteString, Int)
bso ast :: Value
ast = (ByteString, Int) -> Value -> (Value -> Bool) -> (ByteString, Int)
stripAstNodes (ByteString, Int)
bso Value
ast Value -> Bool
p
  where
    p :: Value -> Bool
p x :: Value
x = Text -> Value -> Bool
nodeIs "ImportDirective" Value
x Bool -> Bool -> Bool
|| Text -> Value -> Bool
nodeIs "PragmaDirective" Value
x

stripAstNodes :: (ByteString, Int)-> Value -> (Value -> Bool) -> (ByteString, Int)
stripAstNodes :: (ByteString, Int) -> Value -> (Value -> Bool) -> (ByteString, Int)
stripAstNodes bso :: (ByteString, Int)
bso ast :: Value
ast p :: Value -> Bool
p =
  [(Int, Int)] -> (ByteString, Int)
cutRanges [Value -> (Int, Int)
sourceRange Value
node | Value
node <- Value -> [Value]
forall a. Plated a => a -> [a]
universe Value
ast, Value -> Bool
p Value
node]

  where
    -- Removes a set of non-overlapping ranges from a bytestring
    -- by commenting them out.
    cutRanges :: [(Int, Int)] -> (ByteString, Int)
    cutRanges :: [(Int, Int)] -> (ByteString, Int)
cutRanges ([(Int, Int)] -> [(Int, Int)]
forall a. Ord a => [a] -> [a]
sort -> [(Int, Int)]
rs) = ((ByteString, Int) -> (Int, Int) -> (ByteString, Int))
-> (ByteString, Int) -> [(Int, Int)] -> (ByteString, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (ByteString, Int) -> (Int, Int) -> (ByteString, Int)
f (ByteString, Int)
bso [(Int, Int)]
rs
      where
        f :: (ByteString, Int) -> (Int, Int) -> (ByteString, Int)
f (bs' :: ByteString
bs', n :: Int
n) (i :: Int
i, j :: Int
j) =
          ( ByteString -> Int -> Int -> ByteString
cut ByteString
bs' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
          , Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ("/*  */" :: String))

    -- Comments out the bytes between two indices from a bytestring.
    cut :: ByteString -> Int -> Int -> ByteString
    cut :: ByteString -> Int -> Int -> ByteString
cut x :: ByteString
x i :: Int
i j :: Int
j =
      let (a :: ByteString
a, b :: ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
i ByteString
x
      in ByteString
a ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> "/* " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
BS.take (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) ByteString
b ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> " */" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
BS.drop (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) ByteString
b

readAs :: Read a => Text -> Maybe a
readAs :: Text -> Maybe a
readAs = String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe a) -> (Text -> String) -> Text -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

prefixContractAst :: Map Integer Text -> [(Integer, (Integer, Text))] -> (ByteString, Int) -> Value -> (ByteString, Int)
prefixContractAst :: Map Integer Text
-> [(Integer, (Integer, Text))]
-> (ByteString, Int)
-> Value
-> (ByteString, Int)
prefixContractAst castr :: Map Integer Text
castr cs :: [(Integer, (Integer, Text))]
cs bso :: (ByteString, Int)
bso ast :: Value
ast = (ByteString, Int)
prefixAstNodes
  where
    bs :: ByteString
bs = (ByteString, Int) -> ByteString
forall a b. (a, b) -> a
fst (ByteString, Int)
bso
    refDec :: Value -> Maybe Integer
refDec x :: Value
x = Text -> Value -> Maybe Value
getAttribute "referencedDeclaration" Value
x Maybe Value -> (Value -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Getting (First Integer) Value Integer -> Value -> Maybe Integer
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Integer) Value Integer
forall t. AsNumber t => Prism' t Integer
_Integer
    name :: Value -> Maybe Text
name x :: Value
x = Text -> Value -> Maybe Value
getAttribute "name" Value
x Maybe Value -> (Value -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String
    id' :: Value -> Maybe Integer
id' = Getting (First Integer) Value Integer -> Value -> Maybe Integer
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key "id" ((Value -> Const (First Integer) Value)
 -> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Integer) Value Integer
forall t. AsNumber t => Prism' t Integer
_Integer)

    -- Is node top level defined type (contract/interface/struct)
    p :: Value -> Bool
p x :: Value
x = (Text -> Value -> Bool
nodeIs "ContractDefinition" Value
x Bool -> Bool -> Bool
|| Text -> Value -> Bool
nodeIs "StructDefinition" Value
x)
      Bool -> Bool -> Bool
&& (String -> Maybe Integer -> Integer
forall a. String -> Maybe a -> a
fromJust' "id of any" (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Integer
id' Value
x) Integer -> Map Integer Text -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Integer Text
castr

    -- Is node identifier that is referencing top level defined type
    p' :: Value -> Bool
p' x :: Value
x =
      (Text -> Value -> Bool
nodeIs "Identifier" Value
x Bool -> Bool -> Bool
|| Text -> Value -> Bool
nodeIs "UserDefinedTypeName" Value
x)
        Bool -> Bool -> Bool
&& (Maybe Integer -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Integer -> Bool) -> Maybe Integer -> Bool
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Integer
refDec Value
x) Bool -> Bool -> Bool
&& (String -> Maybe Integer -> Integer
forall a. String -> Maybe a -> a
fromJust' "refDec of ident/userdef" (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Integer
refDec Value
x) Integer -> Map Integer Text -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Integer Text
castr

    -- Is node identifier that is referencing a struct nested in a top level
    -- defined contract/interface
    p'' :: Value -> Bool
p'' x :: Value
x =
      (Text -> Value -> Bool
nodeIs "Identifier" Value
x Bool -> Bool -> Bool
|| Text -> Value -> Bool
nodeIs "UserDefinedTypeName" Value
x)
      Bool -> Bool -> Bool
&& (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool) -> Maybe Text -> Bool
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Text
name Value
x)
      Bool -> Bool -> Bool
&& (
        let
          refs :: [Integer]
refs = ((Integer, (Integer, Text)) -> Integer)
-> [(Integer, (Integer, Text))] -> [Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer, (Integer, Text)) -> Integer
forall a b. (a, b) -> a
fst [(Integer, (Integer, Text))]
cs
          i :: Integer
i = String -> Maybe Integer -> Integer
forall a. String -> Maybe a -> a
fromJust' "no id for ident/userdef" (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Integer
id' Value
x
          ref :: Integer
ref = String -> Maybe Integer -> Integer
forall a. String -> Maybe a -> a
fromJust' ("no refDec for ident/userdef: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i) (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Integer
refDec Value
x
          n :: Text
n = String -> Maybe Text -> Text
forall a. String -> Maybe a -> a
fromJust' ("no name for ident/userdef: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Text
name Value
x
          cn :: (Integer, Text)
cn = String -> Maybe (Integer, Text) -> (Integer, Text)
forall a. String -> Maybe a -> a
fromJust'
            ("no match for lookup in nested structs: "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ " -> "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
ref
            ) (Maybe (Integer, Text) -> (Integer, Text))
-> Maybe (Integer, Text) -> (Integer, Text)
forall a b. (a -> b) -> a -> b
$ Integer -> [(Integer, (Integer, Text))] -> Maybe (Integer, Text)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Integer
ref [(Integer, (Integer, Text))]
cs
        in
          -- XXX: comparing canonical name with name of nested structs
          -- might not be super great
          Integer
ref Integer -> [Integer] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Integer]
refs Bool -> Bool -> Bool
&& Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer, Text) -> Text
forall a b. (a, b) -> b
snd (Integer, Text)
cn
      )

    p''' :: Value -> Bool
p''' x :: Value
x = Value -> Bool
p Value
x Bool -> Bool -> Bool
|| Value -> Bool
p' Value
x Bool -> Bool -> Bool
|| Value -> Bool
p'' Value
x

    prefixAstNodes :: (ByteString, Int)
    prefixAstNodes :: (ByteString, Int)
prefixAstNodes  =
      [(Int, Integer)] -> (ByteString, Int)
cutRanges [Value -> (Int, Integer)
sourceId Value
node | Value
node <- Value -> [Value]
forall a. Plated a => a -> [a]
universe Value
ast, Value -> Bool
p''' Value
node]

    -- Parses the `id` and `attributes.referencedDeclaration` field of an AST node
    -- into a pair of byte indices.
    sourceId :: Value -> (Int, Integer)
    sourceId :: Value -> (Int, Integer)
sourceId v :: Value
v =
      if (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Value -> Bool
p Value
v Bool -> Bool -> Bool
|| Value -> Bool
p' Value
v) Bool -> Bool -> Bool
&&  Value -> Bool
p'' Value
v then (
        let
          ref :: Integer
ref = String -> Maybe Integer -> Integer
forall a. String -> Maybe a -> a
fromJust' "refDec of nested struct ref" (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Integer
refDec Value
v
          cn :: (Integer, Text)
cn = String -> Maybe (Integer, Text) -> (Integer, Text)
forall a. String -> Maybe a -> a
fromJust' "no match for lookup in nested structs" (Maybe (Integer, Text) -> (Integer, Text))
-> Maybe (Integer, Text) -> (Integer, Text)
forall a b. (a -> b) -> a -> b
$ Integer -> [(Integer, (Integer, Text))] -> Maybe (Integer, Text)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Integer
ref [(Integer, (Integer, Text))]
cs
        in
          (Int
end, (Integer, Text) -> Integer
forall a b. (a, b) -> a
fst (Integer, Text)
cn)
      ) else
        String -> Maybe (Int, Integer) -> (Int, Integer)
forall a. String -> Maybe a -> a
fromJust' "internal error: no id found for contract reference" Maybe (Int, Integer)
x

      where
        (start :: Int
start, end :: Int
end) = Value -> (Int, Int)
sourceRange Value
v
        f :: Text -> Maybe (Int, Integer)
        f :: Text -> Maybe (Int, Integer)
f t :: Text
t | Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["ContractDefinition", "StructDefinition"] =
              let
                name' :: ByteString
name' = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> Text
forall a. String -> Maybe a -> a
fromJust' "no name for contract/struct" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Text
name Value
v
                bs' :: ByteString
bs' = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (ByteString, Int) -> Int
forall a b. (a, b) -> b
snd (ByteString, Int)
bso) ByteString
bs
                pos :: Int
pos = Int
start
                  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (ByteString -> Int
BS.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
name' ByteString
bs')
                  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (ByteString -> Int
BS.length ByteString
name')
              in
                (Integer -> (Int, Integer))
-> Maybe Integer -> Maybe (Int, Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) Int
pos) (Maybe Integer -> Maybe (Int, Integer))
-> Maybe Integer -> Maybe (Int, Integer)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Integer
id' Value
v
            | Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["UserDefinedTypeName", "Identifier"] =
              (Integer -> (Int, Integer))
-> Maybe Integer -> Maybe (Int, Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) Int
end) (Maybe Integer -> Maybe (Int, Integer))
-> Maybe Integer -> Maybe (Int, Integer)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Integer
refDec Value
v
            | Bool
otherwise =
                String -> Maybe (Int, Integer)
forall a. HasCallStack => String -> a
error (String -> Maybe (Int, Integer)) -> String -> Maybe (Int, Integer)
forall a b. (a -> b) -> a -> b
$ "internal error: not a contract reference: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t

        x :: Maybe (Int, Integer)
        x :: Maybe (Int, Integer)
x = case Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key "nodeType" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String) Value
v of
          Just t :: Text
t -> Text -> Maybe (Int, Integer)
f Text
t
          Nothing -> case Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key "name" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String) Value
v of
            Just t :: Text
t -> Text -> Maybe (Int, Integer)
f Text
t
            Nothing ->
              String -> Maybe (Int, Integer)
forall a. HasCallStack => String -> a
error "internal error: not a contract reference"

    -- Prefix a set of non-overlapping ranges from a bytestring
    -- by commenting them out.
    cutRanges :: [(Int, Integer)] -> (ByteString, Int)
    cutRanges :: [(Int, Integer)] -> (ByteString, Int)
cutRanges ([(Int, Integer)] -> [(Int, Integer)]
forall a. Ord a => [a] -> [a]
sort -> [(Int, Integer)]
rs) = ((ByteString, Int) -> (Int, Integer) -> (ByteString, Int))
-> (ByteString, Int) -> [(Int, Integer)] -> (ByteString, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (ByteString, Int) -> (Int, Integer) -> (ByteString, Int)
f (ByteString, Int)
bso [(Int, Integer)]
rs
      where
        f :: (ByteString, Int) -> (Int, Integer) -> (ByteString, Int)
f (bs' :: ByteString
bs', n :: Int
n) (i :: Int
i, t :: Integer
t) =
          let
            t' :: Text
t' = "_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Map Integer Text
castr Map Integer Text -> Integer -> Text
forall k a. Ord k => Map k a -> k -> a
! Integer
t)
          in
            ( Text -> ByteString -> Int -> ByteString
prefix Text
t' ByteString
bs' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
            , Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
Text.length Text
t' )

    -- Comments out the bytes between two indices from a bytestring.
    prefix :: Text -> ByteString -> Int -> ByteString
    prefix :: Text -> ByteString -> Int -> ByteString
prefix t :: Text
t x :: ByteString
x i :: Int
i =
      let (a :: ByteString
a, b :: ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
i ByteString
x
      in ByteString
a ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 Text
t ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
b

-- Parses the `src` field of an AST node into a pair of byte indices.
sourceRange :: Value -> (Int, Int)
sourceRange :: Value -> (Int, Int)
sourceRange v :: Value
v =
  case Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key "src" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String) Value
v of
    Just (Text -> Text -> [Text]
Text.splitOn ":" -> [Text -> Maybe Int
forall a. Read a => Text -> Maybe a
readAs -> Just i :: Int
i, Text -> Maybe Int
forall a. Read a => Text -> Maybe a
readAs -> Just n :: Int
n, _]) ->
      (Int
i, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
    _ ->
      String -> (Int, Int)
forall a. HasCallStack => String -> a
error "internal error: no source position for AST node"

fromJust' :: String -> Maybe a -> a
fromJust' :: String -> Maybe a -> a
fromJust' msg :: String
msg = \case
  Just x :: a
x -> a
x
  Nothing -> String -> a
forall a. HasCallStack => String -> a
error String
msg

repeated :: Eq a => [a] -> [a]
repeated :: [a] -> [a]
repeated = (([a], [a]) -> [a]) -> ([a] -> ([a], [a])) -> [a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a], [a]) -> [a]
forall a b. (a, b) -> a
fst (([a] -> ([a], [a])) -> [a] -> [a])
-> ([a] -> ([a], [a])) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (([a], [a]) -> a -> ([a], [a])) -> ([a], [a]) -> [a] -> ([a], [a])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([a], [a]) -> a -> ([a], [a])
forall a. Eq a => ([a], [a]) -> a -> ([a], [a])
f ([], [])
  where
    f :: ([a], [a]) -> a -> ([a], [a])
f (acc :: [a]
acc, seen :: [a]
seen) x :: a
x =
      ( if (a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
seen) Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
acc)
        then a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc
        else [a]
acc
      , a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
seen
      )

indexed :: [(Integer, Text)] -> [(Integer, Text)]
indexed :: [(Integer, Text)] -> [(Integer, Text)]
indexed = ([(Integer, Text)], Map Text Integer) -> [(Integer, Text)]
forall a b. (a, b) -> a
fst (([(Integer, Text)], Map Text Integer) -> [(Integer, Text)])
-> ([(Integer, Text)] -> ([(Integer, Text)], Map Text Integer))
-> [(Integer, Text)]
-> [(Integer, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([(Integer, Text)], Map Text Integer)
 -> (Integer, Text) -> ([(Integer, Text)], Map Text Integer))
-> ([(Integer, Text)], Map Text Integer)
-> [(Integer, Text)]
-> ([(Integer, Text)], Map Text Integer)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([(Integer, Text)], Map Text Integer)
-> (Integer, Text) -> ([(Integer, Text)], Map Text Integer)
forall a k a.
(Num a, Ord k, Show a) =>
([(a, Text)], Map k a) -> (a, k) -> ([(a, Text)], Map k a)
f ([], Map Text Integer
forall k a. Map k a
Map.empty) -- (zip (fmap snd xs) $ replicate (length xs) 0) xs
  where
    f :: ([(a, Text)], Map k a) -> (a, k) -> ([(a, Text)], Map k a)
f (acc :: [(a, Text)]
acc, seen :: Map k a
seen) (id' :: a
id', n :: k
n) =
      let
        count :: a
count = (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ Map k a
seen Map k a -> k -> Maybe a
forall k a. Ord k => Map k a -> k -> Maybe a
!? k
n) a -> a -> a
forall a. Num a => a -> a -> a
+ 1
      in
        ((a
id', String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
count) (a, Text) -> [(a, Text)] -> [(a, Text)]
forall a. a -> [a] -> [a]
: [(a, Text)]
acc, k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
n a
count Map k a
seen)