-- | A disassembler for UGen graphs.
module Sound.SC3.UGen.Graph.Reconstruct where

import Data.Char {- base -}
import Data.List {- base -}
import Text.Printf {- base -}

import qualified Sound.SC3.Common.Math.Operator as Operator
import qualified Sound.SC3.Common.Rate as Rate
import qualified Sound.SC3.UGen.Graph as Graph
import qualified Sound.SC3.UGen.Type as Type
import qualified Sound.SC3.UGen.UGen as UGen

-- | Generate label for 'Graph.From_Port'
from_port_label :: Char -> Graph.From_Port -> String
from_port_label :: Char -> From_Port -> String
from_port_label Char
jn From_Port
fp =
    case From_Port
fp of
      Graph.From_Port_C UID_t
n -> String -> UID_t -> String
forall r. PrintfType r => String -> r
printf String
"c_%d" UID_t
n
      Graph.From_Port_K UID_t
n K_Type
_ -> String -> UID_t -> String
forall r. PrintfType r => String -> r
printf String
"k_%d" UID_t
n
      Graph.From_Port_U UID_t
n Maybe UID_t
Nothing -> String -> UID_t -> String
forall r. PrintfType r => String -> r
printf String
"u_%d" UID_t
n
      Graph.From_Port_U UID_t
n (Just UID_t
i) -> String -> UID_t -> Char -> UID_t -> String
forall r. PrintfType r => String -> r
printf String
"u_%d%co_%d" UID_t
n Char
jn UID_t
i

-- | Any name that does not begin with a letter is considered an operator.
is_operator_name :: String -> Bool
is_operator_name :: String -> Bool
is_operator_name String
nm =
    case String
nm of
      Char
c:String
_ -> Bool -> Bool
not (Char -> Bool
isLetter Char
c)
      String
_ -> Bool
False

parenthesise_operator :: String -> String
parenthesise_operator :: String -> String
parenthesise_operator String
nm =
    if String -> Bool
is_operator_name String
nm
    then String -> String -> String
forall r. PrintfType r => String -> r
printf String
"(%s)" String
nm
    else String
nm

reconstruct_graph :: Graph.U_Graph -> ([String],String)
reconstruct_graph :: U_Graph -> ([String], String)
reconstruct_graph U_Graph
g =
    let (Graph.U_Graph UID_t
_ [U_Node]
c [U_Node]
k [U_Node]
u) = U_Graph
g
        ls :: [String]
ls = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [(U_Node -> String) -> [U_Node] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> String
reconstruct_c_str ([U_Node] -> [U_Node]
Graph.u_node_sort [U_Node]
c)
                    ,(U_Node -> String) -> [U_Node] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> String
reconstruct_k_str ([U_Node] -> [U_Node]
Graph.u_node_sort [U_Node]
k)
                    ,(U_Node -> [String]) -> [U_Node] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap U_Node -> [String]
reconstruct_u_str [U_Node]
u]
    in ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [String]
ls,[U_Node] -> String
reconstruct_mrg_str [U_Node]
u)

reconstruct_graph_module :: String -> Graph.U_Graph -> [String]
reconstruct_graph_module :: String -> U_Graph -> [String]
reconstruct_graph_module String
nm U_Graph
gr =
  let imp :: [String]
imp = [String
"import Sound.SC3 {- hsc3 -}"
            ,String
"import Sound.SC3.Common.Base {- hsc3 -}"
            ,String
"import Sound.SC3.UGen.Plain {- hsc3 -}"]
      (String
b0:[String]
bnd,String
res) = U_Graph -> ([String], String)
reconstruct_graph U_Graph
gr
      hs :: [String]
hs = (String
"  let " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b0) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"      " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ) [String]
bnd [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"  in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
res]
      pre :: [String]
pre = [String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" :: UGen",String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ="]
  in ([String]
imp [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
pre [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
hs)

{- | Generate a reconstruction of a 'Graph'.

> import Sound.SC3 {- hsc3 -}
> import Sound.SC3.UGen.Graph {- hsc3 -}
> import Sound.SC3.UGen.Graph.Reconstruct {- hsc3 -}

> let k = control KR "bus" 0
> let o = sinOsc AR 440 0 + whiteNoise 'α' AR
> let u = out k (pan2 (o * 0.1) 0 1)
> let m = mrg [u,out 1 (impulse AR 1 0 * 0.1)]
> putStrLn (reconstruct_graph_str "anon" (ugen_to_graph m))

-}
reconstruct_graph_str :: String -> Graph.U_Graph -> String
reconstruct_graph_str :: String -> U_Graph -> String
reconstruct_graph_str String
nm = [String] -> String
unlines ([String] -> String) -> (U_Graph -> [String]) -> U_Graph -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> U_Graph -> [String]
reconstruct_graph_module String
nm

reconstruct_c_str :: Graph.U_Node -> String
reconstruct_c_str :: U_Node -> String
reconstruct_c_str U_Node
u =
    let l :: String
l = U_Node -> String
Graph.u_node_label U_Node
u
        c :: Sample
c = U_Node -> Sample
Graph.u_node_c_value U_Node
u
    in String -> String -> Sample -> String
forall r. PrintfType r => String -> r
printf String
"%s = constant (%f::Sample)" String
l Sample
c

reconstruct_c_ugen :: Graph.U_Node -> Type.UGen
reconstruct_c_ugen :: U_Node -> UGen
reconstruct_c_ugen U_Node
u = Sample -> UGen
forall n. Real n => n -> UGen
Type.constant (U_Node -> Sample
Graph.u_node_c_value U_Node
u)

-- | Discards index.
reconstruct_k_rnd :: Graph.U_Node -> (Rate.Rate,String,Type.Sample)
reconstruct_k_rnd :: U_Node -> (Rate, String, Sample)
reconstruct_k_rnd U_Node
u =
    let r :: Rate
r = U_Node -> Rate
Graph.u_node_k_rate U_Node
u
        n :: String
n = U_Node -> String
Graph.u_node_k_name U_Node
u
        d :: Sample
d = U_Node -> Sample
Graph.u_node_k_default U_Node
u
    in (Rate
r,String
n,Sample
d)

reconstruct_k_str :: Graph.U_Node -> String
reconstruct_k_str :: U_Node -> String
reconstruct_k_str U_Node
u =
    let l :: String
l = U_Node -> String
Graph.u_node_label U_Node
u
        (Rate
r,String
n,Sample
d) = U_Node -> (Rate, String, Sample)
reconstruct_k_rnd U_Node
u
    in String -> String -> String -> String -> Sample -> String
forall r. PrintfType r => String -> r
printf String
"%s = control %s \"%s\" %f" String
l (Rate -> String
forall a. Show a => a -> String
show Rate
r) String
n Sample
d

reconstruct_k_ugen :: Graph.U_Node -> Type.UGen
reconstruct_k_ugen :: U_Node -> UGen
reconstruct_k_ugen U_Node
u =
    let (Rate
r,String
n,Sample
d) = U_Node -> (Rate, String, Sample)
reconstruct_k_rnd U_Node
u
    in Rate -> Maybe UID_t -> String -> Sample -> UGen
UGen.control_f64 Rate
r Maybe UID_t
forall a. Maybe a
Nothing String
n Sample
d

ugen_qname :: String -> Type.Special -> (String,String)
ugen_qname :: String -> Special -> (String, String)
ugen_qname String
nm (Type.Special UID_t
n) =
    case String
nm of
      String
"UnaryOpUGen" -> (String
"uop CS",UID_t -> String
Operator.unaryName UID_t
n)
      String
"BinaryOpUGen" -> (String
"binop CS",UID_t -> String
Operator.binaryName UID_t
n)
      String
_ -> (String
"ugen",String
nm)

reconstruct_mce_str :: Graph.U_Node -> String
reconstruct_mce_str :: U_Node -> String
reconstruct_mce_str U_Node
u =
    let o :: UID_t
o = [Rate] -> UID_t
forall (t :: * -> *) a. Foldable t => t a -> UID_t
length (U_Node -> [Rate]
Graph.u_node_u_outputs U_Node
u)
        l :: String
l = U_Node -> String
Graph.u_node_label U_Node
u
        p :: [String]
p = (UID_t -> String) -> [UID_t] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> UID_t -> String
forall r. PrintfType r => String -> r
printf String
"%s_o_%d" String
l) [UID_t
0 .. UID_t
o UID_t -> UID_t -> UID_t
forall a. Num a => a -> a -> a
- UID_t
1]
        p' :: String
p' = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
p
    in if UID_t
o UID_t -> UID_t -> Bool
forall a. Ord a => a -> a -> Bool
<= UID_t
1
       then String
""
       else String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"[%s] = mceChannels %s" String
p' String
l

reconstruct_u_str :: Graph.U_Node -> [String]
reconstruct_u_str :: U_Node -> [String]
reconstruct_u_str U_Node
u =
    let l :: String
l = U_Node -> String
Graph.u_node_label U_Node
u
        r :: Rate
r = U_Node -> Rate
Graph.u_node_u_rate U_Node
u
        i :: [From_Port]
i = U_Node -> [From_Port]
Graph.u_node_u_inputs U_Node
u
        i_s :: String
i_s = [String] -> String
unwords ((From_Port -> String) -> [From_Port] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> From_Port -> String
from_port_label Char
'_') [From_Port]
i)
        i_l :: String
i_l = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((From_Port -> String) -> [From_Port] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> From_Port -> String
from_port_label Char
'_') [From_Port]
i)
        s :: Special
s = U_Node -> Special
Graph.u_node_u_special U_Node
u
        (String
q,String
n) = String -> Special -> (String, String)
ugen_qname (U_Node -> String
Graph.u_node_u_name U_Node
u) Special
s
        z :: UID_t
z = U_Node -> UID_t
Graph.u_node_id U_Node
u
        o :: UID_t
o = [Rate] -> UID_t
forall (t :: * -> *) a. Foldable t => t a -> UID_t
length (U_Node -> [Rate]
Graph.u_node_u_outputs U_Node
u)
        u_s :: String
u_s = String -> String -> String -> String -> String -> UID_t -> String
forall r. PrintfType r => String -> r
printf String
"%s = ugen \"%s\" %s [%s] %d" String
l String
n (Rate -> String
forall a. Show a => a -> String
show Rate
r) String
i_l UID_t
o
        nd_s :: String
nd_s = let t :: String
t = String
"%s = nondet \"%s\" (UId %d) %s [%s] %d"
               in String
-> String -> String -> UID_t -> String -> String -> UID_t -> String
forall r. PrintfType r => String -> r
printf String
t String
l String
n UID_t
z (Rate -> String
forall a. Show a => a -> String
show Rate
r) String
i_l UID_t
o
        c :: String
c = case String
q of
              String
"ugen" -> if U_Node -> UGenId
Graph.u_node_u_ugenid U_Node
u UGenId -> UGenId -> Bool
forall a. Eq a => a -> a -> Bool
== UGenId
Type.NoId then String
u_s else String
nd_s
              String
_ -> String -> String -> String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s = %s \"%s\" %s %s" String
l String
q String
n (Rate -> String
forall a. Show a => a -> String
show Rate
r) String
i_s
        m :: String
m = U_Node -> String
reconstruct_mce_str U_Node
u
    in if U_Node -> Bool
Graph.u_node_is_implicit_control U_Node
u
       then []
       else if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
m then [String
c] else [String
c,String
m]

reconstruct_mrg_str :: [Graph.U_Node] -> String
reconstruct_mrg_str :: [U_Node] -> String
reconstruct_mrg_str [U_Node]
u =
    let zero_out :: U_Node -> Bool
zero_out U_Node
n = Bool -> Bool
not (U_Node -> Bool
Graph.u_node_is_implicit_control U_Node
n) Bool -> Bool -> Bool
&& [Rate] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (U_Node -> [Rate]
Graph.u_node_u_outputs U_Node
n)
    in case (U_Node -> String) -> [U_Node] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> String
Graph.u_node_label ((U_Node -> Bool) -> [U_Node] -> [U_Node]
forall a. (a -> Bool) -> [a] -> [a]
filter U_Node -> Bool
zero_out [U_Node]
u) of
         [] -> String -> String
forall a. HasCallStack => String -> a
error String
"reconstruct_mrg_str: nil input?"
         [String
o] -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s" String
o
         [String]
o -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"mrg [%s]" (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
o)