Added query functions for parameters

Added "queryP" and "queryP'" to query parameters from SCNode. Moved querying examples to haddock comment in Sound.SC3.Tree module. Couple minor tidy ups.
8c6794b6 · Mar 28, 2014 · 2222f7d · 2222f7d
1 parent 65fcb61
commit 2222f7d
Show file tree

Hide file tree

Showing 5 changed files with 120 additions and 15 deletions.
diff --git a/hsc3-tree/hsc3-tree.cabal b/hsc3-tree/hsc3-tree.cabal
@@ -7,7 +7,7 @@ description:
   declarative style. 'Synth' and 'Group' nodes could be expressed as haskell
   data type, for sending to and receiving from scsynth server.
   .
-  See "Sound.SC3.Tree" for example.
+  See "Sound.SC3.Tree" for examples.
 
 license:             BSD3
 license-file:        LICENSE

diff --git a/hsc3-tree/src/example/tree.hs b/hsc3-tree/src/example/tree.hs
@@ -89,3 +89,27 @@ amp    = control KR "amp" 0.3
 freq   = control KR "freq" 440
 pan    = control KR "pan" 0
 fmod   = control KR "fmod" 0
+
+-- --------------------------------------------------------------------------
+--
+-- Querying example
+--
+-- --------------------------------------------------------------------------
+
+-- | Assuming that 'main' action has executed.
+act05 :: IO ()
+act05 = do
+  n <- withSC3 getRootNode
+  putStrLn $ drawSCNode n
+
+act06 :: IO ()
+act06 = do
+  n <- withSC3 getRootNode
+  let (g10:_) = queryN (nodeId ==? 10) n
+  putStrLn $ drawSCNode g10
+
+act07 :: IO ()
+act07 = do
+  n <- withSC3 getRootNode
+  let fmods = queryN (params (paramName ==? "fmod")) n
+  mapM_ (putStrLn . drawSCNode) fmods
diff --git a/hsc3-tree/src/lib/Sound/SC3/Tree.hs b/hsc3-tree/src/lib/Sound/SC3/Tree.hs
@@ -16,7 +16,10 @@ module Sound.SC3.Tree
     -- $example_interactive
 
     -- ** Routing nodes
-    -- $example_declarative
+    -- $example_routing
+
+    -- ** Querying
+    -- $example_query
 
     -- * Module re-exports
     module Sound.SC3.Tree.Connection
@@ -73,7 +76,7 @@ Doubling the frequencies:
 >>> withSC3 $ patchNode $ everywhere (mkT g) t
 -}
 
-{-$example_declarative
+{-$example_routing
 
 Write node structure and send it to scsynth. \"fmod\" parameters
 in synth \"bar\" are mapped from control rate outputs of synth \"foo\".
@@ -115,3 +118,44 @@ in synth \"bar\" are mapped from control rate outputs of synth \"foo\".
 > fmod = control KR "fmod" 0
 
 -}
+
+{-$example_query
+
+Suppose that we have a 'SCNode' shown in routing example:
+
+>>> n <- withSC3 getRootNode
+>>> putStrLn $ drawSCNode n
+0 group
+   1 group
+      10 group
+         10000 foo
+           amp: 100.0 freq: 0.6600000262260437 out: 100.0
+         10001 foo
+           amp: 80.0 freq: 3.3299999237060547 out: 101.0
+      11 group
+         11000 bar
+           pan: 0.75 amp: 0.10000000149011612 freq: 220.0 fmod: c100 out: 0.0
+         11001 bar
+           pan: -0.75 amp: 0.10000000149011612 freq: 330.0 fmod: c101 out: 0.0
+
+Querying a node in group 10 with 'nodeId' and '==?':
+
+>>> let (g10:_) = queryN (nodeId ==? 10) n
+>>> putStrLn $ drawSCNode g10
+10 group
+   10000 foo
+     amp: 100.0 freq: 0.6600000262260437 out: 100.0
+   10001 foo
+     amp: 80.0 freq: 3.3299999237060547 out: 101.0
+
+Querying nodes with condition to 'SynthParam' with 'params'. Filtering nodes
+containing \"fmod\" parameter:
+
+>>> let fmods = queryN (params (paramName ==? "fmod")) n
+>>> mapM_ (putStrLn . drawSCNode) fmods
+11000 bar
+  pan: 0.75 amp: 0.10000000149011612 freq: 220.0 fmod: c100 out: 0.0
+11001 bar
+  pan: -0.75 amp: 0.10000000149011612 freq: 330.0 fmod: c101 out: 0.0
+
+-}
diff --git a/hsc3-tree/src/lib/Sound/SC3/Tree/Query.hs b/hsc3-tree/src/lib/Sound/SC3/Tree/Query.hs
@@ -10,28 +10,20 @@ Functions to query 'SCNode' with conditions.
 
 -}
 module Sound.SC3.Tree.Query
-    ( -- * Example
-      -- $example
-
-      -- * Querying functions
+    ( -- * Querying functions
       queryN
     , queryN'
+    , queryP
+    , queryP'
       -- * Query builder
     , Condition
     , params, (==?), (/=?), (&&?), (||?)
     ) where
 
-import Data.Generics.Uniplate.Data (universe)
+import Data.Generics.Uniplate.Data (universe, universeBi)
 
 import Sound.SC3.Tree.Type
 
-{-$example
-
-
-
--}
-
-
 -- --------------------------------------------------------------------------
 --
 -- Querying functions
@@ -48,6 +40,16 @@ queryN' p node = case queryN p node of
     (x:_) -> Just x
     _     -> Nothing
 
+-- | Query given 'SCNode' with conditions to parameters, returns 'SynthParam'
+-- satisfying given condition.
+queryP :: Condition SynthParam -> SCNode -> [SynthParam]
+queryP p node = [sp|sp<-universeBi node, p sp]
+
+-- | Variant of 'queryP' returning 'Maybe' value.
+queryP' :: Condition SynthParam -> SCNode -> Maybe SynthParam
+queryP' p node = case queryP p node of
+    (x:_) -> Just x
+    _     -> Nothing
 
 -- --------------------------------------------------------------------------
 --
@@ -99,3 +101,29 @@ liftQ op f v = \x -> f x `op` v
 
 liftQ2 :: (c -> d -> b) -> (a -> c) -> (a -> d) -> a -> b
 liftQ2 op f g v = f v `op` g v
+
+{-
+
+--- Sample data
+
+nodes :: Nd
+nodes =
+  grp 0
+    [grp 1
+      [grp 10
+       [mod1, mod2]
+      ,grp 11
+       [bar1, bar2]]]
+
+mod1, mod2, bar1, bar2 :: Nd
+mod1 = syn "foo" ["out"*=100, "amp"*=100, "freq"*=0.66]
+mod2 = syn "foo" ["out"*=101, "amp"*=80, "freq"*=3.33]
+bar1 = syn "bar" ["amp"*=0.1, "pan"*=0.75, "freq"*=220, "fmod"*<-mod1-*"out"]
+bar2 = syn "bar" ["amp"*=0.1, "pan"*=(-0.75), "freq"*=330, "fmod"*<-mod2-*"out"]
+
+q01 :: Maybe SynthParam
+q01 = do
+    nbar2 <- queryN' (synthName ==? "bar" &&?
+                      params (paramValue ==? 101)) (nodify nodes)
+    queryP' (paramName ==? "pan") nbar2
+-}
diff --git a/hsc3-tree/src/lib/Sound/SC3/Tree/Type.hs b/hsc3-tree/src/lib/Sound/SC3/Tree/Type.hs
@@ -16,6 +16,7 @@ module Sound.SC3.Tree.Type
   , NodeId
   , nodeId
   , synthName
+  , synthParams
   , SynthName
   , SynthParam(..)
   , ParamName
@@ -110,6 +111,12 @@ synthName n = case n of
     Synth _ n' _ -> n'
     _            -> ""
 
+-- | Get 'SynthParam' of given synth node. Returns empty list for group node.
+synthParams :: SCNode -> [SynthParam]
+synthParams n = case n of
+    Synth _ _ ps -> ps
+    _            -> []
+
 -- | Parse osc message returned from \"/g_queryTree\" and returns haskell
 -- representation of scsynth node tree.
 -- Only working with osc message including synth control parameters.
@@ -245,6 +252,8 @@ paramName x = case x of
   (n :<- _) -> n
   (n :<= _) -> n
 
+-- | Converts value of 'SynthParam' to 'Double'. Information of mapped buses
+-- will be lost.
 paramValue :: SynthParam -> Double
 paramValue p = case p of
   _ :=  v -> v