print arc coverage as JSON

lib/Echidna/Exec.hs

@@ -1,8 +1,9 @@
-{-# LANGUAGE BangPatterns, FlexibleContexts, KindSignatures,
-    LambdaCase, StrictData #-}
+{-# LANGUAGE BangPatterns, DeriveGeneric, FlexibleContexts, KindSignatures, LambdaCase, StrictData #-}
 
 module Echidna.Exec (
-    CoveragePoint(..)
+    ContractCov(..)
+  , CoveragePoint(..)
+  , CoverageReport(..)
   , byHashes
   , checkTest
   , checkBoolExpTest
@@ -18,6 +19,7 @@ module Echidna.Exec (
   , execCall
   , execCallCoverage
   , getCover
+  , ppHashes
   , module Echidna.Internal.Runner
   ) where
 
@@ -27,10 +29,12 @@ import Control.Monad.Catch        (MonadCatch)
 import Control.Monad.IO.Class     (MonadIO, liftIO)
 import Control.Monad.State.Strict (MonadState, StateT, evalState, evalStateT, execState, get, put, runState)
 import Control.Monad.Reader       (MonadReader, ReaderT, runReaderT, ask)
+import Data.Aeson                 (ToJSON(..), encode)
+import Data.ByteString.Lazy.Char8 (unpack)
 import Data.Foldable              (Foldable(..))
 import Data.IORef                 (IORef, modifyIORef', newIORef, readIORef)
 import Data.List                  (intercalate, foldl')
-import Data.Map.Strict            (Map, insertWith)
+import Data.Map.Strict            (Map, insertWith, toAscList)
 import Data.Maybe                 (fromMaybe)
 import Data.Ord                   (comparing)
 import Data.Set                   (Set, insert, singleton)
@@ -38,6 +42,7 @@ import Data.Text                  (Text)
 import Data.Typeable              (Typeable)
 import Data.Vector                (Vector, fromList)
 import Data.Vector.Generic        (maximumBy)
+import GHC.Generics
 
 import qualified Control.Monad.State.Strict as S
 
@@ -61,18 +66,28 @@ import Echidna.Property (PropertyType(..))
 --------------------------------------------------------------------
 -- COVERAGE HANDLING
 
-data CoveragePoint = C Int W256 deriving Eq
+data CoveragePoint = C (Int, Int) W256 deriving Eq
 
 instance Ord CoveragePoint where
-  compare (C i0 w0) (C i1 w1) = case compare w0 w1 of EQ -> compare i0 i1
-                                                      x  -> x
+  compare (C (_,i0) w0) (C (_,i1) w1) = case compare w0 w1 of EQ -> compare i0 i1
+                                                              x  -> x
 
 type CoverageInfo = (SolCall, Set CoveragePoint)
 type CoverageRef  = IORef CoverageInfo
 
-byHashes :: (Foldable t, Monoid (t CoveragePoint)) => t CoveragePoint -> Map W256 (Set Int)
+byHashes :: (Foldable t, Monoid (t CoveragePoint)) => t CoveragePoint -> Map W256 (Set (Int, Int))
 byHashes = foldr (\(C i w) -> insertWith mappend w $ singleton i) mempty . toList
 
+data ContractCov = ContractCov { hash :: String, arcs :: [(Int, Int)] } deriving (Show, Generic)
+newtype CoverageReport = CoverageReport { coverage :: [ContractCov] } deriving (Show, Generic)
+
+instance ToJSON ContractCov
+instance ToJSON CoverageReport
+
+ppHashes :: Map W256 (Set (Int, Int)) -> String
+ppHashes = unpack . encode . toJSON . CoverageReport
+  . map (\(h, is) -> ContractCov (show h) (toList is)) . toAscList
+
 getCover :: (Foldable t, Monoid (t b)) => [(a, t b)] -> IO [a]
 getCover [] = return []
 getCover xs = setCover (fromList xs) mempty totalCoverage []
@@ -105,9 +120,10 @@ execCallCoverage sol = execCallUsing (go mempty) sol where
                  liftIO $ modifyIORef' ref (const (sol, c))
                  return x
     _      -> do current <- use $ state . pc
-                 hash    <- view codehash . fromMaybe (error "no current contract??") . currentContract <$> get 
+                 ch      <- view codehash . fromMaybe (error "no current contract??") . currentContract <$> get 
                  S.state (runState exec1)
-                 go $ insert (C current hash) c
+                 new     <- use $ state . pc
+                 go $ insert (C (current, new) ch) c
 
 -------------------------------------------------------------------
 -- Fuzzing and Hedgehog Init

src/Main.hs

@@ -7,9 +7,7 @@ import Control.Concurrent.MVar (newMVar, readMVar, swapMVar)
 import Control.Monad           (forM, replicateM_)
 import Control.Monad.IO.Class  (liftIO)
 import Control.Monad.Reader    (runReaderT)
-import Data.Foldable           (toList)
 import Data.List               (foldl')
-import Data.Map                (toAscList)
 import Data.Set                (size, unions)
 import Data.Text               (pack)
 import Data.Semigroup          ((<>))
@@ -55,14 +53,14 @@ opts = info (options <**> helper)
 main :: IO ()
 main = do
   -- Read cmd line options and load config
-  (Options file contract coverage configFile) <- execParser opts
+  (Options file contract usecov configFile) <- execParser opts
   config <- maybe (pure defaultConfig) parseConfig configFile
   let f = checkTest (config ^. returnType)
 
   flip runReaderT config $ do
     -- Load solidity contract and get VM
     (v,a,ts) <- loadSolidity file (pack <$> contract)
-    if not coverage
+    if not usecov
       -- Run without coverage
       then do
       let prop t = ePropertySeq (`f` t) a v >>= \x -> return (PropertyName $ show t, x)
@@ -87,4 +85,4 @@ main = do
       ls <- liftIO $ mapM (readMVar . snd) tests
       let ci = foldl' (\acc xs -> unions (acc : map snd xs)) mempty ls
       liftIO $ putStrLn $ "Coverage: " ++ show (size ci) ++ " unique PCs"
-      liftIO $ print $ toAscList $ toList <$> byHashes ci
+      liftIO $ print $ ppHashes $ byHashes ci