{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-unused-pattern-binds -Wno-unused-imports #-}

module Test.Syd.ReRun (withRerunByReport) where

import Autodocodec
import Control.Monad.Writer
import qualified Data.ByteString as SB
import qualified Data.ByteString.Lazy as LB
import Data.Map (Map)
import qualified Data.Map as M
import Data.Monoid
import Data.Text (Text)
import GHC.Generics (Generic)
import Path
import Path.IO
import Test.Syd.Def
import Test.Syd.OptParse
import Test.Syd.Run
import Test.Syd.SpecDef
import Test.Syd.SpecForest

withRerunByReport ::
  Settings ->
  (TestDefM outers inner r -> IO (Timed ResultForest)) ->
  TestDefM outers inner r ->
  IO (Timed ResultForest)
withRerunByReport :: forall (outers :: [*]) inner r.
Settings
-> (TestDefM outers inner r -> IO (Timed ResultForest))
-> TestDefM outers inner r
-> IO (Timed ResultForest)
withRerunByReport Settings
sets TestDefM outers inner r -> IO (Timed ResultForest)
func TestDefM outers inner r
spec =
  if Settings -> Bool
settingSkipPassed Settings
sets
    then do
      Maybe ReportForest
mReport <- Settings -> IO (Maybe ReportForest)
readReport Settings
sets
      Timed ResultForest
resultForest <- TestDefM outers inner r -> IO (Timed ResultForest)
func (Maybe ReportForest
-> TestDefM outers inner r -> TestDefM outers inner r
forall (outers :: [*]) inner r.
Maybe ReportForest
-> TestDefM outers inner r -> TestDefM outers inner r
filterByMReport Maybe ReportForest
mReport TestDefM outers inner r
spec)
      let newReport :: ReportForest
newReport = Settings -> Timed ResultForest -> ReportForest
collectReport Settings
sets Timed ResultForest
resultForest
      let combinedReport :: ReportForest
combinedReport = ReportForest
-> (ReportForest -> ReportForest)
-> Maybe ReportForest
-> ReportForest
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReportForest
newReport (ReportForest -> ReportForest -> ReportForest
`combineReport` ReportForest
newReport) Maybe ReportForest
mReport
      Settings -> ReportForest -> IO ()
writeReport Settings
sets ReportForest
combinedReport
      Timed ResultForest -> IO (Timed ResultForest)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Timed ResultForest
resultForest
    else TestDefM outers inner r -> IO (Timed ResultForest)
func TestDefM outers inner r
spec

filterByMReport :: Maybe ReportForest -> TestDefM outers inner r -> TestDefM outers inner r
filterByMReport :: forall (outers :: [*]) inner r.
Maybe ReportForest
-> TestDefM outers inner r -> TestDefM outers inner r
filterByMReport = (TestDefM outers inner r -> TestDefM outers inner r)
-> (ReportForest
    -> TestDefM outers inner r -> TestDefM outers inner r)
-> Maybe ReportForest
-> TestDefM outers inner r
-> TestDefM outers inner r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TestDefM outers inner r -> TestDefM outers inner r
forall a. a -> a
id ReportForest -> TestDefM outers inner r -> TestDefM outers inner r
forall (outers :: [*]) inner r.
ReportForest -> TestDefM outers inner r -> TestDefM outers inner r
filterByReport

filterByReport :: ReportForest -> TestDefM outers inner r -> TestDefM outers inner r
filterByReport :: forall (outers :: [*]) inner r.
ReportForest -> TestDefM outers inner r -> TestDefM outers inner r
filterByReport ReportForest
report =
  (TestForest outers inner -> TestForest outers inner)
-> TestDefM outers inner r -> TestDefM outers inner r
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor
    ( \TestForest outers inner
testForest ->
        -- Don't filter anything if everything was removed because it passed.
        -- This should be the final step that reruns all the tests because
        let (TestForest outers inner
filteredResult, All Bool
allPassedOrSkipped) = Writer All (TestForest outers inner)
-> (TestForest outers inner, All)
forall w a. Writer w a -> (a, w)
runWriter (ReportForest
-> TestForest outers inner -> Writer All (TestForest outers inner)
forall (o :: [*]) i.
ReportForest -> TestForest o i -> Writer All (TestForest o i)
goF ReportForest
report TestForest outers inner
testForest)
         in if Bool
allPassedOrSkipped
              then TestForest outers inner
testForest
              else TestForest outers inner
filteredResult
    )
  where
    goF :: ReportForest -> TestForest o i -> Writer All (TestForest o i)
    goF :: forall (o :: [*]) i.
ReportForest -> TestForest o i -> Writer All (TestForest o i)
goF ReportForest
forest = (SpecDefTree o i () -> WriterT All Identity (SpecDefTree o i ()))
-> [SpecDefTree o i ()]
-> WriterT All Identity [SpecDefTree o i ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ReportForest
-> SpecDefTree o i () -> WriterT All Identity (SpecDefTree o i ())
forall (o :: [*]) i.
ReportForest -> TestTree o i -> Writer All (TestTree o i)
goT ReportForest
forest)
    goT :: ReportForest -> TestTree o i -> Writer All (TestTree o i)
    goT :: forall (o :: [*]) i.
ReportForest -> TestTree o i -> Writer All (TestTree o i)
goT ReportForest
forest TestTree o i
t = case TestTree o i
t of
      DefSpecifyNode Text
description TDef
  (ProgressReporter
   -> ((HList o -> i -> IO ()) -> IO ()) -> IO TestRunResult)
_ ()
_ -> do
        case Text -> ReportForest -> Maybe ReportTree
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
description ReportForest
forest of
          Maybe ReportTree
Nothing -> do
            -- New test, definitely run it.
            All -> WriterT All Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (All -> WriterT All Identity ()) -> All -> WriterT All Identity ()
forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
False
            TestTree o i -> Writer All (TestTree o i)
forall a. a -> WriterT All Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestTree o i
t
          Just (ReportBranch ReportForest
_) -> do
            -- "it" turned into "describe": new, definitely run.
            All -> WriterT All Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (All -> WriterT All Identity ()) -> All -> WriterT All Identity ()
forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
False
            TestTree o i -> Writer All (TestTree o i)
forall a. a -> WriterT All Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestTree o i
t
          Just (ReportNode Bool
passed) -> do
            -- Don't rerun if it's already passed.
            All -> WriterT All Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (All -> WriterT All Identity ()) -> All -> WriterT All Identity ()
forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
passed
            TestTree o i -> Writer All (TestTree o i)
forall a. a -> WriterT All Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestTree o i -> Writer All (TestTree o i))
-> TestTree o i -> Writer All (TestTree o i)
forall a b. (a -> b) -> a -> b
$
              if Bool
passed
                then Text -> Maybe Text -> TestTree o i
forall (outers :: [*]) inner extra.
Text -> Maybe Text -> SpecDefTree outers inner extra
DefPendingNode Text
description (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Skipped passed test")
                else TestTree o i
t
      DefPendingNode {} -> do
        -- Keep the pending node, it doesn't hurt.
        All -> WriterT All Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (All -> WriterT All Identity ()) -> All -> WriterT All Identity ()
forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
True
        TestTree o i -> Writer All (TestTree o i)
forall a. a -> WriterT All Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestTree o i
t
      DefDescribeNode Text
description SpecDefForest o i ()
f ->
        case Text -> ReportForest -> Maybe ReportTree
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
description ReportForest
forest of
          Maybe ReportTree
Nothing -> do
            -- New branch, or a branch that wasn't run because of a filter,
            -- definitely run it.
            TestTree o i -> Writer All (TestTree o i)
forall a. a -> WriterT All Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestTree o i
t
          Just (ReportNode Bool
_) -> do
            -- "describe" turned into "it": new, definitely run.
            TestTree o i -> Writer All (TestTree o i)
forall a. a -> WriterT All Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestTree o i
t
          Just (ReportBranch ReportForest
deeperForest) ->
            Text -> SpecDefForest o i () -> TestTree o i
forall (outers :: [*]) inner extra.
Text
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefDescribeNode Text
description (SpecDefForest o i () -> TestTree o i)
-> WriterT All Identity (SpecDefForest o i ())
-> Writer All (TestTree o i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportForest
-> SpecDefForest o i ()
-> WriterT All Identity (SpecDefForest o i ())
forall (o :: [*]) i.
ReportForest -> TestForest o i -> Writer All (TestForest o i)
goF ReportForest
deeperForest SpecDefForest o i ()
f
      DefSetupNode IO ()
func SpecDefForest o i ()
f -> IO () -> SpecDefForest o i () -> TestTree o i
forall (outers :: [*]) inner extra.
IO ()
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefSetupNode IO ()
func (SpecDefForest o i () -> TestTree o i)
-> WriterT All Identity (SpecDefForest o i ())
-> Writer All (TestTree o i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportForest
-> SpecDefForest o i ()
-> WriterT All Identity (SpecDefForest o i ())
forall (o :: [*]) i.
ReportForest -> TestForest o i -> Writer All (TestForest o i)
goF ReportForest
forest SpecDefForest o i ()
f
      DefBeforeAllNode IO outer
func SpecDefForest (outer : o) i ()
f -> IO outer -> SpecDefForest (outer : o) i () -> TestTree o i
forall outer (outers :: [*]) inner extra.
IO outer
-> SpecDefForest (outer : outers) inner extra
-> SpecDefTree outers inner extra
DefBeforeAllNode IO outer
func (SpecDefForest (outer : o) i () -> TestTree o i)
-> WriterT All Identity (SpecDefForest (outer : o) i ())
-> Writer All (TestTree o i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportForest
-> SpecDefForest (outer : o) i ()
-> WriterT All Identity (SpecDefForest (outer : o) i ())
forall (o :: [*]) i.
ReportForest -> TestForest o i -> Writer All (TestForest o i)
goF ReportForest
forest SpecDefForest (outer : o) i ()
f
      DefBeforeAllWithNode oldOuter -> IO newOuter
func SpecDefForest (newOuter : oldOuter : otherOuters) i ()
f -> (oldOuter -> IO newOuter)
-> SpecDefForest (newOuter : oldOuter : otherOuters) i ()
-> SpecDefTree (oldOuter : otherOuters) i ()
forall oldOuter newOuter (otherOuters :: [*]) inner extra.
(oldOuter -> IO newOuter)
-> SpecDefForest (newOuter : oldOuter : otherOuters) inner extra
-> SpecDefTree (oldOuter : otherOuters) inner extra
DefBeforeAllWithNode oldOuter -> IO newOuter
func (SpecDefForest (newOuter : oldOuter : otherOuters) i ()
 -> TestTree o i)
-> WriterT
     All
     Identity
     (SpecDefForest (newOuter : oldOuter : otherOuters) i ())
-> Writer All (TestTree o i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportForest
-> SpecDefForest (newOuter : oldOuter : otherOuters) i ()
-> WriterT
     All
     Identity
     (SpecDefForest (newOuter : oldOuter : otherOuters) i ())
forall (o :: [*]) i.
ReportForest -> TestForest o i -> Writer All (TestForest o i)
goF ReportForest
forest SpecDefForest (newOuter : oldOuter : otherOuters) i ()
f
      DefWrapNode IO () -> IO ()
func SpecDefForest o i ()
f -> (IO () -> IO ()) -> SpecDefForest o i () -> TestTree o i
forall (outers :: [*]) inner extra.
(IO () -> IO ())
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefWrapNode IO () -> IO ()
func (SpecDefForest o i () -> TestTree o i)
-> WriterT All Identity (SpecDefForest o i ())
-> Writer All (TestTree o i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportForest
-> SpecDefForest o i ()
-> WriterT All Identity (SpecDefForest o i ())
forall (o :: [*]) i.
ReportForest -> TestForest o i -> Writer All (TestForest o i)
goF ReportForest
forest SpecDefForest o i ()
f
      DefAroundAllNode (outer -> IO ()) -> IO ()
func SpecDefForest (outer : o) i ()
f -> ((outer -> IO ()) -> IO ())
-> SpecDefForest (outer : o) i () -> TestTree o i
forall outer (outers :: [*]) inner extra.
((outer -> IO ()) -> IO ())
-> SpecDefForest (outer : outers) inner extra
-> SpecDefTree outers inner extra
DefAroundAllNode (outer -> IO ()) -> IO ()
func (SpecDefForest (outer : o) i () -> TestTree o i)
-> WriterT All Identity (SpecDefForest (outer : o) i ())
-> Writer All (TestTree o i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportForest
-> SpecDefForest (outer : o) i ()
-> WriterT All Identity (SpecDefForest (outer : o) i ())
forall (o :: [*]) i.
ReportForest -> TestForest o i -> Writer All (TestForest o i)
goF ReportForest
forest SpecDefForest (outer : o) i ()
f
      DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
func SpecDefForest (newOuter : oldOuter : otherOuters) i ()
f -> ((newOuter -> IO ()) -> oldOuter -> IO ())
-> SpecDefForest (newOuter : oldOuter : otherOuters) i ()
-> SpecDefTree (oldOuter : otherOuters) i ()
forall newOuter oldOuter (otherOuters :: [*]) inner extra.
((newOuter -> IO ()) -> oldOuter -> IO ())
-> SpecDefForest (newOuter : oldOuter : otherOuters) inner extra
-> SpecDefTree (oldOuter : otherOuters) inner extra
DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
func (SpecDefForest (newOuter : oldOuter : otherOuters) i ()
 -> TestTree o i)
-> WriterT
     All
     Identity
     (SpecDefForest (newOuter : oldOuter : otherOuters) i ())
-> Writer All (TestTree o i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportForest
-> SpecDefForest (newOuter : oldOuter : otherOuters) i ()
-> WriterT
     All
     Identity
     (SpecDefForest (newOuter : oldOuter : otherOuters) i ())
forall (o :: [*]) i.
ReportForest -> TestForest o i -> Writer All (TestForest o i)
goF ReportForest
forest SpecDefForest (newOuter : oldOuter : otherOuters) i ()
f
      DefAfterAllNode HList o -> IO ()
func SpecDefForest o i ()
f -> (HList o -> IO ()) -> SpecDefForest o i () -> TestTree o i
forall (outers :: [*]) inner extra.
(HList outers -> IO ())
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefAfterAllNode HList o -> IO ()
func (SpecDefForest o i () -> TestTree o i)
-> WriterT All Identity (SpecDefForest o i ())
-> Writer All (TestTree o i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportForest
-> SpecDefForest o i ()
-> WriterT All Identity (SpecDefForest o i ())
forall (o :: [*]) i.
ReportForest -> TestForest o i -> Writer All (TestForest o i)
goF ReportForest
forest SpecDefForest o i ()
f
      DefParallelismNode Parallelism
x SpecDefForest o i ()
f -> Parallelism -> SpecDefForest o i () -> TestTree o i
forall (outers :: [*]) inner extra.
Parallelism
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefParallelismNode Parallelism
x (SpecDefForest o i () -> TestTree o i)
-> WriterT All Identity (SpecDefForest o i ())
-> Writer All (TestTree o i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportForest
-> SpecDefForest o i ()
-> WriterT All Identity (SpecDefForest o i ())
forall (o :: [*]) i.
ReportForest -> TestForest o i -> Writer All (TestForest o i)
goF ReportForest
forest SpecDefForest o i ()
f
      DefRandomisationNode ExecutionOrderRandomisation
x SpecDefForest o i ()
f -> ExecutionOrderRandomisation -> SpecDefForest o i () -> TestTree o i
forall (outers :: [*]) inner extra.
ExecutionOrderRandomisation
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefRandomisationNode ExecutionOrderRandomisation
x (SpecDefForest o i () -> TestTree o i)
-> WriterT All Identity (SpecDefForest o i ())
-> Writer All (TestTree o i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportForest
-> SpecDefForest o i ()
-> WriterT All Identity (SpecDefForest o i ())
forall (o :: [*]) i.
ReportForest -> TestForest o i -> Writer All (TestForest o i)
goF ReportForest
forest SpecDefForest o i ()
f
      DefTimeoutNode Timeout -> Timeout
func SpecDefForest o i ()
f -> (Timeout -> Timeout) -> SpecDefForest o i () -> TestTree o i
forall (outers :: [*]) inner extra.
(Timeout -> Timeout)
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefTimeoutNode Timeout -> Timeout
func (SpecDefForest o i () -> TestTree o i)
-> WriterT All Identity (SpecDefForest o i ())
-> Writer All (TestTree o i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportForest
-> SpecDefForest o i ()
-> WriterT All Identity (SpecDefForest o i ())
forall (o :: [*]) i.
ReportForest -> TestForest o i -> Writer All (TestForest o i)
goF ReportForest
forest SpecDefForest o i ()
f
      DefRetriesNode Word -> Word
func SpecDefForest o i ()
f -> (Word -> Word) -> SpecDefForest o i () -> TestTree o i
forall (outers :: [*]) inner extra.
(Word -> Word)
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefRetriesNode Word -> Word
func (SpecDefForest o i () -> TestTree o i)
-> WriterT All Identity (SpecDefForest o i ())
-> Writer All (TestTree o i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportForest
-> SpecDefForest o i ()
-> WriterT All Identity (SpecDefForest o i ())
forall (o :: [*]) i.
ReportForest -> TestForest o i -> Writer All (TestForest o i)
goF ReportForest
forest SpecDefForest o i ()
f
      DefFlakinessNode FlakinessMode
x SpecDefForest o i ()
f -> FlakinessMode -> SpecDefForest o i () -> TestTree o i
forall (outers :: [*]) inner extra.
FlakinessMode
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefFlakinessNode FlakinessMode
x (SpecDefForest o i () -> TestTree o i)
-> WriterT All Identity (SpecDefForest o i ())
-> Writer All (TestTree o i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportForest
-> SpecDefForest o i ()
-> WriterT All Identity (SpecDefForest o i ())
forall (o :: [*]) i.
ReportForest -> TestForest o i -> Writer All (TestForest o i)
goF ReportForest
forest SpecDefForest o i ()
f
      DefExpectationNode ExpectationMode
x SpecDefForest o i ()
f -> ExpectationMode -> SpecDefForest o i () -> TestTree o i
forall (outers :: [*]) inner extra.
ExpectationMode
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefExpectationNode ExpectationMode
x (SpecDefForest o i () -> TestTree o i)
-> WriterT All Identity (SpecDefForest o i ())
-> Writer All (TestTree o i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportForest
-> SpecDefForest o i ()
-> WriterT All Identity (SpecDefForest o i ())
forall (o :: [*]) i.
ReportForest -> TestForest o i -> Writer All (TestForest o i)
goF ReportForest
forest SpecDefForest o i ()
f

readReport :: Settings -> IO (Maybe ReportForest)
readReport :: Settings -> IO (Maybe ReportForest)
readReport Settings
settings = do
  Path Abs File
reportFile <- Settings -> IO (Path Abs File)
getReportFile Settings
settings
  Maybe ByteString
mContents <- IO ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (IO ByteString -> IO (Maybe ByteString))
-> IO ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
SB.readFile (Path Abs File -> FilePath
fromAbsFile Path Abs File
reportFile)
  case Maybe ByteString
mContents of
    Maybe ByteString
Nothing -> Maybe ReportForest -> IO (Maybe ReportForest)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ReportForest
forall a. Maybe a
Nothing
    Just ByteString
contents ->
      case ByteString -> Either FilePath ReportForest
forall a. HasCodec a => ByteString -> Either FilePath a
eitherDecodeJSONViaCodec (ByteString -> ByteString
LB.fromStrict ByteString
contents) of
        Left FilePath
_ ->
          -- If we cant decode the file, just pretend it wasn't there.
          Maybe ReportForest -> IO (Maybe ReportForest)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ReportForest
forall a. Maybe a
Nothing
        Right ReportForest
report -> Maybe ReportForest -> IO (Maybe ReportForest)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReportForest -> Maybe ReportForest
forall a. a -> Maybe a
Just ReportForest
report)

writeReport :: Settings -> ReportForest -> IO ()
writeReport :: Settings -> ReportForest -> IO ()
writeReport Settings
settings ReportForest
report = do
  Path Abs File
reportFile <- Settings -> IO (Path Abs File)
getReportFile Settings
settings
  Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
reportFile)
  FilePath -> ByteString -> IO ()
SB.writeFile (Path Abs File -> FilePath
fromAbsFile Path Abs File
reportFile) (ByteString -> ByteString
SB.toStrict (ReportForest -> ByteString
forall a. HasCodec a => a -> ByteString
encodeJSONViaCodec ReportForest
report))

getReportFile :: Settings -> IO (Path Abs File)
getReportFile :: Settings -> IO (Path Abs File)
getReportFile Settings
setting = case Settings -> Maybe (Path Abs File)
settingReportFile Settings
setting of
  Just Path Abs File
fp -> Path Abs File -> IO (Path Abs File)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs File
fp
  Maybe (Path Abs File)
Nothing -> do
    Path Abs Dir
cacheDir <- XdgDirectory -> Maybe (Path Rel Dir) -> IO (Path Abs Dir)
forall (m :: * -> *).
MonadIO m =>
XdgDirectory -> Maybe (Path Rel Dir) -> m (Path Abs Dir)
getXdgDir XdgDirectory
XdgCache (Path Rel Dir -> Maybe (Path Rel Dir)
forall a. a -> Maybe a
Just [reldir|sydtest|])
    Path Abs Dir -> FilePath -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Path Abs File)
resolveFile Path Abs Dir
cacheDir FilePath
"sydtest-report.json"

collectReport :: Settings -> Timed ResultForest -> ReportForest
collectReport :: Settings -> Timed ResultForest -> ReportForest
collectReport Settings
settings = ResultForest -> ReportForest
goF (ResultForest -> ReportForest)
-> (Timed ResultForest -> ResultForest)
-> Timed ResultForest
-> ReportForest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed ResultForest -> ResultForest
forall a. Timed a -> a
timedValue
  where
    goF :: ResultForest -> ReportForest
    goF :: ResultForest -> ReportForest
goF = [ReportForest] -> ReportForest
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ([ReportForest] -> ReportForest)
-> (ResultForest -> [ReportForest]) -> ResultForest -> ReportForest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SpecTree (TDef (Timed TestRunReport)) -> ReportForest)
-> ResultForest -> [ReportForest]
forall a b. (a -> b) -> [a] -> [b]
map SpecTree (TDef (Timed TestRunReport)) -> ReportForest
goT
    goT :: ResultTree -> Map Text ReportTree
    goT :: SpecTree (TDef (Timed TestRunReport)) -> ReportForest
goT = \case
      DescribeNode Text
description ResultForest
f -> Text -> ReportTree -> ReportForest
forall k a. k -> a -> Map k a
M.singleton Text
description (ReportForest -> ReportTree
ReportBranch (ResultForest -> ReportForest
goF ResultForest
f))
      SubForestNode ResultForest
f -> ResultForest -> ReportForest
goF ResultForest
f
      PendingNode Text
_ Maybe Text
_ -> ReportForest
forall k a. Map k a
M.empty
      SpecifyNode Text
testReportDescription TDef {CallStack
Timed TestRunReport
testDefVal :: Timed TestRunReport
testDefCallStack :: CallStack
testDefCallStack :: forall value. TDef value -> CallStack
testDefVal :: forall value. TDef value -> value
..} ->
        let report :: TestRunReport
report = Timed TestRunReport -> TestRunReport
forall a. Timed a -> a
timedValue Timed TestRunReport
testDefVal
            passed :: Bool
passed = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Settings -> TestRunReport -> Bool
testRunReportFailed Settings
settings TestRunReport
report
         in Text -> ReportTree -> ReportForest
forall k a. k -> a -> Map k a
M.singleton Text
testReportDescription (Bool -> ReportTree
ReportNode Bool
passed)

combineReport :: ReportForest -> ReportForest -> ReportForest
combineReport :: ReportForest -> ReportForest -> ReportForest
combineReport = ReportForest -> ReportForest -> ReportForest
goF
  where
    goF :: ReportForest -> ReportForest -> ReportForest
    goF :: ReportForest -> ReportForest -> ReportForest
goF = (ReportTree -> ReportTree -> ReportTree)
-> ReportForest -> ReportForest -> ReportForest
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith ReportTree -> ReportTree -> ReportTree
goT
    goT :: ReportTree -> ReportTree -> ReportTree
    goT :: ReportTree -> ReportTree -> ReportTree
goT ReportTree
oldT ReportTree
newT = case (ReportTree
oldT, ReportTree
newT) of
      (ReportNode Bool
_, ReportNode Bool
newPassed) ->
        -- We could do '||' here but ignoring the old value is more accurate
        -- because the whole point is that we skip passed tests.
        Bool -> ReportTree
ReportNode Bool
newPassed
      (ReportBranch ReportForest
oldForest, ReportBranch ReportForest
newForest) -> ReportForest -> ReportTree
ReportBranch (ReportForest -> ReportTree) -> ReportForest -> ReportTree
forall a b. (a -> b) -> a -> b
$ ReportForest -> ReportForest -> ReportForest
goF ReportForest
oldForest ReportForest
newForest
      (ReportTree, ReportTree)
_ -> ReportTree
newT

type ReportForest = Map Text ReportTree

data ReportTree
  = ReportNode !Bool
  | ReportBranch !ReportForest
  deriving stock (Int -> ReportTree -> ShowS
[ReportTree] -> ShowS
ReportTree -> FilePath
(Int -> ReportTree -> ShowS)
-> (ReportTree -> FilePath)
-> ([ReportTree] -> ShowS)
-> Show ReportTree
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReportTree -> ShowS
showsPrec :: Int -> ReportTree -> ShowS
$cshow :: ReportTree -> FilePath
show :: ReportTree -> FilePath
$cshowList :: [ReportTree] -> ShowS
showList :: [ReportTree] -> ShowS
Show, ReportTree -> ReportTree -> Bool
(ReportTree -> ReportTree -> Bool)
-> (ReportTree -> ReportTree -> Bool) -> Eq ReportTree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReportTree -> ReportTree -> Bool
== :: ReportTree -> ReportTree -> Bool
$c/= :: ReportTree -> ReportTree -> Bool
/= :: ReportTree -> ReportTree -> Bool
Eq, (forall x. ReportTree -> Rep ReportTree x)
-> (forall x. Rep ReportTree x -> ReportTree) -> Generic ReportTree
forall x. Rep ReportTree x -> ReportTree
forall x. ReportTree -> Rep ReportTree x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReportTree -> Rep ReportTree x
from :: forall x. ReportTree -> Rep ReportTree x
$cto :: forall x. Rep ReportTree x -> ReportTree
to :: forall x. Rep ReportTree x -> ReportTree
Generic)

instance HasCodec ReportTree where
  codec :: JSONCodec ReportTree
codec = Text -> JSONCodec ReportTree -> JSONCodec ReportTree
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"ReportTree" (JSONCodec ReportTree -> JSONCodec ReportTree)
-> JSONCodec ReportTree -> JSONCodec ReportTree
forall a b. (a -> b) -> a -> b
$ (Either Bool ReportForest -> ReportTree)
-> (ReportTree -> Either Bool ReportForest)
-> Codec
     Value (Either Bool ReportForest) (Either Bool ReportForest)
-> JSONCodec ReportTree
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either Bool ReportForest -> ReportTree
f ReportTree -> Either Bool ReportForest
g (Codec Value (Either Bool ReportForest) (Either Bool ReportForest)
 -> JSONCodec ReportTree)
-> Codec
     Value (Either Bool ReportForest) (Either Bool ReportForest)
-> JSONCodec ReportTree
forall a b. (a -> b) -> a -> b
$ Codec Value Bool Bool
-> Codec Value ReportForest ReportForest
-> Codec
     Value (Either Bool ReportForest) (Either Bool ReportForest)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec Codec Value Bool Bool
forall value. HasCodec value => JSONCodec value
codec Codec Value ReportForest ReportForest
forall value. HasCodec value => JSONCodec value
codec
    where
      f :: Either Bool ReportForest -> ReportTree
f = \case
        Left Bool
n -> Bool -> ReportTree
ReportNode Bool
n
        Right ReportForest
ts -> ReportForest -> ReportTree
ReportBranch ReportForest
ts
      g :: ReportTree -> Either Bool ReportForest
g = \case
        ReportNode Bool
n -> Bool -> Either Bool ReportForest
forall a b. a -> Either a b
Left Bool
n
        ReportBranch ReportForest
n -> ReportForest -> Either Bool ReportForest
forall a b. b -> Either a b
Right ReportForest
n