Common.hs

module Sound.SC3.UGen.Dot.Common where

import Text.Printf {- base -}

-- | Bracket with elements.
bracket1 :: (a,a) -> [a] -> [a]
bracket1 (l,r) x = [l] ++ x ++ [r]

-- | Bracket with lists.
bracket :: ([a],[a]) -> [a] -> [a]
bracket (l,r) x = l ++ x ++ r

-- | 'bracket' with double quotes.
string_pp :: String -> String
string_pp = bracket1 ('"','"')

-- | 'bracket' with double quotes and braces.
label_pp :: String -> String
label_pp = bracket ("\"{","}\"")

-- | Type specialised 'show'.
int_pp :: Int -> String
int_pp = show

-- | 'reverse' of /f/ of 'reverse'.
--
-- > let drop_while_right f = right_variant (dropWhile f)
-- > in drop_while_right isUpper "abcDEF" == "abc"
right_variant :: ([a] -> [b]) -> [a] -> [b]
right_variant f = reverse . f . reverse

-- | Limited precision PP for 'n', no scientific notation.
--
-- > map (limit_precision_p True 2) [1,1.25,1.12345,0,0.05,pi*1e8,1e9]
limit_precision_p :: (PrintfArg n) => Bool -> Int -> n -> String
limit_precision_p r n c =
    let i = printf "%.*f" n c
    in if r
       then i
       else right_variant (dropWhile (== '.') . dropWhile (== '0')) i

-- | Limited precision PP for 'n', with scientific notation.
--
-- > map (limit_precision_e 3) [1,1.25,0.05,pi*1e8,1e9,read "Infinity"]
limit_precision_e :: (Read n,Show n) => Int -> n -> String
limit_precision_e n c =
    case show c of
      "Infinity" -> "Infinity"
      c' ->
          let (i,j') = break (== '.') c'
              j = if null j' then error ("limit_precision_e: no dot: " ++ c') else tail j'
              (k,l) = break (== 'e') j
              f :: String -> Int
              f m = round ((read (take (n + 1) m) :: Read n => n) / (10::Double))
              k' = if length k > n
                   then show (f k)
                   else k
          in i ++ if k == "0"
                  then l
                  else "." ++ k' ++ l

-- | Variant selecting scientific notation more cautiously than haskells default PP.
--
-- > map (limit_precision True 3) [1,1.25,0.05,0,pi*1e8,1e9]
limit_precision :: (Floating n,Ord n,Read n,Show n,PrintfArg n) => Bool -> Int -> n -> String
limit_precision r n c =
    if c /= 0 && (c < (10 ** fromIntegral (- n)) || c > 1e6)
    then limit_precision_e n c
    else limit_precision_p r n c