Bindings.hs

-- | Generate UGen binding functions from DB.
module Sound.SC3.UGen.DB.Bindings where

import Data.List
import Data.Maybe
import Sound.SC3.UGen.Name {- hsc3 -}
import Text.Printf

import Sound.SC3.UGen.DB.Record

-- > import Sound.SC3.UGen.DB
-- > import Sound.SC3.UGen.DB.Data
-- > import Sound.SC3.UGen.DB.Rename
-- > map ugen_name (filter (not . ugen_mce_sane) ugenDB) == []
ugen_mce_sane :: U -> Bool
ugen_mce_sane u =
    case ugen_mce_input u of
      Just n -> n == length (ugen_inputs u) - 1
      Nothing -> True

-- > fmap u_input_names (uLookup "SinOsc")
-- > fmap u_input_names (uLookup "BufRd")
u_input_names :: U -> [String]
u_input_names = map input_name . ugen_inputs

unenumerator :: String -> String
unenumerator en =
    case en of
      "Loop" -> "from_loop"
      "Interpolation" -> "from_interpolation"
      "DoneAction" -> "from_done_action"
      "Warp" -> "from_warp"
      _ -> error "unenumerator"

input_name_proc :: I -> String
input_name_proc i =
    let nm = input_name i
    in case input_enumeration i of
         Just en -> printf "%s %s" (unenumerator en) nm
         Nothing -> nm

u_input_names_proc :: U -> [String]
u_input_names_proc = map input_name_proc . ugen_inputs

-- > about ('[',']') "a,b" == "[a,b]"
about :: (a, a) -> [a] -> [a]
about (p,q) s = p : s ++ [q]

-- > brckt "a,b" == "[a,b]"
brckt :: String -> String
brckt = about ('[',']')

quote :: [Char] -> [Char]
quote = about ('"','"')

-- > ppl_space ["freq","phase"] == "freq phase"
ppl_space :: [String] -> String
ppl_space = unwords'

-- > ppl_list ["freq","phase"] == "[freq,phase]"
ppl_list :: [String] -> String
ppl_list = brckt . intercalate ","

-- | Variant that 'delete's empty inputs, useful for pretty printing.
--
-- > unwords ["a","","b"] == "a  b"
-- > unwords' ["a","","b"] == "a b"
unwords' :: [String] -> String
unwords' = unwords . filter (not . null)

-- > fmap u_gen_type_sig (uLookup "Blip")
-- > fmap u_gen_type_sig (uLookup "BufRd")
-- > fmap u_gen_type_sig (uLookup "Resonz")
-- > fmap u_gen_type_sig (uLookup "BrownNoise")
u_gen_type_sig :: U -> [String]
u_gen_type_sig u =
    let i = ugen_inputs u
        i_sig = map (fromMaybe "UGen" . input_enumeration) i
        nm_h = ugen_name u
        o = case ugen_outputs u of
              Left _ -> "" -- printf "{- nc=%d -}" k
              Right _ -> "Int ->"
        r = if isNothing (ugen_filter u)
            then "Rate ->"
            else "" -- "{- filter -}"
        i_sig' = intercalate " -> " i_sig
        arr = if null i then "" else "->"
    in [nm_h,"::",o,r,i_sig',arr,"UGen"]

-- > fmap u_outputs (uLookup "BufRd") == Just ("numChannels","numChannels")
-- > fmap u_outputs (uLookup "SinOsc") == Just ("","1")
u_outputs :: U -> (String,String)
u_outputs u =
    case ugen_outputs u of
      Left n -> ("",show n)
      Right _ -> ("numChannels","numChannels")

-- > fmap u_gen_osc_f (uLookup "Blip")
-- > fmap u_gen_osc_f (uLookup "BufRd")
u_gen_osc_f :: U -> [String]
u_gen_osc_f u =
    let nm_h = ugen_name u
        nm = toSC3Name nm_h
        i_s = ppl_space (u_input_names u)
        i_l = ppl_list (u_input_names_proc u)
        r = ppl_list (map show (ugen_operating_rates u))
        (o_lhs,o_rhs) = u_outputs u
    in [nm_h,o_lhs,"rate",i_s,"= mkOscR",r,"rate",quote nm,i_l,o_rhs]

-- > fmap u_gen_filter_f (uLookup "Resonz")
u_gen_filter_f :: U -> [String]
u_gen_filter_f u =
    let nm_h = ugen_name u
        nm = toSC3Name nm_h
        i = u_input_names u
        i_s = ppl_space i
        i_l = ppl_list i
        (o_lhs,o_rhs) = u_outputs u
     in [nm_h,o_lhs,i_s,"= mkFilter",quote nm,i_l,o_rhs]

-- > fmap u_gen_binding (uLookup "LFGauss")
-- > fmap (u_gen_binding . u_rename) (uLookup "In")
-- > let b = map (u_gen_binding . u_rename_db ugenDB) ugenDB
-- > writeFile "/tmp/bind-sc3.hs" (unlines (intercalate [""] b))
u_gen_binding :: U -> [String]
u_gen_binding u =
    let c = ["-- |",ugen_summary u]
        s = u_gen_type_sig u
        b = case ugen_filter u of
              Just _ -> u_gen_filter_f u
              _ -> u_gen_osc_f u
    in map unwords' [c,s,b]