{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall c a. (Eq c, Eq a) => Tree c a -> Tree c a -> Bool
Eq, Int -> Tree c a -> ShowS
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
showList :: [Tree c a] -> ShowS
$cshowList :: forall c a. (Show c, Show a) => [Tree c a] -> ShowS
show :: Tree c a -> String
$cshow :: forall c a. (Show c, Show a) => Tree c a -> String
showsPrec :: Int -> Tree c a -> ShowS
$cshowsPrec :: forall c a. (Show c, Show a) => Int -> Tree c a -> ShowS
Show, 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
<$ :: forall a b. a -> Tree c b -> Tree c a
$c<$ :: forall c a b. a -> Tree c b -> Tree c a
fmap :: forall a b. (a -> b) -> Tree c a -> Tree c b
$cfmap :: forall c a b. (a -> b) -> Tree c a -> Tree c b
Functor, forall a. Tree c a -> Bool
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 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
product :: forall a. Num a => Tree c a -> a
$cproduct :: forall c a. Num a => Tree c a -> a
sum :: forall a. Num a => Tree c a -> a
$csum :: forall c a. Num a => Tree c a -> a
minimum :: forall a. Ord a => Tree c a -> a
$cminimum :: forall c a. Ord a => Tree c a -> a
maximum :: forall a. Ord a => Tree c a -> a
$cmaximum :: forall c a. Ord a => Tree c a -> a
elem :: forall a. Eq a => a -> Tree c a -> Bool
$celem :: forall c a. Eq a => a -> Tree c a -> Bool
length :: forall a. Tree c a -> Int
$clength :: forall c a. Tree c a -> Int
null :: forall a. Tree c a -> Bool
$cnull :: forall c a. Tree c a -> Bool
toList :: forall a. Tree c a -> [a]
$ctoList :: forall c a. Tree c a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Tree c a -> a
$cfoldl1 :: forall c a. (a -> a -> a) -> Tree c a -> a
foldr1 :: forall a. (a -> a -> a) -> Tree c a -> a
$cfoldr1 :: forall c a. (a -> a -> a) -> Tree c a -> a
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
$cfoldl :: forall c b a. (b -> a -> 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
$cfoldr :: forall c a b. (a -> b -> b) -> b -> Tree c a -> b
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
$cfoldMap :: forall c m a. Monoid m => (a -> m) -> Tree c a -> m
fold :: forall m. Monoid m => Tree c m -> m
$cfold :: forall c m. Monoid m => Tree c m -> m
Foldable, 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 (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tree c a -> f (Tree c b)
sequence :: forall (m :: * -> *) a. Monad m => Tree c (m a) -> m (Tree c a)
$csequence :: forall c (m :: * -> *) a. Monad m => Tree c (m a) -> m (Tree c a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Tree c a -> m (Tree c b)
$cmapM :: forall c (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Tree c a -> m (Tree c b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Tree c (f a) -> f (Tree c a)
$csequenceA :: forall c (f :: * -> *) a.
Applicative f =>
Tree c (f a) -> f (Tree c a)
traverse :: 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)
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 = forall a b. (a -> b) -> [a] -> [b]
map (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 -> forall c a. String -> [Tree c a] -> Tree c a
Node String
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 -> forall c a. Maybe (String, Location) -> c -> [Tree c a] -> Tree c a
NodeWithCleanup Maybe (String, Location)
loc (a -> b
g a
action) (forall a b. (a -> b) -> [a] -> [b]
map Tree a c -> Tree b d
go [Tree a c]
xs)
      Leaf c
item -> 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 = forall a c. ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)
filterTreeWithLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a c. ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]
filterForestWithLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 = 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 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c a. String -> [Tree c a] -> Tree c a
Node String
group forall a b. (a -> b) -> a -> b
$ forall a c.
[String] -> ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]
filterForest_ ([String]
groups 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 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c a. Maybe (String, Location) -> c -> [Tree c a] -> Tree c a
NodeWithCleanup Maybe (String, Location)
loc c
action forall a b. (a -> b) -> a -> b
$ 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 -> forall c a. a -> Tree c a
Leaf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe 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 -> forall c a. String -> [Tree c a] -> Tree c a
Node String
group forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall c a. Maybe (String, Location) -> c -> [Tree c a] -> Tree c a
NodeWithCleanup Maybe (String, Location)
loc c
action forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {c} {a}. [Tree c a] -> Maybe [Tree c a]
prune [Tree c a]
xs
  Leaf{} -> forall a. a -> Maybe a
Just Tree c a
node
  where
    prune :: [Tree c a] -> Maybe [Tree c a]
prune = forall (m :: * -> *) a. Alternative m => (a -> Bool) -> a -> m a
guarded (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall c a. String -> [Tree c a] -> Tree c a
Node HasCallStack => String
msg
  where
    msg :: HasCallStack => String
    msg :: HasCallStack => String
msg
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"(no description given)" Location -> String
formatDefaultDescription 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 = forall c a. a -> Tree c a
Leaf Item {
    itemRequirement :: String
itemRequirement = String
s
  , itemLocation :: Maybe Location
itemLocation = HasCallStack => Maybe Location
location
  , itemIsParallelizable :: Maybe Bool
itemIsParallelizable = forall a. Maybe a
Nothing
  , itemIsFocused :: Bool
itemIsFocused = Bool
False
  , itemExample :: Params
-> (ActionWith (Arg e) -> IO ()) -> ProgressCallback -> IO Result
itemExample = 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 = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Maybe (String, Location)
callSite

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

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

toModuleName :: FilePath -> String
toModuleName :: ShowS
toModuleName = forall a. [a] -> [[a]] -> [a]
intercalate String
"." forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile String -> Bool
isModuleNameComponent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitDirectories 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
&& 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 forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\''