{-# 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 -- A test with its description
  | PendingNode Text (Maybe Text)
  | DescribeNode Text (SpecForest a) -- A description
  | SubForestNode (SpecForest a) -- A test with its description
  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