Modified queries returning Maybe value

Stop the iteration when first match is found.
8c6794b6 · May 16, 2014 · 00db2f2 · 00db2f2
1 parent a8a361d
commit 00db2f2
Show file tree

Hide file tree

Showing 2 changed files with 40 additions and 7 deletions.
diff --git a/hsc3-tree/src/lib/Sound/SC3/Tree/Query.hs b/hsc3-tree/src/lib/Sound/SC3/Tree/Query.hs
@@ -45,12 +45,19 @@ queryN p node =
 -- queryN p node = [n|n<-universe node, p n]
 --
 
-
 -- | Variant of 'query' returning 'Maybe' value.
+--
+-- Query will stop with first matching 'SCNode', if any.
+--
 queryN' :: Condition SCNode -> SCNode -> Maybe SCNode
-queryN' p node = case queryN p node of
-    (x:_) -> Just x
-    _     -> Nothing
+queryN' p node =
+    let f x acc =
+            case x of
+                Group _ ns | p x       -> Just x
+                           | otherwise -> foldr f acc ns
+                Synth {}   | p x       -> Just x
+                           | otherwise -> acc
+    in  foldr f Nothing [node]
 
 -- | Query given 'SCNode' with conditions to parameters, returns 'SynthParam'
 -- satisfying given condition.
@@ -65,10 +72,18 @@ queryP cond node =
     in  foldr f [] [node]
 
 -- | Variant of 'queryP' returning 'Maybe' value.
+--
+-- Query will stop with first matching 'SynthParam', if any.
+--
 queryP' :: Condition SynthParam -> SCNode -> Maybe SynthParam
-queryP' p node = case queryP p node of
-    (x:_) -> Just x
-    _     -> Nothing
+queryP' cond node =
+    let f n acc =
+            case n of
+                Group _ ns   -> foldr f acc ns
+                Synth _ _ ps ->
+                    let g p acc' = if cond p then Just p else acc'
+                    in  foldr g acc ps
+    in  foldr f Nothing [node]
 
 
 -- --------------------------------------------------------------------------

diff --git a/hsc3-tree/src/test/Test/Sound/SC3/Tree/Query.hs b/hsc3-tree/src/test/Test/Sound/SC3/Tree/Query.hs
@@ -51,5 +51,23 @@ case_param_fmod = do
   let ns = queryN (params (paramName ==? "fmod")) nodes'
   length ns @?= 2
 
+case_group_11 :: Assertion
+case_group_11 = do
+  let n11       = queryN (nodeId ==? 11) nodes'
+      Just n11' = queryN' (nodeId ==? 11) nodes'
+  head n11 @?= n11'
+
+case_param_freqs :: Assertion
+case_param_freqs = do
+  let foos = queryN (synthName ==? "foo") nodes'
+      ps   = map (queryP (paramName ==? "freq")) foos
+  concat ps @?= ["freq":=0.66,"freq":=3.33]
+
+case_param_first_freq :: Assertion
+case_param_first_freq = do
+  let Just foo = queryN' (synthName ==? "foo") nodes'
+      p        = queryP' (paramName ==? "freq") foo
+  p @?= Just ("freq":=0.66)
+
 tests :: TestTree
 tests = $testGroupGenerator