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

-- |
-- Stability: unstable
module Test.Hspec.Core.Tree (
  SpecTree
, Tree (..)
, Item (..)
, specGroup
, specItem
, bimapTree
, bimapForest
, filterTree
, filterForest
, location
) where

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

import           Data.CallStack
import           Data.Maybe

import           Test.Hspec.Core.Example

-- | Internal tree data structure
data Tree c a =
    Node String [Tree c a]
  | NodeWithCleanup c [Tree c a]
  | Leaf a
  deriving (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
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, 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
/= :: 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, a -> Tree c b -> Tree c a
(a -> b) -> Tree c a -> Tree c b
(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
<$ :: a -> Tree c b -> Tree c a
$c<$ :: forall c a b. a -> Tree c b -> Tree c a
fmap :: (a -> b) -> Tree c a -> Tree c b
$cfmap :: forall c a b. (a -> b) -> Tree c a -> Tree c b
Functor, Tree c a -> Bool
(a -> m) -> Tree c a -> m
(a -> b -> b) -> b -> Tree c a -> b
(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
product :: Tree c a -> a
$cproduct :: forall c a. Num a => Tree c a -> a
sum :: Tree c a -> a
$csum :: forall c a. Num a => Tree c a -> a
minimum :: Tree c a -> a
$cminimum :: forall c a. Ord a => Tree c a -> a
maximum :: Tree c a -> a
$cmaximum :: forall c a. Ord a => Tree c a -> a
elem :: a -> Tree c a -> Bool
$celem :: forall c a. Eq a => a -> Tree c a -> Bool
length :: Tree c a -> Int
$clength :: forall c a. Tree c a -> Int
null :: Tree c a -> Bool
$cnull :: forall c a. Tree c a -> Bool
toList :: Tree c a -> [a]
$ctoList :: forall c a. Tree c a -> [a]
foldl1 :: (a -> a -> a) -> Tree c a -> a
$cfoldl1 :: forall c a. (a -> a -> a) -> Tree c a -> a
foldr1 :: (a -> a -> a) -> Tree c a -> a
$cfoldr1 :: forall c a. (a -> a -> a) -> Tree c a -> a
foldl' :: (b -> a -> b) -> b -> Tree c a -> b
$cfoldl' :: forall c b a. (b -> a -> b) -> b -> Tree c a -> b
foldl :: (b -> a -> b) -> b -> Tree c a -> b
$cfoldl :: forall c b a. (b -> a -> b) -> b -> Tree c a -> b
foldr' :: (a -> b -> b) -> b -> Tree c a -> b
$cfoldr' :: forall c a b. (a -> b -> b) -> b -> Tree c a -> b
foldr :: (a -> b -> b) -> b -> Tree c a -> b
$cfoldr :: forall c a b. (a -> b -> b) -> b -> Tree c a -> b
foldMap' :: (a -> m) -> Tree c a -> m
$cfoldMap' :: forall c m a. Monoid m => (a -> m) -> Tree c a -> m
foldMap :: (a -> m) -> Tree c a -> m
$cfoldMap :: forall c m a. Monoid m => (a -> m) -> Tree c a -> m
fold :: Tree c m -> m
$cfold :: forall c m. Monoid m => Tree c m -> m
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)
(a -> f b) -> Tree c a -> f (Tree c b)
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)
sequence :: Tree c (m a) -> m (Tree c a)
$csequence :: forall c (m :: * -> *) a. Monad m => Tree c (m a) -> m (Tree c a)
mapM :: (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 :: Tree c (f a) -> f (Tree c a)
$csequenceA :: forall c (f :: * -> *) a.
Applicative f =>
Tree c (f a) -> f (Tree c a)
traverse :: (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)
$cp2Traversable :: forall c. Foldable (Tree c)
$cp1Traversable :: forall c. Functor (Tree c)
Traversable)

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

bimapForest :: (a -> b) -> (c -> d) -> [Tree a c] -> [Tree b d]
bimapForest :: (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 :: (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 a
cleanup [Tree a c]
xs -> b -> [Tree b d] -> Tree b d
forall c a. c -> [Tree c a] -> Tree c a
NodeWithCleanup (a -> b
g a
cleanup) ((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)

filterForest :: (a -> Bool) -> [Tree c a] -> [Tree c a]
filterForest :: (a -> Bool) -> [Tree c a] -> [Tree c a]
filterForest = (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])
-> ((a -> Bool) -> Tree c a -> Maybe (Tree c a))
-> (a -> Bool)
-> [Tree c a]
-> [Tree c a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> Tree c a -> Maybe (Tree c a)
forall a c. (a -> Bool) -> Tree c a -> Maybe (Tree c a)
filterTree

filterTree :: (a -> Bool) -> Tree c a -> Maybe (Tree c a)
filterTree :: (a -> Bool) -> Tree c a -> Maybe (Tree c a)
filterTree a -> Bool
p Tree c a
t = case Tree c a
t of
  Node String
s [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
s ((a -> Bool) -> [Tree c a] -> [Tree c a]
forall a c. (a -> Bool) -> [Tree c a] -> [Tree c a]
filterForest a -> Bool
p [Tree c a]
xs)
  NodeWithCleanup c
c [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
$ c -> [Tree c a] -> Tree c a
forall c a. c -> [Tree c a] -> Tree c a
NodeWithCleanup c
c ((a -> Bool) -> [Tree c a] -> [Tree c a]
forall a c. (a -> Bool) -> [Tree c a] -> [Tree c a]
filterForest a -> Bool
p [Tree c a]
xs)
  leaf :: Tree c a
leaf@(Leaf a
a) -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a -> Bool
p a
a) Maybe () -> Maybe (Tree c a) -> Maybe (Tree c a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tree c a -> Maybe (Tree c a)
forall (m :: * -> *) a. Monad m => a -> m a
return Tree c a
leaf

-- |
-- @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
  Item a -> String
itemRequirement :: String

  -- | Source location of the spec item
, 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
, Item a -> Maybe Bool
itemIsParallelizable :: Maybe Bool

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

  -- | Example for behavior
, 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 :: String -> [SpecTree a] -> SpecTree a
specGroup String
s = String -> [SpecTree a] -> SpecTree a
forall c a. String -> [Tree c a] -> Tree c a
Node String
HasCallStack => String
msg
  where
    msg :: HasCallStack => String
    msg :: String
msg
      | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"(no description given)" Maybe String
HasCallStack => Maybe String
defaultDescription
      | Bool
otherwise = String
s

-- | The @specItem@ function creates a spec item.
specItem :: (HasCallStack, Example a) => String -> a -> SpecTree (Arg a)
specItem :: String -> a -> SpecTree (Arg a)
specItem String
s a
e = Item (Arg a) -> SpecTree (Arg a)
forall c a. a -> Tree c a
Leaf (Item (Arg a) -> SpecTree (Arg a))
-> Item (Arg a) -> SpecTree (Arg a)
forall a b. (a -> b) -> a -> b
$ String
-> Maybe Location
-> Maybe Bool
-> Bool
-> (Params
    -> (ActionWith (Arg a) -> IO ()) -> ProgressCallback -> IO Result)
-> Item (Arg a)
forall a.
String
-> Maybe Location
-> Maybe Bool
-> Bool
-> (Params
    -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result)
-> Item a
Item String
HasCallStack => String
requirement Maybe Location
HasCallStack => Maybe Location
location Maybe Bool
forall a. Maybe a
Nothing Bool
False (a
-> Params
-> (ActionWith (Arg a) -> IO ())
-> ProgressCallback
-> IO Result
forall e.
Example e =>
e
-> Params
-> (ActionWith (Arg e) -> IO ())
-> ProgressCallback
-> IO Result
safeEvaluateExample a
e)
  where
    requirement :: HasCallStack => String
    requirement :: String
requirement
      | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"(unspecified behavior)" Maybe String
HasCallStack => Maybe String
defaultDescription
      | Bool
otherwise = String
s

location :: HasCallStack => Maybe Location
location :: Maybe Location
location = case [(String, SrcLoc)] -> [(String, SrcLoc)]
forall a. [a] -> [a]
reverse [(String, SrcLoc)]
HasCallStack => [(String, SrcLoc)]
callStack of
  (String
_, SrcLoc
loc) : [(String, SrcLoc)]
_ -> Location -> Maybe Location
forall a. a -> Maybe a
Just (String -> Int -> Int -> Location
Location (SrcLoc -> String
srcLocFile SrcLoc
loc) (SrcLoc -> Int
srcLocStartLine SrcLoc
loc) (SrcLoc -> Int
srcLocStartCol SrcLoc
loc))
  [(String, SrcLoc)]
_ -> Maybe Location
forall a. Maybe a
Nothing

defaultDescription :: HasCallStack => Maybe String
defaultDescription :: Maybe String
defaultDescription = case [(String, SrcLoc)] -> [(String, SrcLoc)]
forall a. [a] -> [a]
reverse [(String, SrcLoc)]
HasCallStack => [(String, SrcLoc)]
callStack of
  (String
_, SrcLoc
loc) : [(String, SrcLoc)]
_ -> String -> Maybe String
forall a. a -> Maybe a
Just (SrcLoc -> String
srcLocModule SrcLoc
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 (SrcLoc -> Int
srcLocStartLine SrcLoc
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 (SrcLoc -> Int
srcLocStartCol SrcLoc
loc) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]")
  [(String, SrcLoc)]
_ -> Maybe String
forall a. Maybe a
Nothing