codeclimate pass 2

pull/355/head
agroce 5 years ago
parent 3167beb6ff
commit 39ebf01871
  1. 5
      lib/Echidna/Campaign.hs
  2. 4
      lib/Echidna/UI/Report.hs

@ -104,8 +104,9 @@ data Campaign = Campaign { _tests :: [(SolTest, TestState)]
instance ToJSON Campaign where
toJSON (Campaign ts co gi _) = object $ ("tests", toJSON $ mapMaybe format ts)
: ((if co == mempty then [] else [("coverage",) . toJSON . mapKeys (`showHex` "") $ DF.toList <$> co]) ++
(if gi == mempty then [] else [ (("maxgas",) . toJSON . toList) gi])) where
: ((if co == mempty then [] else [
("coverage",) . toJSON . mapKeys (`showHex` "") $ DF.toList <$> co]) ++
[(("maxgas",) . toJSON . toList) gi | not (gi == mempty)]) where
format (Right _, Open _) = Nothing
format (Right (n, _), s) = Just ("assertion in " <> n, toJSON s)
format (Left (n, _), s) = Just (n, toJSON s)

@ -4,7 +4,7 @@
module Echidna.UI.Report where
import Control.Lens
import Control.Monad.Reader (MonadReader, liftM, liftM2)
import Control.Monad.Reader (MonadReader, liftM2)
import Data.Has (Has(..))
import Data.List (intercalate, nub, sortOn)
import Data.Map (Map, toList)
@ -56,7 +56,7 @@ ppGasOne (f, (g, xs)) = let pxs = mapM (ppTx $ length (nub $ view src <$> xs) /=
-- | Pretty-print the gas usage information a 'Campaign' has obtained.
ppGasInfo :: (MonadReader x m, Has Names x, Has TxConf x) => Campaign -> m String
ppGasInfo (Campaign _ _ gi _) | gi == mempty = pure ""
ppGasInfo (Campaign _ _ gi _) = (liftM $ intercalate "") (mapM ppGasOne $ sortOn (\(_, (n, _)) -> n) $ toList gi)
ppGasInfo (Campaign _ _ gi _) = (fmap $ intercalate "") (mapM ppGasOne $ sortOn (\(_, (n, _)) -> n) $ toList gi)
-- | Pretty-print the status of a solved test.
ppFail :: (MonadReader x m, Has Names x, Has TxConf x) => Maybe (Int, Int) -> [Tx] -> m String

Loading…
Cancel
Save