{- | Functions to normalise Ugen names.

@Sc3@ Ugen names are capitalised at word boundaries.
@hsc3@ cannot use these names for Ugen constructor functions.
Haskell names are given by lower-casing until the first word edge.
Lisp names are given by lower-casing everything and adding hyphens before edges.
-}
module Sound.Sc3.Ugen.Name where

import Data.Char {- base -}

import Sound.Sc3.Common.Base {- hsc3 -}
import Sound.Sc3.Common.Rate {- hsc3 -}

{-
import qualified Sound.Sc3.Common.Base {- hsc3 -}

is_uc_or_num :: Char -> Bool
is_uc_or_num c = isUpper c || isDigit c

is_lc_or_num :: Char -> Bool
is_lc_or_num c = isLower c || isDigit c
-}

{- | Find all Sc3 name edges. Edges occur at non lower-case letters.
  This rule is very simple but is coherent and predictable and works well for .hs names.
-}
sc3_name_edges_plain :: String -> [Bool]
sc3_name_edges_plain :: String -> [Bool]
sc3_name_edges_plain = (Char -> Bool) -> String -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isLower)

{- | Find non-initial Sc3 name edges.

>>> sc3_name_edges "SinOsc"
[False,False,False,True,False,False]

>>> sc3_name_edges "FFT"
[False,False,False]

>>> sc3_name_edges "DFM1"
[False,False,False,False]

>>> sc3_name_edges "PV_Add"
[False,False,False,True,False,False]

>>> sc3_name_edges "A2K"
[False,False,False]

>>> sc3_name_edges "Lag2UD"
[False,False,False,True,True,True]

>>> sc3_name_edges "PeakEQ"
[False,False,False,False,True,True]
-}
sc3_name_edges :: String -> [Bool]
sc3_name_edges :: String -> [Bool]
sc3_name_edges String
s =
  let ([Bool]
p, [Bool]
q) = (Bool -> Bool) -> [Bool] -> ([Bool], [Bool])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) (String -> [Bool]
sc3_name_edges_plain String
s)
      n :: Int
n = [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
p
  in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 Bool -> Bool -> Bool
|| [Bool] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bool]
q
      then Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n Bool
False [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Bool]
q
      else Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Bool
False [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Bool
True] [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Bool]
q

{- | Convert from ScLang (class) name to Haskell (function) name.

>>> let f = unwords . map sc3_name_to_hs_name . words
>>> f "SinOsc LFSaw FFT PV_Add AllpassN BHiPass BinaryOpUGen HPZ1 RLPF"
"sinOsc lfSaw fft pv_Add allpassN bHiPass binaryOpUGen hpz1 rlpf"

>>> f "TGrains DFM1 FBSineC A2K Lag2UD IIRFilter FMGrainB Pan2 PeakEQ RIRandN"
"tGrains dfm1 fbSineC a2k lag2UD iirFilter fmGrainB pan2 peakEQ riRandN"
-}
sc3_name_to_hs_name :: String -> String
sc3_name_to_hs_name :: String -> String
sc3_name_to_hs_name String
s =
  let f :: (Char, Bool) -> Char
f (Char
c, Bool
e) = if Bool
e then Char -> Char
toUpper Char
c else Char
c
  in (Char -> Bool -> Char) -> String -> [Bool] -> String
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Char, Bool) -> Char) -> Char -> Bool -> Char
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Char, Bool) -> Char
f) ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s) (String -> [Bool]
sc3_name_edges String
s)

{- | Convert from Sc3 name to Lisp style name.

>>> let f = unwords . map sc3_name_to_lisp_name . words
>>> f "SinOsc LFSaw FFT PV_Add AllpassN BHiPass BinaryOpUGen HPZ1 RLPF TGrains DFM1 BPeakEQ Pan2 RIRandN"
"sin-osc lf-saw fft pv-add allpass-n b-hi-pass binary-op-u-gen hpz1 rlpf t-grains dfm1 b-peak-e-q pan-2 ri-rand-n"
-}
sc3_name_to_lisp_name :: String -> String
sc3_name_to_lisp_name :: String -> String
sc3_name_to_lisp_name String
s =
  let f :: (Char, Bool) -> String
f (Char
c, Bool
e) = if Bool
e then [Char
'-', Char
c] else if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' then [] else [Char
c]
  in ((Char, Bool) -> String) -> [(Char, Bool)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Char, Bool) -> String
f (String -> [Bool] -> [(Char, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s) (String -> [Bool]
sc3_name_edges String
s))

{- | Sc3 Ugen /names/ are given with rate suffixes if oscillators, without if filters.

>>> map sc3_ugen_name_sep (words "SinOsc.ar LPF *")
[Just ("SinOsc",Just AudioRate),Just ("LPF",Nothing),Just ("*",Nothing)]
-}
sc3_ugen_name_sep :: String -> Maybe (String, Maybe Rate)
sc3_ugen_name_sep :: String -> Maybe (String, Maybe Rate)
sc3_ugen_name_sep String
u =
  case Char -> String -> [String]
string_split_at_char Char
'.' String
u of
    [String
nm, String
rt] -> (String, Maybe Rate) -> Maybe (String, Maybe Rate)
forall a. a -> Maybe a
Just (String
nm, String -> Maybe Rate
rate_parse ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
rt))
    [String
nm] -> (String, Maybe Rate) -> Maybe (String, Maybe Rate)
forall a. a -> Maybe a
Just (String
nm, Maybe Rate
forall a. Maybe a
Nothing)
    [String]
_ -> Maybe (String, Maybe Rate)
forall a. Maybe a
Nothing