diff options
Diffstat (limited to 'src/Verismith/Report.hs')
| -rw-r--r-- | src/Verismith/Report.hs | 564 |
1 files changed, 290 insertions, 274 deletions
diff --git a/src/Verismith/Report.hs b/src/Verismith/Report.hs index a62dab5..6c0d537 100644 --- a/src/Verismith/Report.hs +++ b/src/Verismith/Report.hs @@ -1,69 +1,72 @@ -{-# LANGUAGE RankNTypes #-} -{-| -Module : Verismith.Report -Description : Generate a report from a fuzz run. -Copyright : (c) 2019, Yann Herklotz Grave -License : GPL-3 -Maintainer : yann [at] yannherklotz [dot] com -Stability : experimental -Portability : POSIX - -Generate a report from a fuzz run. --} - +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} +-- | +-- Module : Verismith.Report +-- Description : Generate a report from a fuzz run. +-- Copyright : (c) 2019, Yann Herklotz Grave +-- License : GPL-3 +-- Maintainer : yann [at] yannherklotz [dot] com +-- Stability : experimental +-- Portability : POSIX +-- +-- Generate a report from a fuzz run. module Verismith.Report - ( SynthTool(..) - , SynthStatus(..) - , SynthResult(..) - , SimResult(..) - , SimTool(..) - , FuzzReport(..) - , printResultReport - , printSummary - , synthResults - , simResults - , synthStatus - , equivTime - , fuzzDir - , fileLines - , reducTime - , synthTime - , defaultIcarusSim - , defaultVivadoSynth - , defaultYosysSynth - , defaultXSTSynth - , defaultQuartusSynth - , defaultQuartusLightSynth - , defaultIdentitySynth - , descriptionToSim - , descriptionToSynth - ) + ( SynthTool (..), + SynthStatus (..), + SynthResult (..), + SimResult (..), + SimTool (..), + FuzzReport (..), + printResultReport, + printSummary, + synthResults, + simResults, + synthStatus, + equivTime, + fuzzDir, + fileLines, + reducTime, + synthTime, + defaultIcarusSim, + defaultVivadoSynth, + defaultYosysSynth, + defaultXSTSynth, + defaultQuartusSynth, + defaultQuartusLightSynth, + defaultIdentitySynth, + descriptionToSim, + descriptionToSynth, + ) 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 qualified Data.Text as T -import Data.Text.Lazy (toStrict) -import Data.Time -import Prelude hiding (FilePath) -import Shelly (FilePath, fromText, - toTextIgnore, (<.>), (</>)) -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 Verismith.Config -import Verismith.Internal -import Verismith.Result -import Verismith.Tool -import Verismith.Tool.Internal +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.Time +import Shelly + ( (<.>), + (</>), + FilePath, + fromText, + toTextIgnore, + ) +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 Verismith.Config +import Verismith.Internal +import Verismith.Result +import Verismith.Tool +import Verismith.Tool.Internal +import Prelude hiding (FilePath) -- | Common type alias for synthesis results type UResult = Result Failed () @@ -71,59 +74,60 @@ type UResult = Result Failed () -- | Commont type alias for simulation results type BResult = Result Failed ByteString -data SynthTool = XSTSynth {-# UNPACK #-} !XST - | VivadoSynth {-# UNPACK #-} !Vivado - | YosysSynth {-# UNPACK #-} !Yosys - | QuartusSynth {-# UNPACK #-} !Quartus - | QuartusLightSynth {-# UNPACK #-} !QuartusLight - | IdentitySynth {-# UNPACK #-} !Identity - deriving (Eq) +data SynthTool + = XSTSynth {-# UNPACK #-} !XST + | VivadoSynth {-# UNPACK #-} !Vivado + | YosysSynth {-# UNPACK #-} !Yosys + | QuartusSynth {-# UNPACK #-} !Quartus + | QuartusLightSynth {-# UNPACK #-} !QuartusLight + | IdentitySynth {-# UNPACK #-} !Identity + deriving (Eq) instance NFData SynthTool where - rnf (XSTSynth a) = rnf a - rnf (VivadoSynth a) = rnf a - rnf (YosysSynth a) = rnf a - rnf (QuartusSynth a) = rnf a - rnf (QuartusLightSynth a) = rnf a - rnf (IdentitySynth a) = rnf a + rnf (XSTSynth a) = rnf a + rnf (VivadoSynth a) = rnf a + rnf (YosysSynth a) = rnf a + rnf (QuartusSynth a) = rnf a + rnf (QuartusLightSynth a) = rnf a + rnf (IdentitySynth a) = rnf a instance Show SynthTool where - show (XSTSynth xst) = show xst - show (VivadoSynth vivado) = show vivado - show (YosysSynth yosys) = show yosys - show (QuartusSynth quartus) = show quartus - show (QuartusLightSynth quartus) = show quartus - show (IdentitySynth identity) = show identity + show (XSTSynth xst) = show xst + show (VivadoSynth vivado) = show vivado + show (YosysSynth yosys) = show yosys + show (QuartusSynth quartus) = show quartus + show (QuartusLightSynth quartus) = show quartus + show (IdentitySynth identity) = show identity instance Tool SynthTool where - toText (XSTSynth xst) = toText xst - toText (VivadoSynth vivado) = toText vivado - toText (YosysSynth yosys) = toText yosys - toText (QuartusSynth quartus) = toText quartus - toText (QuartusLightSynth quartus) = toText quartus - toText (IdentitySynth identity) = toText identity + toText (XSTSynth xst) = toText xst + toText (VivadoSynth vivado) = toText vivado + toText (YosysSynth yosys) = toText yosys + toText (QuartusSynth quartus) = toText quartus + toText (QuartusLightSynth quartus) = toText quartus + toText (IdentitySynth identity) = toText identity instance Synthesiser SynthTool where - runSynth (XSTSynth xst) = runSynth xst - runSynth (VivadoSynth vivado) = runSynth vivado - runSynth (YosysSynth yosys) = runSynth yosys - runSynth (QuartusSynth quartus) = runSynth quartus - runSynth (QuartusLightSynth quartus) = runSynth quartus - runSynth (IdentitySynth identity) = runSynth identity - - synthOutput (XSTSynth xst) = synthOutput xst - synthOutput (VivadoSynth vivado) = synthOutput vivado - synthOutput (YosysSynth yosys) = synthOutput yosys - synthOutput (QuartusSynth quartus) = synthOutput quartus - synthOutput (QuartusLightSynth quartus) = synthOutput quartus - synthOutput (IdentitySynth identity) = synthOutput identity - - setSynthOutput (YosysSynth yosys) = YosysSynth . setSynthOutput yosys - setSynthOutput (XSTSynth xst) = XSTSynth . setSynthOutput xst - setSynthOutput (VivadoSynth vivado) = VivadoSynth . setSynthOutput vivado - setSynthOutput (QuartusSynth quartus) = QuartusSynth . setSynthOutput quartus - setSynthOutput (QuartusLightSynth quartus) = QuartusLightSynth . setSynthOutput quartus - setSynthOutput (IdentitySynth identity) = IdentitySynth . setSynthOutput identity + runSynth (XSTSynth xst) = runSynth xst + runSynth (VivadoSynth vivado) = runSynth vivado + runSynth (YosysSynth yosys) = runSynth yosys + runSynth (QuartusSynth quartus) = runSynth quartus + runSynth (QuartusLightSynth quartus) = runSynth quartus + runSynth (IdentitySynth identity) = runSynth identity + + synthOutput (XSTSynth xst) = synthOutput xst + synthOutput (VivadoSynth vivado) = synthOutput vivado + synthOutput (YosysSynth yosys) = synthOutput yosys + synthOutput (QuartusSynth quartus) = synthOutput quartus + synthOutput (QuartusLightSynth quartus) = synthOutput quartus + synthOutput (IdentitySynth identity) = synthOutput identity + + setSynthOutput (YosysSynth yosys) = YosysSynth . setSynthOutput yosys + setSynthOutput (XSTSynth xst) = XSTSynth . setSynthOutput xst + setSynthOutput (VivadoSynth vivado) = VivadoSynth . setSynthOutput vivado + setSynthOutput (QuartusSynth quartus) = QuartusSynth . setSynthOutput quartus + setSynthOutput (QuartusLightSynth quartus) = QuartusLightSynth . setSynthOutput quartus + setSynthOutput (IdentitySynth identity) = IdentitySynth . setSynthOutput identity defaultYosysSynth :: SynthTool defaultYosysSynth = YosysSynth defaultYosys @@ -144,20 +148,20 @@ defaultIdentitySynth :: SynthTool defaultIdentitySynth = IdentitySynth defaultIdentity newtype SimTool = IcarusSim Icarus - deriving (Eq) + deriving (Eq) instance NFData SimTool where - rnf (IcarusSim a) = rnf a + rnf (IcarusSim a) = rnf a instance Tool SimTool where - toText (IcarusSim icarus) = toText icarus + toText (IcarusSim icarus) = toText icarus instance Simulator SimTool where - runSim (IcarusSim icarus) = runSim icarus - runSimWithFile (IcarusSim icarus) = runSimWithFile icarus + runSim (IcarusSim icarus) = runSim icarus + runSimWithFile (IcarusSim icarus) = runSimWithFile icarus instance Show SimTool where - show (IcarusSim icarus) = show icarus + show (IcarusSim icarus) = show icarus defaultIcarusSim :: SimTool defaultIcarusSim = IcarusSim defaultIcarus @@ -165,10 +169,10 @@ 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 ![ByteString] !BResult !NominalDiffTime - deriving (Eq) + deriving (Eq) instance Show SimResult where - show (SimResult synth sim _ r d) = show synth <> ", " <> show sim <> ": " <> show (bimap show (T.unpack . showBS) 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 () @@ -178,10 +182,10 @@ getSimResult (SimResult _ _ _ (Fail b) _) = Fail b -- formal equivalence checker. This will either return a failure or an output -- which is most likely '()'. data SynthResult = SynthResult !SynthTool !SynthTool !UResult !NominalDiffTime - deriving (Eq) + deriving (Eq) instance Show SynthResult where - show (SynthResult synth synth2 r d) = show synth <> ", " <> show synth2 <> ": " <> show r <> " (" <> show d <> ")" + show (SynthResult synth synth2 r d) = show synth <> ", " <> show synth2 <> ": " <> show r <> " (" <> show d <> ")" getSynthResult :: SynthResult -> UResult getSynthResult (SynthResult _ _ a _) = a @@ -190,127 +194,134 @@ getSynthResult (SynthResult _ _ a _) = a -- attempting to run the equivalence checks on the simulator, as that would be -- unnecessary otherwise. data SynthStatus = SynthStatus !SynthTool !UResult !NominalDiffTime - deriving (Eq) + deriving (Eq) getSynthStatus :: SynthStatus -> UResult getSynthStatus (SynthStatus _ a _) = a instance Show SynthStatus where - show (SynthStatus synth r d) = "synthesis " <> show synth <> ": " <> show r <> " (" <> show d <> ")" + 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 { _fuzzDir :: !FilePath - , _synthResults :: ![SynthResult] -- ^ Results of the equivalence check. - , _simResults :: ![SimResult] -- ^ Results of the simulation. - , _synthStatus :: ![SynthStatus] -- ^ Results of the synthesis step. - , _fileLines :: {-# UNPACK #-} !Int - , _synthTime :: !NominalDiffTime - , _equivTime :: !NominalDiffTime - , _reducTime :: !NominalDiffTime - } - deriving (Eq, Show) +data FuzzReport + = FuzzReport + { _fuzzDir :: !FilePath, + -- | Results of the equivalence check. + _synthResults :: ![SynthResult], + -- | Results of the simulation. + _simResults :: ![SimResult], + -- | Results of the synthesis step. + _synthStatus :: ![SynthStatus], + _fileLines :: {-# UNPACK #-} !Int, + _synthTime :: !NominalDiffTime, + _equivTime :: !NominalDiffTime, + _reducTime :: !NominalDiffTime + } + deriving (Eq, Show) $(makeLenses ''FuzzReport) descriptionToSim :: SimDescription -> SimTool descriptionToSim (SimDescription "icarus") = defaultIcarusSim descriptionToSim s = - error $ "Could not find implementation for simulator '" <> show s <> "'" + error $ "Could not find implementation for simulator '" <> show s <> "'" -- | Convert a description to a synthesiser. descriptionToSynth :: SynthDescription -> SynthTool descriptionToSynth (SynthDescription "yosys" bin desc out) = - YosysSynth - . Yosys (fromText <$> bin) (fromMaybe (yosysDesc defaultYosys) desc) - $ maybe (yosysOutput defaultYosys) fromText out + YosysSynth + . Yosys (fromText <$> bin) (fromMaybe (yosysDesc defaultYosys) desc) + $ maybe (yosysOutput defaultYosys) fromText out descriptionToSynth (SynthDescription "vivado" bin desc out) = - VivadoSynth - . Vivado (fromText <$> bin) (fromMaybe (vivadoDesc defaultVivado) desc) - $ maybe (vivadoOutput defaultVivado) fromText out + VivadoSynth + . Vivado (fromText <$> bin) (fromMaybe (vivadoDesc defaultVivado) desc) + $ maybe (vivadoOutput defaultVivado) fromText out descriptionToSynth (SynthDescription "xst" bin desc out) = - XSTSynth - . XST (fromText <$> bin) (fromMaybe (xstDesc defaultXST) desc) - $ maybe (xstOutput defaultXST) fromText out + XSTSynth + . XST (fromText <$> bin) (fromMaybe (xstDesc defaultXST) desc) + $ maybe (xstOutput defaultXST) fromText out descriptionToSynth (SynthDescription "quartus" bin desc out) = - QuartusSynth - . Quartus (fromText <$> bin) - (fromMaybe (quartusDesc defaultQuartus) desc) - $ maybe (quartusOutput defaultQuartus) fromText out + QuartusSynth + . Quartus + (fromText <$> bin) + (fromMaybe (quartusDesc defaultQuartus) desc) + $ maybe (quartusOutput defaultQuartus) fromText out descriptionToSynth (SynthDescription "quartuslight" bin desc out) = - QuartusLightSynth - . QuartusLight (fromText <$> bin) - (fromMaybe (quartusDesc defaultQuartus) desc) - $ maybe (quartusOutput defaultQuartus) fromText out + QuartusLightSynth + . QuartusLight + (fromText <$> bin) + (fromMaybe (quartusDesc defaultQuartus) desc) + $ maybe (quartusOutput defaultQuartus) fromText out descriptionToSynth (SynthDescription "identity" _ desc out) = - IdentitySynth - . Identity (fromMaybe (identityDesc defaultIdentity) desc) - $ maybe (identityOutput defaultIdentity) fromText out + IdentitySynth + . Identity (fromMaybe (identityDesc defaultIdentity) desc) + $ maybe (identityOutput defaultIdentity) fromText out descriptionToSynth s = - error $ "Could not find implementation for synthesiser '" <> show s <> "'" + error $ "Could not find implementation for synthesiser '" <> show s <> "'" status :: Result Failed () -> Html -status (Pass _ ) = H.td ! A.class_ "is-success" $ "Passed" -status (Fail EmptyFail ) = H.td ! A.class_ "is-danger" $ "Failed" +status (Pass _) = H.td ! A.class_ "is-success" $ "Passed" +status (Fail EmptyFail) = H.td ! A.class_ "is-danger" $ "Failed" status (Fail (EquivFail _)) = H.td ! A.class_ "is-danger" $ "Equivalence failed" -status (Fail (SimFail _)) = H.td ! A.class_ "is-danger" $ "Simulation failed" -status (Fail SynthFail ) = H.td ! A.class_ "is-danger" $ "Synthesis failed" -status (Fail EquivError ) = H.td ! A.class_ "is-danger" $ "Equivalence error" -status (Fail TimeoutError) = H.td ! A.class_ "is-warning" $ "Time out" +status (Fail (SimFail _)) = H.td ! A.class_ "is-danger" $ "Simulation failed" +status (Fail SynthFail) = H.td ! A.class_ "is-danger" $ "Synthesis failed" +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 diff) = H.tr $ do - H.td . H.toHtml $ toText synth - status res - H.td . H.toHtml $ showT diff + H.td . H.toHtml $ toText synth + status res + H.td . H.toHtml $ showT diff synthResultHtml :: SynthResult -> Html 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 + 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" + 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 - resultHead name - H.body - . (H.section ! A.class_ "section") - . (H.div ! A.class_ "container") - $ do - 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 "Tool", H.th "Status", H.th "Run time"] - ) - H.tbody . H.toHtml $ fmap synthStatusHtml stat - H.h2 ! A.class_ "title is-2" $ "Equivalence Check" - H.table ! A.class_ "table" $ do - H.thead - . H.toHtml - $ ( H.tr - . H.toHtml - $ [ H.th "First tool" - , H.th "Second tool" - , H.th "Status" - , H.th "Run time" - ] - ) - H.tbody . H.toHtml $ fmap synthResultHtml synth + resultHead name + H.body + . (H.section ! A.class_ "section") + . (H.div ! A.class_ "container") + $ do + 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 "Tool", H.th "Status", H.th "Run time"] + ) + H.tbody . H.toHtml $ fmap synthStatusHtml stat + H.h2 ! A.class_ "title is-2" $ "Equivalence Check" + H.table ! A.class_ "table" $ do + H.thead + . H.toHtml + $ ( H.tr + . H.toHtml + $ [ H.th "First tool", + H.th "Second tool", + 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" @@ -324,94 +335,99 @@ meanVariance l = (mean, variance) squ x = x * x len = fromIntegral $ length l -fuzzStats - :: (Real a1, Traversable t) - => ((a1 -> Const (Endo [a1]) a1) -> a2 -> Const (Endo [a1]) a2) - -> t a2 - -> (Double, Double) +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 = fmap realToFrac $ fr ^.. traverse . sel + where + converted = fmap realToFrac $ fr ^.. traverse . sel fuzzStatus :: Text -> FuzzReport -> Html fuzzStatus name (FuzzReport dir s1 s2 s3 sz t1 t2 t3) = H.tr $ do - H.td - . ( H.a + H.td + . ( H.a ! A.href - ( H.textValue - $ toTextIgnore (dir <.> "html") - ) - ) - $ H.toHtml name - resultStatus - $ 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 + ( H.textValue $ + toTextIgnore (dir <.> "html") + ) + ) + $ H.toHtml name + resultStatus $ + 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 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 "Size (loc)" - , 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 - , H.td - . H.string - . show - . sum - $ fuzz - ^.. traverse - . fileLines - , sumUp synthTime - , sumUp equivTime - , sumUp reducTime - ] - 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 - ] - 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 - ] + 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 "Size (loc)", + 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, + H.td + . H.string + . show + . sum + $ fuzz + ^.. traverse + . fileLines, + sumUp synthTime, + sumUp equivTime, + sumUp reducTime + ] + 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 + ] + 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 + ] 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) - d2I = 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 |