{- | 'U_Graph' and related types.

The UGen type is recursive, inputs to UGens are UGens.

This makes writing UGen graphs simple, but manipulating them awkward.

UGen equality is structural, and can be slow to determine for some UGen graph structures.

A U_Node is a non-recursive notation for a UGen, all U_Nodes have unique identifiers.

A U_Graph is constructed by a stateful traversal of a UGen.

A U_Graph is represented as a partioned (by type) set of U_Nodes, edges are implicit.

-}
module Sound.SC3.UGen.Graph where

import Data.Function {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}

import Sound.SC3.Common.Rate {- hsc3 -}
import Sound.SC3.UGen.Type {- hsc3 -}
import Sound.SC3.UGen.UGen {- hsc3 -}

import qualified Sound.SC3.UGen.Analysis as Analysis {- hsc3 -}

-- * Types

-- | Port index.
type Port_Index = Int

-- | Type to represent the left hand side of an edge in a unit generator graph.
data From_Port = From_Port_C {From_Port -> UID_t
from_port_nid :: UID_t}
               | From_Port_K {from_port_nid :: UID_t,From_Port -> K_Type
from_port_kt :: K_Type}
               | From_Port_U {from_port_nid :: UID_t,From_Port -> Maybe UID_t
from_port_idx :: Maybe Port_Index}
               deriving (From_Port -> From_Port -> Bool
(From_Port -> From_Port -> Bool)
-> (From_Port -> From_Port -> Bool) -> Eq From_Port
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: From_Port -> From_Port -> Bool
$c/= :: From_Port -> From_Port -> Bool
== :: From_Port -> From_Port -> Bool
$c== :: From_Port -> From_Port -> Bool
Eq,UID_t -> From_Port -> ShowS
[From_Port] -> ShowS
From_Port -> String
(UID_t -> From_Port -> ShowS)
-> (From_Port -> String)
-> ([From_Port] -> ShowS)
-> Show From_Port
forall a.
(UID_t -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [From_Port] -> ShowS
$cshowList :: [From_Port] -> ShowS
show :: From_Port -> String
$cshow :: From_Port -> String
showsPrec :: UID_t -> From_Port -> ShowS
$cshowsPrec :: UID_t -> From_Port -> ShowS
Show)

-- | A destination port.
data To_Port = To_Port {To_Port -> UID_t
to_port_nid :: UID_t,To_Port -> UID_t
to_port_idx :: Port_Index}
             deriving (To_Port -> To_Port -> Bool
(To_Port -> To_Port -> Bool)
-> (To_Port -> To_Port -> Bool) -> Eq To_Port
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: To_Port -> To_Port -> Bool
$c/= :: To_Port -> To_Port -> Bool
== :: To_Port -> To_Port -> Bool
$c== :: To_Port -> To_Port -> Bool
Eq,UID_t -> To_Port -> ShowS
[To_Port] -> ShowS
To_Port -> String
(UID_t -> To_Port -> ShowS)
-> (To_Port -> String) -> ([To_Port] -> ShowS) -> Show To_Port
forall a.
(UID_t -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [To_Port] -> ShowS
$cshowList :: [To_Port] -> ShowS
show :: To_Port -> String
$cshow :: To_Port -> String
showsPrec :: UID_t -> To_Port -> ShowS
$cshowsPrec :: UID_t -> To_Port -> ShowS
Show)

-- | A connection from 'From_Port' to 'To_Port'.
type U_Edge = (From_Port,To_Port)

-- | Sum-type to represent nodes in unit generator graph.
--   _C = constant, _K = control, _U = ugen, _P = proxy.
data U_Node = U_Node_C {U_Node -> UID_t
u_node_id :: UID_t
                       ,U_Node -> Sample
u_node_c_value :: Sample}
            | U_Node_K {u_node_id :: UID_t
                       ,U_Node -> Rate
u_node_k_rate :: Rate
                       ,U_Node -> Maybe UID_t
u_node_k_index :: Maybe Int
                       ,U_Node -> String
u_node_k_name :: String
                       ,U_Node -> Sample
u_node_k_default :: Sample
                       ,U_Node -> K_Type
u_node_k_type :: K_Type
                       ,U_Node -> Maybe (Control_Meta Sample)
u_node_k_meta :: Maybe (Control_Meta Sample)}
            | U_Node_U {u_node_id :: UID_t
                       ,U_Node -> Rate
u_node_u_rate :: Rate
                       ,U_Node -> String
u_node_u_name :: String
                       ,U_Node -> [From_Port]
u_node_u_inputs :: [From_Port]
                       ,U_Node -> [Rate]
u_node_u_outputs :: [Output]
                       ,U_Node -> Special
u_node_u_special :: Special
                       ,U_Node -> UGenId
u_node_u_ugenid :: UGenId}
            | U_Node_P {u_node_id :: UID_t
                       ,U_Node -> U_Node
u_node_p_node :: U_Node
                       ,U_Node -> UID_t
u_node_p_index :: Port_Index}
            deriving (U_Node -> U_Node -> Bool
(U_Node -> U_Node -> Bool)
-> (U_Node -> U_Node -> Bool) -> Eq U_Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: U_Node -> U_Node -> Bool
$c/= :: U_Node -> U_Node -> Bool
== :: U_Node -> U_Node -> Bool
$c== :: U_Node -> U_Node -> Bool
Eq,UID_t -> U_Node -> ShowS
[U_Node] -> ShowS
U_Node -> String
(UID_t -> U_Node -> ShowS)
-> (U_Node -> String) -> ([U_Node] -> ShowS) -> Show U_Node
forall a.
(UID_t -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [U_Node] -> ShowS
$cshowList :: [U_Node] -> ShowS
show :: U_Node -> String
$cshow :: U_Node -> String
showsPrec :: UID_t -> U_Node -> ShowS
$cshowsPrec :: UID_t -> U_Node -> ShowS
Show)

-- | Convert from U_Node_K to Control (ie. discard index).
u_node_k_to_control :: U_Node -> Control
u_node_k_to_control :: U_Node -> Control
u_node_k_to_control U_Node
nd =
  case U_Node
nd of
    U_Node_K UID_t
_ Rate
rt Maybe UID_t
ix String
nm Sample
df K_Type
ty Maybe (Control_Meta Sample)
mt -> Rate
-> Maybe UID_t
-> String
-> Sample
-> Bool
-> Maybe (Control_Meta Sample)
-> Control
Control Rate
rt Maybe UID_t
ix String
nm Sample
df (K_Type
ty K_Type -> K_Type -> Bool
forall a. Eq a => a -> a -> Bool
== K_Type
K_TR) Maybe (Control_Meta Sample)
mt
    U_Node
_ -> String -> Control
forall a. HasCallStack => String -> a
error String
"u_node_k_to_control?"

-- | Derive "user" name for U_Node
u_node_user_name :: U_Node -> String
u_node_user_name :: U_Node -> String
u_node_user_name U_Node
n = String -> Special -> String
ugen_user_name (U_Node -> String
u_node_u_name U_Node
n) (U_Node -> Special
u_node_u_special U_Node
n)

-- | Type to represent a unit generator graph.
data U_Graph = U_Graph {U_Graph -> UID_t
ug_next_id :: UID_t
                       ,U_Graph -> [U_Node]
ug_constants :: [U_Node]
                       ,U_Graph -> [U_Node]
ug_controls :: [U_Node]
                       ,U_Graph -> [U_Node]
ug_ugens :: [U_Node]}
             deriving (UID_t -> U_Graph -> ShowS
[U_Graph] -> ShowS
U_Graph -> String
(UID_t -> U_Graph -> ShowS)
-> (U_Graph -> String) -> ([U_Graph] -> ShowS) -> Show U_Graph
forall a.
(UID_t -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [U_Graph] -> ShowS
$cshowList :: [U_Graph] -> ShowS
show :: U_Graph -> String
$cshow :: U_Graph -> String
showsPrec :: UID_t -> U_Graph -> ShowS
$cshowsPrec :: UID_t -> U_Graph -> ShowS
Show)

-- * Ports

-- | Get 'port_idx' for 'From_Port_U', else @0@.
port_idx_or_zero :: From_Port -> Port_Index
port_idx_or_zero :: From_Port -> UID_t
port_idx_or_zero From_Port
p =
    case From_Port
p of
      From_Port_U UID_t
_ (Just UID_t
x) -> UID_t
x
      From_Port
_ -> UID_t
0

-- | Is 'From_Port' 'From_Port_U'.
is_from_port_u :: From_Port -> Bool
is_from_port_u :: From_Port -> Bool
is_from_port_u From_Port
p =
    case From_Port
p of
      From_Port_U UID_t
_ Maybe UID_t
_ -> Bool
True
      From_Port
_ -> Bool
False

-- * Nodes

-- | Is 'U_Node' a /constant/.
is_u_node_c :: U_Node -> Bool
is_u_node_c :: U_Node -> Bool
is_u_node_c U_Node
n =
    case U_Node
n of
      U_Node_C UID_t
_ Sample
_ -> Bool
True
      U_Node
_ -> Bool
False

-- | Predicate to determine if 'U_Node' is a constant with indicated /value/.
is_u_node_c_of :: Sample -> U_Node -> Bool
is_u_node_c_of :: Sample -> U_Node -> Bool
is_u_node_c_of Sample
x U_Node
n =
    case U_Node
n of
      U_Node_C UID_t
_ Sample
y -> Sample
x Sample -> Sample -> Bool
forall a. Eq a => a -> a -> Bool
== Sample
y
      U_Node
_ -> String -> Bool
forall a. HasCallStack => String -> a
error String
"is_u_node_c_of: non U_Node_C"

-- | Is 'U_Node' a /control/.
is_u_node_k :: U_Node -> Bool
is_u_node_k :: U_Node -> Bool
is_u_node_k U_Node
n =
    case U_Node
n of
      U_Node_K {} -> Bool
True
      U_Node
_ -> Bool
False

-- | Predicate to determine if 'U_Node' is a control with indicated
-- /name/.  Names must be unique.
is_u_node_k_of :: String -> U_Node -> Bool
is_u_node_k_of :: String -> U_Node -> Bool
is_u_node_k_of String
x U_Node
n =
    case U_Node
n of
      U_Node_K UID_t
_ Rate
_ Maybe UID_t
_ String
y Sample
_ K_Type
_ Maybe (Control_Meta Sample)
_ -> String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
y
      U_Node
_ -> String -> Bool
forall a. HasCallStack => String -> a
error String
"is_u_node_k_of"

-- | Is 'U_Node' a /UGen/.
is_u_node_u :: U_Node -> Bool
is_u_node_u :: U_Node -> Bool
is_u_node_u U_Node
n =
    case U_Node
n of
      U_Node_U {} -> Bool
True
      U_Node
_ -> Bool
False

-- | Compare 'U_Node_K' values 'on' 'u_node_k_type'.
u_node_k_cmp :: U_Node -> U_Node -> Ordering
u_node_k_cmp :: U_Node -> U_Node -> Ordering
u_node_k_cmp = K_Type -> K_Type -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (K_Type -> K_Type -> Ordering)
-> (U_Node -> K_Type) -> U_Node -> U_Node -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` U_Node -> K_Type
u_node_k_type

-- | Sort by 'u_node_id'.
u_node_sort :: [U_Node] -> [U_Node]
u_node_sort :: [U_Node] -> [U_Node]
u_node_sort = (U_Node -> U_Node -> Ordering) -> [U_Node] -> [U_Node]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (UID_t -> UID_t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (UID_t -> UID_t -> Ordering)
-> (U_Node -> UID_t) -> U_Node -> U_Node -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` U_Node -> UID_t
u_node_id)

-- | Equality test, error if not U_Node_K.
u_node_k_eq :: U_Node -> U_Node -> Bool
u_node_k_eq :: U_Node -> U_Node -> Bool
u_node_k_eq U_Node
p U_Node
q =
  if U_Node -> Bool
is_u_node_k U_Node
p Bool -> Bool -> Bool
&& U_Node -> Bool
is_u_node_k U_Node
q
  then U_Node
p U_Node -> U_Node -> Bool
forall a. Eq a => a -> a -> Bool
== U_Node
q
  else String -> Bool
forall a. HasCallStack => String -> a
error String
"u_node_k_eq? not U_Node_K"

-- | 'Rate' of 'U_Node', ie. 'IR' for constants & see through 'U_Node_P'.
u_node_rate :: U_Node -> Rate
u_node_rate :: U_Node -> Rate
u_node_rate U_Node
n =
    case U_Node
n of
      U_Node_C {} -> Rate
IR
      U_Node_K {} -> U_Node -> Rate
u_node_k_rate U_Node
n
      U_Node_U {} -> U_Node -> Rate
u_node_u_rate U_Node
n
      U_Node_P UID_t
_ U_Node
n' UID_t
_ -> U_Node -> Rate
u_node_rate U_Node
n'

-- | Generate a label for 'U_Node' using the /type/ and the 'u_node_id'.
u_node_label :: U_Node -> String
u_node_label :: U_Node -> String
u_node_label U_Node
nd =
    case U_Node
nd of
      U_Node_C UID_t
n Sample
_ -> String
"c_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UID_t -> String
forall a. Show a => a -> String
show UID_t
n
      U_Node_K UID_t
n Rate
_ Maybe UID_t
_ String
_ Sample
_ K_Type
_ Maybe (Control_Meta Sample)
_ -> String
"k_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UID_t -> String
forall a. Show a => a -> String
show UID_t
n
      U_Node_U UID_t
n Rate
_ String
_ [From_Port]
_ [Rate]
_ Special
_ UGenId
_ -> String
"u_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UID_t -> String
forall a. Show a => a -> String
show UID_t
n
      U_Node_P UID_t
n U_Node
_ UID_t
_ -> String
"p_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UID_t -> String
forall a. Show a => a -> String
show UID_t
n

-- | Calculate all in edges for a 'U_Node_U'.
u_node_in_edges :: U_Node -> [U_Edge]
u_node_in_edges :: U_Node -> [U_Edge]
u_node_in_edges U_Node
n =
    case U_Node
n of
      U_Node_U UID_t
x Rate
_ String
_ [From_Port]
i [Rate]
_ Special
_ UGenId
_ -> [From_Port] -> [To_Port] -> [U_Edge]
forall a b. [a] -> [b] -> [(a, b)]
zip [From_Port]
i ((UID_t -> To_Port) -> [UID_t] -> [To_Port]
forall a b. (a -> b) -> [a] -> [b]
map (UID_t -> UID_t -> To_Port
To_Port UID_t
x) [UID_t
0..])
      U_Node
_ -> String -> [U_Edge]
forall a. HasCallStack => String -> a
error String
"u_node_in_edges: non U_Node_U input node"

-- | Transform 'U_Node' to 'From_Port'.
u_node_from_port :: U_Node -> From_Port
u_node_from_port :: U_Node -> From_Port
u_node_from_port U_Node
d =
    case U_Node
d of
      U_Node_C UID_t
n Sample
_ -> UID_t -> From_Port
From_Port_C UID_t
n
      U_Node_K UID_t
n Rate
_ Maybe UID_t
_ String
_ Sample
_ K_Type
t Maybe (Control_Meta Sample)
_ -> UID_t -> K_Type -> From_Port
From_Port_K UID_t
n K_Type
t
      U_Node_U UID_t
n Rate
_ String
_ [From_Port]
_ [Rate]
o Special
_ UGenId
_ ->
          case [Rate]
o of
            [Rate
_] -> UID_t -> Maybe UID_t -> From_Port
From_Port_U UID_t
n Maybe UID_t
forall a. Maybe a
Nothing
            [Rate]
_ -> String -> From_Port
forall a. HasCallStack => String -> a
error ((String, U_Node) -> String
forall a. Show a => a -> String
show (String
"u_node_from_port: non unary U_Node_U",U_Node
d))
      U_Node_P UID_t
_ U_Node
u UID_t
p -> UID_t -> Maybe UID_t -> From_Port
From_Port_U (U_Node -> UID_t
u_node_id U_Node
u) (UID_t -> Maybe UID_t
forall a. a -> Maybe a
Just UID_t
p)

-- | If controls have been given indices they must be coherent.
u_node_sort_controls :: [U_Node] -> [U_Node]
u_node_sort_controls :: [U_Node] -> [U_Node]
u_node_sort_controls [U_Node]
c =
    let u_node_k_ix :: U_Node -> UID_t
u_node_k_ix U_Node
n = UID_t -> Maybe UID_t -> UID_t
forall a. a -> Maybe a -> a
fromMaybe UID_t
forall a. Bounded a => a
maxBound (U_Node -> Maybe UID_t
u_node_k_index U_Node
n)
        cmp :: U_Node -> U_Node -> Ordering
cmp = UID_t -> UID_t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (UID_t -> UID_t -> Ordering)
-> (U_Node -> UID_t) -> U_Node -> U_Node -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` U_Node -> UID_t
u_node_k_ix
        c' :: [U_Node]
c' = (U_Node -> U_Node -> Ordering) -> [U_Node] -> [U_Node]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy U_Node -> U_Node -> Ordering
cmp [U_Node]
c
        coheres :: UID_t -> U_Node -> Bool
coheres UID_t
z = Bool -> (UID_t -> Bool) -> Maybe UID_t -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (UID_t -> UID_t -> Bool
forall a. Eq a => a -> a -> Bool
== UID_t
z) (Maybe UID_t -> Bool) -> (U_Node -> Maybe UID_t) -> U_Node -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U_Node -> Maybe UID_t
u_node_k_index
        coherent :: Bool
coherent = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((UID_t -> U_Node -> Bool) -> [UID_t] -> [U_Node] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith UID_t -> U_Node -> Bool
coheres [UID_t
0..] [U_Node]
c')
    in if Bool
coherent then [U_Node]
c' else String -> [U_Node]
forall a. HasCallStack => String -> a
error ((String, [U_Node]) -> String
forall a. Show a => a -> String
show (String
"u_node_sort_controls: incoherent",[U_Node]
c))

-- | Determine 'K_Type' of a /control/ UGen at 'U_Node_U', or not.
u_node_ktype :: U_Node -> Maybe K_Type
u_node_ktype :: U_Node -> Maybe K_Type
u_node_ktype U_Node
n =
    case (U_Node -> String
u_node_u_name U_Node
n,U_Node -> Rate
u_node_u_rate U_Node
n) of
      (String
"Control",Rate
IR) -> K_Type -> Maybe K_Type
forall a. a -> Maybe a
Just K_Type
K_IR
      (String
"Control",Rate
KR) -> K_Type -> Maybe K_Type
forall a. a -> Maybe a
Just K_Type
K_KR
      (String
"TrigControl",Rate
KR) -> K_Type -> Maybe K_Type
forall a. a -> Maybe a
Just K_Type
K_TR
      (String
"AudioControl",Rate
AR) -> K_Type -> Maybe K_Type
forall a. a -> Maybe a
Just K_Type
K_AR
      (String, Rate)
_ -> Maybe K_Type
forall a. Maybe a
Nothing

-- | Is 'U_Node' a control UGen?
u_node_is_control :: U_Node -> Bool
u_node_is_control :: U_Node -> Bool
u_node_is_control U_Node
n =
    let cs :: [String]
cs = [String
"AudioControl",String
"Control",String
"TrigControl"]
    in case U_Node
n of
        U_Node_U UID_t
_ Rate
_ String
s [From_Port]
_ [Rate]
_ Special
_ UGenId
_ -> String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
cs
        U_Node
_ -> Bool
False

-- | Is 'U_Node' an /implicit/ control UGen?
u_node_is_implicit_control :: U_Node -> Bool
u_node_is_implicit_control :: U_Node -> Bool
u_node_is_implicit_control U_Node
n = U_Node -> Bool
u_node_is_control U_Node
n Bool -> Bool -> Bool
&& U_Node -> UID_t
u_node_id U_Node
n UID_t -> UID_t -> Bool
forall a. Eq a => a -> a -> Bool
== -UID_t
1

-- | Is U_Node implicit?
u_node_is_implicit :: U_Node -> Bool
u_node_is_implicit :: U_Node -> Bool
u_node_is_implicit U_Node
n = U_Node -> String
u_node_u_name U_Node
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"MaxLocalBufs" Bool -> Bool -> Bool
|| U_Node -> Bool
u_node_is_implicit_control U_Node
n

-- | Zero if no local buffers, or if maxLocalBufs is given.
u_node_localbuf_count :: [U_Node] -> Int
u_node_localbuf_count :: [U_Node] -> UID_t
u_node_localbuf_count [U_Node]
us =
    case (U_Node -> Bool) -> [U_Node] -> Maybe U_Node
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) String
"MaxLocalBufs" (String -> Bool) -> (U_Node -> String) -> U_Node -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U_Node -> String
u_node_u_name) [U_Node]
us of
      Maybe U_Node
Nothing -> [U_Node] -> UID_t
forall (t :: * -> *) a. Foldable t => t a -> UID_t
length ((U_Node -> Bool) -> [U_Node] -> [U_Node]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) String
"LocalBuf" (String -> Bool) -> (U_Node -> String) -> U_Node -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U_Node -> String
u_node_u_name) [U_Node]
us)
      Just U_Node
_ -> UID_t
0

-- | Controls are a special case.  We need to know not the overall
-- index but the index in relation to controls of the same type.
u_node_fetch_k :: UID_t -> K_Type -> [U_Node] -> Int
u_node_fetch_k :: UID_t -> K_Type -> [U_Node] -> UID_t
u_node_fetch_k UID_t
z K_Type
t =
    let recur :: t -> [U_Node] -> t
recur t
i [U_Node]
ns =
            case [U_Node]
ns of
              [] -> String -> t
forall a. HasCallStack => String -> a
error String
"u_node_fetch_k"
              U_Node
n:[U_Node]
ns' -> if UID_t
z UID_t -> UID_t -> Bool
forall a. Eq a => a -> a -> Bool
== U_Node -> UID_t
u_node_id U_Node
n
                       then t
i
                       else if K_Type
t K_Type -> K_Type -> Bool
forall a. Eq a => a -> a -> Bool
== U_Node -> K_Type
u_node_k_type U_Node
n
                            then t -> [U_Node] -> t
recur (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) [U_Node]
ns'
                            else t -> [U_Node] -> t
recur t
i [U_Node]
ns'
    in UID_t -> [U_Node] -> UID_t
forall t. Num t => t -> [U_Node] -> t
recur UID_t
0

-- | All the elements of a U_Node_U, except the u_node_id.
type U_Node_NOID = (Rate,String,[From_Port],[Output],Special,UGenId)

-- | Predicate to locate primitive, names must be unique.
u_node_eq_noid :: U_Node_NOID -> U_Node -> Bool
u_node_eq_noid :: U_Node_NOID -> U_Node -> Bool
u_node_eq_noid U_Node_NOID
x U_Node
nd =
    case U_Node
nd of
      U_Node_U UID_t
_ Rate
r String
n [From_Port]
i [Rate]
o Special
s UGenId
d -> (Rate
r,String
n,[From_Port]
i,[Rate]
o,Special
s,UGenId
d) U_Node_NOID -> U_Node_NOID -> Bool
forall a. Eq a => a -> a -> Bool
== U_Node_NOID
x
      U_Node
_ ->  String -> Bool
forall a. HasCallStack => String -> a
error String
"u_node_eq_noid"

-- | Make map associating 'K_Type' with UGen index.
u_node_mk_ktype_map :: [U_Node] -> [(K_Type,Int)]
u_node_mk_ktype_map :: [U_Node] -> [(K_Type, UID_t)]
u_node_mk_ktype_map =
    let f :: (a, U_Node) -> Maybe (K_Type, a)
f (a
i,U_Node
n) = let g :: a -> (a, a)
g a
ty = (a
ty,a
i) in (K_Type -> (K_Type, a)) -> Maybe K_Type -> Maybe (K_Type, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap K_Type -> (K_Type, a)
forall a. a -> (a, a)
g (U_Node -> Maybe K_Type
u_node_ktype U_Node
n)
    in ((UID_t, U_Node) -> Maybe (K_Type, UID_t))
-> [(UID_t, U_Node)] -> [(K_Type, UID_t)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (UID_t, U_Node) -> Maybe (K_Type, UID_t)
forall a. (a, U_Node) -> Maybe (K_Type, a)
f ([(UID_t, U_Node)] -> [(K_Type, UID_t)])
-> ([U_Node] -> [(UID_t, U_Node)]) -> [U_Node] -> [(K_Type, UID_t)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UID_t] -> [U_Node] -> [(UID_t, U_Node)]
forall a b. [a] -> [b] -> [(a, b)]
zip [UID_t
0..]

-- * Nodes (Implicit)

-- | 4-tuple to count 'K_Type's, ie. (IR,KR,TR,AR).
type U_NODE_KS_COUNT = (Int,Int,Int,Int)

-- | Count the number of /controls/ of each 'K_Type'.
u_node_ks_count :: [U_Node] -> U_NODE_KS_COUNT
u_node_ks_count :: [U_Node] -> U_NODE_KS_COUNT
u_node_ks_count =
    let recur :: (a, b, c, d) -> [U_Node] -> (a, b, c, d)
recur (a, b, c, d)
r [U_Node]
ns =
            let (a
i,b
k,c
t,d
a) = (a, b, c, d)
r
            in case [U_Node]
ns of
                 [] -> (a, b, c, d)
r
                 U_Node
n:[U_Node]
ns' -> let r' :: (a, b, c, d)
r' = case U_Node -> K_Type
u_node_k_type U_Node
n of
                                     K_Type
K_IR -> (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1,b
k,c
t,d
a)
                                     K_Type
K_KR -> (a
i,b
kb -> b -> b
forall a. Num a => a -> a -> a
+b
1,c
t,d
a)
                                     K_Type
K_TR -> (a
i,b
k,c
tc -> c -> c
forall a. Num a => a -> a -> a
+c
1,d
a)
                                     K_Type
K_AR -> (a
i,b
k,c
t,d
ad -> d -> d
forall a. Num a => a -> a -> a
+d
1)
                          in (a, b, c, d) -> [U_Node] -> (a, b, c, d)
recur (a, b, c, d)
r' [U_Node]
ns'
    in U_NODE_KS_COUNT -> [U_Node] -> U_NODE_KS_COUNT
forall a b c d.
(Num a, Num b, Num c, Num d) =>
(a, b, c, d) -> [U_Node] -> (a, b, c, d)
recur (UID_t
0,UID_t
0,UID_t
0,UID_t
0)

-- | Construct implicit /control/ unit generator 'U_Nodes'.  Unit
-- generators are only constructed for instances of control types that
-- are present.
u_node_mk_implicit_ctl :: [U_Node] -> [U_Node]
u_node_mk_implicit_ctl :: [U_Node] -> [U_Node]
u_node_mk_implicit_ctl [U_Node]
ks =
    let (UID_t
ni,UID_t
nk,UID_t
nt,UID_t
na) = [U_Node] -> U_NODE_KS_COUNT
u_node_ks_count [U_Node]
ks
        mk_n :: K_Type -> UID_t -> UID_t -> Maybe U_Node
mk_n K_Type
t UID_t
n UID_t
o =
            let (String
nm,Rate
r) = case K_Type
t of
                            K_Type
K_IR -> (String
"Control",Rate
IR)
                            K_Type
K_KR -> (String
"Control",Rate
KR)
                            K_Type
K_TR -> (String
"TrigControl",Rate
KR)
                            K_Type
K_AR -> (String
"AudioControl",Rate
AR)
                i :: [Rate]
i = UID_t -> Rate -> [Rate]
forall a. UID_t -> a -> [a]
replicate UID_t
n Rate
r
            in if UID_t
n UID_t -> UID_t -> Bool
forall a. Eq a => a -> a -> Bool
== UID_t
0
               then Maybe U_Node
forall a. Maybe a
Nothing
               else U_Node -> Maybe U_Node
forall a. a -> Maybe a
Just (UID_t
-> Rate
-> String
-> [From_Port]
-> [Rate]
-> Special
-> UGenId
-> U_Node
U_Node_U (-UID_t
1) Rate
r String
nm [] [Rate]
i (UID_t -> Special
Special UID_t
o) UGenId
no_id)
    in [Maybe U_Node] -> [U_Node]
forall a. [Maybe a] -> [a]
catMaybes [K_Type -> UID_t -> UID_t -> Maybe U_Node
mk_n K_Type
K_IR UID_t
ni UID_t
0
                 ,K_Type -> UID_t -> UID_t -> Maybe U_Node
mk_n K_Type
K_KR UID_t
nk UID_t
ni
                 ,K_Type -> UID_t -> UID_t -> Maybe U_Node
mk_n K_Type
K_TR UID_t
nt (UID_t
ni UID_t -> UID_t -> UID_t
forall a. Num a => a -> a -> a
+ UID_t
nk)
                 ,K_Type -> UID_t -> UID_t -> Maybe U_Node
mk_n K_Type
K_AR UID_t
na (UID_t
ni UID_t -> UID_t -> UID_t
forall a. Num a => a -> a -> a
+ UID_t
nk UID_t -> UID_t -> UID_t
forall a. Num a => a -> a -> a
+ UID_t
nt)]

-- * Edges

-- | List of 'From_Port_U' at /e/ with multiple out edges.
u_edge_multiple_out_edges :: [U_Edge] -> [From_Port]
u_edge_multiple_out_edges :: [U_Edge] -> [From_Port]
u_edge_multiple_out_edges [U_Edge]
e =
    let p :: [From_Port]
p = (From_Port -> Bool) -> [From_Port] -> [From_Port]
forall a. (a -> Bool) -> [a] -> [a]
filter From_Port -> Bool
is_from_port_u ((U_Edge -> From_Port) -> [U_Edge] -> [From_Port]
forall a b. (a -> b) -> [a] -> [b]
map U_Edge -> From_Port
forall a b. (a, b) -> a
fst [U_Edge]
e)
        p' :: [[From_Port]]
p' = [From_Port] -> [[From_Port]]
forall a. Eq a => [a] -> [[a]]
group ((From_Port -> From_Port -> Ordering) -> [From_Port] -> [From_Port]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (UID_t -> UID_t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (UID_t -> UID_t -> Ordering)
-> (From_Port -> UID_t) -> From_Port -> From_Port -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` From_Port -> UID_t
from_port_nid) [From_Port]
p)
    in ([From_Port] -> From_Port) -> [[From_Port]] -> [From_Port]
forall a b. (a -> b) -> [a] -> [b]
map [From_Port] -> From_Port
forall a. [a] -> a
head (([From_Port] -> Bool) -> [[From_Port]] -> [[From_Port]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((UID_t -> UID_t -> Bool
forall a. Ord a => a -> a -> Bool
> UID_t
1) (UID_t -> Bool) -> ([From_Port] -> UID_t) -> [From_Port] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [From_Port] -> UID_t
forall (t :: * -> *) a. Foldable t => t a -> UID_t
length) [[From_Port]]
p')

-- * Graph

-- | Calculate all edges of a 'U_Graph'.
ug_edges :: U_Graph -> [U_Edge]
ug_edges :: U_Graph -> [U_Edge]
ug_edges = (U_Node -> [U_Edge]) -> [U_Node] -> [U_Edge]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap U_Node -> [U_Edge]
u_node_in_edges ([U_Node] -> [U_Edge])
-> (U_Graph -> [U_Node]) -> U_Graph -> [U_Edge]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U_Graph -> [U_Node]
ug_ugens

-- | The empty 'U_Graph'.
ug_empty_graph :: U_Graph
ug_empty_graph :: U_Graph
ug_empty_graph = UID_t -> [U_Node] -> [U_Node] -> [U_Node] -> U_Graph
U_Graph UID_t
0 [] [] []

-- | Find the maximum 'UID_t' used at 'U_Graph'.  It is an error if this is not 'ug_next_id'.
ug_maximum_id :: U_Graph -> UID_t
ug_maximum_id :: U_Graph -> UID_t
ug_maximum_id (U_Graph UID_t
z [U_Node]
c [U_Node]
k [U_Node]
u) =
  let z' :: UID_t
z' = [UID_t] -> UID_t
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((U_Node -> UID_t) -> [U_Node] -> [UID_t]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> UID_t
u_node_id ([U_Node]
c [U_Node] -> [U_Node] -> [U_Node]
forall a. [a] -> [a] -> [a]
++ [U_Node]
k [U_Node] -> [U_Node] -> [U_Node]
forall a. [a] -> [a] -> [a]
++ [U_Node]
u))
  in if UID_t
z' UID_t -> UID_t -> Bool
forall a. Eq a => a -> a -> Bool
/= UID_t
z
     then String -> UID_t
forall a. HasCallStack => String -> a
error ((String, UID_t, UID_t) -> String
forall a. Show a => a -> String
show (String
"ug_maximum_id: not ug_next_id?",UID_t
z,UID_t
z'))
     else UID_t
z

-- | Find 'U_Node' with indicated 'UID_t'.
ug_find_node :: U_Graph -> UID_t -> Maybe U_Node
ug_find_node :: U_Graph -> UID_t -> Maybe U_Node
ug_find_node (U_Graph UID_t
_ [U_Node]
cs [U_Node]
ks [U_Node]
us) UID_t
n =
    let f :: U_Node -> Bool
f U_Node
x = U_Node -> UID_t
u_node_id U_Node
x UID_t -> UID_t -> Bool
forall a. Eq a => a -> a -> Bool
== UID_t
n
    in (U_Node -> Bool) -> [U_Node] -> Maybe U_Node
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find U_Node -> Bool
f ([U_Node]
cs [U_Node] -> [U_Node] -> [U_Node]
forall a. [a] -> [a] -> [a]
++ [U_Node]
ks [U_Node] -> [U_Node] -> [U_Node]
forall a. [a] -> [a] -> [a]
++ [U_Node]
us)

-- | Locate 'U_Node' of 'From_Port' in 'U_Graph'.
ug_from_port_node :: U_Graph -> From_Port -> Maybe U_Node
ug_from_port_node :: U_Graph -> From_Port -> Maybe U_Node
ug_from_port_node U_Graph
g From_Port
fp = U_Graph -> UID_t -> Maybe U_Node
ug_find_node U_Graph
g (From_Port -> UID_t
from_port_nid From_Port
fp)

-- | Erroring variant.
ug_from_port_node_err :: U_Graph -> From_Port -> U_Node
ug_from_port_node_err :: U_Graph -> From_Port -> U_Node
ug_from_port_node_err U_Graph
g From_Port
fp =
    let e :: a
e = String -> a
forall a. HasCallStack => String -> a
error String
"ug_from_port_node_err"
    in U_Node -> Maybe U_Node -> U_Node
forall a. a -> Maybe a -> a
fromMaybe U_Node
forall a. a
e (U_Graph -> From_Port -> Maybe U_Node
ug_from_port_node U_Graph
g From_Port
fp)

-- * Graph (Building)

-- | Insert a constant 'U_Node' into the 'U_Graph'.
ug_push_c :: Sample -> U_Graph -> (U_Node,U_Graph)
ug_push_c :: Sample -> U_Graph -> (U_Node, U_Graph)
ug_push_c Sample
x U_Graph
g =
    let n :: U_Node
n = UID_t -> Sample -> U_Node
U_Node_C (U_Graph -> UID_t
ug_next_id U_Graph
g) Sample
x
    in (U_Node
n,U_Graph
g {ug_constants :: [U_Node]
ug_constants = U_Node
n U_Node -> [U_Node] -> [U_Node]
forall a. a -> [a] -> [a]
: U_Graph -> [U_Node]
ug_constants U_Graph
g
            ,ug_next_id :: UID_t
ug_next_id = U_Graph -> UID_t
ug_next_id U_Graph
g UID_t -> UID_t -> UID_t
forall a. Num a => a -> a -> a
+ UID_t
1})

-- | Either find existing 'Constant' 'U_Node', or insert a new 'U_Node'.
ug_mk_node_c :: Constant -> U_Graph -> (U_Node,U_Graph)
ug_mk_node_c :: Constant -> U_Graph -> (U_Node, U_Graph)
ug_mk_node_c (Constant Sample
x) U_Graph
g =
    let y :: Maybe U_Node
y = (U_Node -> Bool) -> [U_Node] -> Maybe U_Node
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Sample -> U_Node -> Bool
is_u_node_c_of Sample
x) (U_Graph -> [U_Node]
ug_constants U_Graph
g)
    in (U_Node, U_Graph)
-> (U_Node -> (U_Node, U_Graph))
-> Maybe U_Node
-> (U_Node, U_Graph)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Sample -> U_Graph -> (U_Node, U_Graph)
ug_push_c Sample
x U_Graph
g) (\U_Node
y' -> (U_Node
y',U_Graph
g)) Maybe U_Node
y

-- | Insert a control node into the 'U_Graph'.
ug_push_k :: Control -> U_Graph -> (U_Node,U_Graph)
ug_push_k :: Control -> U_Graph -> (U_Node, U_Graph)
ug_push_k (Control Rate
r Maybe UID_t
ix String
nm Sample
d Bool
tr Maybe (Control_Meta Sample)
meta) U_Graph
g =
    let n :: U_Node
n = UID_t
-> Rate
-> Maybe UID_t
-> String
-> Sample
-> K_Type
-> Maybe (Control_Meta Sample)
-> U_Node
U_Node_K (U_Graph -> UID_t
ug_next_id U_Graph
g) Rate
r Maybe UID_t
ix String
nm Sample
d (Rate -> Bool -> K_Type
ktype Rate
r Bool
tr) Maybe (Control_Meta Sample)
meta
    in (U_Node
n,U_Graph
g {ug_controls :: [U_Node]
ug_controls = U_Node
n U_Node -> [U_Node] -> [U_Node]
forall a. a -> [a] -> [a]
: U_Graph -> [U_Node]
ug_controls U_Graph
g
            ,ug_next_id :: UID_t
ug_next_id = U_Graph -> UID_t
ug_next_id U_Graph
g UID_t -> UID_t -> UID_t
forall a. Num a => a -> a -> a
+ UID_t
1})

-- | Either find existing 'Control' 'U_Node', or insert a new 'U_Node'.
ug_mk_node_k :: Control -> U_Graph -> (U_Node,U_Graph)
ug_mk_node_k :: Control -> U_Graph -> (U_Node, U_Graph)
ug_mk_node_k Control
c U_Graph
g =
    let nm :: String
nm = Control -> String
controlName Control
c
        y :: Maybe U_Node
y = (U_Node -> Bool) -> [U_Node] -> Maybe U_Node
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String -> U_Node -> Bool
is_u_node_k_of String
nm) (U_Graph -> [U_Node]
ug_controls U_Graph
g)
    in (U_Node, U_Graph)
-> (U_Node -> (U_Node, U_Graph))
-> Maybe U_Node
-> (U_Node, U_Graph)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Control -> U_Graph -> (U_Node, U_Graph)
ug_push_k Control
c U_Graph
g) (\U_Node
y' -> (U_Node
y',U_Graph
g)) Maybe U_Node
y

-- | Insert a /primitive/ 'U_Node_U' into the 'U_Graph'.
ug_push_u :: U_Node_NOID -> U_Graph -> (U_Node,U_Graph)
ug_push_u :: U_Node_NOID -> U_Graph -> (U_Node, U_Graph)
ug_push_u (Rate
r,String
nm,[From_Port]
i,[Rate]
o,Special
s,UGenId
d) U_Graph
g =
    let n :: U_Node
n = UID_t
-> Rate
-> String
-> [From_Port]
-> [Rate]
-> Special
-> UGenId
-> U_Node
U_Node_U (U_Graph -> UID_t
ug_next_id U_Graph
g) Rate
r String
nm [From_Port]
i [Rate]
o Special
s UGenId
d
    in (U_Node
n,U_Graph
g {ug_ugens :: [U_Node]
ug_ugens = U_Node
n U_Node -> [U_Node] -> [U_Node]
forall a. a -> [a] -> [a]
: U_Graph -> [U_Node]
ug_ugens U_Graph
g
            ,ug_next_id :: UID_t
ug_next_id = U_Graph -> UID_t
ug_next_id U_Graph
g UID_t -> UID_t -> UID_t
forall a. Num a => a -> a -> a
+ UID_t
1})

-- | Recursively traverse set of UGen calling 'ug_mk_node'.
ug_mk_node_rec :: [UGen] -> [U_Node] -> U_Graph -> ([U_Node],U_Graph)
ug_mk_node_rec :: [UGen] -> [U_Node] -> U_Graph -> ([U_Node], U_Graph)
ug_mk_node_rec [UGen]
u [U_Node]
n U_Graph
g =
    case [UGen]
u of
      [] -> ([U_Node] -> [U_Node]
forall a. [a] -> [a]
reverse [U_Node]
n,U_Graph
g)
      UGen
x:[UGen]
xs -> let (U_Node
y,U_Graph
g') = UGen -> U_Graph -> (U_Node, U_Graph)
ug_mk_node UGen
x U_Graph
g
              in [UGen] -> [U_Node] -> U_Graph -> ([U_Node], U_Graph)
ug_mk_node_rec [UGen]
xs (U_Node
yU_Node -> [U_Node] -> [U_Node]
forall a. a -> [a] -> [a]
:[U_Node]
n) U_Graph
g'

-- | Run 'ug_mk_node_rec' at inputs and either find existing primitive
-- node or insert a new one.
ug_mk_node_u :: Primitive -> U_Graph -> (U_Node,U_Graph)
ug_mk_node_u :: Primitive -> U_Graph -> (U_Node, U_Graph)
ug_mk_node_u (Primitive Rate
r String
nm [UGen]
i [Rate]
o Special
s UGenId
d) U_Graph
g =
    let ([U_Node]
i',U_Graph
g') = [UGen] -> [U_Node] -> U_Graph -> ([U_Node], U_Graph)
ug_mk_node_rec [UGen]
i [] U_Graph
g
        i'' :: [From_Port]
i'' = (U_Node -> From_Port) -> [U_Node] -> [From_Port]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> From_Port
u_node_from_port [U_Node]
i'
        u :: U_Node_NOID
u = (Rate
r,String
nm,[From_Port]
i'',[Rate]
o,Special
s,UGenId
d)
        y :: Maybe U_Node
y = (U_Node -> Bool) -> [U_Node] -> Maybe U_Node
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (U_Node_NOID -> U_Node -> Bool
u_node_eq_noid U_Node_NOID
u) (U_Graph -> [U_Node]
ug_ugens U_Graph
g')
    in (U_Node, U_Graph)
-> (U_Node -> (U_Node, U_Graph))
-> Maybe U_Node
-> (U_Node, U_Graph)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (U_Node_NOID -> U_Graph -> (U_Node, U_Graph)
ug_push_u U_Node_NOID
u U_Graph
g') (\U_Node
y' -> (U_Node
y',U_Graph
g')) Maybe U_Node
y

-- | Proxies do not get stored in the graph.
ug_mk_node_p :: U_Node -> Port_Index -> U_Graph -> (U_Node,U_Graph)
ug_mk_node_p :: U_Node -> UID_t -> U_Graph -> (U_Node, U_Graph)
ug_mk_node_p U_Node
n UID_t
p U_Graph
g =
    let z :: UID_t
z = U_Graph -> UID_t
ug_next_id U_Graph
g
    in (UID_t -> U_Node -> UID_t -> U_Node
U_Node_P UID_t
z U_Node
n UID_t
p,U_Graph
g {ug_next_id :: UID_t
ug_next_id = UID_t
z UID_t -> UID_t -> UID_t
forall a. Num a => a -> a -> a
+ UID_t
1})

-- | Transform 'UGen' into 'U_Graph', appending to existing 'U_Graph'.
--   Allow RHS of MRG node to be MCE (splice all nodes into graph).
ug_mk_node :: UGen -> U_Graph -> (U_Node,U_Graph)
ug_mk_node :: UGen -> U_Graph -> (U_Node, U_Graph)
ug_mk_node UGen
u U_Graph
g =
    case UGen
u of
      Constant_U Constant
c -> Constant -> U_Graph -> (U_Node, U_Graph)
ug_mk_node_c Constant
c U_Graph
g
      Control_U Control
k -> Control -> U_Graph -> (U_Node, U_Graph)
ug_mk_node_k Control
k U_Graph
g
      Label_U Label
_ -> String -> (U_Node, U_Graph)
forall a. HasCallStack => String -> a
error ((String, UGen) -> String
forall a. Show a => a -> String
show (String
"ug_mk_node: label",UGen
u))
      Primitive_U Primitive
p -> Primitive -> U_Graph -> (U_Node, U_Graph)
ug_mk_node_u Primitive
p U_Graph
g
      Proxy_U Proxy
p ->
          let (U_Node
n,U_Graph
g') = Primitive -> U_Graph -> (U_Node, U_Graph)
ug_mk_node_u (Proxy -> Primitive
proxySource Proxy
p) U_Graph
g
          in U_Node -> UID_t -> U_Graph -> (U_Node, U_Graph)
ug_mk_node_p U_Node
n (Proxy -> UID_t
proxyIndex Proxy
p) U_Graph
g'
      MRG_U MRG
m ->
          let f :: U_Graph -> [UGen] -> U_Graph
f U_Graph
g' [UGen]
l = case [UGen]
l of
                         [] -> U_Graph
g'
                         UGen
n:[UGen]
l' -> let (U_Node
_,U_Graph
g'') = UGen -> U_Graph -> (U_Node, U_Graph)
ug_mk_node UGen
n U_Graph
g' in U_Graph -> [UGen] -> U_Graph
f U_Graph
g'' [UGen]
l'
          in UGen -> U_Graph -> (U_Node, U_Graph)
ug_mk_node (MRG -> UGen
mrgLeft MRG
m) (U_Graph -> [UGen] -> U_Graph
f U_Graph
g (UGen -> [UGen]
mceChannels (MRG -> UGen
mrgRight MRG
m)))
      MCE_U MCE UGen
_ -> String -> (U_Node, U_Graph)
forall a. HasCallStack => String -> a
error ((String, UGen) -> String
forall a. Show a => a -> String
show (String
"ug_mk_node: mce",UGen
u))

-- | Add implicit /control/ UGens to 'U_Graph'.
ug_add_implicit_ctl :: U_Graph -> U_Graph
ug_add_implicit_ctl :: U_Graph -> U_Graph
ug_add_implicit_ctl U_Graph
g =
    let (U_Graph UID_t
z [U_Node]
cs [U_Node]
ks [U_Node]
us) = U_Graph
g
        ks' :: [U_Node]
ks' = (U_Node -> U_Node -> Ordering) -> [U_Node] -> [U_Node]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy U_Node -> U_Node -> Ordering
u_node_k_cmp [U_Node]
ks
        im :: [U_Node]
im = if [U_Node] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [U_Node]
ks' then [] else [U_Node] -> [U_Node]
u_node_mk_implicit_ctl [U_Node]
ks'
        us' :: [U_Node]
us' = [U_Node]
im [U_Node] -> [U_Node] -> [U_Node]
forall a. [a] -> [a] -> [a]
++ [U_Node]
us
    in UID_t -> [U_Node] -> [U_Node] -> [U_Node] -> U_Graph
U_Graph UID_t
z [U_Node]
cs [U_Node]
ks' [U_Node]
us'

-- | Add implicit 'maxLocalBufs' if not present.
ug_add_implicit_buf :: U_Graph -> U_Graph
ug_add_implicit_buf :: U_Graph -> U_Graph
ug_add_implicit_buf U_Graph
g =
    case [U_Node] -> UID_t
u_node_localbuf_count (U_Graph -> [U_Node]
ug_ugens U_Graph
g) of
      UID_t
0 -> U_Graph
g
      UID_t
n -> let (U_Node
c,U_Graph
g') = Constant -> U_Graph -> (U_Node, U_Graph)
ug_mk_node_c (Sample -> Constant
Constant (UID_t -> Sample
forall a b. (Integral a, Num b) => a -> b
fromIntegral UID_t
n)) U_Graph
g
               p :: From_Port
p = U_Node -> From_Port
u_node_from_port U_Node
c
               u :: U_Node
u = UID_t
-> Rate
-> String
-> [From_Port]
-> [Rate]
-> Special
-> UGenId
-> U_Node
U_Node_U (-UID_t
1) Rate
IR String
"MaxLocalBufs" [From_Port
p] [] (UID_t -> Special
Special UID_t
0) UGenId
no_id
           in U_Graph
g' {ug_ugens :: [U_Node]
ug_ugens = U_Node
u U_Node -> [U_Node] -> [U_Node]
forall a. a -> [a] -> [a]
: U_Graph -> [U_Node]
ug_ugens U_Graph
g'}

-- | 'ug_add_implicit_buf' and 'ug_add_implicit_ctl'.
ug_add_implicit :: U_Graph -> U_Graph
ug_add_implicit :: U_Graph -> U_Graph
ug_add_implicit = U_Graph -> U_Graph
ug_add_implicit_buf (U_Graph -> U_Graph) -> (U_Graph -> U_Graph) -> U_Graph -> U_Graph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U_Graph -> U_Graph
ug_add_implicit_ctl

-- | Remove implicit UGens from 'U_Graph'
ug_remove_implicit :: U_Graph -> U_Graph
ug_remove_implicit :: U_Graph -> U_Graph
ug_remove_implicit U_Graph
g =
    let u :: [U_Node]
u = (U_Node -> Bool) -> [U_Node] -> [U_Node]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (U_Node -> Bool) -> U_Node -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U_Node -> Bool
u_node_is_implicit) (U_Graph -> [U_Node]
ug_ugens U_Graph
g)
    in U_Graph
g {ug_ugens :: [U_Node]
ug_ugens = [U_Node]
u}

-- * Graph (Queries)

-- | Descendents at 'U_Graph' of 'U_Node'.
u_node_descendents :: U_Graph -> U_Node -> [U_Node]
u_node_descendents :: U_Graph -> U_Node -> [U_Node]
u_node_descendents U_Graph
g U_Node
n =
    let e :: [U_Edge]
e = U_Graph -> [U_Edge]
ug_edges U_Graph
g
        c :: [U_Edge]
c = (U_Edge -> Bool) -> [U_Edge] -> [U_Edge]
forall a. (a -> Bool) -> [a] -> [a]
filter ((UID_t -> UID_t -> Bool
forall a. Eq a => a -> a -> Bool
== U_Node -> UID_t
u_node_id U_Node
n) (UID_t -> Bool) -> (U_Edge -> UID_t) -> U_Edge -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. From_Port -> UID_t
from_port_nid (From_Port -> UID_t) -> (U_Edge -> From_Port) -> U_Edge -> UID_t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U_Edge -> From_Port
forall a b. (a, b) -> a
fst) [U_Edge]
e
        f :: To_Port -> UID_t
f (To_Port UID_t
k UID_t
_) = UID_t
k
    in (U_Edge -> Maybe U_Node) -> [U_Edge] -> [U_Node]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (U_Graph -> UID_t -> Maybe U_Node
ug_find_node U_Graph
g (UID_t -> Maybe U_Node)
-> (U_Edge -> UID_t) -> U_Edge -> Maybe U_Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. To_Port -> UID_t
f (To_Port -> UID_t) -> (U_Edge -> To_Port) -> U_Edge -> UID_t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U_Edge -> To_Port
forall a b. (a, b) -> b
snd) [U_Edge]
c

-- * PV edge accounting

-- | List @PV@ 'U_Node's at 'U_Graph' with multiple out edges.
ug_pv_multiple_out_edges :: U_Graph -> [U_Node]
ug_pv_multiple_out_edges :: U_Graph -> [U_Node]
ug_pv_multiple_out_edges U_Graph
g =
    let e :: [U_Edge]
e = U_Graph -> [U_Edge]
ug_edges U_Graph
g
        p :: [From_Port]
p = [U_Edge] -> [From_Port]
u_edge_multiple_out_edges [U_Edge]
e
        n :: [U_Node]
n = (From_Port -> Maybe U_Node) -> [From_Port] -> [U_Node]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (U_Graph -> UID_t -> Maybe U_Node
ug_find_node U_Graph
g (UID_t -> Maybe U_Node)
-> (From_Port -> UID_t) -> From_Port -> Maybe U_Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. From_Port -> UID_t
from_port_nid) [From_Port]
p
    in (U_Node -> Bool) -> [U_Node] -> [U_Node]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
Analysis.primitive_is_pv_rate (String -> Bool) -> (U_Node -> String) -> U_Node -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U_Node -> String
u_node_u_name) [U_Node]
n

-- | Error string if graph has an invalid @PV@ subgraph, ie. multiple out edges
-- at @PV@ node not connecting to @Unpack1FFT@ & @PackFFT@, else Nothing.
ug_pv_check :: U_Graph -> Maybe String
ug_pv_check :: U_Graph -> Maybe String
ug_pv_check U_Graph
g =
    case U_Graph -> [U_Node]
ug_pv_multiple_out_edges U_Graph
g of
      [] -> Maybe String
forall a. Maybe a
Nothing
      [U_Node]
n ->
        let d :: [String]
d = (U_Node -> [String]) -> [U_Node] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((U_Node -> String) -> [U_Node] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> String
u_node_u_name ([U_Node] -> [String])
-> (U_Node -> [U_Node]) -> U_Node -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U_Graph -> U_Node -> [U_Node]
u_node_descendents U_Graph
g) [U_Node]
n
        in if (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
Analysis.primitive_is_pv_rate [String]
d Bool -> Bool -> Bool
|| (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"IFFT"]) [String]
d
           then String -> Maybe String
forall a. a -> Maybe a
Just ((String, [String], [String]) -> String
forall a. Show a => a -> String
show (String
"PV: multiple out edges, see pv_split",(U_Node -> String) -> [U_Node] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> String
u_node_u_name [U_Node]
n,[String]
d))
           else Maybe String
forall a. Maybe a
Nothing

-- | Variant that runs 'error' as required.
ug_pv_validate :: U_Graph -> U_Graph
ug_pv_validate :: U_Graph -> U_Graph
ug_pv_validate U_Graph
g = U_Graph -> (String -> U_Graph) -> Maybe String -> U_Graph
forall b a. b -> (a -> b) -> Maybe a -> b
maybe U_Graph
g String -> U_Graph
forall a. HasCallStack => String -> a
error (U_Graph -> Maybe String
ug_pv_check U_Graph
g)

-- * UGen to U_Graph

{- | Transform a unit generator into a graph.
     'ug_mk_node' begins with an empty graph,
     then reverses the resulting 'UGen' list and sorts the 'Control' list,
     and finally adds implicit nodes and validates PV sub-graphs.

> import Sound.SC3 {- hsc3 -}
> ugen_to_graph (out 0 (pan2 (sinOsc AR 440 0) 0.5 0.1))

-}
ugen_to_graph :: UGen -> U_Graph
ugen_to_graph :: UGen -> U_Graph
ugen_to_graph UGen
u =
    let (U_Node
_,U_Graph
g) = UGen -> U_Graph -> (U_Node, U_Graph)
ug_mk_node (UGen -> UGen
prepare_root UGen
u) U_Graph
ug_empty_graph
        g' :: U_Graph
g' = U_Graph
g {ug_ugens :: [U_Node]
ug_ugens = [U_Node] -> [U_Node]
forall a. [a] -> [a]
reverse (U_Graph -> [U_Node]
ug_ugens U_Graph
g)
               ,ug_controls :: [U_Node]
ug_controls = [U_Node] -> [U_Node]
u_node_sort_controls (U_Graph -> [U_Node]
ug_controls U_Graph
g)}
    in U_Graph -> U_Graph
ug_pv_validate (U_Graph -> U_Graph
ug_add_implicit U_Graph
g')

-- * Stat

-- | Simple statistical analysis of a unit generator graph.
ug_stat_ln :: U_Graph -> [String]
ug_stat_ln :: U_Graph -> [String]
ug_stat_ln U_Graph
s =
    let cs :: [U_Node]
cs = U_Graph -> [U_Node]
ug_constants U_Graph
s
        ks :: [U_Node]
ks = U_Graph -> [U_Node]
ug_controls U_Graph
s
        us :: [U_Node]
us = U_Graph -> [U_Node]
ug_ugens U_Graph
s
        hist :: (t -> String) -> [t] -> String
hist t -> String
pp_f =
          let h :: [a] -> (a, UID_t)
h (a
x:[a]
xs) = (a
x,[a] -> UID_t
forall (t :: * -> *) a. Foldable t => t a -> UID_t
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs))
              h [] = String -> (a, UID_t)
forall a. HasCallStack => String -> a
error String
"graph_stat_ln"
          in [String] -> String
unwords ([String] -> String) -> ([t] -> [String]) -> [t] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([t] -> String) -> [[t]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((\(t
p,UID_t
q) -> t -> String
pp_f t
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"×" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UID_t -> String
forall a. Show a => a -> String
show UID_t
q) ((t, UID_t) -> String) -> ([t] -> (t, UID_t)) -> [t] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [t] -> (t, UID_t)
forall a. [a] -> (a, UID_t)
h) ([[t]] -> [String]) -> ([t] -> [[t]]) -> [t] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [t] -> [[t]]
forall a. Eq a => [a] -> [[a]]
group ([t] -> [[t]]) -> ([t] -> [t]) -> [t] -> [[t]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [t] -> [t]
forall a. Ord a => [a] -> [a]
sort
    in [String
"number of constants       : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UID_t -> String
forall a. Show a => a -> String
show ([U_Node] -> UID_t
forall (t :: * -> *) a. Foldable t => t a -> UID_t
length [U_Node]
cs)
       ,String
"number of controls        : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UID_t -> String
forall a. Show a => a -> String
show ([U_Node] -> UID_t
forall (t :: * -> *) a. Foldable t => t a -> UID_t
length [U_Node]
ks)
       ,String
"control rates             : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Rate -> String) -> [Rate] -> String
forall t. Ord t => (t -> String) -> [t] -> String
hist Rate -> String
forall a. Show a => a -> String
show ((U_Node -> Rate) -> [U_Node] -> [Rate]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> Rate
u_node_k_rate [U_Node]
ks)
       ,String
"control names             : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((U_Node -> String) -> [U_Node] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> String
u_node_k_name [U_Node]
ks)
       ,String
"number of unit generators : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UID_t -> String
forall a. Show a => a -> String
show ([U_Node] -> UID_t
forall (t :: * -> *) a. Foldable t => t a -> UID_t
length [U_Node]
us)
       ,String
"unit generator rates      : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Rate -> String) -> [Rate] -> String
forall t. Ord t => (t -> String) -> [t] -> String
hist Rate -> String
forall a. Show a => a -> String
show ((U_Node -> Rate) -> [U_Node] -> [Rate]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> Rate
u_node_u_rate [U_Node]
us)
       ,String
"unit generator set        : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS -> [String] -> String
forall t. Ord t => (t -> String) -> [t] -> String
hist ShowS
forall a. a -> a
id ((U_Node -> String) -> [U_Node] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> String
u_node_user_name [U_Node]
us)
       ,String
"unit generator sequence   : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((U_Node -> String) -> [U_Node] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> String
u_node_user_name [U_Node]
us)]

-- | 'unlines' of 'ug_stat_ln'.
ug_stat :: U_Graph -> String
ug_stat :: U_Graph -> String
ug_stat = [String] -> String
unlines ([String] -> String) -> (U_Graph -> [String]) -> U_Graph -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U_Graph -> [String]
ug_stat_ln

-- * Indices

-- | Find indices of all instances of the named UGen at 'Graph'.
-- The index is required when using 'Sound.SC3.Server.Command.u_cmd'.
ug_ugen_indices :: (Num n,Enum n) => String -> U_Graph -> [n]
ug_ugen_indices :: String -> U_Graph -> [n]
ug_ugen_indices String
nm =
    let f :: (a, U_Node) -> Maybe a
f (a
k,U_Node
nd) =
            case U_Node
nd of
              U_Node_U UID_t
_ Rate
_ String
nm' [From_Port]
_ [Rate]
_ Special
_ UGenId
_ -> if String
nm String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
nm' then a -> Maybe a
forall a. a -> Maybe a
Just a
k else Maybe a
forall a. Maybe a
Nothing
              U_Node
_ -> Maybe a
forall a. Maybe a
Nothing
    in ((n, U_Node) -> Maybe n) -> [(n, U_Node)] -> [n]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (n, U_Node) -> Maybe n
forall a. (a, U_Node) -> Maybe a
f ([(n, U_Node)] -> [n])
-> (U_Graph -> [(n, U_Node)]) -> U_Graph -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [n] -> [U_Node] -> [(n, U_Node)]
forall a b. [a] -> [b] -> [(a, b)]
zip [n
0..] ([U_Node] -> [(n, U_Node)])
-> (U_Graph -> [U_Node]) -> U_Graph -> [(n, U_Node)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U_Graph -> [U_Node]
ug_ugens