{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}

module Test.Hspec.Core.Tree (
-- RE-EXPORTED from Test.Hspec.Core.Spec
  SpecTree
, Tree (..)
, Item (..)
, specGroup
, specItem
, bimapTree
, bimapForest
, filterTree
, filterForest
, filterTreeWithLabels
, filterForestWithLabels
, pruneTree -- unused
, pruneForest -- unused
, location
-- END RE-EXPORTED from Test.Hspec.Core.Spec
, callSite
, formatDefaultDescription
, toModuleName
) where

import           Prelude ()
import           Test.Hspec.Core.Compat

import           Data.Char
import           System.FilePath
import qualified Data.CallStack as CallStack

import           Test.Hspec.Core.Example

-- | Internal tree data structure
data Tree c a =
    Node String [Tree c a]
  | NodeWithCleanup (Maybe (String, Location)) c [Tree c a]
  | Leaf a
  deriving (Tree c a -> Tree c a -> Bool
(Tree c a -> Tree c a -> Bool)
-> (Tree c a -> Tree c a -> Bool) -> Eq (Tree c a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c a. (Eq c, Eq a) => Tree c a -> Tree c a -> Bool
$c== :: forall c a. (Eq c, Eq a) => Tree c a -> Tree c a -> Bool
== :: Tree c a -> Tree c a -> Bool
$c/= :: forall c a. (Eq c, Eq a) => Tree c a -> Tree c a -> Bool
/= :: Tree c a -> Tree c a -> Bool
Eq, Int -> Tree c a -> ShowS
[Tree c a] -> ShowS
Tree c a -> String
(Int -> Tree c a -> ShowS)
-> (Tree c a -> String) -> ([Tree c a] -> ShowS) -> Show (Tree c a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c a. (Show c, Show a) => Int -> Tree c a -> ShowS
forall c a. (Show c, Show a) => [Tree c a] -> ShowS
forall c a. (Show c, Show a) => Tree c a -> String
$cshowsPrec :: forall c a. (Show c, Show a) => Int -> Tree c a -> ShowS
showsPrec :: Int -> Tree c a -> ShowS
$cshow :: forall c a. (Show c, Show a) => Tree c a -> String
show :: Tree c a -> String
$cshowList :: forall c a. (Show c, Show a) => [Tree c a] -> ShowS
showList :: [Tree c a] -> ShowS
Show, (forall a b. (a -> b) -> Tree c a -> Tree c b)
-> (forall a b. a -> Tree c b -> Tree c a) -> Functor (Tree c)
forall a b. a -> Tree c b -> Tree c a
forall a b. (a -> b) -> Tree c a -> Tree c b
forall c a b. a -> Tree c b -> Tree c a
forall c a b. (a -> b) -> Tree c a -> Tree c b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall c a b. (a -> b) -> Tree c a -> Tree c b
fmap :: forall a b. (a -> b) -> Tree c a -> Tree c b
$c<$ :: forall c a b. a -> Tree c b -> Tree c a
<$ :: forall a b. a -> Tree c b -> Tree c a
Functor, (forall m. Monoid m => Tree c m -> m)
-> (forall m a. Monoid m => (a -> m) -> Tree c a -> m)
-> (forall m a. Monoid m => (a -> m) -> Tree c a -> m)
-> (forall a b. (a -> b -> b) -> b -> Tree c a -> b)
-> (forall a b. (a -> b -> b) -> b -> Tree c a -> b)
-> (forall b a. (b -> a -> b) -> b -> Tree c a -> b)
-> (forall b a. (b -> a -> b) -> b -> Tree c a -> b)
-> (forall a. (a -> a -> a) -> Tree c a -> a)
-> (forall a. (a -> a -> a) -> Tree c a -> a)
-> (forall a. Tree c a -> [a])
-> (forall a. Tree c a -> Bool)
-> (forall a. Tree c a -> Int)
-> (forall a. Eq a => a -> Tree c a -> Bool)
-> (forall a. Ord a => Tree c a -> a)
-> (forall a. Ord a => Tree c a -> a)
-> (forall a. Num a => Tree c a -> a)
-> (forall a. Num a => Tree c a -> a)
-> Foldable (Tree c)
forall a. Eq a => a -> Tree c a -> Bool
forall a. Num a => Tree c a -> a
forall a. Ord a => Tree c a -> a
forall m. Monoid m => Tree c m -> m
forall a. Tree c a -> Bool
forall a. Tree c a -> Int
forall a. Tree c a -> [a]
forall a. (a -> a -> a) -> Tree c a -> a
forall c a. Eq a => a -> Tree c a -> Bool
forall c a. Num a => Tree c a -> a
forall c a. Ord a => Tree c a -> a
forall m a. Monoid m => (a -> m) -> Tree c a -> m
forall c m. Monoid m => Tree c m -> m
forall c a. Tree c a -> Bool
forall c a. Tree c a -> Int
forall c a. Tree c a -> [a]
forall b a. (b -> a -> b) -> b -> Tree c a -> b
forall a b. (a -> b -> b) -> b -> Tree c a -> b
forall c a. (a -> a -> a) -> Tree c a -> a
forall c m a. Monoid m => (a -> m) -> Tree c a -> m
forall c b a. (b -> a -> b) -> b -> Tree c a -> b
forall c a b. (a -> b -> b) -> b -> Tree c a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall c m. Monoid m => Tree c m -> m
fold :: forall m. Monoid m => Tree c m -> m
$cfoldMap :: forall c m a. Monoid m => (a -> m) -> Tree c a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Tree c a -> m
$cfoldMap' :: forall c m a. Monoid m => (a -> m) -> Tree c a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Tree c a -> m
$cfoldr :: forall c a b. (a -> b -> b) -> b -> Tree c a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Tree c a -> b
$cfoldr' :: forall c a b. (a -> b -> b) -> b -> Tree c a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Tree c a -> b
$cfoldl :: forall c b a. (b -> a -> b) -> b -> Tree c a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Tree c a -> b
$cfoldl' :: forall c b a. (b -> a -> b) -> b -> Tree c a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Tree c a -> b
$cfoldr1 :: forall c a. (a -> a -> a) -> Tree c a -> a
foldr1 :: forall a. (a -> a -> a) -> Tree c a -> a
$cfoldl1 :: forall c a. (a -> a -> a) -> Tree c a -> a
foldl1 :: forall a. (a -> a -> a) -> Tree c a -> a
$ctoList :: forall c a. Tree c a -> [a]
toList :: forall a. Tree c a -> [a]
$cnull :: forall c a. Tree c a -> Bool
null :: forall a. Tree c a -> Bool
$clength :: forall c a. Tree c a -> Int
length :: forall a. Tree c a -> Int
$celem :: forall c a. Eq a => a -> Tree c a -> Bool
elem :: forall a. Eq a => a -> Tree c a -> Bool
$cmaximum :: forall c a. Ord a => Tree c a -> a
maximum :: forall a. Ord a => Tree c a -> a
$cminimum :: forall c a. Ord a => Tree c a -> a
minimum :: forall a. Ord a => Tree c a -> a
$csum :: forall c a. Num a => Tree c a -> a
sum :: forall a. Num a => Tree c a -> a
$cproduct :: forall c a. Num a => Tree c a -> a
product :: forall a. Num a => Tree c a -> a
Foldable, Functor (Tree c)
Foldable (Tree c)
(Functor (Tree c), Foldable (Tree c)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Tree c a -> f (Tree c b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Tree c (f a) -> f (Tree c a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Tree c a -> m (Tree c b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Tree c (m a) -> m (Tree c a))
-> Traversable (Tree c)
forall c. Functor (Tree c)
forall c. Foldable (Tree c)
forall c (m :: * -> *) a. Monad m => Tree c (m a) -> m (Tree c a)
forall c (f :: * -> *) a.
Applicative f =>
Tree c (f a) -> f (Tree c a)
forall c (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Tree c a -> m (Tree c b)
forall c (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tree c a -> f (Tree c b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Tree c (m a) -> m (Tree c a)
forall (f :: * -> *) a.
Applicative f =>
Tree c (f a) -> f (Tree c a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Tree c a -> m (Tree c b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tree c a -> f (Tree c b)
$ctraverse :: forall c (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tree c a -> f (Tree c b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tree c a -> f (Tree c b)
$csequenceA :: forall c (f :: * -> *) a.
Applicative f =>
Tree c (f a) -> f (Tree c a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Tree c (f a) -> f (Tree c a)
$cmapM :: forall c (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Tree c a -> m (Tree c b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Tree c a -> m (Tree c b)
$csequence :: forall c (m :: * -> *) a. Monad m => Tree c (m a) -> m (Tree c a)
sequence :: forall (m :: * -> *) a. Monad m => Tree c (m a) -> m (Tree c a)
Traversable)

-- | A tree is used to represent a spec internally.  The tree is parameterized
-- over the type of cleanup actions and the type of the actual spec items.
type SpecTree a = Tree (IO ()) (Item a)

bimapForest :: (a -> b) -> (c -> d) -> [Tree a c] -> [Tree b d]
bimapForest :: forall a b c d. (a -> b) -> (c -> d) -> [Tree a c] -> [Tree b d]
bimapForest a -> b
g c -> d
f = (Tree a c -> Tree b d) -> [Tree a c] -> [Tree b d]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> (c -> d) -> Tree a c -> Tree b d
forall a b c d. (a -> b) -> (c -> d) -> Tree a c -> Tree b d
bimapTree a -> b
g c -> d
f)

bimapTree :: (a -> b) -> (c -> d) -> Tree a c -> Tree b d
bimapTree :: forall a b c d. (a -> b) -> (c -> d) -> Tree a c -> Tree b d
bimapTree a -> b
g c -> d
f = Tree a c -> Tree b d
go
  where
    go :: Tree a c -> Tree b d
go Tree a c
spec = case Tree a c
spec of
      Node String
d [Tree a c]
xs -> String -> [Tree b d] -> Tree b d
forall c a. String -> [Tree c a] -> Tree c a
Node String
d ((Tree a c -> Tree b d) -> [Tree a c] -> [Tree b d]
forall a b. (a -> b) -> [a] -> [b]
map Tree a c -> Tree b d
go [Tree a c]
xs)
      NodeWithCleanup Maybe (String, Location)
loc a
action [Tree a c]
xs -> Maybe (String, Location) -> b -> [Tree b d] -> Tree b d
forall c a. Maybe (String, Location) -> c -> [Tree c a] -> Tree c a
NodeWithCleanup Maybe (String, Location)
loc (a -> b
g a
action) ((Tree a c -> Tree b d) -> [Tree a c] -> [Tree b d]
forall a b. (a -> b) -> [a] -> [b]
map Tree a c -> Tree b d
go [Tree a c]
xs)
      Leaf c
item -> d -> Tree b d
forall c a. a -> Tree c a
Leaf (c -> d
f c
item)

filterTree :: (a -> Bool) -> Tree c a -> Maybe (Tree c a)
filterTree :: forall a c. (a -> Bool) -> Tree c a -> Maybe (Tree c a)
filterTree = ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)
forall a c. ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)
filterTreeWithLabels (([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a))
-> ((a -> Bool) -> [String] -> a -> Bool)
-> (a -> Bool)
-> Tree c a
-> Maybe (Tree c a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [String] -> a -> Bool
forall a b. a -> b -> a
const

filterForest :: (a -> Bool) -> [Tree c a] -> [Tree c a]
filterForest :: forall a c. (a -> Bool) -> [Tree c a] -> [Tree c a]
filterForest = ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]
forall a c. ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]
filterForestWithLabels (([String] -> a -> Bool) -> [Tree c a] -> [Tree c a])
-> ((a -> Bool) -> [String] -> a -> Bool)
-> (a -> Bool)
-> [Tree c a]
-> [Tree c a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [String] -> a -> Bool
forall a b. a -> b -> a
const

filterTreeWithLabels :: ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)
filterTreeWithLabels :: forall a c. ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)
filterTreeWithLabels = [String] -> ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)
forall a c.
[String] -> ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)
filterTree_ []

filterForestWithLabels :: ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]
filterForestWithLabels :: forall a c. ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]
filterForestWithLabels = [String] -> ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]
forall a c.
[String] -> ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]
filterForest_ []

filterForest_ :: [String] -> ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]
filterForest_ :: forall a c.
[String] -> ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]
filterForest_ [String]
groups = (Tree c a -> Maybe (Tree c a)) -> [Tree c a] -> [Tree c a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Tree c a -> Maybe (Tree c a)) -> [Tree c a] -> [Tree c a])
-> (([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a))
-> ([String] -> a -> Bool)
-> [Tree c a]
-> [Tree c a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)
forall a c.
[String] -> ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)
filterTree_ [String]
groups

filterTree_ :: [String] -> ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)
filterTree_ :: forall a c.
[String] -> ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)
filterTree_ [String]
groups [String] -> a -> Bool
p Tree c a
tree = case Tree c a
tree of
  Node String
group [Tree c a]
xs -> Tree c a -> Maybe (Tree c a)
forall a. a -> Maybe a
Just (Tree c a -> Maybe (Tree c a)) -> Tree c a -> Maybe (Tree c a)
forall a b. (a -> b) -> a -> b
$ String -> [Tree c a] -> Tree c a
forall c a. String -> [Tree c a] -> Tree c a
Node String
group ([Tree c a] -> Tree c a) -> [Tree c a] -> Tree c a
forall a b. (a -> b) -> a -> b
$ [String] -> ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]
forall a c.
[String] -> ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]
filterForest_ ([String]
groups [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
group]) [String] -> a -> Bool
p [Tree c a]
xs
  NodeWithCleanup Maybe (String, Location)
loc c
action [Tree c a]
xs -> Tree c a -> Maybe (Tree c a)
forall a. a -> Maybe a
Just (Tree c a -> Maybe (Tree c a)) -> Tree c a -> Maybe (Tree c a)
forall a b. (a -> b) -> a -> b
$ Maybe (String, Location) -> c -> [Tree c a] -> Tree c a
forall c a. Maybe (String, Location) -> c -> [Tree c a] -> Tree c a
NodeWithCleanup Maybe (String, Location)
loc c
action ([Tree c a] -> Tree c a) -> [Tree c a] -> Tree c a
forall a b. (a -> b) -> a -> b
$ [String] -> ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]
forall a c.
[String] -> ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]
filterForest_ [String]
groups [String] -> a -> Bool
p [Tree c a]
xs
  Leaf a
item -> a -> Tree c a
forall c a. a -> Tree c a
Leaf (a -> Tree c a) -> Maybe a -> Maybe (Tree c a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Bool) -> a -> Maybe a
forall (m :: * -> *) a. Alternative m => (a -> Bool) -> a -> m a
guarded ([String] -> a -> Bool
p [String]
groups) a
item

pruneForest :: [Tree c a] -> [Tree c a]
pruneForest :: forall c a. [Tree c a] -> [Tree c a]
pruneForest = (Tree c a -> Maybe (Tree c a)) -> [Tree c a] -> [Tree c a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Tree c a -> Maybe (Tree c a)
forall c a. Tree c a -> Maybe (Tree c a)
pruneTree

pruneTree :: Tree c a -> Maybe (Tree c a)
pruneTree :: forall c a. Tree c a -> Maybe (Tree c a)
pruneTree Tree c a
node = case Tree c a
node of
  Node String
group [Tree c a]
xs -> String -> [Tree c a] -> Tree c a
forall c a. String -> [Tree c a] -> Tree c a
Node String
group ([Tree c a] -> Tree c a) -> Maybe [Tree c a] -> Maybe (Tree c a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree c a] -> Maybe [Tree c a]
forall {c} {a}. [Tree c a] -> Maybe [Tree c a]
prune [Tree c a]
xs
  NodeWithCleanup Maybe (String, Location)
loc c
action [Tree c a]
xs -> Maybe (String, Location) -> c -> [Tree c a] -> Tree c a
forall c a. Maybe (String, Location) -> c -> [Tree c a] -> Tree c a
NodeWithCleanup Maybe (String, Location)
loc c
action ([Tree c a] -> Tree c a) -> Maybe [Tree c a] -> Maybe (Tree c a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree c a] -> Maybe [Tree c a]
forall {c} {a}. [Tree c a] -> Maybe [Tree c a]
prune [Tree c a]
xs
  Leaf{} -> Tree c a -> Maybe (Tree c a)
forall a. a -> Maybe a
Just Tree c a
node
  where
    prune :: [Tree c a] -> Maybe [Tree c a]
prune = ([Tree c a] -> Bool) -> [Tree c a] -> Maybe [Tree c a]
forall (m :: * -> *) a. Alternative m => (a -> Bool) -> a -> m a
guarded (Bool -> Bool
not (Bool -> Bool) -> ([Tree c a] -> Bool) -> [Tree c a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree c a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([Tree c a] -> Maybe [Tree c a])
-> ([Tree c a] -> [Tree c a]) -> [Tree c a] -> Maybe [Tree c a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree c a] -> [Tree c a]
forall c a. [Tree c a] -> [Tree c a]
pruneForest

-- |
-- @Item@ is used to represent spec items internally.  A spec item consists of:
--
-- * a textual description of a desired behavior
-- * an example for that behavior
-- * additional meta information
--
-- Everything that is an instance of the `Example` type class can be used as an
-- example, including QuickCheck properties, Hspec expectations and HUnit
-- assertions.
data Item a = Item {

  -- | Textual description of behavior
  forall a. Item a -> String
itemRequirement :: String

  -- | Source location of the spec item
, forall a. Item a -> Maybe Location
itemLocation :: Maybe Location

  -- | A flag that indicates whether it is safe to evaluate this spec item in
  -- parallel with other spec items
, forall a. Item a -> Maybe Bool
itemIsParallelizable :: Maybe Bool

  -- | A flag that indicates whether this spec item is focused
, forall a. Item a -> Bool
itemIsFocused :: Bool

  -- | Example for behavior
, forall a.
Item a
-> Params
-> (ActionWith a -> IO ())
-> ProgressCallback
-> IO Result
itemExample :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result
}

-- | The @specGroup@ function combines a list of specs into a larger spec.
specGroup :: HasCallStack => String -> [SpecTree a] -> SpecTree a
specGroup :: forall a. HasCallStack => String -> [SpecTree a] -> SpecTree a
specGroup String
s = String -> [Tree (IO ()) (Item a)] -> Tree (IO ()) (Item a)
forall c a. String -> [Tree c a] -> Tree c a
Node String
HasCallStack => String
msg
  where
    msg :: HasCallStack => String
    msg :: HasCallStack => String
msg
      | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s = String -> (Location -> String) -> Maybe Location -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"(no description given)" Location -> String
formatDefaultDescription Maybe Location
HasCallStack => Maybe Location
location
      | Bool
otherwise = String
s

-- | The @specItem@ function creates a spec item.
specItem :: (HasCallStack, Example e) => String -> e -> SpecTree (Arg e)
specItem :: forall e.
(HasCallStack, Example e) =>
String -> e -> SpecTree (Arg e)
specItem String
s e
e = Item (Arg e) -> Tree (IO ()) (Item (Arg e))
forall c a. a -> Tree c a
Leaf Item {
    itemRequirement :: String
itemRequirement = String
s
  , itemLocation :: Maybe Location
itemLocation = Maybe Location
HasCallStack => Maybe Location
location
  , itemIsParallelizable :: Maybe Bool
itemIsParallelizable = Maybe Bool
forall a. Maybe a
Nothing
  , itemIsFocused :: Bool
itemIsFocused = Bool
False
  , itemExample :: Params
-> (ActionWith (Arg e) -> IO ()) -> ProgressCallback -> IO Result
itemExample = e
-> Params
-> (ActionWith (Arg e) -> IO ())
-> ProgressCallback
-> IO Result
forall e.
Example e =>
e
-> Params
-> (ActionWith (Arg e) -> IO ())
-> ProgressCallback
-> IO Result
safeEvaluateExample e
e
  }

location :: HasCallStack => Maybe Location
location :: HasCallStack => Maybe Location
location = (String, Location) -> Location
forall a b. (a, b) -> b
snd ((String, Location) -> Location)
-> Maybe (String, Location) -> Maybe Location
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (String, Location)
HasCallStack => Maybe (String, Location)
callSite

callSite :: HasCallStack => Maybe (String, Location)
callSite :: HasCallStack => Maybe (String, Location)
callSite = (SrcLoc -> Location) -> (String, SrcLoc) -> (String, Location)
forall a b. (a -> b) -> (String, a) -> (String, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SrcLoc -> Location
toLocation ((String, SrcLoc) -> (String, Location))
-> Maybe (String, SrcLoc) -> Maybe (String, Location)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (String, SrcLoc)
HasCallStack => Maybe (String, SrcLoc)
CallStack.callSite

formatDefaultDescription :: Location -> String
formatDefaultDescription :: Location -> String
formatDefaultDescription Location
loc = ShowS
toModuleName (Location -> String
locationFile Location
loc) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Location -> Int
locationLine Location
loc) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Location -> Int
locationColumn Location
loc) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"

toModuleName :: FilePath -> String
toModuleName :: ShowS
toModuleName = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile String -> Bool
isModuleNameComponent ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitDirectories (String -> [String]) -> ShowS -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
dropExtension

isModuleNameComponent :: String -> Bool
isModuleNameComponent :: String -> Bool
isModuleNameComponent String
name = case String
name of
  Char
x : String
xs -> Char -> Bool
isUpper Char
x Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isIdChar String
xs
  String
_ -> Bool
False

isIdChar :: Char -> Bool
isIdChar :: Char -> Bool
isIdChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''