{-|
Description : (Internal module)
License     : MIT
-}

{-# LANGUAGE OverloadedStrings #-}

module Test.Hspec.TidyFormatter.Internal
(
  -- * Formatter
  tidy

  -- * (to enable doctests:)
, mapLast
, append

) where

import Data.Effable

import Test.Hspec.Api.Formatters.V3 qualified as Api
import Test.Hspec.Api.Formatters.V3 (Formatter, FormatM)
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))


--
-- Exported formatter
--

tidy :: Formatter
tidy :: Formatter
tidy = Api.Formatter {
  formatterStarted :: FormatM ()
formatterStarted      = FormatM ()
nothing
, formatterDone :: FormatM ()
formatterDone         = Formatter -> FormatM ()
Api.formatterDone Formatter
Api.checks -- footer, failures
, formatterGroupDone :: Path -> FormatM ()
formatterGroupDone    = FormatM () -> Path -> FormatM ()
forall a b. a -> b -> a
const FormatM ()
nothing
, formatterGroupStarted :: Path -> FormatM ()
formatterGroupStarted = \([String] -> Nesting
nst->Nesting
n,String
grp)     -> Nesting -> Lines -> FormatM ()
write     Nesting
n (Nesting -> String -> Lines
groupStarted Nesting
n String
grp)
, formatterItemStarted :: Path -> FormatM ()
formatterItemStarted  = \([String] -> Nesting
nst->Nesting
n,String
req)     -> Nesting -> String -> FormatM ()
transient Nesting
n (String -> String
itemStarted String
req)
, formatterItemDone :: Path -> Item -> FormatM ()
formatterItemDone     = \([String] -> Nesting
nst->Nesting
n,String
req) Item
itm -> Nesting -> Lines -> FormatM ()
write     Nesting
n (String -> Item -> Lines
itemDone String
req Item
itm)
, formatterProgress :: Path -> Progress -> FormatM ()
formatterProgress     = \([String] -> Nesting
nst->Nesting
n,String
_  ) Progress
prg -> Nesting -> String -> FormatM ()
transient Nesting
n (Progress -> String
progress Progress
prg)
} where

  nothing :: FormatM ()
nothing = () -> FormatM ()
forall a. a -> FormatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  nst :: [String] -> Nesting
nst     = [String] -> Nesting
nesting


--
-- hspec API type aliases
--

type Group         = String   -- ([Group],Req) == Api.Path
type Req           = String
type PendingString = String


--
-- Chunks and Lines
--

{- |
'Chunks': a sequence of text fragments to be written to the terminal; constitutes a full line or part of a line
'Lines' : a list of 'Chunks' with each element representing one printed line of text, in the String/[String]/lines/unlines sense

Neither ever contains \n-s.

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 Chunks = Effable FormatM String
type Lines  = Effable FormatM [Chunks]

embedLines :: [Chunks] -> Lines
embedLines :: [Effable FormatM String] -> Lines
embedLines = [Effable FormatM String] -> Lines
forall b (m :: * -> *). b -> Effable m b
embed

lines' :: String -> [Chunks]
lines' :: String -> [Effable FormatM String]
lines' = (String -> Effable FormatM String)
-> [String] -> [Effable FormatM String]
forall a b. (a -> b) -> [a] -> [b]
map String -> Effable FormatM String
forall b (m :: * -> *). IsString b => String -> Effable m b
string ([String] -> [Effable FormatM String])
-> (String -> [String]) -> String -> [Effable FormatM String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

mapEachLine :: (Chunks->Chunks) -> Lines -> Lines
mapEachLine :: (Effable FormatM String -> Effable FormatM String)
-> Lines -> Lines
mapEachLine =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap @(Effable FormatM)
  (([Effable FormatM String] -> [Effable FormatM String])
 -> Lines -> Lines)
-> ((Effable FormatM String -> Effable FormatM String)
    -> [Effable FormatM String] -> [Effable FormatM String])
-> (Effable FormatM String -> Effable FormatM String)
-> Lines
-> Lines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap @[]

--
-- Output
--

type TransientString = String

write :: Nesting -> Lines -> FormatM ()
write :: Nesting -> Lines -> FormatM ()
write Nesting
nst =
  ([Effable FormatM String] -> FormatM ()) -> Lines -> FormatM ()
forall (m :: * -> *) b.
Applicative m =>
(b -> m ()) -> Effable m b -> m ()
run (([Effable FormatM String] -> FormatM ()) -> Lines -> FormatM ())
-> ([Effable FormatM String] -> FormatM ()) -> Lines -> FormatM ()
forall a b. (a -> b) -> a -> b
$ (Effable FormatM String -> FormatM ())
-> [Effable FormatM String] -> FormatM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Effable FormatM String -> FormatM ())
 -> [Effable FormatM String] -> FormatM ())
-> (Effable FormatM String -> FormatM ())
-> [Effable FormatM String]
-> FormatM ()
forall a b. (a -> b) -> a -> b
$ \Effable FormatM String
l ->
    (String -> FormatM ()) -> Effable FormatM String -> FormatM ()
forall (m :: * -> *) b.
Applicative m =>
(b -> m ()) -> Effable m b -> m ()
run String -> FormatM ()
Api.write (Nesting -> Effable FormatM String
forall m. IsString m => Nesting -> m
specIndentation Nesting
nst Effable FormatM String
-> Effable FormatM String -> Effable FormatM String
forall a. Semigroup a => a -> a -> a
<> Effable FormatM String
l Effable FormatM String
-> Effable FormatM String -> Effable FormatM String
forall a. Semigroup a => a -> a -> a
<> Effable FormatM String
"\n")

transient :: Nesting -> TransientString -> FormatM ()
transient :: Nesting -> String -> FormatM ()
transient Nesting
nst String
str =
  FormatM () -> FormatM ()
whenReportProgress (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$
  String -> FormatM ()
Api.writeTransient (Nesting -> String
forall m. IsString m => Nesting -> m
specIndentation Nesting
nst String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
str)


--
-- Handlers
--

groupStarted :: Nesting -> Group -> Lines
groupStarted :: Nesting -> String -> Lines
groupStarted Nesting
nst String
group =
  [Effable FormatM String] -> Lines
embedLines ([Effable FormatM String] -> Lines)
-> [Effable FormatM String] -> Lines
forall a b. (a -> b) -> a -> b
$
  if |Nesting
nst Nesting -> Nesting -> Bool
forall a. Ord a => a -> a -> Bool
> Nesting
0   ->              [Effable FormatM String]
group'
     |Bool
otherwise -> [Effable FormatM String]
blankLine [Effable FormatM String]
-> [Effable FormatM String] -> [Effable FormatM String]
forall a. Semigroup a => a -> a -> a
<> [Effable FormatM String]
group'
  where
    blankLine :: [Effable FormatM String]
blankLine = [Effable FormatM String
""]
    group' :: [Effable FormatM String]
group'    = String -> [Effable FormatM String]
lines' String
group

itemStarted :: Req -> TransientString
itemStarted :: String -> String
itemStarted String
req = String
"[ ] " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
firstLine String
req)
  where
    firstLine :: String -> String
firstLine = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

itemDone :: Req -> Api.Item -> Lines
itemDone :: String -> Item -> Lines
itemDone String
req Item
itm =
     [Effable FormatM String] -> Lines
embedLines (Effable FormatM String -> String -> [Effable FormatM String]
laminate' Effable FormatM String
box String
req [Effable FormatM String]
-> Effable FormatM String -> [Effable FormatM String]
forall a. Semigroup a => [a] -> a -> [a]
`append` (Effable FormatM String
durationEffable FormatM String
-> Effable FormatM String -> Effable FormatM String
forall a. Semigroup a => a -> a -> a
<>Effable FormatM String
infoStr))
  Lines -> Lines -> Lines
forall a. Semigroup a => a -> a -> a
<> (Lines -> Lines
boxIndent Lines
pendingBlock)
  Lines -> Lines -> Lines
forall a. Semigroup a => a -> a -> a
<> (Lines -> Lines
boxIndent Lines
infoBlock)
  where
    box :: Effable FormatM String
box                 = Effable FormatM String
"["Effable FormatM String
-> Effable FormatM String -> Effable FormatM String
forall a. Semigroup a => a -> a -> a
<>Effable FormatM String
mEffable FormatM String
-> Effable FormatM String -> Effable FormatM String
forall a. Semigroup a => a -> a -> a
<>Effable FormatM String
"] "
    boxIndentation :: String
boxIndentation      = String
"    "
    duration :: Effable FormatM String
duration            = Seconds -> Effable FormatM String
mkDuration      (Seconds -> Effable FormatM String)
-> Seconds -> Effable FormatM String
forall a b. (a -> b) -> a -> b
$ Item -> Seconds
Api.itemDuration Item
itm
    (Effable FormatM String
infoStr,Lines
infoBlock) = [Effable FormatM String] -> (Effable FormatM String, Lines)
mkInfo ([Effable FormatM String] -> (Effable FormatM String, Lines))
-> (String -> [Effable FormatM String])
-> String
-> (Effable FormatM String, Lines)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Effable FormatM String]
lines' (String -> (Effable FormatM String, Lines))
-> String -> (Effable FormatM String, Lines)
forall a b. (a -> b) -> a -> b
$ Item -> String
Api.itemInfo     Item
itm

    m :: Effable FormatM String
m =
      let pick :: Effable FormatM b -> Effable FormatM b -> Effable FormatM b
pick = FormatM Bool
-> Effable FormatM b -> Effable FormatM b -> Effable FormatM b
forall (m :: * -> *) b.
Monad m =>
m Bool -> Effable m b -> Effable m b -> Effable m b
ifThenElse FormatM Bool
Api.outputUnicode in
      case Item -> Result
Api.itemResult Item
itm of
        Result
Api.Success     -> Effable FormatM String -> Effable FormatM String
Color
succColor (Effable FormatM String
-> Effable FormatM String -> Effable FormatM String
forall {b}.
Effable FormatM b -> Effable FormatM b -> Effable FormatM b
pick Effable FormatM String
"✔" Effable FormatM String
"v")
        Api.Failure Maybe Location
_ FailureReason
_ -> Effable FormatM String -> Effable FormatM String
Color
failColor (Effable FormatM String
-> Effable FormatM String -> Effable FormatM String
forall {b}.
Effable FormatM b -> Effable FormatM b -> Effable FormatM b
pick Effable FormatM String
"✘" Effable FormatM String
"x")
        Api.Pending Maybe Location
_ Maybe String
_ -> Effable FormatM String -> Effable FormatM String
Color
pendColor (Effable FormatM String
-> Effable FormatM String -> Effable FormatM String
forall {b}.
Effable FormatM b -> Effable FormatM b -> Effable FormatM b
pick Effable FormatM String
"‐" Effable FormatM String
"-")

    pendingBlock :: Lines
pendingBlock =
      case Item -> Result
Api.itemResult Item
itm of
        Api.Pending Maybe Location
_ Maybe String
s -> Maybe String -> Lines
mkPending Maybe String
s
        Result
_               -> Lines
forall a. Effable FormatM a
forall (f :: * -> *) a. Alternative f => f a
empty

    laminate' :: Effable FormatM String -> String -> [Effable FormatM String]
laminate' = String
-> Effable FormatM String -> String -> [Effable FormatM String]
laminate String
boxIndentation
    boxIndent :: Lines -> Lines
boxIndent = (Effable FormatM String -> Effable FormatM String)
-> Lines -> Lines
mapEachLine (String -> Effable FormatM String
forall a. IsString a => String -> a
fromString (String
boxIndentation)<>)

progress :: Api.Progress -> TransientString
progress :: Progress -> String
progress (Int
now,Int
total) = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
  where
    str :: String
str
      |Int
totalInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0  = Int -> String
forall a. Show a => a -> String
show Int
now
      |Bool
otherwise = Int -> String
forall a. Show a => a -> String
show Int
now String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
total


--
-- Handler helpers
--

type InfoLines = [Chunks]

mkInfo :: InfoLines -> (Chunks,Lines)
mkInfo :: [Effable FormatM String] -> (Effable FormatM String, Lines)
mkInfo [Effable FormatM String]
i = Effable FormatM (Effable FormatM String, Lines)
-> (Effable FormatM String, Lines)
forall (m :: * -> *) a b. Monad m => m (m a, m b) -> (m a, m b)
joinTuple (Verbosity -> (Effable FormatM String, Lines)
resolve' (Verbosity -> (Effable FormatM String, Lines))
-> Effable FormatM Verbosity
-> Effable FormatM (Effable FormatM String, Lines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FormatM Verbosity -> Effable FormatM Verbosity
forall (m :: * -> *) a.
(Monad m, Enumerable a) =>
m a -> Effable m a
embedAction FormatM Verbosity
verbosityM)
  where
    resolve' :: Verbosity -> (Effable FormatM String, Lines)
resolve' Verbosity
v = ([Effable FormatM String], Verbosity)
-> (Effable FormatM String, Lines)
resolveInfo ([Effable FormatM String]
i,Verbosity
v)

resolveInfo ::      (InfoLines,Verbosity)  ->  (Chunks    ,Lines     )
resolveInfo :: ([Effable FormatM String], Verbosity)
-> (Effable FormatM String, Lines)
resolveInfo = \case ([]       ,Verbosity
_        )  ->  (Effable FormatM String
forall a. Effable FormatM a
e         ,Lines
forall {m :: * -> *} {a}. Effable m [a]
e'        )
                    ([Effable FormatM String
_]      ,Verbosity
Quiet    )  ->  (Effable FormatM String
forall a. Effable FormatM a
e         ,Lines
forall {m :: * -> *} {a}. Effable m [a]
e'        )
                    ([Effable FormatM String
l]      ,Verbosity
Verbose  )  ->  (Effable FormatM String -> Effable FormatM String
asStr Effable FormatM String
l   ,Lines
forall {m :: * -> *} {a}. Effable m [a]
e'        )
                    ([Effable FormatM String]
ls       ,Verbosity
_        )  ->  (Effable FormatM String
forall a. Effable FormatM a
e         ,[Effable FormatM String] -> Lines
asBlock [Effable FormatM String]
ls)
  where
    asStr :: Effable FormatM String -> Effable FormatM String
asStr   = Effable FormatM String -> Effable FormatM String
Color
unlessExpert (Effable FormatM String -> Effable FormatM String)
-> (Effable FormatM String -> Effable FormatM String)
-> Effable FormatM String
-> Effable FormatM String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.             Effable FormatM String -> Effable FormatM String
Color
infoColor (Effable FormatM String -> Effable FormatM String)
-> (Effable FormatM String -> Effable FormatM String)
-> Effable FormatM String
-> Effable FormatM String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Effable FormatM String -> Effable FormatM String
forall {a}. (Semigroup a, IsString a) => a -> a
fmtStr
    asBlock :: [Effable FormatM String] -> Lines
asBlock = Lines -> Lines
Color
unlessExpert (Lines -> Lines)
-> ([Effable FormatM String] -> Lines)
-> [Effable FormatM String]
-> Lines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Effable FormatM String -> Effable FormatM String)
-> Lines -> Lines
mapEachLine Effable FormatM String -> Effable FormatM String
Color
infoColor (Lines -> Lines)
-> ([Effable FormatM String] -> Lines)
-> [Effable FormatM String]
-> Lines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Effable FormatM String] -> Lines
embedLines

    fmtStr :: a -> a
fmtStr a
s = a
" (" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"

    e :: Effable FormatM a
e  = Effable FormatM a
forall a. Effable FormatM a
forall (f :: * -> *) a. Alternative f => f a
empty
    e' :: Effable m [a]
e' = [a] -> Effable m [a]
forall b (m :: * -> *). b -> Effable m b
embed []

mkPending :: Maybe PendingString -> Lines
mkPending :: Maybe String -> Lines
mkPending Maybe String
mb =
  (Effable FormatM String -> Effable FormatM String)
-> Lines -> Lines
mapEachLine Effable FormatM String -> Effable FormatM String
Color
pendColor (Lines -> Lines)
-> ([Effable FormatM String] -> Lines)
-> [Effable FormatM String]
-> Lines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Effable FormatM String] -> Lines
embedLines ([Effable FormatM String] -> Lines)
-> [Effable FormatM String] -> Lines
forall a b. (a -> b) -> a -> b
$
  case Maybe String
mb of
    Maybe String
Nothing  -> [Effable FormatM String
"# PENDING"]
    Just String
str ->
      String
-> Effable FormatM String -> String -> [Effable FormatM String]
laminate
        String
"           "
        Effable FormatM String
"# PENDING: "
        String
str

mkDuration :: Api.Seconds -> Chunks
mkDuration :: Seconds -> Effable FormatM String
mkDuration (Api.Seconds Double
secs) =
  FormatM Bool -> Effable FormatM String -> Effable FormatM String
forall (m :: * -> *) b.
Monad m =>
m Bool -> Effable m b -> Effable m b
when' FormatM Bool
Api.printTimes (Effable FormatM String -> Effable FormatM String)
-> Effable FormatM String -> Effable FormatM String
forall a b. (a -> b) -> a -> b
$
  case Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
secs Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000) of
    Integer
0  -> Effable FormatM String
""
    Integer
ms -> Effable FormatM String -> Effable FormatM String
Color
infoColor (Effable FormatM String -> Effable FormatM String)
-> (String -> Effable FormatM String)
-> String
-> Effable FormatM String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Effable FormatM String
forall b (m :: * -> *). IsString b => String -> Effable m b
string (String -> Effable FormatM String)
-> String -> Effable FormatM String
forall a b. (a -> b) -> a -> b
$ String
"  (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
ms String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"ms)"

{- | 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 :: String
-> Effable FormatM String -> String -> [Effable FormatM String]
laminate String
pad Effable FormatM String
label String
body =
  case String -> [Effable FormatM String]
lines' String
body of
    []     ->    [Effable FormatM String
label]
    [Effable FormatM String
l]    ->    [Effable FormatM String
label Effable FormatM String
-> Effable FormatM String -> Effable FormatM String
forall a. Semigroup a => a -> a -> a
<> Effable FormatM String
l]
    (Effable FormatM String
l:[Effable FormatM String]
ls) ->    [Effable FormatM String
label Effable FormatM String
-> Effable FormatM String -> Effable FormatM String
forall a. Semigroup a => a -> a -> a
<> Effable FormatM String
l]
              [Effable FormatM String]
-> [Effable FormatM String] -> [Effable FormatM String]
forall a. [a] -> [a] -> [a]
++ [Effable FormatM String
forall {m :: * -> *}. Effable m String
pad'  Effable FormatM String
-> Effable FormatM String -> Effable FormatM String
forall a. Semigroup a => a -> a -> a
<> Effable FormatM String
l' | Effable FormatM String
l'<-[Effable FormatM String]
ls]
  where
    pad' :: Effable m String
pad' = String -> Effable m String
forall b (m :: * -> *). IsString b => String -> Effable m b
string String
pad


--
-- Api shorthands
--

type ApplyWrap = ∀ b. Effable FormatM b -> Effable FormatM b


--- Color ---

type Color = ApplyWrap

infoColor :: Color
pendColor :: Color
succColor :: Color
failColor :: Color

infoColor :: Color
infoColor = (FormatM () -> FormatM ())
-> Effable FormatM b -> Effable FormatM b
forall (m :: * -> *) b. Wrap m -> Effable m b -> Effable m b
wrapInside FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
Api.withInfoColor
pendColor :: Color
pendColor = (FormatM () -> FormatM ())
-> Effable FormatM b -> Effable FormatM b
forall (m :: * -> *) b. Wrap m -> Effable m b -> Effable m b
wrapInside FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
Api.withPendingColor
succColor :: Color
succColor = (FormatM () -> FormatM ())
-> Effable FormatM b -> Effable FormatM b
forall (m :: * -> *) b. Wrap m -> Effable m b -> Effable m b
wrapInside FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
Api.withSuccessColor
failColor :: Color
failColor = (FormatM () -> FormatM ())
-> Effable FormatM b -> Effable FormatM b
forall (m :: * -> *) b. Wrap m -> Effable m b -> Effable m b
wrapInside FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
Api.withFailColor


--- Verbosity ---

data Verbosity =
    Quiet
  | Verbose
  deriving (Verbosity -> Verbosity -> Bool
(Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool) -> Eq Verbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
/= :: Verbosity -> Verbosity -> Bool
Eq, Int -> Verbosity -> String -> String
[Verbosity] -> String -> String
Verbosity -> String
(Int -> Verbosity -> String -> String)
-> (Verbosity -> String)
-> ([Verbosity] -> String -> String)
-> Show Verbosity
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Verbosity -> String -> String
showsPrec :: Int -> Verbosity -> String -> String
$cshow :: Verbosity -> String
show :: Verbosity -> String
$cshowList :: [Verbosity] -> String -> String
showList :: [Verbosity] -> String -> String
Show, Int -> Verbosity
Verbosity -> Int
Verbosity -> [Verbosity]
Verbosity -> Verbosity
Verbosity -> Verbosity -> [Verbosity]
Verbosity -> Verbosity -> Verbosity -> [Verbosity]
(Verbosity -> Verbosity)
-> (Verbosity -> Verbosity)
-> (Int -> Verbosity)
-> (Verbosity -> Int)
-> (Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> Verbosity -> [Verbosity])
-> Enum Verbosity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Verbosity -> Verbosity
succ :: Verbosity -> Verbosity
$cpred :: Verbosity -> Verbosity
pred :: Verbosity -> Verbosity
$ctoEnum :: Int -> Verbosity
toEnum :: Int -> Verbosity
$cfromEnum :: Verbosity -> Int
fromEnum :: Verbosity -> Int
$cenumFrom :: Verbosity -> [Verbosity]
enumFrom :: Verbosity -> [Verbosity]
$cenumFromThen :: Verbosity -> Verbosity -> [Verbosity]
enumFromThen :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromTo :: Verbosity -> Verbosity -> [Verbosity]
enumFromTo :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
enumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
Enum, Verbosity
Verbosity -> Verbosity -> Bounded Verbosity
forall a. a -> a -> Bounded a
$cminBound :: Verbosity
minBound :: Verbosity
$cmaxBound :: Verbosity
maxBound :: Verbosity
Bounded)

type VerbosityM = FormatM Verbosity

verbosityM :: VerbosityM
verbosityM :: FormatM Verbosity
verbosityM = FormatM Bool
Api.printTimes FormatM Bool -> (Bool -> Verbosity) -> FormatM Verbosity
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
  Bool
False -> Verbosity
Quiet
  Bool
True  -> Verbosity
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)


--- Expert ---

unlessExpert :: ApplyWrap
unlessExpert :: Color
unlessExpert = (FormatM () -> FormatM ())
-> Effable FormatM b -> Effable FormatM b
forall (m :: * -> *) b. Wrap m -> Effable m b -> Effable m b
wrapInside FormatM () -> FormatM ()
Api.unlessExpert


--- Progress ---

whenReportProgress :: FormatM () -> FormatM ()
whenReportProgress :: FormatM () -> FormatM ()
whenReportProgress = FormatM Bool -> FormatM () -> FormatM ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((FormatConfig -> Bool) -> FormatM Bool
forall a. (FormatConfig -> a) -> FormatM a
Api.getConfigValue FormatConfig -> Bool
Api.formatConfigReportProgress)


--
-- Spec indentation
--

-- 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.

-- | The nesting depth of a spec tree item.
newtype Nesting = Nesting Int
  deriving (Int -> Nesting -> String -> String
[Nesting] -> String -> String
Nesting -> String
(Int -> Nesting -> String -> String)
-> (Nesting -> String)
-> ([Nesting] -> String -> String)
-> Show Nesting
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Nesting -> String -> String
showsPrec :: Int -> Nesting -> String -> String
$cshow :: Nesting -> String
show :: Nesting -> String
$cshowList :: [Nesting] -> String -> String
showList :: [Nesting] -> String -> String
Show, Nesting -> Nesting -> Bool
(Nesting -> Nesting -> Bool)
-> (Nesting -> Nesting -> Bool) -> Eq Nesting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Nesting -> Nesting -> Bool
== :: Nesting -> Nesting -> Bool
$c/= :: Nesting -> Nesting -> Bool
/= :: Nesting -> Nesting -> Bool
Eq, Eq Nesting
Eq Nesting =>
(Nesting -> Nesting -> Ordering)
-> (Nesting -> Nesting -> Bool)
-> (Nesting -> Nesting -> Bool)
-> (Nesting -> Nesting -> Bool)
-> (Nesting -> Nesting -> Bool)
-> (Nesting -> Nesting -> Nesting)
-> (Nesting -> Nesting -> Nesting)
-> Ord Nesting
Nesting -> Nesting -> Bool
Nesting -> Nesting -> Ordering
Nesting -> Nesting -> Nesting
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Nesting -> Nesting -> Ordering
compare :: Nesting -> Nesting -> Ordering
$c< :: Nesting -> Nesting -> Bool
< :: Nesting -> Nesting -> Bool
$c<= :: Nesting -> Nesting -> Bool
<= :: Nesting -> Nesting -> Bool
$c> :: Nesting -> Nesting -> Bool
> :: Nesting -> Nesting -> Bool
$c>= :: Nesting -> Nesting -> Bool
>= :: Nesting -> Nesting -> Bool
$cmax :: Nesting -> Nesting -> Nesting
max :: Nesting -> Nesting -> Nesting
$cmin :: Nesting -> Nesting -> Nesting
min :: Nesting -> Nesting -> Nesting
Ord, Integer -> Nesting
Nesting -> Nesting
Nesting -> Nesting -> Nesting
(Nesting -> Nesting -> Nesting)
-> (Nesting -> Nesting -> Nesting)
-> (Nesting -> Nesting -> Nesting)
-> (Nesting -> Nesting)
-> (Nesting -> Nesting)
-> (Nesting -> Nesting)
-> (Integer -> Nesting)
-> Num Nesting
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Nesting -> Nesting -> Nesting
+ :: Nesting -> Nesting -> Nesting
$c- :: Nesting -> Nesting -> Nesting
- :: Nesting -> Nesting -> Nesting
$c* :: Nesting -> Nesting -> Nesting
* :: Nesting -> Nesting -> Nesting
$cnegate :: Nesting -> Nesting
negate :: Nesting -> Nesting
$cabs :: Nesting -> Nesting
abs :: Nesting -> Nesting
$csignum :: Nesting -> Nesting
signum :: Nesting -> Nesting
$cfromInteger :: Integer -> Nesting
fromInteger :: Integer -> Nesting
Num, Num Nesting
Ord Nesting
(Num Nesting, Ord Nesting) => (Nesting -> Rational) -> Real Nesting
Nesting -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: Nesting -> Rational
toRational :: Nesting -> Rational
Real, Int -> Nesting
Nesting -> Int
Nesting -> [Nesting]
Nesting -> Nesting
Nesting -> Nesting -> [Nesting]
Nesting -> Nesting -> Nesting -> [Nesting]
(Nesting -> Nesting)
-> (Nesting -> Nesting)
-> (Int -> Nesting)
-> (Nesting -> Int)
-> (Nesting -> [Nesting])
-> (Nesting -> Nesting -> [Nesting])
-> (Nesting -> Nesting -> [Nesting])
-> (Nesting -> Nesting -> Nesting -> [Nesting])
-> Enum Nesting
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Nesting -> Nesting
succ :: Nesting -> Nesting
$cpred :: Nesting -> Nesting
pred :: Nesting -> Nesting
$ctoEnum :: Int -> Nesting
toEnum :: Int -> Nesting
$cfromEnum :: Nesting -> Int
fromEnum :: Nesting -> Int
$cenumFrom :: Nesting -> [Nesting]
enumFrom :: Nesting -> [Nesting]
$cenumFromThen :: Nesting -> Nesting -> [Nesting]
enumFromThen :: Nesting -> Nesting -> [Nesting]
$cenumFromTo :: Nesting -> Nesting -> [Nesting]
enumFromTo :: Nesting -> Nesting -> [Nesting]
$cenumFromThenTo :: Nesting -> Nesting -> Nesting -> [Nesting]
enumFromThenTo :: Nesting -> Nesting -> Nesting -> [Nesting]
Enum, Enum Nesting
Real Nesting
(Real Nesting, Enum Nesting) =>
(Nesting -> Nesting -> Nesting)
-> (Nesting -> Nesting -> Nesting)
-> (Nesting -> Nesting -> Nesting)
-> (Nesting -> Nesting -> Nesting)
-> (Nesting -> Nesting -> (Nesting, Nesting))
-> (Nesting -> Nesting -> (Nesting, Nesting))
-> (Nesting -> Integer)
-> Integral Nesting
Nesting -> Integer
Nesting -> Nesting -> (Nesting, Nesting)
Nesting -> Nesting -> Nesting
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: Nesting -> Nesting -> Nesting
quot :: Nesting -> Nesting -> Nesting
$crem :: Nesting -> Nesting -> Nesting
rem :: Nesting -> Nesting -> Nesting
$cdiv :: Nesting -> Nesting -> Nesting
div :: Nesting -> Nesting -> Nesting
$cmod :: Nesting -> Nesting -> Nesting
mod :: Nesting -> Nesting -> Nesting
$cquotRem :: Nesting -> Nesting -> (Nesting, Nesting)
quotRem :: Nesting -> Nesting -> (Nesting, Nesting)
$cdivMod :: Nesting -> Nesting -> (Nesting, Nesting)
divMod :: Nesting -> Nesting -> (Nesting, Nesting)
$ctoInteger :: Nesting -> Integer
toInteger :: Nesting -> Integer
Integral)

nesting :: [Group] -> Nesting
nesting :: [String] -> Nesting
nesting [String]
gs = Int -> Nesting
Nesting (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
gs)

specIndentation :: IsString m => Nesting -> m
specIndentation :: forall m. IsString m => Nesting -> m
specIndentation Nesting
n = String -> m
forall a. IsString a => String -> a
fromString (Nesting -> Char -> String
forall i a. Integral i => i -> a -> [a]
genericReplicate Nesting
n Char
' ')


--
-- General helpers
--

whenM :: Monad m => m Bool -> m () -> m ()
whenM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM m Bool
bM m ()
action = do
  Bool
b <- m Bool
bM
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b m ()
action

joinTuple :: Monad m => m (m a,m b) -> (m a,m b)
joinTuple :: forall (m :: * -> *) a b. Monad m => m (m a, m b) -> (m a, m b)
joinTuple m (m a, m b)
x =
  ( m (m a) -> m a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m a) -> m a) -> m (m a) -> m a
forall a b. (a -> b) -> a -> b
$ (m a, m b) -> m a
forall a b. (a, b) -> a
fst ((m a, m b) -> m a) -> m (m a, m b) -> m (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (m a, m b)
x
  , m (m b) -> m b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m b) -> m b) -> m (m b) -> m b
forall a b. (a -> b) -> a -> b
$ (m a, m b) -> m b
forall a b. (a, b) -> b
snd ((m a, m b) -> m b) -> m (m a, m b) -> m (m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (m a, m b)
x
  )

{-| Map the last element.

>>> mapLast (+1) [1,2,3]
[1,2,4]
-}
mapLast :: (a -> a) -> [a] -> [a]
mapLast :: forall a. (a -> a) -> [a] -> [a]
mapLast a -> a
f = [a] -> [a]
go where
  go :: [a] -> [a]
go []     = []
  go [a
x]    = a -> a
f a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: []
  go (a
x:[a]
xs) = a
x   a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
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 :: forall a. Semigroup a => [a] -> a -> [a]
append [a]
xs a
x = (a -> a) -> [a] -> [a]
forall a. (a -> a) -> [a] -> [a]
mapLast (a -> a -> a
forall a. Semigroup a => a -> a -> a
<>a
x) [a]
xs
infixl 3 `append`


--
-- Dev notes
--

{- Dev notes:

ref.: source code for built-in formatters:
  https://hackage-content.haskell.org/package/hspec-core/docs/src/Test.Hspec.Core.Formatters.V2.html

---

'writeTransient' of `hspec-api` does roughly:

> writeTransient str = do
>   IO.hPutStr stdout str         -- print payload
>   IO.hFlush  stdout
>   IO.hPutStr stdout "\r\ESC[K"  -- schedule CR, ^K (^K == clear-line)

Effect: the clear-line control sequence will be emitted the next time the output buffer is flushed; until then, the transient payload will be visible in the terminal

---

With this spec tree...

@
spec :: 'Test.Hspec.Spec'
spec = do
  describe "d0" $ do
    describe "d1" $ do
      it "i" $ do
        1 == 1
@

...the t'Api.Path' provided for the inner 'Test.Hspec.it' node will be:

@
path :: 'Api.Path'
path = (["d0","d1"],"i")
@

-}