{-# LANGUAGE CPP #-}
module UVMHS.Lib.Testing
  ( module UVMHS.Lib.Testing
  ) where

import UVMHS.Core
import UVMHS.Lib.Pretty
import UVMHS.Lib.Shrinky
import UVMHS.Lib.Rand
import UVMHS.Lib.Fuzzy
import UVMHS.Lib.TreeNested
import UVMHS.Lib.THLiftInstances ()

import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Syntax as TH

data FuzzParams = FuzzParams
  { FuzzParams -> ℕ64
fuzzParamsRadiusMax ∷ ℕ64
  , FuzzParams -> ℕ64
fuzzParamsRadiusStep ∷ ℕ64
  , FuzzParams -> ℕ64
fuzzParamsDepthMax ∷ ℕ64
  , FuzzParams -> ℕ64
fuzzParamsDepthStep ∷ ℕ64
  , FuzzParams -> ℕ64
fuzzParamsSpread ∷ ℕ64
  } deriving (FuzzParams -> FuzzParams -> 𝔹
(FuzzParams -> FuzzParams -> 𝔹)
-> (FuzzParams -> FuzzParams -> 𝔹) -> Eq FuzzParams
forall a. (a -> a -> 𝔹) -> (a -> a -> 𝔹) -> Eq a
$c== :: FuzzParams -> FuzzParams -> 𝔹
== :: FuzzParams -> FuzzParams -> 𝔹
$c/= :: FuzzParams -> FuzzParams -> 𝔹
/= :: FuzzParams -> FuzzParams -> 𝔹
Eq,Eq FuzzParams
Eq FuzzParams =>
(FuzzParams -> FuzzParams -> Ordering)
-> (FuzzParams -> FuzzParams -> 𝔹)
-> (FuzzParams -> FuzzParams -> 𝔹)
-> (FuzzParams -> FuzzParams -> 𝔹)
-> (FuzzParams -> FuzzParams -> 𝔹)
-> (FuzzParams -> FuzzParams -> FuzzParams)
-> (FuzzParams -> FuzzParams -> FuzzParams)
-> Ord FuzzParams
FuzzParams -> FuzzParams -> 𝔹
FuzzParams -> FuzzParams -> Ordering
FuzzParams -> FuzzParams -> FuzzParams
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> 𝔹)
-> (a -> a -> 𝔹)
-> (a -> a -> 𝔹)
-> (a -> a -> 𝔹)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FuzzParams -> FuzzParams -> Ordering
compare :: FuzzParams -> FuzzParams -> Ordering
$c< :: FuzzParams -> FuzzParams -> 𝔹
< :: FuzzParams -> FuzzParams -> 𝔹
$c<= :: FuzzParams -> FuzzParams -> 𝔹
<= :: FuzzParams -> FuzzParams -> 𝔹
$c> :: FuzzParams -> FuzzParams -> 𝔹
> :: FuzzParams -> FuzzParams -> 𝔹
$c>= :: FuzzParams -> FuzzParams -> 𝔹
>= :: FuzzParams -> FuzzParams -> 𝔹
$cmax :: FuzzParams -> FuzzParams -> FuzzParams
max :: FuzzParams -> FuzzParams -> FuzzParams
$cmin :: FuzzParams -> FuzzParams -> FuzzParams
min :: FuzzParams -> FuzzParams -> FuzzParams
Ord,Int -> FuzzParams -> ShowS
[FuzzParams] -> ShowS
FuzzParams -> String
(Int -> FuzzParams -> ShowS)
-> (FuzzParams -> String)
-> ([FuzzParams] -> ShowS)
-> Show FuzzParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FuzzParams -> ShowS
showsPrec :: Int -> FuzzParams -> ShowS
$cshow :: FuzzParams -> String
show :: FuzzParams -> String
$cshowList :: [FuzzParams] -> ShowS
showList :: [FuzzParams] -> ShowS
Show,(forall (m :: * -> *). Quote m => FuzzParams -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    FuzzParams -> Code m FuzzParams)
-> Lift FuzzParams
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => FuzzParams -> m Exp
forall (m :: * -> *). Quote m => FuzzParams -> Code m FuzzParams
$clift :: forall (m :: * -> *). Quote m => FuzzParams -> m Exp
lift :: forall (m :: * -> *). Quote m => FuzzParams -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => FuzzParams -> Code m FuzzParams
liftTyped :: forall (m :: * -> *). Quote m => FuzzParams -> Code m FuzzParams
TH.Lift)

fuzzParams₀ ∷ FuzzParams
fuzzParams₀ :: FuzzParams
fuzzParams₀ = ℕ64 -> ℕ64 -> ℕ64 -> ℕ64 -> ℕ64 -> FuzzParams
FuzzParams ℕ64
10 ℕ64
1 ℕ64
10 ℕ64
1 ℕ64
1

fuzzParamsTny ∷ ℕ64 → FuzzParams
fuzzParamsTny :: ℕ64 -> FuzzParams
fuzzParamsTny = ℕ64 -> ℕ64 -> ℕ64 -> ℕ64 -> ℕ64 -> FuzzParams
FuzzParams ℕ64
2 ℕ64
1 ℕ64
2 ℕ64
1

fuzzParamsSml ∷ ℕ64 → FuzzParams
fuzzParamsSml :: ℕ64 -> FuzzParams
fuzzParamsSml = ℕ64 -> ℕ64 -> ℕ64 -> ℕ64 -> ℕ64 -> FuzzParams
FuzzParams ℕ64
4 ℕ64
1 ℕ64
4 ℕ64
1

fuzzParamsMed ∷ ℕ64 → FuzzParams
fuzzParamsMed :: ℕ64 -> FuzzParams
fuzzParamsMed = ℕ64 -> ℕ64 -> ℕ64 -> ℕ64 -> ℕ64 -> FuzzParams
FuzzParams ℕ64
8 ℕ64
1 ℕ64
8 ℕ64
1

fuzzParamsLrg ∷ ℕ64 → FuzzParams
fuzzParamsLrg :: ℕ64 -> FuzzParams
fuzzParamsLrg = ℕ64 -> ℕ64 -> ℕ64 -> ℕ64 -> ℕ64 -> FuzzParams
FuzzParams ℕ64
16 ℕ64
1 ℕ64
16 ℕ64
1

data Test = Test
  { Test -> Doc
testSrcLoc ∷ Doc
  , Test -> () -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ()
testResult ∷ () → ErrorT (() → 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ()
  }

eqTest ∷ (Eq a,Pretty a) ⇒ 𝐿 𝕊 → 𝕊 → a → a → 𝑇D Test
eqTest :: forall a. (Eq a, Pretty a) => 𝐿 𝕊 -> 𝕊 -> a -> a -> 𝑇D Test
eqTest 𝐿 𝕊
tags 𝕊
lS a
x a
y = 𝐿 𝕊 -> 𝑇D Test -> 𝑇D Test
forall a. 𝐿 𝕊 -> 𝑇D a -> 𝑇D a
keys𝑇D 𝐿 𝕊
tags (𝑇D Test -> 𝑇D Test) -> 𝑇D Test -> 𝑇D Test
forall a b. (a -> b) -> a -> b
$ Test -> 𝑇D Test
forall a. a -> 𝑇D a
val𝑇D (Test -> 𝑇D Test) -> Test -> 𝑇D Test
forall a b. (a -> b) -> a -> b
$ Doc
-> (() -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
-> Test
Test (𝕊 -> Doc
ppString 𝕊
lS) ((() -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
 -> Test)
-> (() -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
-> Test
forall a b. (a -> b) -> a -> b
$ \ () →
  if a
x a -> a -> 𝔹
forall a. Eq a => a -> a -> 𝔹
≡ a
y
  then ℕ64 -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ()
forall o (m :: * -> *). MonadWriter o m => o -> m ()
tell ℕ64
forall a. One a => a
one
  else (() -> 𝑇A Doc)
-> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ()
forall a.
(() -> 𝑇A Doc)
-> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) a
forall {k} e (m :: k -> *) (a :: k). MonadError e m => e -> m a
throw ((() -> 𝑇A Doc)
 -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
-> (() -> 𝑇A Doc)
-> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ()
forall a b. (a -> b) -> a -> b
$ \ () → [𝑇A Doc] -> 𝑇A Doc
forall a t. (Monoid a, ToIter a t) => t -> a
concat
    [ 𝕊 -> 𝑇A Doc -> 𝑇A Doc
forall a. 𝕊 -> 𝑇A a -> 𝑇A a
𝐤 𝕊
"L" (𝑇A Doc -> 𝑇A Doc) -> 𝑇A Doc -> 𝑇A Doc
forall a b. (a -> b) -> a -> b
$ Doc -> 𝑇A Doc
forall a. a -> 𝑇A a
𝐯 (Doc -> 𝑇A Doc) -> Doc -> 𝑇A Doc
forall a b. (a -> b) -> a -> b
$ a -> Doc
forall a. Pretty a => a -> Doc
pretty a
x
    , 𝕊 -> 𝑇A Doc -> 𝑇A Doc
forall a. 𝕊 -> 𝑇A a -> 𝑇A a
𝐤 𝕊
"R" (𝑇A Doc -> 𝑇A Doc) -> 𝑇A Doc -> 𝑇A Doc
forall a b. (a -> b) -> a -> b
$ Doc -> 𝑇A Doc
forall a. a -> 𝑇A a
𝐯 (Doc -> 𝑇A Doc) -> Doc -> 𝑇A Doc
forall a b. (a -> b) -> a -> b
$ a -> Doc
forall a. Pretty a => a -> Doc
pretty a
y
    ]

fuzzTest ∷ (Pretty a,Shrinky a) ⇒ 𝐿 𝕊 → 𝕊 → FuzzyM a → (a → 𝔹) → (a → Doc) → 𝑇D Test
fuzzTest :: forall a.
(Pretty a, Shrinky a) =>
𝐿 𝕊 -> 𝕊 -> FuzzyM a -> (a -> 𝔹) -> (a -> Doc) -> 𝑇D Test
fuzzTest 𝐿 𝕊
tags 𝕊
lS FuzzyM a
xM a -> 𝔹
p a -> Doc
xD = 𝐿 𝕊 -> 𝑇D Test -> 𝑇D Test
forall a. 𝐿 𝕊 -> 𝑇D a -> 𝑇D a
keys𝑇D 𝐿 𝕊
tags (𝑇D Test -> 𝑇D Test) -> 𝑇D Test -> 𝑇D Test
forall a b. (a -> b) -> a -> b
$ Test -> 𝑇D Test
forall a. a -> 𝑇D a
val𝑇D (Test -> 𝑇D Test) -> Test -> 𝑇D Test
forall a b. (a -> b) -> a -> b
$ Doc
-> (() -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
-> Test
Test (𝕊 -> Doc
ppString 𝕊
lS) ((() -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
 -> Test)
-> (() -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
-> Test
forall a b. (a -> b) -> a -> b
$ \ () → do
  FuzzParams ℕ64
radiusMax ℕ64
radiusStep ℕ64
depthMax ℕ64
depthStep ℕ64
spread ← ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) FuzzParams
forall (m :: * -> *) r. (Monad m, MonadReader r m) => m r
ask
  𝐼 ℕ64
-> (ℕ64 -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
-> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ()
forall (m :: * -> *) a t.
(Monad m, ToIter a t) =>
t -> (a -> m ()) -> m ()
eachOn (ℕ64 -> ℕ64 -> 𝐼 ℕ64
uptoStep ℕ64
radiusMax ℕ64
radiusStep) ((ℕ64 -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
 -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
-> (ℕ64 -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
-> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ()
forall a b. (a -> b) -> a -> b
$ \ ℕ64
r →
    𝐼 ℕ64
-> (ℕ64 -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
-> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ()
forall (m :: * -> *) a t.
(Monad m, ToIter a t) =>
t -> (a -> m ()) -> m ()
eachOn (ℕ64 -> ℕ64 -> 𝐼 ℕ64
uptoStep ℕ64
depthMax ℕ64
depthStep) ((ℕ64 -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
 -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
-> (ℕ64 -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
-> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ()
forall a b. (a -> b) -> a -> b
$ \ ℕ64
d →
      𝐼 ℕ64
-> (ℕ64 -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
-> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ()
forall (m :: * -> *) a t.
(Monad m, ToIter a t) =>
t -> (a -> m ()) -> m ()
eachOn (ℕ64 -> 𝐼 ℕ64
forall n. (Eq n, Additive n, One n) => n -> 𝐼 n
upto ℕ64
spread) ((ℕ64 -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
 -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
-> (ℕ64 -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ())
-> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ()
forall a b. (a -> b) -> a -> b
$ \ ℕ64
_i → do
        a
x ← IO a -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) a
forall a.
IO a -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO a -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) a)
-> IO a -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) a
forall a b. (a -> b) -> a -> b
$ State RG a -> IO a
forall a. State RG a -> IO a
forall (m :: * -> *) a. MonadRand m => State RG a -> m a
rng (State RG a -> IO a) -> State RG a -> IO a
forall a b. (a -> b) -> a -> b
$ FuzzyEnv -> FuzzyM a -> State RG a
forall a. FuzzyEnv -> FuzzyM a -> State RG a
runFuzzyMRG (ℕ64 -> ℕ64 -> FuzzyEnv
FuzzyEnv ℕ64
r ℕ64
d) FuzzyM a
xM
        if a -> 𝔹
p a
x 
        then ℕ64 -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ()
forall o (m :: * -> *). MonadWriter o m => o -> m ()
tell ℕ64
forall a. One a => a
one
        else
          let ℕ64
n :* a
x' = (a -> 𝔹) -> a -> ℕ64 ∧ a
forall a. Shrinky a => (a -> 𝔹) -> a -> ℕ64 ∧ a
shrunk (𝔹 -> 𝔹
not (𝔹 -> 𝔹) -> (a -> 𝔹) -> a -> 𝔹
forall b c a. (b -> c) -> (a -> b) -> a -> c
∘ a -> 𝔹
p) a
x
              errD :: () -> 𝑇A Doc
errD () = [𝑇A Doc] -> 𝑇A Doc
forall a t. (Monoid a, ToIter a t) => t -> a
concat
                [ 𝕊 -> 𝑇A Doc -> 𝑇A Doc
forall a. 𝕊 -> 𝑇A a -> 𝑇A a
𝐤 𝕊
"R" (𝑇A Doc -> 𝑇A Doc) -> 𝑇A Doc -> 𝑇A Doc
forall a b. (a -> b) -> a -> b
$ Doc -> 𝑇A Doc
forall a. a -> 𝑇A a
𝐯 (Doc -> 𝑇A Doc) -> Doc -> 𝑇A Doc
forall a b. (a -> b) -> a -> b
$ ℕ64 -> Doc
forall a. Pretty a => a -> Doc
pretty ℕ64
r
                , 𝕊 -> 𝑇A Doc -> 𝑇A Doc
forall a. 𝕊 -> 𝑇A a -> 𝑇A a
𝐤 𝕊
"D" (𝑇A Doc -> 𝑇A Doc) -> 𝑇A Doc -> 𝑇A Doc
forall a b. (a -> b) -> a -> b
$ Doc -> 𝑇A Doc
forall a. a -> 𝑇A a
𝐯 (Doc -> 𝑇A Doc) -> Doc -> 𝑇A Doc
forall a b. (a -> b) -> a -> b
$ ℕ64 -> Doc
forall a. Pretty a => a -> Doc
pretty ℕ64
d
                , 𝕊 -> 𝑇A Doc -> 𝑇A Doc
forall a. 𝕊 -> 𝑇A a -> 𝑇A a
𝐤 𝕊
"N" (𝑇A Doc -> 𝑇A Doc) -> 𝑇A Doc -> 𝑇A Doc
forall a b. (a -> b) -> a -> b
$ Doc -> 𝑇A Doc
forall a. a -> 𝑇A a
𝐯 (Doc -> 𝑇A Doc) -> Doc -> 𝑇A Doc
forall a b. (a -> b) -> a -> b
$ ℕ64 -> Doc
forall a. Pretty a => a -> Doc
pretty ℕ64
n
                , 𝕊 -> 𝑇A Doc -> 𝑇A Doc
forall a. 𝕊 -> 𝑇A a -> 𝑇A a
𝐤 𝕊
"X" (𝑇A Doc -> 𝑇A Doc) -> 𝑇A Doc -> 𝑇A Doc
forall a b. (a -> b) -> a -> b
$ Doc -> 𝑇A Doc
forall a. a -> 𝑇A a
𝐯 (Doc -> 𝑇A Doc) -> Doc -> 𝑇A Doc
forall a b. (a -> b) -> a -> b
$ a -> Doc
xD a
x'
                ]
          in (() -> 𝑇A Doc)
-> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ()
forall a.
(() -> 𝑇A Doc)
-> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) a
forall {k} e (m :: k -> *) (a :: k). MonadError e m => e -> m a
throw () -> 𝑇A Doc
errD

data TestsOut = TestsOut
  { TestsOut -> 𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc))
testsOutFailures ∷ 𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() → 𝑇A Doc))
  , TestsOut -> 𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)
testsOutMetrics ∷ 𝐿 𝕊 ⇰ ℕ64 ∧ ℕ64
  }

testsOutFailure ∷ 𝐿 𝕊 → Doc → (() → 𝑇A Doc) → TestsOut
testsOutFailure :: 𝐿 𝕊 -> Doc -> (() -> 𝑇A Doc) -> TestsOut
testsOutFailure 𝐿 𝕊
tag Doc
lD () -> 𝑇A Doc
errD = (𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc))) -> (𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)) -> TestsOut
TestsOut (𝐿 𝕊 -> 𝐼 (Doc ∧ (() -> 𝑇A Doc)) -> 𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc))
forall a. 𝐿 𝕊 -> a -> 𝐿 𝕊 ⇰ a
forall k s (d :: * -> *) a. Dict k s d => k -> a -> d a
(↦) 𝐿 𝕊
tag (𝐼 (Doc ∧ (() -> 𝑇A Doc)) -> 𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc)))
-> 𝐼 (Doc ∧ (() -> 𝑇A Doc)) -> 𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc))
forall a b. (a -> b) -> a -> b
$ (Doc ∧ (() -> 𝑇A Doc)) -> 𝐼 (Doc ∧ (() -> 𝑇A Doc))
forall a t. Single a t => a -> t
single ((Doc ∧ (() -> 𝑇A Doc)) -> 𝐼 (Doc ∧ (() -> 𝑇A Doc)))
-> (Doc ∧ (() -> 𝑇A Doc)) -> 𝐼 (Doc ∧ (() -> 𝑇A Doc))
forall a b. (a -> b) -> a -> b
$ Doc
lD Doc -> (() -> 𝑇A Doc) -> Doc ∧ (() -> 𝑇A Doc)
forall a b. a -> b -> a ∧ b
:* () -> 𝑇A Doc
errD) 𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)
forall a. Null a => a
null

testsOutMetricPass ∷ 𝐿 𝕊 → ℕ64 → TestsOut
testsOutMetricPass :: 𝐿 𝕊 -> ℕ64 -> TestsOut
testsOutMetricPass 𝐿 𝕊
tags ℕ64
n = (𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc))) -> (𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)) -> TestsOut
TestsOut 𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc))
forall a. Null a => a
null ((𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)) -> TestsOut)
-> (𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)) -> TestsOut
forall a b. (a -> b) -> a -> b
$ 𝐿 𝕊
tags 𝐿 𝕊 -> (ℕ64 ∧ ℕ64) -> 𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)
forall a. 𝐿 𝕊 -> a -> 𝐿 𝕊 ⇰ a
forall k s (d :: * -> *) a. Dict k s d => k -> a -> d a
↦ ℕ64
n ℕ64 -> ℕ64 -> ℕ64 ∧ ℕ64
forall a b. a -> b -> a ∧ b
:* ℕ64
forall a. Zero a => a
zero

testsOutMetricFail ∷ 𝐿 𝕊 → ℕ64 → TestsOut
testsOutMetricFail :: 𝐿 𝕊 -> ℕ64 -> TestsOut
testsOutMetricFail 𝐿 𝕊
tags ℕ64
n = (𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc))) -> (𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)) -> TestsOut
TestsOut 𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc))
forall a. Null a => a
null ((𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)) -> TestsOut)
-> (𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)) -> TestsOut
forall a b. (a -> b) -> a -> b
$ 𝐿 𝕊
tags 𝐿 𝕊 -> (ℕ64 ∧ ℕ64) -> 𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)
forall a. 𝐿 𝕊 -> a -> 𝐿 𝕊 ⇰ a
forall k s (d :: * -> *) a. Dict k s d => k -> a -> d a
↦ ℕ64
forall a. Zero a => a
zero ℕ64 -> ℕ64 -> ℕ64 ∧ ℕ64
forall a b. a -> b -> a ∧ b
:* ℕ64
n

instance Null TestsOut where
  null :: TestsOut
null = (𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc))) -> (𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)) -> TestsOut
TestsOut 𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc))
forall a. Null a => a
null 𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)
forall a. Null a => a
null
instance Append TestsOut where
  TestsOut 𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc))
f₁ 𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)
m₁ ⧺ :: TestsOut -> TestsOut -> TestsOut
⧺ TestsOut 𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc))
f₂ 𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)
m₂ = (𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc))) -> (𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)) -> TestsOut
TestsOut (𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc))
f₁ (𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc)))
-> (𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc)))
-> 𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc))
forall a. Append a => a -> a -> a
⧺ 𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc))
f₂) ((𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)) -> TestsOut)
-> (𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)) -> TestsOut
forall a b. (a -> b) -> a -> b
$ 𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)
m₁ (𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)) -> (𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)) -> 𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)
forall a. Append a => a -> a -> a
⧺ 𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)
m₂
instance Monoid TestsOut

runTests ∷ 𝔹 → FuzzParams → 𝑇D Test → IO ()
runTests :: 𝔹 -> FuzzParams -> 𝑇D Test -> IO ()
runTests 𝔹
noisy FuzzParams
γ 𝑇D Test
tests = do
  𝔹 -> (() -> IO ()) -> IO ()
forall (m :: * -> *). Return m => 𝔹 -> (() -> m ()) -> m ()
when  𝔹
noisy ((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ () → do
    Doc -> IO ()
forall a. Pretty a => a -> IO ()
pprint (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ 𝕊 -> Doc
ppComment 𝕊
"running tests…"
  IO ()
oflush
  let fₙ ∷ 𝕊 → MU (RWST (𝐼 𝕊) TestsOut () IO) → MU (RWST (𝐼 𝕊) TestsOut () IO)
      fₙ :: 𝕊
-> MU (RWST (𝐼 𝕊) TestsOut () IO) -> MU (RWST (𝐼 𝕊) TestsOut () IO)
fₙ 𝕊
gr = (RWST (𝐼 𝕊) TestsOut () IO () -> RWST (𝐼 𝕊) TestsOut () IO ())
-> MU (RWST (𝐼 𝕊) TestsOut () IO) -> MU (RWST (𝐼 𝕊) TestsOut () IO)
forall (m :: * -> *). (m () -> m ()) -> MU m -> MU m
onMU ((RWST (𝐼 𝕊) TestsOut () IO () -> RWST (𝐼 𝕊) TestsOut () IO ())
 -> MU (RWST (𝐼 𝕊) TestsOut () IO)
 -> MU (RWST (𝐼 𝕊) TestsOut () IO))
-> (RWST (𝐼 𝕊) TestsOut () IO () -> RWST (𝐼 𝕊) TestsOut () IO ())
-> MU (RWST (𝐼 𝕊) TestsOut () IO)
-> MU (RWST (𝐼 𝕊) TestsOut () IO)
forall a b. (a -> b) -> a -> b
$ (𝐼 𝕊 -> 𝐼 𝕊)
-> RWST (𝐼 𝕊) TestsOut () IO () -> RWST (𝐼 𝕊) TestsOut () IO ()
forall (m :: * -> *) r a.
(Monad m, MonadReader r m) =>
(r -> r) -> m a -> m a
mapEnv ((𝐼 𝕊 -> 𝐼 𝕊)
 -> RWST (𝐼 𝕊) TestsOut () IO () -> RWST (𝐼 𝕊) TestsOut () IO ())
-> (𝐼 𝕊 -> 𝐼 𝕊)
-> RWST (𝐼 𝕊) TestsOut () IO ()
-> RWST (𝐼 𝕊) TestsOut () IO ()
forall a b. (a -> b) -> a -> b
$ 𝐼 𝕊 -> 𝐼 𝕊 -> 𝐼 𝕊
forall a. Append a => a -> a -> a
pospend (𝐼 𝕊 -> 𝐼 𝕊 -> 𝐼 𝕊) -> 𝐼 𝕊 -> 𝐼 𝕊 -> 𝐼 𝕊
forall a b. (a -> b) -> a -> b
$ 𝕊 -> 𝐼 𝕊
forall a t. Single a t => a -> t
single 𝕊
gr
      fₗ ∷ 𝐼 Test → MU (RWST (𝐼 𝕊) TestsOut () IO)
      fₗ :: 𝐼 Test -> MU (RWST (𝐼 𝕊) TestsOut () IO)
fₗ 𝐼 Test
ts = RWST (𝐼 𝕊) TestsOut () IO () -> MU (RWST (𝐼 𝕊) TestsOut () IO)
forall (m :: * -> *). m () -> MU m
MU (RWST (𝐼 𝕊) TestsOut () IO () -> MU (RWST (𝐼 𝕊) TestsOut () IO))
-> RWST (𝐼 𝕊) TestsOut () IO () -> MU (RWST (𝐼 𝕊) TestsOut () IO)
forall a b. (a -> b) -> a -> b
$ 𝐼 Test
-> (Test -> RWST (𝐼 𝕊) TestsOut () IO ())
-> RWST (𝐼 𝕊) TestsOut () IO ()
forall (m :: * -> *) a t.
(Monad m, ToIter a t) =>
t -> (a -> m ()) -> m ()
eachOn 𝐼 Test
ts ((Test -> RWST (𝐼 𝕊) TestsOut () IO ())
 -> RWST (𝐼 𝕊) TestsOut () IO ())
-> (Test -> RWST (𝐼 𝕊) TestsOut () IO ())
-> RWST (𝐼 𝕊) TestsOut () IO ()
forall a b. (a -> b) -> a -> b
$ \ (Test Doc
lD () -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ()
uM) → do
        𝐿 𝕊
tags ← 𝐼 𝕊 -> 𝐿 𝕊
forall a t. ToIter a t => t -> 𝐿 a
list (𝐼 𝕊 -> 𝐿 𝕊)
-> RWST (𝐼 𝕊) TestsOut () IO (𝐼 𝕊)
-> RWST (𝐼 𝕊) TestsOut () IO (𝐿 𝕊)
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ RWST (𝐼 𝕊) TestsOut () IO (𝐼 𝕊)
forall (m :: * -> *) r. (Monad m, MonadReader r m) => m r
ask
        () :* ℕ64
nPass :* (() -> 𝑇A Doc) ∨ ()
ueE ← IO ((() ∧ ℕ64) ∧ ((() -> 𝑇A Doc) ∨ ()))
-> RWST (𝐼 𝕊) TestsOut () IO ((() ∧ ℕ64) ∧ ((() -> 𝑇A Doc) ∨ ()))
forall a. IO a -> RWST (𝐼 𝕊) TestsOut () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO ((() ∧ ℕ64) ∧ ((() -> 𝑇A Doc) ∨ ()))
 -> RWST (𝐼 𝕊) TestsOut () IO ((() ∧ ℕ64) ∧ ((() -> 𝑇A Doc) ∨ ())))
-> IO ((() ∧ ℕ64) ∧ ((() -> 𝑇A Doc) ∨ ()))
-> RWST (𝐼 𝕊) TestsOut () IO ((() ∧ ℕ64) ∧ ((() -> 𝑇A Doc) ∨ ()))
forall a b. (a -> b) -> a -> b
$ FuzzParams
-> ()
-> RWST FuzzParams ℕ64 () IO ((() -> 𝑇A Doc) ∨ ())
-> IO ((() ∧ ℕ64) ∧ ((() -> 𝑇A Doc) ∨ ()))
forall r o s (m :: * -> *) a.
Monad m =>
r -> s -> RWST r o s m a -> m ((s ∧ o) ∧ a)
runRWST FuzzParams
γ () (RWST FuzzParams ℕ64 () IO ((() -> 𝑇A Doc) ∨ ())
 -> IO ((() ∧ ℕ64) ∧ ((() -> 𝑇A Doc) ∨ ())))
-> RWST FuzzParams ℕ64 () IO ((() -> 𝑇A Doc) ∨ ())
-> IO ((() ∧ ℕ64) ∧ ((() -> 𝑇A Doc) ∨ ()))
forall a b. (a -> b) -> a -> b
$ ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ()
-> RWST FuzzParams ℕ64 () IO ((() -> 𝑇A Doc) ∨ ())
forall e (m :: * -> *) a. ErrorT e m a -> m (e ∨ a)
unErrorT (ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ()
 -> RWST FuzzParams ℕ64 () IO ((() -> 𝑇A Doc) ∨ ()))
-> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ()
-> RWST FuzzParams ℕ64 () IO ((() -> 𝑇A Doc) ∨ ())
forall a b. (a -> b) -> a -> b
$ () -> ErrorT (() -> 𝑇A Doc) (RWST FuzzParams ℕ64 () IO) ()
uM ()
        case (() -> 𝑇A Doc) ∨ ()
ueE of
          Inl () -> 𝑇A Doc
errD → do
            TestsOut -> RWST (𝐼 𝕊) TestsOut () IO ()
forall o (m :: * -> *). MonadWriter o m => o -> m ()
tell (TestsOut -> RWST (𝐼 𝕊) TestsOut () IO ())
-> TestsOut -> RWST (𝐼 𝕊) TestsOut () IO ()
forall a b. (a -> b) -> a -> b
$ 𝐿 𝕊 -> ℕ64 -> TestsOut
testsOutMetricFail 𝐿 𝕊
tags ℕ64
1
            TestsOut -> RWST (𝐼 𝕊) TestsOut () IO ()
forall o (m :: * -> *). MonadWriter o m => o -> m ()
tell (TestsOut -> RWST (𝐼 𝕊) TestsOut () IO ())
-> TestsOut -> RWST (𝐼 𝕊) TestsOut () IO ()
forall a b. (a -> b) -> a -> b
$ 𝐿 𝕊 -> Doc -> (() -> 𝑇A Doc) -> TestsOut
testsOutFailure 𝐿 𝕊
tags Doc
lD () -> 𝑇A Doc
errD
          Inr () → do
            TestsOut -> RWST (𝐼 𝕊) TestsOut () IO ()
forall o (m :: * -> *). MonadWriter o m => o -> m ()
tell (TestsOut -> RWST (𝐼 𝕊) TestsOut () IO ())
-> TestsOut -> RWST (𝐼 𝕊) TestsOut () IO ()
forall a b. (a -> b) -> a -> b
$ 𝐿 𝕊 -> ℕ64 -> TestsOut
testsOutMetricPass 𝐿 𝕊
tags ℕ64
nPass
  TestsOut
o ← 𝐼 𝕊 -> () -> RWST (𝐼 𝕊) TestsOut () IO TestsOut -> IO TestsOut
forall r o s (m :: * -> *) a.
Monad m =>
r -> s -> RWST r o s m a -> m a
evalRWST 𝐼 𝕊
forall a. Null a => a
null () (RWST (𝐼 𝕊) TestsOut () IO TestsOut -> IO TestsOut)
-> RWST (𝐼 𝕊) TestsOut () IO TestsOut -> IO TestsOut
forall a b. (a -> b) -> a -> b
$ RWST (𝐼 𝕊) TestsOut () IO () -> RWST (𝐼 𝕊) TestsOut () IO TestsOut
forall o (m :: * -> *) a. (Monad m, MonadWriter o m) => m a -> m o
retOut (RWST (𝐼 𝕊) TestsOut () IO ()
 -> RWST (𝐼 𝕊) TestsOut () IO TestsOut)
-> RWST (𝐼 𝕊) TestsOut () IO ()
-> RWST (𝐼 𝕊) TestsOut () IO TestsOut
forall a b. (a -> b) -> a -> b
$ MU (RWST (𝐼 𝕊) TestsOut () IO) -> RWST (𝐼 𝕊) TestsOut () IO ()
forall (m :: * -> *). MU m -> m ()
unMU (MU (RWST (𝐼 𝕊) TestsOut () IO) -> RWST (𝐼 𝕊) TestsOut () IO ())
-> MU (RWST (𝐼 𝕊) TestsOut () IO) -> RWST (𝐼 𝕊) TestsOut () IO ()
forall a b. (a -> b) -> a -> b
$ 𝑇D Test
-> (𝐼 Test -> MU (RWST (𝐼 𝕊) TestsOut () IO))
-> (𝕊
    -> MU (RWST (𝐼 𝕊) TestsOut () IO)
    -> MU (RWST (𝐼 𝕊) TestsOut () IO))
-> MU (RWST (𝐼 𝕊) TestsOut () IO)
forall b a. Monoid b => 𝑇D a -> (𝐼 a -> b) -> (𝕊 -> b -> b) -> b
fold𝑇DOn 𝑇D Test
tests 𝐼 Test -> MU (RWST (𝐼 𝕊) TestsOut () IO)
fₗ 𝕊
-> MU (RWST (𝐼 𝕊) TestsOut () IO) -> MU (RWST (𝐼 𝕊) TestsOut () IO)
fₙ
  𝔹 -> (() -> IO ()) -> IO ()
forall (m :: * -> *). Return m => 𝔹 -> (() -> m ()) -> m ()
when 𝔹
noisy ((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ () → do
    Doc -> IO ()
forall a. Pretty a => a -> IO ()
pprint (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall t. ToIter Doc t => t -> Doc
ppVertical
      [ 𝕊 -> Doc
ppHeader 𝕊
"TEST METRICS"
      , 𝐼 Doc -> Doc
forall t. ToIter Doc t => t -> Doc
ppVertical (𝐼 Doc -> Doc) -> 𝐼 Doc -> Doc
forall a b. (a -> b) -> a -> b
$ 𝐼 (𝐿 𝕊 ∧ (ℕ64 ∧ ℕ64)) -> ((𝐿 𝕊 ∧ (ℕ64 ∧ ℕ64)) -> Doc) -> 𝐼 Doc
forall (t :: * -> *) a b. Functor t => t a -> (a -> b) -> t b
mapOn ((𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)) -> 𝐼 (𝐿 𝕊 ∧ (ℕ64 ∧ ℕ64))
forall a t. ToIter a t => t -> 𝐼 a
iter ((𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)) -> 𝐼 (𝐿 𝕊 ∧ (ℕ64 ∧ ℕ64)))
-> (𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)) -> 𝐼 (𝐿 𝕊 ∧ (ℕ64 ∧ ℕ64))
forall a b. (a -> b) -> a -> b
$ TestsOut -> 𝐿 𝕊 ⇰ (ℕ64 ∧ ℕ64)
testsOutMetrics TestsOut
o) (((𝐿 𝕊 ∧ (ℕ64 ∧ ℕ64)) -> Doc) -> 𝐼 Doc)
-> ((𝐿 𝕊 ∧ (ℕ64 ∧ ℕ64)) -> Doc) -> 𝐼 Doc
forall a b. (a -> b) -> a -> b
$ \ (𝐿 𝕊
tags :* (ℕ64
p :* ℕ64
f)) →
          let src :: 𝕊
src = 𝐼 𝕊 -> 𝕊
forall a t. (Monoid a, ToIter a t) => t -> a
concat (𝐼 𝕊 -> 𝕊) -> 𝐼 𝕊 -> 𝕊
forall a b. (a -> b) -> a -> b
$ 𝕊 -> 𝐿 𝕊 -> 𝐼 𝕊
forall a t. ToIter a t => a -> t -> 𝐼 a
inbetween 𝕊
":" 𝐿 𝕊
tags
          in 𝐼 Doc -> Doc
forall t. ToIter Doc t => t -> Doc
ppVertical (𝐼 Doc -> Doc) -> 𝐼 Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [𝐼 Doc] -> 𝐼 Doc
forall a t. (Monoid a, ToIter a t) => t -> a
concat
            [ if ℕ64
p ℕ64 -> ℕ64 -> 𝔹
forall a. Eq a => a -> a -> 𝔹
≡ ℕ64
0 then 𝐼 Doc
forall a. 𝐼 a
null𝐼 else Doc -> 𝐼 Doc
forall a t. Single a t => a -> t
single (Doc -> 𝐼 Doc) -> Doc -> 𝐼 Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
forall t. ToIter Doc t => t -> Doc
ppHorizontal
                  [ Color -> Doc -> Doc
ppFG Color
green (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ 𝕊 -> Doc
ppString 𝕊
"PASSED"
                  , Doc -> Doc
ppBD (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Color -> Doc -> Doc
ppFG Color
green (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ 𝕊 -> Doc
ppString (𝕊 -> Doc) -> 𝕊 -> Doc
forall a b. (a -> b) -> a -> b
$ ℕ -> 𝕊 -> 𝕊
alignRight (ℕ -> ℕ
𝕟 ℕ
3) (𝕊 -> 𝕊) -> 𝕊 -> 𝕊
forall a b. (a -> b) -> a -> b
$ ℕ64 -> 𝕊
forall a. Show a => a -> 𝕊
show𝕊 ℕ64
p
                  , 𝕊 -> Doc
ppPun (𝕊 -> Doc) -> 𝕊 -> Doc
forall a b. (a -> b) -> a -> b
$ [𝕊] -> 𝕊
forall a t. (Monoid a, ToIter a t) => t -> a
concat [𝕊
"» ",𝕊
src]
                  ]
            , if ℕ64
f ℕ64 -> ℕ64 -> 𝔹
forall a. Eq a => a -> a -> 𝔹
≡ ℕ64
0 then 𝐼 Doc
forall a. Null a => a
null else Doc -> 𝐼 Doc
forall a t. Single a t => a -> t
single (Doc -> 𝐼 Doc) -> Doc -> 𝐼 Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
forall t. ToIter Doc t => t -> Doc
ppHorizontal
                  [ Color -> Doc -> Doc
ppFG Color
red (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ 𝕊 -> Doc
ppString 𝕊
"FAILED"
                  , Doc -> Doc
ppBD (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Color -> Doc -> Doc
ppFG Color
red (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ 𝕊 -> Doc
ppString (𝕊 -> Doc) -> 𝕊 -> Doc
forall a b. (a -> b) -> a -> b
$ ℕ -> 𝕊 -> 𝕊
alignRight (ℕ -> ℕ
𝕟 ℕ
3) (𝕊 -> 𝕊) -> 𝕊 -> 𝕊
forall a b. (a -> b) -> a -> b
$ ℕ64 -> 𝕊
forall a. Show a => a -> 𝕊
show𝕊 ℕ64
f
                  , 𝕊 -> Doc
ppPun (𝕊 -> Doc) -> 𝕊 -> Doc
forall a b. (a -> b) -> a -> b
$ [𝕊] -> 𝕊
forall a t. (Monoid a, ToIter a t) => t -> a
concat [𝕊
"» ",𝕊
src]
                  ]
            ]

      ]
  𝔹 -> (() -> IO ()) -> IO ()
forall (m :: * -> *). Return m => 𝔹 -> (() -> m ()) -> m ()
when (𝔹 -> 𝔹
not (𝔹 -> 𝔹) -> 𝔹 -> 𝔹
forall a b. (a -> b) -> a -> b
$ 𝐼 (𝐿 𝕊 ∧ 𝐼 (Doc ∧ (() -> 𝑇A Doc))) -> 𝔹
forall a t. ToIter a t => t -> 𝔹
isEmpty (𝐼 (𝐿 𝕊 ∧ 𝐼 (Doc ∧ (() -> 𝑇A Doc))) -> 𝔹)
-> 𝐼 (𝐿 𝕊 ∧ 𝐼 (Doc ∧ (() -> 𝑇A Doc))) -> 𝔹
forall a b. (a -> b) -> a -> b
$ (𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc)))
-> 𝐼 (𝐿 𝕊 ∧ 𝐼 (Doc ∧ (() -> 𝑇A Doc)))
forall a t. ToIter a t => t -> 𝐼 a
iter ((𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc)))
 -> 𝐼 (𝐿 𝕊 ∧ 𝐼 (Doc ∧ (() -> 𝑇A Doc))))
-> (𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc)))
-> 𝐼 (𝐿 𝕊 ∧ 𝐼 (Doc ∧ (() -> 𝑇A Doc)))
forall a b. (a -> b) -> a -> b
$ TestsOut -> 𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc))
testsOutFailures TestsOut
o) ((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ () → do
    Doc -> IO ()
forall a. Pretty a => a -> IO ()
pprint (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall t. ToIter Doc t => t -> Doc
ppVertical
      [ 𝕊 -> Doc
ppHeader 𝕊
"FAILED TESTS"
      , 𝑇A Doc -> Doc
forall a. Pretty a => a -> Doc
pretty (𝑇A Doc -> Doc) -> 𝑇A Doc -> Doc
forall a b. (a -> b) -> a -> b
$ 𝐼 (𝑇A Doc) -> 𝑇A Doc
forall a t. (Monoid a, ToIter a t) => t -> a
concat (𝐼 (𝑇A Doc) -> 𝑇A Doc) -> 𝐼 (𝑇A Doc) -> 𝑇A Doc
forall a b. (a -> b) -> a -> b
$ 𝐼 (𝐿 𝕊 ∧ 𝐼 (Doc ∧ (() -> 𝑇A Doc)))
-> ((𝐿 𝕊 ∧ 𝐼 (Doc ∧ (() -> 𝑇A Doc))) -> 𝑇A Doc) -> 𝐼 (𝑇A Doc)
forall (t :: * -> *) a b. Functor t => t a -> (a -> b) -> t b
mapOn ((𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc)))
-> 𝐼 (𝐿 𝕊 ∧ 𝐼 (Doc ∧ (() -> 𝑇A Doc)))
forall a t. ToIter a t => t -> 𝐼 a
iter ((𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc)))
 -> 𝐼 (𝐿 𝕊 ∧ 𝐼 (Doc ∧ (() -> 𝑇A Doc))))
-> (𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc)))
-> 𝐼 (𝐿 𝕊 ∧ 𝐼 (Doc ∧ (() -> 𝑇A Doc)))
forall a b. (a -> b) -> a -> b
$ TestsOut -> 𝐿 𝕊 ⇰ 𝐼 (Doc ∧ (() -> 𝑇A Doc))
testsOutFailures TestsOut
o) (((𝐿 𝕊 ∧ 𝐼 (Doc ∧ (() -> 𝑇A Doc))) -> 𝑇A Doc) -> 𝐼 (𝑇A Doc))
-> ((𝐿 𝕊 ∧ 𝐼 (Doc ∧ (() -> 𝑇A Doc))) -> 𝑇A Doc) -> 𝐼 (𝑇A Doc)
forall a b. (a -> b) -> a -> b
$ \ (𝐿 𝕊
tags :* 𝐼 (Doc ∧ (() -> 𝑇A Doc))
lDerrDs) →
          𝐼 (𝑇A Doc) -> 𝑇A Doc
forall a t. (Monoid a, ToIter a t) => t -> a
concat (𝐼 (𝑇A Doc) -> 𝑇A Doc) -> 𝐼 (𝑇A Doc) -> 𝑇A Doc
forall a b. (a -> b) -> a -> b
$ 𝐼 (Doc ∧ (() -> 𝑇A Doc))
-> ((Doc ∧ (() -> 𝑇A Doc)) -> 𝑇A Doc) -> 𝐼 (𝑇A Doc)
forall (t :: * -> *) a b. Functor t => t a -> (a -> b) -> t b
mapOn 𝐼 (Doc ∧ (() -> 𝑇A Doc))
lDerrDs (((Doc ∧ (() -> 𝑇A Doc)) -> 𝑇A Doc) -> 𝐼 (𝑇A Doc))
-> ((Doc ∧ (() -> 𝑇A Doc)) -> 𝑇A Doc) -> 𝐼 (𝑇A Doc)
forall a b. (a -> b) -> a -> b
$ \ (Doc
lD :* () -> 𝑇A Doc
errD) → 
            𝕊 -> 𝑇A Doc -> 𝑇A Doc
forall a. 𝕊 -> 𝑇A a -> 𝑇A a
𝐤 (𝐼 𝕊 -> 𝕊
forall a t. (Monoid a, ToIter a t) => t -> a
concat (𝐼 𝕊 -> 𝕊) -> 𝐼 𝕊 -> 𝕊
forall a b. (a -> b) -> a -> b
$ 𝕊 -> 𝐿 𝕊 -> 𝐼 𝕊
forall a t. ToIter a t => a -> t -> 𝐼 a
inbetween 𝕊
":" 𝐿 𝕊
tags) (𝑇A Doc -> 𝑇A Doc) -> 𝑇A Doc -> 𝑇A Doc
forall a b. (a -> b) -> a -> b
$ [𝑇A Doc] -> 𝑇A Doc
forall a t. (Monoid a, ToIter a t) => t -> a
concat
              [ 𝕊 -> 𝑇A Doc -> 𝑇A Doc
forall a. 𝕊 -> 𝑇A a -> 𝑇A a
𝐤 𝕊
"loc" (𝑇A Doc -> 𝑇A Doc) -> 𝑇A Doc -> 𝑇A Doc
forall a b. (a -> b) -> a -> b
$ Doc -> 𝑇A Doc
forall a. a -> 𝑇A a
𝐯 (Doc -> 𝑇A Doc) -> Doc -> 𝑇A Doc
forall a b. (a -> b) -> a -> b
$ Color -> Doc -> Doc
ppFG Color
grayDark Doc
lD
              , () -> 𝑇A Doc
errD ()
              ]
      ]
    IO ()
forall a. IO a
abortIO

𝔱 ∷ 𝕊 → TH.ExpQ → TH.ExpQ → TH.Q [TH.Dec]
#ifdef NO_UVMHS_TESTS
𝔱 _ _ _ = return []
#else
𝔱 :: 𝕊 -> Q Exp -> Q Exp -> Q [Dec]
𝔱 𝕊
tag Q Exp
xEQ Q Exp
yEQ = forall a. (Eq a, Pretty a) => 𝕊 -> CodeQ a -> CodeQ a -> Q [Dec]
𝔱T @() 𝕊
tag (Q Exp -> CodeQ ()
forall a (m :: * -> *). Quote m => m Exp -> Code m a
TH.unsafeCodeCoerce Q Exp
xEQ) (Q Exp -> CodeQ ()
forall a (m :: * -> *). Quote m => m Exp -> Code m a
TH.unsafeCodeCoerce Q Exp
yEQ)
#endif

𝔱T ∷ (Eq a,Pretty a) ⇒ 𝕊 → TH.CodeQ a → TH.CodeQ a → TH.Q [TH.Dec]
𝔱T :: forall a. (Eq a, Pretty a) => 𝕊 -> CodeQ a -> CodeQ a -> Q [Dec]
𝔱T 𝕊
tag CodeQ a
xE CodeQ a
yE = do
  Loc
l ← Q Loc
TH.location
  let lS :: 𝕊
lS = [𝕊] -> 𝕊
forall a t. (Monoid a, ToIter a t) => t -> a
concat [String -> 𝕊
frhsChars (String -> 𝕊) -> String -> 𝕊
forall a b. (a -> b) -> a -> b
$ Loc -> String
TH.loc_module Loc
l,𝕊
":",ℤ64 -> 𝕊
forall a. Show a => a -> 𝕊
show𝕊 (ℤ64 -> 𝕊) -> ℤ64 -> 𝕊
forall a b. (a -> b) -> a -> b
$ (ℤ64 ∧ ℤ64) -> ℤ64
forall a b. (a ∧ b) -> a
fst ((ℤ64 ∧ ℤ64) -> ℤ64) -> (ℤ64 ∧ ℤ64) -> ℤ64
forall a b. (a -> b) -> a -> b
$ CharPos -> ℤ64 ∧ ℤ64
forall a b. CHS a b => b -> a
frhs (CharPos -> ℤ64 ∧ ℤ64) -> CharPos -> ℤ64 ∧ ℤ64
forall a b. (a -> b) -> a -> b
$ Loc -> CharPos
TH.loc_start Loc
l]
  let tags :: 𝐿 𝕊
tags = 𝐼 𝕊 -> 𝐿 𝕊
forall a t. ToIter a t => t -> 𝐿 a
list (𝐼 𝕊 -> 𝐿 𝕊) -> 𝐼 𝕊 -> 𝐿 𝕊
forall a b. (a -> b) -> a -> b
$ 𝕊 -> 𝕊 -> 𝐼 𝕊
splitOn𝕊 𝕊
":" 𝕊
tag
  𝐼 (CodeQ (𝑇D Test))
tests ← 𝐼 (CodeQ (𝑇D Test))
-> 𝑂 (𝐼 (CodeQ (𝑇D Test))) -> 𝐼 (CodeQ (𝑇D Test))
forall a. a -> 𝑂 a -> a
ifNone 𝐼 (CodeQ (𝑇D Test))
forall a. Null a => a
null (𝑂 (𝐼 (CodeQ (𝑇D Test))) -> 𝐼 (CodeQ (𝑇D Test)))
-> (Maybe (𝐼 (CodeQ (𝑇D Test))) -> 𝑂 (𝐼 (CodeQ (𝑇D Test))))
-> Maybe (𝐼 (CodeQ (𝑇D Test)))
-> 𝐼 (CodeQ (𝑇D Test))
forall b c a. (b -> c) -> (a -> b) -> a -> c
∘ Maybe (𝐼 (CodeQ (𝑇D Test))) -> 𝑂 (𝐼 (CodeQ (𝑇D Test)))
forall a. Maybe a -> 𝑂 a
frhs𝑂 (Maybe (𝐼 (CodeQ (𝑇D Test))) -> 𝐼 (CodeQ (𝑇D Test)))
-> Q (Maybe (𝐼 (CodeQ (𝑇D Test)))) -> Q (𝐼 (CodeQ (𝑇D Test)))
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ forall a. Typeable a => Q (Maybe a)
TH.getQ @(𝐼 (TH.CodeQ (𝑇D Test)))
  let t :: CodeQ (𝑇D Test)
t = [|| 𝐿 𝕊 -> 𝕊 -> a -> a -> 𝑇D Test
forall a. (Eq a, Pretty a) => 𝐿 𝕊 -> 𝕊 -> a -> a -> 𝑇D Test
eqTest 𝐿 a
tags a
lS $$CodeQ a
xE $$CodeQ a
yE ||]
      tests' :: 𝐼 (CodeQ (𝑇D Test))
tests' = 𝐼 (CodeQ (𝑇D Test))
tests 𝐼 (CodeQ (𝑇D Test)) -> 𝐼 (CodeQ (𝑇D Test)) -> 𝐼 (CodeQ (𝑇D Test))
forall a. Append a => a -> a -> a
⧺ CodeQ (𝑇D Test) -> 𝐼 (CodeQ (𝑇D Test))
forall a t. Single a t => a -> t
single CodeQ (𝑇D Test)
t
  forall a. Typeable a => a -> Q ()
TH.putQ @(𝐼 (TH.CodeQ (𝑇D Test))) 𝐼 (CodeQ (𝑇D Test))
tests'
  [Dec] -> Q [Dec]
forall a. a -> Q a
forall (m :: * -> *) a. Return m => a -> m a
return []

𝔣 ∷ 𝕊 → TH.ExpQ → TH.ExpQ → TH.ExpQ → TH.Q [TH.Dec]
#ifdef NO_UVMHS_TESTS
𝔣 _ _ _ _ = return []
#else
𝔣 :: 𝕊 -> Q Exp -> Q Exp -> Q Exp -> Q [Dec]
𝔣 𝕊
tag Q Exp
xIO Q Exp
p Q Exp
xD = forall a.
(Pretty a, Shrinky a) =>
𝕊
-> CodeQ (FuzzyM a)
-> CodeQ (a -> 𝔹)
-> CodeQ (a -> Doc)
-> Q [Dec]
𝔣T @() 𝕊
tag (Q Exp -> CodeQ (FuzzyM ())
forall a (m :: * -> *). Quote m => m Exp -> Code m a
TH.unsafeCodeCoerce Q Exp
xIO) (Q Exp -> CodeQ (() -> 𝔹)
forall a (m :: * -> *). Quote m => m Exp -> Code m a
TH.unsafeCodeCoerce Q Exp
p) (CodeQ (() -> Doc) -> Q [Dec]) -> CodeQ (() -> Doc) -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ Q Exp -> CodeQ (() -> Doc)
forall a (m :: * -> *). Quote m => m Exp -> Code m a
TH.unsafeCodeCoerce Q Exp
xD
#endif

𝔣T ∷ (Pretty a,Shrinky a) ⇒ 𝕊 → TH.CodeQ (FuzzyM a) → TH.CodeQ (a → 𝔹) → TH.CodeQ (a → Doc) → TH.Q [TH.Dec]
𝔣T :: forall a.
(Pretty a, Shrinky a) =>
𝕊
-> CodeQ (FuzzyM a)
-> CodeQ (a -> 𝔹)
-> CodeQ (a -> Doc)
-> Q [Dec]
𝔣T 𝕊
tag CodeQ (FuzzyM a)
xIOE CodeQ (a -> 𝔹)
pE CodeQ (a -> Doc)
xDE = do
  Loc
l ← Q Loc
TH.location
  let lS :: 𝕊
lS = [𝕊] -> 𝕊
forall a t. (Monoid a, ToIter a t) => t -> a
concat
        [ String -> 𝕊
frhsChars (String -> 𝕊) -> String -> 𝕊
forall a b. (a -> b) -> a -> b
$ Loc -> String
TH.loc_module Loc
l
        , 𝕊
":"
        , ℤ64 -> 𝕊
forall a. Show a => a -> 𝕊
show𝕊 (ℤ64 -> 𝕊) -> ℤ64 -> 𝕊
forall a b. (a -> b) -> a -> b
$ (ℤ64 ∧ ℤ64) -> ℤ64
forall a b. (a ∧ b) -> a
fst ((ℤ64 ∧ ℤ64) -> ℤ64) -> (ℤ64 ∧ ℤ64) -> ℤ64
forall a b. (a -> b) -> a -> b
$ CharPos -> ℤ64 ∧ ℤ64
forall a b. CHS a b => b -> a
frhs (CharPos -> ℤ64 ∧ ℤ64) -> CharPos -> ℤ64 ∧ ℤ64
forall a b. (a -> b) -> a -> b
$ Loc -> CharPos
TH.loc_start Loc
l
        ]
  let tags :: 𝐿 𝕊
tags = 𝐼 𝕊 -> 𝐿 𝕊
forall a t. ToIter a t => t -> 𝐿 a
list (𝐼 𝕊 -> 𝐿 𝕊) -> 𝐼 𝕊 -> 𝐿 𝕊
forall a b. (a -> b) -> a -> b
$ 𝕊 -> 𝕊 -> 𝐼 𝕊
splitOn𝕊 𝕊
":" 𝕊
tag
  𝐼 (CodeQ (𝑇D Test))
tests ← 𝐼 (CodeQ (𝑇D Test))
-> 𝑂 (𝐼 (CodeQ (𝑇D Test))) -> 𝐼 (CodeQ (𝑇D Test))
forall a. a -> 𝑂 a -> a
ifNone 𝐼 (CodeQ (𝑇D Test))
forall a. Null a => a
null (𝑂 (𝐼 (CodeQ (𝑇D Test))) -> 𝐼 (CodeQ (𝑇D Test)))
-> (Maybe (𝐼 (CodeQ (𝑇D Test))) -> 𝑂 (𝐼 (CodeQ (𝑇D Test))))
-> Maybe (𝐼 (CodeQ (𝑇D Test)))
-> 𝐼 (CodeQ (𝑇D Test))
forall b c a. (b -> c) -> (a -> b) -> a -> c
∘ Maybe (𝐼 (CodeQ (𝑇D Test))) -> 𝑂 (𝐼 (CodeQ (𝑇D Test)))
forall a. Maybe a -> 𝑂 a
frhs𝑂 (Maybe (𝐼 (CodeQ (𝑇D Test))) -> 𝐼 (CodeQ (𝑇D Test)))
-> Q (Maybe (𝐼 (CodeQ (𝑇D Test)))) -> Q (𝐼 (CodeQ (𝑇D Test)))
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ forall a. Typeable a => Q (Maybe a)
TH.getQ @(𝐼 (TH.CodeQ (𝑇D Test)))
  let t' :: CodeQ (𝑇D Test)
t' = [|| 𝐿 𝕊 -> 𝕊 -> FuzzyM a -> (a -> 𝔹) -> (a -> Doc) -> 𝑇D Test
forall a.
(Pretty a, Shrinky a) =>
𝐿 𝕊 -> 𝕊 -> FuzzyM a -> (a -> 𝔹) -> (a -> Doc) -> 𝑇D Test
fuzzTest 𝐿 a
tags a
lS $$CodeQ (FuzzyM a)
xIOE $$CodeQ (a -> 𝔹)
pE $$CodeQ (a -> Doc)
xDE ||]
      tests' :: 𝐼 (CodeQ (𝑇D Test))
tests' = 𝐼 (CodeQ (𝑇D Test))
tests 𝐼 (CodeQ (𝑇D Test)) -> 𝐼 (CodeQ (𝑇D Test)) -> 𝐼 (CodeQ (𝑇D Test))
forall a. Append a => a -> a -> a
⧺ CodeQ (𝑇D Test) -> 𝐼 (CodeQ (𝑇D Test))
forall a t. Single a t => a -> t
single CodeQ (𝑇D Test)
t'
  forall a. Typeable a => a -> Q ()
TH.putQ @(𝐼 (TH.CodeQ (𝑇D Test))) 𝐼 (CodeQ (𝑇D Test))
tests'
  [Dec] -> Q [Dec]
forall a. a -> Q a
forall (m :: * -> *) a. Return m => a -> m a
return []

buildTests ∷ TH.Q [TH.Dec]
buildTests :: Q [Dec]
buildTests = do
  𝐼 (CodeQ (𝑇D Test))
testEQs ← 𝐼 (CodeQ (𝑇D Test))
-> 𝑂 (𝐼 (CodeQ (𝑇D Test))) -> 𝐼 (CodeQ (𝑇D Test))
forall a. a -> 𝑂 a -> a
ifNone 𝐼 (CodeQ (𝑇D Test))
forall a. Null a => a
null (𝑂 (𝐼 (CodeQ (𝑇D Test))) -> 𝐼 (CodeQ (𝑇D Test)))
-> (Maybe (𝐼 (CodeQ (𝑇D Test))) -> 𝑂 (𝐼 (CodeQ (𝑇D Test))))
-> Maybe (𝐼 (CodeQ (𝑇D Test)))
-> 𝐼 (CodeQ (𝑇D Test))
forall b c a. (b -> c) -> (a -> b) -> a -> c
∘ Maybe (𝐼 (CodeQ (𝑇D Test))) -> 𝑂 (𝐼 (CodeQ (𝑇D Test)))
forall a. Maybe a -> 𝑂 a
frhs𝑂 (Maybe (𝐼 (CodeQ (𝑇D Test))) -> 𝐼 (CodeQ (𝑇D Test)))
-> Q (Maybe (𝐼 (CodeQ (𝑇D Test)))) -> Q (𝐼 (CodeQ (𝑇D Test)))
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ forall a. Typeable a => Q (Maybe a)
TH.getQ @(𝐼 (TH.CodeQ (𝑇D Test)))
  Loc
l ← Q Loc
TH.location
  let modNameS :: 𝕊
modNameS = String -> 𝕊
frhsChars (String -> 𝕊) -> String -> 𝕊
forall a b. (a -> b) -> a -> b
$ Loc -> String
TH.loc_module Loc
l
      testsNameS :: 𝕊
testsNameS = 𝕊
"g__TESTS__" 𝕊 -> 𝕊 -> 𝕊
forall a. Append a => a -> a -> a
⧺ 𝕊 -> 𝕊 -> 𝕊 -> 𝕊
replace𝕊 𝕊
"." 𝕊
"__" 𝕊
modNameS
      testsName :: Name
testsName = String -> Name
TH.mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ 𝕊 -> String
tohsChars 𝕊
testsNameS
      testEQs' ∷ TH.CodeQ [𝑇D Test]
      testEQs' :: CodeQ [𝑇D Test]
testEQs' = Q (TExp [𝑇D Test]) -> CodeQ [𝑇D Test]
forall (m :: * -> *) a. m (TExp a) -> Code m a
TH.Code (Q (TExp [𝑇D Test]) -> CodeQ [𝑇D Test])
-> Q (TExp [𝑇D Test]) -> CodeQ [𝑇D Test]
forall a b. (a -> b) -> a -> b
$ Exp -> TExp [𝑇D Test]
forall a. Exp -> TExp a
TH.TExp (Exp -> TExp [𝑇D Test]) -> Q Exp -> Q (TExp [𝑇D Test])
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
TH.listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ 𝐼 (Q Exp) -> [Q Exp]
forall a t. ToIter a t => t -> [a]
lazyList (𝐼 (Q Exp) -> [Q Exp]) -> 𝐼 (Q Exp) -> [Q Exp]
forall a b. (a -> b) -> a -> b
$ (CodeQ (𝑇D Test) -> Q Exp) -> 𝐼 (CodeQ (𝑇D Test)) -> 𝐼 (Q Exp)
forall a b. (a -> b) -> 𝐼 a -> 𝐼 b
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
map CodeQ (𝑇D Test) -> Q Exp
forall a (m :: * -> *). Quote m => Code m a -> m Exp
TH.unTypeCode 𝐼 (CodeQ (𝑇D Test))
testEQs
      testsEQ ∷ TH.CodeQ (𝑇D Test)
      testsEQ :: CodeQ (𝑇D Test)
testsEQ = [|| t -> a
forall a t. (Monoid a, ToIter a t) => t -> a
concat $$CodeQ [𝑇D Test]
testEQs' ||]
  [[Dec]] -> [Dec]
forall a t. (Monoid a, ToIter a t) => t -> a
concat ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ [Q [Dec]] -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a.
(FunctorM t, Monad m) =>
t (m a) -> m (t a)
exchange ([Q [Dec]] -> Q [[Dec]]) -> [Q [Dec]] -> Q [[Dec]]
forall a b. (a -> b) -> a -> b
$
    [ Dec -> [Dec]
forall a t. Single a t => a -> t
single (Dec -> [Dec]) -> Q Dec -> Q [Dec]
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ Name -> Q Type -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
TH.sigD Name
testsName [t| 𝑇D Test |]
    , [d| $(Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
TH.varP Name
testsName) = $(CodeQ (𝑇D Test) -> Q Exp
forall a (m :: * -> *). Quote m => Code m a -> m Exp
TH.unTypeCode CodeQ (𝑇D Test)
testsEQ) |]
    ]

testModules ∷ 𝔹 → FuzzParams → [𝕊] → TH.CodeQ (IO ())
testModules :: 𝔹 -> FuzzParams -> [𝕊] -> CodeQ (IO ())
testModules 𝔹
noisy FuzzParams
γ [𝕊]
nsS =
  let nss :: [𝐼 𝕊]
nss = (𝕊 -> 𝐼 𝕊) -> [𝕊] -> [𝐼 𝕊]
forall a b. (a -> b) -> [a] -> [b]
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
map (𝕊 -> 𝕊 -> 𝐼 𝕊
splitOn𝕊 𝕊
":") [𝕊]
nsS
      testsNamesS :: [𝕊]
testsNamesS = [𝐼 𝕊] -> (𝐼 𝕊 -> 𝕊) -> [𝕊]
forall (t :: * -> *) a b. Functor t => t a -> (a -> b) -> t b
mapOn [𝐼 𝕊]
nss ((𝐼 𝕊 -> 𝕊) -> [𝕊]) -> (𝐼 𝕊 -> 𝕊) -> [𝕊]
forall a b. (a -> b) -> a -> b
$ \ 𝐼 𝕊
ns →
        𝐼 𝕊 -> 𝕊
forall a t. (Monoid a, ToIter a t) => t -> a
concat (𝐼 𝕊 -> 𝕊) -> 𝐼 𝕊 -> 𝕊
forall a b. (a -> b) -> a -> b
$ 𝕊 -> 𝐼 𝕊 -> 𝐼 𝕊
forall a t. ToIter a t => a -> t -> 𝐼 a
inbetween 𝕊
"." (𝐼 𝕊 -> 𝐼 𝕊) -> 𝐼 𝕊 -> 𝐼 𝕊
forall a b. (a -> b) -> a -> b
$ 𝐼 𝕊 -> (𝕊 -> 𝕊) -> 𝐼 𝕊
forall a t. ToIter a t => t -> (a -> a) -> 𝐼 a
mapLastOn 𝐼 𝕊
ns ((𝕊 -> 𝕊) -> 𝐼 𝕊) -> (𝕊 -> 𝕊) -> 𝐼 𝕊
forall a b. (a -> b) -> a -> b
$ \ 𝕊
n → 𝕊
"g__TESTS__" 𝕊 -> 𝕊 -> 𝕊
forall a. Append a => a -> a -> a
⧺ 𝕊 -> 𝕊 -> 𝕊 -> 𝕊
replace𝕊 𝕊
"." 𝕊
"__" 𝕊
n
      testsNames :: [Name]
testsNames = [𝕊] -> (𝕊 -> Name) -> [Name]
forall (t :: * -> *) a b. Functor t => t a -> (a -> b) -> t b
mapOn [𝕊]
testsNamesS ((𝕊 -> Name) -> [Name]) -> (𝕊 -> Name) -> [Name]
forall a b. (a -> b) -> a -> b
$ \ 𝕊
testsNameS → String -> Name
TH.mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ 𝕊 -> String
tohsChars 𝕊
testsNameS
      testNamesE :: [Q Exp]
testNamesE = [Name] -> (Name -> Q Exp) -> [Q Exp]
forall (t :: * -> *) a b. Functor t => t a -> (a -> b) -> t b
mapOn [Name]
testsNames ((Name -> Q Exp) -> [Q Exp]) -> (Name -> Q Exp) -> [Q Exp]
forall a b. (a -> b) -> a -> b
$ \ Name
testsName → Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE Name
testsName
      testsEQ ∷ TH.CodeQ [𝑇D Test]
      testsEQ :: CodeQ [𝑇D Test]
testsEQ = Q (TExp [𝑇D Test]) -> CodeQ [𝑇D Test]
forall (m :: * -> *) a. m (TExp a) -> Code m a
TH.Code (Q (TExp [𝑇D Test]) -> CodeQ [𝑇D Test])
-> Q (TExp [𝑇D Test]) -> CodeQ [𝑇D Test]
forall a b. (a -> b) -> a -> b
$ Exp -> TExp [𝑇D Test]
forall a. Exp -> TExp a
TH.TExp (Exp -> TExp [𝑇D Test]) -> Q Exp -> Q (TExp [𝑇D Test])
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
TH.listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Q Exp] -> [Q Exp]
forall a t. ToIter a t => t -> [a]
lazyList [Q Exp]
testNamesE
  in
  [|| 𝔹 -> FuzzParams -> 𝑇D Test -> IO ()
runTests 𝔹
noisy FuzzParams
γ (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ t -> a
forall a t. (Monoid a, ToIter a t) => t -> a
concat $$CodeQ [𝑇D Test]
testsEQ ||]

-- unqualifyName ∷ TH.Name → TH.Name
-- unqualifyName = id -- TH.mkName ∘ TH.nameBase
-- 
-- unqualifyExp ∷ TH.Exp → TH.Exp
-- unqualifyExp = \case
--   TH.VarE x → TH.VarE $ unqualifyName x
--   TH.ConE x → TH.ConE x
--   TH.LitE l → TH.LitE l
--   TH.AppE e₁ e₂ → TH.AppE (unqualifyExp e₁) $ unqualifyExp e₂
--   TH.AppTypeE e t → TH.AppTypeE e t
--   TH.InfixE eM₁ e₂ eM₃ → TH.InfixE eM₁ e₂ eM₃
--   TH.UInfixE eM₁ e₂ eM₃ → TH.UInfixE eM₁ e₂ eM₃
--   TH.ParensE e → TH.ParensE e
--   TH.LamE ps e → TH.LamE ps e
--   TH.LamCaseE ms → TH.LamCaseE ms
--   TH.LamCasesE cs → TH.LamCasesE cs
--   TH.TupE eMs → TH.TupE eMs
--   TH.UnboxedTupE eMs → TH.UnboxedTupE eMs
--   TH.UnboxedSumE e al ar → TH.UnboxedSumE e al ar
--   TH.CondE e₁ e₂ e₃ → TH.CondE e₁ e₂ e₃
--   e → e
-- 
-- 
-- play ∷ TH.ExpQ → TH.Q [TH.Dec]
-- play e = do
--   e' ← e
--   let s = string $ TH.pprint $ unqualifyExp e'
--   [d| doPlay = s |]