module Sound.SC3.RW.ID where
import Data.Char
import System.Directory
greek_letters :: [(Char,Char,String)]
greek_letters =
[('Α','α',"Alpha")
,('Β','β',"Beta")
,('Γ','γ',"Gamma")
,('Δ','δ',"Delta")
,('Ε','ε',"Epsilon")
,('Ζ','ζ',"Zeta")
,('Η','η',"Eta")
,('Θ','θ',"Theta")
,('Ι','ι',"Iota")
,('Κ','κ',"Kappa")
,('Λ','λ',"Lambda")
,('Μ','μ',"Mu")
,('Ν','ν',"Nu")
,('Ξ','ξ',"Xi")
,('Ο','ο',"Omicron")
,('Π','π',"Pi")
,('Ρ','ρ',"Rho")
,('Σ','σ',"Sigma")
,('Τ','τ',"Tau")
,('Υ','υ',"Upsilon")
,('Φ','φ',"Phi")
,('Χ','χ',"Chi")
,('Ψ','ψ',"Psi")
,('Ω','ω',"Omega")]
type Name_Supply = [Char]
greek_letters_nm :: Name_Supply
greek_letters_nm =
let uc = map (\(c,_,_) -> c) greek_letters
lc = map (\(_,c,_) -> c) greek_letters
in lc ++ uc
rewrite :: Name_Supply -> String -> String
rewrite s l =
case s of
k:s' -> case l of
[] -> []
'\'' : c : '\'' : l' ->
if isLetter c
then '\'' : k : '\'' : rewrite s' l'
else '\'' : c : rewrite s ('\'' : l')
c : l' -> c : rewrite s l'
_ -> undefined
hsc3_id_rewrite :: String -> String
hsc3_id_rewrite = rewrite greek_letters_nm
hsc3_id_clear :: String -> String
hsc3_id_clear = rewrite (repeat 'α')
hsc3_id_rewrite_preprocessor :: FilePath -> FilePath -> FilePath -> IO ()
hsc3_id_rewrite_preprocessor _ i_fn o_fn = do
s <- readFile i_fn
writeFile o_fn (hsc3_id_rewrite s)
hsc3_id_rewrite_inplace :: FilePath -> IO ()
hsc3_id_rewrite_inplace fn = do
let fn' = fn ++ "~"
copyFile fn fn'
hsc3_id_rewrite_preprocessor fn fn' fn