{-# 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 (a -> SpecTree b -> SpecTree a
(a -> b) -> SpecTree a -> SpecTree b
(forall a b. (a -> b) -> SpecTree a -> SpecTree b)
-> (forall a b. a -> SpecTree b -> SpecTree a) -> Functor SpecTree
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
<$ :: a -> SpecTree b -> SpecTree a
$c<$ :: forall a b. a -> SpecTree b -> SpecTree a
fmap :: (a -> b) -> SpecTree a -> SpecTree b
$cfmap :: forall a b. (a -> b) -> SpecTree a -> SpecTree b
Functor)

instance Foldable SpecTree where
  foldMap :: (a -> m) -> SpecTree a -> m
foldMap a -> m
f = \case
    SpecifyNode Text
_ a
a -> a -> m
f a
a
    PendingNode Text
_ Maybe Text
_ -> m
forall a. Monoid a => a
mempty
    DescribeNode Text
_ SpecForest a
sts -> (SpecTree a -> m) -> SpecForest a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> SpecTree a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) SpecForest a
sts
    SubForestNode SpecForest a
sts -> (SpecTree a -> m) -> SpecForest a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> SpecTree a -> m
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 :: (a -> f b) -> SpecTree a -> f (SpecTree b)
traverse a -> f b
func = \case
    SpecifyNode Text
s a
a -> Text -> b -> SpecTree b
forall a. Text -> a -> SpecTree a
SpecifyNode Text
s (b -> SpecTree b) -> f b -> f (SpecTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
func a
a
    PendingNode Text
t Maybe Text
mr -> SpecTree b -> f (SpecTree b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SpecTree b -> f (SpecTree b)) -> SpecTree b -> f (SpecTree b)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> SpecTree b
forall a. Text -> Maybe Text -> SpecTree a
PendingNode Text
t Maybe Text
mr
    DescribeNode Text
s SpecForest a
sf -> Text -> SpecForest b -> SpecTree b
forall a. Text -> SpecForest a -> SpecTree a
DescribeNode Text
s (SpecForest b -> SpecTree b) -> f (SpecForest b) -> f (SpecTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SpecTree a -> f (SpecTree b)) -> SpecForest a -> f (SpecForest b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f b) -> SpecTree a -> f (SpecTree b)
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 -> SpecForest b -> SpecTree b
forall a. SpecForest a -> SpecTree a
SubForestNode (SpecForest b -> SpecTree b) -> f (SpecForest b) -> f (SpecTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SpecTree a -> f (SpecTree b)) -> SpecForest a -> f (SpecForest b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f b) -> SpecTree a -> f (SpecTree b)
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 :: SpecForest a -> [([Text], a)]
flattenSpecForest = (SpecTree a -> [([Text], a)]) -> SpecForest a -> [([Text], a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SpecTree a -> [([Text], a)]
forall a. SpecTree a -> [([Text], a)]
flattenSpecTree

flattenSpecTree :: SpecTree a -> [([Text], a)]
flattenSpecTree :: 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 -> (([Text], a) -> ([Text], a)) -> [([Text], a)] -> [([Text], a)]
forall a b. (a -> b) -> [a] -> [b]
map (\([Text]
ts, a
a) -> (Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ts, a
a)) ([([Text], a)] -> [([Text], a)]) -> [([Text], a)] -> [([Text], a)]
forall a b. (a -> b) -> a -> b
$ SpecForest a -> [([Text], a)]
forall a. SpecForest a -> [([Text], a)]
flattenSpecForest SpecForest a
sf
  SubForestNode SpecForest a
sf -> SpecForest a -> [([Text], a)]
forall a. SpecForest a -> [([Text], a)]
flattenSpecForest SpecForest a
sf