-
Notifications
You must be signed in to change notification settings - Fork 47
/
Tree.purs
133 lines (111 loc) · 4.52 KB
/
Tree.purs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
module Test.Spec.Tree
( Tree(..)
, Item(..)
, ActionWith
, bimapTree
, countTests
, isAllParallelizable
, discardUnfocused
, modifyAroundAction
, PathItem(..)
, Path
, parentSuiteName
, parentSuite
) where
import Prelude
import Control.Monad.State (execState)
import Control.Monad.State as State
import Data.Array (mapMaybe, snoc)
import Data.Array.NonEmpty (NonEmptyArray)
import Data.Array.NonEmpty as NEA
import Data.Bifunctor (class Bifunctor)
import Data.Either (Either, either)
import Data.Foldable (class Foldable, all, foldMapDefaultL, foldl, foldr)
import Data.Maybe (Maybe(..), maybe)
import Data.Newtype (class Newtype, un)
import Data.Traversable (for, for_)
data Tree c a
= Node (Either String c) (Array (Tree c a))
| Leaf String (Maybe a)
instance showGroup :: (Show c, Show a) => Show (Tree c a) where
show (Node nc xs) = "(Node " <> show nc <> " " <> show xs <> ")"
show (Leaf name t) = "(Leaf " <> show name <> " " <> show t <> ")"
instance eqGroup :: (Eq c, Eq a) => Eq (Tree c a) where
eq (Node nc1 xs1) (Node nc2 xs2) = nc1 == nc2 && xs1 == xs2
eq (Leaf n1 t1) (Leaf n2 t2) = n1 == n2 && t1 == t2
eq _ _ = false
bimapTree :: forall a b c d. (Array String -> a -> b) -> (NonEmptyArray String -> c -> d) -> Tree a c -> Tree b d
bimapTree g f = go []
where
go :: Array String -> Tree a c -> Tree b d
go namePath spec = case spec of
Node d xs ->
let
namePath' = either (snoc namePath) (const namePath) d
in
Node (map (g namePath') d) (map (go namePath') xs)
Leaf n item -> Leaf n (map (f $ NEA.snoc' namePath n) item)
instance treeBifunctor :: Bifunctor Tree where
bimap g f = bimapTree (const g) (const f)
instance treeFoldable :: Foldable (Tree c) where
foldr f i (Leaf _ a) = maybe i (\a' -> f a' i) a
foldr f i (Node _ as) = foldr (\a i' -> foldr f i' a) i as
foldl f i (Leaf _ a) = maybe i (\a' -> f i a') a
foldl f i (Node _ as) = foldl (\i' a -> foldl f i' a) i as
foldMap f = foldMapDefaultL f
type ActionWith m a = a -> m Unit
newtype Item m a = Item
{ isFocused :: Boolean
, isParallelizable :: Maybe Boolean
, example :: (ActionWith m a -> m Unit) -> m Unit
}
derive instance itemNewtype :: Newtype (Item m a) _
instance itemShow :: Show (Item m a) where
show (Item { isFocused, isParallelizable }) =
"Item (" <> show { isFocused, isParallelizable, example: "Function" } <> ")"
instance itemEq :: Eq (Item m a) where
eq (Item a) (Item b) =
a.isFocused == b.isFocused && a.isParallelizable == b.isParallelizable
-- | Count the total number of tests in a spec
countTests :: forall c t. Array (Tree c t) -> Int
countTests g = execState (for g go) 0
where
go (Node _ xs) = for_ xs go
go (Leaf _ _) = State.modify_ (_ + 1)
-- | Return true if all items in the tree are parallelizable
isAllParallelizable :: forall c m a. Tree c (Item m a) -> Boolean
isAllParallelizable = case _ of
Node _ xs -> all isAllParallelizable xs
Leaf _ x -> x == Nothing || (x >>= un Item >>> _.isParallelizable) == Just true
-- | If there is at least one focused element, all paths which don't
-- | lead to a focused element will be remove. otherwise input will
-- | be returned as unchanged.
discardUnfocused :: forall c m a. Array (Tree c (Item m a)) -> Array (Tree c (Item m a))
discardUnfocused ts = case mapMaybe findFocus ts of
[] -> ts
r -> r
where
findFocus :: Tree c (Item m a) -> Maybe (Tree c (Item m a))
findFocus (Node n ts') = case mapMaybe findFocus ts' of
[] -> Nothing
r -> Just $ Node n r
findFocus t@(Leaf _ (Just (Item { isFocused }))) = if isFocused then Just t else Nothing
findFocus (Leaf _ Nothing) = Nothing
-- | Modify around action of an Item
modifyAroundAction :: forall g a b. (ActionWith g a -> ActionWith g b) -> Item g a -> Item g b
modifyAroundAction action (Item item) = Item $ item
{ example = \aroundAction -> item.example (aroundAction <<< action)
}
newtype PathItem = PathItem { index :: Int, name :: Maybe String }
derive instance newtypePathItem :: Newtype PathItem _
derive newtype instance showIdTerm :: Show PathItem
derive newtype instance pathItemEq :: Eq PathItem
derive newtype instance pathItemOrd :: Ord PathItem
type Path = Array PathItem
parentSuiteName :: Path -> Array String
parentSuiteName = mapMaybe (un PathItem >>> _.name)
parentSuite :: Path -> Maybe { path :: Path, name :: String }
parentSuite = flip foldr Nothing case _, _ of
PathItem { name: Just name }, Nothing -> Just { path: [], name }
PathItem { name: Nothing }, Nothing -> Nothing
p, Just acc -> Just acc { path = [ p ] <> acc.path }