hsc3-rec-0.9: mk/build.hs

import Data.Char
import Sound.SC3.UGen.Rate
import qualified Sound.SC3.UGen.DB.Data as D
import System.FilePath
import Text.Printf

-- Rename parameters that conflict with keywords or prelude functions,
-- or which have otherwise unwieldy names.
rename_input :: String -> String
rename_input "in" = "input"
rename_input "channelsArray" = "input"
rename_input "exp" = "exp_"
rename_input "id" = "id_"
rename_input "length" = "length_"
rename_input "init" = "init_"
rename_input "floor" = "floor_"
rename_input "div" = "div_"
rename_input "max" = "max_"
rename_input "min" = "min_"
rename_input "spring" = "spring_"
rename_input "rate" = "rate_"
rename_input "default" = "default_"
rename_input s = s

-- Rename unit generators that conflict with keywords or prelude
-- functions.
rename_ugen :: String -> String
rename_ugen "in" = "in'"
rename_ugen s = s

input_name :: D.I -> String
input_name = rename_input . D.input_name

-- True if the unit generator can operate at multiple rates, in which
-- case the record will require a rate field.
needs_rate :: D.U -> Bool
needs_rate u = length (D.ugen_operating_rates u) > 1

-- In the case of one input rate use that instead of default rate,
-- which can be innacurate (see pitch for example).
fixed_rate :: D.U -> Rate
fixed_rate (D.U _ [r] _ _ _) = r
fixed_rate (D.U _ [] r _ _) = r
fixed_rate _ = undefined

-- List of field names and types.
inputs_of :: D.U -> [(String, String)]
inputs_of u =
    let is = D.ugen_inputs u
        bs = zip (map input_name is) (repeat "S.UGen")
    in if needs_rate u
       then ("rate", "S.Rate") : bs
       else bs

-- Append a character to each but the last string.
with_char :: Char -> [String] -> [String]
with_char c (x:y:xs) = (x ++ [c]) : with_char c (y:xs)
with_char _ xs = xs

with_comma :: [String] -> [String]
with_comma = with_char ','

with_space :: [String] -> [String]
with_space = with_char ' '

downcase_first_char :: String -> String
downcase_first_char [] = []
downcase_first_char (x:xs) = toLower x : xs

-- Construct the parameter record.
gen_param :: D.U -> [String]
gen_param u =
    let n = D.ugen_name u
        pre = [printf "data %s = %s {" n n]
        post = ["  } deriving (Show)"]
        f (nm, ty) = printf "  %s :: %s" nm ty
    in pre ++ with_comma (map f (inputs_of u)) ++ post

-- Construct a default instance of the parameter structure.
gen_defaults :: D.U -> [String]
gen_defaults u@(D.U n _ r is _) =
    let nm = rename_ugen (downcase_first_char n)
        pre = [ printf "%s :: %s" nm n
              , printf "%s = %s {" nm n]
        post = [ "  }" ]
        opt = if needs_rate u then [printf "  rate = S.%s," (show r)] else []
        f i = printf "  %s = %f" (input_name i) (D.input_default i)
    in pre ++ opt ++ with_comma (map f is) ++ post

-- Generate a list of variable names (a,b..)
var_names :: Int -> [String]
var_names n = map (\x -> x : "'") (take n ['a'..])

-- Generate the constructor for the unit generator.
gen_cons :: D.U -> [String]
gen_cons u@(D.U n _ _ is o) = 
    let xs = var_names (length is)
        nr = needs_rate u
        l_opt = if nr then "r" else ""
        r_opt = if nr then "r" else printf "S.%s" (show (fixed_rate u))
    in [ printf "mk%s :: %s -> S.UGen" n n
       , printf "mk%s (%s %s %s) = S.mkOsc %s \"%s\" [%s] %d" 
                n
                n
                l_opt
                (concat (with_space xs))
                r_opt
                n 
                (concat (with_comma xs))
                o]

-- Generate instance of the Make class.
gen_make :: D.U -> [String]
gen_make u =
    let n = D.ugen_name u
    in [ printf "instance Make %s where" n
       , printf "  ugen = mk%s" n ]

-- Path to write files to.
sc3_ugen_dir :: FilePath
sc3_ugen_dir = "Sound" </> "SC3" </> "UGen"

-- Write module for a unit generator.
write_module :: D.U -> IO ()
write_module u =
    let n = D.ugen_name u
        m = [ printf "module Sound.SC3.UGen.Record.%s where" n
            , "import qualified Sound.SC3.UGen as S"
            , "import Sound.SC3.UGen.Record" ]
        p = gen_param u
        d = gen_defaults u
        c = gen_cons u
        i = gen_make u
        fn = sc3_ugen_dir </> "Record" </> n <.> ".hs"
    in writeFile fn (unlines (m ++ p ++ d ++ c ++ i))

main :: IO ()
main = do
  let us = filter (\u -> not (null (D.ugen_inputs u))) D.ugenDB
  mapM_ write_module us

{-
gen_module_clause :: [D.U] -> [String]
gen_module_clause us =
    let f u = printf "  module Sound.SC3.UGen.Record.%s" (D.ugen_name u)
        pre = ["{-# LANGUAGE DisambiguateRecordFields #-}"
              ,"module Sound.SC3.UGen.Record.All ("]
        post = ["  ) where"]
    in pre ++ with_comma (map f us) ++ post

gen_imports :: [D.U] -> [String]
gen_imports = 
    let f u = printf "import Sound.SC3.UGen.Record.%s" (D.ugen_name u)
    in map f

write_records :: [D.U] -> IO ()
write_records us = 
    let s = unlines (gen_module_clause us ++ gen_imports us)
    in writeFile (sc3_ugen_dir </> "Record" </> "All" <.> "hs") s
-}