{- | '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 qualified Sound.Sc3.Common.Rate as Rate {- hsc3 -}
import qualified Sound.Sc3.Common.Uid as Uid {- hsc3 -}

import qualified Sound.Sc3.Ugen.Analysis as Analysis {- hsc3 -}
import Sound.Sc3.Ugen.Types {- hsc3 -}
import qualified Sound.Sc3.Ugen.Util as Util {- hsc3 -}

-- * Types

-- | Port index.
type Port_Index = Int

{- | Type to represent the left hand side of an edge in a unit generator graph.
C = constant, K = control, U = ugen.
-}
data From_Port =
  From_Port_C {From_Port -> Id
from_port_nid :: Uid.Id}
  | From_Port_K {from_port_nid :: Uid.Id,From_Port -> K_Type
from_port_kt :: Rate.K_Type}
  | From_Port_U {from_port_nid :: Uid.Id,From_Port -> Maybe Id
from_port_idx :: Maybe Port_Index}
  deriving (From_Port -> From_Port -> Bool
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,Id -> From_Port -> ShowS
[From_Port] -> ShowS
From_Port -> String
forall a.
(Id -> 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 :: Id -> From_Port -> ShowS
$cshowsPrec :: Id -> From_Port -> ShowS
Show)

-- | A destination port.
data To_Port = To_Port {To_Port -> Id
to_port_nid :: Uid.Id,To_Port -> Id
to_port_idx :: Port_Index}
             deriving (To_Port -> To_Port -> Bool
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,Id -> To_Port -> ShowS
[To_Port] -> ShowS
To_Port -> String
forall a.
(Id -> 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 :: Id -> To_Port -> ShowS
$cshowsPrec :: Id -> 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 -> Id
u_node_id :: Uid.Id
                       ,U_Node -> Sample
u_node_c_value :: Sample}
            | U_Node_K {u_node_id :: Uid.Id
                       ,U_Node -> Rate
u_node_k_rate :: Rate.Rate
                       ,U_Node -> Maybe Id
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 :: Rate.K_Type
                       ,U_Node -> Maybe (Control_Meta Sample)
u_node_k_meta :: Maybe (Control_Meta Sample)}
            | U_Node_U {u_node_id :: Uid.Id
                       ,U_Node -> Rate
u_node_u_rate :: 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.Id
                       ,U_Node -> Id
u_node_p_id :: Uid.Id
                       ,U_Node -> Id
u_node_p_index :: Port_Index
                       ,U_Node -> Rate
u_node_p_rate :: Rate.Rate}
            deriving (U_Node -> U_Node -> Bool
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,Id -> U_Node -> ShowS
[U_Node] -> ShowS
U_Node -> String
forall a.
(Id -> 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 :: Id -> U_Node -> ShowS
$cshowsPrec :: Id -> U_Node -> ShowS
Show)

u_node_is_c,u_node_is_k,u_node_is_u :: U_Node -> Bool
u_node_is_c :: U_Node -> Bool
u_node_is_c U_Node
n = case U_Node
n of {U_Node_C {} -> Bool
True; U_Node
_ -> Bool
False}
u_node_is_k :: U_Node -> Bool
u_node_is_k U_Node
n = case U_Node
n of {U_Node_K {} -> Bool
True; U_Node
_ -> Bool
False}
u_node_is_u :: U_Node -> Bool
u_node_is_u U_Node
n = case U_Node
n of {U_Node_U {} -> Bool
True; U_Node
_ -> Bool
False}

-- | 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 Id
_ Rate
rt Maybe Id
ix String
nm Sample
df K_Type
ty Maybe (Control_Meta Sample)
mt -> Rate
-> Maybe Id
-> String
-> Sample
-> Bool
-> Maybe (Control_Meta Sample)
-> Brackets
-> Control
Control Rate
rt Maybe Id
ix String
nm Sample
df (K_Type
ty forall a. Eq a => a -> a -> Bool
== K_Type
Rate.K_TriggerRate) Maybe (Control_Meta Sample)
mt Brackets
emptyBrackets
    U_Node
_ -> 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 -> Id
ug_next_id :: Uid.Id
                       ,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 (Id -> U_Graph -> ShowS
[U_Graph] -> ShowS
U_Graph -> String
forall a.
(Id -> 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 :: Id -> U_Graph -> ShowS
$cshowsPrec :: Id -> 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 -> Id
port_idx_or_zero From_Port
p =
    case From_Port
p of
      From_Port_U Id
_ (Just Id
x) -> Id
x
      From_Port
_ -> Id
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 Id
_ Maybe Id
_ -> 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 Id
_ 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 Id
_ Sample
y -> Sample
x forall a. Eq a => a -> a -> Bool
== Sample
y
      U_Node
_ -> 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 Id
_ Rate
_ Maybe Id
_ String
y Sample
_ K_Type
_ Maybe (Control_Meta Sample)
_ -> String
x forall a. Eq a => a -> a -> Bool
== String
y
      U_Node
_ -> 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 = forall a. Ord a => a -> a -> Ordering
compare 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 = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` U_Node -> Id
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 forall a. Eq a => a -> a -> Bool
== U_Node
q
  else forall a. HasCallStack => String -> a
error String
"u_node_k_eq? not U_Node_K"

{- | 'Rate' of 'U_Node', ie. 'InitialisationRate' for constants. See through 'U_Node_P'.
      Not used at hsc3 but used by hsc3-dot &etc.
-}
u_node_rate :: U_Node -> Rate.Rate
u_node_rate :: U_Node -> Rate
u_node_rate U_Node
n =
    case U_Node
n of
      U_Node_C {} -> Rate
Rate.InitialisationRate
      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 {} -> U_Node -> Rate
u_node_p_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 Id
n Sample
_ -> String
"c_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Id
n
      U_Node_K Id
n Rate
_ Maybe Id
_ String
_ Sample
_ K_Type
_ Maybe (Control_Meta Sample)
_ -> String
"k_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Id
n
      U_Node_U Id
n Rate
_ String
_ [From_Port]
_ [Rate]
_ Special
_ UgenId
_ -> String
"u_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Id
n
      U_Node_P Id
n Id
_ Id
_ Rate
_ -> String
"p_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Id
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 Id
x Rate
_ String
_ [From_Port]
i [Rate]
_ Special
_ UgenId
_ -> forall a b. [a] -> [b] -> [(a, b)]
zip [From_Port]
i (forall a b. (a -> b) -> [a] -> [b]
map (Id -> Id -> To_Port
To_Port Id
x) [Id
0..])
      U_Node
_ -> 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 Id
n Sample
_ -> Id -> From_Port
From_Port_C Id
n
      U_Node_K Id
n Rate
_ Maybe Id
_ String
_ Sample
_ K_Type
t Maybe (Control_Meta Sample)
_ -> Id -> K_Type -> From_Port
From_Port_K Id
n K_Type
t
      U_Node_U Id
n Rate
_ String
_ [From_Port]
_ [Rate]
o Special
_ UgenId
_ ->
          case [Rate]
o of
            [Rate
_] -> Id -> Maybe Id -> From_Port
From_Port_U Id
n forall a. Maybe a
Nothing
            [Rate]
_ -> forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show (String
"u_node_from_port: non unary U_Node_U",U_Node
d))
      U_Node_P Id
_ Id
u Id
p Rate
_ -> Id -> Maybe Id -> From_Port
From_Port_U Id
u (forall a. a -> Maybe a
Just Id
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 -> Id
u_node_k_ix U_Node
n = forall a. a -> Maybe a -> a
fromMaybe forall a. Bounded a => a
maxBound (U_Node -> Maybe Id
u_node_k_index U_Node
n)
        cmp :: U_Node -> U_Node -> Ordering
cmp = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` U_Node -> Id
u_node_k_ix
        c' :: [U_Node]
c' = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy U_Node -> U_Node -> Ordering
cmp [U_Node]
c
        coheres :: Id -> U_Node -> Bool
coheres Id
z = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a. Eq a => a -> a -> Bool
== Id
z) forall b c a. (b -> c) -> (a -> b) -> a -> c
. U_Node -> Maybe Id
u_node_k_index
        coherent :: Bool
coherent = forall (t :: * -> *). Foldable t => t Bool -> Bool
and (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Id -> U_Node -> Bool
coheres [Id
0..] [U_Node]
c')
    in if Bool
coherent then [U_Node]
c' else forall a. HasCallStack => String -> a
error (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 Rate.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
Rate.InitialisationRate) -> forall a. a -> Maybe a
Just K_Type
Rate.K_InitialisationRate
      (String
"Control",Rate
Rate.ControlRate) -> forall a. a -> Maybe a
Just K_Type
Rate.K_ControlRate
      (String
"TrigControl",Rate
Rate.ControlRate) -> forall a. a -> Maybe a
Just K_Type
Rate.K_TriggerRate
      (String
"AudioControl",Rate
Rate.AudioRate) -> forall a. a -> Maybe a
Just K_Type
Rate.K_AudioRate
      (String, Rate)
_ -> 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 Id
_ Rate
_ String
s [From_Port]
_ [Rate]
_ Special
_ UgenId
_ -> String
s 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 -> Id
u_node_id U_Node
n forall a. Eq a => a -> a -> Bool
== -Id
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 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] -> Id
u_node_localbuf_count [U_Node]
us =
    case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall a. Eq a => a -> a -> Bool
(==) String
"MaxLocalBufs" 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 -> forall (t :: * -> *) a. Foldable t => t a -> Id
length (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
(==) String
"LocalBuf" forall b c a. (b -> c) -> (a -> b) -> a -> c
. U_Node -> String
u_node_u_name) [U_Node]
us)
      Just U_Node
_ -> Id
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.Id -> Rate.K_Type -> [U_Node] -> Int
u_node_fetch_k :: Id -> K_Type -> [U_Node] -> Id
u_node_fetch_k Id
z K_Type
t =
    let recur :: t -> [U_Node] -> t
recur t
i [U_Node]
ns =
            case [U_Node]
ns of
              [] -> forall a. HasCallStack => String -> a
error String
"u_node_fetch_k"
              U_Node
n:[U_Node]
ns' -> if Id
z forall a. Eq a => a -> a -> Bool
== U_Node -> Id
u_node_id U_Node
n
                       then t
i
                       else if K_Type
t 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 forall a. Num a => a -> a -> a
+ t
1) [U_Node]
ns'
                            else t -> [U_Node] -> t
recur t
i [U_Node]
ns'
    in forall {t}. Num t => t -> [U_Node] -> t
recur Id
0

-- | All the elements of a U_Node_U, except the u_node_id.
type U_Node_NoId = (Rate.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 :: (Rate, String, [From_Port], [Rate], Special, UgenId)
-> U_Node -> Bool
u_node_eq_noid (Rate, String, [From_Port], [Rate], Special, UgenId)
x U_Node
nd =
    case U_Node
nd of
      U_Node_U Id
_ 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) forall a. Eq a => a -> a -> Bool
== (Rate, String, [From_Port], [Rate], Special, UgenId)
x
      U_Node
_ ->  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] -> [(Rate.K_Type,Int)]
u_node_mk_ktype_map :: [U_Node] -> [(K_Type, Id)]
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. a -> (a, a)
g (U_Node -> Maybe K_Type
u_node_ktype U_Node
n)
    in forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. (a, U_Node) -> Maybe (K_Type, a)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Id
0..]

-- * Nodes (Implicit)

-- | 4-tuple to count 'K_Type's, ie. (InitialisationRate,ControlRate,TriggerRate,AudioRate).
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
Rate.K_InitialisationRate -> (a
iforall a. Num a => a -> a -> a
+a
1,b
k,c
t,d
a)
                                     K_Type
Rate.K_ControlRate -> (a
i,b
kforall a. Num a => a -> a -> a
+b
1,c
t,d
a)
                                     K_Type
Rate.K_TriggerRate -> (a
i,b
k,c
tforall a. Num a => a -> a -> a
+c
1,d
a)
                                     K_Type
Rate.K_AudioRate -> (a
i,b
k,c
t,d
aforall 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 forall {a} {b} {c} {d}.
(Num a, Num b, Num c, Num d) =>
(a, b, c, d) -> [U_Node] -> (a, b, c, d)
recur (Id
0,Id
0,Id
0,Id
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 (Id
ni,Id
nk,Id
nt,Id
na) = [U_Node] -> U_NODE_KS_COUNT
u_node_ks_count [U_Node]
ks
        mk_n :: K_Type -> Id -> Id -> Maybe U_Node
mk_n K_Type
t Id
n Id
o =
            let (String
nm,Rate
r) = case K_Type
t of
                            K_Type
Rate.K_InitialisationRate -> (String
"Control",Rate
Rate.InitialisationRate)
                            K_Type
Rate.K_ControlRate -> (String
"Control",Rate
Rate.ControlRate)
                            K_Type
Rate.K_TriggerRate -> (String
"TrigControl",Rate
Rate.ControlRate)
                            K_Type
Rate.K_AudioRate -> (String
"AudioControl",Rate
Rate.AudioRate)
                i :: [Rate]
i = forall a. Id -> a -> [a]
replicate Id
n Rate
r
            in if Id
n forall a. Eq a => a -> a -> Bool
== Id
0
               then forall a. Maybe a
Nothing
               else forall a. a -> Maybe a
Just (Id
-> Rate
-> String
-> [From_Port]
-> [Rate]
-> Special
-> UgenId
-> U_Node
U_Node_U (-Id
1) Rate
r String
nm [] [Rate]
i (Id -> Special
Special Id
o) UgenId
no_id)
    in forall a. [Maybe a] -> [a]
catMaybes [K_Type -> Id -> Id -> Maybe U_Node
mk_n K_Type
Rate.K_InitialisationRate Id
ni Id
0
                 ,K_Type -> Id -> Id -> Maybe U_Node
mk_n K_Type
Rate.K_ControlRate Id
nk Id
ni
                 ,K_Type -> Id -> Id -> Maybe U_Node
mk_n K_Type
Rate.K_TriggerRate Id
nt (Id
ni forall a. Num a => a -> a -> a
+ Id
nk)
                 ,K_Type -> Id -> Id -> Maybe U_Node
mk_n K_Type
Rate.K_AudioRate Id
na (Id
ni forall a. Num a => a -> a -> a
+ Id
nk forall a. Num a => a -> a -> a
+ Id
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 = forall a. (a -> Bool) -> [a] -> [a]
filter From_Port -> Bool
is_from_port_u (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [U_Edge]
e)
        p' :: [[From_Port]]
p' = forall a. Eq a => [a] -> [[a]]
group (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` From_Port -> Id
from_port_nid) [From_Port]
p)
    in forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
head (forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
> Id
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Id
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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap U_Node -> [U_Edge]
u_node_in_edges 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 = Id -> [U_Node] -> [U_Node] -> [U_Node] -> U_Graph
U_Graph Id
0 [] [] []

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

-- | Find 'U_Node' with indicated 'Uid.Id'.
ug_find_node :: U_Graph -> Uid.Id -> Maybe U_Node
ug_find_node :: U_Graph -> Id -> Maybe U_Node
ug_find_node (U_Graph Id
_ [U_Node]
cs [U_Node]
ks [U_Node]
us) Id
n =
    let f :: U_Node -> Bool
f U_Node
x = U_Node -> Id
u_node_id U_Node
x forall a. Eq a => a -> a -> Bool
== Id
n
    in forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find U_Node -> Bool
f ([U_Node]
cs forall a. [a] -> [a] -> [a]
++ [U_Node]
ks 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 -> Id -> Maybe U_Node
ug_find_node U_Graph
g (From_Port -> Id
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 = forall a. HasCallStack => String -> a
error String
"ug_from_port_node_err"
    in forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e (U_Graph -> From_Port -> Maybe U_Node
ug_from_port_node U_Graph
g From_Port
fp)

-- * Graph (Construct from Ugen)

-- | 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 = Id -> Sample -> U_Node
U_Node_C (U_Graph -> Id
ug_next_id U_Graph
g) Sample
x
    in (U_Node
n,U_Graph
g {ug_constants :: [U_Node]
ug_constants = U_Node
n forall a. a -> [a] -> [a]
: U_Graph -> [U_Node]
ug_constants U_Graph
g
            ,ug_next_id :: Id
ug_next_id = U_Graph -> Id
ug_next_id U_Graph
g forall a. Num a => a -> a -> a
+ Id
1})

{- | Either find existing 'Constant' 'U_Node', or insert a new 'U_Node'.
     Brackets are discarded.
-}
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 Brackets
_b) U_Graph
g =
    let y :: Maybe U_Node
y = 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 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 Id
ix String
nm Sample
d Bool
tr Maybe (Control_Meta Sample)
meta Brackets
_brk) U_Graph
g =
    let n :: U_Node
n = Id
-> Rate
-> Maybe Id
-> String
-> Sample
-> K_Type
-> Maybe (Control_Meta Sample)
-> U_Node
U_Node_K (U_Graph -> Id
ug_next_id U_Graph
g) Rate
r Maybe Id
ix String
nm Sample
d (Rate -> Bool -> K_Type
Rate.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 forall a. a -> [a] -> [a]
: U_Graph -> [U_Node]
ug_controls U_Graph
g
            ,ug_next_id :: Id
ug_next_id = U_Graph -> Id
ug_next_id U_Graph
g forall a. Num a => a -> a -> a
+ Id
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 = 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 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 :: (Rate, String, [From_Port], [Rate], Special, UgenId)
-> 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 = Id
-> Rate
-> String
-> [From_Port]
-> [Rate]
-> Special
-> UgenId
-> U_Node
U_Node_U (U_Graph -> Id
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 forall a. a -> [a] -> [a]
: U_Graph -> [U_Node]
ug_ugens U_Graph
g
            ,ug_next_id :: Id
ug_next_id = U_Graph -> Id
ug_next_id U_Graph
g forall a. Num a => a -> a -> a
+ Id
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
      [] -> (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
yforall 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.
     Brackets are discarded.
-}
ug_mk_node_u :: Primitive Ugen -> U_Graph -> (U_Node,U_Graph)
ug_mk_node_u :: Primitive Ugen -> U_Graph -> (U_Node, U_Graph)
ug_mk_node_u (Primitive Rate
r String
nm [Ugen]
i [Rate]
o Special
s UgenId
d Brackets
_b) 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'' = forall a b. (a -> b) -> [a] -> [b]
map U_Node -> From_Port
u_node_from_port [U_Node]
i'
        u :: (Rate, String, [From_Port], [Rate], Special, UgenId)
u = (Rate
r,String
nm,[From_Port]
i'',[Rate]
o,Special
s,UgenId
d)
        y :: Maybe U_Node
y = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Rate, String, [From_Port], [Rate], Special, UgenId)
-> U_Node -> Bool
u_node_eq_noid (Rate, String, [From_Port], [Rate], Special, UgenId)
u) (U_Graph -> [U_Node]
ug_ugens U_Graph
g')
    in forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((Rate, String, [From_Port], [Rate], Special, UgenId)
-> U_Graph -> (U_Node, U_Graph)
ug_push_u (Rate, String, [From_Port], [Rate], Special, UgenId)
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.  Proxies are always of U nodes.
ug_mk_node_p :: U_Node -> Port_Index -> U_Graph -> (U_Node,U_Graph)
ug_mk_node_p :: U_Node -> Id -> U_Graph -> (U_Node, U_Graph)
ug_mk_node_p U_Node
n Id
p U_Graph
g =
    let z :: Id
z = U_Graph -> Id
ug_next_id U_Graph
g
    in (Id -> Id -> Id -> Rate -> U_Node
U_Node_P Id
z (U_Node -> Id
u_node_id U_Node
n) Id
p (U_Node -> Rate
u_node_u_rate U_Node
n),U_Graph
g {ug_next_id :: Id
ug_next_id = Id
z forall a. Num a => a -> a -> a
+ Id
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
_ -> forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show (String
"ug_mk_node: label",Ugen
u))
      Primitive_U Primitive Ugen
p -> Primitive Ugen -> U_Graph -> (U_Node, U_Graph)
ug_mk_node_u Primitive Ugen
p U_Graph
g
      Proxy_U Proxy Ugen
p ->
          let (U_Node
n,U_Graph
g') = Primitive Ugen -> U_Graph -> (U_Node, U_Graph)
ug_mk_node_u (forall t. Proxy t -> Primitive t
proxySource Proxy Ugen
p) U_Graph
g
          in U_Node -> Id -> U_Graph -> (U_Node, U_Graph)
ug_mk_node_p U_Node
n (forall t. Proxy t -> Id
proxyIndex Proxy Ugen
p) U_Graph
g'
      Mrg_U Mrg Ugen
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 (forall t. Mrg t -> t
mrgLeft Mrg Ugen
m) (U_Graph -> [Ugen] -> U_Graph
f U_Graph
g (Ugen -> [Ugen]
mceChannels (forall t. Mrg t -> t
mrgRight Mrg Ugen
m)))
      Mce_U Mce Ugen
_ -> forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show (String
"ug_mk_node: mce",Ugen
u))

-- * Implicit

-- | 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 Id
z [U_Node]
cs [U_Node]
ks [U_Node]
us) = U_Graph
g
        ks' :: [U_Node]
ks' = 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 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 forall a. [a] -> [a] -> [a]
++ [U_Node]
us
    in Id -> [U_Node] -> [U_Node] -> [U_Node] -> U_Graph
U_Graph Id
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] -> Id
u_node_localbuf_count (U_Graph -> [U_Node]
ug_ugens U_Graph
g) of
      Id
0 -> U_Graph
g
      Id
n -> let (U_Node
c,U_Graph
g') = Constant -> U_Graph -> (U_Node, U_Graph)
ug_mk_node_c (Sample -> Brackets -> Constant
Constant (forall a b. (Integral a, Num b) => a -> b
fromIntegral Id
n) ([],[])) U_Graph
g
               p :: From_Port
p = U_Node -> From_Port
u_node_from_port U_Node
c
               u :: U_Node
u = Id
-> Rate
-> String
-> [From_Port]
-> [Rate]
-> Special
-> UgenId
-> U_Node
U_Node_U (-Id
1) Rate
Rate.InitialisationRate String
"MaxLocalBufs" [From_Port
p] [] (Id -> Special
Special Id
0) UgenId
no_id
           in U_Graph
g' {ug_ugens :: [U_Node]
ug_ugens = U_Node
u 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 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 = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not 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 = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== U_Node -> Id
u_node_id U_Node
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. From_Port -> Id
from_port_nid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [U_Edge]
e
        f :: To_Port -> Id
f (To_Port Id
k Id
_) = Id
k
    in forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (U_Graph -> Id -> Maybe U_Node
ug_find_node U_Graph
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. To_Port -> Id
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (U_Graph -> Id -> Maybe U_Node
ug_find_node U_Graph
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. From_Port -> Id
from_port_nid) [From_Port]
p
    in forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
Analysis.primitive_is_pv_rate 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
      [] -> forall a. Maybe a
Nothing
      [U_Node]
n ->
        let d :: [String]
d = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map U_Node -> String
u_node_u_name 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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
Analysis.primitive_is_pv_rate [String]
d Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"IFFT"]) [String]
d
           then forall a. a -> Maybe a
Just (forall a. Show a => a -> String
show (String
"PV: multiple out edges, see pv_Split",forall a b. (a -> b) -> [a] -> [b]
map U_Node -> String
u_node_u_name [U_Node]
n,[String]
d))
           else 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe U_Graph
g 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_direct :: Ugen -> U_Graph
ugen_to_graph_direct :: Ugen -> U_Graph
ugen_to_graph_direct Ugen
u =
    let (U_Node
_,U_Graph
g) = Ugen -> U_Graph -> (U_Node, U_Graph)
ug_mk_node (Ugen -> Ugen
Util.prepare_root Ugen
u) U_Graph
ug_empty_graph
        g' :: U_Graph
g' = U_Graph
g {ug_ugens :: [U_Node]
ug_ugens = 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')

{-
ugen_to_graph_netlist :: Ugen -> U_Graph
ugen_to_graph_netlist u =
    let g = netlist_to_u_graph (ugenNetlist (Util.prepare_root u))
        g' = g {ug_ugens = reverse (ug_ugens g)
               ,ug_controls = u_node_sort_controls (ug_controls g)}
    in ug_pv_validate (ug_add_implicit g')
-}

ugen_to_graph :: Ugen -> U_Graph
ugen_to_graph :: Ugen -> U_Graph
ugen_to_graph = Ugen -> U_Graph
ugen_to_graph_direct

-- * 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, Id)
h (a
x:[a]
xs) = (a
x,forall (t :: * -> *) a. Foldable t => t a -> Id
length (a
xforall a. a -> [a] -> [a]
:[a]
xs))
              h [] = forall a. HasCallStack => String -> a
error String
"graph_stat_ln"
          in [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((\(t
p,Id
q) -> t -> String
pp_f t
p forall a. [a] -> [a] -> [a]
++ String
"×" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Id
q) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. [a] -> (a, Id)
h) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [[a]]
group forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort
    in [String
"number of constants       : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Id
length [U_Node]
cs)
       ,String
"number of controls        : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Id
length [U_Node]
ks)
       ,String
"control rates             : " forall a. [a] -> [a] -> [a]
++ forall {t}. Ord t => (t -> String) -> [t] -> String
hist forall a. Show a => a -> String
show (forall a b. (a -> b) -> [a] -> [b]
map U_Node -> Rate
u_node_k_rate [U_Node]
ks)
       ,String
"control names             : " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map U_Node -> String
u_node_k_name [U_Node]
ks)
       ,String
"number of unit generators : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Id
length [U_Node]
us)
       ,String
"unit generator rates      : " forall a. [a] -> [a] -> [a]
++ forall {t}. Ord t => (t -> String) -> [t] -> String
hist Rate -> String
Rate.rateAbbrev (forall a b. (a -> b) -> [a] -> [b]
map U_Node -> Rate
u_node_u_rate [U_Node]
us)
       ,String
"unit generator set        : " forall a. [a] -> [a] -> [a]
++ forall {t}. Ord t => (t -> String) -> [t] -> String
hist forall a. a -> a
id (forall a b. (a -> b) -> [a] -> [b]
map U_Node -> String
u_node_user_name [U_Node]
us)
       ,String
"unit generator sequence   : " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (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 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 :: forall n. (Num n, Enum n) => 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 Id
_ Rate
_ String
nm' [From_Port]
_ [Rate]
_ Special
_ UgenId
_ -> if String
nm forall a. Eq a => a -> a -> Bool
== String
nm' then forall a. a -> Maybe a
Just a
k else forall a. Maybe a
Nothing
              U_Node
_ -> forall a. Maybe a
Nothing
    in forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. (a, U_Node) -> Maybe a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [n
0..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. U_Graph -> [U_Node]
ug_ugens