hspec-tidy-formatter 0.1.1.0 → 0.2.0.0

raw patch · 11 files changed

+626/−472 lines, 11 filesdep +effablePVP ok

version bump matches the API change (PVP)

Dependencies added: effable

API changes (from Hackage documentation)

Files

• LICENSE +21/−0
• README.lhs +94/−1
• README.md +94/−1
• assets/montage.png binary
• hspec-tidy-formatter.cabal +44/−13
• src/Test/Hspec/TidyFormatter/Internal.hs +212/−119
• src/Test/Hspec/TidyFormatter/Internal/Parts.hs +0/−285
• test/dev-example/Example/SubSpec.hs +0/−10
• test/dev-example/ExampleSpec.hs +36/−43
• test/dev-example/Sub/MultilineSpec.hs +115/−0
• test/dev-example/Sub/SubSpec.hs +10/−0

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2025 Carl Wernhoff++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -2,8 +2,9 @@  _A custom [`hspec`] formatter for terminal output._ -![GitHub License](https://img.shields.io/github/license/carlwr/hspec-tidy-formatter)+[![License](https://img.shields.io/badge/license-MIT-green)](./LICENSE) ![Hackage Version](https://img.shields.io/hackage/v/hspec-tidy-formatter)+![CI](https://img.shields.io/github/actions/workflow/status/carlwr/hspec-tidy-formatter/ci.yml?label=CI)  <br> @@ -18,8 +19,87 @@ </p> <br> +<!-- plaintext of montage.png: --- +$  # stack test --test-arguments=--format=tidy+$  # cabal test --test-options=--format=tidy+$  hspec --format=tidy+++Data.MyLogic.Core.Instances+  [✔] Functor+  [✔] Monoid+  is Applicative-lawful per+    [✔] Identity+    [✔] Homomorphism+    [✔] Interchange+    [✔] Composition++Data.MyLogic.Evaluator+  [✔] is consistent+  [‐] proves this test to fail+      # PENDING: seems to run forever+                 ->TODO trouble-shoot++Data.MyLogic.TestUtils.Generator+  [✔] Hedgehog generator+      passed 100 tests.+        n:   0       1% ▏···················+        n:   1- 4    5% █···················+        n:   5-19   16% ███▏················+        n:  20-79   54% ██████████▊·········+        n:  80-     24% ████▊···············++Finished in 0.0322 seconds+9 examples, 0 failures, 1 pending++$  █+++---++$  # stack test+$  # cabal test+$  hspec+++Data.MyLogic.Core.Instances+  Functor [✔]+  Monoid [✔]+  is Applicative-lawful per+    Identity [✔]+      passed 100 tests.+    Homomorphism [✔]+      passed 100 tests.+    Interchange [✔]+      passed 100 tests.+    Composition [✔]+      passed 100 tests.+Data.MyLogic.Evaluator+  is consistent [✔]+    passed 100 tests.+  proves this test to fail [‐]+    # PENDING: seems to run forever+    ->TODO trouble-shoot+Data.MyLogic.TestUtils.Generator+  Hedgehog generator [✔]+    passed 100 tests.+      n:   0       1% ▏···················+      n:   1- 4    5% █···················+      n:   5-19   16% ███▏················+      n:  20-79   54% ██████████▊·········+      n:  80-     24% ████▊···············++Finished in 0.0294 seconds+9 examples, 0 failures, 1 pending++$  █++-->++---+ The formatter should work with with any test runner backend. It may be particularly useful with [Hedgehog] tests through [`hspec-hedgehog`]: it omits the _"passed 100 tests."_ otherwise printed after each spec item, yet includes manually added test output (`Hedgehog.collect`, `Hedgehog.label` etc.).  @@ -82,6 +162,10 @@  * supports transient output/progress +* handles multiline spec tree strings gracefully+  * transient/progress output only prints the first line in case of multiline strings+  * the eventual non-transient output prints all lines, properly indented+ * honors most `hspec` options, including: `--times`, `--no-unicode`, `--no-color`, `--print-cpu-time`, `--print-slow-items=[=N]`  ### Printing of additional text from test runners@@ -157,6 +241,15 @@   echo } } -->+++## Written by a human++During the development of this package, AI models were used extensively for discussions and feedback. All code and documentation however is authored by me (Carl), a human developer: no text (code; natural language) within this package/repo is direct output from an AI model.++Since I am not a native English speaker, any natural language is likely to feature language quirks. AI models were not asked to identify or rectify such.++The above should not be understood as any opinion or even preference of mine - I both use and value development with higher degrees of AI autonomy than what was used in this project.   <!-- links -->

@@ -2,8 +2,9 @@  _A custom [`hspec`] formatter for terminal output._ -![GitHub License](https://img.shields.io/github/license/carlwr/hspec-tidy-formatter)+[![License](https://img.shields.io/badge/license-MIT-green)](./LICENSE) ![Hackage Version](https://img.shields.io/hackage/v/hspec-tidy-formatter)+![CI](https://img.shields.io/github/actions/workflow/status/carlwr/hspec-tidy-formatter/ci.yml?label=CI)  <br> @@ -18,8 +19,87 @@ </p> <br> +<!-- plaintext of montage.png: --- +$  # stack test --test-arguments=--format=tidy+$  # cabal test --test-options=--format=tidy+$  hspec --format=tidy+++Data.MyLogic.Core.Instances+  [✔] Functor+  [✔] Monoid+  is Applicative-lawful per+    [✔] Identity+    [✔] Homomorphism+    [✔] Interchange+    [✔] Composition++Data.MyLogic.Evaluator+  [✔] is consistent+  [‐] proves this test to fail+      # PENDING: seems to run forever+                 ->TODO trouble-shoot++Data.MyLogic.TestUtils.Generator+  [✔] Hedgehog generator+      passed 100 tests.+        n:   0       1% ▏···················+        n:   1- 4    5% █···················+        n:   5-19   16% ███▏················+        n:  20-79   54% ██████████▊·········+        n:  80-     24% ████▊···············++Finished in 0.0322 seconds+9 examples, 0 failures, 1 pending++$  █+++---++$  # stack test+$  # cabal test+$  hspec+++Data.MyLogic.Core.Instances+  Functor [✔]+  Monoid [✔]+  is Applicative-lawful per+    Identity [✔]+      passed 100 tests.+    Homomorphism [✔]+      passed 100 tests.+    Interchange [✔]+      passed 100 tests.+    Composition [✔]+      passed 100 tests.+Data.MyLogic.Evaluator+  is consistent [✔]+    passed 100 tests.+  proves this test to fail [‐]+    # PENDING: seems to run forever+    ->TODO trouble-shoot+Data.MyLogic.TestUtils.Generator+  Hedgehog generator [✔]+    passed 100 tests.+      n:   0       1% ▏···················+      n:   1- 4    5% █···················+      n:   5-19   16% ███▏················+      n:  20-79   54% ██████████▊·········+      n:  80-     24% ████▊···············++Finished in 0.0294 seconds+9 examples, 0 failures, 1 pending++$  █++-->++---+ The formatter should work with with any test runner backend. It may be particularly useful with [Hedgehog] tests through [`hspec-hedgehog`]: it omits the _"passed 100 tests."_ otherwise printed after each spec item, yet includes manually added test output (`Hedgehog.collect`, `Hedgehog.label` etc.).  @@ -82,6 +162,10 @@  * supports transient output/progress +* handles multiline spec tree strings gracefully+  * transient/progress output only prints the first line in case of multiline strings+  * the eventual non-transient output prints all lines, properly indented+ * honors most `hspec` options, including: `--times`, `--no-unicode`, `--no-color`, `--print-cpu-time`, `--print-slow-items=[=N]`  ### Printing of additional text from test runners@@ -157,6 +241,15 @@   echo } } -->+++## Written by a human++During the development of this package, AI models were used extensively for discussions and feedback. All code and documentation however is authored by me (Carl), a human developer: no text (code; natural language) within this package/repo is direct output from an AI model.++Since I am not a native English speaker, any natural language is likely to feature language quirks. AI models were not asked to identify or rectify such.++The above should not be understood as any opinion or even preference of mine - I both use and value development with higher degrees of AI autonomy than what was used in this project.   <!-- links -->

binary file changed (163354 → 162796 bytes)

@@ -1,7 +1,7 @@ cabal-version: 3.0  name:           hspec-tidy-formatter-version:        0.1.1.0+version:        0.2.0.0 stability:      experimental category:       Testing synopsis:       A custom hspec formatter for easy-to-read terminal output.@@ -11,10 +11,14 @@ maintainer:     Carl copyright:      none license:        MIT+license-file:   LICENSE build-type:     Simple tested-with:+    GHC == 9.14.1     GHC == 9.12.2     GHC == 9.10.2+    GHC == 9.8.4+    GHC == 9.6.7     GHC == 9.4.8 extra-doc-files:     README.md@@ -32,12 +36,24 @@   default: False   manual: True -flag suppress-module-prefixes+flag isDev+  description: development conveniences   default: False   manual: True ++-- dependencies+-- ------------++-- library:+ common dep_base       { build-depends: base             >= 4.17.2.1 && < 5 }+common dep_effable    { build-depends: effable          >= 0.3.0.0  && <0.4} common dep_hspec-api  { build-depends: hspec-api        >= 2.11.8   && < 3 }+++-- test components:+ common dep_hspec      { build-depends: hspec            >= 2.11.8   && < 3 } common dep_hspec-core { build-depends: hspec-core       >= 2.11.8   && < 3 } common dep_hspec-hh   { build-depends: hspec-hedgehog   >= 0.3.0.0  && < 1 }@@ -47,9 +63,11 @@   build-tool-depends:       hspec-discover:hspec-discover >= 2.11.8 && < 3 ++-- components+-- ----------+ common defaults-  autogen-modules: Paths_hspec_tidy_formatter-  other-modules:   Paths_hspec_tidy_formatter   ghc-options:       -Wall       -Wcompat@@ -64,16 +82,16 @@       -Winvalid-haddock       -Wredundant-bang-patterns       -Wredundant-strictness-flags+  if impl(ghc >= 9.8)+    ghc-options:+      -Winconsistent-flags+  if flag(isDev)+    ghc-options:       -freverse-errors       -fshow-hole-matches-of-hole-fits       -fhide-source-paths       -fwrite-ide-info-  if impl(ghc >= 9.8) { ghc-options:-      -Winconsistent-flags-      }-  if flag(suppress-module-prefixes) { ghc-options:       -dsuppress-module-prefixes-      }   default-language: GHC2021   default-extensions:       PartialTypeSignatures@@ -81,17 +99,21 @@       ExtendedDefaultRules       LambdaCase       RecordWildCards+      ViewPatterns+      MultiWayIf  library   import:     , defaults     , dep_base+    , dep_effable     , dep_hspec-api   hs-source-dirs: src+  autogen-modules: Paths_hspec_tidy_formatter+  other-modules:   Paths_hspec_tidy_formatter   exposed-modules:       Test.Hspec.TidyFormatter       Test.Hspec.TidyFormatter.Internal-      Test.Hspec.TidyFormatter.Internal.Parts  test-suite readme   import:@@ -102,7 +124,7 @@   main-is:         README.lhs   ghc-options:     -pgmL markdown-unlit   build-tool-depends:-    , markdown-unlit:markdown-unlit == 0.6.0+    , markdown-unlit:markdown-unlit >= 0.5 && < 0.7   build-depends:     , hspec-tidy-formatter @@ -110,7 +132,9 @@   import:     , defaults     , dep_base-  if !flag(doctest)+  -- no solution for 9.14 due to doctest-parallell+  -- (forcing with --alow-newer causes compilation error)+  if !flag(doctest) || impl(ghc >= 9.14)       buildable: False   hs-source-dirs:  test/doctests   type:            exitcode-stdio-1.0@@ -130,6 +154,9 @@     , dep_hspec-hh     , dep_hh     , tooldep_hspec-discover+  -- no solution for 9.14 (involves hedgehog)+  if impl(ghc >= 9.14)+      buildable: False   hs-source-dirs:  readme-example   type:            exitcode-stdio-1.0   main-is:         Spec.hs@@ -156,6 +183,9 @@     , dep_hspec-hh     , dep_hh     , tooldep_hspec-discover+  -- uses MultilineStrings (ghc-9.12+):+  if !flag(isDev) || impl(ghc < 9.12.0.0)+      buildable: False   hs-source-dirs:  test/dev-example   type:            exitcode-stdio-1.0   main-is:         Spec.hs@@ -166,7 +196,8 @@       -main-is Spec   other-modules:       ExampleSpec-      Example.SubSpec+      Sub.SubSpec+      Sub.MultilineSpec       SpecHook   build-depends:     , hspec-tidy-formatter

@@ -6,16 +6,26 @@ {-# LANGUAGE OverloadedStrings #-}  module Test.Hspec.TidyFormatter.Internal-( tidy+(+  -- * Formatter+  tidy++  -- * (to enable doctests:)+, mapLast+, append+ ) where -import Test.Hspec.TidyFormatter.Internal.Parts+import Data.Effable  import Test.Hspec.Api.Formatters.V3 qualified as Api import Test.Hspec.Api.Formatters.V3 (Formatter, FormatM)-import Data.Monoid (Endo (..))-import Control.Monad (when)-import Data.Bifunctor+import Control.Monad (when, join)+import Data.String (fromString, IsString)+import Data.List (genericReplicate)+import Data.Functor ((<&>))+import Data.Foldable (traverse_)+import Control.Applicative (Alternative(empty))   --@@ -24,25 +34,26 @@  tidy :: Formatter tidy = Api.Formatter {-  formatterStarted      = pure ()+  formatterStarted      = nothing , formatterDone         = Api.formatterDone Api.checks -- footer, failures-, formatterGroupDone    = \(_ ,_  )     -> nothing-, formatterGroupStarted = \(gs,grp)     -> write     gs (groupStarted grp)-, formatterItemStarted  = \(gs,req)     -> transient gs (itemStarted req)-, formatterItemDone     = \(gs,req) itm -> write     gs (itemDone req itm)-, formatterProgress     = \(gs,_  ) prg -> transient gs (progress prg)-}-  where nothing = pure ()+, formatterGroupDone    = const nothing+, formatterGroupStarted = \(nst->n,grp)     -> write     n (groupStarted n grp)+, formatterItemStarted  = \(nst->n,req)     -> transient n (itemStarted req)+, formatterItemDone     = \(nst->n,req) itm -> write     n (itemDone req itm)+, formatterProgress     = \(nst->n,_  ) prg -> transient n (progress prg)+} where +  nothing = pure ()+  nst     = nesting + -- -- hspec API type aliases -- -type Group       = String   -- ([Group],Req) == Api.Path-type Req         = String-type ItemInfo    = String-type Indentation = [Group]  -- [Group] when used to determine indentation+type Group         = String   -- ([Group],Req) == Api.Path+type Req           = String+type PendingString = String   --@@ -55,81 +66,84 @@  Neither ever contains \n-s. -Note: the [Chunks] of 'Lines' is embedded in an outer t'Parts' to allow monadic FormatM conditions to influence whether the newlines implied by [Chunks] are printed or not, i.e. to influence whether a 'Lines' value (including its implied newlines) are printed or not.--> Chunks ~ Silenceable FormatM String-> Lines  ~ Silenceable FormatM [Chunks]-+Note: the [Chunks] of 'Lines' is embedded as well to allow monadic FormatM conditions to influence whether the newlines implied by [Chunks] are printed or not, i.e. to influence whether a 'Lines' value (including its implied newlines) are printed or not. -} -type WithFormat = Endo (FormatM ())--type Chunks' ann = Parts ann String-type Lines'  ann = Parts ann [Chunks]--type Chunks = Chunks' WithFormat-type Lines  = Lines'  WithFormat+type Chunks = Effable FormatM String+type Lines  = Effable FormatM [Chunks] -chunk :: String -> Chunks-chunk = string . filter (/='\n')+embedLines :: [Chunks] -> Lines+embedLines = embed -line :: Chunks -> Lines-line chunks = value [chunks]+lines' :: String -> [Chunks]+lines' = map string . lines +mapEachLine :: (Chunks->Chunks) -> Lines -> Lines+mapEachLine =+    fmap @(Effable FormatM)+  . fmap @[]  -- -- Output -- --- `write` and `transient` find and leave the terminal state as: cursor at column 0 of next line to be written- type TransientString = String -write :: Indentation -> Lines -> FormatM ()-write gs = run (run Api.write . vsep . unlines')-  where-    unlines' = foldMap mkLine-    mkLine c = indentation gs <> c <> "\n"--    vsep|isLevel0  = ("\n" <>)-        |otherwise = id--    isLevel0 = null gs+write :: Nesting -> Lines -> FormatM ()+write nst =+  run $ traverse_ $ \l ->+    run Api.write (specIndentation nst <> l <> "\n") -transient :: Indentation -> TransientString -> FormatM ()-transient gs =-  writeTransient-  . (indentationStr gs ++)-  . filter (/='\n')-  where-    writeTransient = whenReportProgress . Api.writeTransient+transient :: Nesting -> TransientString -> FormatM ()+transient nst str =+  whenReportProgress $+  Api.writeTransient (specIndentation nst <> str)   -- -- Handlers -- -groupStarted :: Group -> Lines-groupStarted group = line (chunk group)+groupStarted :: Nesting -> Group -> Lines+groupStarted nst group =+  embedLines $+  if |nst > 0   ->              group'+     |otherwise -> blankLine <> group'+  where+    blankLine = [""]+    group'    = lines' group  itemStarted :: Req -> TransientString-itemStarted req = "[ ] " ++ req+itemStarted req = "[ ] " ++ (firstLine req)+  where+    firstLine = concat . take 1 . lines  itemDone :: Req -> Api.Item -> Lines itemDone req itm =-     line (box <> chunk req <> duration <> ifOneline info)-  <> pending-  <> ifMultiline info+     embedLines (laminate' box req `append` (duration<>infoStr))+  <> (boxIndent pendingBlock)+  <> (boxIndent infoBlock)   where-    duration = mkDuration (Api.itemDuration itm)-    info     = mkInfo     (Api.itemInfo     itm)+    box                 = "["<>m<>"] "+    boxIndentation      = "    "+    duration            = mkDuration      $ Api.itemDuration itm+    (infoStr,infoBlock) = mkInfo . lines' $ Api.itemInfo     itm -    (box,pending) =+    m =+      let pick = ifThenElse Api.outputUnicode in       case Api.itemResult itm of-        Api.Success     -> (mkBox '✔' 'v' succColor,empty   )-        Api.Failure _ _ -> (mkBox '✘' 'x' failColor,empty   )-        Api.Pending _ s -> (mkBox '‐' '-' pendColor,mkPending s)+        Api.Success     -> succColor (pick "✔" "v")+        Api.Failure _ _ -> failColor (pick "✘" "x")+        Api.Pending _ _ -> pendColor (pick "‐" "-") +    pendingBlock =+      case Api.itemResult itm of+        Api.Pending _ s -> mkPending s+        _               -> empty++    laminate' = laminate boxIndentation+    boxIndent = mapEachLine (fromString (boxIndentation)<>)+ progress :: Api.Progress -> TransientString progress (now,total) = "[" ++ str ++ "]"   where@@ -142,97 +156,150 @@ -- Handler helpers -- -data Info' ann = Info-  { ifOneline   :: Chunks' ann-  , ifMultiline :: Lines'  ann-  }--instance Functor Info' where-  fmap f (Info one multi) = Info (first f one) (first f multi)+type InfoLines = [Chunks] -type Info = Info' WithFormat+mkInfo :: InfoLines -> (Chunks,Lines)+mkInfo i = joinTuple (resolve' <$> embedAction verbosityM)+  where+    resolve' v = resolveInfo (i,v) -mkInfo :: ItemInfo -> Info-mkInfo str =-  unlessExpert . infoColor <$>-  case lines str of-    []  -> z-    [l] -> z{ ifOneline   =       (one   $ l ) `onlyIf` isVerbose }-    ls  -> z{ ifMultiline = value (multi<$>ls) }+resolveInfo ::      (InfoLines,Verbosity)  ->  (Chunks    ,Lines     )+resolveInfo = \case ([]       ,_        )  ->  (e         ,e'        )+                    ([_]      ,Quiet    )  ->  (e         ,e'        )+                    ([l]      ,Verbose  )  ->  (asStr l   ,e'        )+                    (ls       ,_        )  ->  (e         ,asBlock ls)   where-    z       = Info empty empty-    one   s = chunk $ " (" <> s <> ")"-    multi s = chunk $ "  " <> s+    asStr   = unlessExpert .             infoColor . fmtStr+    asBlock = unlessExpert . mapEachLine infoColor . embedLines -mkPending :: Maybe String -> Lines+    fmtStr s = " (" <> s <> ")"++    e  = empty+    e' = embed []++mkPending :: Maybe PendingString -> Lines mkPending mb =-  value $-  extraInd . mapAnn pendColor . chunk <$>-  case lines <$> mb of-    Nothing -> [ "# PENDING"   ]-    Just ls -> ( "# PENDING: "-               , "           " ) `laminate` ls-  where-    laminate (x,y) = zipWith (++) (x : repeat y)-    extraInd c     = "    " <> c+  mapEachLine pendColor . embedLines $+  case mb of+    Nothing  -> ["# PENDING"]+    Just str ->+      laminate+        "           "+        "# PENDING: "+        str  mkDuration :: Api.Seconds -> Chunks mkDuration (Api.Seconds secs) =-  maybeEmpty (chunk <$> mbStr)-    `with`   infoColor-    `onlyIf` Api.printTimes-  where-    mbStr = case floor (secs * 1000) of-      0  -> Nothing-      ms -> Just $ ("  (" ++ show ms ++ "ms)")+  when' Api.printTimes $+  case floor (secs * 1000) of+    0  -> ""+    ms -> infoColor . string $ "  (" ++ show ms ++ "ms)" -mkBox :: Char -> Char -> Color -> Chunks-mkBox unicode ascii color = "[" <> marker <> "] "+{- | Join two columns horizontally.++The first column has @label@ as its first line, and the given padding string as all following lines.++The second column has lines formed by splitting the 'String' argument on '\n's using 'lines'.++=== Illustration++The value 'actual' below, if rendered with a sensible invocation of 'run', would print the same lines as if the lines of 'expected' were printed:++@+actual :: [Chunks]+actual =+  laminate+    "       "+    "label: "+    "BODY-\nCONTENTS\n."++expected :: [String]+expected =+  unlines+    [ "label: BODY-"+    , "       CONTENTS"+    , "       ."+    ]+@+-}+laminate :: String -> Chunks -> String -> [Chunks]+laminate pad label body =+  case lines' body of+    []     ->    [label]+    [l]    ->    [label <> l]+    (l:ls) ->    [label <> l]+              ++ [pad'  <> l' | l'<-ls]   where-    marker =-      ifThenElse Api.outputUnicode-        (chunk [unicode] `with` color)-        (chunk [ascii  ] `with` color)+    pad' = string pad   -- -- Api shorthands -- -type Color = WithFormat -> WithFormat+type ApplyWrap = ∀ b. Effable FormatM b -> Effable FormatM b ++--- Color ---++type Color = ApplyWrap+ infoColor :: Color pendColor :: Color succColor :: Color failColor :: Color -infoColor = (<> Endo Api.withInfoColor   )-pendColor = (<> Endo Api.withPendingColor)-succColor = (<> Endo Api.withSuccessColor)-failColor = (<> Endo Api.withFailColor   )+infoColor = wrapInside Api.withInfoColor+pendColor = wrapInside Api.withPendingColor+succColor = wrapInside Api.withSuccessColor+failColor = wrapInside Api.withFailColor -isVerbose :: FormatM Bool-isVerbose = Api.printTimes++--- Verbosity ---++data Verbosity =+    Quiet+  | Verbose+  deriving (Eq, Show, Enum, Bounded)++type VerbosityM = FormatM Verbosity++verbosityM :: VerbosityM+verbosityM = Api.printTimes <&> \case+  False -> Quiet+  True  -> Verbose   -- borrow '--times' as verbosity switch since that gives non-verbose by default, which is what we want (using '--expert' would give _verbose_ by default) -unlessExpert :: WithFormat -> WithFormat-unlessExpert = (<> Endo Api.unlessExpert) +--- Expert ---++unlessExpert :: ApplyWrap+unlessExpert = wrapInside Api.unlessExpert+++--- Progress ---+ whenReportProgress :: FormatM () -> FormatM () whenReportProgress = whenM (Api.getConfigValue Api.formatConfigReportProgress)   ----- Misc+-- Spec indentation -- -indentationStr :: Indentation -> String-indentationStr gs = replicate (length gs * 2) ' '+-- These functions, with signatures that include the 'Nesting' type, are used only for the indentation of /a full spec tree item as a whole/ - indentation of its constituents use other, local, indentation logic. -indentation :: Indentation -> Chunks-indentation gs = chunk (indentationStr gs)+-- | The nesting depth of a spec tree item.+newtype Nesting = Nesting Int+  deriving (Show, Eq, Ord, Num, Real, Enum, Integral) +nesting :: [Group] -> Nesting+nesting gs = Nesting (2 * length gs) +specIndentation :: IsString m => Nesting -> m+specIndentation n = fromString (genericReplicate n ' ')++ -- -- General helpers --@@ -241,6 +308,32 @@ whenM bM action = do   b <- bM   when b action++joinTuple :: Monad m => m (m a,m b) -> (m a,m b)+joinTuple x =+  ( join $ fst <$> x+  , join $ snd <$> x+  )++{-| Map the last element.++>>> mapLast (+1) [1,2,3]+[1,2,4]+-}+mapLast :: (a -> a) -> [a] -> [a]+mapLast f = go where+  go []     = []+  go [x]    = f x : []+  go (x:xs) = x   : go xs++{-| Append the last item monoidally with the given value.++>>> [[1],[2,3]] `append` [4,5]+[[1],[2,3,4,5]]+-}+append :: Semigroup a => [a] -> a -> [a]+append xs x = mapLast (<>x) xs+infixl 3 `append`   --

@@ -1,285 +0,0 @@-{-|-Description : Ordered annotated sequences useful for conditional emission-License     : MIT--/The mise-en-place utility set needed for a readable, declarative implementation of "Test.Hspec.TidyFormatter" -- in the dress of a small, general annotated-sequence module./--The t'Parts' type expresses /ordered annotated sequences/. It is expected to be useful primarily in its 'Silenceable' specialization.--The 'Silenceable' type, together with utility functions and instances, can be useful as an abstraction over sequences of /pairs of pure values and effect-modifying functions/.---}---{-# LANGUAGE OverloadedStrings #-}--module Test.Hspec.TidyFormatter.Internal.Parts-where--import Control.Monad (when)-import Data.String (IsString (..))-import Data.Monoid (Endo (..))-import Data.Bifunctor (Bifunctor (..))---{- $setup->>> import Data.Monoid (Sum)--}---- * Type--{- | An ordered sequence of /elements/ where each /element/ consists of an /annotation/ and a /label/.--This type is a thin newtype wrapper over [(a,b)], and usefully different from that bare type in nuance only: in t'Parts', the first tuple component (the /annotation/) is assumed to be meaningful only together with the second tuple component (the /label/). Therefore, t'Parts' have no utility functions or instances that allow combining over only the annotations of a t'Parts' - hence the lack of (Bi)Foldable and (Bi)Traversable. t'Parts' instead offers up to (Bi)Functor, Semigroup and Monoid; all of which retains the structural pairing of annotations and labels. For combining over the @(ann,b)@ pairs (elements) of a t'Parts', 'foldParts' and 'interpret' are provided instead.--Further, the justification of a 'Parts' type could be claimed to rely solely on its specialization to the 'Silenceable' type.--}-newtype Parts ann b = Parts [(ann,b)]-  deriving (Functor, Read, Show, Eq, Ord)--instance Bifunctor Parts where-  bimap :: (ann -> ann') -> (b -> b') -> Parts ann b -> Parts ann' b'-  bimap f g = mapAnn f . fmap g--instance Semigroup (Parts ann b) where-  Parts xs <> Parts ys = Parts (xs ++ ys)--instance Monoid (Parts ann b) where-  mempty = Parts []--instance (Monoid ann, IsString b) => IsString (Parts ann b) where-  fromString = string----- * Create--{- $create--Examples:-->>> singleton [] "a" :: Parts [Int] String-Parts [([],"a")]-->>> string "a" :: Parts [Int] String-Parts [([],"a")]-->>> p = singleton [] "a" :: Parts [Int] String->>> :seti -XOverloadedStrings->>> p <> "b"-Parts [([],"a"),([],"b")]--}--singleton :: ann -> b -> Parts ann b-singleton ann x = Parts [(ann,x)]---- | Embed a value annotated with 'mempty'.-value :: Monoid ann => b -> Parts ann b-value x = Parts [(mempty,x)]---- | Embed a string literal annotated with 'mempty'.-string :: (Monoid ann, IsString b) => String -> Parts ann b-string s = Parts [(mempty,fromString s)]--empty :: Parts ann b-empty = Parts []----- * Modify--maybeEmpty :: Maybe (Parts ann b) -> Parts ann b-maybeEmpty = \case-  Just p -> p-  _      -> empty--{- | Map annotations.--@-mapAnn == 'first'-@--}-mapAnn :: (ann->ann') -> Parts ann b -> Parts ann' b-mapAnn f (Parts xs) = Parts (f' <$> xs)-  where-    f' (ann,b) = (f ann,b)--{- | Flipped 'mapAnn'.--Examples:-->>> p = string "ab" :: Parts [Int] String->>> p-Parts [([],"ab")]-->>> p `with` (++[1])-Parts [([1],"ab")]--The high precedence of the operator variant means it binds tighter than e.g. '<>', which is inteded to facilitate constructs such as:-->>> :seti -XOverloadedStrings->>> :{-let parts :: Parts (Sum Int) String-    parts =    "a" `with` (+1)-            <> "b" `with` (+2)-in  parts-:}-Parts [(Sum {getSum = 1},"a"),(Sum {getSum = 2},"b")]--(Note: above, the 'IsString' instance promotes the string literals to 'Parts', initializing the annotation to 'mempty' == 'Sum 0'.)--}-with :: Parts ann b -> (ann -> ann') -> Parts ann' b-with = flip mapAnn-infixl 7 `with`----- * Fold--{- | Right-fold a t'Parts'.--@-v'Parts' . 'foldParts' (:) [] == 'id'-@--}-foldParts ::-     ((ann,b) -> acc -> acc) -- ^ combine-  -> acc                     -- ^ initial aggregate-  -> Parts ann b-  -> acc-foldParts f z (Parts xs) = foldr f z xs----- * Interpret--{- | Interpret an annotated sequence by applying a function to each element and combine the results.--@-'interpret' (,)                == 'foldParts'-'Parts' . 'interpret' (,) (:) [] == 'id'-@--Examples:-->>> parts = singleton 'a' 1 <> singleton 'b' 2->>> interpret (,) (:) [] parts-[('a',1),('b',2)]--> >>> :seti -XOverloadedStrings-> >>> import Data.Monoid (Endo(..))-> >>> interp  = interpret (\ann -> appEndo ann . putStr) (>>) (pure ())-> >>> bold    = putStr "\ESC[1m"-> >>> stop    = putStr "\ESC[0m"-> >>> asBold  = Endo $ \x -> bold >> x >> stop-> >>> interp $ "plain, " <> "bold" `with` (<> asBold)-> <prints "plain, bold" with "bold" bold-formatted>--}-interpret :: ∀ ann b c acc.-     (ann->b->c)   -- ^ interpreting one element-  -> (c->acc->acc) -- ^ adding an interpretation to the aggregate-  -> acc           -- ^ initial aggregate-  -> Parts ann b   -- ^ the t'Parts' to interpret-  -> acc           -- ^ returned interpretation-interpret interp f = foldParts f'-  where-    f' :: (ann,b) -> acc -> acc-    f' (ann,b) acc = interp ann b `f` acc----- * t'Parts' with 'Silenceable' elements--{- $silenceable--The 'Silenceable' specialization of t'Parts' have annotations that /describe how to transform the effect of emitting the label it is paired with/. This allows embedding per-element effectfully-predicated include/suppress decisions in the annotations. The decisions are effectuated at interpretation time.--}--type Silenceable m b = Parts (Endo (m ())) b----- ** Conditionals--{- $silenceable-conditionals--These transformations are semantically meaningful, and in a way that aligns with the function names, if later interpreted with 'run', e.g. @'run' 'putStr'@.--Labels remain pure, inspectable and 'fmap'-able; instances remain lawful.--Note: upon interpretation,--- effectful predicates will run /for each element/-- conditionals nested on the same element have short-circuiting behaviour--}---{- | /Conditional inclusion/.--Transform each annotation so that, when interpreted as a wrapper around the element’s action, the element’s effects are only run if the effectful predicate evaluates to True.--}-when' :: Monad m =>-     m Bool-  -> Silenceable m b -- ^ to include if True (else nothing)-  -> Silenceable m b-when' bM = mapAnn (Endo f <>)-  where-    f action = do-      b <- bM-      when b action---- | /Conditional inclusion/ based on a pure predicate.-whenA :: Applicative f =>-     Bool-  -> Silenceable f b -- ^ to include if True (else nothing)-  -> Silenceable f b-whenA b = mapAnn (Endo (when b) <>)---{- | Flipped 'when''.--Example:-->>> import Data.Monoid (Endo(..))->>> import Data.Char (toUpper)->>> upper  = fmap toUpper->>> interp = interpret (\ann -> appEndo ann . putStr) (>>) (pure ())->>> yes    = string "yes" `onlyIf` (pure True )->>> no     = string "no"  `onlyIf` (pure False)->>> ok     = upper <$> (yes <> no <> string ".")->>> interp ok-YES.--}-onlyIf :: Monad m =>-     Silenceable m b-  -> m Bool-  -> Silenceable m b-onlyIf = flip when'-infixl 7 `onlyIf`---{- | /Binary choice/.--At interpretation, the monadic condition will be run twice (for every element).--The expectation that exactly one of the arguments will have all its elements included and the other have all its elements suppressed will hold if the same Bool is returned every time the effectful condition is run.--}--ifThenElse :: Monad m =>-     m Bool-  -> Silenceable m b  -- ^ to include if True-  -> Silenceable m b  -- ^ to include if False-  -> Silenceable m b-ifThenElse pM true false =-     (when'        pM  true )-  <> (when' (not<$>pM) false)----- ** Interpret--{- | Interpret by emitting each label with the given function, then applying the annotation, and combining with '>>'.--Note: this function is basically 'interpret', but with some type specialization, some defaults and an adjusted API shape.--}-run :: Monad m =>-     (b -> m ())      -- ^ emitting a label-  -> Silenceable m b  -- ^ the t'Silenceable' to interpret-  -> m ()             -- ^ returned interpretation-run emit = interpret f (>>) z-  where-    f ann b = appEndo ann (emit b)-    z       = pure ()

@@ -1,10 +0,0 @@-module Example.SubSpec-( spec-) where--import Test.Hspec--spec :: Spec-spec = do-  it "SubEx non-hh 0" $ True-  it "SubEx non-hh 1" $ True

@@ -1,29 +1,25 @@ {-# LANGUAGE OverloadedStrings #-}  module ExampleSpec-( spec-) where-+where  import Test.Hspec import Test.Hspec.Hedgehog-import Control.Concurrent-import Hedgehog.Gen qualified as Gen+import Hedgehog.Gen   qualified as Gen import Hedgehog.Range qualified as Range-import Control.Monad.IO.Class (liftIO)-import Control.Monad (when)+import Control.Concurrent+import Control.Monad   spec :: Spec spec = do-  when True simple-  when True full+    when True simple+    when True full  simple :: Spec simple = do   it_slow "" 200   it_slow "" 300-  it_slow "" 600   describe "sub1" $ do     it_slow "1_a" 200     it_slow "1_b" 300@@ -31,21 +27,20 @@  full :: Spec full = describe "FULL" $ do-  it_hh_slow  ""   15-  it_slow     "1" 100-  it_slow     "2" 200-  it_slow     "3" 300-  it_hh_cubic ""+  it_hh_prog "" NoStats+  it_slow    "1" 100+  it_hh_prog "" NoStats+  it_ok longString   describe "desc0" $ do     it_hh      ""     it_pend    "pending"-    it_hh_slow "" 15+    it_hh_prog "" NoStats     describe "sub" $ do       it_pendW "sub-pending" "pending msg"       it_pendW "sub-pending" "pending multi-\nline-\nmsg"       it_ok    "sub"-  describe "hedgehog stats" $ do-    it_hh_stats "stats"+  describe "hedgehog prog stats" $ do+    it_hh_prog "" WithStats     it_ok       "stats-after"   when False $     _t_hh_fails "fails"@@ -54,44 +49,42 @@ it_ok       :: String -> Spec it_pend     :: String -> Spec it_pendW    :: String -> String -> Spec-it_slow     :: String -> Int -> Spec+it_slow     :: String -> Float -> Spec it_hh       :: String -> Spec-it_hh_slow  :: String -> Int -> Spec-it_hh_cubic :: String -> Spec _t_hh_fails :: String -> Spec-it_hh_stats :: String -> Spec+it_hh_prog  :: String -> IsStats -> Spec  it_ok       desc   = it desc $ True it_pend     desc   = it desc $ pending it_pendW    desc s = it desc $ pendingWith s it_slow     desc n = it ("DELAY "   <>desc) $ example  $ delay n it_hh       desc   = it ("HH "      <>desc) $ hedgehog $ success-_t_hh_fails desc   = it ("HH FAIL " <>desc) $ hedgehog $ prop-it_hh_slow  desc n = it ("HH DELAY "<>desc) $ hedgehog $ evalIO (delay n)-it_hh_cubic desc   = it ("HH CUBIC "<>desc) $ hedgehog $ prop_cubic-it_hh_stats desc   = it ("HH STATS "<>desc) $ hedgehog $ prop_stats+_t_hh_fails desc   = it ("HH FAIL " <>desc) $ hedgehog $ prop_fail -prop_stats :: PropertyT IO ()-prop_stats = do-    x <- forAll (Gen.int $ Range.constant 0 100)-    classify "  n:   0     " (x== 0         )-    classify "  n:   1- 4  " (x>= 1 && x<= 4)-    classify "  n:   5-19  " (x>= 5 && x<=19)-    evalIO (delay 10)+data IsStats = WithStats | NoStats deriving (Eq, Show) -prop_cubic :: PropertyT IO ()-prop_cubic = do-    (x'::Int) <- forAll $ Gen.integral (Range.linear 0 8)-    let x = fromIntegral x'-    liftIO $ threadDelay (round (x ** 3))+it_hh_prog desc isStats = it desc' $ hedgehog $ prop+  where+    desc' = ("HH PROG "<>show isStats<>" "<>desc)+    prop = do+      x <- forAll (Gen.int $ Range.constant 0 20)+      evalIO (delay $ fromIntegral x)+      when (isStats==WithStats) $ do+        classify "  n:   0     " (x== 0         )+        classify "  n:   1- 4  " (x>= 1 && x<= 4)+        classify "  n:   5-19  " (x>= 5 && x<=19) -prop :: PropertyT IO ()-prop = do+longString :: String+longString =+  "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua."++prop_fail :: PropertyT IO ()+prop_fail = do   i <- forAll $ Gen.int (Range.linear 0 100)   assert (i <= 10) -delay :: Int -> IO ()-delay n = threadDelay $ n * delayScale * 10+delay :: Float -> IO ()+delay n = threadDelay . round $ n * delayScale * 10 -delayScale :: Int+delayScale :: Float delayScale = 15

@@ -0,0 +1,115 @@+{-# LANGUAGE MultilineStrings #-}++module Sub.MultilineSpec+( spec+) where++import ExampleSpec hiding (spec)+import Test.Hspec+import Data.Foldable++stringVariants :: [String]+stringVariants =+  [ "word"+  , "\n"+  , "two\nlines"+  , "\nleading newline"+  , "some\n    hanging\n    indentation"+  ]++block :: String -> (String -> Spec) -> Spec+block desc f = do+  describe desc $ do+    it_ok "//-------------------"+    traverse_ f stringVariants+    it_ok "---------------------//\n\n"+++spec :: Spec+spec = do+  block "STD"         $ it_ok+  block "SLOW"        $ (\s -> it_slow s 200)+  block "AS-DESCRIBE" $ (\s -> describe s (it_ok "item"))+  block "PENDING"     $ (it "pending" . pendingWith)++  it_ok "\n=====================\n\n"++  it_ok+    """let's try the new+        \"\"\"-multiline+        strings+        \n+    """+  it_ok "...Python-style 🐍\n\n"++  describe "...while we are at it:\n\n\n" $ do+      it_ok+        """+        ---------------------------------------++        📜 SUGGESTIONS TO THE HASKELL COMMITTEE++        ---------------------------------------++        \n\n+        """++      it_ok+        """+        can we have the walrus?:++        ```+        {-# LANGUAGE ImpureBindings #-}             -- new+        {-# LANGUAGE NoReferentialTransparency #-}  -- new++        (:=) :: a -> b -> b+        lhs := rhs  =  unsafeTBD+        infixr 0 :=+        ```++        ref.: u/py1337coder (2010-03-17). 'can this Haskel thing I just tried+              plz remove these annoying *Conflicting definitions* errors I+              keep getting?!', r/haskell.++        \n\n+        """++      it_ok+        """+        change `main :: IO ()` -> `__main__ :: IO ()`++        ref.: Backus, J. & van Rossum, G. (1960-11-01). 'Syntax requiring+              redundant punctuation ceremony made possible by recent trends+              in computer memory sizes', Communications of the ALGOL Committee.++        \n\n+        """++      it_ok+        """+        Proposal: The Global Evaluation Lock (GEL)++        We propose a single global mutex that locks down the entire RTS+        whenever a thunk is evaluated. This simplifies concurrency.++        It would also make stack traces deterministic. Programmers spend a+        non-trivial amount of their time reading runtime exception stack+        traces, studies from other languages have shown.++        ref.: (2007-05-14). 'The future of programming - Why in this year of+              2025 Ruby-On-Rails is the dominating framework and why execution+              efficiency proved to be irrelevant', Viktor Brat (RubyConf 2007).+              https://www.youtube.com/watch?v=8pTEmbeENF4.++        \n\n+        """++      it_ok+        """+        add list comprehensions++        ref.: u/py1337coder (2010-03-19). 'srsly why not just copy python+              on these basic things [0 points, 1 comment]', r/haskell.++        \n\n+        """

@@ -0,0 +1,10 @@+module Sub.SubSpec+( spec+) where++import Test.Hspec++spec :: Spec+spec = do+  it "SubEx non-hh 0" $ True+  it "SubEx non-hh 1" $ True