{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
module Test.Syd.SpecForest where
import Data.Text (Text)
import Test.QuickCheck.IO ()
type SpecForest a = [SpecTree a]
data SpecTree a
= SpecifyNode Text a
| PendingNode Text (Maybe Text)
| DescribeNode Text (SpecForest a)
| SubForestNode (SpecForest a)
deriving (forall a b. a -> SpecTree b -> SpecTree a
forall a b. (a -> b) -> SpecTree a -> SpecTree 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 -> SpecTree b -> SpecTree a
$c<$ :: forall a b. a -> SpecTree b -> SpecTree a
fmap :: forall a b. (a -> b) -> SpecTree a -> SpecTree b
$cfmap :: forall a b. (a -> b) -> SpecTree a -> SpecTree b
Functor)
instance Foldable SpecTree where
foldMap :: forall m a. Monoid m => (a -> m) -> SpecTree a -> m
foldMap a -> m
f = \case
SpecifyNode Text
_ a
a -> a -> m
f a
a
PendingNode Text
_ Maybe Text
_ -> forall a. Monoid a => a
mempty
DescribeNode Text
_ SpecForest a
sts -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) SpecForest a
sts
SubForestNode SpecForest a
sts -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) SpecForest a
sts
instance Traversable SpecTree where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SpecTree a -> f (SpecTree b)
traverse a -> f b
func = \case
SpecifyNode Text
s a
a -> forall a. Text -> a -> SpecTree a
SpecifyNode Text
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
func a
a
PendingNode Text
t Maybe Text
mr -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Text -> Maybe Text -> SpecTree a
PendingNode Text
t Maybe Text
mr
DescribeNode Text
s SpecForest a
sf -> forall a. Text -> SpecForest a -> SpecTree a
DescribeNode Text
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
func) SpecForest a
sf
SubForestNode SpecForest a
sf -> forall a. SpecForest a -> SpecTree a
SubForestNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
func) SpecForest a
sf
flattenSpecForest :: SpecForest a -> [([Text], a)]
flattenSpecForest :: forall a. SpecForest a -> [([Text], a)]
flattenSpecForest = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. SpecTree a -> [([Text], a)]
flattenSpecTree
flattenSpecTree :: SpecTree a -> [([Text], a)]
flattenSpecTree :: forall a. SpecTree a -> [([Text], a)]
flattenSpecTree = \case
SpecifyNode Text
t a
a -> [([Text
t], a
a)]
PendingNode Text
_ Maybe Text
_ -> []
DescribeNode Text
t SpecForest a
sf ->
forall a b. (a -> b) -> [a] -> [b]
map (\([Text]
ts, a
a) -> (Text
t forall a. a -> [a] -> [a]
: [Text]
ts, a
a)) forall a b. (a -> b) -> a -> b
$
forall a. SpecForest a -> [([Text], a)]
flattenSpecForest SpecForest a
sf
SubForestNode SpecForest a
sf -> forall a. SpecForest a -> [([Text], a)]
flattenSpecForest SpecForest a
sf