{- | '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 Safe {- safe -}

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
(From_Port -> From_Port -> Bool)
-> (From_Port -> From_Port -> Bool) -> Eq From_Port
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: From_Port -> From_Port -> Bool
== :: From_Port -> From_Port -> Bool
$c/= :: From_Port -> From_Port -> Bool
/= :: From_Port -> From_Port -> Bool
Eq, Id -> From_Port -> ShowS
[From_Port] -> ShowS
From_Port -> String
(Id -> From_Port -> ShowS)
-> (From_Port -> String)
-> ([From_Port] -> ShowS)
-> Show From_Port
forall a.
(Id -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Id -> From_Port -> ShowS
showsPrec :: Id -> From_Port -> ShowS
$cshow :: From_Port -> String
show :: From_Port -> String
$cshowList :: [From_Port] -> ShowS
showList :: [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
(To_Port -> To_Port -> Bool)
-> (To_Port -> To_Port -> Bool) -> Eq To_Port
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: To_Port -> To_Port -> Bool
== :: To_Port -> To_Port -> Bool
$c/= :: To_Port -> To_Port -> Bool
/= :: To_Port -> To_Port -> Bool
Eq, Id -> To_Port -> ShowS
[To_Port] -> ShowS
To_Port -> String
(Id -> To_Port -> ShowS)
-> (To_Port -> String) -> ([To_Port] -> ShowS) -> Show To_Port
forall a.
(Id -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Id -> To_Port -> ShowS
showsPrec :: Id -> To_Port -> ShowS
$cshow :: To_Port -> String
show :: To_Port -> String
$cshowList :: [To_Port] -> ShowS
showList :: [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
(U_Node -> U_Node -> Bool)
-> (U_Node -> U_Node -> Bool) -> Eq U_Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: U_Node -> U_Node -> Bool
== :: U_Node -> U_Node -> Bool
$c/= :: U_Node -> U_Node -> Bool
/= :: U_Node -> U_Node -> Bool
Eq, Id -> U_Node -> ShowS
[U_Node] -> ShowS
U_Node -> String
(Id -> U_Node -> ShowS)
-> (U_Node -> String) -> ([U_Node] -> ShowS) -> Show U_Node
forall a.
(Id -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Id -> U_Node -> ShowS
showsPrec :: Id -> U_Node -> ShowS
$cshow :: U_Node -> String
show :: U_Node -> String
$cshowList :: [U_Node] -> ShowS
showList :: [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 K_Type -> K_Type -> Bool
forall a. Eq a => a -> a -> Bool
== K_Type
Rate.K_TriggerRate) Maybe (Control_Meta Sample)
mt Brackets
emptyBrackets
    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 -> 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
(Id -> U_Graph -> ShowS)
-> (U_Graph -> String) -> ([U_Graph] -> ShowS) -> Show U_Graph
forall a.
(Id -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Id -> U_Graph -> ShowS
showsPrec :: Id -> U_Graph -> ShowS
$cshow :: U_Graph -> String
show :: U_Graph -> String
$cshowList :: [U_Graph] -> ShowS
showList :: [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 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 Id
_ Rate
_ Maybe Id
_ 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 (Id -> Id -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Id -> Id -> Ordering)
-> (U_Node -> Id) -> U_Node -> U_Node -> Ordering
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 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. '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_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Id -> String
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_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show Id
n
    U_Node_U Id
n Rate
_ String
_ [From_Port]
_ [Rate]
_ Special
_ UgenId
_ -> String
"u_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show Id
n
    U_Node_P Id
n Id
_ Id
_ Rate
_ -> String
"p_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Id -> String
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
_ -> [From_Port] -> [To_Port] -> [U_Edge]
forall a b. [a] -> [b] -> [(a, b)]
zip [From_Port]
i ((Id -> To_Port) -> [Id] -> [To_Port]
forall a b. (a -> b) -> [a] -> [b]
map (Id -> Id -> To_Port
To_Port Id
x) [Id
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 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 Maybe Id
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 Id
_ Id
u Id
p Rate
_ -> Id -> Maybe Id -> From_Port
From_Port_U Id
u (Id -> Maybe Id
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 = Id -> Maybe Id -> Id
forall a. a -> Maybe a -> a
fromMaybe Id
forall a. Bounded a => a
maxBound (U_Node -> Maybe Id
u_node_k_index U_Node
n)
      cmp :: U_Node -> U_Node -> Ordering
cmp = Id -> Id -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Id -> Id -> Ordering)
-> (U_Node -> Id) -> U_Node -> U_Node -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` U_Node -> Id
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 :: Id -> U_Node -> Bool
coheres Id
z = Bool -> (Id -> Bool) -> Maybe Id -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
z) (Maybe Id -> Bool) -> (U_Node -> Maybe Id) -> U_Node -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U_Node -> Maybe Id
u_node_k_index
      coherent :: Bool
coherent = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Id -> U_Node -> Bool) -> [Id] -> [U_Node] -> [Bool]
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 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 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) -> K_Type -> Maybe K_Type
forall a. a -> Maybe a
Just K_Type
Rate.K_InitialisationRate
    (String
"Control", Rate
Rate.ControlRate) -> K_Type -> Maybe K_Type
forall a. a -> Maybe a
Just K_Type
Rate.K_ControlRate
    (String
"TrigControl", Rate
Rate.ControlRate) -> K_Type -> Maybe K_Type
forall a. a -> Maybe a
Just K_Type
Rate.K_TriggerRate
    (String
"AudioControl", Rate
Rate.AudioRate) -> K_Type -> Maybe K_Type
forall a. a -> Maybe a
Just K_Type
Rate.K_AudioRate
    (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 Id
_ Rate
_ String
s [From_Port]
_ [Rate]
_ Special
_ UgenId
_ -> String
s String -> [String] -> Bool
forall a. Eq a => a -> [a] -> 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 -> Id
u_node_id U_Node
n Id -> Id -> Bool
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 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] -> Id
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] -> Id
forall a. [a] -> Id
forall (t :: * -> *) a. Foldable t => t a -> Id
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
_ -> 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
          [] -> String -> t
forall a. HasCallStack => String -> a
error String
"u_node_fetch_k"
          U_Node
n : [U_Node]
ns' ->
            if Id
z Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== U_Node -> Id
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 Id -> [U_Node] -> Id
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) (Rate, String, [From_Port], [Rate], Special, UgenId)
-> (Rate, String, [From_Port], [Rate], Special, UgenId) -> Bool
forall a. Eq a => a -> a -> Bool
== (Rate, String, [From_Port], [Rate], Special, UgenId)
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] -> [(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 (K_Type -> (K_Type, a)) -> Maybe K_Type -> Maybe (K_Type, a)
forall a b. (a -> b) -> Maybe a -> Maybe b
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 ((Id, U_Node) -> Maybe (K_Type, Id))
-> [(Id, U_Node)] -> [(K_Type, Id)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Id, U_Node) -> Maybe (K_Type, Id)
forall {a}. (a, U_Node) -> Maybe (K_Type, a)
f ([(Id, U_Node)] -> [(K_Type, Id)])
-> ([U_Node] -> [(Id, U_Node)]) -> [U_Node] -> [(K_Type, Id)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Id] -> [U_Node] -> [(Id, U_Node)]
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
i a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
k, c
t, d
a)
                    K_Type
Rate.K_ControlRate -> (a
i, b
k b -> b -> b
forall a. Num a => a -> a -> a
+ b
1, c
t, d
a)
                    K_Type
Rate.K_TriggerRate -> (a
i, b
k, c
t c -> c -> c
forall a. Num a => a -> a -> a
+ c
1, d
a)
                    K_Type
Rate.K_AudioRate -> (a
i, b
k, c
t, d
a d -> 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 (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.
The special-index holds the accumulated offset where multiple Control Ugens (at different rates) 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 = Id -> Rate -> [Rate]
forall a. Id -> a -> [a]
replicate Id
n Rate
r
        in if Id
n Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
0
            then Maybe U_Node
forall a. Maybe a
Nothing
            else U_Node -> Maybe U_Node
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 [Maybe U_Node] -> [U_Node]
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 Id -> Id -> Id
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 Id -> Id -> Id
forall a. Num a => a -> a -> a
+ Id
nk Id -> Id -> Id
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 = (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 (Id -> Id -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Id -> Id -> Ordering)
-> (From_Port -> Id) -> From_Port -> From_Port -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` From_Port -> Id
from_port_nid) [From_Port]
p)
  in ([From_Port] -> From_Port) -> [[From_Port]] -> [From_Port]
forall a b. (a -> b) -> [a] -> [b]
map (String -> [From_Port] -> From_Port
forall a. HasCallStack => String -> [a] -> a
Safe.headNote String
"u_edge_multiple_out_edges") (([From_Port] -> Bool) -> [[From_Port]] -> [[From_Port]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Id -> Id -> Bool
forall a. Ord a => a -> a -> Bool
> Id
1) (Id -> Bool) -> ([From_Port] -> Id) -> [From_Port] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [From_Port] -> Id
forall a. [a] -> Id
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 = (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 = 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' = [Id] -> Id
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((U_Node -> Id) -> [U_Node] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> Id
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 Id
z' Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
/= Id
z
      then String -> Id
forall a. HasCallStack => String -> a
error ((String, Id, Id) -> String
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 Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
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 -> 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 = 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 (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 = n : ug_constants g
        , ug_next_id = ug_next_id g + 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 = (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 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 = n : ug_controls g
        , ug_next_id = ug_next_id g + 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 :: (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 = n : ug_ugens g
        , ug_next_id = ug_next_id g + 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
y U_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.
     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'' = (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 :: (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 = (U_Node -> Bool) -> [U_Node] -> Maybe U_Node
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 (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 ((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 = z + 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 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 (Proxy Ugen -> Primitive Ugen
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 (Proxy Ugen -> Id
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 (Mrg Ugen -> Ugen
forall t. Mrg t -> t
mrgLeft Mrg Ugen
m) (U_Graph -> [Ugen] -> U_Graph
f U_Graph
g (Ugen -> [Ugen]
mceChannels (Mrg Ugen -> Ugen
forall t. Mrg t -> t
mrgRight Mrg Ugen
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))

-- * 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' = (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 a. [a] -> 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 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 (Id -> Sample
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 : ug_ugens 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}

-- * 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 ((Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== U_Node -> Id
u_node_id U_Node
n) (Id -> Bool) -> (U_Edge -> Id) -> U_Edge -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. From_Port -> Id
from_port_nid (From_Port -> Id) -> (U_Edge -> From_Port) -> U_Edge -> Id
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 -> Id
f (To_Port Id
k Id
_) = Id
k
  in (U_Edge -> Maybe U_Node) -> [U_Edge] -> [U_Node]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (U_Graph -> Id -> Maybe U_Node
ug_find_node U_Graph
g (Id -> Maybe U_Node) -> (U_Edge -> Id) -> U_Edge -> Maybe U_Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. To_Port -> Id
f (To_Port -> Id) -> (U_Edge -> To_Port) -> U_Edge -> Id
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 -> Id -> Maybe U_Node
ug_find_node U_Graph
g (Id -> Maybe U_Node)
-> (From_Port -> Id) -> From_Port -> Maybe U_Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. From_Port -> Id
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 a. Eq a => a -> [a] -> 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_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 = reverse (ug_ugens g)
          , ug_controls = u_node_sort_controls (ug_controls 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, [a] -> Id
forall a. [a] -> Id
forall (t :: * -> *) a. Foldable t => t a -> Id
length (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs))
            h [] = String -> (a, Id)
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, Id
q) -> t -> String
pp_f t
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"×" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show Id
q) ((t, Id) -> String) -> ([t] -> (t, Id)) -> [t] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [t] -> (t, Id)
forall {a}. [a] -> (a, Id)
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]
++ Id -> String
forall a. Show a => a -> String
show ([U_Node] -> Id
forall a. [a] -> Id
forall (t :: * -> *) a. Foldable t => t a -> Id
length [U_Node]
cs)
     , String
"number of controls        : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show ([U_Node] -> Id
forall a. [a] -> Id
forall (t :: * -> *) a. Foldable t => t a -> Id
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]
++ Id -> String
forall a. Show a => a -> String
show ([U_Node] -> Id
forall a. [a] -> Id
forall (t :: * -> *) a. Foldable t => t a -> Id
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
Rate.rateAbbrev ((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 :: 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 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