-- | 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.Types as Types
import qualified Sound.Sc3.Ugen.Util as Util

-- | 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 Int
n -> forall r. PrintfType r => String -> r
printf String
"c_%d" Int
n
      Graph.From_Port_K Int
n K_Type
_ -> forall r. PrintfType r => String -> r
printf String
"k_%d" Int
n
      Graph.From_Port_U Int
n Maybe Int
Nothing -> forall r. PrintfType r => String -> r
printf String
"u_%d" Int
n
      Graph.From_Port_U Int
n (Just Int
i) -> forall r. PrintfType r => String -> r
printf String
"u_%d%co_%d" Int
n Char
jn Int
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 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 Int
_ [U_Node]
c [U_Node]
k [U_Node]
u) = U_Graph
g
        ls :: [String]
ls = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [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)
                    ,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)
                    ,forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap U_Node -> [String]
reconstruct_u_str [U_Node]
u]
    in (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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.Util.Plain {- hsc3 -}"]
      (String
b0:[String]
bnd,String
res) = U_Graph -> ([String], String)
reconstruct_graph U_Graph
gr
      hs :: [String]
hs = (String
"  let " forall a. [a] -> [a] -> [a]
++ String
b0) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (String
"      " forall a. [a] -> [a] -> [a]
++ ) [String]
bnd forall a. [a] -> [a] -> [a]
++ [String
"  in " forall a. [a] -> [a] -> [a]
++ String
res]
      pre :: [String]
pre = [String
nm forall a. [a] -> [a] -> [a]
++ String
" :: Ugen",String
nm forall a. [a] -> [a] -> [a]
++ String
" ="]
  in ([String]
imp forall a. [a] -> [a] -> [a]
++ [String]
pre forall a. [a] -> [a] -> [a]
++ [String]
hs)

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

> import Sound.Sc3 {- hsc3 -}
> import Sound.Sc3.Util.Graph {- hsc3 -}
> import Sound.Sc3.Util.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 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 forall r. PrintfType r => String -> r
printf String
"%s = constant (%f::Sample)" String
l Sample
c

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

-- | Discards index.
reconstruct_k_rnd :: Graph.U_Node -> (Rate.Rate,String,Types.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 forall r. PrintfType r => String -> r
printf String
"%s = control %s \"%s\" %f" String
l (forall a. Show a => a -> String
show Rate
r) String
n Sample
d

reconstruct_k_ugen :: Graph.U_Node -> Types.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 Int -> String -> Sample -> Ugen
Util.control_f64 Rate
r forall a. Maybe a
Nothing String
n Sample
d

ugen_qname :: String -> Types.Special -> (String,String)
ugen_qname :: String -> Special -> (String, String)
ugen_qname String
nm (Types.Special Int
n) =
    case String
nm of
      String
"UnaryOpUGen" -> (String
"uop CS",Int -> String
Operator.unaryName Int
n)
      String
"BinaryOpUGen" -> (String
"binop CS",Int -> String
Operator.binaryName Int
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 :: Int
o = forall (t :: * -> *) a. Foldable t => t a -> Int
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 = forall a b. (a -> b) -> [a] -> [b]
map (forall r. PrintfType r => String -> r
printf String
"%s_o_%d" String
l) [Int
0 .. Int
o forall a. Num a => a -> a -> a
- Int
1]
        p' :: String
p' = forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
p
    in if Int
o forall a. Ord a => a -> a -> Bool
<= Int
1
       then String
""
       else 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 (forall a b. (a -> b) -> [a] -> [b]
map (Char -> From_Port -> String
from_port_label Char
'_') [From_Port]
i)
        i_l :: String
i_l = forall a. [a] -> [[a]] -> [a]
intercalate 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 :: Int
z = U_Node -> Int
Graph.u_node_id U_Node
u
        o :: Int
o = forall (t :: * -> *) a. Foldable t => t a -> Int
length (U_Node -> [Rate]
Graph.u_node_u_outputs U_Node
u)
        u_s :: String
u_s = forall r. PrintfType r => String -> r
printf String
"%s = ugen \"%s\" %s [%s] %d" String
l String
n (forall a. Show a => a -> String
show Rate
r) String
i_l Int
o
        nd_s :: String
nd_s = let t :: String
t = String
"%s = nondet \"%s\" (UId %d) %s [%s] %d"
               in forall r. PrintfType r => String -> r
printf String
t String
l String
n Int
z (forall a. Show a => a -> String
show Rate
r) String
i_l Int
o
        c :: String
c = case String
q of
              String
"ugen" -> if U_Node -> UgenId
Graph.u_node_u_ugenid U_Node
u forall a. Eq a => a -> a -> Bool
== UgenId
Types.NoId then String
u_s else String
nd_s
              String
_ -> forall r. PrintfType r => String -> r
printf String
"%s = %s \"%s\" %s %s" String
l String
q String
n (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 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
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null (U_Node -> [Rate]
Graph.u_node_u_outputs U_Node
n)
    in case forall a b. (a -> b) -> [a] -> [b]
map U_Node -> String
Graph.u_node_label (forall a. (a -> Bool) -> [a] -> [a]
filter U_Node -> Bool
zero_out [U_Node]
u) of
         [] -> forall a. HasCallStack => String -> a
error String
"reconstruct_mrg_str: nil input?"
         [String
o] -> forall r. PrintfType r => String -> r
printf String
"%s" String
o
         [String]
o -> forall r. PrintfType r => String -> r
printf String
"mrg [%s]" (forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
o)