-- | 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 ('[',']')

-- > 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 ","

-- > 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 printf "%s :: %s %s %s %s UGen" nm_h o r i_sig' arr

-- > 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
        tpl = "%s %s rate %s = mkOscR %s rate \"%s\" %s %s"
    in printf tpl nm_h o_lhs i_s r 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
        tpl = "%s %s %s = mkFilter \"%s\" %s %s"
     in printf tpl nm_h o_lhs i_s nm i_l o_rhs

-- > fmap u_gen_binding (uLookup "LFGauss")
-- > fmap (u_gen_binding . u_rename) (uLookup "In")
-- > mapM_ (putStrLn . unlines . u_gen_binding . u_rename_db ugenDB) ugenDB
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 [c,s,b]