-- | Decode (read) a 'Graphdef' into a 'Graph'.
module Sound.Sc3.Server.Graphdef.Read where

import qualified Sound.Osc.Datum as Datum {- hosc -}

import qualified Sound.Sc3.Common.Rate as Rate {- hsc3 -}
import qualified Sound.Sc3.Common.Uid as Uid {- hsc3 -}
import qualified Sound.Sc3.Server.Graphdef as Graphdef {- hsc3 -}
import qualified Sound.Sc3.Server.Graphdef.Binary as Graphdef {- hsc3 -}
import qualified Sound.Sc3.Ugen.Graph as Graph {- hsc3 -}
import qualified Sound.Sc3.Ugen.Types as Types {- hsc3 -}

control_to_node :: Graphdef.Graphdef -> Uid.Id -> (Graphdef.Control, Types.Sample) -> Graph.U_Node
control_to_node :: Graphdef -> Ugen_Index -> (Control, Sample) -> U_Node
control_to_node Graphdef
g Ugen_Index
z ((Name
nm, Ugen_Index
ix), Sample
v) =
  let z' :: Ugen_Index
z' = Graphdef -> Ugen_Index -> Ugen_Index
Graphdef.graphdef_control_nid Graphdef
g Ugen_Index
z
      nm' :: String
nm' = Name -> String
Datum.ascii_to_string Name
nm
  in Ugen_Index
-> Rate
-> Maybe Ugen_Index
-> String
-> Sample
-> K_Type
-> Maybe (Control_Meta Sample)
-> U_Node
Graph.U_Node_K Ugen_Index
z' Rate
Rate.ControlRate (Ugen_Index -> Maybe Ugen_Index
forall a. a -> Maybe a
Just Ugen_Index
ix) String
nm' Sample
v K_Type
Rate.K_ControlRate Maybe (Control_Meta Sample)
forall a. Maybe a
Nothing

-- | Note: Graphs with multiple Control Ugens are not accounted for.
input_to_from_port :: Graphdef.Graphdef -> Graphdef.Input -> Graph.From_Port
input_to_from_port :: Graphdef -> Input -> From_Port
input_to_from_port Graphdef
g (Graphdef.Input Ugen_Index
u Ugen_Index
p) =
  if Ugen_Index
u Ugen_Index -> Ugen_Index -> Bool
forall a. Eq a => a -> a -> Bool
== -Ugen_Index
1
    then Ugen_Index -> From_Port
Graph.From_Port_C (Graphdef -> Ugen_Index -> Ugen_Index
Graphdef.graphdef_constant_nid Graphdef
g Ugen_Index
p)
    else
      if Graphdef -> Input -> Bool
Graphdef.input_is_control Graphdef
g (Ugen_Index -> Ugen_Index -> Input
Graphdef.Input Ugen_Index
u Ugen_Index
p)
        then Ugen_Index -> K_Type -> From_Port
Graph.From_Port_K (Graphdef -> Ugen_Index -> Ugen_Index
Graphdef.graphdef_control_nid Graphdef
g Ugen_Index
p) K_Type
Rate.K_ControlRate
        else
          let ugen :: Ugen
ugen = Graphdef -> [Ugen]
Graphdef.graphdef_ugens Graphdef
g [Ugen] -> Ugen_Index -> Ugen
forall a. HasCallStack => [a] -> Ugen_Index -> a
!! Ugen_Index
u
              port :: Maybe Ugen_Index
port =
                if [Ugen_Index] -> Ugen_Index
forall a. [a] -> Ugen_Index
forall (t :: * -> *) a. Foldable t => t a -> Ugen_Index
length (Ugen -> [Ugen_Index]
Graphdef.ugen_outputs Ugen
ugen) Ugen_Index -> Ugen_Index -> Bool
forall a. Ord a => a -> a -> Bool
> Ugen_Index
1
                  then Ugen_Index -> Maybe Ugen_Index
forall a. a -> Maybe a
Just Ugen_Index
p
                  else Maybe Ugen_Index
forall a. Maybe a
Nothing
          in Ugen_Index -> Maybe Ugen_Index -> From_Port
Graph.From_Port_U (Graphdef -> Ugen_Index -> Ugen_Index
Graphdef.graphdef_ugen_nid Graphdef
g Ugen_Index
u) Maybe Ugen_Index
port

ugen_to_node :: Graphdef.Graphdef -> Uid.Id -> Graphdef.Ugen -> Graph.U_Node
ugen_to_node :: Graphdef -> Ugen_Index -> Ugen -> U_Node
ugen_to_node Graphdef
g Ugen_Index
z Ugen
u =
  let (Name
name, Ugen_Index
rate, [Input]
inputs, [Ugen_Index]
outputs, Ugen_Index
special) = Ugen
u
      z' :: Ugen_Index
z' = Graphdef -> Ugen_Index -> Ugen_Index
Graphdef.graphdef_ugen_nid Graphdef
g Ugen_Index
z
      rate' :: Rate
rate' = Ugen_Index -> Rate
forall a. Enum a => Ugen_Index -> a
toEnum Ugen_Index
rate
      name' :: String
name' = Name -> String
Datum.ascii_to_string Name
name
      inputs' :: [From_Port]
inputs' = (Input -> From_Port) -> [Input] -> [From_Port]
forall a b. (a -> b) -> [a] -> [b]
map (Graphdef -> Input -> From_Port
input_to_from_port Graphdef
g) [Input]
inputs
      outputs' :: [Rate]
outputs' = (Ugen_Index -> Rate) -> [Ugen_Index] -> [Rate]
forall a b. (a -> b) -> [a] -> [b]
map Ugen_Index -> Rate
forall a. Enum a => Ugen_Index -> a
toEnum [Ugen_Index]
outputs
      special' :: Special
special' = Ugen_Index -> Special
Types.Special Ugen_Index
special
  in Ugen_Index
-> Rate
-> String
-> [From_Port]
-> [Rate]
-> Special
-> UgenId
-> U_Node
Graph.U_Node_U Ugen_Index
z' Rate
rate' String
name' [From_Port]
inputs' [Rate]
outputs' Special
special' (Ugen_Index -> UgenId
Types.Uid Ugen_Index
z')

graphdef_to_graph :: Graphdef.Graphdef -> (String, Graph.U_Graph)
graphdef_to_graph :: Graphdef -> (String, U_Graph)
graphdef_to_graph Graphdef
g =
  let constants_nd :: [U_Node]
constants_nd = (Ugen_Index -> Sample -> U_Node)
-> [Ugen_Index] -> [Sample] -> [U_Node]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Ugen_Index -> Sample -> U_Node
Graph.U_Node_C [Ugen_Index
0 ..] (Graphdef -> [Sample]
Graphdef.graphdef_constants Graphdef
g)
      controls_nd :: [U_Node]
controls_nd = (Ugen_Index -> (Control, Sample) -> U_Node)
-> [Ugen_Index] -> [(Control, Sample)] -> [U_Node]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Graphdef -> Ugen_Index -> (Control, Sample) -> U_Node
control_to_node Graphdef
g) [Ugen_Index
0 ..] (Graphdef -> [(Control, Sample)]
Graphdef.graphdef_controls Graphdef
g)
      ugens_nd :: [U_Node]
ugens_nd = (Ugen_Index -> Ugen -> U_Node)
-> [Ugen_Index] -> [Ugen] -> [U_Node]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Graphdef -> Ugen_Index -> Ugen -> U_Node
ugen_to_node Graphdef
g) [Ugen_Index
0 ..] (Graphdef -> [Ugen]
Graphdef.graphdef_ugens Graphdef
g)
      nm :: String
nm = Name -> String
Datum.ascii_to_string (Graphdef -> Name
Graphdef.graphdef_name Graphdef
g)
      gr :: U_Graph
gr = Ugen_Index -> [U_Node] -> [U_Node] -> [U_Node] -> U_Graph
Graph.U_Graph (-Ugen_Index
1) [U_Node]
constants_nd [U_Node]
controls_nd [U_Node]
ugens_nd
  in (String
nm, U_Graph
gr) -- S.Synthdef nm gr

-- | Read graphdef file and translate to graph.
read_graph :: FilePath -> IO Graph.U_Graph
read_graph :: String -> IO U_Graph
read_graph String
sy_nm = do
  Graphdef
d <- String -> IO Graphdef
Graphdef.read_graphdef_file String
sy_nm
  let (String
_, U_Graph
g) = Graphdef -> (String, U_Graph)
graphdef_to_graph Graphdef
d
  U_Graph -> IO U_Graph
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return U_Graph
g

-- | Read graphdef file, translate to graph, and run 'ug_stat_ln'.
scsyndef_ug_stat :: FilePath -> IO String
scsyndef_ug_stat :: String -> IO String
scsyndef_ug_stat String
sy_nm = do
  U_Graph
g <- String -> IO U_Graph
read_graph String
sy_nm
  String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> String
unlines (U_Graph -> [String]
Graph.ug_stat_ln U_Graph
g))