{-# 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
) where

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

import           Data.CallStack (HasCallStack, SrcLoc(..))
import qualified Data.CallStack as CallStack
import           Data.Maybe

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
/= :: 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
[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, 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 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 :: (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 Maybe (String, Location)
loc a
cleanup [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
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)

filterTree :: (a -> Bool) -> Tree c a -> Maybe (Tree c a)
filterTree :: (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 :: (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 :: ([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 :: ([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_ :: [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_ :: [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 :: [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 :: 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 (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
  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 = (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 :: Maybe (String, Location)
callSite = (SrcLoc -> Location) -> (String, SrcLoc) -> (String, Location)
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

defaultDescription :: HasCallStack => Maybe String
defaultDescription :: Maybe String
defaultDescription = case Maybe (String, SrcLoc)
HasCallStack => Maybe (String, SrcLoc)
CallStack.callSite of
  Just (String
_, SrcLoc
loc) -> 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
"]")
  Maybe (String, SrcLoc)
Nothing -> Maybe String
forall a. Maybe a
Nothing

toLocation :: SrcLoc -> Location
toLocation :: SrcLoc -> Location
toLocation SrcLoc
loc = String -> Int -> Int -> Location
Location (SrcLoc -> String
srcLocFile SrcLoc
loc) (SrcLoc -> Int
srcLocStartLine SrcLoc
loc) (SrcLoc -> Int
srcLocStartCol SrcLoc
loc)