-- | 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 -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"c_%d" Int
n
    Graph.From_Port_K Int
n K_Type
_ -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"k_%d" Int
n
    Graph.From_Port_U Int
n Maybe Int
Nothing -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"u_%d" Int
n
    Graph.From_Port_U Int
n (Just Int
i) -> String -> Int -> Char -> Int -> String
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 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 Int
_ [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 a. [a] -> 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 -}"
        ]
  in case U_Graph -> ([String], String)
reconstruct_graph U_Graph
gr of
      (String
b0 : [String]
bnd, String
res) ->
        let 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)
      ([String], String)
_ -> String -> [String]
forall a. HasCallStack => String -> a
error String
"reconstruct_graph_module"

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

> import Sound.Sc3
> import Sound.Sc3.Ugen.Graph
> import Sound.Sc3.Ugen.Graph.Reconstruct

> let k = control kr "bus" 0
> let o = sinOsc ar 440 0 + whiteNoiseId 'α' 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 -> Types.Ugen
reconstruct_c_ugen :: U_Node -> Ugen
reconstruct_c_ugen U_Node
u = Sample -> Ugen
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 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 -> 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 Maybe Int
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 = [Rate] -> Int
forall a. [a] -> Int
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 = (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%s_o_%d" String
l) [Int
0 .. Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
      p' :: String
p' = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
p
  in if Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
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 :: Int
z = U_Node -> Int
Graph.u_node_id U_Node
u
      o :: Int
o = [Rate] -> Int
forall a. [a] -> Int
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 = String -> String -> String -> String -> String -> Int -> 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 Int
o
      nd_s :: String
nd_s =
        let t :: String
t = String
"%s = nondet \"%s\" (Uid %d) %s [%s] %d"
        in String
-> String -> String -> Int -> String -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
t String
l String
n Int
z (Rate -> String
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 UgenId -> UgenId -> Bool
forall a. Eq a => a -> a -> Bool
== UgenId
Types.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 a. [a] -> 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 a. [a] -> 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)