{-# Language DataKinds #-}

module EVM.Dapp where

import EVM.ABI
import EVM.Concrete
import EVM.Solidity
import EVM.Types

import Control.Arrow ((>>>), second)
import Data.Aeson (Value)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.List (find, sort)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (mapMaybe)
import Data.Sequence qualified as Seq
import Data.Text (Text, isPrefixOf, pack)
import Data.Text.Encoding (encodeUtf8)
import Data.Vector qualified as V
import Optics.Core
import Witch (unsafeInto)

data DappInfo = DappInfo
  { DappInfo -> FilePath
root       :: FilePath
  , DappInfo -> Map Text SolcContract
solcByName :: Map Text SolcContract
  , DappInfo -> Map W256 (CodeType, SolcContract)
solcByHash :: Map W256 (CodeType, SolcContract)
  , DappInfo -> [(Code, SolcContract)]
solcByCode :: [(Code, SolcContract)] -- for contracts with `immutable` vars.
  , DappInfo -> SourceCache
sources    :: SourceCache
  , DappInfo -> [(Text, [Sig])]
unitTests  :: [(Text, [Sig])]
  , DappInfo -> Map FunctionSelector Method
abiMap     :: Map FunctionSelector Method
  , DappInfo -> Map W256 Event
eventMap   :: Map W256 Event
  , DappInfo -> Map W256 SolError
errorMap   :: Map W256 SolError
  , DappInfo -> Map Int Value
astIdMap   :: Map Int Value
  , DappInfo -> SrcMap -> Maybe Value
astSrcMap  :: SrcMap -> Maybe Value
  }

-- | bytecode modulo immutables, to identify contracts
data Code = Code
  { Code -> ByteString
raw :: ByteString
  , Code -> [Reference]
immutableLocations :: [Reference]
  }
  deriving Int -> Code -> ShowS
[Code] -> ShowS
Code -> FilePath
(Int -> Code -> ShowS)
-> (Code -> FilePath) -> ([Code] -> ShowS) -> Show Code
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Code -> ShowS
showsPrec :: Int -> Code -> ShowS
$cshow :: Code -> FilePath
show :: Code -> FilePath
$cshowList :: [Code] -> ShowS
showList :: [Code] -> ShowS
Show

data DappContext = DappContext
  { DappContext -> DappInfo
info :: DappInfo
  , DappContext -> Map (Expr 'EAddr) Contract
env  :: Map (Expr EAddr) Contract
  }

dappInfo :: FilePath -> BuildOutput -> DappInfo
dappInfo :: FilePath -> BuildOutput -> DappInfo
dappInfo FilePath
root (BuildOutput (Contracts Map Text SolcContract
cs) SourceCache
sources) =
  let
    solcs :: [SolcContract]
solcs = Map Text SolcContract -> [SolcContract]
forall k a. Map k a -> [a]
Map.elems Map Text SolcContract
cs
    astIds :: Map Int Value
astIds = [Value] -> Map Int Value
forall (f :: * -> *). Foldable f => f Value -> Map Int Value
astIdMap ([Value] -> Map Int Value) -> [Value] -> Map Int Value
forall a b. (a -> b) -> a -> b
$ (Text, Value) -> Value
forall a b. (a, b) -> b
snd ((Text, Value) -> Value) -> [(Text, Value)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Value -> [(Text, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList SourceCache
sources.asts
    immutables :: [SolcContract]
immutables = (SolcContract -> Bool) -> [SolcContract] -> [SolcContract]
forall a. (a -> Bool) -> [a] -> [a]
filter (Map W256 [Reference] -> Map W256 [Reference] -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Map W256 [Reference]
forall a. Monoid a => a
mempty (Map W256 [Reference] -> Bool)
-> (SolcContract -> Map W256 [Reference]) -> SolcContract -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.immutableReferences)) [SolcContract]
solcs

  in DappInfo
    { $sel:root:DappInfo :: FilePath
root = FilePath
root
    , $sel:unitTests:DappInfo :: [(Text, [Sig])]
unitTests = [SolcContract] -> [(Text, [Sig])]
findAllUnitTests [SolcContract]
solcs
    , $sel:sources:DappInfo :: SourceCache
sources = SourceCache
sources
    , $sel:solcByName:DappInfo :: Map Text SolcContract
solcByName = Map Text SolcContract
cs
    , $sel:solcByHash:DappInfo :: Map W256 (CodeType, SolcContract)
solcByHash =
        let
          f :: (SolcContract -> W256)
-> CodeType -> Map W256 (CodeType, SolcContract)
f SolcContract -> W256
g CodeType
k = [(W256, (CodeType, SolcContract))]
-> Map W256 (CodeType, SolcContract)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(SolcContract -> W256
g SolcContract
x, (CodeType
k, SolcContract
x)) | SolcContract
x <- [SolcContract]
solcs]
        in
          Map W256 (CodeType, SolcContract)
-> Map W256 (CodeType, SolcContract)
-> Map W256 (CodeType, SolcContract)
forall a. Monoid a => a -> a -> a
mappend
           ((SolcContract -> W256)
-> CodeType -> Map W256 (CodeType, SolcContract)
f (.runtimeCodehash)  CodeType
Runtime)
           ((SolcContract -> W256)
-> CodeType -> Map W256 (CodeType, SolcContract)
f (.creationCodehash) CodeType
Creation)
      -- contracts with immutable locations can't be id by hash
    , $sel:solcByCode:DappInfo :: [(Code, SolcContract)]
solcByCode =
      [(ByteString -> [Reference] -> Code
Code SolcContract
x.runtimeCode ([[Reference]] -> [Reference]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Reference]] -> [Reference]) -> [[Reference]] -> [Reference]
forall a b. (a -> b) -> a -> b
$ Map W256 [Reference] -> [[Reference]]
forall k a. Map k a -> [a]
Map.elems SolcContract
x.immutableReferences), SolcContract
x) | SolcContract
x <- [SolcContract]
immutables]
      -- Sum up the ABI maps from all the contracts.
    , $sel:abiMap:DappInfo :: Map FunctionSelector Method
abiMap   = [Map FunctionSelector Method] -> Map FunctionSelector Method
forall a. Monoid a => [a] -> a
mconcat ((SolcContract -> Map FunctionSelector Method)
-> [SolcContract] -> [Map FunctionSelector Method]
forall a b. (a -> b) -> [a] -> [b]
map (.abiMap) [SolcContract]
solcs)
    , $sel:eventMap:DappInfo :: Map W256 Event
eventMap = [Map W256 Event] -> Map W256 Event
forall a. Monoid a => [a] -> a
mconcat ((SolcContract -> Map W256 Event)
-> [SolcContract] -> [Map W256 Event]
forall a b. (a -> b) -> [a] -> [b]
map (.eventMap) [SolcContract]
solcs)
    , $sel:errorMap:DappInfo :: Map W256 SolError
errorMap = [Map W256 SolError] -> Map W256 SolError
forall a. Monoid a => [a] -> a
mconcat ((SolcContract -> Map W256 SolError)
-> [SolcContract] -> [Map W256 SolError]
forall a b. (a -> b) -> [a] -> [b]
map (.errorMap) [SolcContract]
solcs)

    , $sel:astIdMap:DappInfo :: Map Int Value
astIdMap  = Map Int Value
astIds
    , $sel:astSrcMap:DappInfo :: SrcMap -> Maybe Value
astSrcMap = Map Int Value -> SrcMap -> Maybe Value
astSrcMap Map Int Value
astIds
    }

emptyDapp :: DappInfo
emptyDapp :: DappInfo
emptyDapp = FilePath -> BuildOutput -> DappInfo
dappInfo FilePath
"" BuildOutput
forall a. Monoid a => a
mempty

-- Dapp unit tests are detected by searching within abi methods
-- that begin with "check" or "prove", that are in a contract with
-- the "IS_TEST()" abi marker, for a given regular expression.
--
-- The regex is matched on the full test method name, including path
-- and contract, i.e. "path/to/file.sol:TestContract.test_name()".

unitTestMarkerAbi :: FunctionSelector
unitTestMarkerAbi :: FunctionSelector
unitTestMarkerAbi = ByteString -> FunctionSelector
abiKeccak (Text -> ByteString
encodeUtf8 Text
"IS_TEST()")

findAllUnitTests :: [SolcContract] -> [(Text, [Sig])]
findAllUnitTests :: [SolcContract] -> [(Text, [Sig])]
findAllUnitTests = Text -> [SolcContract] -> [(Text, [Sig])]
findUnitTests Text
".*:.*\\.(check|prove).*"

mkSig :: Method -> Maybe Sig
mkSig :: Method -> Maybe Sig
mkSig Method
method
  | Text
"prove" Text -> Text -> Bool
`isPrefixOf` Text
testname = Sig -> Maybe Sig
forall a. a -> Maybe a
Just (Text -> [AbiType] -> Sig
Sig Text
testname [AbiType]
argtypes)
  | Text
"check" Text -> Text -> Bool
`isPrefixOf` Text
testname = Sig -> Maybe Sig
forall a. a -> Maybe a
Just (Text -> [AbiType] -> Sig
Sig Text
testname [AbiType]
argtypes)
  | Bool
otherwise = Maybe Sig
forall a. Maybe a
Nothing
  where
    testname :: Text
testname = Method
method.methodSignature
    argtypes :: [AbiType]
argtypes = (Text, AbiType) -> AbiType
forall a b. (a, b) -> b
snd ((Text, AbiType) -> AbiType) -> [(Text, AbiType)] -> [AbiType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Method
method.inputs

findUnitTests :: Text -> ([SolcContract] -> [(Text, [Sig])])
findUnitTests :: Text -> [SolcContract] -> [(Text, [Sig])]
findUnitTests Text
match =
  (SolcContract -> [(Text, [Sig])])
-> [SolcContract] -> [(Text, [Sig])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((SolcContract -> [(Text, [Sig])])
 -> [SolcContract] -> [(Text, [Sig])])
-> (SolcContract -> [(Text, [Sig])])
-> [SolcContract]
-> [(Text, [Sig])]
forall a b. (a -> b) -> a -> b
$ \SolcContract
c ->
    case FunctionSelector -> Map FunctionSelector Method -> Maybe Method
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionSelector
unitTestMarkerAbi SolcContract
c.abiMap of
      Maybe Method
Nothing -> []
      Just Method
_  ->
        let testNames :: [Sig]
testNames = (Text -> Bool) -> SolcContract -> [Sig]
unitTestMethodsFiltered (Text -> Text -> Bool
regexMatches Text
match) SolcContract
c
        in [(SolcContract
c.contractName, [Sig]
testNames) | Bool -> Bool
not (ByteString -> Bool
BS.null SolcContract
c.runtimeCode) Bool -> Bool -> Bool
&& Bool -> Bool
not ([Sig] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Sig]
testNames)]

unitTestMethodsFiltered :: (Text -> Bool) -> (SolcContract -> [Sig])
unitTestMethodsFiltered :: (Text -> Bool) -> SolcContract -> [Sig]
unitTestMethodsFiltered Text -> Bool
matcher SolcContract
c =
  let testName :: Sig -> Text
testName (Sig Text
n [AbiType]
_) = SolcContract
c.contractName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n
  in (Sig -> Bool) -> [Sig] -> [Sig]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Bool
matcher (Text -> Bool) -> (Sig -> Text) -> Sig -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Text
testName) (SolcContract -> [Sig]
unitTestMethods SolcContract
c)

unitTestMethods :: SolcContract -> [Sig]
unitTestMethods :: SolcContract -> [Sig]
unitTestMethods =
  (.abiMap)
  (SolcContract -> Map FunctionSelector Method)
-> (Map FunctionSelector Method -> [Sig]) -> SolcContract -> [Sig]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Map FunctionSelector Method -> [Method]
forall k a. Map k a -> [a]
Map.elems
  (Map FunctionSelector Method -> [Method])
-> ([Method] -> [Sig]) -> Map FunctionSelector Method -> [Sig]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Method -> Maybe Sig) -> [Method] -> [Sig]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Method -> Maybe Sig
mkSig

traceSrcMap :: DappInfo -> Trace -> Maybe SrcMap
traceSrcMap :: DappInfo -> Trace -> Maybe SrcMap
traceSrcMap DappInfo
dapp Trace
trace = DappInfo -> Contract -> Int -> Maybe SrcMap
srcMap DappInfo
dapp Trace
trace.contract Trace
trace.opIx

srcMap :: DappInfo -> Contract -> Int -> Maybe SrcMap
srcMap :: DappInfo -> Contract -> Int -> Maybe SrcMap
srcMap DappInfo
dapp Contract
contr Int
opIndex = do
  SolcContract
sol <- Contract -> DappInfo -> Maybe SolcContract
findSrc Contract
contr DappInfo
dapp
  case Contract
contr.code of
    UnknownCode Expr 'EAddr
_ -> Maybe SrcMap
forall a. Maybe a
Nothing
    InitCode ByteString
_ Expr 'Buf
_ ->
     Int -> Seq SrcMap -> Maybe SrcMap
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
opIndex SolcContract
sol.creationSrcmap
    RuntimeCode RuntimeCode
_ ->
      Int -> Seq SrcMap -> Maybe SrcMap
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
opIndex SolcContract
sol.runtimeSrcmap

findSrc :: Contract -> DappInfo -> Maybe SolcContract
findSrc :: Contract -> DappInfo -> Maybe SolcContract
findSrc Contract
c DappInfo
dapp = do
  W256
hash <- Expr 'EWord -> Maybe W256
maybeLitWord Contract
c.codehash
  case W256
-> Map W256 (CodeType, SolcContract)
-> Maybe (CodeType, SolcContract)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup W256
hash DappInfo
dapp.solcByHash of
    Just (CodeType
_, SolcContract
v) -> SolcContract -> Maybe SolcContract
forall a. a -> Maybe a
Just SolcContract
v
    Maybe (CodeType, SolcContract)
Nothing -> ContractCode -> DappInfo -> Maybe SolcContract
lookupCode Contract
c.code DappInfo
dapp


lookupCode :: ContractCode -> DappInfo -> Maybe SolcContract
lookupCode :: ContractCode -> DappInfo -> Maybe SolcContract
lookupCode (UnknownCode Expr 'EAddr
_) DappInfo
_ = Maybe SolcContract
forall a. Maybe a
Nothing
lookupCode (InitCode ByteString
c Expr 'Buf
_) DappInfo
a =
  (CodeType, SolcContract) -> SolcContract
forall a b. (a, b) -> b
snd ((CodeType, SolcContract) -> SolcContract)
-> Maybe (CodeType, SolcContract) -> Maybe SolcContract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> W256
-> Map W256 (CodeType, SolcContract)
-> Maybe (CodeType, SolcContract)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
c)) DappInfo
a.solcByHash
lookupCode (RuntimeCode (ConcreteRuntimeCode ByteString
c)) DappInfo
a =
  case (CodeType, SolcContract) -> SolcContract
forall a b. (a, b) -> b
snd ((CodeType, SolcContract) -> SolcContract)
-> Maybe (CodeType, SolcContract) -> Maybe SolcContract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> W256
-> Map W256 (CodeType, SolcContract)
-> Maybe (CodeType, SolcContract)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
c)) DappInfo
a.solcByHash of
    Just SolcContract
x -> SolcContract -> Maybe SolcContract
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SolcContract
x
    Maybe SolcContract
Nothing -> (Code, SolcContract) -> SolcContract
forall a b. (a, b) -> b
snd ((Code, SolcContract) -> SolcContract)
-> Maybe (Code, SolcContract) -> Maybe SolcContract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Code, SolcContract) -> Bool)
-> [(Code, SolcContract)] -> Maybe (Code, SolcContract)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (ByteString -> Code -> Bool
compareCode ByteString
c (Code -> Bool)
-> ((Code, SolcContract) -> Code) -> (Code, SolcContract) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Code, SolcContract) -> Code
forall a b. (a, b) -> a
fst) DappInfo
a.solcByCode
lookupCode (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
c)) DappInfo
a = let
    code :: ByteString
code = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Expr 'Byte -> Maybe Word8) -> [Expr 'Byte] -> [Word8]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Expr 'Byte -> Maybe Word8
maybeLitByte ([Expr 'Byte] -> [Word8]) -> [Expr 'Byte] -> [Word8]
forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte) -> [Expr 'Byte]
forall a. Vector a -> [a]
V.toList Vector (Expr 'Byte)
c
  in case (CodeType, SolcContract) -> SolcContract
forall a b. (a, b) -> b
snd ((CodeType, SolcContract) -> SolcContract)
-> Maybe (CodeType, SolcContract) -> Maybe SolcContract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> W256
-> Map W256 (CodeType, SolcContract)
-> Maybe (CodeType, SolcContract)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
code)) DappInfo
a.solcByHash of
    Just SolcContract
x -> SolcContract -> Maybe SolcContract
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SolcContract
x
    Maybe SolcContract
Nothing -> (Code, SolcContract) -> SolcContract
forall a b. (a, b) -> b
snd ((Code, SolcContract) -> SolcContract)
-> Maybe (Code, SolcContract) -> Maybe SolcContract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Code, SolcContract) -> Bool)
-> [(Code, SolcContract)] -> Maybe (Code, SolcContract)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (ByteString -> Code -> Bool
compareCode ByteString
code (Code -> Bool)
-> ((Code, SolcContract) -> Code) -> (Code, SolcContract) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Code, SolcContract) -> Code
forall a b. (a, b) -> a
fst) DappInfo
a.solcByCode

compareCode :: ByteString -> Code -> Bool
compareCode :: ByteString -> Code -> Bool
compareCode ByteString
raw (Code ByteString
template [Reference]
locs) =
  let holes' :: [(Int, Int)]
holes' = [(Int, Int)] -> [(Int, Int)]
forall a. Ord a => [a] -> [a]
sort [(Int
start, Int
len) | (Reference Int
start Int
len) <- [Reference]
locs]
      insert :: source -> Int -> ByteString -> ByteString
insert source
loc Int
len' ByteString
bs = ByteString -> W256 -> W256 -> W256 -> ByteString -> ByteString
writeMemory (Int -> Word8 -> ByteString
BS.replicate Int
len' Word8
0) (Int -> W256
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto Int
len') W256
0 (source -> W256
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto source
loc) ByteString
bs
      refined :: ByteString
refined = ((Int, Int) -> ByteString -> ByteString)
-> ByteString -> [(Int, Int)] -> ByteString
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
start, Int
len) ByteString
acc -> Int -> Int -> ByteString -> ByteString
forall {source}.
(TryFrom source W256, Show source, Typeable source) =>
source -> Int -> ByteString -> ByteString
insert Int
start Int
len ByteString
acc) ByteString
raw [(Int, Int)]
holes'
  in ByteString -> Int
BS.length ByteString
raw Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
BS.length ByteString
template Bool -> Bool -> Bool
&& ByteString
template ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
refined

showTraceLocation :: DappInfo -> Trace -> Either Text Text
showTraceLocation :: DappInfo -> Trace -> Either Text Text
showTraceLocation DappInfo
dapp Trace
trace =
  case DappInfo -> Trace -> Maybe SrcMap
traceSrcMap DappInfo
dapp Trace
trace of
    Maybe SrcMap
Nothing -> Text -> Either Text Text
forall a b. a -> Either a b
Left Text
"<no source map>"
    Just SrcMap
sm ->
      case SourceCache -> SrcMap -> Maybe (FilePath, Int)
srcMapCodePos DappInfo
dapp.sources SrcMap
sm of
        Maybe (FilePath, Int)
Nothing -> Text -> Either Text Text
forall a b. a -> Either a b
Left Text
"<source not found>"
        Just (FilePath
fileName, Int
lineIx) ->
          Text -> Either Text Text
forall a b. b -> Either a b
Right (FilePath -> Text
pack FilePath
fileName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
lineIx))

srcMapCodePos :: SourceCache -> SrcMap -> Maybe (FilePath, Int)
srcMapCodePos :: SourceCache -> SrcMap -> Maybe (FilePath, Int)
srcMapCodePos SourceCache
cache SrcMap
sm =
  ((FilePath, ByteString) -> (FilePath, Int))
-> Maybe (FilePath, ByteString) -> Maybe (FilePath, Int)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> Int) -> (FilePath, ByteString) -> (FilePath, Int)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ByteString -> Int
f) (Maybe (FilePath, ByteString) -> Maybe (FilePath, Int))
-> Maybe (FilePath, ByteString) -> Maybe (FilePath, Int)
forall a b. (a -> b) -> a -> b
$ SourceCache
cache.files Map Int (FilePath, ByteString)
-> Optic'
     (IxKind (Map Int (FilePath, ByteString)))
     NoIx
     (Map Int (FilePath, ByteString))
     (FilePath, ByteString)
-> Maybe (FilePath, ByteString)
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Index (Map Int (FilePath, ByteString))
-> Optic'
     (IxKind (Map Int (FilePath, ByteString)))
     NoIx
     (Map Int (FilePath, ByteString))
     (IxValue (Map Int (FilePath, ByteString)))
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix SrcMap
sm.file
  where
    f :: ByteString -> Int
f ByteString
v = Word8 -> ByteString -> Int
BS.count Word8
0xa (Int -> ByteString -> ByteString
BS.take SrcMap
sm.offset ByteString
v) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

srcMapCode :: SourceCache -> SrcMap -> Maybe ByteString
srcMapCode :: SourceCache -> SrcMap -> Maybe ByteString
srcMapCode SourceCache
cache SrcMap
sm =
  ((FilePath, ByteString) -> ByteString)
-> Maybe (FilePath, ByteString) -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath, ByteString) -> ByteString
f (Maybe (FilePath, ByteString) -> Maybe ByteString)
-> Maybe (FilePath, ByteString) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ SourceCache
cache.files Map Int (FilePath, ByteString)
-> Optic'
     (IxKind (Map Int (FilePath, ByteString)))
     NoIx
     (Map Int (FilePath, ByteString))
     (FilePath, ByteString)
-> Maybe (FilePath, ByteString)
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Index (Map Int (FilePath, ByteString))
-> Optic'
     (IxKind (Map Int (FilePath, ByteString)))
     NoIx
     (Map Int (FilePath, ByteString))
     (IxValue (Map Int (FilePath, ByteString)))
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix SrcMap
sm.file
  where
    f :: (FilePath, ByteString) -> ByteString
f (FilePath
_, ByteString
v) = Int -> ByteString -> ByteString
BS.take (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
80 SrcMap
sm.length) (Int -> ByteString -> ByteString
BS.drop SrcMap
sm.offset ByteString
v)