hsc3-rec-0.14: mk/build.hs

import Data.Char
import Sound.SC3.UGen.Rate {- hsc3 -}
import qualified Sound.SC3.UGen.DB.Data as D {- hsc3-db -}
import qualified Sound.SC3.UGen.DB.Record as D
import qualified Sound.SC3.UGen.DB.Rename as D
import System.FilePath {- filepath -}
import Text.Printf

-- 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 u =
    case D.ugen_operating_rates u of
      [r] -> r
      [] -> D.ugen_default_rate u
      _ -> undefined

--u_input_nm u k = D.input_name (D.ugen_inputs u !! k)

-- List of field names and types.
inputs_of :: D.U -> [(String, String)]
inputs_of u =
    let is = D.ugen_inputs u
        bs = zip (map D.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 l =
    case l of
      x:y:xs -> (x ++ [c]) : with_char c (y:xs)
      _ -> l

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

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

downcase_first_char :: String -> String
downcase_first_char s =
    case s of
      [] -> []
      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 =
    let (D.U n _ r _ is _ _ _) = u
        nm = D.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" (D.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 (: "'") (take n ['a'..])

-- Generate the constructor for the unit generator.
gen_cons :: D.U -> [String]
gen_cons u =
    let (D.U n _ _ _ is _ o _) = u
        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))
        o' = case o of
               Left x -> show x
               Right _ -> "undefined"
    in [ printf "mk%s :: %s -> S.UGen" n n
       , printf "mk%s (%s %s %s) = S.mkOsc %s \"%s\" [%s] %s"
                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 "-- | %s" (D.ugen_summary u)
            , 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 (not . null . D.ugen_inputs) 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
-}