From 751edc28943ed5e56dc7fce42f63f4bb8728686f Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Tue, 21 May 2019 15:25:22 +0100 Subject: Add more fields to the FuzzReport --- src/VeriFuzz/Report.hs | 179 +++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 145 insertions(+), 34 deletions(-) (limited to 'src/VeriFuzz/Report.hs') diff --git a/src/VeriFuzz/Report.hs b/src/VeriFuzz/Report.hs index 2edd31e..53e77ba 100644 --- a/src/VeriFuzz/Report.hs +++ b/src/VeriFuzz/Report.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RankNTypes #-} {-| Module : VeriFuzz.Report Description : Generate a report from a fuzz run. @@ -16,12 +17,18 @@ module VeriFuzz.Report ( SynthTool(..) , SynthStatus(..) , SynthResult(..) + , SimResult(..) , SimTool(..) , FuzzReport(..) , printResultReport + , printSummary , synthResults , simResults , synthStatus + , equivTime + , fuzzDir + , reducTime + , synthTime , defaultIcarusSim , defaultVivadoSynth , defaultYosysSynth @@ -34,18 +41,25 @@ module VeriFuzz.Report where import Control.DeepSeq (NFData, rnf) -import Control.Lens hiding (Identity) +import Control.Lens hiding (Identity, (<.>)) +import Data.Bifunctor (bimap) import Data.ByteString (ByteString) import Data.Maybe (fromMaybe) +import Data.Monoid (Endo) import Data.Text (Text) import Data.Text.Lazy (toStrict) +import Data.Time +import Data.Vector (fromList) import Prelude hiding (FilePath) -import Shelly (fromText) +import Shelly (FilePath, fromText, + toTextIgnore, (<.>), ()) +import Statistics.Sample (meanVariance) import Text.Blaze.Html (Html, (!)) import Text.Blaze.Html.Renderer.Text (renderHtml) import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A import VeriFuzz.Config +import VeriFuzz.Internal import VeriFuzz.Result import VeriFuzz.Sim import VeriFuzz.Sim.Internal @@ -139,46 +153,54 @@ defaultIcarusSim = IcarusSim defaultIcarus -- | The results from running a tool through a simulator. It can either fail or -- return a result, which is most likely a 'ByteString'. -data SimResult = SimResult !SynthTool !SimTool !BResult +data SimResult = SimResult !SynthTool !SimTool !BResult !NominalDiffTime deriving (Eq) instance Show SimResult where - show (SimResult synth sim r) = show synth <> ", " <> show sim <> ": " <> show r + show (SimResult synth sim r d) = show synth <> ", " <> show sim <> ": " <> show r <> " (" <> show d <> ")" + +getSimResult :: SimResult -> UResult +getSimResult (SimResult _ _ (Pass _) _) = Pass () +getSimResult (SimResult _ _ (Fail b) _) = Fail b -- | The results of comparing the synthesised outputs of two files using a -- formal equivalence checker. This will either return a failure or an output -- which is most likely '()'. -data SynthResult = SynthResult !SynthTool !SynthTool !UResult +data SynthResult = SynthResult !SynthTool !SynthTool !UResult !NominalDiffTime deriving (Eq) instance Show SynthResult where - show (SynthResult synth synth2 r) = show synth <> ", " <> show synth2 <> ": " <> show r + show (SynthResult synth synth2 r d) = show synth <> ", " <> show synth2 <> ": " <> show r <> " (" <> show d <> ")" + +getSynthResult :: SynthResult -> UResult +getSynthResult (SynthResult _ _ a _) = a -- | The status of the synthesis using a simulator. This will be checked before -- attempting to run the equivalence checks on the simulator, as that would be -- unnecessary otherwise. -data SynthStatus = SynthStatus !SynthTool !UResult +data SynthStatus = SynthStatus !SynthTool !UResult !NominalDiffTime deriving (Eq) +getSynthStatus :: SynthStatus -> UResult +getSynthStatus (SynthStatus _ a _) = a + instance Show SynthStatus where - show (SynthStatus synth r) = "synthesis " <> show synth <> ": " <> show r + show (SynthStatus synth r d) = "synthesis " <> show synth <> ": " <> show r <> " (" <> show d <> ")" -- | The complete state that will be used during fuzzing, which contains the -- results from all the operations. -data FuzzReport = FuzzReport { _synthResults :: ![SynthResult] +data FuzzReport = FuzzReport { _fuzzDir :: {-# UNPACK #-} !FilePath + , _synthResults :: ![SynthResult] , _simResults :: ![SimResult] , _synthStatus :: ![SynthStatus] + , _synthTime :: {-# UNPACK #-} !NominalDiffTime + , _equivTime :: {-# UNPACK #-} !NominalDiffTime + , _reducTime :: {-# UNPACK #-} !NominalDiffTime } deriving (Eq, Show) $(makeLenses ''FuzzReport) -instance Semigroup FuzzReport where - FuzzReport a1 b1 c1 <> FuzzReport a2 b2 c2 = FuzzReport (a1 <> a2) (b1 <> b2) (c1 <> c2) - -instance Monoid FuzzReport where - mempty = FuzzReport [] [] [] - descriptionToSim :: SimDescription -> SimTool descriptionToSim (SimDescription "icarus") = defaultIcarusSim descriptionToSim s = @@ -201,11 +223,11 @@ descriptionToSynth (SynthDescription "xst" bin desc out) = descriptionToSynth (SynthDescription "quartus" bin desc out) = QuartusSynth . Quartus (fromText <$> bin) - (fromMaybe (quartusDesc defaultQuartus) $ desc) + (fromMaybe (quartusDesc defaultQuartus) desc) $ maybe (quartusOutput defaultQuartus) fromText out descriptionToSynth (SynthDescription "identity" _ desc out) = IdentitySynth - . Identity (fromMaybe (identityDesc defaultIdentity) $ desc) + . Identity (fromMaybe (identityDesc defaultIdentity) desc) $ maybe (identityOutput defaultIdentity) fromText out descriptionToSynth s = error $ "Could not find implementation for synthesiser '" <> show s <> "'" @@ -220,42 +242,46 @@ status (Fail EquivError ) = H.td ! A.class_ "is-danger" $ "Equivalence error" status (Fail TimeoutError) = H.td ! A.class_ "is-warning" $ "Time out" synthStatusHtml :: SynthStatus -> Html -synthStatusHtml (SynthStatus synth res) = H.tr $ do +synthStatusHtml (SynthStatus synth res diff) = H.tr $ do H.td . H.toHtml $ toText synth status res + H.td . H.toHtml $ showT diff synthResultHtml :: SynthResult -> Html -synthResultHtml (SynthResult synth1 synth2 res) = H.tr $ do +synthResultHtml (SynthResult synth1 synth2 res diff) = H.tr $ do H.td . H.toHtml $ toText synth1 H.td . H.toHtml $ toText synth2 status res + H.td . H.toHtml $ showT diff + +resultHead :: Text -> Html +resultHead name = H.head $ do + H.title $ "Fuzz Report - " <> H.toHtml name + H.meta ! A.name "viewport" ! A.content "width=device-width, initial-scale=1" + H.meta ! A.charset "utf8" + H.link + ! A.rel "stylesheet" + ! A.href + "https://cdnjs.cloudflare.com/ajax/libs/bulma/0.7.4/css/bulma.min.css" resultReport :: Text -> FuzzReport -> Html -resultReport name (FuzzReport synth _ stat) = H.docTypeHtml $ do - H.head $ do - H.title $ "Fuzz Report - " <> H.toHtml name - H.meta ! A.name "viewport" ! A.content - "width=device-width, initial-scale=1" - H.meta ! A.charset "utf8" - H.link - ! A.rel "stylesheet" - ! A.href - "https://cdnjs.cloudflare.com/ajax/libs/bulma/0.7.4/css/bulma.min.css" +resultReport name (FuzzReport _ synth _ stat _ _ _) = H.docTypeHtml $ do + resultHead name H.body . (H.section ! A.class_ "section") . (H.div ! A.class_ "container") $ do - H.h1 ! A.class_ "title" $ "Fuzz Report - " <> H.toHtml name - H.h2 ! A.class_ "subtitle" $ "Synthesis Failure" + H.h1 ! A.class_ "title is-1" $ "Fuzz Report - " <> H.toHtml name + H.h2 ! A.class_ "title is-2" $ "Synthesis" H.table ! A.class_ "table" $ do H.thead . H.toHtml $ ( H.tr . H.toHtml - $ [H.th "Synthesis tool", H.th "Synthesis Status"] + $ [H.th "Tool", H.th "Status", H.th "Run time"] ) H.tbody . H.toHtml $ fmap synthStatusHtml stat - H.h2 ! A.class_ "subtitle" $ "Equivalence Check Status" + H.h2 ! A.class_ "title is-2" $ "Equivalence Check" H.table ! A.class_ "table" $ do H.thead . H.toHtml @@ -263,10 +289,95 @@ resultReport name (FuzzReport synth _ stat) = H.docTypeHtml $ do . H.toHtml $ [ H.th "First tool" , H.th "Second tool" - , H.th "Equivalence Status" + , H.th "Status" + , H.th "Run time" ] ) H.tbody . H.toHtml $ fmap synthResultHtml synth +resultStatus :: Result a b -> Html +resultStatus (Pass _) = H.td ! A.class_ "is-success" $ "Passed" +resultStatus (Fail _) = H.td ! A.class_ "is-danger" $ "Failed" + +fuzzStats + :: (Real a1, Traversable t) + => ((a1 -> Const (Endo [a1]) a1) -> a2 -> Const (Endo [a1]) a2) + -> t a2 + -> (Double, Double) +fuzzStats sel fr = meanVariance converted + where converted = fromList . fmap realToFrac $ fr ^.. traverse . sel + +fuzzStatus :: Text -> FuzzReport -> Html +fuzzStatus name (FuzzReport dir s1 s2 s3 t1 t2 t3) = H.tr $ do + H.td + . ( H.a + ! A.href + ( H.textValue + $ toTextIgnore (dir fromText "index" <.> "html") + ) + ) + $ H.toHtml name + resultStatus + $ mconcat (fmap getSynthResult s1) + <> mconcat (fmap getSimResult s2) + <> mconcat (fmap getSynthStatus s3) + H.td . H.string $ show t1 + H.td . H.string $ show t2 + H.td . H.string $ show t3 + +summary :: Text -> [FuzzReport] -> Html +summary name fuzz = H.docTypeHtml $ do + resultHead name + H.body + . (H.section ! A.class_ "section") + . (H.div ! A.class_ "container") + $ do + H.h1 ! A.class_ "title is-1" $ "FuzzReport - " <> H.toHtml name + H.table ! A.class_ "table" $ do + H.thead . H.tr $ H.toHtml + [ H.th "Name" + , H.th "Status" + , H.th "Synthesis time" + , H.th "Equivalence check time" + , H.th "Reduction time" + ] + H.tbody + . H.toHtml + . fmap + (\(i, r) -> + fuzzStatus ("Fuzz " <> showT (i :: Int)) r + ) + $ zip [1 ..] fuzz + H.tfoot . H.toHtml $ do + H.tr $ H.toHtml + [ H.td $ H.strong "Total" + , H.td mempty + , sumUp synthTime + , sumUp equivTime + , sumUp reducTime + ] + H.tr $ H.toHtml + [ H.td $ H.strong "Mean" + , H.td mempty + , fst $ meanVar synthTime + , fst $ meanVar equivTime + , fst $ meanVar reducTime + ] + H.tr $ H.toHtml + [ H.td $ H.strong "Variance" + , H.td mempty + , snd $ meanVar synthTime + , snd $ meanVar equivTime + , snd $ meanVar reducTime + ] + where + sumUp s = showHtml . sum $ fuzz ^.. traverse . s + meanVar s = bimap d2T d2T $ fuzzStats s fuzz + showHtml = H.td . H.string . show + d2T = showHtml . (realToFrac :: Double -> NominalDiffTime) + printResultReport :: Text -> FuzzReport -> Text printResultReport t f = toStrict . renderHtml $ resultReport t f + +printSummary :: Text -> [FuzzReport] -> Text +printSummary t f = toStrict . renderHtml $ summary t f -- cgit From e2cb5d2cfe050ff45fba823c88a5fa45d3fb556e Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Tue, 21 May 2019 20:51:10 +0100 Subject: Add lines of code to report --- src/VeriFuzz/Report.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) (limited to 'src/VeriFuzz/Report.hs') diff --git a/src/VeriFuzz/Report.hs b/src/VeriFuzz/Report.hs index 53e77ba..20addfb 100644 --- a/src/VeriFuzz/Report.hs +++ b/src/VeriFuzz/Report.hs @@ -27,6 +27,7 @@ module VeriFuzz.Report , synthStatus , equivTime , fuzzDir + , fileLines , reducTime , synthTime , defaultIcarusSim @@ -189,10 +190,11 @@ instance Show SynthStatus where -- | The complete state that will be used during fuzzing, which contains the -- results from all the operations. -data FuzzReport = FuzzReport { _fuzzDir :: {-# UNPACK #-} !FilePath +data FuzzReport = FuzzReport { _fuzzDir :: !FilePath , _synthResults :: ![SynthResult] , _simResults :: ![SimResult] , _synthStatus :: ![SynthStatus] + , _fileLines :: {-# UNPACK #-} !Int , _synthTime :: {-# UNPACK #-} !NominalDiffTime , _equivTime :: {-# UNPACK #-} !NominalDiffTime , _reducTime :: {-# UNPACK #-} !NominalDiffTime @@ -265,7 +267,7 @@ resultHead name = H.head $ do "https://cdnjs.cloudflare.com/ajax/libs/bulma/0.7.4/css/bulma.min.css" resultReport :: Text -> FuzzReport -> Html -resultReport name (FuzzReport _ synth _ stat _ _ _) = H.docTypeHtml $ do +resultReport name (FuzzReport _ synth _ stat _ _ _ _) = H.docTypeHtml $ do resultHead name H.body . (H.section ! A.class_ "section") @@ -308,7 +310,7 @@ fuzzStats sel fr = meanVariance converted where converted = fromList . fmap realToFrac $ fr ^.. traverse . sel fuzzStatus :: Text -> FuzzReport -> Html -fuzzStatus name (FuzzReport dir s1 s2 s3 t1 t2 t3) = H.tr $ do +fuzzStatus name (FuzzReport dir s1 s2 s3 sz t1 t2 t3) = H.tr $ do H.td . ( H.a ! A.href @@ -321,6 +323,7 @@ fuzzStatus name (FuzzReport dir s1 s2 s3 t1 t2 t3) = H.tr $ do $ mconcat (fmap getSynthResult s1) <> mconcat (fmap getSimResult s2) <> mconcat (fmap getSynthStatus s3) + H.td . H.string $ show sz H.td . H.string $ show t1 H.td . H.string $ show t2 H.td . H.string $ show t3 @@ -337,6 +340,7 @@ summary name fuzz = H.docTypeHtml $ do H.thead . H.tr $ H.toHtml [ H.th "Name" , H.th "Status" + , H.th "Size (loc)" , H.th "Synthesis time" , H.th "Equivalence check time" , H.th "Reduction time" @@ -352,6 +356,7 @@ summary name fuzz = H.docTypeHtml $ do H.tr $ H.toHtml [ H.td $ H.strong "Total" , H.td mempty + , H.td . H.string . show . sum $ fuzz ^.. traverse . fileLines , sumUp synthTime , sumUp equivTime , sumUp reducTime @@ -359,6 +364,7 @@ summary name fuzz = H.docTypeHtml $ do H.tr $ H.toHtml [ H.td $ H.strong "Mean" , H.td mempty + , fst $ bimap d2I d2I $ fuzzStats fileLines fuzz , fst $ meanVar synthTime , fst $ meanVar equivTime , fst $ meanVar reducTime @@ -366,6 +372,7 @@ summary name fuzz = H.docTypeHtml $ do H.tr $ H.toHtml [ H.td $ H.strong "Variance" , H.td mempty + , snd $ bimap d2I d2I $ fuzzStats fileLines fuzz , snd $ meanVar synthTime , snd $ meanVar equivTime , snd $ meanVar reducTime @@ -375,6 +382,7 @@ summary name fuzz = H.docTypeHtml $ do meanVar s = bimap d2T d2T $ fuzzStats s fuzz showHtml = H.td . H.string . show d2T = showHtml . (realToFrac :: Double -> NominalDiffTime) + d2I = H.td . H.string . show printResultReport :: Text -> FuzzReport -> Text printResultReport t f = toStrict . renderHtml $ resultReport t f -- cgit From 720fa7a822a077458cf0b29e9dcdc754a881e8bd Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Wed, 5 Jun 2019 13:52:20 +0100 Subject: Format all files --- src/VeriFuzz/Report.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'src/VeriFuzz/Report.hs') diff --git a/src/VeriFuzz/Report.hs b/src/VeriFuzz/Report.hs index 20addfb..fb66275 100644 --- a/src/VeriFuzz/Report.hs +++ b/src/VeriFuzz/Report.hs @@ -356,7 +356,13 @@ summary name fuzz = H.docTypeHtml $ do H.tr $ H.toHtml [ H.td $ H.strong "Total" , H.td mempty - , H.td . H.string . show . sum $ fuzz ^.. traverse . fileLines + , H.td + . H.string + . show + . sum + $ fuzz + ^.. traverse + . fileLines , sumUp synthTime , sumUp equivTime , sumUp reducTime @@ -382,7 +388,7 @@ summary name fuzz = H.docTypeHtml $ do meanVar s = bimap d2T d2T $ fuzzStats s fuzz showHtml = H.td . H.string . show d2T = showHtml . (realToFrac :: Double -> NominalDiffTime) - d2I = H.td . H.string . show + d2I = H.td . H.string . show printResultReport :: Text -> FuzzReport -> Text printResultReport t f = toStrict . renderHtml $ resultReport t f -- cgit From bb697f8bc7b593e5aabb43505f686e6503b7726f Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Sat, 29 Jun 2019 20:21:43 +0100 Subject: Fix pedantic warnings --- src/VeriFuzz/Report.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'src/VeriFuzz/Report.hs') diff --git a/src/VeriFuzz/Report.hs b/src/VeriFuzz/Report.hs index fb66275..a3c4ebd 100644 --- a/src/VeriFuzz/Report.hs +++ b/src/VeriFuzz/Report.hs @@ -48,6 +48,7 @@ import Data.ByteString (ByteString) import Data.Maybe (fromMaybe) import Data.Monoid (Endo) import Data.Text (Text) +import qualified Data.Text as T import Data.Text.Lazy (toStrict) import Data.Time import Data.Vector (fromList) @@ -158,7 +159,7 @@ data SimResult = SimResult !SynthTool !SimTool !BResult !NominalDiffTime deriving (Eq) instance Show SimResult where - show (SimResult synth sim r d) = show synth <> ", " <> show sim <> ": " <> show r <> " (" <> show d <> ")" + show (SimResult synth sim r d) = show synth <> ", " <> show sim <> ": " <> show (bimap show (T.unpack . showBS) r) <> " (" <> show d <> ")" getSimResult :: SimResult -> UResult getSimResult (SimResult _ _ (Pass _) _) = Pass () -- cgit From d32f4cc45bc8c0670fb788b1fcd4c2f2b15fa094 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Sat, 29 Jun 2019 20:33:59 +0100 Subject: Format files --- src/VeriFuzz/Report.hs | 40 +++++++++++++++++++++++++--------------- 1 file changed, 25 insertions(+), 15 deletions(-) (limited to 'src/VeriFuzz/Report.hs') diff --git a/src/VeriFuzz/Report.hs b/src/VeriFuzz/Report.hs index a3c4ebd..3037b34 100644 --- a/src/VeriFuzz/Report.hs +++ b/src/VeriFuzz/Report.hs @@ -41,23 +41,33 @@ module VeriFuzz.Report ) where -import Control.DeepSeq (NFData, rnf) -import Control.Lens hiding (Identity, (<.>)) -import Data.Bifunctor (bimap) -import Data.ByteString (ByteString) -import Data.Maybe (fromMaybe) -import Data.Monoid (Endo) -import Data.Text (Text) +import Control.DeepSeq ( NFData + , rnf + ) +import Control.Lens hiding ( Identity + , (<.>) + ) +import Data.Bifunctor ( bimap ) +import Data.ByteString ( ByteString ) +import Data.Maybe ( fromMaybe ) +import Data.Monoid ( Endo ) +import Data.Text ( Text ) import qualified Data.Text as T -import Data.Text.Lazy (toStrict) +import Data.Text.Lazy ( toStrict ) import Data.Time -import Data.Vector (fromList) -import Prelude hiding (FilePath) -import Shelly (FilePath, fromText, - toTextIgnore, (<.>), ()) -import Statistics.Sample (meanVariance) -import Text.Blaze.Html (Html, (!)) -import Text.Blaze.Html.Renderer.Text (renderHtml) +import Data.Vector ( fromList ) +import Prelude hiding ( FilePath ) +import Shelly ( FilePath + , fromText + , toTextIgnore + , (<.>) + , () + ) +import Statistics.Sample ( meanVariance ) +import Text.Blaze.Html ( Html + , (!) + ) +import Text.Blaze.Html.Renderer.Text ( renderHtml ) import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A import VeriFuzz.Config -- cgit